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-2026 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 False
 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-- | optionally parse a dot followed by decimal digits as fractional part.
 71-- if there is no dot, and the fractional part is not required (as indicated
 72-- by the predicate argument), then 0.0 is returned.
 73fraction :: (Fractional f, Stream s m Char) => Bool -> ParsecT s u m f
 74fraction reqDigit = do
 75  hasDot <- (char '.' >> pure True) <|> pure False
 76  if hasDot
 77    then baseFraction reqDigit 10 digit
 78    else if reqDigit then parserFail "no dot in fraction" else pure 0.0
 79
 80-- | parse base dependent digits (usually after dot) as fractional part
 81baseFraction ::
 82  (Fractional f, Stream s m Char) =>
 83  Bool ->
 84  Int ->
 85  ParsecT s u m Char ->
 86  ParsecT s u m f
 87baseFraction requireDigit base baseDigit =
 88  fmap
 89    (fractionValue base)
 90    ((if requireDigit then many1 else many) baseDigit <?> "fraction")
 91    <?> "fraction"
 92
 93-- | compute the fraction given by a sequence of digits following the dot.
 94-- Only one division is performed and trailing zeros are ignored.
 95fractionValue :: (Fractional f) => Int -> String -> f
 96fractionValue base =
 97  uncurry (/)
 98    . foldl
 99      ( \(s, p) d ->
100          (p * fromIntegral (digitToInt d) + s, p * fromIntegral base)
101      )
102      (0, 1)
103    . dropWhile (== '0')
104    . reverse
105
106-- * integers and naturals
107
108-- | parse a negative or a positive number (returning 'negate' or 'id').
109-- positive numbers are NOT allowed to be prefixed by a plus sign.
110signMinus :: (Num a, Stream s m Char) => ParsecT s u m (a -> a)
111signMinus = (char '-' >> return negate) <|> return id
112
113-- | parse an optional plus or minus sign, returning 'negate' or 'id'
114sign :: (Num a, Stream s m Char) => ParsecT s u m (a -> a)
115sign = (char '-' >> return negate) <|> (optional (char '+') >> return id)
116
117-- | parse plain non-negative decimal numbers given by a non-empty sequence
118-- of digits
119decimal :: (Integral i, Stream s m Char) => ParsecT s u m i
120decimal = number 10 digit
121
122-- ** natural parts
123
124-- | parse a hexadecimal number
125hexnum :: (Integral i, Stream s m Char) => ParsecT s u m i
126hexnum = number 16 hexDigit
127
128-- | parse an octal number
129octnum :: (Integral i, Stream s m Char) => ParsecT s u m i
130octnum = number 8 octDigit
131
132-- | parse a non-negative number given a base and a parser for the digits
133number ::
134  (Integral i, Stream s m t) =>
135  Int ->
136  ParsecT s u m Char ->
137  ParsecT s u m i
138number base baseDigit = do
139  n <- fmap (numberValue base) (many1 baseDigit)
140  seq n (return n)
141
142-- | compute the value from a string of digits using a base
143numberValue :: (Integral i) => Int -> String -> i
144numberValue base =
145  foldl (\x -> ((fromIntegral base * x) +) . fromIntegral . digitToInt) 0