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