Remove old representation of CSEnv; part of #5996

2 files changed, 1 insertions, 151 deletions

diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index 3cdf2a6d5c..00f704f7c8 100644
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -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}
 
@@ -1519,81 +1514,6 @@ altSize (c,bs,e) = c `seq` bndrsSize bs + exprSize e
 
 %************************************************************************
 %*                                                                      *
-\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
 %*                                                                      *
 %************************************************************************
diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs
index 2f92708de2..1d9ef45f7f 100644
--- a/compiler/simplCore/CSE.lhs
+++ b/compiler/simplCore/CSE.lhs
@@ -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