-hasCafRefs :: (Id -> Bool) -> CoreExpr -> CafInfo
-hasCafRefss :: (Id -> Bool) -> [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 = if isCAF expr || isFastTrue (cafRefs p expr)
- then MayHaveCafRefs
- else 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 = if any isCAF exprs || isFastTrue (cafRefss p exprs)
- then MayHaveCafRefs
- else NoCafRefs
-
-cafRefs p (Var id)
- | p id
- = case idCafInfo id of
- NoCafRefs -> fastBool False
- MayHaveCafRefs -> fastBool True
- | otherwise
- = fastBool False
-
-cafRefs p (Lit l) = fastBool False
-cafRefs p (App f a) = cafRefs p f `fastOr` cafRefs p a
-cafRefs p (Lam x e) = cafRefs p e
-cafRefs p (Let b e) = cafRefss p (rhssOfBind b) `fastOr` cafRefs p e
-cafRefs p (Case e bndr alts) = cafRefs p e `fastOr` 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) = cafRefs p e `fastOr` cafRefss p es
-
--- Decide whether a closure looks like a CAF or not. In an effort to
--- keep the number of CAFs (and hence the size of the SRTs) down, we
--- would also like to look at the expression and decide whether it
--- requires a small bounded amount of heap, so we can ignore it as a
--- CAF. In these cases however, we would need to use an additional
--- CAF list to keep track of non-collectable CAFs.
-
--- We mark real CAFs as `MayHaveCafRefs' because this information is
--- used to decide whether a particular closure needs to be referenced
--- in an SRT or not.
-
-isCAF :: CoreExpr -> Bool
-isCAF e = not (rhsIsNonUpd e)
- {- ToDo: check type for onceness, i.e. non-updatable thunks? -}
-
-rhsIsNonUpd :: CoreExpr -> Bool -- True => Value-lambda, constructor, PAP
-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 = idAppIsNonUpd f n_args
-
- go (App f a) n_args
- | isTypeArg a = go f n_args
- | otherwise = go f (n_args + 1)
-
- go (Note (SCC _) f) n_args = False
- go (Note _ f) n_args = go f n_args
-
- go other n_args = False
-
-idAppIsNonUpd :: Id -> Int -> Bool
-idAppIsNonUpd id n_val_args
- = case idFlavour id of
- DataConId _ -> True
- other -> n_val_args < idArity id
-
--- We consider partial applications to be non-updatable. NOTE: this
--- must match how CoreToStg marks the closure.