Ticket #5996: 0002RemoveoldrepresentationofCSEnv.patch
File 0002RemoveoldrepresentationofCSEnv.patch, 8.8 KB (added by michalt, 4 years ago) 


compiler/coreSyn/CoreUtils.lhs
From 63a99dd8028ccd82eadb6fb83461aa19e687f130 Mon Sep 17 00:00:00 2001 From: Michal Terepeta <michal.terepeta@gmail.com> 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 ( 30 30 coreBindsSize, exprSize, 31 31 CoreStats(..), coreBindsStats, 32 32 33  * Hashing34 hashExpr,35 36 33  * Equality 37 34 cheapEqExpr, eqExpr, eqExprX, 38 35 … … import FastString 68 65 import Maybes 69 66 import Util 70 67 import Pair 71 import Data.Word72 import Data.Bits73 68 import Data.List 74 69 \end{code} 75 70 … … coStats :: Coercion > CoreStats 1428 1423 coStats co = zeroCS { cs_co = coercionSize co } 1429 1424 \end{code} 1430 1425 1431 %************************************************************************1432 %* *1433 \subsection{Hashing}1434 %* *1435 %************************************************************************1436 1437 \begin{code}1438 hashExpr :: CoreExpr > Int1439  ^ 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 alphaequivalent1445  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 Ints1452 1453 type HashEnv = (Int, VarEnv Int)  Hash code for bound variables1454 1455 hash_expr :: HashEnv > CoreExpr > Word321456  Word32, because we're expecting overflows here, and overflowing1457  signed types just isn't cool. In C it's even undefined.1458 hash_expr env (Tick _ e) = hash_expr env e1459 hash_expr env (Cast e _) = hash_expr env e1460 hash_expr env (Var v) = hashVar env v1461 hash_expr _ (Lit lit) = fromIntegral (hashLiteral lit)1462 hash_expr env (App f e) = hash_expr env f * fast_hash_expr env e1463 hash_expr env (Let (NonRec b r) e) = hash_expr (extend_env env b) e * fast_hash_expr env r1464 hash_expr env (Let (Rec ((b,_):_)) e) = hash_expr (extend_env env b) e1465 hash_expr _ (Let (Rec []) _) = panic "hash_expr: Let (Rec []) _"1466 hash_expr env (Case e _ _ _) = hash_expr env e1467 hash_expr env (Lam b e) = hash_expr (extend_env env b) e1468 hash_expr env (Coercion co) = fast_hash_co env co1469 hash_expr _ (Type _) = WARN(True, text "hash_expr: type") 11470  Shouldn't happen. Better to use WARN than trace, because trace1471  prevents the CPR optimisation kicking in for hash_expr.1472 1473 fast_hash_expr :: HashEnv > CoreExpr > Word321474 fast_hash_expr env (Var v) = hashVar env v1475 fast_hash_expr env (Type t) = fast_hash_type env t1476 fast_hash_expr env (Coercion co) = fast_hash_co env co1477 fast_hash_expr _ (Lit lit) = fromIntegral (hashLiteral lit)1478 fast_hash_expr env (Cast e _) = fast_hash_expr env e1479 fast_hash_expr env (Tick _ e) = fast_hash_expr env e1480 fast_hash_expr env (App _ a) = fast_hash_expr env a  A bit idiosyncratic ('a' not 'f')!1481 fast_hash_expr _ _ = 11482 1483 fast_hash_type :: HashEnv > Type > Word321484 fast_hash_type env ty1485  Just tv < getTyVar_maybe ty = hashVar env tv1486  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 tys1488  otherwise = 11489 1490 fast_hash_co :: HashEnv > Coercion > Word321491 fast_hash_co env co1492  Just cv < getCoVar_maybe co = hashVar env cv1493  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 cos1495  otherwise = 11496 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 > Word321501 hashVar (_,env) v1502 = fromIntegral (lookupVarEnv env v `orElse` hashName (idName v))1503 \end{code}1504 1505 1426 1506 1427 %************************************************************************ 1507 1428 %* * 
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 8 8 9 9 #include "HsVersions.h" 10 10 11  Note [Keep old CSEnv rep]12  ~~~~~~~~~~~~~~~~~~~~~~~~~13  Temporarily retain code for the old representation for CSEnv14  Keeping it only so that we can switch back if a bug shows up15  or we want to do some performance comparisions16 17  NB: when you remove this, also delete hashExpr from CoreUtils18 #ifdef OLD_CSENV_REP19 import CoreUtils ( exprIsBig, hashExpr, eqExpr )20 import StaticFlags ( opt_PprStyle_Debug )21 import Util ( lengthExceeds )22 import UniqFM23 import FastString24 #else25 import TrieMap26 #endif27 28 11 import CoreSubst 29 12 import Var ( Var ) 30 13 import Id ( Id, idType, idInlineActivation, zapIdOccInfo ) … … import Type ( tyConAppArgs ) 34 17 import CoreSyn 35 18 import Outputable 36 19 import BasicTypes ( isAlwaysActive ) 20 import TrieMap 37 21 38 22 import Data.List 39 23 \end{code} … … type OutExpr = CoreExpr  Postcloning 310 294 type OutBndr = CoreBndr 311 295 type OutAlt = CoreAlt 312 296 313  See Note [Keep old CsEnv rep]314 #ifdef OLD_CSENV_REP315 data CSEnv = CS { cs_map :: CSEMap316 , cs_subst :: Subst }317 318 type CSEMap = UniqFM [(OutExpr, OutExpr)]  This is the reverse mapping319  It maps the hashcode of an expression e to list of (e,e') pairs320  This means that it's good to replace e by e'321  INVARIANT: The expr in the range has already been CSE'd322 323 emptyCSEnv :: CSEnv324 emptyCSEnv = CS { cs_map = emptyUFM, cs_subst = emptySubst }325 326 lookupCSEnv :: CSEnv > OutExpr > Maybe OutExpr327 lookupCSEnv (CS { cs_map = oldmap, cs_subst = sub}) expr328 = case lookupUFM oldmap (hashExpr expr) of329 Nothing > Nothing330 Just pairs > lookup_list pairs331 where332 in_scope = substInScope sub333 334  In this lookup we use full expression equality335  Reason: when expressions differ we generally find out quickly336  but I found that cheapEqExpr was saying (\x.x) /= (\y.y),337  and this kind of thing happened in real programs338 lookup_list :: [(OutExpr,OutExpr)] > Maybe OutExpr339 lookup_list ((e,e'):es)340  eqExpr in_scope e expr = Just e'341  otherwise = lookup_list es342 lookup_list [] = Nothing343 344 addCSEnvItem :: CSEnv > OutExpr > OutExpr > CSEnv345 addCSEnvItem env expr expr'  exprIsBig expr = env346  otherwise = extendCSEnv env expr expr'347  We don't try to CSE big expressions, because they are expensive to compare348  (and are unlikely to be the same anyway)349 350 extendCSEnv :: CSEnv > OutExpr > OutExpr > CSEnv351 extendCSEnv cse@(CS { cs_map = oldmap }) expr expr'352 = cse { cs_map = addToUFM_C combine oldmap hash [(expr, expr')] }353 where354 hash = hashExpr expr355 combine old new356 = WARN( result `lengthExceeds` 4, short_msg $$ nest 2 long_msg ) result357 where358 result = new ++ old359 short_msg = ptext (sLit "extendCSEnv: long list, length") <+> int (length result)360 long_msg  opt_PprStyle_Debug = (text "hash code" <+> text (show hash)) $$ ppr result361  otherwise = empty362 363 #else364  NEW 365 366 297 data CSEnv = CS { cs_map :: CoreMap (OutExpr, OutExpr)  Key, value 367 298 , cs_subst :: Subst } 368 299 … … addCSEnvItem = extendCSEnv 386 317 extendCSEnv :: CSEnv > OutExpr > OutExpr > CSEnv 387 318 extendCSEnv cse expr expr' 388 319 = cse { cs_map = extendCoreMap (cs_map cse) expr (expr,expr') } 389 #endif390 320 391 321 csEnvSubst :: CSEnv > Subst 392 322 csEnvSubst = cs_subst