diff options
| -rw-r--r-- | compiler/hsSyn/HsSyn.lhs | 5 | ||||
| -rw-r--r-- | compiler/main/DynFlags.hs | 9 | ||||
| -rw-r--r-- | compiler/main/HeaderInfo.hs | 11 | ||||
| -rw-r--r-- | compiler/main/HscStats.lhs | 2 | ||||
| -rw-r--r-- | compiler/parser/Lexer.x | 28 | ||||
| -rw-r--r-- | compiler/parser/Parser.y.pp | 38 | ||||
| -rw-r--r-- | compiler/typecheck/TcRnDriver.lhs | 2 |
7 files changed, 54 insertions, 41 deletions
diff --git a/compiler/hsSyn/HsSyn.lhs b/compiler/hsSyn/HsSyn.lhs index afaad8c05c..43941695fe 100644 --- a/compiler/hsSyn/HsSyn.lhs +++ b/compiler/hsSyn/HsSyn.lhs @@ -70,7 +70,6 @@ data HsModule name -- often empty, downstream. [LHsDecl name] -- Type, class, value, and interface signature decls (Maybe DeprecTxt) -- reason/explanation for deprecation of this module - (Maybe String) -- Haddock options, declared with the {-# DOCOPTIONS ... #-} pragma (HaddockModInfo name) -- Haddock module info (Maybe (HsDoc name)) -- Haddock module description @@ -105,10 +104,10 @@ instance Outputable Char where instance (OutputableBndr name) => Outputable (HsModule name) where - ppr (HsModule Nothing _ imports decls _ _ _ mbDoc) + ppr (HsModule Nothing _ imports decls _ _ mbDoc) = pp_mb mbDoc $$ pp_nonnull imports $$ pp_nonnull decls - ppr (HsModule (Just name) exports imports decls deprec opts _ mbDoc) + ppr (HsModule (Just name) exports imports decls deprec _ mbDoc) = vcat [ pp_mb mbDoc, case exports of diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index bf456c97af..5d8922cd06 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -267,6 +267,7 @@ data DynFlag | Opt_HideAllPackages | Opt_PrintBindResult | Opt_Haddock + | Opt_HaddockOptions | Opt_Hpc_No_Auto | Opt_BreakOnException | Opt_BreakOnError @@ -390,7 +391,9 @@ data DynFlags = DynFlags { flags :: [DynFlag], -- message output - log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO () + log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO (), + + haddockOptions :: Maybe String } data HscTarget @@ -519,6 +522,7 @@ defaultDynFlags = packageFlags = [], pkgDatabase = Nothing, pkgState = panic "no package state yet: call GHC.setSessionDynFlags", + haddockOptions = Nothing, flags = [ Opt_ReadUserPackageConf, @@ -617,6 +621,8 @@ addOptwindres f d = d{ opt_windres = f : opt_windres d} addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d} +addHaddockOpts f d = d{ haddockOptions = Just f} + -- ----------------------------------------------------------------------------- -- Command-line options @@ -1011,6 +1017,7 @@ dynamic_flags = [ , ( "no-hs-main" , NoArg (setDynFlag Opt_NoHsMain)) , ( "main-is" , SepArg setMainIs ) , ( "haddock" , NoArg (setDynFlag Opt_Haddock) ) + , ( "haddock-opts" , HasArg (upd . addHaddockOpts)) , ( "hpcdir" , SepArg setOptHpcDir ) ------- recompilation checker (DEPRECATED, use -fforce-recomp) ----- diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index a68069536d..7142645435 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -67,7 +67,7 @@ getImports dflags buf filename source_filename = do printErrorsAndWarnings dflags ms when (errorsFound dflags ms) $ exitWith (ExitFailure 1) case rdr_module of - L _ (HsModule mb_mod _ imps _ _ _ _ _) -> + L _ (HsModule mb_mod _ imps _ _ _ _) -> let main_loc = mkSrcLoc (mkFastString source_filename) 1 0 mod = mb_mod `orElse` L (srcLocSpan main_loc) mAIN_NAME @@ -146,6 +146,15 @@ getOptions' buf filename , ITclose_prag <- getToken close = map (L (getLoc open)) ["-#include",removeSpaces str] `combine` parseToks xs + parseToks (open:close:xs) + | ITdocOptions str <- getToken open + , ITclose_prag <- getToken close + = map (L (getLoc open)) ["-haddock-opts", removeSpaces str] + `combine` parseToks xs + parseToks (open:xs) + | ITdocOptionsOld str <- getToken open + = map (L (getLoc open)) ["-haddock-opts", removeSpaces str] + `combine` parseToks xs parseToks (open:xs) | ITlanguage_prag <- getToken open = parseLanguage xs diff --git a/compiler/main/HscStats.lhs b/compiler/main/HscStats.lhs index e7b780af5b..188b4f338d 100644 --- a/compiler/main/HscStats.lhs +++ b/compiler/main/HscStats.lhs @@ -30,7 +30,7 @@ import Util ( count ) %************************************************************************ \begin{code} -ppSourceStats short (L _ (HsModule _ exports imports ldecls _ _ _ _)) +ppSourceStats short (L _ (HsModule _ exports imports ldecls _ _ _)) = (if short then hcat else vcat) (map pp_val [("ExportAll ", export_all), -- 1 if no export list diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 47fd10767e..2f6b7329a9 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -149,7 +149,7 @@ $tab+ { warn Opt_WarnTabs (text "Tab character") } -- 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 @@ -257,9 +257,6 @@ $tab+ { warn Opt_WarnTabs (text "Tab character") } "{-#" $whitechar* (CORE|core) { token ITcore_prag } "{-#" $whitechar* (UNPACK|unpack) { token ITunpack_prag } - "{-#" $whitechar* (DOC_OPTIONS|doc_options) - / { ifExtension haddockEnabled } { lex_string_prag ITdocOptions } - "{-#" { nested_comment lexToken } -- ToDo: should only be valid inside a pragma: @@ -267,11 +264,18 @@ $tab+ { warn Opt_WarnTabs (text "Tab character") } } <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> { @@ -284,8 +288,8 @@ $tab+ { warn Opt_WarnTabs (text "Tab character") } -- 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 @@ -555,6 +559,7 @@ data Token | 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 @@ -819,7 +824,8 @@ withLexedDocType lexDocComment = do '|' -> 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 diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 109fd8be47..8adc381319 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -322,7 +322,6 @@ incorrect. DOCPREV { L _ (ITdocCommentPrev _) } DOCNAMED { L _ (ITdocCommentNamed _) } DOCSECTION { L _ (ITdocSection _ _) } - DOCOPTIONS { L _ (ITdocOptions _) } -- Template Haskell '[|' { L _ ITopenExpQuote } @@ -365,22 +364,19 @@ identifier :: { Located RdrName } -- know what they are doing. :-) module :: { Located (HsModule RdrName) } - : optdoc 'module' modid maybemoddeprec maybeexports 'where' body - {% fileSrcSpan >>= \ loc -> case $1 of { (opt, info, doc) -> - return (L loc (HsModule (Just $3) $5 (fst $7) (snd $7) $4 - opt info doc) )}} + : maybedocheader 'module' modid maybemoddeprec maybeexports 'where' body + {% fileSrcSpan >>= \ loc -> case $1 of { (info, doc) -> + return (L loc (HsModule (Just $3) $5 (fst $7) (snd $7) $4 + info doc) )}} | body2 {% fileSrcSpan >>= \ loc -> - return (L loc (HsModule Nothing Nothing - (fst $1) (snd $1) Nothing Nothing emptyHaddockModInfo + return (L loc (HsModule Nothing Nothing + (fst $1) (snd $1) Nothing emptyHaddockModInfo Nothing)) } -optdoc :: { (Maybe String, HaddockModInfo RdrName, Maybe (HsDoc RdrName)) } - : moduleheader { (Nothing, fst $1, snd $1) } - | docoptions { (Just $1, emptyHaddockModInfo, Nothing)} - | docoptions moduleheader { (Just $1, fst $2, snd $2) } - | moduleheader docoptions { (Just $2, fst $1, snd $1) } - | {- empty -} { (Nothing, emptyHaddockModInfo, Nothing) } +maybedocheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) } + : moduleheader { (fst $1, snd $1) } + | {- empty -} { (emptyHaddockModInfo, Nothing) } missing_module_keyword :: { () } : {- empty -} {% pushCurrentContext } @@ -409,14 +405,14 @@ cvtopdecls :: { [LHsDecl RdrName] } -- Module declaration & imports only header :: { Located (HsModule RdrName) } - : optdoc 'module' modid maybemoddeprec maybeexports 'where' header_body - {% fileSrcSpan >>= \ loc -> case $1 of { (opt, info, doc) -> - return (L loc (HsModule (Just $3) $5 $7 [] $4 - opt info doc))}} + : maybedocheader 'module' modid maybemoddeprec maybeexports 'where' header_body + {% fileSrcSpan >>= \ loc -> case $1 of { (info, doc) -> + return (L loc (HsModule (Just $3) $5 $7 [] $4 + info doc))}} | missing_module_keyword importdecls {% fileSrcSpan >>= \ loc -> - return (L loc (HsModule Nothing Nothing $2 [] Nothing - Nothing emptyHaddockModInfo Nothing)) } + return (L loc (HsModule Nothing Nothing $2 [] Nothing + emptyHaddockModInfo Nothing)) } header_body :: { [LImportDecl RdrName] } : '{' importdecls { $2 } @@ -1866,9 +1862,6 @@ docsection :: { Located (n, HsDoc RdrName) } Left err -> parseError (getLoc $1) err; Right doc -> return (L1 (n, doc)) } } -docoptions :: { String } - : DOCOPTIONS '#-}' { getDOCOPTIONS $1 } - moduleheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) } : DOCNEXT {% let string = getDOCNEXT $1 in case parseModuleHeader string of { @@ -1918,7 +1911,6 @@ getDOCNEXT (L _ (ITdocCommentNext x)) = x getDOCPREV (L _ (ITdocCommentPrev x)) = x getDOCNAMED (L _ (ITdocCommentNamed x)) = x getDOCSECTION (L _ (ITdocSection n x)) = (n, x) -getDOCOPTIONS (L _ (ITdocOptions x)) = x -- Utilities for combining source spans comb2 :: Located a -> Located b -> SrcSpan diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index 694a77a21d..74209d916a 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -125,7 +125,7 @@ tcRnModule :: HscEnv tcRnModule hsc_env hsc_src save_rn_syntax (L loc (HsModule maybe_mod export_ies - import_decls local_decls mod_deprec _ + import_decls local_decls mod_deprec module_info maybe_doc)) = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ; |