Fixes #952, as it turns out.
When compiling via C, we are at the mercy of C's undefined behaviour
with respect to overflow of signed integer operations, and this was
biting us here.
Perhaps we should always add the -fwrapv flag to gcc, but since
Haskell doesn't define overflow on Int either, it seemed the right
thing to do to fix this code anyway.
import FastString
import Maybes
import Util
import FastString
import Maybes
import Util
+import Data.Word
+import Data.Bits
import GHC.Exts -- For `xori`
\end{code}
import GHC.Exts -- For `xori`
\end{code}
-- 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)
-- 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 (1,emptyVarEnv) e) -- Negative numbers kill UniqFM
+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
type HashEnv = (Int, VarEnv Int) -- Hash code for bound variables
-hash_expr :: HashEnv -> CoreExpr -> Int
+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 (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 (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 (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,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 (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
+hash_expr env (Type t) = 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 env (Var v) = hashVar env v
fast_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 (Lit lit) = fromIntegral (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_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 :: HashEnv -> Type -> Word32
fast_hash_type env ty
| Just tv <- getTyVar_maybe ty = hashVar env tv
fast_hash_type env ty
| Just tv <- getTyVar_maybe ty = hashVar env tv
- | Just (tc,_) <- splitTyConApp_maybe ty = hashName (tyConName tc)
+ | Just (tc,_) <- splitTyConApp_maybe ty
+ = fromIntegral (hashName (tyConName tc))
| otherwise = 1
extend_env :: HashEnv -> Var -> (Int, VarEnv Int)
extend_env (n,env) b = (n+1, extendVarEnv env b n)
| 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)
+hashVar :: HashEnv -> Var -> Word32
+hashVar (_,env) v
+ = fromIntegral (lookupVarEnv env v `orElse` hashName (idName v))
\end{code}
%************************************************************************
\end{code}
%************************************************************************