1 \section[CprAnalyse]{Identify functions that always return a
2 constructed product result}
5 module CprAnalyse ( cprAnalyse ) where
7 #include "HsVersions.h"
9 import CmdLineOpts ( DynFlags, DynFlag(..) )
10 import CoreLint ( showPass, endPass )
12 import CoreUtils ( exprIsValue )
13 import Id ( Id, setIdCprInfo, idCprInfo, idArity,
14 isBottomingId, idDemandInfo, isImplicitId )
15 import IdInfo ( CprInfo(..) )
16 import Demand ( isStrict )
18 import Util ( nTimes, mapAccumL )
24 This module performs an analysis of a set of Core Bindings for the
25 Constructed Product Result (CPR) transformation.
27 It detects functions that always explicitly (manifestly?) construct a
28 result value with a product type. A product type is a type which has
29 only one constructor. For example, tuples and boxed primitive values
32 We must also ensure that the function's body starts with sufficient
33 manifest lambdas otherwise loss of sharing can occur. See the comment
36 The transformation of bindings to worker/wrapper pairs is done by the
37 worker-wrapper pass. The worker-wrapper pass splits bindings on the
38 basis of both strictness and CPR info. If an id has both then it can
39 combine the transformations so that only one pair is produced.
41 The analysis here detects nested CPR information. For example, if a
42 function returns a constructed pair, the first element of which is a
43 constructed int, then the analysis will detect nested CPR information
44 for the int as well. Unfortunately, the current transformations can't
45 take advantage of the nested CPR information. They have (broken now,
46 I think) code which will flatten out nested CPR components and rebuild
47 them in the wrapper, but enabling this would lose laziness. It is
48 possible to make use of the nested info: if we knew that a caller was
49 strict in that position then we could create a specialized version of
50 the function which flattened/reconstructed that position.
52 It is not known whether this optimisation would be worthwhile.
54 So we generate and carry round nested CPR information, but before
55 using this info to guide the creation of workers and wrappers we map
56 all components of a CPRInfo to NoCprInfo.
62 Within this module Id's CPR information is represented by
63 ``AbsVal''. When adding this information to the Id's pragma info field
64 we convert the ``Absval'' to a ``CprInfo'' value.
66 Abstract domains consist of a `no information' value (Top), a function
67 value (Fun) which when applied to an argument returns a new AbsVal
68 (note the argument is not used in any way), , for product types, a
69 corresponding length tuple (Tuple) of abstract values. And finally,
70 Bot. Bot is not a proper abstract value but a generic bottom is
71 useful for calculating fixpoints and representing divergent
72 computations. Note that we equate Bot and Fun^n Bot (n > 0), and
73 likewise for Top. This saves a lot of delving in types to keep
74 everything exactly correct.
76 Since functions abstract to constant functions we could just
77 represent them by the abstract value of their result. However, it
78 turns out (I know - I tried!) that this requires a lot of type
79 manipulation and the code is more straightforward if we represent
80 functions by an abstract constant function.
83 data AbsVal = Top -- Not a constructed product
85 | Fun AbsVal -- A function that takes an argument
86 -- and gives AbsVal as result.
88 | Tuple -- A constructed product of values
90 | Bot -- Bot'tom included for convenience
91 -- we could use appropriate Tuple Vals
94 -- For pretty debugging
95 instance Outputable AbsVal where
96 ppr Top = ptext SLIT("Top")
97 ppr (Fun r) = ptext SLIT("Fun->") <> (parens.ppr) r
98 ppr Tuple = ptext SLIT("Tuple ")
99 ppr Bot = ptext SLIT("Bot")
102 -- lub takes the lowest upper bound of two abstract values, standard.
103 lub :: AbsVal -> AbsVal -> AbsVal
108 lub Tuple Tuple = Tuple
109 lub (Fun l) (Fun r) = Fun (lub l r)
110 lub l r = panic "CPR Analysis tried to take the lub of a function and a tuple"
115 The environment maps Ids to their abstract CPR value.
119 type CPREnv = VarEnv AbsVal
121 initCPREnv = emptyVarEnv
128 Take a list of core bindings and return a new list with CPR function
129 ids decorated with their CprInfo pragmas.
133 cprAnalyse :: DynFlags -> [CoreBind] -> IO [CoreBind]
135 -- Omit unless DEBUG is on
136 cprAnalyse dflags binds = return binds
139 cprAnalyse dflags binds
141 showPass dflags "Constructed Product analysis" ;
142 let { binds_plus_cpr = do_prog binds } ;
143 endPass dflags "Constructed Product analysis"
144 Opt_D_dump_cpranal binds_plus_cpr
147 do_prog :: [CoreBind] -> [CoreBind]
148 do_prog binds = snd $ mapAccumL cprAnalBind initCPREnv binds
151 The cprAnal functions take binds/expressions and an environment which
152 gives CPR info for visible ids and returns a new bind/expression
153 with ids decorated with their CPR info.
156 -- Return environment extended with info from this binding
157 cprAnalBind :: CPREnv -> CoreBind -> (CPREnv, CoreBind)
158 cprAnalBind rho (NonRec b e)
159 | isImplicitId b -- Don't touch the CPR info on constructors, selectors etc
162 = (extendVarEnv rho b absval, NonRec b' e')
164 (e', absval) = cprAnalExpr rho e
165 b' = addIdCprInfo b e' absval
167 cprAnalBind rho (Rec prs)
168 = (final_rho, Rec (map do_pr prs))
170 do_pr (b,e) = (b', e')
172 b' = addIdCprInfo b e' absval
173 (e', absval) = cprAnalExpr final_rho e
175 -- When analyzing mutually recursive bindings the iterations to find
176 -- a fixpoint is bounded by the number of bindings in the group.
177 -- for simplicity we just iterate that number of times.
178 final_rho = nTimes (length prs) do_one_pass init_rho
179 init_rho = rho `extendVarEnvList` [(b,Bot) | (b,e) <- prs]
181 do_one_pass :: CPREnv -> CPREnv
182 do_one_pass rho = foldl (\ rho (b,e) -> extendVarEnv rho b (snd (cprAnalExpr rho e)))
186 cprAnalExpr :: CPREnv -> CoreExpr -> (CoreExpr, AbsVal)
188 -- If Id will always diverge when given sufficient arguments then
189 -- we can just set its abs val to Bot. Any other CPR info
190 -- from other paths will then dominate, which is what we want.
191 -- Check in rho, if not there it must be imported, so check
193 cprAnalExpr rho e@(Var v)
194 | isBottomingId v = (e, Bot)
195 | otherwise = (e, case lookupVarEnv rho v of
197 Nothing -> getCprAbsVal v)
199 -- Literals are unboxed
200 cprAnalExpr rho (Lit l) = (Lit l, Top)
202 -- For apps we don't care about the argument's abs val. This
203 -- app will return a constructed product if the function does. We strip
204 -- a Fun from the functions abs val, unless the argument is a type argument
205 -- or it is already Top or Bot.
206 cprAnalExpr rho (App fun arg@(Type _))
207 = (App fun_cpr arg, fun_res)
209 (fun_cpr, fun_res) = cprAnalExpr rho fun
211 cprAnalExpr rho (App fun arg)
212 = (App fun_cpr arg_cpr, res_res)
214 (fun_cpr, fun_res) = cprAnalExpr rho fun
215 (arg_cpr, _) = cprAnalExpr rho arg
216 res_res = case fun_res of
217 Fun res_res -> res_res
220 Tuple -> WARN( True, ppr (App fun arg) ) Top
221 -- This really should not happen!
224 -- Map arguments to Top (we aren't constructing them)
225 -- Return the abstract value of the body, since functions
226 -- are represented by the CPR value of their result, and
227 -- add a Fun for this lambda..
228 cprAnalExpr rho (Lam b body) | isTyVar b = (Lam b body_cpr, body_aval)
229 | otherwise = (Lam b body_cpr, Fun body_aval)
231 (body_cpr, body_aval) = cprAnalExpr (extendVarEnv rho b Top) body
233 cprAnalExpr rho (Let bind body)
234 = (Let bind' body', body_aval)
236 (rho', bind') = cprAnalBind rho bind
237 (body', body_aval) = cprAnalExpr rho' body
239 cprAnalExpr rho (Case scrut bndr alts)
240 = (Case scrut_cpr bndr alts_cpr, alts_aval)
242 (scrut_cpr, scrut_aval) = cprAnalExpr rho scrut
243 (alts_cpr, alts_aval) = cprAnalCaseAlts (extendVarEnv rho bndr scrut_aval) alts
245 cprAnalExpr rho (Note n exp)
246 = (Note n exp_cpr, expr_aval)
248 (exp_cpr, expr_aval) = cprAnalExpr rho exp
250 cprAnalExpr rho (Type t)
253 cprAnalCaseAlts :: CPREnv -> [CoreAlt] -> ([CoreAlt], AbsVal)
254 cprAnalCaseAlts rho alts
255 = foldl anal_alt ([], Bot) alts
257 anal_alt :: ([CoreAlt], AbsVal) -> CoreAlt -> ([CoreAlt], AbsVal)
258 anal_alt (done, aval) (con, binds, exp)
259 = (done ++ [(con,binds,exp_cpr)], aval `lub` exp_aval)
260 where (exp_cpr, exp_aval) = cprAnalExpr rho' exp
261 rho' = rho `extendVarEnvList` (zip binds (repeat Top))
264 addIdCprInfo :: Id -> CoreExpr -> AbsVal -> Id
265 addIdCprInfo bndr rhs absval
266 | useful_info && ok_to_add = setIdCprInfo bndr cpr_info
269 cpr_info = absToCprInfo absval
270 useful_info = case cpr_info of { ReturnsCPR -> True; NoCPRInfo -> False }
272 ok_to_add = case absval of
273 Fun _ -> idArity bndr >= n_fun_tys absval
274 -- Enough visible lambdas
276 Tuple -> exprIsValue rhs || isStrict (idDemandInfo bndr)
277 -- If the rhs is a value, and returns a constructed product,
278 -- it will be inlined at usage sites, so we give it a Tuple absval
279 -- If it isn't a value, we won't inline it (code/work dup worries), so
280 -- we discard its absval.
282 -- Also, if the strictness analyser has figured out that it's strict,
283 -- the let-to-case transformation will happen, so again it's good.
284 -- (CPR analysis runs before the simplifier has had a chance to do
285 -- the let-to-case transform.)
286 -- This made a big difference to PrelBase.modInt, which had something like
287 -- modInt = \ x -> let r = ... -> I# v in
288 -- ...body strict in r...
289 -- r's RHS isn't a value yet; but modInt returns r in various branches, so
290 -- if r doesn't have the CPR property then neither does modInt
294 n_fun_tys :: AbsVal -> Int
295 n_fun_tys (Fun av) = 1 + n_fun_tys av
299 absToCprInfo :: AbsVal -> CprInfo
300 absToCprInfo Tuple = ReturnsCPR
301 absToCprInfo (Fun r) = absToCprInfo r
302 absToCprInfo _ = NoCPRInfo
305 -- Cpr Info doesn't store the number of arguments a function has, so the caller
306 -- must take care to add the appropriate number of Funs.
307 getCprAbsVal v = case idCprInfo v of
309 ReturnsCPR -> nTimes arity Fun Tuple
312 -- Imported (non-nullary) constructors will have the CPR property
313 -- in their IdInfo, so no need to look at their unfolding