-- - 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"
-- space followed by a Haddock comment symbol (docsym) (in which case we'd
-- have a Haddock comment). The rules then munch the rest of the line.
-"-- " ~$docsym .* ;
+"-- " ~[$docsym \#] .* ;
"--" [^$symbol : \ ] .* ;
-- Next, match Haddock comments if no -haddock flag
"{-#" $whitechar* (CORE|core) { token ITcore_prag }
"{-#" $whitechar* (UNPACK|unpack) { token ITunpack_prag }
- "{-#" $whitechar* (DOCOPTIONS|docoptions)
- / { ifExtension haddockEnabled } { lex_string_prag ITdocOptions }
-
"{-#" { nested_comment lexToken }
-- ToDo: should only be valid inside a pragma:
}
<option_prags> {
- "{-#" $whitechar* (OPTIONS|options) { lex_string_prag IToptions_prag }
- "{-#" $whitechar* (OPTIONS_GHC|options_ghc)
+ "{-#" $whitechar* (OPTIONS|options) { lex_string_prag IToptions_prag }
+ "{-#" $whitechar* (OPTIONS_GHC|options_ghc)
{ lex_string_prag IToptions_prag }
- "{-#" $whitechar* (LANGUAGE|language) { token ITlanguage_prag }
- "{-#" $whitechar* (INCLUDE|include) { lex_string_prag ITinclude_prag }
+ "{-#" $whitechar* (OPTIONS_HADDOCK|options_haddock)
+ { lex_string_prag ITdocOptions }
+ "-- #" { multiline_doc_comment }
+ "{-#" $whitechar* (LANGUAGE|language) { token ITlanguage_prag }
+ "{-#" $whitechar* (INCLUDE|include) { lex_string_prag ITinclude_prag }
+}
+
+<0> {
+ "-- #" .* ;
}
<0,option_prags> {
-- Haddock comments
<0> {
- "-- " $docsym / { ifExtension haddockEnabled } { multiline_doc_comment }
- "{-" \ ? $docsym / { ifExtension haddockEnabled } { nested_doc_comment }
+ "-- " $docsym / { ifExtension haddockEnabled } { multiline_doc_comment }
+ "{-" \ ? $docsym / { ifExtension haddockEnabled } { nested_doc_comment }
}
-- "special" symbols
| ITdocCommentNamed String -- something beginning '-- $'
| ITdocSection Int String -- a section heading
| ITdocOptions String -- doc options (prune, ignore-exports, etc)
+ | ITdocOptionsOld String -- doc options declared "-- # ..."-style
#ifdef DEBUG
deriving Show -- debugging
'|' -> lexDocComment input ITdocCommentNext False
'^' -> lexDocComment input ITdocCommentPrev False
'$' -> lexDocComment input ITdocCommentNamed False
- '*' -> lexDocSection 1 input
+ '*' -> lexDocSection 1 input
+ '#' -> lexDocComment input ITdocOptionsOld False
where
lexDocSection n input = case alexGetChar input of
Just ('*', input) -> lexDocSection (n+1) input
-- 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