Commit cfe92a8f authored by ian@well-typed.com's avatar ian@well-typed.com

Remove old representation of CSEnv; part of #5996

parent c0e4eefe
......@@ -30,9 +30,6 @@ module CoreUtils (
coreBindsSize, exprSize,
CoreStats(..), coreBindsStats,
-- * Hashing
hashExpr,
-- * Equality
cheapEqExpr, eqExpr, eqExprX,
......@@ -70,8 +67,6 @@ import Maybes
import Platform
import Util
import Pair
import Data.Word
import Data.Bits
import Data.List
\end{code}
......@@ -1517,81 +1512,6 @@ altSize (c,bs,e) = c `seq` bndrsSize bs + exprSize e
\end{code}
%************************************************************************
%* *
\subsection{Hashing}
%* *
%************************************************************************
\begin{code}
hashExpr :: CoreExpr -> Int
-- ^ Two expressions that hash to the same @Int@ may be equal (but may not be)
-- Two expressions that hash to the different Ints are definitely unequal.
--
-- The emphasis is on a crude, fast hash, rather than on high precision.
--
-- But unequal here means \"not identical\"; two alpha-equivalent
-- expressions may hash to the different Ints.
--
-- We must be careful that @\\x.x@ and @\\y.y@ map to the same hash code,
-- (at least if we want the above invariant to be true).
hashExpr e = fromIntegral (hash_expr (1,emptyVarEnv) e .&. 0x7fffffff)
-- UniqFM doesn't like negative Ints
type HashEnv = (Int, VarEnv Int) -- Hash code for bound variables
hash_expr :: HashEnv -> CoreExpr -> Word32
-- Word32, because we're expecting overflows here, and overflowing
-- signed types just isn't cool. In C it's even undefined.
hash_expr env (Tick _ e) = hash_expr env e
hash_expr env (Cast e _) = hash_expr env e
hash_expr env (Var v) = hashVar env v
hash_expr _ (Lit lit) = fromIntegral (hashLiteral lit)
hash_expr env (App f e) = hash_expr env f * fast_hash_expr env e
hash_expr env (Let (NonRec b r) e) = hash_expr (extend_env env b) e * fast_hash_expr env r
hash_expr env (Let (Rec ((b,_):_)) e) = hash_expr (extend_env env b) e
hash_expr _ (Let (Rec []) _) = panic "hash_expr: Let (Rec []) _"
hash_expr env (Case e _ _ _) = hash_expr env e
hash_expr env (Lam b e) = hash_expr (extend_env env b) e
hash_expr env (Coercion co) = fast_hash_co env co
hash_expr _ (Type _) = WARN(True, text "hash_expr: type") 1
-- Shouldn't happen. Better to use WARN than trace, because trace
-- prevents the CPR optimisation kicking in for hash_expr.
fast_hash_expr :: HashEnv -> CoreExpr -> Word32
fast_hash_expr env (Var v) = hashVar env v
fast_hash_expr env (Type t) = fast_hash_type env t
fast_hash_expr env (Coercion co) = fast_hash_co env co
fast_hash_expr _ (Lit lit) = fromIntegral (hashLiteral lit)
fast_hash_expr env (Cast e _) = fast_hash_expr env e
fast_hash_expr env (Tick _ e) = fast_hash_expr env e
fast_hash_expr env (App _ a) = fast_hash_expr env a -- A bit idiosyncratic ('a' not 'f')!
fast_hash_expr _ _ = 1
fast_hash_type :: HashEnv -> Type -> Word32
fast_hash_type env ty
| Just tv <- getTyVar_maybe ty = hashVar env tv
| Just (tc,tys) <- splitTyConApp_maybe ty = let hash_tc = fromIntegral (hashName (tyConName tc))
in foldr (\t n -> fast_hash_type env t + n) hash_tc tys
| otherwise = 1
fast_hash_co :: HashEnv -> Coercion -> Word32
fast_hash_co env co
| Just cv <- getCoVar_maybe co = hashVar env cv
| Just (tc,cos) <- splitTyConAppCo_maybe co = let hash_tc = fromIntegral (hashName (tyConName tc))
in foldr (\c n -> fast_hash_co env c + n) hash_tc cos
| otherwise = 1
extend_env :: HashEnv -> Var -> (Int, VarEnv Int)
extend_env (n,env) b = (n+1, extendVarEnv env b n)
hashVar :: HashEnv -> Var -> Word32
hashVar (_,env) v
= fromIntegral (lookupVarEnv env v `orElse` hashName (idName v))
\end{code}
%************************************************************************
%* *
Eta reduction
......
......@@ -8,23 +8,6 @@ module CSE (cseProgram) where
#include "HsVersions.h"
-- Note [Keep old CSEnv rep]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~
-- Temporarily retain code for the old representation for CSEnv
-- Keeping it only so that we can switch back if a bug shows up
-- or we want to do some performance comparisions
--
-- NB: when you remove this, also delete hashExpr from CoreUtils
#ifdef OLD_CSENV_REP
import CoreUtils ( exprIsBig, hashExpr, eqExpr )
import StaticFlags ( opt_PprStyle_Debug )
import Util ( lengthExceeds )
import UniqFM
import FastString
#else
import TrieMap
#endif
import CoreSubst
import Var ( Var )
import Id ( Id, idType, idInlineActivation, zapIdOccInfo )
......@@ -34,6 +17,7 @@ import Type ( tyConAppArgs )
import CoreSyn
import Outputable
import BasicTypes ( isAlwaysActive )
import TrieMap
import Data.List
\end{code}
......@@ -290,59 +274,6 @@ type OutExpr = CoreExpr -- Post-cloning
type OutBndr = CoreBndr
type OutAlt = CoreAlt
-- See Note [Keep old CsEnv rep]
#ifdef OLD_CSENV_REP
data CSEnv = CS { cs_map :: CSEMap
, cs_subst :: Subst }
type CSEMap = UniqFM [(OutExpr, OutExpr)] -- This is the reverse mapping
-- It maps the hash-code of an expression e to list of (e,e') pairs
-- This means that it's good to replace e by e'
-- INVARIANT: The expr in the range has already been CSE'd
emptyCSEnv :: CSEnv
emptyCSEnv = CS { cs_map = emptyUFM, cs_subst = emptySubst }
lookupCSEnv :: CSEnv -> OutExpr -> Maybe OutExpr
lookupCSEnv (CS { cs_map = oldmap, cs_subst = sub}) expr
= case lookupUFM oldmap (hashExpr expr) of
Nothing -> Nothing
Just pairs -> lookup_list pairs
where
in_scope = substInScope sub
-- In this lookup we use full expression equality
-- Reason: when expressions differ we generally find out quickly
-- but I found that cheapEqExpr was saying (\x.x) /= (\y.y),
-- and this kind of thing happened in real programs
lookup_list :: [(OutExpr,OutExpr)] -> Maybe OutExpr
lookup_list ((e,e'):es)
| eqExpr in_scope e expr = Just e'
| otherwise = lookup_list es
lookup_list [] = Nothing
addCSEnvItem :: CSEnv -> OutExpr -> OutExpr -> CSEnv
addCSEnvItem env expr expr' | exprIsBig expr = env
| otherwise = extendCSEnv env expr expr'
-- We don't try to CSE big expressions, because they are expensive to compare
-- (and are unlikely to be the same anyway)
extendCSEnv :: CSEnv -> OutExpr -> OutExpr -> CSEnv
extendCSEnv cse@(CS { cs_map = oldmap }) expr expr'
= cse { cs_map = addToUFM_C combine oldmap hash [(expr, expr')] }
where
hash = hashExpr expr
combine old new
= WARN( result `lengthExceeds` 4, short_msg $$ nest 2 long_msg ) result
where
result = new ++ old
short_msg = ptext (sLit "extendCSEnv: long list, length") <+> int (length result)
long_msg | opt_PprStyle_Debug = (text "hash code" <+> text (show hash)) $$ ppr result
| otherwise = empty
#else
------------ NEW ----------------
data CSEnv = CS { cs_map :: CoreMap (OutExpr, OutExpr) -- Key, value
, cs_subst :: Subst }
......@@ -366,7 +297,6 @@ addCSEnvItem = extendCSEnv
extendCSEnv :: CSEnv -> OutExpr -> OutExpr -> CSEnv
extendCSEnv cse expr expr'
= cse { cs_map = extendCoreMap (cs_map cse) expr (expr,expr') }
#endif
csEnvSubst :: CSEnv -> Subst
csEnvSubst = cs_subst
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment