-- - pragma-end should be only valid in a pragma
{
+{-# OPTIONS -w #-}
+-- The above warning 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 Lexer (
Token(..), lexer, pragState, mkPState, PState(..),
P(..), ParseResult(..), getSrcLoc,
getMessages,
popContext, pushCurrentContext, setLastToken, setSrcLoc,
getLexState, popLexState, pushLexState,
- extension, standaloneDerivingEnabled, bangPatEnabled
+ extension, standaloneDerivingEnabled, bangPatEnabled,
+ addWarning
) where
#include "HsVersions.h"
"{-#" $whitechar* (CORE|core) { token ITcore_prag }
"{-#" $whitechar* (UNPACK|unpack) { token ITunpack_prag }
- "{-#" $whitechar* (DOCOPTIONS|docoptions)
+ "{-#" $whitechar* (DOC_OPTIONS|doc_options)
/ { ifExtension haddockEnabled } { lex_string_prag ITdocOptions }
"{-#" { nested_comment lexToken }
| ITdata
| ITdefault
| ITderiving
- | ITderive
| ITdo
| ITelse
| IThiding
-- not as a keyword.
isSpecial ITas = True
isSpecial IThiding = True
-isSpecial ITderive = True
isSpecial ITqualified = True
isSpecial ITforall = True
isSpecial ITexport = True
( "data", ITdata, 0 ),
( "default", ITdefault, 0 ),
( "deriving", ITderiving, 0 ),
- ( "derive", ITderive, 0 ),
( "do", ITdo, 0 ),
( "else", ITelse, 0 ),
( "hiding", IThiding, 0 ),
-- Warnings
warn :: DynFlag -> SDoc -> Action
-warn option warning span _buf _len = do
- addWarning option (mkWarnMsg span alwaysQualify warning)
+warn option warning srcspan _buf _len = do
+ addWarning option srcspan warning
lexToken
-- -----------------------------------------------------------------------------
b `setBitIf` cond | cond = bit b
| otherwise = 0
-addWarning :: DynFlag -> WarnMsg -> P ()
-addWarning option w
+addWarning :: DynFlag -> SrcSpan -> SDoc -> P ()
+addWarning option srcspan warning
= P $ \s@PState{messages=(ws,es), dflags=d} ->
- let ws' = if dopt option d then ws `snocBag` w else ws
+ let warning' = mkWarnMsg srcspan alwaysQualify warning
+ ws' = if dopt option d then ws `snocBag` warning' else ws
in POk s{messages=(ws', es)} ()
getMessages :: PState -> Messages