ghc/compiler/cprAnalysis/CprAnalyse.lhs

   1 \section[CprAnalyse]{Identify functions that always return a
   2 constructed product result}
   3
   4 \begin{code}
   5 module CprAnalyse ( cprAnalyse ) where
   6
   7 #include "HsVersions.h"
   8
   9 import CmdLineOpts      ( DynFlags, DynFlag(..) )
  10 import CoreLint         ( showPass, endPass )
  11 import CoreSyn
  12 import CoreUtils        ( exprIsValue )
  13 import Id               ( Id, setIdCprInfo, idCprInfo, idArity,
  14                           isBottomingId, idDemandInfo, isImplicitId )
  15 import IdInfo           ( CprInfo(..) )
  16 import Demand           ( isStrict )
  17 import VarEnv
  18 import Util             ( nTimes, mapAccumL )
  19 import Outputable
  20
  21 import Maybe
  22 \end{code}
  23
  24 This module performs an analysis of a set of Core Bindings for the
  25 Constructed Product Result (CPR) transformation.
  26
  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
  30 have product type.
  31
  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
  34 in @StrictAnal.lhs@.
  35
  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.
  40
  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.
  51
  52 It is not known whether this optimisation would be worthwhile.
  53
  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.
  57
  58
  59 Data types
  60 ~~~~~~~~~~
  61
  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.
  65
  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.
  75
  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.
  81
  82 \begin{code}
  83 data AbsVal = Top                -- Not a constructed product
  84
  85             | Fun AbsVal         -- A function that takes an argument
  86                                  -- and gives AbsVal as result.
  87
  88             | Tuple              -- A constructed product of values
  89
  90             | Bot                -- Bot'tom included for convenience
  91                                  -- we could use appropriate Tuple Vals
  92      deriving (Eq,Show)
  93
  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")
 100
 101
 102 -- lub takes the lowest upper bound of two abstract values, standard.
 103 lub :: AbsVal -> AbsVal -> AbsVal
 104 lub Bot a = a
 105 lub a Bot = a
 106 lub Top a = Top
 107 lub a Top = Top
 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"
 111
 112
 113 \end{code}
 114
 115 The environment maps Ids to their abstract CPR value.
 116
 117 \begin{code}
 118
 119 type CPREnv = VarEnv AbsVal
 120
 121 initCPREnv = emptyVarEnv
 122
 123 \end{code}
 124
 125 Programs
 126 ~~~~~~~~
 127
 128 Take a list of core bindings and return a new list with CPR function
 129 ids decorated with their CprInfo pragmas.
 130
 131 \begin{code}
 132
 133 cprAnalyse :: DynFlags -> [CoreBind] -> IO [CoreBind]
 134 cprAnalyse dflags binds
 135   = do {
 136         showPass dflags "Constructed Product analysis" ;
 137         let { binds_plus_cpr = do_prog binds } ;
 138         endPass dflags "Constructed Product analysis"
 139                 Opt_D_dump_cpranal binds_plus_cpr
 140     }
 141   where
 142     do_prog :: [CoreBind] -> [CoreBind]
 143     do_prog binds = snd $ mapAccumL cprAnalBind initCPREnv binds
 144 \end{code}
 145
 146 The cprAnal functions take binds/expressions and an environment which
 147 gives CPR info for visible ids and returns a new bind/expression
 148 with ids decorated with their CPR info.
 149
 150 \begin{code}
 151 -- Return environment extended with info from this binding
 152 cprAnalBind :: CPREnv -> CoreBind -> (CPREnv, CoreBind)
 153 cprAnalBind rho (NonRec b e)
 154   | isImplicitId b      -- Don't touch the CPR info on constructors, selectors etc
 155   = (rho, NonRec b e)
 156   | otherwise
 157   = (extendVarEnv rho b absval, NonRec b' e')
 158   where
 159     (e', absval) = cprAnalExpr rho e
 160     b' = addIdCprInfo b e' absval
 161
 162 cprAnalBind rho (Rec prs)
 163   = (final_rho, Rec (map do_pr prs))
 164   where
 165     do_pr (b,e) = (b', e')
 166                 where
 167                   b'           = addIdCprInfo b e' absval
 168                   (e', absval) = cprAnalExpr final_rho e
 169
 170         -- When analyzing mutually recursive bindings the iterations to find
 171         -- a fixpoint is bounded by the number of bindings in the group.
 172         -- for simplicity we just iterate that number of times.
 173     final_rho = nTimes (length prs) do_one_pass init_rho
 174     init_rho  = rho `extendVarEnvList` [(b,Bot) | (b,e) <- prs]
 175
 176     do_one_pass :: CPREnv -> CPREnv
 177     do_one_pass rho = foldl (\ rho (b,e) -> extendVarEnv rho b (snd (cprAnalExpr rho e)))
 178                             rho prs
 179
 180
 181 cprAnalExpr :: CPREnv -> CoreExpr -> (CoreExpr, AbsVal)
 182
 183 -- If Id will always diverge when given sufficient arguments then
 184 -- we can just set its abs val to Bot.  Any other CPR info
 185 -- from other paths will then dominate,  which is what we want.
 186 -- Check in rho,  if not there it must be imported, so check
 187 -- the var's idinfo.
 188 cprAnalExpr rho e@(Var v)
 189     | isBottomingId v = (e, Bot)
 190     | otherwise       = (e, case lookupVarEnv rho v of
 191                              Just a_val -> a_val
 192                              Nothing    -> getCprAbsVal v)
 193
 194 -- Literals are unboxed
 195 cprAnalExpr rho (Lit l) = (Lit l, Top)
 196
 197 -- For apps we don't care about the argument's abs val.  This
 198 -- app will return a constructed product if the function does. We strip
 199 -- a Fun from the functions abs val, unless the argument is a type argument
 200 -- or it is already Top or Bot.
 201 cprAnalExpr rho (App fun arg@(Type _))
 202     = (App fun_cpr arg, fun_res)
 203     where
 204       (fun_cpr, fun_res)  = cprAnalExpr rho fun
 205
 206 cprAnalExpr rho (App fun arg)
 207     = (App fun_cpr arg_cpr, res_res)
 208     where
 209       (fun_cpr, fun_res)  = cprAnalExpr rho fun
 210       (arg_cpr, _)        = cprAnalExpr rho arg
 211       res_res             = case fun_res of
 212                                 Fun res_res -> res_res
 213                                 Top         -> Top
 214                                 Bot         -> Bot
 215                                 Tuple       -> WARN( True, ppr (App fun arg) ) Top
 216                                                 -- This really should not happen!
 217
 218
 219 -- Map arguments to Top (we aren't constructing them)
 220 -- Return the abstract value of the body, since functions
 221 -- are represented by the CPR value of their result, and
 222 -- add a Fun for this lambda..
 223 cprAnalExpr rho (Lam b body) | isTyVar b = (Lam b body_cpr, body_aval)
 224                              | otherwise = (Lam b body_cpr, Fun body_aval)
 225       where
 226       (body_cpr, body_aval) = cprAnalExpr (extendVarEnv rho b Top) body
 227
 228 cprAnalExpr rho (Let bind body)
 229     = (Let bind' body', body_aval)
 230     where
 231       (rho', bind') = cprAnalBind rho bind
 232       (body', body_aval) = cprAnalExpr rho' body
 233
 234 cprAnalExpr rho (Case scrut bndr alts)
 235     = (Case scrut_cpr bndr alts_cpr, alts_aval)
 236       where
 237       (scrut_cpr, scrut_aval) = cprAnalExpr rho scrut
 238       (alts_cpr, alts_aval) = cprAnalCaseAlts (extendVarEnv rho bndr scrut_aval) alts
 239
 240 cprAnalExpr rho (Note n exp)
 241     = (Note n exp_cpr, expr_aval)
 242       where
 243       (exp_cpr, expr_aval) = cprAnalExpr rho exp
 244
 245 cprAnalExpr rho (Type t)
 246     = (Type t, Top)
 247
 248 cprAnalCaseAlts :: CPREnv -> [CoreAlt] -> ([CoreAlt], AbsVal)
 249 cprAnalCaseAlts rho alts
 250     = foldl anal_alt ([], Bot) alts
 251       where
 252       anal_alt :: ([CoreAlt], AbsVal) -> CoreAlt -> ([CoreAlt], AbsVal)
 253       anal_alt (done, aval) (con, binds, exp)
 254           = (done ++ [(con,binds,exp_cpr)], aval `lub` exp_aval)
 255             where (exp_cpr, exp_aval) = cprAnalExpr rho' exp
 256                   rho' = rho `extendVarEnvList` (zip binds (repeat Top))
 257
 258
 259 addIdCprInfo :: Id -> CoreExpr -> AbsVal -> Id
 260 addIdCprInfo bndr rhs absval
 261   | useful_info && ok_to_add = setIdCprInfo bndr cpr_info
 262   | otherwise                = bndr
 263   where
 264     cpr_info    = absToCprInfo absval
 265     useful_info = case cpr_info of { ReturnsCPR -> True; NoCPRInfo -> False }
 266
 267     ok_to_add = case absval of
 268                   Fun _ -> idArity bndr >= n_fun_tys absval
 269                       -- Enough visible lambdas
 270
 271                   Tuple  -> exprIsValue rhs || isStrict (idDemandInfo bndr)
 272                         -- If the rhs is a value, and returns a constructed product,
 273                         -- it will be inlined at usage sites, so we give it a Tuple absval
 274                         -- If it isn't a value, we won't inline it (code/work dup worries), so
 275                         -- we discard its absval.
 276                         --
 277                         -- Also, if the strictness analyser has figured out that it's strict,
 278                         -- the let-to-case transformation will happen, so again it's good.
 279                         -- (CPR analysis runs before the simplifier has had a chance to do
 280                         --  the let-to-case transform.)
 281                         -- This made a big difference to PrelBase.modInt, which had something like
 282                         --      modInt = \ x -> let r = ... -> I# v in
 283                         --                      ...body strict in r...
 284                         -- r's RHS isn't a value yet; but modInt returns r in various branches, so
 285                         -- if r doesn't have the CPR property then neither does modInt
 286
 287                   _ -> False
 288
 289     n_fun_tys :: AbsVal -> Int
 290     n_fun_tys (Fun av) = 1 + n_fun_tys av
 291     n_fun_tys other    = 0
 292
 293
 294 absToCprInfo :: AbsVal -> CprInfo
 295 absToCprInfo Tuple   = ReturnsCPR
 296 absToCprInfo (Fun r) = absToCprInfo r
 297 absToCprInfo _       = NoCPRInfo
 298
 299
 300 -- Cpr Info doesn't store the number of arguments a function has,  so the caller
 301 -- must take care to add the appropriate number of Funs.
 302 getCprAbsVal v = case idCprInfo v of
 303                         NoCPRInfo -> Top
 304                         ReturnsCPR -> nTimes arity Fun Tuple
 305                where
 306                  arity = idArity v
 307         -- Imported (non-nullary) constructors will have the CPR property
 308         -- in their IdInfo, so no need to look at their unfolding
 309 \end{code}