compiler/cprAnalysis/CprAnalyse.lhs

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