X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FCmmLex.x;h=9a7b43da6cf4ed9570f5876ff780720fe51e9dac;hp=fb1179f4905291badffd59acba5c0674b021da1e;hb=b2bd63f99d643f6b3eb30bb72bb9ae26d4183252;hpb=49c98d143c382a1341e1046f5ca00819a25691ba diff --git a/compiler/cmm/CmmLex.x b/compiler/cmm/CmmLex.x index fb1179f..9a7b43d 100644 --- a/compiler/cmm/CmmLex.x +++ b/compiler/cmm/CmmLex.x @@ -11,13 +11,19 @@ ----------------------------------------------------------------------------- { +{-# LANGUAGE BangPatterns #-} +{-# OPTIONS -Wwarn -w #-} +-- The above -Wwarn supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module CmmLex ( CmmToken(..), cmmlex, ) where -#include "HsVersions.h" - -import Cmm +import OldCmm import Lexer import SrcLoc @@ -29,24 +35,24 @@ import Util --import TRACE } -$whitechar = [\ \t\n\r\f\v\xa0] +$whitechar = [\ \t\n\r\f\v\xa0] -- \xa0 is Unicode no-break space $white_no_nl = $whitechar # \n $ascdigit = 0-9 -$unidigit = \x01 +$unidigit = \x01 -- Trick Alex into handling Unicode. See alexGetChar. $digit = [$ascdigit $unidigit] $octit = 0-7 $hexit = [$digit A-F a-f] -$unilarge = \x03 +$unilarge = \x03 -- Trick Alex into handling Unicode. See alexGetChar. $asclarge = [A-Z \xc0-\xd6 \xd8-\xde] $large = [$asclarge $unilarge] -$unismall = \x04 +$unismall = \x04 -- Trick Alex into handling Unicode. See alexGetChar. $ascsmall = [a-z \xdf-\xf6 \xf8-\xff] $small = [$ascsmall $unismall \_] -$namebegin = [$large $small \_ \. \$ \@] +$namebegin = [$large $small \. \$ \@] $namechar = [$namebegin $digit] @decimal = $digit+ @@ -56,7 +62,7 @@ $namechar = [$namebegin $digit] @floating_point = @decimal \. @decimal @exponent? | @decimal @exponent -@escape = \\ ([abfnrt\\\'\"\?] | x @hexadecimal | @octal) +@escape = \\ ([abfnrt\\\'\"\?] | x $hexit{1,2} | $octit{1,3}) @strchar = ($printable # [\"\\]) | @escape cmm :- @@ -69,7 +75,7 @@ $white_no_nl+ ; -- single-line line pragmas, of the form -- # "" \n $digit+ { setLine line_prag1 } - \" ($printable # \")* \" { setFile line_prag2 } + \" [^\"]* \" { setFile line_prag2 } .* { pop } <0> { @@ -88,7 +94,8 @@ $white_no_nl+ ; "&&" { kw CmmT_BoolAnd } "||" { kw CmmT_BoolOr } - R@decimal { global_regN VanillaReg } + P@decimal { global_regN (\n -> VanillaReg n VGcPtr) } + R@decimal { global_regN (\n -> VanillaReg n VNonGcPtr) } F@decimal { global_regN FloatReg } D@decimal { global_regN DoubleReg } L@decimal { global_regN LongReg } @@ -138,7 +145,10 @@ data CmmToken | CmmT_if | CmmT_jump | CmmT_foreign + | CmmT_never | CmmT_prim + | CmmT_return + | CmmT_returns | CmmT_import | CmmT_switch | CmmT_case @@ -149,6 +159,7 @@ data CmmToken | CmmT_bits64 | CmmT_float32 | CmmT_float64 + | CmmT_gcptr | CmmT_GlobalReg GlobalReg | CmmT_Name FastString | CmmT_String String @@ -162,7 +173,7 @@ data CmmToken -- ----------------------------------------------------------------------------- -- Lexer actions -type Action = SrcSpan -> StringBuffer -> Int -> P (Located CmmToken) +type Action = RealSrcSpan -> StringBuffer -> Int -> P (RealLocated CmmToken) begin :: Int -> Action begin code _span _str _len = do pushLexState code; lexToken @@ -180,7 +191,7 @@ global_regN :: (Int -> GlobalReg) -> Action global_regN con span buf len = return (L span (CmmT_GlobalReg (con (fromIntegral n)))) where buf' = stepOn buf - n = parseInteger buf' (len-1) 10 octDecDigit + n = parseUnsignedInteger buf' (len-1) 10 octDecDigit global_reg :: GlobalReg -> Action global_reg r span buf len = return (L span (CmmT_GlobalReg r)) @@ -213,7 +224,10 @@ reservedWordsFM = listToUFM $ ( "if", CmmT_if ), ( "jump", CmmT_jump ), ( "foreign", CmmT_foreign ), + ( "never", CmmT_never ), ( "prim", CmmT_prim ), + ( "return", CmmT_return ), + ( "returns", CmmT_returns ), ( "import", CmmT_import ), ( "switch", CmmT_switch ), ( "case", CmmT_case ), @@ -223,17 +237,25 @@ reservedWordsFM = listToUFM $ ( "bits32", CmmT_bits32 ), ( "bits64", CmmT_bits64 ), ( "float32", CmmT_float32 ), - ( "float64", CmmT_float64 ) + ( "float64", CmmT_float64 ), +-- New forms + ( "b8", CmmT_bits8 ), + ( "b16", CmmT_bits16 ), + ( "b32", CmmT_bits32 ), + ( "b64", CmmT_bits64 ), + ( "f32", CmmT_float32 ), + ( "f64", CmmT_float64 ), + ( "gcptr", CmmT_gcptr ) ] tok_decimal span buf len - = return (L span (CmmT_Int $! parseInteger buf len 10 octDecDigit)) + = return (L span (CmmT_Int $! parseUnsignedInteger buf len 10 octDecDigit)) tok_octal span buf len - = return (L span (CmmT_Int $! parseInteger (offsetBytes 1 buf) (len-1) 8 octDecDigit)) + = return (L span (CmmT_Int $! parseUnsignedInteger (offsetBytes 1 buf) (len-1) 8 octDecDigit)) tok_hexadecimal span buf len - = return (L span (CmmT_Int $! parseInteger (offsetBytes 2 buf) (len-2) 16 hexDigit)) + = return (L span (CmmT_Int $! parseUnsignedInteger (offsetBytes 2 buf) (len-2) 16 hexDigit)) tok_float str = CmmT_Float $! readRational str @@ -245,8 +267,8 @@ tok_string str = CmmT_String (read str) setLine :: Int -> Action setLine code span buf len = do - let line = parseInteger buf len 10 octDecDigit - setSrcLoc (mkSrcLoc (srcSpanFile span) (fromIntegral line - 1) 0) + let line = parseUnsignedInteger buf len 10 octDecDigit + setSrcLoc (mkRealSrcLoc (srcSpanFile span) (fromIntegral line - 1) 1) -- subtract one: the line number refers to the *following* line -- trace ("setLine " ++ show line) $ do popLexState @@ -256,7 +278,7 @@ setLine code span buf len = do setFile :: Int -> Action setFile code span buf len = do let file = lexemeToFastString (stepOn buf) (len-2) - setSrcLoc (mkSrcLoc file (srcSpanEndLine span) (srcSpanEndCol span)) + setSrcLoc (mkRealSrcLoc file (srcSpanEndLine span) (srcSpanEndCol span)) popLexState pushLexState code lexToken @@ -267,17 +289,17 @@ setFile code span buf len = do cmmlex :: (Located CmmToken -> P a) -> P a cmmlex cont = do - tok@(L _ tok__) <- lexToken - --trace ("token: " ++ show tok__) $ do - cont tok + (L span tok) <- lexToken + --trace ("token: " ++ show tok) $ do + cont (L (RealSrcSpan span) tok) -lexToken :: P (Located CmmToken) +lexToken :: P (RealLocated CmmToken) lexToken = do inp@(loc1,buf) <- getInput sc <- getLexState case alexScan inp sc of - AlexEOF -> do let span = mkSrcSpan loc1 loc1 - setLastToken span 0 0 + AlexEOF -> do let span = mkRealSrcSpan loc1 loc1 + setLastToken span 0 return (L span CmmT_EOF) AlexError (loc2,_) -> do failLocMsgP loc1 loc2 "lexical error" AlexSkip inp2 _ -> do @@ -285,15 +307,15 @@ lexToken = do lexToken AlexToken inp2@(end,buf2) len t -> do setInput inp2 - let span = mkSrcSpan loc1 end - span `seq` setLastToken span len len + let span = mkRealSrcSpan loc1 end + span `seq` setLastToken span len t span buf len -- ----------------------------------------------------------------------------- -- Monad stuff -- Stuff that Alex needs to know about our input type: -type AlexInput = (SrcLoc,StringBuffer) +type AlexInput = (RealSrcLoc,StringBuffer) alexInputPrevChar :: AlexInput -> Char alexInputPrevChar (_,s) = prevChar s '\n'