-hasCafRefs :: IdEnv HowBound -> CoreExpr -> (CafInfo, UpdateFlag)
-hasCafRefs p expr
- | is_caf || mentions_cafs = (MayHaveCafRefs, upd_flag)
- | otherwise = (NoCafRefs, ReEntrant)
- where
- mentions_cafs = isFastTrue (cafRefs p expr)
- is_caf = not (rhsIsNonUpd p expr)
- upd_flag | is_caf = Updatable
- | otherwise = ReEntrant
-
--- The environment that cafRefs uses has top-level bindings *only*.
--- We don't bother to add local bindings as cafRefs traverses the expression
--- because they will all be for LocalIds (all nested things are LocalIds)
--- However, we must look in the env first, because some top level things
--- might be local Ids
-
-cafRefs p (Var id)
- = case lookupVarEnv p id of
- Just (LetBound (TopLet caf_info) _) -> fastBool (mayHaveCafRefs caf_info)
- Nothing | isGlobalId id -> fastBool (mayHaveCafRefs (idCafInfo id)) -- Imported
- | otherwise -> fastBool False -- Nested binder
- _other -> error ("cafRefs " ++ showSDoc (ppr id)) -- No nested things in env
-
-cafRefs p (Lit l) = fastBool False
-cafRefs p (App f a) = fastOr (cafRefs p f) (cafRefs p) a
-cafRefs p (Lam x e) = cafRefs p e
-cafRefs p (Let b e) = fastOr (cafRefss p (rhssOfBind b)) (cafRefs p) e
-cafRefs p (Case e bndr alts) = fastOr (cafRefs p e) (cafRefss p) (rhssOfAlts alts)
-cafRefs p (Note n e) = cafRefs p e
-cafRefs p (Type t) = fastBool False
-
-cafRefss p [] = fastBool False
-cafRefss p (e:es) = fastOr (cafRefs p e) (cafRefss p) es
-
--- hack for lazy-or over FastBool.
-fastOr a f x = fastBool (isFastTrue a || isFastTrue (f x))
-
-
-rhsIsNonUpd :: IdEnv HowBound -> CoreExpr -> Bool
- -- True => Value-lambda, constructor, PAP
- -- This is a bit like CoreUtils.exprIsValue, with the following differences:
- -- a) scc "foo" (\x -> ...) is updatable (so we catch the right SCC)
- --
- -- b) (C x xs), where C is a contructors is updatable if the application is
- -- dynamic: see isDynConApp
- --
- -- c) don't look through unfolding of f in (f x). I'm suspicious of this one
-
--- This function has to line up with what the update flag
--- for the StgRhs gets set to in mkStgRhs (above)
---
--- When opt_RuntimeTypes is on, we keep type lambdas and treat
--- them as making the RHS re-entrant (non-updatable).
-rhsIsNonUpd p (Lam b e) = isRuntimeVar b || rhsIsNonUpd p e
-rhsIsNonUpd p (Note (SCC _) e) = False
-rhsIsNonUpd p (Note _ e) = rhsIsNonUpd p e
-rhsIsNonUpd p other_expr
- = go other_expr 0 []
- where
- go (Var f) n_args args = idAppIsNonUpd p f n_args args
-
- go (App f a) n_args args
- | isTypeArg a = go f n_args args
- | otherwise = go f (n_args + 1) (a:args)
-
- go (Note (SCC _) f) n_args args = False
- go (Note _ f) n_args args = go f n_args args
-
- go other n_args args = False
-
-idAppIsNonUpd :: IdEnv HowBound -> Id -> Int -> [CoreExpr] -> Bool
-idAppIsNonUpd p id n_val_args args
- | Just con <- isDataConWorkId_maybe id = not (isCrossDllConApp con args)
- | otherwise = False -- SDM: disbled. See comment with isPAP above.
- -- n_val_args < stgArity id (lookupBinding p id)
-