compiler/cprAnalysis/CprAnalyse.lhs

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