Refactor number lexing; part of #5688
[packages/base.git] / Text / Read / Lex.hs
index a3e48e4..fe20a0b 100644 (file)
@@ -19,6 +19,8 @@ module Text.Read.Lex
   -- lexing types
   ( Lexeme(..)  -- :: *; Show, Eq
 
+  , numberToInteger, numberToRational
+
   -- lexer
   , lex         -- :: ReadP Lexeme      Skips leading spaces
   , hsLex       -- :: ReadP String
@@ -35,13 +37,12 @@ import Text.ParserCombinators.ReadP
 
 #ifdef __GLASGOW_HASKELL__
 import GHC.Base
+import GHC.Char
 import GHC.Num( Num(..), Integer )
 import GHC.Show( Show(..) )
-#ifndef __HADDOCK__
 import {-# SOURCE #-} GHC.Unicode ( isSpace, isAlpha, isAlphaNum )
-#endif
-import GHC.Real( Ratio(..), Integral, Rational, (%), fromIntegral,
-                 toInteger, (^), (^^), infinity, notANumber )
+import GHC.Real( Integral, Rational, (%), fromIntegral,
+                 toInteger, (^), infinity, notANumber )
 import GHC.List
 import GHC.Enum( maxBound )
 #else
@@ -65,11 +66,47 @@ data Lexeme
   | Punc   String       -- ^ Punctuation or reserved symbol, e.g. @(@, @::@
   | Ident  String       -- ^ Haskell identifier, e.g. @foo@, @Baz@
   | Symbol String       -- ^ Haskell symbol, e.g. @>>@, @:%@
-  | Int Integer         -- ^ Integer literal
-  | Rat Rational        -- ^ Floating point literal
+  | Number Number
   | EOF
  deriving (Eq, Show)
 
+data Number = MkNumber Int              -- Base
+                       Digits           -- Integral part
+            | MkDecimal Digits          -- Integral part
+                        (Maybe Digits)  -- Fractional part
+                        (Maybe Integer) -- Exponent
+            | NotANumber
+            | Infinity
+ deriving (Eq, Show)
+
+numberToInteger :: Number -> Maybe Integer
+numberToInteger (MkNumber base iPart) = Just (val (fromIntegral base) 0 iPart)
+numberToInteger (MkDecimal iPart Nothing mExp)
+    = let i = val 10 0 iPart
+      in case mExp of
+         Nothing             -> Just i
+         Just exp | exp >= 0 -> Just (i * (10 ^ exp))
+         _                   -> Nothing
+numberToInteger _ = Nothing
+
+numberToRational :: Number -> Rational
+numberToRational NotANumber = notANumber
+numberToRational Infinity   = infinity
+numberToRational (MkNumber base iPart) = val (fromIntegral base) 0 iPart % 1
+numberToRational (MkDecimal iPart mFPart mExp)
+ = let i = val 10 0 iPart
+   in case (mFPart, mExp) of
+      (Nothing, Nothing)     -> i % 1
+      (Nothing, Just exp)
+       | exp >= 0            -> (i * (10 ^ exp)) % 1
+       | otherwise           -> i % (10 ^ (- exp))
+      (Just fPart, Nothing)  -> fracExp 0   i fPart
+      (Just fPart, Just exp) -> fracExp exp i fPart
+      -- fracExp is a bit more efficient in calculating the Rational.
+      -- Instead of calculating the fractional part alone, then
+      -- adding the integral part and finally multiplying with
+      -- 10 ^ exp if an exponent was given, do it all at once.
+
 -- -----------------------------------------------------------------------------
 -- Lexing
 
@@ -131,8 +168,8 @@ lexId = lex_nan <++ lex_id
   where
         -- NaN and Infinity look like identifiers, so
         -- we parse them first.
-    lex_nan = (string "NaN"      >> return (Rat notANumber)) +++
-              (string "Infinity" >> return (Rat infinity))
+    lex_nan = (string "NaN"      >> return (Number NotANumber)) +++
+              (string "Infinity" >> return (Number Infinity))
 
     lex_id = do c <- satisfy isIdsChar
                 s <- munch isIdfChar
@@ -319,7 +356,7 @@ lexHexOct
   = do  _ <- char '0'
         base <- lexBaseChar
         digits <- lexDigits base
-        return (Int (val (fromIntegral base) 0 digits))
+        return (Number (MkNumber base digits))
 
 lexBaseChar :: ReadP Int
 -- Lex a single character indicating the base; fail if not there
@@ -336,27 +373,7 @@ lexDecNumber =
   do xs    <- lexDigits 10
      mFrac <- lexFrac <++ return Nothing
      mExp  <- lexExp  <++ return Nothing
-     return (value xs mFrac mExp)
- where
-  value xs mFrac mExp = valueFracExp (val 10 0 xs) mFrac mExp
-
-  valueFracExp :: Integer -> Maybe Digits -> Maybe Integer
-               -> Lexeme
-  valueFracExp a Nothing Nothing
-    = Int a                                             -- 43
-  valueFracExp a Nothing (Just exp)
-    | exp >= 0  = Int (a * (10 ^ exp))                  -- 43e7
-    | otherwise = Rat (valExp (fromInteger a) exp)      -- 43e-7
-  valueFracExp a (Just fs) mExp
-     = case mExp of
-         Nothing  -> Rat rat                            -- 4.3
-         Just exp -> Rat (valExp rat exp)               -- 4.3e-4
-     where
-        rat :: Rational
-        rat = fromInteger a + frac 10 0 1 fs
-
-  valExp :: Rational -> Integer -> Rational
-  valExp rat exp = rat * (10 ^^ exp)
+     return (Number (MkDecimal xs mFrac mExp))
 
 lexFrac :: ReadP (Maybe Digits)
 -- Read the fractional part; fail if it doesn't
@@ -400,14 +417,24 @@ val base y (x:xs) = y' `seq` val base y' xs
  where
   y' = y * base + fromIntegral x
 
-frac :: Integral a => a -> a -> a -> Digits -> Ratio a
-frac _    a b []     = a % b
-frac base a b (x:xs) = a' `seq` b' `seq` frac base a' b' xs
- where
-  a' = a * base + fromIntegral x
-  b' = b * base
+-- Calculate a Rational from the exponent [of 10 to multiply with],
+-- the integral part of the mantissa and the digits of the fractional
+-- part. Leaving the calculation of the power of 10 until the end,
+-- when we know the effective exponent, saves multiplications.
+-- More importantly, this way we need at most one gcd instead of three.
+--
+-- frac was never used with anything but Integer and base 10, so
+-- those are hardcoded now (trivial to change if necessary).
+fracExp :: Integer -> Integer -> Digits -> Rational
+fracExp exp mant []
+  | exp < 0     = mant % (10 ^ (-exp))
+  | otherwise   = fromInteger (mant * 10 ^ exp)
+fracExp exp mant (d:ds) = exp' `seq` mant' `seq` fracExp exp' mant' ds
+  where
+    exp'  = exp - 1
+    mant' = mant * 10 + fromIntegral d
 
-valDig :: Num a => a -> Char -> Maybe Int
+valDig :: (Eq a, Num a) => a -> Char -> Maybe Int
 valDig 8 c
   | '0' <= c && c <= '7' = Just (ord c - ord '0')
   | otherwise            = Nothing
@@ -435,13 +462,14 @@ readIntP base isDigit valDigit =
   do s <- munch1 isDigit
      return (val base 0 (map valDigit s))
 
-readIntP' :: Num a => a -> ReadP a
+readIntP' :: (Eq a, Num a) => a -> ReadP a
 readIntP' base = readIntP base isDigit valDigit
  where
   isDigit  c = maybe False (const True) (valDig base c)
   valDigit c = maybe 0     id           (valDig base c)
 
-readOctP, readDecP, readHexP :: Num a => ReadP a
+readOctP, readDecP, readHexP :: (Eq a, Num a) => ReadP a
 readOctP = readIntP' 8
 readDecP = readIntP' 10
 readHexP = readIntP' 16
+