quebex

  1-- SPDX-FileCopyrightText: 1999-2001 Daan Leijen
  2-- SPDX-FileCopyrightText: 2007 Paolo Martini
  3-- SPDX-FileCopyrightText: 2013-2014 Christian Maeder <chr.maeder@web.de>
  4-- SPDX-FileCopyrightText: 2025 Sören Tempel <soeren+git@soeren-tempel.net>
  5--
  6-- SPDX-License-Identifier: BSD-2-Clause AND GPL-3.0-only
  7
  8module Language.QBE.Numbers where
  9
 10import Control.Monad (ap)
 11import Data.Char (digitToInt)
 12import Text.Parsec
 13
 14-- ** float parts
 15
 16-- | parse a floating point number given the number before a dot, e or E
 17fractExponent :: (Floating f, Stream s m Char) => Integer -> ParsecT s u m f
 18fractExponent i = fractExp i True
 19
 20-- | parse a floating point number given the number before a dot, e or E
 21fractExp ::
 22  (Floating f, Stream s m Char) =>
 23  Integer ->
 24  Bool ->
 25  ParsecT s u m f
 26fractExp i b = genFractExp i (fraction b) exponentFactor
 27
 28-- | parse a floating point number given the number before the fraction and
 29-- exponent
 30genFractExp ::
 31  (Floating f, Stream s m Char) =>
 32  Integer ->
 33  ParsecT s u m f ->
 34  ParsecT s u m (f -> f) ->
 35  ParsecT s u m f
 36genFractExp i frac expo = case fromInteger i of
 37  f -> genFractAndExp f frac expo <|> fmap ($ f) expo
 38
 39-- | parse a floating point number given the number before the fraction and
 40-- exponent that must follow the fraction
 41genFractAndExp ::
 42  (Floating f, Stream s m Char) =>
 43  f ->
 44  ParsecT s u m f ->
 45  ParsecT s u m (f -> f) ->
 46  ParsecT s u m f
 47genFractAndExp f frac = ap (fmap (flip id . (f +)) frac) . option id
 48
 49-- | parse a floating point exponent starting with e or E
 50exponentFactor :: (Floating f, Stream s m Char) => ParsecT s u m (f -> f)
 51exponentFactor = oneOf "eE" >> extExponentFactor 10 <?> "exponent"
 52
 53-- | parse a signed decimal and compute the exponent factor given a base.
 54-- For hexadecimal exponential notation (IEEE 754) the base is 2 and the
 55-- leading character a p.
 56extExponentFactor ::
 57  (Floating f, Stream s m Char) =>
 58  Int -> ParsecT s u m (f -> f)
 59extExponentFactor base =
 60  fmap (flip (*) . exponentValue base) (ap sign (decimal <?> "exponent"))
 61
 62-- | compute the factor given by the number following e or E. This
 63-- implementation uses @**@ rather than @^@ for more efficiency for large
 64-- integers.
 65exponentValue :: (Floating f) => Int -> Integer -> f
 66exponentValue base = (fromIntegral base **) . fromInteger
 67
 68-- ** fractional parts
 69
 70-- | parse a dot followed by decimal digits as fractional part
 71fraction :: (Fractional f, Stream s m Char) => Bool -> ParsecT s u m f
 72fraction b = baseFraction b 10 digit
 73
 74-- | parse a dot followed by base dependent digits as fractional part
 75baseFraction ::
 76  (Fractional f, Stream s m Char) =>
 77  Bool ->
 78  Int ->
 79  ParsecT s u m Char ->
 80  ParsecT s u m f
 81baseFraction requireDigit base baseDigit =
 82  char '.'
 83    >> fmap
 84      (fractionValue base)
 85      ((if requireDigit then many1 else many) baseDigit <?> "fraction")
 86    <?> "fraction"
 87
 88-- | compute the fraction given by a sequence of digits following the dot.
 89-- Only one division is performed and trailing zeros are ignored.
 90fractionValue :: (Fractional f) => Int -> String -> f
 91fractionValue base =
 92  uncurry (/)
 93    . foldl
 94      ( \(s, p) d ->
 95          (p * fromIntegral (digitToInt d) + s, p * fromIntegral base)
 96      )
 97      (0, 1)
 98    . dropWhile (== '0')
 99    . reverse
100
101-- * integers and naturals
102
103-- | parse an optional plus or minus sign, returning 'negate' or 'id'
104sign :: (Num a, Stream s m Char) => ParsecT s u m (a -> a)
105sign = (char '-' >> return negate) <|> (optional (char '+') >> return id)
106
107-- | parse plain non-negative decimal numbers given by a non-empty sequence
108-- of digits
109decimal :: (Integral i, Stream s m Char) => ParsecT s u m i
110decimal = number 10 digit
111
112-- ** natural parts
113
114-- | parse a hexadecimal number
115hexnum :: (Integral i, Stream s m Char) => ParsecT s u m i
116hexnum = number 16 hexDigit
117
118-- | parse an octal number
119octnum :: (Integral i, Stream s m Char) => ParsecT s u m i
120octnum = number 8 octDigit
121
122-- | parse a non-negative number given a base and a parser for the digits
123number ::
124  (Integral i, Stream s m t) =>
125  Int ->
126  ParsecT s u m Char ->
127  ParsecT s u m i
128number base baseDigit = do
129  n <- fmap (numberValue base) (many1 baseDigit)
130  seq n (return n)
131
132-- | compute the value from a string of digits using a base
133numberValue :: (Integral i) => Int -> String -> i
134numberValue base =
135  foldl (\x -> ((fromIntegral base * x) +) . fromIntegral . digitToInt) 0