Clean up and refactor in SimplUtils.mkCase1 (identity case)

Mon Sep 18 19:40:05 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
  * Clean up and refactor in SimplUtils.mkCase1 (identity case)
  Wed Sep  6 07:42:45 EDT 2006  simonpj@microsoft.com
    * Clean up and refactor in SimplUtils.mkCase1 (identity case)

diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs
index 32402b2..cd610a9 100644 (file)
--- a/compiler/simplCore/SimplUtils.lhs
+++ b/compiler/simplCore/SimplUtils.lhs
@@ -1462,36 +1462,31 @@ mkCase1 scrut case_bndr ty [(con,bndrs,rhs)]
 mkCase1 scrut case_bndr ty alts        -- Identity case
   | all identity_alt alts
   = tick (CaseIdentity case_bndr)              `thenSmpl_`
-    returnSmpl (re_note scrut)
+    returnSmpl (re_cast scrut)
   where
-    identity_alt (con, args, rhs) = de_note rhs `cheapEqExpr` identity_rhs con args
+    identity_alt (con, args, rhs) = de_cast rhs `cheapEqExpr` mk_id_rhs con args
 
-    identity_rhs (DataAlt con) args
-      | isClosedNewTyCon (dataConTyCon con) 
-      = wrapNewTypeBody (dataConTyCon con) arg_tys (varToCoreExpr $ head args)
-      | otherwise
-      = mkConApp con (arg_ty_exprs ++ varsToCoreExprs args)
-    identity_rhs (LitAlt lit)  _    = Lit lit
-    identity_rhs DEFAULT       _    = Var case_bndr
+    mk_id_rhs (DataAlt con) args = mkConApp con (arg_tys ++ varsToCoreExprs args)
+    mk_id_rhs (LitAlt lit)  _    = Lit lit
+    mk_id_rhs DEFAULT       _    = Var case_bndr
 
-    arg_tys = (tyConAppArgs (idType case_bndr))
-    arg_ty_exprs = map Type arg_tys
+    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 _ _)) -> 
-                            let co = mkUnsafeCoercion (idType case_bndr) (exprType rhs1) in 
-                               -- this unsafeCoercion is bad, make this better
-                            mkCoerce co scrut
-                       other                 -> scrut
+       --      case e of x { _ -> x `cast` c }
+       -- And we definitely want to eliminate this case, to give
+       --      e `cast` c
+       -- So we throw away the cast from the RHS, and reconstruct
+       -- it at the other end.  All the RHS casts must be the same
+       -- if (all identity_alt alts) holds.
+       -- 
+       -- Don't worry about nested casts, because the simplifier combines them
+    de_cast (Cast e _) = e
+    de_cast e         = e
+
+    re_cast scrut = case head alts of
+                       (_,_,Cast _ co) -> Cast scrut co
+                       other           -> scrut