diff options
Diffstat (limited to 'compiler/main')
| -rw-r--r-- | compiler/main/DriverMkDepend.hs | 2 | ||||
| -rw-r--r-- | compiler/main/DynFlags.hs | 98 | ||||
| -rw-r--r-- | compiler/main/ErrUtils.lhs | 18 | ||||
| -rw-r--r-- | compiler/main/HscMain.hs | 4 | ||||
| -rw-r--r-- | compiler/main/InteractiveEval.hs | 2 | ||||
| -rw-r--r-- | compiler/main/TidyPgm.lhs | 4 |
6 files changed, 82 insertions, 46 deletions
diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs index fecf28362a..953b2c4568 100644 --- a/compiler/main/DriverMkDepend.hs +++ b/compiler/main/DriverMkDepend.hs @@ -335,7 +335,7 @@ endMkDependHS dflags dumpModCycles :: DynFlags -> [ModSummary] -> IO () dumpModCycles dflags mod_summaries - | not (gopt Opt_D_dump_mod_cycles dflags) + | not (dopt Opt_D_dump_mod_cycles dflags) = return () | null cycles diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index cdbb08680b..e1e8c5a384 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -13,6 +13,7 @@ module DynFlags ( -- * Dynamic flags and associated configuration types + DumpFlag(..), GeneralFlag(..), WarningFlag(..), ExtensionFlag(..), @@ -21,15 +22,10 @@ module DynFlags ( FatalMessager, LogAction, FlushOut(..), FlushErr(..), ProfAuto(..), glasgowExtsFlags, - gopt, - gopt_set, - gopt_unset, - wopt, - wopt_set, - wopt_unset, - xopt, - xopt_set, - xopt_unset, + dopt, + gopt, gopt_set, gopt_unset, + wopt, wopt_set, wopt_unset, + xopt, xopt_set, xopt_unset, lang_set, DynFlags(..), HasDynFlags(..), ContainsDynFlags(..), @@ -169,8 +165,7 @@ import qualified Data.IntSet as IntSet -- ----------------------------------------------------------------------------- -- DynFlags --- | Enumerates the simple on-or-off dynamic flags -data GeneralFlag +data DumpFlag -- debugging flags = Opt_D_dump_cmm @@ -234,15 +229,21 @@ data GeneralFlag | Opt_D_dump_ticked | Opt_D_dump_rtti | Opt_D_source_stats - | Opt_D_verbose_core2core | Opt_D_verbose_stg2stg | Opt_D_dump_hi | Opt_D_dump_hi_diffs - | Opt_D_dump_minimal_imports | Opt_D_dump_mod_cycles | Opt_D_dump_view_pattern_commoning + | Opt_D_verbose_core2core + + deriving (Eq, Show, Enum) + +-- | Enumerates the simple on-or-off dynamic flags +data GeneralFlag + + = Opt_DumpToFile -- ^ Append dump output to files instead of stdout. | Opt_D_faststring_stats - | Opt_DumpToFile -- ^ Append dump output to files instead of stdout. + | Opt_D_dump_minimal_imports | Opt_DoCoreLinting | Opt_DoStgLinting | Opt_DoCmmLinting @@ -639,7 +640,8 @@ data DynFlags = DynFlags { generatedDumps :: IORef (Set FilePath), -- hsc dynamic flags - flags :: IntSet, + dumpFlags :: IntSet, + generalFlags :: IntSet, warningFlags :: IntSet, -- Don't change this without updating extensionFlags: language :: Maybe Language, @@ -1194,7 +1196,8 @@ defaultDynFlags mySettings = filesToNotIntermediateClean = panic "defaultDynFlags: No filesToNotIntermediateClean", generatedDumps = panic "defaultDynFlags: No generatedDumps", haddockOptions = Nothing, - flags = IntSet.fromList (map fromEnum (defaultFlags mySettings)), + dumpFlags = IntSet.empty, + generalFlags = IntSet.fromList (map fromEnum (defaultFlags mySettings)), warningFlags = IntSet.fromList (map fromEnum standardWarnings), ghciScripts = [], language = Nothing, @@ -1343,17 +1346,50 @@ languageExtensions (Just Haskell2010) Opt_DoAndIfThenElse, Opt_RelaxedPolyRec] +-- | Test whether a 'DumpFlag' is set +dopt :: DumpFlag -> DynFlags -> Bool +dopt f dflags = (fromEnum f `IntSet.member` dumpFlags dflags) + || (verbosity dflags >= 4 && enableIfVerbose f) + where enableIfVerbose Opt_D_dump_tc_trace = False + enableIfVerbose Opt_D_dump_rn_trace = False + enableIfVerbose Opt_D_dump_cs_trace = False + enableIfVerbose Opt_D_dump_if_trace = False + enableIfVerbose Opt_D_dump_vt_trace = False + enableIfVerbose Opt_D_dump_tc = False + enableIfVerbose Opt_D_dump_rn = False + enableIfVerbose Opt_D_dump_rn_stats = False + enableIfVerbose Opt_D_dump_hi_diffs = False + enableIfVerbose Opt_D_verbose_core2core = False + enableIfVerbose Opt_D_verbose_stg2stg = False + enableIfVerbose Opt_D_dump_splices = False + enableIfVerbose Opt_D_dump_rule_firings = False + enableIfVerbose Opt_D_dump_rule_rewrites = False + enableIfVerbose Opt_D_dump_rtti = False + enableIfVerbose Opt_D_dump_inlinings = False + enableIfVerbose Opt_D_dump_core_stats = False + enableIfVerbose Opt_D_dump_asm_stats = False + enableIfVerbose Opt_D_dump_types = False + enableIfVerbose Opt_D_dump_simpl_iterations = False + enableIfVerbose Opt_D_dump_ticked = False + enableIfVerbose Opt_D_dump_view_pattern_commoning = False + enableIfVerbose Opt_D_dump_mod_cycles = False + enableIfVerbose _ = True + +-- | Set a 'DumpFlag' +dopt_set :: DynFlags -> DumpFlag -> DynFlags +dopt_set dfs f = dfs{ dumpFlags = IntSet.insert (fromEnum f) (dumpFlags dfs) } + -- | Test whether a 'GeneralFlag' is set gopt :: GeneralFlag -> DynFlags -> Bool -gopt f dflags = fromEnum f `IntSet.member` flags dflags +gopt f dflags = fromEnum f `IntSet.member` generalFlags dflags -- | Set a 'GeneralFlag' gopt_set :: DynFlags -> GeneralFlag -> DynFlags -gopt_set dfs f = dfs{ flags = IntSet.insert (fromEnum f) (flags dfs) } +gopt_set dfs f = dfs{ generalFlags = IntSet.insert (fromEnum f) (generalFlags dfs) } -- | Unset a 'GeneralFlag' gopt_unset :: DynFlags -> GeneralFlag -> DynFlags -gopt_unset dfs f = dfs{ flags = IntSet.delete (fromEnum f) (flags dfs) } +gopt_unset dfs f = dfs{ generalFlags = IntSet.delete (fromEnum f) (generalFlags dfs) } -- | Test whether a 'WarningFlag' is set wopt :: WarningFlag -> DynFlags -> Bool @@ -2013,13 +2049,13 @@ dynamic_flags = [ setVerboseCore2Core)) , Flag "dverbose-stg2stg" (setDumpFlag Opt_D_verbose_stg2stg) , Flag "ddump-hi" (setDumpFlag Opt_D_dump_hi) - , Flag "ddump-minimal-imports" (setDumpFlag Opt_D_dump_minimal_imports) + , Flag "ddump-minimal-imports" (NoArg (setGeneralFlag Opt_D_dump_minimal_imports)) , Flag "ddump-vect" (setDumpFlag Opt_D_dump_vect) , Flag "ddump-hpc" (setDumpFlag Opt_D_dump_ticked) -- back compat , Flag "ddump-ticked" (setDumpFlag Opt_D_dump_ticked) , Flag "ddump-mod-cycles" (setDumpFlag Opt_D_dump_mod_cycles) , Flag "ddump-view-pattern-commoning" (setDumpFlag Opt_D_dump_view_pattern_commoning) - , Flag "ddump-to-file" (setDumpFlag Opt_DumpToFile) + , Flag "ddump-to-file" (NoArg (setGeneralFlag Opt_DumpToFile)) , Flag "ddump-hi-diffs" (setDumpFlag Opt_D_dump_hi_diffs) , Flag "ddump-rtti" (setDumpFlag Opt_D_dump_rtti) , Flag "dcore-lint" (NoArg (setGeneralFlag Opt_DoCoreLinting)) @@ -2786,7 +2822,7 @@ optIntSuffixM :: (Maybe Int -> DynFlags -> DynP DynFlags) -> OptKind (CmdLineP DynFlags) optIntSuffixM fn = OptIntSuffix (\mi -> updM (fn mi)) -setDumpFlag :: GeneralFlag -> OptKind (CmdLineP DynFlags) +setDumpFlag :: DumpFlag -> OptKind (CmdLineP DynFlags) setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag) -------------------------- @@ -2831,16 +2867,15 @@ alterSettings :: (Settings -> Settings) -> DynFlags -> DynFlags alterSettings f dflags = dflags { settings = f (settings dflags) } -------------------------- -setDumpFlag' :: GeneralFlag -> DynP () +setDumpFlag' :: DumpFlag -> DynP () setDumpFlag' dump_flag - = do setGeneralFlag dump_flag + = do upd (\dfs -> dopt_set dfs dump_flag) when want_recomp forceRecompile - where - -- Certain dumpy-things are really interested in what's going - -- on during recompilation checking, so in those cases we - -- don't want to turn it off. - want_recomp = dump_flag `notElem` [Opt_D_dump_if_trace, - Opt_D_dump_hi_diffs] + where -- Certain dumpy-things are really interested in what's going + -- on during recompilation checking, so in those cases we + -- don't want to turn it off. + want_recomp = dump_flag `notElem` [Opt_D_dump_if_trace, + Opt_D_dump_hi_diffs] forceRecompile :: DynP () -- Whenver we -ddump, force recompilation (by switching off the @@ -2853,8 +2888,7 @@ forceRecompile = do dfs <- liftEwM getCmdLineState force_recomp dfs = isOneShot (ghcMode dfs) setVerboseCore2Core :: DynP () -setVerboseCore2Core = do forceRecompile - setGeneralFlag Opt_D_verbose_core2core +setVerboseCore2Core = do setDumpFlag' Opt_D_verbose_core2core upd (\dfs -> dfs { shouldDumpSimplPhase = Nothing }) setDumpSimplPhases :: String -> DynP () diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs index 7b1f55fb11..776382ecc3 100644 --- a/compiler/main/ErrUtils.lhs +++ b/compiler/main/ErrUtils.lhs @@ -206,9 +206,9 @@ dumpIfSet dflags flag hdr doc | not flag = return () | otherwise = log_action dflags dflags SevDump noSrcSpan defaultDumpStyle (mkDumpDoc hdr doc) -dumpIfSet_dyn :: DynFlags -> GeneralFlag -> String -> SDoc -> IO () +dumpIfSet_dyn :: DynFlags -> DumpFlag -> String -> SDoc -> IO () dumpIfSet_dyn dflags flag hdr doc - | gopt flag dflags || verbosity dflags >= 4 + | dopt flag dflags = dumpSDoc dflags flag hdr doc | otherwise = return () @@ -229,7 +229,7 @@ mkDumpDoc hdr doc -- -- When hdr is empty, we print in a more compact format (no separators and -- blank lines) -dumpSDoc :: DynFlags -> GeneralFlag -> String -> SDoc -> IO () +dumpSDoc :: DynFlags -> DumpFlag -> String -> SDoc -> IO () dumpSDoc dflags flag hdr doc = do let mFile = chooseDumpFile dflags flag case mFile of @@ -263,7 +263,7 @@ dumpSDoc dflags flag hdr doc -- | Choose where to put a dump file based on DynFlags -- -chooseDumpFile :: DynFlags -> GeneralFlag -> Maybe String +chooseDumpFile :: DynFlags -> DumpFlag -> Maybe String chooseDumpFile dflags flag | gopt Opt_DumpToFile dflags @@ -289,11 +289,13 @@ chooseDumpFile dflags flag Nothing -> f -- | Build a nice file name from name of a GeneralFlag constructor -beautifyDumpName :: GeneralFlag -> String +beautifyDumpName :: DumpFlag -> String beautifyDumpName flag - = let str = show flag - cut = if isPrefixOf "Opt_D_" str then drop 6 str else str - dash = map (\c -> if c == '_' then '-' else c) cut + = let str = show flag + suff = case stripPrefix "Opt_D_" str of + Just x -> x + Nothing -> panic ("Bad flag name: " ++ str) + dash = map (\c -> if c == '_' then '-' else c) suff in dash diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index d9949db1e4..ab48d35bf4 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -1779,8 +1779,8 @@ dumpIfaceStats hsc_env = do (ifaceStats eps) where dflags = hsc_dflags hsc_env - dump_rn_stats = gopt Opt_D_dump_rn_stats dflags - dump_if_trace = gopt Opt_D_dump_if_trace dflags + dump_rn_stats = dopt Opt_D_dump_rn_stats dflags + dump_if_trace = dopt Opt_D_dump_if_trace dflags {- ********************************************************************** diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index 3f184d6278..64b2d3303c 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -706,7 +706,7 @@ rttiEnvironment hsc_env@HscEnv{hsc_IC=ic} = do ++ "improvement for a type")) hsc_env Just subst -> do let dflags = hsc_dflags hsc_env - when (gopt Opt_D_dump_rtti dflags) $ + when (dopt Opt_D_dump_rtti dflags) $ printInfoForUser dflags alwaysQualify $ fsep [text "RTTI Improvement for", ppr id, equals, ppr subst] diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index e2010645b2..64a9058e0c 100644 --- a/compiler/main/TidyPgm.lhs +++ b/compiler/main/TidyPgm.lhs @@ -373,14 +373,14 @@ tidyProgram hsc_env (ModGuts { mg_module = mod -- If the endPass didn't print the rules, but ddump-rules is -- on, print now - ; unless (gopt Opt_D_dump_simpl dflags) $ + ; unless (dopt Opt_D_dump_simpl dflags) $ Err.dumpIfSet_dyn dflags Opt_D_dump_rules (showSDoc dflags (ppr CoreTidy <+> ptext (sLit "rules"))) (pprRulesForUser tidy_rules) -- Print one-line size info ; let cs = coreBindsStats tidy_binds - ; when (gopt Opt_D_dump_core_stats dflags) + ; when (dopt Opt_D_dump_core_stats dflags) (log_action dflags dflags SevDump noSrcSpan defaultDumpStyle (ptext (sLit "Tidy size (terms,types,coercions)") <+> ppr (moduleName mod) <> colon |