Merge branch 'master' of http://darcs.haskell.org/ghc

1 files changed, 51 insertions, 0 deletions

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index f72be2cbb4..0a9d388b7f 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -1054,6 +1054,10 @@ simplTick env tickish expr cont
        ; return (env'', wrapFloats env expr'')
        }
 
+  | Just expr' <- want_to_push_tick_inside
+    -- see Note [case-of-scc-of-case]
+  = simplExprF env expr' cont
+
   | otherwise
   = do { let (inc,outc) = splitCont cont
        ; (env', expr') <- simplExprF (zapFloats env) expr inc
@@ -1062,6 +1066,21 @@ simplTick env tickish expr cont
        ; rebuild env'' expr' (TickIt tickish' outc)
        }
  where
+  want_to_push_tick_inside
+     | not interesting_cont = Nothing
+     | otherwise
+       = case expr of
+           Case scrut bndr ty alts
+              -> Just (Case (mkTick tickish scrut) bndr ty alts')
+             where t_scope = mkNoTick tickish -- drop the tick on the dup'd ones
+                   alts'   = [ (c,bs, mkTick t_scope e) | (c,bs,e) <- alts]
+           _other -> Nothing
+
+  interesting_cont = case cont of
+                          Select _ _ _ _ _ -> True
+                          _ -> False
+
+
   simplTickish env tickish
     | Breakpoint n ids <- tickish
           = Breakpoint n (map (getDoneId . substId env) ids)
@@ -1078,6 +1097,38 @@ simplTick env tickish expr cont
   getDoneId (DoneId id) = id
   getDoneId (DoneEx e)  = getIdFromTrivialExpr e -- Note [substTickish] in CoreSubst
   getDoneId other = pprPanic "getDoneId" (ppr other)
+
+-- Note [case-of-scc-of-case]
+-- It's pretty important to be able to transform case-of-case when
+-- there's an SCC in the way.  For example, the following comes up
+-- in nofib/real/compress/Encode.hs:
+--
+--        case scctick<code_string.r1>
+--             case $wcode_string_r13s wild_XC w1_s137 w2_s138 l_aje
+--             of _ { (# ww1_s13f, ww2_s13g, ww3_s13h #) ->
+--             (ww1_s13f, ww2_s13g, ww3_s13h)
+--             }
+--        of _ { (ww_s12Y, ww1_s12Z, ww2_s130) ->
+--        tick<code_string.f1>
+--        (ww_s12Y,
+--         ww1_s12Z,
+--         PTTrees.PT
+--           @ GHC.Types.Char @ GHC.Types.Int wild2_Xj ww2_s130 r_ajf)
+--        }
+--  
+-- We really want this case-of-case to fire, because then the 3-tuple
+-- will go away (indeed, the CPR optimisation is relying on this
+-- happening).  But the scctick is in the way - we need to push it
+-- inside to expose the case-of-case.  So we perform this
+-- transformation on the inner case:
+--
+--   scctick c (case e of { p1 -> e1; ...; pn -> en })
+--    ==>
+--   case (scctick c e) of { p1 -> scc c e1; ...; pn -> scc c en }
+--
+-- So we've moved a constant amount of work out of the scc to expose
+-- the case.  We only do this when the continuation is interesting: in
+-- for now, it has to be another Case (maybe generalise this later).
 \end{code}