Add -ddump-rule-firings

[ghc-hetmet.git] / compiler / simplCore / Simplify.lhs

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index efd1b78..13c20e7 100644 (file)
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -208,7 +208,8 @@ simplTopBinds env binds
                -- It's rather as if the top-level binders were imported.
        ; env <- simplRecBndrs env (bindersOfBinds binds)
        ; dflags <- getDOptsSmpl
-       ; let dump_flag = dopt Opt_D_dump_inlinings dflags
+       ; let dump_flag = dopt Opt_D_dump_inlinings dflags || 
+                         dopt Opt_D_dump_rule_firings dflags
        ; env' <- simpl_binds dump_flag env binds
        ; freeTick SimplifierDone
        ; return (getFloats env') }
@@ -216,6 +217,9 @@ simplTopBinds env binds
        -- We need to track the zapped top-level binders, because
        -- they should have their fragile IdInfo zapped (notably occurrence info)
        -- That's why we run down binds and bndrs' simultaneously.
+       --
+       -- The dump-flag emits a trace for each top-level binding, which
+       -- helps to locate the tracing for inlining and rule firing
     simpl_binds :: Bool -> SimplEnv -> [InBind] -> SimplM SimplEnv
     simpl_binds dump env []          = return env
     simpl_binds dump env (bind:binds) = do { env' <- trace dump bind $
@@ -410,7 +414,7 @@ becomes
 prepareRhs :: SimplEnv -> OutExpr -> SimplM (SimplEnv, OutExpr)
 -- Adds new floats to the env iff that allows us to return a good RHS
 
-prepareRhs env (Cast rhs co)   -- Note [Float coersions]
+prepareRhs env (Cast rhs co)   -- Note [Float coercions]
   = do { (env', rhs') <- makeTrivial env rhs
        ; return (env', Cast rhs' co) }
 
@@ -735,8 +739,9 @@ simplCast env body co cont
   where
        addCoerce co cont = add_coerce co (coercionKind co) cont
 
-       add_coerce co (s1, k1) cont 
-         | s1 `coreEqType` k1 = cont
+       add_coerce co (s1, k1) cont     -- co :: ty~ty
+         | s1 `coreEqType` k1 = cont   -- is a no-op
+
        add_coerce co1 (s1, k2) (CoerceIt co2 cont)
          | (l1, t1) <- coercionKind co2
                 --     coerce T1 S1 (coerce S1 K1 e)
@@ -945,7 +950,7 @@ completeCall env var cont
        ; case maybe_rule of {
            Just (rule, rule_rhs) -> 
                tick (RuleFired (ru_name rule))                 `thenSmpl_`
-               (if dopt Opt_D_dump_inlinings dflags then
+               (if dopt Opt_D_dump_rule_firings dflags then
                   pprTrace "Rule fired" (vcat [
                        text "Rule:" <+> ftext (ru_name rule),
                        text "Before:" <+> ppr var <+> sep (map pprParendExpr args),
@@ -1123,18 +1128,10 @@ in action in spectral/cichelli/Prog.hs:
         [(m,n) | m <- [1..max], n <- [1..max]]
 Hence the check for NoCaseOfCase.
 
-Note [Case of cast]
-~~~~~~~~~~~~~~~~~~~
-Consider       case (v `cast` co) of x { I# ->
-               ... (case (v `cast` co) of {...}) ...
-We'd like to eliminate the inner case.  We can get this neatly by 
-arranging that inside the outer case we add the unfolding
-       v |-> x `cast` (sym co)
-to v.  Then we should inline v at the inner case, cancel the casts, and away we go
-       
-Note 2
-~~~~~~
-There is another situation when we don't want to do it.  If we have
+Note [Suppressing the case binder-swap]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+There is another situation when it might make sense to suppress the
+case-expression binde-swap. If we have
 
     case x of w1 { DEFAULT -> case x of w2 { A -> e1; B -> e2 }
                   ...other cases .... }
@@ -1196,6 +1193,15 @@ The point is that we bring into the envt a binding
 after the outer case, and that makes (a,b) alive.  At least we do unless
 the case binder is guaranteed dead.
 
+Note [Case of cast]
+~~~~~~~~~~~~~~~~~~~
+Consider       case (v `cast` co) of x { I# ->
+               ... (case (v `cast` co) of {...}) ...
+We'd like to eliminate the inner case.  We can get this neatly by 
+arranging that inside the outer case we add the unfolding
+       v |-> x `cast` (sym co)
+to v.  Then we should inline v at the inner case, cancel the casts, and away we go
+       
 \begin{code}
 simplCaseBinder :: SimplEnv -> OutExpr -> InId -> SimplM (SimplEnv, OutId)
 simplCaseBinder env scrut case_bndr