Ticket #5996: 0003-Add-a-missing-mapping-when-doing-CSE.patch

File 0003-Add-a-missing-mapping-when-doing-CSE.patch, 1.6 KB (added by michalt, 3 years ago)
  • compiler/simplCore/CSE.lhs

    From 914ee4b06bd8bcf4abd60b98baeacca86223257c Mon Sep 17 00:00:00 2001
    From: Michal Terepeta <[email protected]>
    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 = <rhs>
    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 b cseBind env (Rec pairs) 
    193193cseRhs :: CSEnv -> (OutBndr, InExpr) -> (CSEnv, OutExpr) 
    194194cseRhs env (id',rhs) 
    195195  = case lookupCSEnv env rhs' of 
    196         Just other_expr     -> (env,                             other_expr) 
    197         Nothing             -> (addCSEnvItem env rhs' (Var id'), rhs') 
     196      -- Since now we have something like 
     197      --   let x = y 
     198      -- we want to add a mapping x |-> y 
     199      Just var@(Var id'') -> (extendCSSubst env id' id'', var) 
     200 
     201      -- This shouldn't be possible -- we only insert mappings to variables or 
     202      -- to unboxed tuples, but an unboxed tuple cannot be the RHS of a let. 
     203      Just expr -> WARN( True, text "CSE.cseRhs: unexpected result of lookup:" 
     204                         <+> ppr rhs' <+> text "|->" <+> ppr expr 
     205                         <+> text "in RHS of" <+> ppr id' ) 
     206                   (env, expr) 
     207 
     208      Nothing -> (addCSEnvItem env rhs' (Var id'), rhs') 
    198209  where 
    199210    rhs' | isAlwaysActive (idInlineActivation id') = cseExpr env rhs 
    200211         | otherwise                               = rhs