diff options
Diffstat (limited to 'compiler/main/DynFlags.hs')
| -rw-r--r-- | compiler/main/DynFlags.hs | 98 |
1 files changed, 66 insertions, 32 deletions
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 () |