{
{-# OPTIONS -Wwarn -w #-}
--- The above warning supression flag is a temporary kludge.
+-- 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
module Lexer (
Token(..), lexer, pragState, mkPState, PState(..),
P(..), ParseResult(..), getSrcLoc,
- getPState,
+ getPState, getDynFlags, withThisPackage,
failLocMsgP, failSpanMsgP, srcParseFail,
- getMessages,
+ getMessages,
popContext, pushCurrentContext, setLastToken, setSrcLoc,
getLexState, popLexState, pushLexState,
extension, standaloneDerivingEnabled, bangPatEnabled,
import SrcLoc
import UniqFM
import DynFlags
+import Module
import Ctype
import Util ( readRational )
( "ccall", ITccallconv, bit ffiBit),
( "prim", ITprimcallconv, bit ffiBit),
- ( "rec", ITrec, bit arrowsBit),
+ ( "rec", ITrec, bit recBit),
( "proc", ITproc, bit arrowsBit)
]
-- RULES pragmas turn on the forall and '.' keywords, and we turn them
-- off again at the end of the pragma.
rulePrag :: Action
-rulePrag span _ _ = do
+rulePrag span _buf _len = do
setExts (.|. bit inRulePragBit)
return (L span ITrules_prag)
endPrag :: Action
-endPrag span _ _ = do
+endPrag span _buf _len = do
setExts (.&. complement (bit inRulePragBit))
return (L span ITclose_prag)
getPState :: P PState
getPState = P $ \s -> POk s s
+getDynFlags :: P DynFlags
+getDynFlags = P $ \s -> POk s (dflags s)
+
+withThisPackage :: (PackageId -> a) -> P a
+withThisPackage f
+ = do pkg <- liftM thisPackage getDynFlags
+ return $ f pkg
+
extension :: (Int -> Bool) -> P Bool
extension p = P $ \s -> POk s (p $! extsBitmap s)
rawTokenStreamBit = 20 -- producing a token stream with all comments included
newQualOpsBit :: Int
newQualOpsBit = 21 -- Haskell' qualified operator syntax, e.g. Prelude.(+)
+recBit :: Int
+recBit = 22 -- rec
always :: Int -> Bool
always _ = True
.|. magicHashBit `setBitIf` dopt Opt_MagicHash flags
.|. kindSigsBit `setBitIf` dopt Opt_KindSignatures flags
.|. recursiveDoBit `setBitIf` dopt Opt_RecursiveDo flags
+ .|. recBit `setBitIf` dopt Opt_DoRec flags
+ .|. recBit `setBitIf` dopt Opt_Arrows flags
.|. unicodeSyntaxBit `setBitIf` dopt Opt_UnicodeSyntax flags
.|. unboxedTuplesBit `setBitIf` dopt Opt_UnboxedTuples flags
.|. standaloneDerivingBit `setBitIf` dopt Opt_StandaloneDeriving flags