Commit a33ae68a authored by rl@cse.unsw.edu.au's avatar rl@cse.unsw.edu.au

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.
parent b4229ab6
......@@ -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 })
......
......@@ -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
......
......@@ -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}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment