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