import DynFlags
import TysPrim
import FastString
+import Maybes
import Util
import GHC.Exts -- For `xori`
exprOkForSpeculation :: CoreExpr -> Bool
exprOkForSpeculation (Lit _) = True
exprOkForSpeculation (Type _) = True
+ -- Tick boxes are *not* suitable for speculation
exprOkForSpeculation (Var v) = isUnLiftedType (idType v)
+ && not (isTickBoxOp v)
exprOkForSpeculation (Note _ e) = exprOkForSpeculation e
exprOkForSpeculation (Cast e co) = exprOkForSpeculation e
exprOkForSpeculation other_expr
Just (dc, map Type to_tc_arg_tys ++ ex_args ++ new_co_args ++ new_val_args)
}}
+{-
-- We do not want to tell the world that we have a
-- Cons, to *stop* Case of Known Cons, which removes
-- the TickBox.
= Nothing
exprIsConApp_maybe (Note (BinaryTickBox {}) expr)
= Nothing
+-}
exprIsConApp_maybe (Note _ expr)
= exprIsConApp_maybe expr
go (Var v) = idArity v
go (Lam x e) | isId x = go e + 1
| otherwise = go e
- go (Note (TickBox {}) _) = 0
- go (Note (BinaryTickBox {}) _)
- = 0
go (Note n e) = go e
go (Cast e _) = go e
go (App e (Type t)) = go e
noteSize (SCC cc) = cc `seq` 1
noteSize InlineMe = 1
noteSize (CoreNote s) = s `seq` 1 -- hdaume: core annotations
-noteSize (TickBox m n) = m `seq` n `seq` 1
-noteSize (BinaryTickBox m t e) = m `seq` t `seq` e `seq` 1
-
+
varSize :: Var -> Int
varSize b | isTyVar b = 1
| otherwise = seqType (idType b) `seq`
-- 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}
%************************************************************************
is_static False (Lam b e) = isRuntimeVar b || is_static False e
is_static in_arg (Note (SCC _) e) = False
- is_static in_arg (Note (TickBox {}) e) = False
- is_static in_arg (Note (BinaryTickBox {}) e) = False
is_static in_arg (Note _ e) = is_static in_arg e
is_static in_arg (Cast e co) = is_static in_arg e