Token(..), lexer, pragState, mkPState, PState(..),
P(..), ParseResult(..), getSrcLoc,
failLocMsgP, failSpanMsgP, srcParseFail,
+ getMessages,
popContext, pushCurrentContext, setLastToken, setSrcLoc,
getLexState, popLexState, pushLexState,
extension, glaExtsEnabled, bangPatEnabled
#include "HsVersions.h"
-import ErrUtils ( Message )
+import Bag
+import ErrUtils
import Outputable
import StringBuffer
import FastString
import Ctype
import Util ( maybePrefixMatch, readRational )
+import Control.Monad
import Data.Bits
import Data.Char ( chr, isSpace )
import Data.Ratio
}
$unispace = \x05
-$whitechar = [\ \t\n\r\f\v\xa0 $unispace]
+$whitechar = [\ \n\r\f\v\xa0 $unispace]
$white_no_nl = $whitechar # \n
+$tab = \t
$ascdigit = 0-9
$unidigit = \x03
-- everywhere: skip whitespace and comments
$white_no_nl+ ;
+$tab+ { warn Opt_WarnTabs (text "Tab character") }
-- Everywhere: deal with nested comments. We explicitly rule out
-- pragmas, "{-#", so that we don't accidentally treat them as comments.
"{-#" $whitechar* (DEPRECATED|deprecated)
{ token ITdeprecated_prag }
"{-#" $whitechar* (SCC|scc) { token ITscc_prag }
+ "{-#" $whitechar* (GENERATED|generated)
+ { token ITgenerated_prag }
"{-#" $whitechar* (CORE|core) { token ITcore_prag }
"{-#" $whitechar* (UNPACK|unpack) { token ITunpack_prag }
}
{
--- work around bug in Alex 2.0
-#if __GLASGOW_HASKELL__ < 503
-unsafeAt arr i = arr ! i
-#endif
-
-- -----------------------------------------------------------------------------
-- The token type
| ITdata
| ITdefault
| ITderiving
+ | ITderive
| ITdo
| ITelse
- | ITfor
| IThiding
| ITif
| ITimport
| ITccallconv
| ITdotnet
| ITmdo
- | ITiso
| ITfamily
-- Pragmas
| ITdeprecated_prag
| ITline_prag
| ITscc_prag
+ | ITgenerated_prag
| ITcore_prag -- hdaume: core annotations
| ITunpack_prag
| ITclose_prag
-- not as a keyword.
isSpecial ITas = True
isSpecial IThiding = True
-isSpecial ITfor = True
+isSpecial ITderive = True
isSpecial ITqualified = True
isSpecial ITforall = True
isSpecial ITexport = True
isSpecial ITccallconv = True
isSpecial ITstdcallconv = True
isSpecial ITmdo = True
-isSpecial ITiso = True
isSpecial ITfamily = True
isSpecial _ = False
( "data", ITdata, 0 ),
( "default", ITdefault, 0 ),
( "deriving", ITderiving, 0 ),
+ ( "derive", ITderive, 0 ),
( "do", ITdo, 0 ),
( "else", ITelse, 0 ),
- ( "for", ITfor, 0 ),
( "hiding", IThiding, 0 ),
( "if", ITif, 0 ),
( "import", ITimport, 0 ),
,(">>-", ITRarrowtail, bit arrowsBit)
#if __GLASGOW_HASKELL__ >= 605
- ,("λ", ITlam, bit glaExtsBit)
,("∷", ITdcolon, bit glaExtsBit)
,("⇒", ITdarrow, bit glaExtsBit)
,("∀", ITforall, bit glaExtsBit)
Just (c,i) -> do setInput i; return c
-- -----------------------------------------------------------------------------
+-- Warnings
+
+warn :: DynFlag -> SDoc -> Action
+warn option warning span _buf _len = do
+ addWarning option (mkWarnMsg span alwaysQualify warning)
+ lexToken
+
+-- -----------------------------------------------------------------------------
-- The Parse Monad
data LayoutContext
data PState = PState {
buffer :: StringBuffer,
+ dflags :: DynFlags,
+ messages :: Messages,
last_loc :: SrcSpan, -- pos of previous token
last_offs :: !Int, -- offset of the previous token from the
-- beginning of the current line.
pragState buf loc =
PState {
buffer = buf,
+ messages = emptyMessages,
+ -- XXX defaultDynFlags is not right, but we don't have a real
+ -- dflags handy
+ dflags = defaultDynFlags,
last_loc = mkSrcSpan loc loc,
last_offs = 0,
last_len = 0,
mkPState buf loc flags =
PState {
buffer = buf,
+ dflags = flags,
+ messages = emptyMessages,
last_loc = mkSrcSpan loc loc,
last_offs = 0,
last_len = 0,
b `setBitIf` cond | cond = bit b
| otherwise = 0
+addWarning :: DynFlag -> WarnMsg -> P ()
+addWarning option w
+ = P $ \s@PState{messages=(ws,es), dflags=d} ->
+ let ws' = if dopt option d then ws `snocBag` w else ws
+ in POk s{messages=(ws', es)} ()
+
+getMessages :: PState -> Messages
+getMessages PState{messages=ms} = ms
+
getContext :: P [LayoutContext]
getContext = P $ \s@PState{context=ctx} -> POk s ctx