Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/afcddc5ce033de84ab88e73657a2f753aaee785a >--------------------------------------------------------------- commit afcddc5ce033de84ab88e73657a2f753aaee785a Author: Ian Lynagh <[email protected]> Date: Thu Mar 1 01:26:06 2012 +0000 Refactor number lexing; part of #5688 This doesn't change the behaviour yet, but I think it's a step in the right direction. >--------------------------------------------------------------- GHC/Read.lhs | 12 +++++----- Numeric.hs | 5 +-- Text/Read/Lex.hs | 66 ++++++++++++++++++++++++++++++++++++------------------ 3 files changed, 52 insertions(+), 31 deletions(-) diff --git a/GHC/Read.lhs b/GHC/Read.lhs index cea761b..0e2529e 100644 --- a/GHC/Read.lhs +++ b/GHC/Read.lhs @@ -1,6 +1,6 @@ \begin{code} {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE CPP, NoImplicitPrelude, StandaloneDeriving #-} +{-# LANGUAGE CPP, NoImplicitPrelude, StandaloneDeriving, PatternGuards #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- @@ -468,13 +468,13 @@ readNumber convert = convertInt :: Num a => L.Lexeme -> ReadPrec a -convertInt (L.Int i) = return (fromInteger i) -convertInt _ = pfail +convertInt (L.Number n) + | Just i <- L.numberToInteger n = return (fromInteger i) +convertInt _ = pfail convertFrac :: Fractional a => L.Lexeme -> ReadPrec a -convertFrac (L.Int i) = return (fromInteger i) -convertFrac (L.Rat r) = return (fromRational r) -convertFrac _ = pfail +convertFrac (L.Number n) = return (fromRational $ L.numberToRational n) +convertFrac _ = pfail instance Read Int where readPrec = readNumber convertInt diff --git a/Numeric.hs b/Numeric.hs index 167aa7b..c29d7b9 100644 --- a/Numeric.hs +++ b/Numeric.hs @@ -111,9 +111,8 @@ readFloatP :: RealFrac a => ReadP a readFloatP = do tok <- L.lex case tok of - L.Rat y -> return (fromRational y) - L.Int i -> return (fromInteger i) - _ -> pfail + L.Number n -> return $ fromRational $ L.numberToRational n + _ -> pfail -- It's turgid to have readSigned work using list comprehensions, -- but it's specified as a ReadS to ReadS transformer diff --git a/Text/Read/Lex.hs b/Text/Read/Lex.hs index 0af66b7..fe20a0b 100644 --- a/Text/Read/Lex.hs +++ b/Text/Read/Lex.hs @@ -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 @@ -64,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 @@ -130,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 @@ -318,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 @@ -335,23 +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 (a % (10 ^ (-exp))) -- 43e-7 - valueFracExp a (Just fs) mExp -- 4.3[e2] - = Rat (fracExp (fromMaybe 0 mExp) a fs) - -- Be 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. + return (Number (MkDecimal xs mFrac mExp)) lexFrac :: ReadP (Maybe Digits) -- Read the fractional part; fail if it doesn't _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
