X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FCmmLex.x;h=9a7b43da6cf4ed9570f5876ff780720fe51e9dac;hp=a5defb618ae8bf34e7ac41458e7189bdcc876469;hb=b2bd63f99d643f6b3eb30bb72bb9ae26d4183252;hpb=ddec0ec0a7772c434f2c7b4d284e9280067ed26b diff --git a/compiler/cmm/CmmLex.x b/compiler/cmm/CmmLex.x index a5defb6..9a7b43d 100644 --- a/compiler/cmm/CmmLex.x +++ b/compiler/cmm/CmmLex.x @@ -11,6 +11,7 @@ ----------------------------------------------------------------------------- { +{-# 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 @@ -22,7 +23,7 @@ module CmmLex ( CmmToken(..), cmmlex, ) where -import Cmm +import OldCmm import Lexer import SrcLoc @@ -172,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 @@ -267,7 +268,7 @@ tok_string str = CmmT_String (read str) setLine :: Int -> Action setLine code span buf len = do let line = parseUnsignedInteger buf len 10 octDecDigit - setSrcLoc (mkSrcLoc (srcSpanFile span) (fromIntegral line - 1) 1) + setSrcLoc (mkRealSrcLoc (srcSpanFile span) (fromIntegral line - 1) 1) -- subtract one: the line number refers to the *following* line -- trace ("setLine " ++ show line) $ do popLexState @@ -277,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 @@ -288,16 +289,16 @@ 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 + AlexEOF -> do let span = mkRealSrcSpan loc1 loc1 setLastToken span 0 return (L span CmmT_EOF) AlexError (loc2,_) -> do failLocMsgP loc1 loc2 "lexical error" @@ -306,7 +307,7 @@ lexToken = do lexToken AlexToken inp2@(end,buf2) len t -> do setInput inp2 - let span = mkSrcSpan loc1 end + let span = mkRealSrcSpan loc1 end span `seq` setLastToken span len t span buf len @@ -314,7 +315,7 @@ lexToken = do -- 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'