--- Does one analysis pass through a list of mutually recursive bindings.
-do_one_pass :: (CPREnv, [(CoreBndr,CoreExpr)]) -> (CPREnv, [(CoreBndr,CoreExpr)])
-do_one_pass (i_rho,bounders)
- = foldl anal_bind (i_rho, []) bounders
- where
- anal_bind (c_rho, done) (b,e) = (modifyVarEnv (const e_absval') c_rho b,
- done ++ [(b,e')])
- where (e', e_absval) = cprAnalExpr c_rho e
- e_absval' = snd (pinCPR b e e_absval)
-
-
--- take a binding pair and the abs val calculated from the rhs and
--- calculate a new absval taking into account sufficient manifest
--- lambda condition
--- Also we pin the var's CPR property to it. A var only has the CPR property if
--- it is a function
-
-pinCPR :: Var -> CoreExpr -> AbsVal -> (Var, AbsVal)
-pinCPR v e av = case av of
- -- is v a function with insufficent lambdas?
- Fun _ | length argtys /= length val_binders ->
- -- argtys must be greater than val_binders. So stripped_exp
- -- has a function type. The head of this expr can't be lambda
- -- a note, because we stripped them off before. It can't be a
- -- Con because it has a function type. It can't be a Type.
- -- If its an app, let or case then there is work to get the
- -- and we can't do anything because we may lose laziness. *But*
- -- if its a var (i.e. a function name) then we are fine. Note
- -- that I don't think this case is at all interesting, but I have
- -- a test program that generates it.
-
- -- UPDATE: 20 Jul 1999
- -- I've decided not to allow this (useless) optimisation. It will make
- -- the w/w split more complex.
- -- if isVar stripped_exp then
- -- (addCpr av, av)
- -- else
- (addCpr Top, Top)
- Tuple _ ->
- -- not a function.
- -- Pin NoInfo to v. If v appears in the interface file then an
- -- importing module will check to see if it has an unfolding
- -- with a constructor at its head (WHNF). If it does it will re-analyse
- -- the folding. I could do the check here, but I don't know if
- -- the current unfolding info is final.
- (addCpr Top,
- -- Retain CPR info if it has a constructor
- -- at its head, and thus will be inlined and simplified by
- -- case of a known constructor
- if isCon e then av else Top)
- _ -> (addCpr av, av)
- where
- -- func to pin CPR info on a var
- addCpr :: AbsVal -> Var
- addCpr = (setIdCprInfo v).absToCprInfo
-
- -- Split argument types and result type from v's type
- (_, argtys, _) = (splitTypeToFunArgAndRes.varType) v
-
- -- val_binders are the explicit lambdas at the head of the expression
- (_, val_binders, _) = collectTyAndValBinders e -- collectBindersIgnoringNotes e'
+addIdCprInfo :: Id -> CoreExpr -> AbsVal -> Id
+addIdCprInfo bndr rhs absval
+ | useful_info && ok_to_add = setIdCprInfo bndr cpr_info
+ | otherwise = bndr
+ where
+ cpr_info = absToCprInfo absval
+ useful_info = case cpr_info of { ReturnsCPR -> True; NoCPRInfo -> False }
+
+ ok_to_add = case absval of
+ Fun _ -> idArity bndr >= n_fun_tys absval
+ -- Enough visible lambdas
+
+ Tuple -> exprIsValue rhs || isStrict (idDemandInfo bndr)
+ -- If the rhs is a value, and returns a constructed product,
+ -- it will be inlined at usage sites, so we give it a Tuple absval
+ -- If it isn't a value, we won't inline it (code/work dup worries), so
+ -- we discard its absval.
+ --
+ -- Also, if the strictness analyser has figured out that it's strict,
+ -- the let-to-case transformation will happen, so again it's good.
+ -- (CPR analysis runs before the simplifier has had a chance to do
+ -- the let-to-case transform.)
+ -- This made a big difference to PrelBase.modInt, which had something like
+ -- modInt = \ x -> let r = ... -> I# v in
+ -- ...body strict in r...
+ -- r's RHS isn't a value yet; but modInt returns r in various branches, so
+ -- if r doesn't have the CPR property then neither does modInt
+
+ _ -> False
+
+ n_fun_tys :: AbsVal -> Int
+ n_fun_tys (Fun av) = 1 + n_fun_tys av
+ n_fun_tys other = 0