projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix CodingStyle#Warnings URLs
[ghc-hetmet.git]
/
compiler
/
parser
/
Lexer.x
diff --git
a/compiler/parser/Lexer.x
b/compiler/parser/Lexer.x
index
8b637da
..
a63fa3b
100644
(file)
--- a/
compiler/parser/Lexer.x
+++ b/
compiler/parser/Lexer.x
@@
-21,6
+21,13
@@
-- - pragma-end should be only valid in a pragma
{
-- - 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,
module Lexer (
Token(..), lexer, pragState, mkPState, PState(..),
P(..), ParseResult(..), getSrcLoc,
@@
-28,7
+35,8
@@
module Lexer (
getMessages,
popContext, pushCurrentContext, setLastToken, setSrcLoc,
getLexState, popLexState, pushLexState,
getMessages,
popContext, pushCurrentContext, setLastToken, setSrcLoc,
getLexState, popLexState, pushLexState,
- extension, standaloneDerivingEnabled, bangPatEnabled
+ extension, standaloneDerivingEnabled, bangPatEnabled,
+ addWarning
) where
#include "HsVersions.h"
) where
#include "HsVersions.h"
@@
-405,7
+413,6
@@
data Token
| ITdata
| ITdefault
| ITderiving
| ITdata
| ITdefault
| ITderiving
- | ITderive
| ITdo
| ITelse
| IThiding
| ITdo
| ITelse
| IThiding
@@
-559,7
+566,6
@@
isSpecial :: Token -> Bool
-- not as a keyword.
isSpecial ITas = True
isSpecial IThiding = True
-- not as a keyword.
isSpecial ITas = True
isSpecial IThiding = True
-isSpecial ITderive = True
isSpecial ITqualified = True
isSpecial ITforall = True
isSpecial ITexport = True
isSpecial ITqualified = True
isSpecial ITforall = True
isSpecial ITexport = True
@@
-590,7
+596,6
@@
reservedWordsFM = listToUFM $
( "data", ITdata, 0 ),
( "default", ITdefault, 0 ),
( "deriving", ITderiving, 0 ),
( "data", ITdata, 0 ),
( "default", ITdefault, 0 ),
( "deriving", ITderiving, 0 ),
- ( "derive", ITderive, 0 ),
( "do", ITdo, 0 ),
( "else", ITelse, 0 ),
( "hiding", IThiding, 0 ),
( "do", ITdo, 0 ),
( "else", ITelse, 0 ),
( "hiding", IThiding, 0 ),
@@
-774,7
+779,7
@@
multiline_doc_comment span buf _len = withLexedDocType (worker "")
nested_comment :: P (Located Token) -> Action
nested_comment cont span _str _len = do
input <- getInput
nested_comment :: P (Located Token) -> Action
nested_comment cont span _str _len = do
input <- getInput
- go 1 input
+ go (1::Int) input
where
go 0 input = do setInput input; cont
go n input = case alexGetChar input of
where
go 0 input = do setInput input; cont
go n input = case alexGetChar input of
@@
-1301,8
+1306,8
@@
getCharOrFail = do
-- Warnings
warn :: DynFlag -> SDoc -> Action
-- 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
-- -----------------------------------------------------------------------------
lexToken
-- -----------------------------------------------------------------------------
@@
-1584,10
+1589,11
@@
mkPState buf loc flags =
b `setBitIf` cond | cond = bit b
| otherwise = 0
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} ->
= 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
in POk s{messages=(ws', es)} ()
getMessages :: PState -> Messages