From 13066ef96857811821e1d397dc97cb285af16a99 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Wed, 21 Feb 2001 12:55:48 +0000
Subject: [PATCH] [project @ 2001-02-21 12:55:48 by simonpj] Improve the
 identity-case transform in strange Coerce situations

---
 ghc/compiler/simplCore/SimplUtils.lhs |   31 +++++++++++++++++++++++--------
 1 file changed, 23 insertions(+), 8 deletions(-)

diff --git a/ghc/compiler/simplCore/SimplUtils.lhs b/ghc/compiler/simplCore/SimplUtils.lhs
index 4d9ebd3..2732f0a 100644
--- a/ghc/compiler/simplCore/SimplUtils.lhs
+++ b/ghc/compiler/simplCore/SimplUtils.lhs
@@ -23,7 +23,8 @@ import CmdLineOpts	( switchIsOn, SimplifierSwitch(..),
 			  opt_UF_UpdateInPlace
 			)
 import CoreSyn
-import CoreUtils	( exprIsTrivial, cheapEqExpr, exprType, exprIsCheap, etaExpand, exprEtaExpandArity, bindNonRec )
+import CoreUtils	( exprIsTrivial, cheapEqExpr, exprType, exprIsCheap, 
+			  etaExpand, exprEtaExpandArity, bindNonRec, mkCoerce )
 import Subst		( InScopeSet, mkSubst, substBndrs, substBndr, substIds, substExpr )
 import Id		( idType, idName, 
 			  idUnfolding, idStrictness,
@@ -789,14 +790,28 @@ and similar friends.
 mkCase scrut case_bndr alts
   | all identity_alt alts
   = tick (CaseIdentity case_bndr)		`thenSmpl_`
-    returnSmpl scrut
+    returnSmpl (re_note scrut)
   where
-    identity_alt (DEFAULT, [], Var v)     = v == case_bndr
-    identity_alt (DataAlt con, args, rhs) = cheapEqExpr rhs
-					  		(mkConApp con (map Type arg_tys ++ map varToCoreExpr args))
-    identity_alt other		          = False
-
-    arg_tys = tyConAppArgs (idType case_bndr)
+    identity_alt (con, args, rhs) = de_note rhs `cheapEqExpr` identity_rhs con args
+
+    identity_rhs (DataAlt con) args = mkConApp con (arg_tys ++ map varToCoreExpr args)
+    identity_rhs (LitAlt lit)  _    = Lit lit
+    identity_rhs DEFAULT       _    = Var case_bndr
+
+    arg_tys = map Type (tyConAppArgs (idType case_bndr))
+
+	-- We've seen this:
+	--	case coerce T e of x { _ -> coerce T' x }
+	-- And we definitely want to eliminate this case!
+	-- So we throw away notes from the RHS, and reconstruct
+	-- (at least an approximation) at the other end
+    de_note (Note _ e) = de_note e
+    de_note e	       = e
+
+	-- re_note wraps a coerce if it might be necessary
+    re_note scrut = case head alts of
+			(_,_,rhs1@(Note _ _)) -> mkCoerce (exprType rhs1) (idType case_bndr) scrut
+			other		      -> scrut
 \end{code}
 
 The catch-all case
-- 
1.7.10.4