From 129e40f1ba90cdccee79009a33482dcfd537fd88 Mon Sep 17 00:00:00 2001 From: Manuel M T Chakravarty Date: Wed, 20 Sep 2006 18:47:12 +0000 Subject: [PATCH] Clean up and refactor in SimplUtils.mkCase1 (identity case) Mon Sep 18 19:40:05 EDT 2006 Manuel M T Chakravarty * 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) --- compiler/simplCore/SimplUtils.lhs | 45 +++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 25 deletions(-) diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs index 32402b2..cd610a9 100644 --- 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 -- 1.7.10.4