X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Text%2FRead%2FLex.hs;h=222d6cf06dbbe9c0fae148002fbf3e51651c1353;hb=41e8fba828acbae1751628af50849f5352b27873;hp=6adb8ae166c2625735c1e3b15e27cc3d302e8ba7;hpb=aaf764b3ad8b1816d68b5f27299eac125f08e1a5;p=ghc-base.git diff --git a/Text/Read/Lex.hs b/Text/Read/Lex.hs index 6adb8ae..222d6cf 100644 --- a/Text/Read/Lex.hs +++ b/Text/Read/Lex.hs @@ -1,4 +1,5 @@ -{-# OPTIONS_GHC -fno-implicit-prelude #-} +{-# LANGUAGE CPP, NoImplicitPrelude #-} + ----------------------------------------------------------------------------- -- | -- Module : Text.Read.Lex @@ -16,12 +17,12 @@ module Text.Read.Lex -- lexing types ( Lexeme(..) -- :: *; Show, Eq - - -- lexer - , lex -- :: ReadP Lexeme Skips leading spaces - , hsLex -- :: ReadP String - , lexChar -- :: ReadP Char Reads just one char, with H98 escapes - + + -- lexer + , lex -- :: ReadP Lexeme Skips leading spaces + , hsLex -- :: ReadP String + , lexChar -- :: ReadP Char Reads just one char, with H98 escapes + , readIntP -- :: Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadP a , readOctP -- :: Num a => ReadP a , readDecP -- :: Num a => ReadP a @@ -39,7 +40,7 @@ import GHC.Show( Show(..) ) import {-# SOURCE #-} GHC.Unicode ( isSpace, isAlpha, isAlphaNum ) #endif import GHC.Real( Ratio(..), Integral, Rational, (%), fromIntegral, - toInteger, (^), (^^), infinity, notANumber ) + toInteger, (^), (^^), infinity, notANumber ) import GHC.List import GHC.Enum( maxBound ) #else @@ -56,14 +57,15 @@ import Control.Monad -- ----------------------------------------------------------------------------- -- Lexing types +-- ^ Haskell lexemes. data Lexeme - = Char Char -- Quotes removed, - | String String -- escapes interpreted - | Punc String -- Punctuation, eg "(", "::" - | Ident String -- Haskell identifiers, e.g. foo, baz - | Symbol String -- Haskell symbols, e.g. >>, % - | Int Integer - | Rat Rational + = Char Char -- ^ Character literal + | String String -- ^ String literal, with escapes interpreted + | 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 | EOF deriving (Eq, Show) @@ -76,25 +78,25 @@ lex = skipSpaces >> lexToken hsLex :: ReadP String -- ^ Haskell lexer: returns the lexed string, rather than the lexeme hsLex = do skipSpaces - (s,_) <- gather lexToken - return s + (s,_) <- gather lexToken + return s lexToken :: ReadP Lexeme lexToken = lexEOF +++ - lexLitChar +++ - lexString +++ - lexPunc +++ - lexSymbol +++ - lexId +++ - lexNumber + lexLitChar +++ + lexString +++ + lexPunc +++ + lexSymbol +++ + lexId +++ + lexNumber -- ---------------------------------------------------------------------- -- End of file lexEOF :: ReadP Lexeme lexEOF = do s <- look - guard (null s) - return EOF + guard (null s) + return EOF -- --------------------------------------------------------------------------- -- Single character lexemes @@ -113,9 +115,9 @@ lexSymbol :: ReadP Lexeme lexSymbol = do s <- munch1 isSymbolChar if s `elem` reserved_ops then - return (Punc s) -- Reserved-ops count as punctuation + return (Punc s) -- Reserved-ops count as punctuation else - return (Symbol s) + return (Symbol s) where isSymbolChar c = c `elem` "!@#$%&*+./<=>?\\^|:-~" reserved_ops = ["..", "::", "=", "\\", "|", "<-", "->", "@", "~", "=>"] @@ -126,16 +128,16 @@ lexSymbol = lexId :: ReadP Lexeme lexId = lex_nan <++ lex_id where - -- NaN and Infinity look like identifiers, so - -- we parse them first. + -- NaN and Infinity look like identifiers, so + -- we parse them first. lex_nan = (string "NaN" >> return (Rat notANumber)) +++ - (string "Infinity" >> return (Rat infinity)) + (string "Infinity" >> return (Rat infinity)) lex_id = do c <- satisfy isIdsChar - s <- munch isIdfChar - return (Ident (c:s)) + s <- munch isIdfChar + return (Ident (c:s)) - -- Identifiers can start with a '_' + -- Identifiers can start with a '_' isIdsChar c = isAlpha c || c == '_' isIdfChar c = isAlphaNum c || c `elem` "_'" @@ -150,10 +152,10 @@ notANumber = 0 :% 0 lexLitChar :: ReadP Lexeme lexLitChar = - do char '\'' + do _ <- char '\'' (c,esc) <- lexCharE - guard (esc || c /= '\'') -- Eliminate '' possibility - char '\'' + guard (esc || c /= '\'') -- Eliminate '' possibility + _ <- char '\'' return (Char c) lexChar :: ReadP Char @@ -161,10 +163,10 @@ lexChar = do { (c,_) <- lexCharE; return c } lexCharE :: ReadP (Char, Bool) -- "escaped or not"? lexCharE = - do c <- get - if c == '\\' - then do c <- lexEsc; return (c, True) - else do return (c, False) + do c1 <- get + if c1 == '\\' + then do c2 <- lexEsc; return (c2, True) + else do return (c1, False) where lexEsc = lexEscChar @@ -194,7 +196,7 @@ lexCharE = return (chr (fromInteger n)) lexCntrlChar = - do char '^' + do _ <- char '^' c <- get case c of '@' -> return '\^@' @@ -234,9 +236,9 @@ lexCharE = lexAscii = do choice [ (string "SOH" >> return '\SOH') <++ - (string "SO" >> return '\SO') - -- \SO and \SOH need maximal-munch treatment - -- See the Haskell report Sect 2.6 + (string "SO" >> return '\SO') + -- \SO and \SOH need maximal-munch treatment + -- See the Haskell report Sect 2.6 , string "NUL" >> return '\NUL' , string "STX" >> return '\STX' @@ -278,7 +280,7 @@ lexCharE = lexString :: ReadP Lexeme lexString = - do char '"' + do _ <- char '"' body id where body f = @@ -286,17 +288,17 @@ lexString = if c /= '"' || esc then body (f.(c:)) else let s = f "" in - return (String s) + return (String s) lexStrItem = (lexEmpty >> lexStrItem) - +++ lexCharE + +++ lexCharE lexEmpty = - do char '\\' + do _ <- char '\\' c <- get case c of '&' -> do return () - _ | isSpace c -> do skipSpaces; char '\\'; return () + _ | isSpace c -> do skipSpaces; _ <- char '\\'; return () _ -> do pfail -- --------------------------------------------------------------------------- @@ -307,26 +309,26 @@ type Digits = [Int] lexNumber :: ReadP Lexeme lexNumber - = lexHexOct <++ -- First try for hex or octal 0x, 0o etc - -- If that fails, try for a decimal number - lexDecNumber -- Start with ordinary digits - + = lexHexOct <++ -- First try for hex or octal 0x, 0o etc + -- If that fails, try for a decimal number + lexDecNumber -- Start with ordinary digits + lexHexOct :: ReadP Lexeme lexHexOct - = do char '0' - base <- lexBaseChar - digits <- lexDigits base - return (Int (val (fromIntegral base) 0 digits)) + = do _ <- char '0' + base <- lexBaseChar + digits <- lexDigits base + return (Int (val (fromIntegral base) 0 digits)) lexBaseChar :: ReadP Int -- Lex a single character indicating the base; fail if not there lexBaseChar = do { c <- get; - case c of - 'o' -> return 8 - 'O' -> return 8 - 'x' -> return 16 - 'X' -> return 16 - _ -> pfail } + case c of + 'o' -> return 8 + 'O' -> return 8 + 'x' -> return 16 + 'X' -> return 16 + _ -> pfail } lexDecNumber :: ReadP Lexeme lexDecNumber = @@ -338,19 +340,19 @@ lexDecNumber = 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 + -> 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 + | 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 + 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 + rat :: Rational + rat = fromInteger a + frac 10 0 1 fs valExp :: Rational -> Integer -> Rational valExp rat exp = rat * (10 ^^ exp) @@ -358,14 +360,14 @@ lexDecNumber = lexFrac :: ReadP (Maybe Digits) -- Read the fractional part; fail if it doesn't -- start ".d" where d is a digit -lexFrac = do char '.' - frac <- lexDigits 10 - return (Just frac) +lexFrac = do _ <- char '.' + fraction <- lexDigits 10 + return (Just fraction) lexExp :: ReadP (Maybe Integer) -lexExp = do char 'e' +++ char 'E' +lexExp = do _ <- char 'e' +++ char 'E' exp <- signedExp +++ lexInteger 10 - return (Just exp) + return (Just exp) where signedExp = do c <- char '-' +++ char '+' @@ -381,7 +383,7 @@ lexDigits base = return xs where scan (c:cs) f = case valDig base c of - Just n -> do get; scan cs (f.(n:)) + Just n -> do _ <- get; scan cs (f.(n:)) Nothing -> do return (f []) scan [] f = do return (f []) @@ -392,13 +394,13 @@ lexInteger base = val :: Num a => a -> a -> Digits -> a -- val base y [d1,..,dn] = y ++ [d1,..,dn], as it were -val base y [] = y +val _ y [] = y 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 base a b [] = a % b +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 @@ -417,6 +419,9 @@ valDig 16 c | 'A' <= c && c <= 'F' = Just (ord c - ord 'A' + 10) | otherwise = Nothing +valDig _ _ = error "valDig: Bad base" + +valDecDig :: Char -> Maybe Int valDecDig c | '0' <= c && c <= '9' = Just (ord c - ord '0') | otherwise = Nothing