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