X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FLexer.x;h=1be9aa3443047a383be041bbfddd8527112a72d2;hb=feaa49b66900f45756d26297ababcbfce142171b;hp=8ae3cd94353621ab1ccdc0495380dfa14ba77d92;hpb=914e7d90e2afe1f72b72fb41d293fb56bd35edb5;p=ghc-hetmet.git diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 8ae3cd9..1be9aa3 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -28,7 +28,8 @@ module Lexer ( getMessages, popContext, pushCurrentContext, setLastToken, setSrcLoc, getLexState, popLexState, pushLexState, - extension, standaloneDerivingEnabled, bangPatEnabled + extension, standaloneDerivingEnabled, bangPatEnabled, + addWarning ) where #include "HsVersions.h" @@ -1298,8 +1299,8 @@ getCharOrFail = do -- 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 -- ----------------------------------------------------------------------------- @@ -1581,10 +1582,11 @@ mkPState buf loc flags = 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