Ticket #5996: 0002-Remove-old-representation-of-CSEnv.patch

File 0002-Remove-old-representation-of-CSEnv.patch, 8.8 KB (added by michalt, 3 years ago)
  • compiler/coreSyn/CoreUtils.lhs

    From 63a99dd8028ccd82eadb6fb83461aa19e687f130 Mon Sep 17 00:00:00 2001
    From: Michal Terepeta <[email protected]>
    Date: Sun, 11 Dec 2011 10:12:29 +0100
    Subject: [PATCH 2/3] Remove old representation of CSEnv.
    
    The old representation was kept only temporarily (in case of
    bugs with the new one). This also removes CoreUtils.hashExpr
    which was only used in the old representation of CSEnv.
    ---
     compiler/coreSyn/CoreUtils.lhs |   79 ----------------------------------------
     compiler/simplCore/CSE.lhs     |   72 +------------------------------------
     2 files changed, 1 insertions(+), 150 deletions(-)
    
    diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
    index df72778..b3bd7b5 100644
    a b module CoreUtils ( 
    3030        coreBindsSize, exprSize, 
    3131        CoreStats(..), coreBindsStats, 
    3232 
    33         -- * Hashing 
    34         hashExpr, 
    35  
    3633        -- * Equality 
    3734        cheapEqExpr, eqExpr, eqExprX, 
    3835 
    import FastString 
    6865import Maybes 
    6966import Util 
    7067import Pair 
    71 import Data.Word 
    72 import Data.Bits 
    7368import Data.List 
    7469\end{code} 
    7570 
    coStats :: Coercion -> CoreStats 
    14281423coStats co = zeroCS { cs_co = coercionSize co } 
    14291424\end{code} 
    14301425 
    1431 %************************************************************************ 
    1432 %*                                                                      * 
    1433 \subsection{Hashing} 
    1434 %*                                                                      * 
    1435 %************************************************************************ 
    1436  
    1437 \begin{code} 
    1438 hashExpr :: CoreExpr -> Int 
    1439 -- ^ Two expressions that hash to the same @Int@ may be equal (but may not be) 
    1440 -- Two expressions that hash to the different Ints are definitely unequal. 
    1441 -- 
    1442 -- The emphasis is on a crude, fast hash, rather than on high precision. 
    1443 -- 
    1444 -- But unequal here means \"not identical\"; two alpha-equivalent 
    1445 -- expressions may hash to the different Ints. 
    1446 -- 
    1447 -- We must be careful that @\\x.x@ and @\\y.y@ map to the same hash code, 
    1448 -- (at least if we want the above invariant to be true). 
    1449  
    1450 hashExpr e = fromIntegral (hash_expr (1,emptyVarEnv) e .&. 0x7fffffff) 
    1451              -- UniqFM doesn't like negative Ints 
    1452  
    1453 type HashEnv = (Int, VarEnv Int)  -- Hash code for bound variables 
    1454  
    1455 hash_expr :: HashEnv -> CoreExpr -> Word32 
    1456 -- Word32, because we're expecting overflows here, and overflowing 
    1457 -- signed types just isn't cool.  In C it's even undefined. 
    1458 hash_expr env (Tick _ e)              = hash_expr env e 
    1459 hash_expr env (Cast e _)              = hash_expr env e 
    1460 hash_expr env (Var v)                 = hashVar env v 
    1461 hash_expr _   (Lit lit)               = fromIntegral (hashLiteral lit) 
    1462 hash_expr env (App f e)               = hash_expr env f * fast_hash_expr env e 
    1463 hash_expr env (Let (NonRec b r) e)    = hash_expr (extend_env env b) e * fast_hash_expr env r 
    1464 hash_expr env (Let (Rec ((b,_):_)) e) = hash_expr (extend_env env b) e 
    1465 hash_expr _   (Let (Rec []) _)        = panic "hash_expr: Let (Rec []) _" 
    1466 hash_expr env (Case e _ _ _)          = hash_expr env e 
    1467 hash_expr env (Lam b e)               = hash_expr (extend_env env b) e 
    1468 hash_expr env (Coercion co)           = fast_hash_co env co 
    1469 hash_expr _   (Type _)                = WARN(True, text "hash_expr: type") 1 
    1470 -- Shouldn't happen.  Better to use WARN than trace, because trace 
    1471 -- prevents the CPR optimisation kicking in for hash_expr. 
    1472  
    1473 fast_hash_expr :: HashEnv -> CoreExpr -> Word32 
    1474 fast_hash_expr env (Var v)       = hashVar env v 
    1475 fast_hash_expr env (Type t)      = fast_hash_type env t 
    1476 fast_hash_expr env (Coercion co) = fast_hash_co env co 
    1477 fast_hash_expr _   (Lit lit)     = fromIntegral (hashLiteral lit) 
    1478 fast_hash_expr env (Cast e _)    = fast_hash_expr env e 
    1479 fast_hash_expr env (Tick _ e)    = fast_hash_expr env e 
    1480 fast_hash_expr env (App _ a)     = fast_hash_expr env a -- A bit idiosyncratic ('a' not 'f')! 
    1481 fast_hash_expr _   _             = 1 
    1482  
    1483 fast_hash_type :: HashEnv -> Type -> Word32 
    1484 fast_hash_type env ty 
    1485   | Just tv <- getTyVar_maybe ty            = hashVar env tv 
    1486   | Just (tc,tys) <- splitTyConApp_maybe ty = let hash_tc = fromIntegral (hashName (tyConName tc)) 
    1487                                               in foldr (\t n -> fast_hash_type env t + n) hash_tc tys 
    1488   | otherwise                               = 1 
    1489  
    1490 fast_hash_co :: HashEnv -> Coercion -> Word32 
    1491 fast_hash_co env co 
    1492   | Just cv <- getCoVar_maybe co              = hashVar env cv 
    1493   | Just (tc,cos) <- splitTyConAppCo_maybe co = let hash_tc = fromIntegral (hashName (tyConName tc)) 
    1494                                                 in foldr (\c n -> fast_hash_co env c + n) hash_tc cos 
    1495   | otherwise                                 = 1 
    1496  
    1497 extend_env :: HashEnv -> Var -> (Int, VarEnv Int) 
    1498 extend_env (n,env) b = (n+1, extendVarEnv env b n) 
    1499  
    1500 hashVar :: HashEnv -> Var -> Word32 
    1501 hashVar (_,env) v 
    1502  = fromIntegral (lookupVarEnv env v `orElse` hashName (idName v)) 
    1503 \end{code} 
    1504  
    15051426 
    15061427%************************************************************************ 
    15071428%*                                                                      * 
  • compiler/simplCore/CSE.lhs

    diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs
    index a1f6d8f..afa43c0 100644
    a b module CSE ( cseProgram ) where 
    88 
    99#include "HsVersions.h" 
    1010 
    11 -- Note [Keep old CSEnv rep] 
    12 -- ~~~~~~~~~~~~~~~~~~~~~~~~~ 
    13 -- Temporarily retain code for the old representation for CSEnv 
    14 -- Keeping it only so that we can switch back if a bug shows up 
    15 -- or we want to do some performance comparisions 
    16 -- 
    17 -- NB: when you remove this, also delete hashExpr from CoreUtils 
    18 #ifdef OLD_CSENV_REP 
    19 import CoreUtils        ( exprIsBig, hashExpr, eqExpr ) 
    20 import StaticFlags      ( opt_PprStyle_Debug ) 
    21 import Util             ( lengthExceeds ) 
    22 import UniqFM 
    23 import FastString 
    24 #else 
    25 import TrieMap 
    26 #endif 
    27  
    2811import CoreSubst 
    2912import Var              ( Var ) 
    3013import Id               ( Id, idType, idInlineActivation, zapIdOccInfo ) 
    import Type ( tyConAppArgs ) 
    3417import CoreSyn 
    3518import Outputable 
    3619import BasicTypes       ( isAlwaysActive ) 
     20import TrieMap 
    3721 
    3822import Data.List 
    3923\end{code} 
    type OutExpr = CoreExpr -- Post-cloning 
    310294type OutBndr  = CoreBndr 
    311295type OutAlt   = CoreAlt 
    312296 
    313 -- See Note [Keep old CsEnv rep] 
    314 #ifdef OLD_CSENV_REP 
    315 data CSEnv  = CS { cs_map    :: CSEMap 
    316                  , cs_subst  :: Subst } 
    317  
    318 type CSEMap = UniqFM [(OutExpr, OutExpr)]       -- This is the reverse mapping 
    319         -- It maps the hash-code of an expression e to list of (e,e') pairs 
    320         -- This means that it's good to replace e by e' 
    321         -- INVARIANT: The expr in the range has already been CSE'd 
    322  
    323 emptyCSEnv :: CSEnv 
    324 emptyCSEnv = CS { cs_map = emptyUFM, cs_subst = emptySubst } 
    325  
    326 lookupCSEnv :: CSEnv -> OutExpr -> Maybe OutExpr 
    327 lookupCSEnv (CS { cs_map = oldmap, cs_subst = sub}) expr 
    328   = case lookupUFM oldmap (hashExpr expr) of 
    329                 Nothing -> Nothing 
    330                 Just pairs -> lookup_list pairs 
    331   where 
    332     in_scope = substInScope sub 
    333  
    334   -- In this lookup we use full expression equality 
    335   -- Reason: when expressions differ we generally find out quickly 
    336   --         but I found that cheapEqExpr was saying (\x.x) /= (\y.y), 
    337   --         and this kind of thing happened in real programs 
    338     lookup_list :: [(OutExpr,OutExpr)] -> Maybe OutExpr 
    339     lookup_list ((e,e'):es) 
    340       | eqExpr in_scope e expr = Just e' 
    341       | otherwise                        = lookup_list es 
    342     lookup_list []                       = Nothing 
    343  
    344 addCSEnvItem :: CSEnv -> OutExpr -> OutExpr -> CSEnv 
    345 addCSEnvItem env expr expr' | exprIsBig expr = env 
    346                             | otherwise      = extendCSEnv env expr expr' 
    347    -- We don't try to CSE big expressions, because they are expensive to compare 
    348    -- (and are unlikely to be the same anyway) 
    349  
    350 extendCSEnv :: CSEnv -> OutExpr -> OutExpr -> CSEnv 
    351 extendCSEnv cse@(CS { cs_map = oldmap }) expr expr' 
    352   = cse { cs_map = addToUFM_C combine oldmap hash [(expr, expr')] } 
    353   where 
    354     hash = hashExpr expr 
    355     combine old new 
    356         = WARN( result `lengthExceeds` 4, short_msg $$ nest 2 long_msg ) result 
    357         where 
    358           result = new ++ old 
    359           short_msg = ptext (sLit "extendCSEnv: long list, length") <+> int (length result) 
    360           long_msg | opt_PprStyle_Debug = (text "hash code" <+> text (show hash)) $$ ppr result 
    361                    | otherwise          = empty 
    362  
    363 #else 
    364 ------------ NEW ---------------- 
    365  
    366297data CSEnv  = CS { cs_map    :: CoreMap (OutExpr, OutExpr)   -- Key, value 
    367298                 , cs_subst  :: Subst } 
    368299 
    addCSEnvItem = extendCSEnv 
    386317extendCSEnv :: CSEnv -> OutExpr -> OutExpr -> CSEnv 
    387318extendCSEnv cse expr expr' 
    388319  = cse { cs_map = extendCoreMap (cs_map cse) expr (expr,expr') } 
    389 #endif 
    390320 
    391321csEnvSubst :: CSEnv -> Subst 
    392322csEnvSubst = cs_subst