Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/35ff29d8fdf916c79a01103f0bb40ee6d3b50453 >--------------------------------------------------------------- commit 35ff29d8fdf916c79a01103f0bb40ee6d3b50453 Author: Ian Lynagh <[email protected]> Date: Thu Mar 1 13:58:18 2012 +0000 Change how NaN and Infinity are read by lex They now get read as Ident's, and the Read Double/Float instances (via convertFrac) handle that Ident specially. >--------------------------------------------------------------- GHC/Read.lhs | 2 ++ Text/Read/Lex.hs | 25 ++++--------------------- 2 files changed, 6 insertions(+), 21 deletions(-) diff --git a/GHC/Read.lhs b/GHC/Read.lhs index 0e2529e..37bcee2 100644 --- a/GHC/Read.lhs +++ b/GHC/Read.lhs @@ -473,6 +473,8 @@ convertInt (L.Number n) convertInt _ = pfail convertFrac :: Fractional a => L.Lexeme -> ReadPrec a +convertFrac (L.Ident "NaN") = return (0 / 0) +convertFrac (L.Ident "Infinity") = return (1 / 0) convertFrac (L.Number n) = return (fromRational $ L.numberToRational n) convertFrac _ = pfail diff --git a/Text/Read/Lex.hs b/Text/Read/Lex.hs index fe20a0b..ac6ec68 100644 --- a/Text/Read/Lex.hs +++ b/Text/Read/Lex.hs @@ -42,7 +42,7 @@ import GHC.Num( Num(..), Integer ) import GHC.Show( Show(..) ) import {-# SOURCE #-} GHC.Unicode ( isSpace, isAlpha, isAlphaNum ) import GHC.Real( Integral, Rational, (%), fromIntegral, - toInteger, (^), infinity, notANumber ) + toInteger, (^) ) import GHC.List import GHC.Enum( maxBound ) #else @@ -75,8 +75,6 @@ data Number = MkNumber Int -- Base | MkDecimal Digits -- Integral part (Maybe Digits) -- Fractional part (Maybe Integer) -- Exponent - | NotANumber - | Infinity deriving (Eq, Show) numberToInteger :: Number -> Maybe Integer @@ -90,8 +88,6 @@ numberToInteger (MkDecimal iPart Nothing mExp) 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 @@ -164,27 +160,14 @@ lexSymbol = -- identifiers lexId :: ReadP Lexeme -lexId = lex_nan <++ lex_id +lexId = do c <- satisfy isIdsChar + s <- munch isIdfChar + return (Ident (c:s)) where - -- NaN and Infinity look like identifiers, so - -- we parse them first. - lex_nan = (string "NaN" >> return (Number NotANumber)) +++ - (string "Infinity" >> return (Number Infinity)) - - lex_id = do c <- satisfy isIdsChar - s <- munch isIdfChar - return (Ident (c:s)) - -- Identifiers can start with a '_' isIdsChar c = isAlpha c || c == '_' isIdfChar c = isAlphaNum c || c `elem` "_'" -#ifndef __GLASGOW_HASKELL__ -infinity, notANumber :: Rational -infinity = 1 :% 0 -notANumber = 0 :% 0 -#endif - -- --------------------------------------------------------------------------- -- Lexing character literals _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
