From b4229ab662b6d87b1477bafa85d2db46e5a9a152 Mon Sep 17 00:00:00 2001 From: Roman Leshchinskiy Date: Mon, 11 Feb 2008 02:06:30 +0000 Subject: [PATCH] Allow -ddump-simpl-phases to specify which phases to dump We can now say -ddump-simpl-phases=1,2 to dump only these two phases and nothing else. --- compiler/coreSyn/CoreLint.lhs | 5 ++++- compiler/main/DynFlags.hs | 36 ++++++++++++++++++++++++++++++++++-- compiler/main/ErrUtils.lhs | 18 ++++++++++++------ compiler/simplCore/SimplCore.lhs | 13 ++++++++----- 4 files changed, 58 insertions(+), 14 deletions(-) diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs index 421f3b0..e903c6a 100644 --- a/compiler/coreSyn/CoreLint.lhs +++ b/compiler/coreSyn/CoreLint.lhs @@ -10,7 +10,7 @@ A ``lint'' pass to check for Core correctness module CoreLint ( lintCoreBindings, lintUnfolding, - showPass, endPass, endIteration + showPass, endPass, endPassIf, endIteration ) where #include "HsVersions.h" @@ -57,6 +57,9 @@ and do Core Lint when necessary. endPass :: DynFlags -> String -> DynFlag -> [CoreBind] -> IO [CoreBind] endPass = dumpAndLint dumpIfSet_core +endPassIf :: Bool -> DynFlags -> String -> DynFlag -> [CoreBind] -> IO [CoreBind] +endPassIf cond = dumpAndLint (dumpIf_core cond) + endIteration :: DynFlags -> String -> DynFlag -> [CoreBind] -> IO [CoreBind] endIteration = dumpAndLint dumpIfSet_dyn diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index fb87391..76658cc 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -301,6 +301,7 @@ data DynFlags = DynFlags { optLevel :: Int, -- optimisation level simplPhases :: Int, -- number of simplifier phases maxSimplIterations :: Int, -- max simplifier iterations + shouldDumpSimplPhase :: SimplifierMode -> Bool, ruleCheck :: Maybe String, specConstrThreshold :: Maybe Int, -- Threshold for SpecConstr @@ -492,6 +493,7 @@ defaultDynFlags = optLevel = 0, simplPhases = 2, maxSimplIterations = 4, + shouldDumpSimplPhase = const False, ruleCheck = Nothing, specConstrThreshold = Just 200, liberateCaseThreshold = Just 200, @@ -1116,7 +1118,7 @@ dynamic_flags = [ , ( "ddump-rn", setDumpFlag Opt_D_dump_rn) , ( "ddump-simpl", setDumpFlag Opt_D_dump_simpl) , ( "ddump-simpl-iterations", setDumpFlag Opt_D_dump_simpl_iterations) - , ( "ddump-simpl-phases", setDumpFlag Opt_D_dump_simpl_phases) + , ( "ddump-simpl-phases", OptPrefix setDumpSimplPhases) , ( "ddump-spec", setDumpFlag Opt_D_dump_spec) , ( "ddump-prep", setDumpFlag Opt_D_dump_prep) , ( "ddump-stg", setDumpFlag Opt_D_dump_stg) @@ -1135,7 +1137,7 @@ dynamic_flags = [ , ( "ddump-simpl-stats", setDumpFlag Opt_D_dump_simpl_stats) , ( "ddump-bcos", setDumpFlag Opt_D_dump_BCOs) , ( "dsource-stats", setDumpFlag Opt_D_source_stats) - , ( "dverbose-core2core", setDumpFlag Opt_D_verbose_core2core) + , ( "dverbose-core2core", NoArg setVerboseCore2Core) , ( "dverbose-stg2stg", setDumpFlag Opt_D_verbose_stg2stg) , ( "ddump-hi", setDumpFlag Opt_D_dump_hi) , ( "ddump-minimal-imports", setDumpFlag Opt_D_dump_minimal_imports) @@ -1466,6 +1468,36 @@ setDumpFlag dump_flag -- Whenver we -ddump, switch off the recompilation checker, -- else you don't see the dump! +setVerboseCore2Core = do setDynFlag Opt_ForceRecomp + setDynFlag Opt_D_verbose_core2core + upd (\s -> s { shouldDumpSimplPhase = const True }) + +setDumpSimplPhases s = do setDynFlag Opt_ForceRecomp + upd (\s -> s { shouldDumpSimplPhase = spec }) + where + spec = join (||) + . map (join (&&)) + . map (map match) + . map (split '+') + . split ',' + $ case s of + '=' : s' -> s' + _ -> s + + join op [] = const True + join op ss = foldr1 (\f g x -> f x `op` g x) ss + + match "" = const True + match s = case reads s of + [(n,"")] -> phase_num n + _ -> phase_name s + + phase_num n (SimplPhase k) = n == k + phase_num _ _ = False + + phase_name "gentle" SimplGently = True + phase_name _ _ = False + setVerbosity :: Maybe Int -> DynP () setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 }) diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs index 0b61295..72d0e93 100644 --- a/compiler/main/ErrUtils.lhs +++ b/compiler/main/ErrUtils.lhs @@ -16,7 +16,8 @@ module ErrUtils ( ghcExit, doIfSet, doIfSet_dyn, - dumpIfSet, dumpIfSet_core, dumpIfSet_dyn, dumpIfSet_dyn_or, mkDumpDoc, dumpSDoc, + dumpIfSet, dumpIf_core, dumpIfSet_core, dumpIfSet_dyn, dumpIfSet_dyn_or, + mkDumpDoc, dumpSDoc, -- * Messages during compilation putMsg, @@ -195,13 +196,18 @@ dumpIfSet flag hdr doc | not flag = return () | otherwise = printDump (mkDumpDoc hdr doc) +dumpIf_core :: Bool -> DynFlags -> DynFlag -> String -> SDoc -> IO () +dumpIf_core cond dflags dflag hdr doc + | cond + || verbosity dflags >= 4 + || dopt Opt_D_verbose_core2core dflags + = dumpSDoc dflags dflag hdr doc + + | otherwise = return () + dumpIfSet_core :: DynFlags -> DynFlag -> String -> SDoc -> IO () dumpIfSet_core dflags flag hdr doc - | dopt flag dflags - || verbosity dflags >= 4 - || dopt Opt_D_verbose_core2core dflags - = dumpSDoc dflags flag hdr doc - | otherwise = return () + = dumpIf_core (dopt flag dflags) dflags flag hdr doc dumpIfSet_dyn :: DynFlags -> DynFlag -> String -> SDoc -> IO () dumpIfSet_dyn dflags flag hdr doc diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs index a7671a4..fc5b903 100644 --- a/compiler/simplCore/SimplCore.lhs +++ b/compiler/simplCore/SimplCore.lhs @@ -17,7 +17,7 @@ module SimplCore ( core2core, simplifyExpr ) where import DynFlags ( CoreToDo(..), SimplifierSwitch(..), SimplifierMode(..), DynFlags, DynFlag(..), dopt, - getCoreToDo ) + getCoreToDo, shouldDumpSimplPhase ) import CoreSyn import HscTypes import CSE ( cseProgram ) @@ -35,7 +35,7 @@ import Simplify ( simplTopBinds, simplExpr ) import SimplEnv ( SimplEnv, simplBinders, mkSimplEnv, setInScopeSet ) import SimplMonad import ErrUtils ( dumpIfSet, dumpIfSet_dyn, showPass ) -import CoreLint ( endPass, endIteration ) +import CoreLint ( endPassIf, endIteration ) import FloatIn ( floatInwards ) import FloatOut ( floatOutwards ) import FamInstEnv @@ -448,14 +448,15 @@ simplifyPgm mode switches hsc_env us imp_rule_base guts (termination_msg, it_count, counts_out, binds') <- do_iteration us 1 (zeroSimplCount dflags) (mg_binds guts) ; - dumpIfSet (dopt Opt_D_verbose_core2core dflags - && dopt Opt_D_dump_simpl_stats dflags) + dumpIfSet (dump_phase && dopt Opt_D_dump_simpl_stats dflags) "Simplifier statistics" (vcat [text termination_msg <+> text "after" <+> ppr it_count <+> text "iterations", text "", pprSimplCount counts_out]); - endPass dflags ("Simplify phase " ++ phase_info ++ " done") Opt_D_dump_simpl_phases binds'; + endPassIf dump_phase dflags + ("Simplify phase " ++ phase_info ++ " done") + Opt_D_dump_simpl_phases binds'; return (counts_out, guts { mg_binds = binds' }) } @@ -464,6 +465,8 @@ simplifyPgm mode switches hsc_env us imp_rule_base guts phase_info = case mode of SimplGently -> "gentle" SimplPhase n -> show n + + dump_phase = shouldDumpSimplPhase dflags mode sw_chkr = isAmongSimpl switches max_iterations = intSwitchSet sw_chkr MaxSimplifierIterations `orElse` 2 -- 1.7.10.4