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