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 a negative or a positive number (returning 'negate' or 'id').
104-- positive numbers are NOT allowed to be prefixed by a plus sign.
105signMinus :: (Num a, Stream s m Char) => ParsecT s u m (a -> a)
106signMinus = (char '-' >> return negate) <|> return id
107
108-- | parse an optional plus or minus sign, returning 'negate' or 'id'
109sign :: (Num a, Stream s m Char) => ParsecT s u m (a -> a)
110sign = (char '-' >> return negate) <|> (optional (char '+') >> return id)
111
112-- | parse plain non-negative decimal numbers given by a non-empty sequence
113-- of digits
114decimal :: (Integral i, Stream s m Char) => ParsecT s u m i
115decimal = number 10 digit
116
117-- ** natural parts
118
119-- | parse a hexadecimal number
120hexnum :: (Integral i, Stream s m Char) => ParsecT s u m i
121hexnum = number 16 hexDigit
122
123-- | parse an octal number
124octnum :: (Integral i, Stream s m Char) => ParsecT s u m i
125octnum = number 8 octDigit
126
127-- | parse a non-negative number given a base and a parser for the digits
128number ::
129  (Integral i, Stream s m t) =>
130  Int ->
131  ParsecT s u m Char ->
132  ParsecT s u m i
133number base baseDigit = do
134  n <- fmap (numberValue base) (many1 baseDigit)
135  seq n (return n)
136
137-- | compute the value from a string of digits using a base
138numberValue :: (Integral i) => Int -> String -> i
139numberValue base =
140  foldl (\x -> ((fromIntegral base * x) +) . fromIntegral . digitToInt) 0