ghc/compiler/stgSyn/CoreToStg.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   3 %
   4 \section[CoreToStg]{Converts Core to STG Syntax}
   5
   6 And, as we have the info in hand, we may convert some lets to
   7 let-no-escapes.
   8
   9 \begin{code}
  10 module CoreToStg ( coreToStg, coreExprToStg ) where
  11
  12 #include "HsVersions.h"
  13
  14 import CoreSyn
  15 import CoreUtils
  16 import StgSyn
  17
  18 import Type
  19 import TyCon            ( isAlgTyCon )
  20 import Literal
  21 import Id
  22 import Var              ( Var, globalIdDetails )
  23 import IdInfo
  24 import DataCon
  25 import CostCentre       ( noCCS )
  26 import VarSet
  27 import VarEnv
  28 import DataCon          ( dataConWrapId )
  29 import IdInfo           ( OccInfo(..) )
  30 import TysPrim          ( foreignObjPrimTyCon )
  31 import Maybes           ( maybeToBool )
  32 import Name             ( getOccName, isExternallyVisibleName, isDllName )
  33 import OccName          ( occNameUserString )
  34 import BasicTypes       ( TopLevelFlag(..), isNotTopLevel )
  35 import CmdLineOpts      ( DynFlags, opt_KeepStgTypes )
  36 import FastTypes        hiding ( fastOr )
  37 import Outputable
  38
  39 import List             ( partition )
  40
  41 infixr 9 `thenLne`
  42 \end{code}
  43
  44 %************************************************************************
  45 %*                                                                      *
  46 \subsection[live-vs-free-doc]{Documentation}
  47 %*                                                                      *
  48 %************************************************************************
  49
  50 (There is other relevant documentation in codeGen/CgLetNoEscape.)
  51
  52 The actual Stg datatype is decorated with {\em live variable}
  53 information, as well as {\em free variable} information.  The two are
  54 {\em not} the same.  Liveness is an operational property rather than a
  55 semantic one.  A variable is live at a particular execution point if
  56 it can be referred to {\em directly} again.  In particular, a dead
  57 variable's stack slot (if it has one):
  58 \begin{enumerate}
  59 \item
  60 should be stubbed to avoid space leaks, and
  61 \item
  62 may be reused for something else.
  63 \end{enumerate}
  64
  65 There ought to be a better way to say this.  Here are some examples:
  66 \begin{verbatim}
  67         let v = [q] \[x] -> e
  68         in
  69         ...v...  (but no q's)
  70 \end{verbatim}
  71
  72 Just after the `in', v is live, but q is dead.  If the whole of that
  73 let expression was enclosed in a case expression, thus:
  74 \begin{verbatim}
  75         case (let v = [q] \[x] -> e in ...v...) of
  76                 alts[...q...]
  77 \end{verbatim}
  78 (ie @alts@ mention @q@), then @q@ is live even after the `in'; because
  79 we'll return later to the @alts@ and need it.
  80
  81 Let-no-escapes make this a bit more interesting:
  82 \begin{verbatim}
  83         let-no-escape v = [q] \ [x] -> e
  84         in
  85         ...v...
  86 \end{verbatim}
  87 Here, @q@ is still live at the `in', because @v@ is represented not by
  88 a closure but by the current stack state.  In other words, if @v@ is
  89 live then so is @q@.  Furthermore, if @e@ mentions an enclosing
  90 let-no-escaped variable, then {\em its} free variables are also live
  91 if @v@ is.
  92
  93 %************************************************************************
  94 %*                                                                      *
  95 \subsection[caf-info]{Collecting live CAF info}
  96 %*                                                                      *
  97 %************************************************************************
  98
  99 In this pass we also collect information on which CAFs are live for
 100 constructing SRTs (see SRT.lhs).
 101
 102 A top-level Id has CafInfo, which is
 103
 104         - MayHaveCafRefs, if it may refer indirectly to
 105           one or more CAFs, or
 106         - NoCafRefs if it definitely doesn't
 107
 108 we collect the CafInfo first by analysing the original Core expression, and
 109 also place this information in the environment.
 110
 111 During CoreToStg, we then pin onto each binding and case expression, a
 112 list of Ids which represents the "live" CAFs at that point.  The meaning
 113 of "live" here is the same as for live variables, see above (which is
 114 why it's convenient to collect CAF information here rather than elsewhere).
 115
 116 The later SRT pass takes these lists of Ids and uses them to construct
 117 the actual nested SRTs, and replaces the lists of Ids with (offset,length)
 118 pairs.
 119
 120 %************************************************************************
 121 %*                                                                      *
 122 \subsection[binds-StgVarInfo]{Setting variable info: top-level, binds, RHSs}
 123 %*                                                                      *
 124 %************************************************************************
 125
 126 \begin{code}
 127 coreToStg :: DynFlags -> [CoreBind] -> IO [StgBinding]
 128 coreToStg dflags pgm
 129   = return pgm'
 130   where (env', fvs, pgm') = coreTopBindsToStg emptyVarEnv pgm
 131
 132 coreExprToStg :: CoreExpr -> StgExpr
 133 coreExprToStg expr
 134   = new_expr where (new_expr,_,_) = initLne emptyVarEnv (coreToStgExpr expr)
 135
 136
 137 coreTopBindsToStg
 138     :: IdEnv HowBound           -- environment for the bindings
 139     -> [CoreBind]
 140     -> (IdEnv HowBound, FreeVarsInfo, [StgBinding])
 141
 142 coreTopBindsToStg env [] = (env, emptyFVInfo, [])
 143 coreTopBindsToStg env (b:bs)
 144   = (env2, fvs1, b':bs')
 145   where
 146         -- env accumulates down the list of binds, fvs accumulates upwards
 147         (env1, fvs2, b' ) = coreTopBindToStg env fvs1 b
 148         (env2, fvs1, bs') = coreTopBindsToStg env1 bs
 149
 150
 151 coreTopBindToStg
 152         :: IdEnv HowBound
 153         -> FreeVarsInfo         -- Info about the body
 154         -> CoreBind
 155         -> (IdEnv HowBound, FreeVarsInfo, StgBinding)
 156
 157 coreTopBindToStg env body_fvs (NonRec id rhs)
 158   = let
 159         caf_info = hasCafRefs env rhs
 160
 161         env' = extendVarEnv env id (LetBound how_bound emptyVarSet)
 162
 163         how_bound | mayHaveCafRefs caf_info = TopLevelHasCafs
 164                   | otherwise               = TopLevelNoCafs
 165
 166         (stg_rhs, fvs', cafs) =
 167             initLne env (
 168               coreToStgRhs body_fvs TopLevel (id,rhs)
 169                         `thenLne` \ (stg_rhs, fvs', _) ->
 170               freeVarsToLiveVars fvs' `thenLne` \ (_, cafs) ->
 171               returnLne (stg_rhs, fvs', cafs)
 172            )
 173
 174         bind = StgNonRec (SRTEntries cafs) id stg_rhs
 175     in
 176     ASSERT2(consistent caf_info bind, ppr id)
 177 --    WARN(not (consistent caf_info bind), ppr id <+> ppr cafs <+> ppCafInfo caf_info)
 178     (env', fvs' `unionFVInfo` body_fvs, bind)
 179
 180 coreTopBindToStg env body_fvs (Rec pairs)
 181   = let
 182         (binders, rhss) = unzip pairs
 183
 184         -- to calculate caf_info, we initially map all the binders to
 185         -- TopLevelNoCafs.
 186         env1 = extendVarEnvList env
 187                 [ (b, LetBound TopLevelNoCafs emptyVarSet) | b <- binders ]
 188
 189         caf_info = hasCafRefss env1{-NB: not env'-} rhss
 190
 191         env' = extendVarEnvList env
 192                 [ (b, LetBound how_bound emptyVarSet) | b <- binders ]
 193
 194         how_bound | mayHaveCafRefs caf_info = TopLevelHasCafs
 195                   | otherwise               = TopLevelNoCafs
 196
 197         (stg_rhss, fvs', cafs)
 198           = initLne env' (
 199                mapAndUnzip3Lne (coreToStgRhs body_fvs TopLevel) pairs
 200                         `thenLne` \ (stg_rhss, fvss', _) ->
 201                let fvs' = unionFVInfos fvss' in
 202                freeVarsToLiveVars fvs'  `thenLne` \ (_, cafs) ->
 203                returnLne (stg_rhss, fvs', cafs)
 204            )
 205
 206         bind = StgRec (SRTEntries cafs) (zip binders stg_rhss)
 207     in
 208     ASSERT2(consistent caf_info bind, ppr binders)
 209 --    WARN(not (consistent caf_info bind), ppr binders <+> ppr cafs <+> ppCafInfo caf_info)
 210     (env', fvs' `unionFVInfo` body_fvs, bind)
 211
 212 -- assertion helper
 213 consistent caf_info bind = mayHaveCafRefs caf_info == stgBindHasCafRefs bind
 214 \end{code}
 215
 216 \begin{code}
 217 coreToStgRhs
 218         :: FreeVarsInfo         -- Free var info for the scope of the binding
 219         -> TopLevelFlag
 220         -> (Id,CoreExpr)
 221         -> LneM (StgRhs, FreeVarsInfo, EscVarsSet)
 222
 223 coreToStgRhs scope_fv_info top (binder, rhs)
 224   = coreToStgExpr rhs  `thenLne` \ (new_rhs, rhs_fvs, rhs_escs) ->
 225     returnLne (mkStgRhs top rhs_fvs binder_info new_rhs,
 226                rhs_fvs, rhs_escs)
 227   where
 228     binder_info = lookupFVInfo scope_fv_info binder
 229
 230 bogus_rhs = StgRhsClosure noCCS noBinderInfo [] ReEntrant [] bogus_expr
 231 bogus_expr = (StgLit (MachInt 1))
 232
 233 mkStgRhs :: TopLevelFlag -> FreeVarsInfo -> StgBinderInfo
 234          -> StgExpr -> StgRhs
 235
 236 mkStgRhs top rhs_fvs binder_info (StgLam _ bndrs body)
 237   = StgRhsClosure noCCS binder_info
 238                   (getFVs rhs_fvs)
 239                   ReEntrant
 240                   bndrs body
 241
 242 mkStgRhs top rhs_fvs binder_info (StgConApp con args)
 243   | isNotTopLevel top || not (isDllConApp con args)
 244   = StgRhsCon noCCS con args
 245
 246 mkStgRhs top rhs_fvs binder_info rhs
 247   = StgRhsClosure noCCS binder_info
 248                   (getFVs rhs_fvs)
 249                   (updatable [] rhs)
 250                   [] rhs
 251   where
 252     updatable args body | null args && isPAP body  = ReEntrant
 253                         | otherwise                = Updatable
 254 {- ToDo:
 255           upd = if isOnceDem dem
 256                     then (if isNotTop toplev
 257                             then SingleEntry    -- HA!  Paydirt for "dem"
 258                             else
 259 #ifdef DEBUG
 260                      trace "WARNING: SE CAFs unsupported, forcing UPD instead" $
 261 #endif
 262                      Updatable)
 263                 else Updatable
 264         -- For now we forbid SingleEntry CAFs; they tickle the
 265         -- ASSERT in rts/Storage.c line 215 at newCAF() re mut_link,
 266         -- and I don't understand why.  There's only one SE_CAF (well,
 267         -- only one that tickled a great gaping bug in an earlier attempt
 268         -- at ClosureInfo.getEntryConvention) in the whole of nofib,
 269         -- specifically Main.lvl6 in spectral/cryptarithm2.
 270         -- So no great loss.  KSW 2000-07.
 271 -}
 272 \end{code}
 273
 274 Detect thunks which will reduce immediately to PAPs, and make them
 275 non-updatable.  This has several advantages:
 276
 277         - the non-updatable thunk behaves exactly like the PAP,
 278
 279         - the thunk is more efficient to enter, because it is
 280           specialised to the task.
 281
 282         - we save one update frame, one stg_update_PAP, one update
 283           and lots of PAP_enters.
 284
 285         - in the case where the thunk is top-level, we save building
 286           a black hole and futhermore the thunk isn't considered to
 287           be a CAF any more, so it doesn't appear in any SRTs.
 288
 289 We do it here, because the arity information is accurate, and we need
 290 to do it before the SRT pass to save the SRT entries associated with
 291 any top-level PAPs.
 292
 293 \begin{code}
 294 isPAP (StgApp f args) = idArity f > length args
 295 isPAP _               = False
 296 \end{code}
 297
 298
 299 -- ---------------------------------------------------------------------------
 300 -- Expressions
 301 -- ---------------------------------------------------------------------------
 302
 303 \begin{code}
 304 coreToStgExpr
 305         :: CoreExpr
 306         -> LneM (StgExpr,       -- Decorated STG expr
 307                  FreeVarsInfo,  -- Its free vars (NB free, not live)
 308                  EscVarsSet)    -- Its escapees, a subset of its free vars;
 309                                 -- also a subset of the domain of the envt
 310                                 -- because we are only interested in the escapees
 311                                 -- for vars which might be turned into
 312                                 -- let-no-escaped ones.
 313 \end{code}
 314
 315 The second and third components can be derived in a simple bottom up pass, not
 316 dependent on any decisions about which variables will be let-no-escaped or
 317 not.  The first component, that is, the decorated expression, may then depend
 318 on these components, but it in turn is not scrutinised as the basis for any
 319 decisions.  Hence no black holes.
 320
 321 \begin{code}
 322 coreToStgExpr (Lit l) = returnLne (StgLit l, emptyFVInfo, emptyVarSet)
 323 coreToStgExpr (Var v) = coreToStgApp Nothing v []
 324
 325 coreToStgExpr expr@(App _ _)
 326   = coreToStgApp Nothing f args
 327   where
 328     (f, args) = myCollectArgs expr
 329
 330 coreToStgExpr expr@(Lam _ _)
 331   = let (args, body) = myCollectBinders expr
 332         args'        = filterStgBinders args
 333     in
 334     extendVarEnvLne [ (a, LambdaBound) | a <- args' ] $
 335     coreToStgExpr body  `thenLne` \ (body, body_fvs, body_escs) ->
 336     let
 337         set_of_args     = mkVarSet args'
 338         fvs             = args' `minusFVBinders` body_fvs
 339         escs            = body_escs `minusVarSet`    set_of_args
 340         result_expr | null args' = body
 341                     | otherwise  = StgLam (exprType expr) args' body
 342     in
 343     returnLne (result_expr, fvs, escs)
 344
 345 coreToStgExpr (Note (SCC cc) expr)
 346   = coreToStgExpr expr          `thenLne` ( \ (expr2, fvs, escs) ->
 347     returnLne (StgSCC cc expr2, fvs, escs) )
 348
 349 coreToStgExpr (Note other_note expr)
 350   = coreToStgExpr expr
 351
 352
 353 -- Cases require a little more real work.
 354
 355 coreToStgExpr (Case scrut bndr alts)
 356   = extendVarEnvLne [(bndr, CaseBound)] $
 357     vars_alts (findDefault alts)   `thenLne` \ (alts2, alts_fvs, alts_escs) ->
 358     freeVarsToLiveVars  alts_fvs   `thenLne` \ (alts_lvs, alts_caf_refs) ->
 359     let
 360         -- determine whether the default binder is dead or not
 361         -- This helps the code generator to avoid generating an assignment
 362         -- for the case binder (is extremely rare cases) ToDo: remove.
 363         bndr'= if (bndr `elementOfFVInfo` alts_fvs)
 364                   then bndr
 365                   else bndr `setIdOccInfo` IAmDead
 366
 367         -- Don't consider the default binder as being 'live in alts',
 368         -- since this is from the point of view of the case expr, where
 369         -- the default binder is not free.
 370         live_in_alts = (alts_lvs `minusVarSet` unitVarSet bndr)
 371     in
 372         -- we tell the scrutinee that everything live in the alts
 373         -- is live in it, too.
 374     setVarsLiveInCont (live_in_alts,alts_caf_refs) (
 375         coreToStgExpr scrut       `thenLne` \ (scrut2, scrut_fvs, scrut_escs) ->
 376         freeVarsToLiveVars scrut_fvs `thenLne` \ (scrut_lvs, _) ->
 377         returnLne (scrut2, scrut_fvs, scrut_escs, scrut_lvs)
 378       )
 379                 `thenLne` \ (scrut2, scrut_fvs, scrut_escs, scrut_lvs) ->
 380
 381     let srt = SRTEntries alts_caf_refs
 382     in
 383     returnLne (
 384       StgCase scrut2 scrut_lvs live_in_alts bndr' srt alts2,
 385       bndr `minusFVBinder` (scrut_fvs `unionFVInfo` alts_fvs),
 386       (alts_escs `minusVarSet` unitVarSet bndr) `unionVarSet` getFVSet scrut_fvs
 387                 -- You might think we should have scrut_escs, not
 388                 -- (getFVSet scrut_fvs), but actually we can't call, and
 389                 -- then return from, a let-no-escape thing.
 390       )
 391   where
 392     scrut_ty   = idType bndr
 393     prim_case  = isUnLiftedType scrut_ty && not (isUnboxedTupleType scrut_ty)
 394
 395     vars_alts (alts,deflt)
 396         | prim_case
 397         = mapAndUnzip3Lne vars_prim_alt alts
 398                         `thenLne` \ (alts2,  alts_fvs_list,  alts_escs_list) ->
 399           let
 400               alts_fvs  = unionFVInfos alts_fvs_list
 401               alts_escs = unionVarSets alts_escs_list
 402           in
 403           vars_deflt deflt `thenLne` \ (deflt2, deflt_fvs, deflt_escs) ->
 404           returnLne (
 405               mkStgPrimAlts scrut_ty alts2 deflt2,
 406               alts_fvs  `unionFVInfo`   deflt_fvs,
 407               alts_escs `unionVarSet` deflt_escs
 408           )
 409
 410         | otherwise
 411         = mapAndUnzip3Lne vars_alg_alt alts
 412                         `thenLne` \ (alts2,  alts_fvs_list,  alts_escs_list) ->
 413           let
 414               alts_fvs  = unionFVInfos alts_fvs_list
 415               alts_escs = unionVarSets alts_escs_list
 416           in
 417           vars_deflt deflt `thenLne` \ (deflt2, deflt_fvs, deflt_escs) ->
 418           returnLne (
 419               mkStgAlgAlts scrut_ty alts2 deflt2,
 420               alts_fvs  `unionFVInfo`   deflt_fvs,
 421               alts_escs `unionVarSet` deflt_escs
 422           )
 423
 424       where
 425         vars_prim_alt (LitAlt lit, _, rhs)
 426           = coreToStgExpr rhs   `thenLne` \ (rhs2, rhs_fvs, rhs_escs) ->
 427             returnLne ((lit, rhs2), rhs_fvs, rhs_escs)
 428
 429         vars_alg_alt (DataAlt con, binders, rhs)
 430           = let
 431                 -- remove type variables
 432                 binders' = filterStgBinders binders
 433             in
 434             extendVarEnvLne [(b, CaseBound) | b <- binders']    $
 435             coreToStgExpr rhs   `thenLne` \ (rhs2, rhs_fvs, rhs_escs) ->
 436             let
 437                 good_use_mask = [ b `elementOfFVInfo` rhs_fvs | b <- binders' ]
 438                 -- records whether each param is used in the RHS
 439             in
 440             returnLne (
 441                 (con, binders', good_use_mask, rhs2),
 442                 binders' `minusFVBinders` rhs_fvs,
 443                 rhs_escs `minusVarSet`   mkVarSet binders'
 444                         -- ToDo: remove the minusVarSet;
 445                         -- since escs won't include any of these binders
 446             )
 447         vars_alg_alt other = pprPanic "vars_alg_alt" (ppr other)
 448
 449         vars_deflt Nothing
 450            = returnLne (StgNoDefault, emptyFVInfo, emptyVarSet)
 451
 452         vars_deflt (Just rhs)
 453            = coreToStgExpr rhs  `thenLne` \ (rhs2, rhs_fvs, rhs_escs) ->
 454              returnLne (StgBindDefault rhs2, rhs_fvs, rhs_escs)
 455 \end{code}
 456
 457 Lets not only take quite a bit of work, but this is where we convert
 458 then to let-no-escapes, if we wish.
 459
 460 (Meanwhile, we don't expect to see let-no-escapes...)
 461 \begin{code}
 462 coreToStgExpr (Let bind body)
 463   = fixLne (\ ~(_, _, _, no_binder_escapes) ->
 464         coreToStgLet no_binder_escapes bind body
 465     )                           `thenLne` \ (new_let, fvs, escs, _) ->
 466
 467     returnLne (new_let, fvs, escs)
 468 \end{code}
 469
 470 If we've got a case containing a _ccall_GC_ primop, we need to
 471 ensure that the arguments are kept live for the duration of the
 472 call. This only an issue
 473
 474 \begin{code}
 475 isForeignObjArg :: Id -> Bool
 476 isForeignObjArg x = isId x && isForeignObjPrimTy (idType x)
 477
 478 isForeignObjPrimTy ty
 479    = case splitTyConApp_maybe ty of
 480         Just (tycon, _) -> tycon == foreignObjPrimTyCon
 481         Nothing         -> False
 482 \end{code}
 483
 484 \begin{code}
 485 mkStgAlgAlts ty alts deflt
 486  =  case alts of
 487                 -- Get the tycon from the data con
 488         (dc, _, _, _) : _rest
 489             -> StgAlgAlts (Just (dataConTyCon dc)) alts deflt
 490
 491                 -- Otherwise just do your best
 492         [] -> case splitTyConApp_maybe (repType ty) of
 493                 Just (tc,_) | isAlgTyCon tc
 494                         -> StgAlgAlts (Just tc) alts deflt
 495                 other
 496                         -> StgAlgAlts Nothing alts deflt
 497
 498 mkStgPrimAlts ty alts deflt
 499   = StgPrimAlts (tyConAppTyCon ty) alts deflt
 500 \end{code}
 501
 502
 503 -- ---------------------------------------------------------------------------
 504 -- Applications
 505 -- ---------------------------------------------------------------------------
 506
 507 \begin{code}
 508 coreToStgApp
 509          :: Maybe UpdateFlag            -- Just upd <=> this application is
 510                                         -- the rhs of a thunk binding
 511                                         --      x = [...] \upd [] -> the_app
 512                                         -- with specified update flag
 513         -> Id                           -- Function
 514         -> [CoreArg]                    -- Arguments
 515         -> LneM (StgExpr, FreeVarsInfo, EscVarsSet)
 516
 517 coreToStgApp maybe_thunk_body f args
 518   = coreToStgArgs args          `thenLne` \ (args', args_fvs) ->
 519     lookupVarLne f              `thenLne` \ how_bound ->
 520
 521     let
 522         n_args           = length args
 523         not_letrec_bound = not (isLetBound how_bound)
 524         fun_fvs          = singletonFVInfo f how_bound fun_occ
 525
 526         -- Mostly, the arity info of a function is in the fn's IdInfo
 527         -- But new bindings introduced by CoreSat may not have no
 528         -- arity info; it would do us no good anyway.  For example:
 529         --      let f = \ab -> e in f
 530         -- No point in having correct arity info for f!
 531         -- Hence the hasArity stuff below.
 532         f_arity_info     = idArityInfo f
 533         f_arity          = arityLowerBound f_arity_info         -- Zero if no info
 534
 535         fun_occ
 536          | not_letrec_bound                 = noBinderInfo      -- Uninteresting variable
 537          | f_arity > 0 && f_arity <= n_args = stgSatOcc         -- Saturated or over-saturated function call
 538          | otherwise                        = stgUnsatOcc       -- Unsaturated function or thunk
 539
 540         fun_escs
 541          | not_letrec_bound  = emptyVarSet      -- Only letrec-bound escapees are interesting
 542          | hasArity f_arity_info &&
 543            f_arity == n_args = emptyVarSet      -- A function *or thunk* with an exactly
 544                                                 -- saturated call doesn't escape
 545                                                 -- (let-no-escape applies to 'thunks' too)
 546
 547          | otherwise         = unitVarSet f     -- Inexact application; it does escape
 548
 549         -- At the moment of the call:
 550
 551         --  either the function is *not* let-no-escaped, in which case
 552         --         nothing is live except live_in_cont
 553         --      or the function *is* let-no-escaped in which case the
 554         --         variables it uses are live, but still the function
 555         --         itself is not.  PS.  In this case, the function's
 556         --         live vars should already include those of the
 557         --         continuation, but it does no harm to just union the
 558         --         two regardless.
 559
 560         app = case globalIdDetails f of
 561                 DataConId dc -> StgConApp dc args'
 562                 PrimOpId op  -> StgPrimApp op args' (exprType (mkApps (Var f) args))
 563                 _other       -> StgApp f args'
 564
 565     in
 566     returnLne (
 567         app,
 568         fun_fvs  `unionFVInfo` args_fvs,
 569         fun_escs `unionVarSet` (getFVSet args_fvs)
 570                                 -- All the free vars of the args are disqualified
 571                                 -- from being let-no-escaped.
 572     )
 573
 574
 575
 576 -- ---------------------------------------------------------------------------
 577 -- Argument lists
 578 -- This is the guy that turns applications into A-normal form
 579 -- ---------------------------------------------------------------------------
 580
 581 coreToStgArgs :: [CoreArg] -> LneM ([StgArg], FreeVarsInfo)
 582 coreToStgArgs []
 583   = returnLne ([], emptyFVInfo)
 584
 585 coreToStgArgs (Type ty : args)  -- Type argument
 586   = coreToStgArgs args  `thenLne` \ (args', fvs) ->
 587     if opt_KeepStgTypes then
 588         returnLne (StgTypeArg ty : args', fvs `unionFVInfo` tyvarFVInfo (tyVarsOfType ty))
 589     else
 590     returnLne (args', fvs)
 591
 592 coreToStgArgs (arg : args)      -- Non-type argument
 593   = coreToStgArgs args  `thenLne` \ (stg_args, args_fvs) ->
 594     coreToStgExpr arg   `thenLne` \ (arg', arg_fvs, escs) ->
 595     let
 596         fvs = args_fvs `unionFVInfo` arg_fvs
 597         stg_arg = case arg' of
 598                        StgApp v []      -> StgVarArg v
 599                        StgConApp con [] -> StgVarArg (dataConWrapId con)
 600                        StgLit lit       -> StgLitArg lit
 601                        _                -> pprPanic "coreToStgArgs" (ppr arg)
 602     in
 603     returnLne (stg_arg : stg_args, fvs)
 604
 605
 606 -- ---------------------------------------------------------------------------
 607 -- The magic for lets:
 608 -- ---------------------------------------------------------------------------
 609
 610 coreToStgLet
 611          :: Bool        -- True <=> yes, we are let-no-escaping this let
 612          -> CoreBind    -- bindings
 613          -> CoreExpr    -- body
 614          -> LneM (StgExpr,      -- new let
 615                   FreeVarsInfo, -- variables free in the whole let
 616                   EscVarsSet,   -- variables that escape from the whole let
 617                   Bool)         -- True <=> none of the binders in the bindings
 618                                 -- is among the escaping vars
 619
 620 coreToStgLet let_no_escape bind body
 621   = fixLne (\ ~(_, _, _, _, _, rec_body_fvs, _, _) ->
 622
 623         -- Do the bindings, setting live_in_cont to empty if
 624         -- we ain't in a let-no-escape world
 625         getVarsLiveInCont               `thenLne` \ live_in_cont ->
 626         setVarsLiveInCont (if let_no_escape
 627                                 then live_in_cont
 628                                 else (emptyVarSet,emptyVarSet))
 629                           (vars_bind rec_body_fvs bind)
 630                   `thenLne` \ (bind2, bind_fvs, bind_escs, bind_lvs, env_ext) ->
 631
 632         -- Do the body
 633         extendVarEnvLne env_ext (
 634           coreToStgExpr body          `thenLne` \(body2, body_fvs, body_escs) ->
 635           freeVarsToLiveVars body_fvs `thenLne` \(body_lvs, _) ->
 636
 637           returnLne (bind2, bind_fvs, bind_escs, bind_lvs,
 638                      body2, body_fvs, body_escs, body_lvs)
 639         )
 640
 641     ) `thenLne` (\ (bind2, bind_fvs, bind_escs, bind_lvs,
 642                     body2, body_fvs, body_escs, body_lvs) ->
 643
 644
 645         -- Compute the new let-expression
 646     let
 647         new_let | let_no_escape = StgLetNoEscape live_in_whole_let bind_lvs bind2 body2
 648                 | otherwise     = StgLet bind2 body2
 649
 650         free_in_whole_let
 651           = binders `minusFVBinders` (bind_fvs `unionFVInfo` body_fvs)
 652
 653         live_in_whole_let
 654           = bind_lvs `unionVarSet` (body_lvs `minusVarSet` set_of_binders)
 655
 656         real_bind_escs = if let_no_escape then
 657                             bind_escs
 658                          else
 659                             getFVSet bind_fvs
 660                             -- Everything escapes which is free in the bindings
 661
 662         let_escs = (real_bind_escs `unionVarSet` body_escs) `minusVarSet` set_of_binders
 663
 664         all_escs = bind_escs `unionVarSet` body_escs    -- Still includes binders of
 665                                                         -- this let(rec)
 666
 667         no_binder_escapes = isEmptyVarSet (set_of_binders `intersectVarSet` all_escs)
 668
 669 #ifdef DEBUG
 670         -- Debugging code as requested by Andrew Kennedy
 671         checked_no_binder_escapes
 672                 | not no_binder_escapes && any is_join_var binders
 673                 = pprTrace "Interesting!  A join var that isn't let-no-escaped" (ppr binders)
 674                   False
 675                 | otherwise = no_binder_escapes
 676 #else
 677         checked_no_binder_escapes = no_binder_escapes
 678 #endif
 679
 680                 -- Mustn't depend on the passed-in let_no_escape flag, since
 681                 -- no_binder_escapes is used by the caller to derive the flag!
 682     in
 683     returnLne (
 684         new_let,
 685         free_in_whole_let,
 686         let_escs,
 687         checked_no_binder_escapes
 688     ))
 689   where
 690     set_of_binders = mkVarSet binders
 691     binders        = case bind of
 692                         NonRec binder rhs -> [binder]
 693                         Rec pairs         -> map fst pairs
 694
 695     mk_binding bind_lvs binder
 696         = (binder,  LetBound  NotTopLevelBound  -- Not top level
 697                         live_vars
 698            )
 699         where
 700            live_vars = if let_no_escape then
 701                             extendVarSet bind_lvs binder
 702                        else
 703                             unitVarSet binder
 704
 705     vars_bind :: FreeVarsInfo           -- Free var info for body of binding
 706               -> CoreBind
 707               -> LneM (StgBinding,
 708                        FreeVarsInfo,
 709                        EscVarsSet,        -- free vars; escapee vars
 710                        StgLiveVars,       -- vars live in binding
 711                        [(Id, HowBound)])  -- extension to environment
 712
 713
 714     vars_bind body_fvs (NonRec binder rhs)
 715       = coreToStgRhs body_fvs NotTopLevel (binder,rhs)
 716                                 `thenLne` \ (rhs2, bind_fvs, escs) ->
 717
 718         freeVarsToLiveVars bind_fvs `thenLne` \ (bind_lvs, bind_cafs) ->
 719         let
 720             env_ext_item@(binder', _) = mk_binding bind_lvs binder
 721         in
 722         returnLne (StgNonRec (SRTEntries bind_cafs) binder' rhs2,
 723                         bind_fvs, escs, bind_lvs, [env_ext_item])
 724
 725
 726     vars_bind body_fvs (Rec pairs)
 727       = fixLne (\ ~(_, rec_rhs_fvs, _, bind_lvs, _) ->
 728            let
 729                 rec_scope_fvs = unionFVInfo body_fvs rec_rhs_fvs
 730                 binders = map fst pairs
 731                 env_ext = map (mk_binding bind_lvs) binders
 732            in
 733            extendVarEnvLne env_ext (
 734               mapAndUnzip3Lne (coreToStgRhs rec_scope_fvs NotTopLevel) pairs
 735                                         `thenLne` \ (rhss2, fvss, escss) ->
 736               let
 737                         bind_fvs = unionFVInfos fvss
 738                         escs     = unionVarSets escss
 739               in
 740               freeVarsToLiveVars (binders `minusFVBinders` bind_fvs)
 741                                         `thenLne` \ (bind_lvs, bind_cafs) ->
 742               returnLne (StgRec (SRTEntries bind_cafs) (binders `zip` rhss2),
 743                                 bind_fvs, escs, bind_lvs, env_ext)
 744            )
 745         )
 746
 747 is_join_var :: Id -> Bool
 748 -- A hack (used only for compiler debuggging) to tell if
 749 -- a variable started life as a join point ($j)
 750 is_join_var j = occNameUserString (getOccName j) == "$j"
 751 \end{code}
 752
 753 %************************************************************************
 754 %*                                                                      *
 755 \subsection[LNE-monad]{A little monad for this let-no-escaping pass}
 756 %*                                                                      *
 757 %************************************************************************
 758
 759 There's a lot of stuff to pass around, so we use this @LneM@ monad to
 760 help.  All the stuff here is only passed *down*.
 761
 762 \begin{code}
 763 type LneM a =  IdEnv HowBound
 764             -> (StgLiveVars,    -- vars live in continuation
 765                 IdSet)          -- cafs live in continuation
 766             -> a
 767
 768 data HowBound
 769   = ImportBound
 770   | CaseBound
 771   | LambdaBound
 772   | LetBound
 773         TopLevelCafInfo
 774         StgLiveVars     -- Live vars... see notes below
 775
 776 isLetBound (LetBound _ _) = True
 777 isLetBound other          = False
 778 \end{code}
 779
 780 For a let(rec)-bound variable, x, we record StgLiveVars, the set of
 781 variables that are live if x is live.  For "normal" variables that is
 782 just x alone.  If x is a let-no-escaped variable then x is represented
 783 by a code pointer and a stack pointer (well, one for each stack).  So
 784 all of the variables needed in the execution of x are live if x is,
 785 and are therefore recorded in the LetBound constructor; x itself
 786 *is* included.
 787
 788 The set of live variables is guaranteed ot have no further let-no-escaped
 789 variables in it.
 790
 791 The std monad functions:
 792 \begin{code}
 793 initLne :: IdEnv HowBound -> LneM a -> a
 794 initLne env m = m env (emptyVarSet,emptyVarSet)
 795
 796 {-# INLINE thenLne #-}
 797 {-# INLINE returnLne #-}
 798
 799 returnLne :: a -> LneM a
 800 returnLne e env lvs_cont = e
 801
 802 thenLne :: LneM a -> (a -> LneM b) -> LneM b
 803 thenLne m k env lvs_cont
 804   = k (m env lvs_cont) env lvs_cont
 805
 806 mapLne  :: (a -> LneM b)   -> [a] -> LneM [b]
 807 mapLne f [] = returnLne []
 808 mapLne f (x:xs)
 809   = f x         `thenLne` \ r  ->
 810     mapLne f xs `thenLne` \ rs ->
 811     returnLne (r:rs)
 812
 813 mapAndUnzipLne  :: (a -> LneM (b,c))   -> [a] -> LneM ([b],[c])
 814
 815 mapAndUnzipLne f [] = returnLne ([],[])
 816 mapAndUnzipLne f (x:xs)
 817   = f x                 `thenLne` \ (r1,  r2)  ->
 818     mapAndUnzipLne f xs `thenLne` \ (rs1, rs2) ->
 819     returnLne (r1:rs1, r2:rs2)
 820
 821 mapAndUnzip3Lne :: (a -> LneM (b,c,d)) -> [a] -> LneM ([b],[c],[d])
 822
 823 mapAndUnzip3Lne f []    = returnLne ([],[],[])
 824 mapAndUnzip3Lne f (x:xs)
 825   = f x                  `thenLne` \ (r1,  r2,  r3)  ->
 826     mapAndUnzip3Lne f xs `thenLne` \ (rs1, rs2, rs3) ->
 827     returnLne (r1:rs1, r2:rs2, r3:rs3)
 828
 829 fixLne :: (a -> LneM a) -> LneM a
 830 fixLne expr env lvs_cont
 831   = result
 832   where
 833     result = expr result env lvs_cont
 834 \end{code}
 835
 836 Functions specific to this monad:
 837
 838 \begin{code}
 839 getVarsLiveInCont :: LneM (StgLiveVars, IdSet)
 840 getVarsLiveInCont env lvs_cont = lvs_cont
 841
 842 setVarsLiveInCont :: (StgLiveVars,IdSet) -> LneM a -> LneM a
 843 setVarsLiveInCont new_lvs_cont expr env lvs_cont
 844   = expr env new_lvs_cont
 845
 846 extendVarEnvLne :: [(Id, HowBound)] -> LneM a -> LneM a
 847 extendVarEnvLne ids_w_howbound expr env lvs_cont
 848   = expr (extendVarEnvList env ids_w_howbound) lvs_cont
 849
 850 lookupVarLne :: Id -> LneM HowBound
 851 lookupVarLne v env lvs_cont
 852   = returnLne (
 853       case (lookupVarEnv env v) of
 854         Just xx -> xx
 855         Nothing -> ImportBound
 856     ) env lvs_cont
 857
 858 -- The result of lookupLiveVarsForSet, a set of live variables, is
 859 -- only ever tacked onto a decorated expression. It is never used as
 860 -- the basis of a control decision, which might give a black hole.
 861
 862 freeVarsToLiveVars :: FreeVarsInfo -> LneM (StgLiveVars, IdSet)
 863 freeVarsToLiveVars fvs env live_in_cont
 864   = returnLne (lvs `unionVarSet` lvs_cont,
 865                mkVarSet cafs `unionVarSet` cafs_cont)
 866          env live_in_cont
 867   where
 868     (lvs_cont, cafs_cont) = live_in_cont -- not a strict pattern match!
 869     (local, global) = partition isLocalId (allFVs fvs)
 870
 871     cafs = filter is_caf_one global
 872     lvs  = unionVarSets (map do_one local)
 873
 874     do_one v
 875       = if isLocalId v then
 876             case (lookupVarEnv env v) of
 877               Just (LetBound _ lvs) -> extendVarSet lvs v
 878               Just _                -> unitVarSet v
 879               Nothing -> pprPanic "lookupLiveVarsForSet/do_one:" (ppr v)
 880         else
 881             emptyVarSet
 882
 883     is_caf_one v
 884          = case lookupVarEnv env v of
 885                 Just (LetBound TopLevelHasCafs lvs) ->
 886                     ASSERT( isEmptyVarSet lvs ) True
 887                 Just (LetBound _ _) -> False
 888                 _otherwise          -> mayHaveCafRefs (idCafInfo v)
 889 \end{code}
 890
 891 %************************************************************************
 892 %*                                                                      *
 893 \subsection[Free-var info]{Free variable information}
 894 %*                                                                      *
 895 %************************************************************************
 896
 897 \begin{code}
 898 type FreeVarsInfo = VarEnv (Var, TopLevelCafInfo, StgBinderInfo)
 899         -- If f is mapped to noBinderInfo, that means
 900         -- that f *is* mentioned (else it wouldn't be in the
 901         -- IdEnv at all), but perhaps in an unsaturated applications.
 902         --
 903         -- All case/lambda-bound things are also mapped to
 904         -- noBinderInfo, since we aren't interested in their
 905         -- occurence info.
 906         --
 907         -- For ILX we track free var info for type variables too;
 908         -- hence VarEnv not IdEnv
 909
 910 data TopLevelCafInfo
 911   = NotTopLevelBound
 912   | TopLevelNoCafs
 913   | TopLevelHasCafs
 914   deriving Eq
 915
 916 type EscVarsSet = IdSet
 917 \end{code}
 918
 919 \begin{code}
 920 emptyFVInfo :: FreeVarsInfo
 921 emptyFVInfo = emptyVarEnv
 922
 923 singletonFVInfo :: Id -> HowBound -> StgBinderInfo -> FreeVarsInfo
 924 singletonFVInfo id ImportBound info
 925    | mayHaveCafRefs (idCafInfo id) = unitVarEnv id (id, TopLevelHasCafs, info)
 926    | otherwise                     = emptyVarEnv
 927 singletonFVInfo id (LetBound top_level _) info
 928    = unitVarEnv id (id, top_level, info)
 929 singletonFVInfo id other info
 930    = unitVarEnv id (id, NotTopLevelBound, info)
 931
 932 tyvarFVInfo :: TyVarSet -> FreeVarsInfo
 933 tyvarFVInfo tvs = foldVarSet add emptyFVInfo tvs
 934         where
 935           add tv fvs = extendVarEnv fvs tv (tv, NotTopLevelBound, noBinderInfo)
 936
 937 unionFVInfo :: FreeVarsInfo -> FreeVarsInfo -> FreeVarsInfo
 938 unionFVInfo fv1 fv2 = plusVarEnv_C plusFVInfo fv1 fv2
 939
 940 unionFVInfos :: [FreeVarsInfo] -> FreeVarsInfo
 941 unionFVInfos fvs = foldr unionFVInfo emptyFVInfo fvs
 942
 943 minusFVBinders :: [Id] -> FreeVarsInfo -> FreeVarsInfo
 944 minusFVBinders vs fv = foldr minusFVBinder fv vs
 945
 946 minusFVBinder :: Id -> FreeVarsInfo -> FreeVarsInfo
 947 minusFVBinder v fv | isId v && opt_KeepStgTypes
 948                    = (fv `delVarEnv` v) `unionFVInfo`
 949                      tyvarFVInfo (tyVarsOfType (idType v))
 950                    | otherwise = fv `delVarEnv` v
 951         -- When removing a binder, remember to add its type variables
 952         -- c.f. CoreFVs.delBinderFV
 953
 954 elementOfFVInfo :: Id -> FreeVarsInfo -> Bool
 955 elementOfFVInfo id fvs = maybeToBool (lookupVarEnv fvs id)
 956
 957 lookupFVInfo :: FreeVarsInfo -> Id -> StgBinderInfo
 958 -- Find how the given Id is used.
 959 -- Externally visible things may be used any old how
 960 lookupFVInfo fvs id
 961   | isExternallyVisibleName (idName id) = noBinderInfo
 962   | otherwise = case lookupVarEnv fvs id of
 963                         Nothing         -> noBinderInfo
 964                         Just (_,_,info) -> info
 965
 966 allFVs :: FreeVarsInfo -> [Id]  -- Non-top-level things only
 967 allFVs fvs = [id | (id,_,_) <- rngVarEnv fvs]
 968
 969 getFVs :: FreeVarsInfo -> [Id]  -- Non-top-level things only
 970 getFVs fvs = [id | (id,NotTopLevelBound,_) <- rngVarEnv fvs]
 971
 972 getFVSet :: FreeVarsInfo -> IdSet
 973 getFVSet fvs = mkVarSet (getFVs fvs)
 974
 975 plusFVInfo (id1,top1,info1) (id2,top2,info2)
 976   = ASSERT (id1 == id2 && top1 == top2)
 977     (id1, top1, combineStgBinderInfo info1 info2)
 978 \end{code}
 979
 980 Misc.
 981 \begin{code}
 982 filterStgBinders :: [Var] -> [Var]
 983 filterStgBinders bndrs
 984   | opt_KeepStgTypes = bndrs
 985   | otherwise        = filter isId bndrs
 986 \end{code}
 987
 988
 989 \begin{code}
 990         -- Ignore all notes except SCC
 991 myCollectBinders expr
 992   = go [] expr
 993   where
 994     go bs (Lam b e)          = go (b:bs) e
 995     go bs e@(Note (SCC _) _) = (reverse bs, e)
 996     go bs (Note _ e)         = go bs e
 997     go bs e                  = (reverse bs, e)
 998
 999 myCollectArgs :: CoreExpr -> (Id, [CoreArg])
1000         -- We assume that we only have variables
1001         -- in the function position by now
1002 myCollectArgs expr
1003   = go expr []
1004   where
1005     go (Var v)          as = (v, as)
1006     go (App f a) as        = go f (a:as)
1007     go (Note (SCC _) e) as = pprPanic "CoreToStg.myCollectArgs" (ppr expr)
1008     go (Note n e)       as = go e as
1009     go _                as = pprPanic "CoreToStg.myCollectArgs" (ppr expr)
1010 \end{code}
1011
1012 %************************************************************************
1013 %*                                                                      *
1014 \subsection{Figuring out CafInfo for an expression}
1015 %*                                                                      *
1016 %************************************************************************
1017
1018 hasCafRefs decides whether a top-level closure can point into the dynamic heap.
1019 We mark such things as `MayHaveCafRefs' because this information is
1020 used to decide whether a particular closure needs to be referenced
1021 in an SRT or not.
1022
1023 There are two reasons for setting MayHaveCafRefs:
1024         a) The RHS is a CAF: a top-level updatable thunk.
1025         b) The RHS refers to something that MayHaveCafRefs
1026
1027 Possible improvement: In an effort to keep the number of CAFs (and
1028 hence the size of the SRTs) down, we could also look at the expression and
1029 decide whether it requires a small bounded amount of heap, so we can ignore
1030 it as a CAF.  In these cases however, we would need to use an additional
1031 CAF list to keep track of non-collectable CAFs.
1032
1033 \begin{code}
1034 hasCafRefs  :: IdEnv HowBound -> CoreExpr -> CafInfo
1035 -- Only called for the RHS of top-level lets
1036 hasCafRefss :: IdEnv HowBound -> [CoreExpr] -> CafInfo
1037         -- predicate returns True for a given Id if we look at this Id when
1038         -- calculating the result.  Used to *avoid* looking at the CafInfo
1039         -- field for an Id that is part of the current recursive group.
1040
1041 hasCafRefs p expr
1042   | isCAF expr || isFastTrue (cafRefs p expr) =  MayHaveCafRefs
1043   | otherwise = NoCafRefs
1044
1045         -- used for recursive groups.  The whole group is set to
1046         -- "MayHaveCafRefs" if at least one of the group is a CAF or
1047         -- refers to any CAFs.
1048 hasCafRefss p exprs
1049   | any isCAF exprs || isFastTrue (cafRefss p exprs) = MayHaveCafRefs
1050   | otherwise = NoCafRefs
1051
1052 -- cafRefs compiles to beautiful code :)
1053
1054 cafRefs p (Var id)
1055   | isLocalId id = fastBool False
1056   | otherwise =
1057       case lookupVarEnv p id of
1058         Just (LetBound TopLevelHasCafs _) -> fastBool True
1059         Just (LetBound _ _) -> fastBool False
1060         Nothing -> fastBool (cgMayHaveCafRefs (idCgInfo id)) --  imported Ids
1061
1062 cafRefs p (Lit l)            = fastBool False
1063 cafRefs p (App f a)          = fastOr (cafRefs p f) (cafRefs p) a
1064 cafRefs p (Lam x e)          = cafRefs p e
1065 cafRefs p (Let b e)          = fastOr (cafRefss p (rhssOfBind b)) (cafRefs p) e
1066 cafRefs p (Case e bndr alts) = fastOr (cafRefs p e)
1067                                 (cafRefss p) (rhssOfAlts alts)
1068 cafRefs p (Note n e)         = cafRefs p e
1069 cafRefs p (Type t)           = fastBool False
1070
1071 cafRefss p []     = fastBool False
1072 cafRefss p (e:es) = fastOr (cafRefs p e) (cafRefss p) es
1073
1074 -- hack for lazy-or over FastBool.
1075 fastOr a f x = fastBool (isFastTrue a || isFastTrue (f x))
1076
1077 isCAF :: CoreExpr -> Bool
1078 -- Only called for the RHS of top-level lets
1079 isCAF e = not (rhsIsNonUpd e)
1080   {- ToDo: check type for onceness, i.e. non-updatable thunks? -}
1081
1082
1083 rhsIsNonUpd :: CoreExpr -> Bool
1084   -- True => Value-lambda, constructor, PAP
1085   -- This is a bit like CoreUtils.exprIsValue, with the following differences:
1086   --    a) scc "foo" (\x -> ...) is updatable (so we catch the right SCC)
1087   --
1088   --    b) (C x xs), where C is a contructors is updatable if the application is
1089   --       dynamic: see isDynConApp
1090   --
1091   --    c) don't look through unfolding of f in (f x).  I'm suspicious of this one
1092
1093 rhsIsNonUpd (Lam b e)          = isId b || rhsIsNonUpd e
1094 rhsIsNonUpd (Note (SCC _) e)   = False
1095 rhsIsNonUpd (Note _ e)         = rhsIsNonUpd e
1096 rhsIsNonUpd other_expr
1097   = go other_expr 0 []
1098   where
1099     go (Var f) n_args args = idAppIsNonUpd f n_args args
1100
1101     go (App f a) n_args args
1102         | isTypeArg a = go f n_args args
1103         | otherwise   = go f (n_args + 1) (a:args)
1104
1105     go (Note (SCC _) f) n_args args = False
1106     go (Note _ f) n_args args       = go f n_args args
1107
1108     go other n_args args = False
1109
1110 idAppIsNonUpd :: Id -> Int -> [CoreExpr] -> Bool
1111 idAppIsNonUpd id n_val_args args
1112   | Just con <- isDataConId_maybe id = not (isDynConApp con args)
1113   | otherwise                        = n_val_args < idArity id
1114
1115 isDynConApp :: DataCon -> [CoreExpr] -> Bool
1116 isDynConApp con args = isDllName (dataConName con) || any isDynArg args
1117 -- Top-level constructor applications can usually be allocated
1118 -- statically, but they can't if
1119 --      a) the constructor, or any of the arguments, come from another DLL
1120 --      b) any of the arguments are LitLits
1121 -- (because we can't refer to static labels in other DLLs).
1122 -- If this happens we simply make the RHS into an updatable thunk,
1123 -- and 'exectute' it rather than allocating it statically.
1124 -- All this should match the decision in (see CoreToStg.coreToStgRhs)
1125
1126
1127 isDynArg :: CoreExpr -> Bool
1128 isDynArg (Var v)    = isDllName (idName v)
1129 isDynArg (Note _ e) = isDynArg e
1130 isDynArg (Lit lit)  = isLitLitLit lit
1131 isDynArg (App e _)  = isDynArg e        -- must be a type app
1132 isDynArg (Lam _ e)  = isDynArg e        -- must be a type lam
1133 \end{code}