projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fixed warnings in parser/Lexer.x
[ghc-hetmet.git]
/
compiler
/
parser
/
Lexer.x
diff --git
a/compiler/parser/Lexer.x
b/compiler/parser/Lexer.x
index
01ed122
..
1692904
100644
(file)
--- a/
compiler/parser/Lexer.x
+++ b/
compiler/parser/Lexer.x
@@
-27,6
+27,9
@@
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
+--
+-- Note that Alex itself generates code with with some unused bindings and
+-- without type signatures, so removing the flag might not be possible.
module Lexer (
Token(..), lexer, pragState, mkPState, PState(..),
module Lexer (
Token(..), lexer, pragState, mkPState, PState(..),
@@
-572,6
+575,7
@@
data Token
deriving Show -- debugging
#endif
deriving Show -- debugging
#endif
+{-
isSpecial :: Token -> Bool
-- If we see M.x, where x is a keyword, but
-- is special, we treat is as just plain M.x,
isSpecial :: Token -> Bool
-- If we see M.x, where x is a keyword, but
-- is special, we treat is as just plain M.x,
@@
-594,6
+598,7
@@
isSpecial ITgroup = True
isSpecial ITby = True
isSpecial ITusing = True
isSpecial _ = False
isSpecial ITby = True
isSpecial ITusing = True
isSpecial _ = False
+-}
-- the bitmap provided as the third component indicates whether the
-- corresponding extension keyword is valid under the extension options
-- the bitmap provided as the third component indicates whether the
-- corresponding extension keyword is valid under the extension options
@@
-701,11
+706,11
@@
reservedSymsFM = listToUFM $
type Action = SrcSpan -> StringBuffer -> Int -> P (Located Token)
special :: Token -> Action
type Action = SrcSpan -> StringBuffer -> Int -> P (Located Token)
special :: Token -> Action
-special tok span _buf len = return (L span tok)
+special tok span _buf _len = return (L span tok)
token, layout_token :: Token -> Action
token, layout_token :: Token -> Action
-token t span buf len = return (L span t)
-layout_token t span buf len = pushLexState layout >> return (L span t)
+token t span _buf _len = return (L span t)
+layout_token t span _buf _len = pushLexState layout >> return (L span t)
idtoken :: (StringBuffer -> Int -> Token) -> Action
idtoken f span buf len = return (L span $! (f buf len))
idtoken :: (StringBuffer -> Int -> Token) -> Action
idtoken f span buf len = return (L span $! (f buf len))
@@
-755,8
+760,10
@@
isNormalComment bits _ _ (AI _ _ buf)
spaceAndP buf p = p buf || nextCharIs buf (==' ') && p (snd (nextChar buf))
spaceAndP buf p = p buf || nextCharIs buf (==' ') && p (snd (nextChar buf))
+{-
haddockDisabledAnd p bits _ _ (AI _ _ buf)
= if haddockEnabled bits then False else (p buf)
haddockDisabledAnd p bits _ _ (AI _ _ buf)
= if haddockEnabled bits then False else (p buf)
+-}
atEOL _ _ _ (AI _ _ buf) = atEnd buf || currentChar buf == '\n'
atEOL _ _ _ (AI _ _ buf) = atEnd buf || currentChar buf == '\n'
@@
-805,12
+812,12
@@
nested_comment cont span _str _len = do
Just ('-',input) -> case alexGetChar input of
Nothing -> errBrace input span
Just ('\125',input) -> go (n-1) input
Just ('-',input) -> case alexGetChar input of
Nothing -> errBrace input span
Just ('\125',input) -> go (n-1) input
- Just (c,_) -> go n input
+ Just (_,_) -> go n input
Just ('\123',input) -> case alexGetChar input of
Nothing -> errBrace input span
Just ('-',input) -> go (n+1) input
Just ('\123',input) -> case alexGetChar input of
Nothing -> errBrace input span
Just ('-',input) -> go (n+1) input
- Just (c,_) -> go n input
- Just (c,input) -> go n input
+ Just (_,_) -> go n input
+ Just (_,input) -> go n input
nested_doc_comment :: Action
nested_doc_comment span buf _len = withLexedDocType (go "")
nested_doc_comment :: Action
nested_doc_comment span buf _len = withLexedDocType (go "")
@@
-819,16
+826,16
@@
nested_doc_comment span buf _len = withLexedDocType (go "")
Nothing -> errBrace input span
Just ('-',input) -> case alexGetChar input of
Nothing -> errBrace input span
Nothing -> errBrace input span
Just ('-',input) -> case alexGetChar input of
Nothing -> errBrace input span
- Just ('\125',input@(AI end _ buf2)) ->
+ Just ('\125',input) ->
docCommentEnd input commentAcc docType buf span
docCommentEnd input commentAcc docType buf span
- Just (c,_) -> go ('-':commentAcc) input docType False
+ Just (_,_) -> go ('-':commentAcc) input docType False
Just ('\123', input) -> case alexGetChar input of
Nothing -> errBrace input span
Just ('-',input) -> do
setInput input
let cont = do input <- getInput; go commentAcc input docType False
nested_comment cont span buf _len
Just ('\123', input) -> case alexGetChar input of
Nothing -> errBrace input span
Just ('-',input) -> do
setInput input
let cont = do input <- getInput; go commentAcc input docType False
nested_comment cont span buf _len
- Just (c,_) -> go ('\123':commentAcc) input docType False
+ Just (_,_) -> go ('\123':commentAcc) input docType False
Just (c,input) -> go (c:commentAcc) input docType False
withLexedDocType lexDocComment = do
Just (c,input) -> go (c:commentAcc) input docType False
withLexedDocType lexDocComment = do
@@
-842,7
+849,7
@@
withLexedDocType lexDocComment = do
where
lexDocSection n input = case alexGetChar input of
Just ('*', input) -> lexDocSection (n+1) input
where
lexDocSection n input = case alexGetChar input of
Just ('*', input) -> lexDocSection (n+1) input
- Just (c, _) -> lexDocComment input (ITdocSection n) True
+ Just (_, _) -> lexDocComment input (ITdocSection n) True
Nothing -> do setInput input; lexToken -- eof reached, lex it normally
-- docCommentEnd
Nothing -> do setInput input; lexToken -- eof reached, lex it normally
-- docCommentEnd
@@
-920,6
+927,7
@@
splitQualName orig_buf len = split orig_buf orig_buf
qual_size = orig_buf `byteDiff` dot_buf
varid span buf len =
qual_size = orig_buf `byteDiff` dot_buf
varid span buf len =
+ fs `seq`
case lookupUFM reservedWordsFM fs of
Just (keyword,0) -> do
maybe_layout keyword
case lookupUFM reservedWordsFM fs of
Just (keyword,0) -> do
maybe_layout keyword
@@
-1028,7
+1036,7
@@
new_layout_context strict span _buf _len = do
-- we must generate a {} sequence now.
pushLexState layout_left
return (L span ITvocurly)
-- we must generate a {} sequence now.
pushLexState layout_left
return (L span ITvocurly)
- other -> do
+ _ -> do
setContext (Layout offset : ctx)
return (L span ITvocurly)
setContext (Layout offset : ctx)
return (L span ITvocurly)
@@
-1062,7
+1070,7
@@
setFile code span buf len = do
-- Options, includes and language pragmas.
lex_string_prag :: (String -> Token) -> Action
-- Options, includes and language pragmas.
lex_string_prag :: (String -> Token) -> Action
-lex_string_prag mkTok span buf len
+lex_string_prag mkTok span _buf _len
= do input <- getInput
start <- getSrcLoc
tok <- go [] input
= do input <- getInput
start <- getSrcLoc
tok <- go [] input
@@
-1075,7
+1083,7
@@
lex_string_prag mkTok span buf len
else case alexGetChar input of
Just (c,i) -> go (c:acc) i
Nothing -> err input
else case alexGetChar input of
Just (c,i) -> go (c:acc) i
Nothing -> err input
- isString i [] = True
+ isString _ [] = True
isString i (x:xs)
= case alexGetChar i of
Just (c,i') | c == x -> isString i' xs
isString i (x:xs)
= case alexGetChar i of
Just (c,i') | c == x -> isString i' xs
@@
-1089,7
+1097,7
@@
lex_string_prag mkTok span buf len
-- This stuff is horrible. I hates it.
lex_string_tok :: Action
-- This stuff is horrible. I hates it.
lex_string_tok :: Action
-lex_string_tok span buf len = do
+lex_string_tok span _buf _len = do
tok <- lex_string ""
end <- getSrcLoc
return (L (mkSrcSpan (srcSpanStart span) end) tok)
tok <- lex_string ""
end <- getSrcLoc
return (L (mkSrcSpan (srcSpanStart span) end) tok)
@@
-1146,7
+1154,7
@@
lex_char_tok :: Action
-- but WIHTOUT CONSUMING the x or T part (the parser does that).
-- So we have to do two characters of lookahead: when we see 'x we need to
-- see if there's a trailing quote
-- but WIHTOUT CONSUMING the x or T part (the parser does that).
-- So we have to do two characters of lookahead: when we see 'x we need to
-- see if there's a trailing quote
-lex_char_tok span buf len = do -- We've seen '
+lex_char_tok span _buf _len = do -- We've seen '
i1 <- getInput -- Look ahead to first character
let loc = srcSpanStart span
case alexGetChar' i1 of
i1 <- getInput -- Look ahead to first character
let loc = srcSpanStart span
case alexGetChar' i1 of
@@
-1159,14
+1167,14
@@
lex_char_tok span buf len = do -- We've seen '
return (L (mkSrcSpan loc end2) ITtyQuote)
else lit_error
return (L (mkSrcSpan loc end2) ITtyQuote)
else lit_error
- Just ('\\', i2@(AI end2 _ _)) -> do -- We've seen 'backslash
+ Just ('\\', i2@(AI _end2 _ _)) -> do -- We've seen 'backslash
setInput i2
lit_ch <- lex_escape
mc <- getCharOrFail -- Trailing quote
if mc == '\'' then finish_char_tok loc lit_ch
else do setInput i2; lit_error
setInput i2
lit_ch <- lex_escape
mc <- getCharOrFail -- Trailing quote
if mc == '\'' then finish_char_tok loc lit_ch
else do setInput i2; lit_error
- Just (c, i2@(AI end2 _ _))
+ Just (c, i2@(AI _end2 _ _))
| not (isAny c) -> lit_error
| otherwise ->
| not (isAny c) -> lit_error
| otherwise ->
@@
-1410,7
+1418,7
@@
instance Monad P where
fail = failP
returnP :: a -> P a
fail = failP
returnP :: a -> P a
-returnP a = P $ \s -> POk s a
+returnP a = a `seq` (P $ \s -> POk s a)
thenP :: P a -> (a -> P b) -> P b
(P m) `thenP` k = P $ \ s ->
thenP :: P a -> (a -> P b) -> P b
(P m) `thenP` k = P $ \ s ->
@@
-1425,10
+1433,10
@@
failMsgP :: String -> P a
failMsgP msg = P $ \s -> PFailed (last_loc s) (text msg)
failLocMsgP :: SrcLoc -> SrcLoc -> String -> P a
failMsgP msg = P $ \s -> PFailed (last_loc s) (text msg)
failLocMsgP :: SrcLoc -> SrcLoc -> String -> P a
-failLocMsgP loc1 loc2 str = P $ \s -> PFailed (mkSrcSpan loc1 loc2) (text str)
+failLocMsgP loc1 loc2 str = P $ \_ -> PFailed (mkSrcSpan loc1 loc2) (text str)
failSpanMsgP :: SrcSpan -> String -> P a
failSpanMsgP :: SrcSpan -> String -> P a
-failSpanMsgP span msg = P $ \s -> PFailed span (text msg)
+failSpanMsgP span msg = P $ \_ -> PFailed span (text msg)
extension :: (Int -> Bool) -> P Bool
extension p = P $ \s -> POk s (p $! extsBitmap s)
extension :: (Int -> Bool) -> P Bool
extension p = P $ \s -> POk s (p $! extsBitmap s)
@@
-1518,7
+1526,7
@@
alexGetChar' (AI loc ofs s)
ofs' = advanceOffs c ofs
advanceOffs :: Char -> Int -> Int
ofs' = advanceOffs c ofs
advanceOffs :: Char -> Int -> Int
-advanceOffs '\n' offs = 0
+advanceOffs '\n' _ = 0
advanceOffs '\t' offs = (offs `quot` 8 + 1) * 8
advanceOffs _ offs = offs + 1
advanceOffs '\t' offs = (offs `quot` 8 + 1) * 8
advanceOffs _ offs = offs + 1
@@
-1535,7
+1543,7
@@
popLexState :: P Int
popLexState = P $ \s@PState{ lex_state=ls:l } -> POk s{ lex_state=l } ls
getLexState :: P Int
popLexState = P $ \s@PState{ lex_state=ls:l } -> POk s{ lex_state=l } ls
getLexState :: P Int
-getLexState = P $ \s@PState{ lex_state=ls:l } -> POk s ls
+getLexState = P $ \s@PState{ lex_state=ls:_ } -> POk s ls
-- for reasons of efficiency, flags indicating language extensions (eg,
-- -fglasgow-exts or -fparr) are represented by a bitmap stored in an unboxed
-- for reasons of efficiency, flags indicating language extensions (eg,
-- -fglasgow-exts or -fparr) are represented by a bitmap stored in an unboxed
@@
-1668,7
+1676,7
@@
setContext ctx = P $ \s -> POk s{context=ctx} ()
popContext :: P ()
popContext = P $ \ s@(PState{ buffer = buf, context = ctx,
popContext :: P ()
popContext = P $ \ s@(PState{ buffer = buf, context = ctx,
- loc = loc, last_len = len, last_loc = last_loc }) ->
+ last_len = len, last_loc = last_loc }) ->
case ctx of
(_:tl) -> POk s{ context = tl } ()
[] -> PFailed last_loc (srcParseErr buf len)
case ctx of
(_:tl) -> POk s{ context = tl } ()
[] -> PFailed last_loc (srcParseErr buf len)
@@
-1716,7
+1724,7
@@
srcParseFail = P $ \PState{ buffer = buf, last_len = len,
lexError :: String -> P a
lexError str = do
loc <- getSrcLoc
lexError :: String -> P a
lexError str = do
loc <- getSrcLoc
- i@(AI end _ buf) <- getInput
+ (AI end _ buf) <- getInput
reportLexError loc end buf str
-- -----------------------------------------------------------------------------
reportLexError loc end buf str
-- -----------------------------------------------------------------------------
@@
-1725,7
+1733,7
@@
lexError str = do
lexer :: (Located Token -> P a) -> P a
lexer cont = do
lexer :: (Located Token -> P a) -> P a
lexer cont = do
- tok@(L span tok__) <- lexToken
+ tok@(L _span _tok__) <- lexToken
-- trace ("token: " ++ show tok__) $ do
cont tok
-- trace ("token: " ++ show tok__) $ do
cont tok
@@
-1735,20
+1743,21
@@
lexToken = do
sc <- getLexState
exts <- getExts
case alexScanUser exts inp sc of
sc <- getLexState
exts <- getExts
case alexScanUser exts inp sc of
- AlexEOF -> do let span = mkSrcSpan loc1 loc1
- setLastToken span 0 0
- return (L span ITeof)
- AlexError (AI loc2 _ buf) -> do
- reportLexError loc1 loc2 buf "lexical error"
+ AlexEOF -> do
+ let span = mkSrcSpan loc1 loc1
+ setLastToken span 0 0
+ return (L span ITeof)
+ AlexError (AI loc2 _ buf) ->
+ reportLexError loc1 loc2 buf "lexical error"
AlexSkip inp2 _ -> do
AlexSkip inp2 _ -> do
- setInput inp2
- lexToken
- AlexToken inp2@(AI end _ buf2) len t -> do
- setInput inp2
- let span = mkSrcSpan loc1 end
- let bytes = byteDiff buf buf2
- span `seq` setLastToken span bytes bytes
- t span buf bytes
+ setInput inp2
+ lexToken
+ AlexToken inp2@(AI end _ buf2) _ t -> do
+ setInput inp2
+ let span = mkSrcSpan loc1 end
+ let bytes = byteDiff buf buf2
+ span `seq` setLastToken span bytes bytes
+ t span buf bytes
reportLexError loc1 loc2 buf str
| atEnd buf = failLocMsgP loc1 loc2 (str ++ " at end of input")
reportLexError loc1 loc2 buf str
| atEnd buf = failLocMsgP loc1 loc2 (str ++ " at end of input")