Ticket #947: 0001-Don-t-CSE-things-with-recursive-type-constructors-94.patch

File 0001-Don-t-CSE-things-with-recursive-type-constructors-94.patch, 1.6 KB (added by michalt, 2 years ago)
  • compiler/simplCore/CSE.lhs

    From 2d06839003fa6136ef6845b97060af2ed12eac6e Mon Sep 17 00:00:00 2001
    From: Michal Terepeta <michal.terepeta@gmail.com>
    Date: Sun, 22 Apr 2012 21:45:47 +0200
    Subject: [PATCH] Don't CSE things with recursive type constructors (#947).
    
    ---
     compiler/simplCore/CSE.lhs |   13 +++++++++++--
     1 files changed, 11 insertions(+), 2 deletions(-)
    
    diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs
    index 94c7c31..affc932 100644
    a b import Var ( Var ) 
    1313import Id               ( Id, idType, idInlineActivation, zapIdOccInfo ) 
    1414import CoreUtils        ( mkAltExpr, exprIsTrivial, exprIsCheap ) 
    1515import DataCon          ( isUnboxedTupleCon ) 
    16 import Type             ( tyConAppArgs ) 
     16import Type             ( Type, tyConAppArgs, tyConAppTyCon_maybe ) 
     17import TyCon            ( isRecursiveTyCon ) 
    1718import CoreSyn 
    1819import Outputable 
    1920import BasicTypes       ( isAlwaysActive ) 
    addCSEnvItem = extendCSEnv 
    326327   -- of the trie. No need for a size test. 
    327328 
    328329extendCSEnv :: CSEnv -> OutExpr -> OutExpr -> CSEnv 
     330extendCSEnv cse expr expr'@(Var var') 
     331  | okToCse (idType var') 
     332  = cse { cs_map = extendCoreMap (cs_map cse) expr (expr, expr') } 
     333  | otherwise 
     334  = cse 
    329335extendCSEnv cse expr expr' 
    330   = cse { cs_map = extendCoreMap (cs_map cse) expr (expr,expr') } 
     336  = cse { cs_map = extendCoreMap (cs_map cse) expr (expr, expr') } 
     337 
     338okToCse :: Type -> Bool 
     339okToCse = maybe True (not . isRecursiveTyCon) . tyConAppTyCon_maybe 
    331340 
    332341csEnvSubst :: CSEnv -> Subst 
    333342csEnvSubst = cs_subst