X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreUtils.lhs;h=78da0e37faff422d182710bb9cb7ac9452a27ab5;hp=146f8cfd736236df6c3299bd199c0984fb6753a8;hb=9ba6b0315f3719a2e8b85b78f84d0b5601490739;hpb=74dec3f606015445eff19f40a3cd0fd4be88492d

diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index 146f8cf..78da0e3 100644
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -69,6 +69,7 @@ import Outputable
 import DynFlags
 import TysPrim
 import FastString
+import Maybes
 import Util
 
 import GHC.Exts		-- For `xori` 
@@ -1351,32 +1352,48 @@ hashExpr :: CoreExpr -> Int
 -- expressions may hash to the different Ints
 --
 -- The emphasis is on a crude, fast hash, rather than on high precision
+--
+-- 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 | hash < 0  = 77	-- Just in case we hit -maxInt
 	   | otherwise = hash
 	   where
-	     hash = abs (hash_expr e)	-- Negative numbers kill UniqFM
-
-hash_expr (Note _ e)   		  = hash_expr e
-hash_expr (Cast e co)             = hash_expr e
-hash_expr (Let (NonRec b r) e)    = hashId b
-hash_expr (Let (Rec ((b,r):_)) e) = hashId b
-hash_expr (Case _ b _ _)	  = hashId b
-hash_expr (App f e)   		  = hash_expr f * fast_hash_expr e
-hash_expr (Var v)     		  = hashId v
-hash_expr (Lit lit)	   	  = hashLiteral lit
-hash_expr (Lam b _)	          = hashId b
-hash_expr (Type t)	          = trace "hash_expr: type" 1		-- Shouldn't happen
-
-fast_hash_expr (Var v)     	= hashId v
-fast_hash_expr (Lit lit)	= hashLiteral lit
-fast_hash_expr (App f (Type _)) = fast_hash_expr f
-fast_hash_expr (App f a)        = fast_hash_expr a
-fast_hash_expr (Lam b _)        = hashId b
-fast_hash_expr other	        = 1
-
-hashId :: Id -> Int
-hashId id = hashName (idName id)
+	     hash = abs (hash_expr (1,emptyVarEnv) e)	-- Negative numbers kill UniqFM
+
+type HashEnv = (Int, VarEnv Int)	-- Hash code for bound variables
+
+hash_expr :: HashEnv -> CoreExpr -> Int
+hash_expr env (Note _ e)   	      = hash_expr env e
+hash_expr env (Cast e co)             = hash_expr env e
+hash_expr env (Var v)     	      = hashVar env v
+hash_expr env (Lit lit)		      = 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,r):_)) e) = hash_expr (extend_env env b) e
+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 (Type t)	              = fast_hash_type env t
+
+fast_hash_expr env (Var v)     	= hashVar env v
+fast_hash_expr env (Type t)	= fast_hash_type env t
+fast_hash_expr env (Lit lit)	= hashLiteral lit
+fast_hash_expr env (Cast e co)  = fast_hash_expr env e
+fast_hash_expr env (Note n e)   = fast_hash_expr env e
+fast_hash_expr env (App f a)    = fast_hash_expr env a	-- A bit idiosyncratic ('a' not 'f')!
+fast_hash_expr env other        = 1
+
+fast_hash_type :: HashEnv -> Type -> Int
+fast_hash_type env ty 
+  | Just tv <- getTyVar_maybe ty          = hashVar env tv
+  | Just (tc,_) <- splitTyConApp_maybe ty = hashName (tyConName tc)
+  | otherwise				  = 1
+
+extend_env :: HashEnv -> Var -> (Int, VarEnv Int)
+extend_env (n,env) b = (n+1, extendVarEnv env b n)
+
+hashVar :: HashEnv -> Var -> Int
+hashVar (_,env) v = lookupVarEnv env v `orElse` hashName (idName v)
 \end{code}
 
 %************************************************************************