import CoreUtils ( exprIsTrivial, isDefaultAlt )
import Id ( isDataConWorkId, isOneShotBndr, setOneShotLambda,
idOccInfo, setIdOccInfo, isLocalId,
- isExportedId, idArity, idSpecialisation,
+ isExportedId, idArity, idHasRules,
idType, idUnique, Id
)
-import IdInfo ( isEmptySpecInfo )
import BasicTypes ( OccInfo(..), isOneOcc, InterestingCxt )
import VarSet
| inlineCandidate bndr rhs = 2 -- Likely to be inlined
- | not (isEmptySpecInfo (idSpecialisation bndr)) = 1
+ | idHasRules bndr = 1
-- Avoid things with specialisations; we'd like
-- to take advantage of them in the subsequent bindings
is_one_shot b = isId b && isOneShotBndr b
occAnal env (Case scrut bndr ty alts)
- = case occ_anal_scrut scrut alts of { (scrut_usage, scrut') ->
- case mapAndUnzip (occAnalAlt env bndr) alts of { (alts_usage_s, alts') ->
+ = case occ_anal_scrut scrut alts of { (scrut_usage, scrut') ->
+ case mapAndUnzip (occAnalAlt alt_env bndr) alts of { (alts_usage_s, alts') ->
let
alts_usage = foldr1 combineAltsUsageDetails alts_usage_s
alts_usage' = addCaseBndrUsage alts_usage
Nothing -> usage
Just occ -> extendVarEnv usage bndr (markMany occ)
+ alt_env = setVanillaCtxt env
+ -- Consider x = case v of { True -> (p,q); ... }
+ -- Then it's fine to inline p and q
+
occ_anal_scrut (Var v) (alt1 : other_alts)
| not (null other_alts) || not (isDefaultAlt alt1)
= (mkOneOcc env v True, Var v)
the "build hack" to work.
\begin{code}
--- Hack for build, fold, runST
occAnalApp env (Var fun, args) is_rhs
= case args_stuff of { (args_uds, args') ->
let
where
fun_uniq = idUnique fun
fun_uds = mkOneOcc env fun (valArgCount args > 0)
+
+ -- Hack for build, fold, runST
args_stuff | fun_uniq == buildIdKey = appSpecial env 2 [True,True] args
| fun_uniq == augmentIdKey = appSpecial env 2 [True,True] args
| fun_uniq == foldrIdKey = appSpecial env 3 [False,True] args
If e turns out to be (e1,e2) we indeed get something like
let a = e1; b = e2; x = (a,b) in rhs
+Note [Aug 06]: I don't think this is necessary any more, and it helpe
+ to know when binders are unused. See esp the call to
+ isDeadBinder in Simplify.mkDupableAlt
+
\begin{code}
occAnalAlt env case_bndr (con, bndrs, rhs)
= case occAnal env rhs of { (rhs_usage, rhs') ->
let
(final_usage, tagged_bndrs) = tagBinders rhs_usage bndrs
+ final_bndrs = tagged_bndrs -- See Note [Aug06] above
+{-
final_bndrs | case_bndr `elemVarEnv` final_usage = bndrs
| otherwise = tagged_bndrs
-- Leave the binders untagged if the case
-- binder occurs at all; see note above
+-}
in
(final_usage, (con, final_bndrs, rhs')) }
\end{code}
isRhsEnv (OccEnv OccRhs _) = True
isRhsEnv (OccEnv OccVanilla _) = False
+setVanillaCtxt :: OccEnv -> OccEnv
+setVanillaCtxt (OccEnv OccRhs ctxt_ty) = OccEnv OccVanilla ctxt_ty
+setVanillaCtxt other_env = other_env
+
setCtxt :: OccEnv -> CtxtTy -> OccEnv
setCtxt (OccEnv encl _) ctxt = OccEnv encl ctxt