From a33ae68ab331a16fbb6e7d6931d1c38bd8f37a85 Mon Sep 17 00:00:00 2001 From: Roman Leshchinskiy Date: Mon, 11 Feb 2008 03:23:50 +0000 Subject: [PATCH] Symbolic tags for simplifier phases Every simplifier phase can have an arbitrary number of tags and multiple phases can share the same tags. The tags can be used as arguments to -ddump-simpl-phases to specify which phases are to be dumped. For instance, -ddump-simpl-phases=main will dump the output of phases 2, 1 and 0 of the initial simplifier run (they all share the "main" tag) while -ddump-simpl-phases=main:0 will dump only the output of phase 0 of that run. At the moment, the supported tags are: main The main, staged simplifier run (before strictness) post-worker-wrapper After the w/w split post-liberate-case After LiberateCase final Final clean-up run The names are somewhat arbitrary and will change in the future. --- compiler/main/DynFlags.hs | 41 ++++++++++++++++++++----------------- compiler/simplCore/SimplCore.lhs | 9 +++++--- compiler/simplCore/SimplUtils.lhs | 20 +++++++++--------- 3 files changed, 38 insertions(+), 32 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 76658cc..dbb791e 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -791,7 +791,7 @@ data CoreToDo -- These are diff core-to-core passes, data SimplifierMode -- See comments in SimplMonad = SimplGently - | SimplPhase Int + | SimplPhase Int [String] data SimplifierSwitch = MaxSimplifierIterations Int @@ -830,12 +830,13 @@ getCoreToDo dflags maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase) - simpl_phase phase iter = CoreDoPasses - [ CoreDoSimplify (SimplPhase phase) [ - MaxSimplifierIterations iter - ], - maybe_rule_check phase - ] + simpl_phase phase names iter + = CoreDoPasses + [ CoreDoSimplify (SimplPhase phase names) [ + MaxSimplifierIterations iter + ], + maybe_rule_check phase + ] -- By default, we have 2 phases before phase 0. @@ -848,7 +849,7 @@ getCoreToDo dflags -- inlined. I found that spectral/hartel/genfft lost some useful -- strictness in the function sumcode' if augment is not inlined -- before strictness analysis runs - simpl_phases = CoreDoPasses [ simpl_phase phase max_iter + simpl_phases = CoreDoPasses [ simpl_phase phase ["main"] max_iter | phase <- [phases, phases-1 .. 1] ] @@ -871,7 +872,7 @@ getCoreToDo dflags core_todo = if opt_level == 0 then - [simpl_phase 0 max_iter] + [simpl_phase 0 ["final"] max_iter] else {- opt_level >= 1 -} [ -- initial simplify: mk specialiser happy: minimum effort please @@ -901,7 +902,7 @@ getCoreToDo dflags -- ==> let k = BIG in letrec go = \xs -> ...(k x).... in go xs -- ==> let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs -- Don't stop now! - simpl_phase 0 (max max_iter 3), + simpl_phase 0 ["main"] (max max_iter 3), #ifdef OLD_STRICTNESS @@ -911,7 +912,7 @@ getCoreToDo dflags CoreDoStrictness, CoreDoWorkerWrapper, CoreDoGlomBinds, - simpl_phase 0 max_iter + simpl_phase 0 ["post-worker-wrapper"] max_iter ]), runWhen full_laziness @@ -937,7 +938,7 @@ getCoreToDo dflags -- strictness analysis and the simplification which follows it. runWhen liberate_case (CoreDoPasses [ CoreLiberateCase, - simpl_phase 0 max_iter + simpl_phase 0 ["post-liberate-case"] max_iter ]), -- Run the simplifier after LiberateCase to vastly -- reduce the possiblility of shadowing -- Reason: see Note [Shadowing] in SpecConstr.lhs @@ -947,7 +948,7 @@ getCoreToDo dflags maybe_rule_check 0, -- Final clean-up simplification: - simpl_phase 0 max_iter + simpl_phase 0 ["final"] max_iter ] -- ----------------------------------------------------------------------------- @@ -1468,23 +1469,25 @@ setDumpFlag dump_flag -- Whenver we -ddump, switch off the recompilation checker, -- else you don't see the dump! +setVerboseCore2Core :: DynP () setVerboseCore2Core = do setDynFlag Opt_ForceRecomp setDynFlag Opt_D_verbose_core2core upd (\s -> s { shouldDumpSimplPhase = const True }) +setDumpSimplPhases :: String -> DynP () setDumpSimplPhases s = do setDynFlag Opt_ForceRecomp upd (\s -> s { shouldDumpSimplPhase = spec }) where spec = join (||) . map (join (&&)) . map (map match) - . map (split '+') + . map (split ':') . split ',' $ case s of '=' : s' -> s' _ -> s - join op [] = const True + join _ [] = const True join op ss = foldr1 (\f g x -> f x `op` g x) ss match "" = const True @@ -1492,11 +1495,11 @@ setDumpSimplPhases s = do setDynFlag Opt_ForceRecomp [(n,"")] -> phase_num n _ -> phase_name s - phase_num n (SimplPhase k) = n == k - phase_num _ _ = False + phase_num n (SimplPhase k _) = n == k + phase_num _ _ = False - phase_name "gentle" SimplGently = True - phase_name _ _ = False + phase_name s SimplGently = s == "gentle" + phase_name s (SimplPhase _ ss) = s `elem` ss setVerbosity :: Maybe Int -> DynP () setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 }) diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs index fc5b903..0a6c404 100644 --- a/compiler/simplCore/SimplCore.lhs +++ b/compiler/simplCore/SimplCore.lhs @@ -61,7 +61,7 @@ import Vectorise ( vectorise ) import UniqSupply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply ) import IO ( hPutStr, stderr ) import Outputable -import List ( partition ) +import List ( partition, intersperse ) import Maybes \end{code} @@ -463,8 +463,11 @@ simplifyPgm mode switches hsc_env us imp_rule_base guts where dflags = hsc_dflags hsc_env phase_info = case mode of - SimplGently -> "gentle" - SimplPhase n -> show n + SimplGently -> "gentle" + SimplPhase n ss -> shows n + . showString " [" + . showString (concat $ intersperse "," ss) + $ "]" dump_phase = shouldDumpSimplPhase dflags mode diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs index 724612e..060d346 100644 --- a/compiler/simplCore/SimplUtils.lhs +++ b/compiler/simplCore/SimplUtils.lhs @@ -433,7 +433,7 @@ settings: (d) Simplifying a GHCi expression or Template Haskell splice - SimplPhase n Used at all other times + SimplPhase n _ Used at all other times The key thing about SimplGently is that it does no call-site inlining. Before full laziness we must be careful not to inline wrappers, @@ -582,8 +582,8 @@ preInlineUnconditionally env top_lvl bndr rhs where phase = getMode env active = case phase of - SimplGently -> isAlwaysActive prag - SimplPhase n -> isActive n prag + SimplGently -> isAlwaysActive prag + SimplPhase n _ -> isActive n prag prag = idInlinePragma bndr try_once in_lam int_cxt -- There's one textual occurrence @@ -617,8 +617,8 @@ preInlineUnconditionally env top_lvl bndr rhs canInlineInLam _ = False early_phase = case phase of - SimplPhase 0 -> False - other -> True + SimplPhase 0 _ -> False + other -> True -- If we don't have this early_phase test, consider -- x = length [1,2,3] -- The full laziness pass carefully floats all the cons cells to @@ -738,8 +738,8 @@ postInlineUnconditionally env top_lvl bndr occ_info rhs unfolding where active = case getMode env of - SimplGently -> isAlwaysActive prag - SimplPhase n -> isActive n prag + SimplGently -> isAlwaysActive prag + SimplPhase n _ -> isActive n prag prag = idInlinePragma bndr activeInline :: SimplEnv -> OutId -> Bool @@ -761,7 +761,7 @@ activeInline env id -- and they are now constructed as Compulsory unfoldings (in MkId) -- so they'll happen anyway. - SimplPhase n -> isActive n prag + SimplPhase n _ -> isActive n prag where prag = idInlinePragma id @@ -772,13 +772,13 @@ activeRule dflags env = Nothing -- Rewriting is off | otherwise = case getMode env of - SimplGently -> Just isAlwaysActive + SimplGently -> Just isAlwaysActive -- Used to be Nothing (no rules in gentle mode) -- Main motivation for changing is that I wanted -- lift String ===> ... -- to work in Template Haskell when simplifying -- splices, so we get simpler code for literal strings - SimplPhase n -> Just (isActive n) + SimplPhase n _ -> Just (isActive n) \end{code} -- 1.7.10.4