Symbolic tags for simplifier phases
authorRoman Leshchinskiy <rl@cse.unsw.edu.au>
Mon, 11 Feb 2008 03:23:50 +0000 (03:23 +0000)
committerRoman Leshchinskiy <rl@cse.unsw.edu.au>
Mon, 11 Feb 2008 03:23:50 +0000 (03:23 +0000)
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
compiler/simplCore/SimplCore.lhs
compiler/simplCore/SimplUtils.lhs

index 76658cc..dbb791e 100644 (file)
@@ -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 })
index fc5b903..0a6c404 100644 (file)
@@ -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
                   
index 724612e..060d346 100644 (file)
@@ -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}