X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplify.lhs;h=f9cbc0af3eece5dbc288d8135544466dd6cf7964;hp=1f691eaa437b5f8718e9ef75aa715f11868676df;hb=a263737bbf44050a7b5ecbe267ddf85d410b73e5;hpb=40b82d31494eabb51ef2eb47d6e6191e0db764fd

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 1f691ea..f9cbc0a 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -632,7 +632,7 @@ addNonRecWithUnf env new_bndr new_rhs new_unfolding
     ASSERT( isId new_bndr )
     WARN( new_arity < old_arity || new_arity < dmd_arity, 
           (ptext (sLit "Arity decrease:") <+> ppr final_id <+> ppr old_arity
-		<+> ppr new_arity <+> ppr dmd_arity) $$ ppr new_rhs )
+		<+> ppr new_arity <+> ppr dmd_arity) )
 	-- Note [Arity decrease]
 
     final_id `seq`   -- This seq forces the Id, and hence its IdInfo,
@@ -656,9 +656,10 @@ simplUnfolding env top_lvl _ _ _
     (CoreUnfolding { uf_tmpl = expr, uf_arity = arity
                    , uf_guidance = guide@(InlineRule {}) })
   = do { expr' <- simplExpr (setMode SimplGently env) expr
-       ; let mb_wkr' = CoreSubst.substInlineRuleGuidance (mkCoreSubst env) (ug_ir_info guide)
+       	       -- See Note [Simplifying gently inside InlineRules] in SimplUtils
+       ; let mb_wkr' = CoreSubst.substInlineRuleInfo (mkCoreSubst env) (ir_info guide)
        ; return (mkCoreUnfolding (isTopLevel top_lvl) expr' arity 
-                                 (guide { ug_ir_info = mb_wkr' })) }
+                                 (guide { ir_info = mb_wkr' })) }
 		-- See Note [Top-level flag on inline rules] in CoreUnfold
 
 simplUnfolding _ top_lvl _ occ_info new_rhs _
@@ -1450,7 +1451,7 @@ rebuildCase env scrut case_bndr [(_, bndrs, rhs)] cont
 
 rebuildCase env scrut case_bndr alts@[(_, bndrs, rhs)] cont
   | all isDeadBinder (case_bndr : bndrs)  -- So this is just 'seq'
-  = 	-- For this case, see Note [Rules for seq] in MkId
+  = 	-- For this case, see Note [User-defined RULES for seq] in MkId
     do { let rhs' = substExpr env rhs
              out_args = [Type (substTy env (idType case_bndr)), 
 	     	         Type (exprType rhs'), scrut, rhs']
@@ -1518,7 +1519,7 @@ much always zap the OccInfo of the binders.  It doesn't matter much though.
 
 Note [Case of cast]
 ~~~~~~~~~~~~~~~~~~~
-Consider        case (v `cast` co) of x { I# ->
+Consider        case (v `cast` co) of x { I# y ->
                 ... (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
@@ -1539,10 +1540,31 @@ where x::F Int.  Then we'd like to rewrite (F Int) to Int, getting
            I# x# -> let x = x' `cast` sym co
                     in rhs
 
-so that 'rhs' can take advantage of the form of x'.  Notice that Note
-[Case of cast] may then apply to the result.
-
-This showed up in Roman's experiments.  Example:
+so that 'rhs' can take advantage of the form of x'.  
+
+Notice that Note [Case of cast] may then apply to the result. 
+
+Nota Bene: We only do the [Improving seq] transformation if the 
+case binder 'x' is actually used in the rhs; that is, if the case 
+is *not* a *pure* seq.  
+  a) There is no point in adding the cast to a pure seq.
+  b) There is a good reason not to: doing so would interfere 
+     with seq rules (Note [Built-in RULES for seq] in MkId).
+     In particular, this [Improving seq] thing *adds* a cast
+     while [Built-in RULES for seq] *removes* one, so they
+     just flip-flop.
+
+You might worry about 
+   case v of x { __DEFAULT ->
+      ... case (v `cast` co) of y { I# -> ... }}
+This is a pure seq (since x is unused), so [Improving seq] won't happen.
+But it's ok: the simplifier will replace 'v' by 'x' in the rhs to get
+   case v of x { __DEFAULT ->
+      ... case (x `cast` co) of y { I# -> ... }}
+Now the outer case is not a pure seq, so [Improving seq] will happen,
+and then the inner case will disappear.
+
+The need for [Improving seq] showed up in Roman's experiments.  Example:
   foo :: F Int -> Int -> Int
   foo t n = t `seq` bar n
      where
@@ -1551,11 +1573,9 @@ This showed up in Roman's experiments.  Example:
 Here we'd like to avoid repeated evaluating t inside the loop, by
 taking advantage of the `seq`.
 
-At one point I did transformation in LiberateCase, but it's more robust here.
-(Otherwise, there's a danger that we'll simply drop the 'seq' altogether, before
-LiberateCase gets to see it.)
-
-
+At one point I did transformation in LiberateCase, but it's more
+robust here.  (Otherwise, there's a danger that we'll simply drop the
+'seq' altogether, before LiberateCase gets to see it.)
 
 
 \begin{code}
@@ -1564,8 +1584,9 @@ improveSeq :: (FamInstEnv, FamInstEnv) -> SimplEnv
 	   -> SimplM (SimplEnv, OutExpr, OutId)
 -- Note [Improving seq]
 improveSeq fam_envs env scrut case_bndr case_bndr1 [(DEFAULT,_,_)]
-  | Just (co, ty2) <- topNormaliseType fam_envs (idType case_bndr1)
-  =  do { case_bndr2 <- newId (fsLit "nt") ty2
+  | not (isDeadBinder case_bndr)	-- Not a pure seq!  See the Note!
+  , Just (co, ty2) <- topNormaliseType fam_envs (idType case_bndr1)
+  = do { case_bndr2 <- newId (fsLit "nt") ty2
         ; let rhs  = DoneEx (Var case_bndr2 `Cast` mkSymCoercion co)
               env2 = extendIdSubst env case_bndr rhs
         ; return (env2, scrut `Cast` co, case_bndr2) }