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