-hasCafRefs :: IdEnv HowBound -> CoreExpr -> CafInfo
--- Only called for the RHS of top-level lets
-hasCafRefss :: IdEnv HowBound -> [CoreExpr] -> CafInfo
- -- predicate returns True for a given Id if we look at this Id when
- -- calculating the result. Used to *avoid* looking at the CafInfo
- -- field for an Id that is part of the current recursive group.
-
-hasCafRefs p expr
- | isCAF expr || isFastTrue (cafRefs p expr) = MayHaveCafRefs
- | otherwise = NoCafRefs
-
- -- used for recursive groups. The whole group is set to
- -- "MayHaveCafRefs" if at least one of the group is a CAF or
- -- refers to any CAFs.
-hasCafRefss p exprs
- | any isCAF exprs || isFastTrue (cafRefss p exprs) = MayHaveCafRefs
- | otherwise = NoCafRefs
-
--- 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))
-
-isCAF :: CoreExpr -> Bool
--- Only called for the RHS of top-level lets
-isCAF e = not (rhsIsNonUpd e)
- {- ToDo: check type for onceness, i.e. non-updatable thunks? -}
-
-
-rhsIsNonUpd :: 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 (Lam b e) = isRuntimeVar b || rhsIsNonUpd e
-rhsIsNonUpd (Note (SCC _) e) = False
-rhsIsNonUpd (Note _ e) = rhsIsNonUpd e
-rhsIsNonUpd other_expr
- = go other_expr 0 []
- where
- go (Var f) n_args args = idAppIsNonUpd 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 :: Id -> Int -> [CoreExpr] -> Bool
-idAppIsNonUpd id n_val_args args
- | Just con <- isDataConId_maybe id = not (isCrossDllConApp con args)
- | otherwise = n_val_args < idArity id
-
-isCrossDllConApp :: DataCon -> [CoreExpr] -> Bool
-isCrossDllConApp con args = isDllName (dataConName con) || any isCrossDllArg args
--- Top-level constructor applications can usually be allocated
--- statically, but they can't if
--- a) the constructor, or any of the arguments, come from another DLL
--- b) any of the arguments are LitLits
--- (because we can't refer to static labels in other DLLs).
--- If this happens we simply make the RHS into an updatable thunk,
--- and 'exectute' it rather than allocating it statically.
--- All this should match the decision in (see CoreToStg.coreToStgRhs)
-
-
-isCrossDllArg :: CoreExpr -> Bool
--- True if somewhere in the expression there's a cross-DLL reference
-isCrossDllArg (Type _) = False
-isCrossDllArg (Var v) = isDllName (idName v)
-isCrossDllArg (Note _ e) = isCrossDllArg e
-isCrossDllArg (Lit lit) = isLitLitLit lit
-isCrossDllArg (App e1 e2) = isCrossDllArg e1 || isCrossDllArg e2 -- must be a type app
-isCrossDllArg (Lam v e) = isCrossDllArg e -- must be a type lam