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, 3 years ago)
  • compiler/simplCore/CSE.lhs

    From 2d06839003fa6136ef6845b97060af2ed12eac6e Mon Sep 17 00:00:00 2001
    From: Michal Terepeta <[email protected]>
    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