%************************************************************************
\begin{code}
-hashName :: Name -> Int
-hashName name = getKey (nameUnique name)
+hashName :: Name -> Int -- ToDo: should really be Word
+hashName name = getKey (nameUnique name) + 1
+ -- The +1 avoids keys with lots of zeros in the ls bits, which
+ -- interacts badly with the cheap and cheerful multiplication in
+ -- hashExpr
\end{code}
fast_hash_type :: HashEnv -> Type -> Word32
fast_hash_type env ty
- | Just tv <- getTyVar_maybe ty = hashVar env tv
- | Just (tc,_) <- splitTyConApp_maybe ty
- = fromIntegral (hashName (tyConName tc))
- | otherwise = 1
+ | 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
extend_env :: HashEnv -> Var -> (Int, VarEnv Int)
extend_env (n,env) b = (n+1, extendVarEnv env b n)
= CS (addToUFM_C combine cs hash [(expr, expr')]) in_scope sub
where
hash = hashExpr expr
- combine old new = WARN( result `lengthExceeds` 4, text "extendCSEnv: long list:" <+> ppr result )
+ combine old new = WARN( result `lengthExceeds` 4, ((text "extendCSEnv: long list (length" <+> int (length result) <> comma
+ <+> text "hash code" <+> text (show hash) <> char ')')
+ $$ nest 4 (ppr result)) )
result
where
result = new ++ old