From 914ee4b06bd8bcf4abd60b98baeacca86223257c Mon Sep 17 00:00:00 2001 From: Michal Terepeta Date: Sun, 8 Apr 2012 12:30:06 +0200 Subject: [PATCH 3/3] Add a missing mapping when doing CSE. In situations where CSE transforms let x = into let x = y we want to add a mapping x |-> y. --- compiler/simplCore/CSE.lhs | 15 +++++++++++++-- 1 files changed, 13 insertions(+), 2 deletions(-) diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs index afa43c0..94c7c31 100644 --- a/compiler/simplCore/CSE.lhs +++ b/compiler/simplCore/CSE.lhs @@ -193,8 +193,19 @@ cseBind env (Rec pairs) cseRhs :: CSEnv -> (OutBndr, InExpr) -> (CSEnv, OutExpr) cseRhs env (id',rhs) = case lookupCSEnv env rhs' of - Just other_expr -> (env, other_expr) - Nothing -> (addCSEnvItem env rhs' (Var id'), rhs') + -- Since now we have something like + -- let x = y + -- we want to add a mapping x |-> y + Just var@(Var id'') -> (extendCSSubst env id' id'', var) + + -- This shouldn't be possible -- we only insert mappings to variables or + -- to unboxed tuples, but an unboxed tuple cannot be the RHS of a let. + Just expr -> WARN( True, text "CSE.cseRhs: unexpected result of lookup:" + <+> ppr rhs' <+> text "|->" <+> ppr expr + <+> text "in RHS of" <+> ppr id' ) + (env, expr) + + Nothing -> (addCSEnvItem env rhs' (Var id'), rhs') where rhs' | isAlwaysActive (idInlineActivation id') = cseExpr env rhs | otherwise = rhs -- 1.7.8.5