-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
-
--- cafRefs compiles to beautiful code :)
-
-cafRefs p (Var id)
- | isLocalId id = fastBool False
- | otherwise =
- case lookupVarEnv p id of
- Just (LetBound TopLevelHasCafs _ _) -> fastBool True
- Just (LetBound _ _ _) -> fastBool False
- Nothing -> fastBool (cgMayHaveCafRefs (idCgInfo id)) -- imported Ids
-
-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
-
-rhsIsNonUpd (Lam b e) = isId 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 (isDynConApp con args)
- | otherwise = n_val_args < idArity id
-
-isDynConApp :: DataCon -> [CoreExpr] -> Bool
-isDynConApp con args = isDllName (dataConName con) || any isDynArg 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)
-
-
-isDynArg :: CoreExpr -> Bool
-isDynArg (Var v) = isDllName (idName v)
-isDynArg (Note _ e) = isDynArg e
-isDynArg (Lit lit) = isLitLitLit lit
-isDynArg (App e _) = isDynArg e -- must be a type app
-isDynArg (Lam _ e) = isDynArg e -- must be a type lam