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