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 {-# OPTIONS -w #-}
  11 -- The above warning supression flag is a temporary kludge.
  12 -- While working on this module you are encouraged to remove it and fix
  13 -- any warnings in the module. See
  14 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
  15 -- for details
  16
  17 module CoreToStg ( coreToStg, coreExprToStg ) where
  18
  19 #include "HsVersions.h"
  20
  21 import CoreSyn
  22 import CoreUtils        ( rhsIsStatic, manifestArity, exprType, findDefault )
  23 import StgSyn
  24
  25 import Type
  26 import TyCon
  27 import Id
  28 import Var              ( Var, globalIdDetails, idType )
  29 import IdInfo
  30 import DataCon
  31 import CostCentre       ( noCCS )
  32 import VarSet
  33 import VarEnv
  34 import Maybes           ( maybeToBool )
  35 import Name             ( getOccName, isExternalName, nameOccName )
  36 import OccName          ( occNameString, occNameFS )
  37 import BasicTypes       ( Arity )
  38 import StaticFlags      ( opt_RuntimeTypes )
  39 import Module
  40 import Outputable
  41 import MonadUtils
  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 The CafInfo has already been calculated during the CoreTidy pass.
 109
 110 During CoreToStg, we then pin onto each binding and case expression, a
 111 list of Ids which represents the "live" CAFs at that point.  The meaning
 112 of "live" here is the same as for live variables, see above (which is
 113 why it's convenient to collect CAF information here rather than elsewhere).
 114
 115 The later SRT pass takes these lists of Ids and uses them to construct
 116 the actual nested SRTs, and replaces the lists of Ids with (offset,length)
 117 pairs.
 118
 119
 120 Interaction of let-no-escape with SRTs   [Sept 01]
 121 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 122 Consider
 123
 124         let-no-escape x = ...caf1...caf2...
 125         in
 126         ...x...x...x...
 127
 128 where caf1,caf2 are CAFs.  Since x doesn't have a closure, we
 129 build SRTs just as if x's defn was inlined at each call site, and
 130 that means that x's CAF refs get duplicated in the overall SRT.
 131
 132 This is unlike ordinary lets, in which the CAF refs are not duplicated.
 133
 134 We could fix this loss of (static) sharing by making a sort of pseudo-closure
 135 for x, solely to put in the SRTs lower down.
 136
 137
 138 %************************************************************************
 139 %*                                                                      *
 140 \subsection[binds-StgVarInfo]{Setting variable info: top-level, binds, RHSs}
 141 %*                                                                      *
 142 %************************************************************************
 143
 144 \begin{code}
 145 coreToStg :: PackageId -> [CoreBind] -> IO [StgBinding]
 146 coreToStg this_pkg pgm
 147   = return pgm'
 148   where (_, _, pgm') = coreTopBindsToStg this_pkg emptyVarEnv pgm
 149
 150 coreExprToStg :: CoreExpr -> StgExpr
 151 coreExprToStg expr
 152   = new_expr where (new_expr,_,_) = initLne emptyVarEnv (coreToStgExpr expr)
 153
 154
 155 coreTopBindsToStg
 156     :: PackageId
 157     -> IdEnv HowBound           -- environment for the bindings
 158     -> [CoreBind]
 159     -> (IdEnv HowBound, FreeVarsInfo, [StgBinding])
 160
 161 coreTopBindsToStg this_pkg env [] = (env, emptyFVInfo, [])
 162 coreTopBindsToStg this_pkg env (b:bs)
 163   = (env2, fvs2, b':bs')
 164   where
 165         -- env accumulates down the list of binds, fvs accumulates upwards
 166         (env1, fvs2, b' ) = coreTopBindToStg this_pkg env fvs1 b
 167         (env2, fvs1, bs') = coreTopBindsToStg this_pkg env1 bs
 168
 169
 170 coreTopBindToStg
 171         :: PackageId
 172         -> IdEnv HowBound
 173         -> FreeVarsInfo         -- Info about the body
 174         -> CoreBind
 175         -> (IdEnv HowBound, FreeVarsInfo, StgBinding)
 176
 177 coreTopBindToStg this_pkg env body_fvs (NonRec id rhs)
 178   = let
 179         env'      = extendVarEnv env id how_bound
 180         how_bound = LetBound TopLet $! manifestArity rhs
 181
 182         (stg_rhs, fvs') =
 183             initLne env $ do
 184               (stg_rhs, fvs') <- coreToTopStgRhs this_pkg body_fvs (id,rhs)
 185               return (stg_rhs, fvs')
 186
 187         bind = StgNonRec id stg_rhs
 188     in
 189     ASSERT2(manifestArity rhs == stgRhsArity stg_rhs, ppr id $$ (ptext SLIT("rhs:")) <+> ppr rhs $$ (ptext SLIT("stg_rhs:"))<+> ppr stg_rhs $$ (ptext SLIT("Manifest:")) <+> (ppr $ manifestArity rhs) $$ (ptext SLIT("STG:")) <+>(ppr $ stgRhsArity stg_rhs) )
 190     ASSERT2(consistentCafInfo id bind, ppr id)
 191 --    WARN(not (consistent caf_info bind), ppr id <+> ppr cafs <+> ppCafInfo caf_info)
 192     (env', fvs' `unionFVInfo` body_fvs, bind)
 193
 194 coreTopBindToStg this_pkg env body_fvs (Rec pairs)
 195   = let
 196         (binders, rhss) = unzip pairs
 197
 198         extra_env' = [ (b, LetBound TopLet $! manifestArity rhs)
 199                      | (b, rhs) <- pairs ]
 200         env' = extendVarEnvList env extra_env'
 201
 202         (stg_rhss, fvs')
 203           = initLne env' $ do
 204                (stg_rhss, fvss') <- mapAndUnzipM (coreToTopStgRhs this_pkg body_fvs) pairs
 205                let fvs' = unionFVInfos fvss'
 206                return (stg_rhss, fvs')
 207
 208         bind = StgRec (zip binders stg_rhss)
 209     in
 210     ASSERT2(and [manifestArity rhs == stgRhsArity stg_rhs | (rhs,stg_rhs) <- rhss `zip` stg_rhss], ppr binders)
 211     ASSERT2(consistentCafInfo (head binders) bind, ppr binders)
 212     (env', fvs' `unionFVInfo` body_fvs, bind)
 213
 214 -- Assertion helper: this checks that the CafInfo on the Id matches
 215 -- what CoreToStg has figured out about the binding's SRT.  The
 216 -- CafInfo will be exact in all cases except when CorePrep has
 217 -- floated out a binding, in which case it will be approximate.
 218 consistentCafInfo id bind
 219   | occNameFS (nameOccName (idName id)) == FSLIT("sat")
 220   = safe
 221   | otherwise
 222   = WARN (not exact, ppr id) safe
 223   where
 224         safe  = id_marked_caffy || not binding_is_caffy
 225         exact = id_marked_caffy == binding_is_caffy
 226         id_marked_caffy  = mayHaveCafRefs (idCafInfo id)
 227         binding_is_caffy = stgBindHasCafRefs bind
 228 \end{code}
 229
 230 \begin{code}
 231 coreToTopStgRhs
 232         :: PackageId
 233         -> FreeVarsInfo         -- Free var info for the scope of the binding
 234         -> (Id,CoreExpr)
 235         -> LneM (StgRhs, FreeVarsInfo)
 236
 237 coreToTopStgRhs this_pkg scope_fv_info (bndr, rhs) = do
 238     (new_rhs, rhs_fvs, _) <- coreToStgExpr rhs
 239     lv_info <- freeVarsToLiveVars rhs_fvs
 240     return (mkTopStgRhs is_static rhs_fvs (mkSRT lv_info) bndr_info new_rhs, rhs_fvs)
 241   where
 242     bndr_info = lookupFVInfo scope_fv_info bndr
 243     is_static = rhsIsStatic this_pkg rhs
 244
 245 mkTopStgRhs :: Bool -> FreeVarsInfo -> SRT -> StgBinderInfo -> StgExpr
 246         -> StgRhs
 247
 248 mkTopStgRhs is_static rhs_fvs srt binder_info (StgLam _ bndrs body)
 249   = ASSERT( is_static )
 250     StgRhsClosure noCCS binder_info
 251                   (getFVs rhs_fvs)
 252                   ReEntrant
 253                   srt
 254                   bndrs body
 255
 256 mkTopStgRhs is_static rhs_fvs srt binder_info (StgConApp con args)
 257   | is_static    -- StgConApps can be updatable (see isCrossDllConApp)
 258   = StgRhsCon noCCS con args
 259
 260 mkTopStgRhs is_static rhs_fvs srt binder_info rhs
 261   = ASSERT2( not is_static, ppr rhs )
 262     StgRhsClosure noCCS binder_info
 263                   (getFVs rhs_fvs)
 264                   Updatable
 265                   srt
 266                   [] rhs
 267 \end{code}
 268
 269
 270 -- ---------------------------------------------------------------------------
 271 -- Expressions
 272 -- ---------------------------------------------------------------------------
 273
 274 \begin{code}
 275 coreToStgExpr
 276         :: CoreExpr
 277         -> LneM (StgExpr,       -- Decorated STG expr
 278                  FreeVarsInfo,  -- Its free vars (NB free, not live)
 279                  EscVarsSet)    -- Its escapees, a subset of its free vars;
 280                                 -- also a subset of the domain of the envt
 281                                 -- because we are only interested in the escapees
 282                                 -- for vars which might be turned into
 283                                 -- let-no-escaped ones.
 284 \end{code}
 285
 286 The second and third components can be derived in a simple bottom up pass, not
 287 dependent on any decisions about which variables will be let-no-escaped or
 288 not.  The first component, that is, the decorated expression, may then depend
 289 on these components, but it in turn is not scrutinised as the basis for any
 290 decisions.  Hence no black holes.
 291
 292 \begin{code}
 293 coreToStgExpr (Lit l) = return (StgLit l, emptyFVInfo, emptyVarSet)
 294 coreToStgExpr (Var v) = coreToStgApp Nothing v []
 295
 296 coreToStgExpr expr@(App _ _)
 297   = coreToStgApp Nothing f args
 298   where
 299     (f, args) = myCollectArgs expr
 300
 301 coreToStgExpr expr@(Lam _ _)
 302   = let
 303         (args, body) = myCollectBinders expr
 304         args'        = filterStgBinders args
 305     in
 306     extendVarEnvLne [ (a, LambdaBound) | a <- args' ] $ do
 307     (body, body_fvs, body_escs) <- coreToStgExpr body
 308     let
 309         fvs             = args' `minusFVBinders` body_fvs
 310         escs            = body_escs `delVarSetList` args'
 311         result_expr | null args' = body
 312                     | otherwise  = StgLam (exprType expr) args' body
 313
 314     return (result_expr, fvs, escs)
 315
 316 coreToStgExpr (Note (SCC cc) expr) = do
 317     (expr2, fvs, escs) <- coreToStgExpr expr
 318     return (StgSCC cc expr2, fvs, escs)
 319
 320 coreToStgExpr (Case (Var id) _bndr ty [(DEFAULT,[],expr)])
 321   | Just (TickBox m n) <- isTickBoxOp_maybe id = do
 322     (expr2, fvs, escs) <- coreToStgExpr expr
 323     return (StgTick m n expr2, fvs, escs)
 324
 325 coreToStgExpr (Note other_note expr)
 326   = coreToStgExpr expr
 327
 328 coreToStgExpr (Cast expr co)
 329   = coreToStgExpr expr
 330
 331 -- Cases require a little more real work.
 332
 333 coreToStgExpr (Case scrut bndr _ alts) = do
 334     (alts2, alts_fvs, alts_escs)
 335        <- extendVarEnvLne [(bndr, LambdaBound)] $ do
 336             (alts2, fvs_s, escs_s) <- mapAndUnzip3M vars_alt alts
 337             return ( alts2,
 338                      unionFVInfos fvs_s,
 339                      unionVarSets escs_s )
 340     let
 341         -- Determine whether the default binder is dead or not
 342         -- This helps the code generator to avoid generating an assignment
 343         -- for the case binder (is extremely rare cases) ToDo: remove.
 344         bndr' | bndr `elementOfFVInfo` alts_fvs = bndr
 345               | otherwise                       = bndr `setIdOccInfo` IAmDead
 346
 347         -- Don't consider the default binder as being 'live in alts',
 348         -- since this is from the point of view of the case expr, where
 349         -- the default binder is not free.
 350         alts_fvs_wo_bndr  = bndr `minusFVBinder` alts_fvs
 351         alts_escs_wo_bndr = alts_escs `delVarSet` bndr
 352
 353     alts_lv_info <- freeVarsToLiveVars alts_fvs_wo_bndr
 354
 355         -- We tell the scrutinee that everything
 356         -- live in the alts is live in it, too.
 357     (scrut2, scrut_fvs, scrut_escs, scrut_lv_info)
 358        <- setVarsLiveInCont alts_lv_info $ do
 359             (scrut2, scrut_fvs, scrut_escs) <- coreToStgExpr scrut
 360             scrut_lv_info <- freeVarsToLiveVars scrut_fvs
 361             return (scrut2, scrut_fvs, scrut_escs, scrut_lv_info)
 362
 363     return (
 364       StgCase scrut2 (getLiveVars scrut_lv_info)
 365                      (getLiveVars alts_lv_info)
 366                      bndr'
 367                      (mkSRT alts_lv_info)
 368                      (mkStgAltType bndr alts)
 369                      alts2,
 370       scrut_fvs `unionFVInfo` alts_fvs_wo_bndr,
 371       alts_escs_wo_bndr `unionVarSet` getFVSet scrut_fvs
 372                 -- You might think we should have scrut_escs, not
 373                 -- (getFVSet scrut_fvs), but actually we can't call, and
 374                 -- then return from, a let-no-escape thing.
 375       )
 376   where
 377     vars_alt (con, binders, rhs)
 378       = let     -- Remove type variables
 379             binders' = filterStgBinders binders
 380         in
 381         extendVarEnvLne [(b, LambdaBound) | b <- binders'] $ do
 382         (rhs2, rhs_fvs, rhs_escs) <- coreToStgExpr rhs
 383         let
 384                 -- Records whether each param is used in the RHS
 385             good_use_mask = [ b `elementOfFVInfo` rhs_fvs | b <- binders' ]
 386
 387         return ( (con, binders', good_use_mask, rhs2),
 388                  binders' `minusFVBinders` rhs_fvs,
 389                  rhs_escs `delVarSetList` binders' )
 390                 -- ToDo: remove the delVarSet;
 391                 -- since escs won't include any of these binders
 392 \end{code}
 393
 394 Lets not only take quite a bit of work, but this is where we convert
 395 then to let-no-escapes, if we wish.
 396
 397 (Meanwhile, we don't expect to see let-no-escapes...)
 398 \begin{code}
 399 coreToStgExpr (Let bind body) = do
 400     (new_let, fvs, escs, _)
 401        <- mfix (\ ~(_, _, _, no_binder_escapes) ->
 402              coreToStgLet no_binder_escapes bind body
 403           )
 404
 405     return (new_let, fvs, escs)
 406 \end{code}
 407
 408 \begin{code}
 409 mkStgAltType bndr alts
 410   = case splitTyConApp_maybe (repType (idType bndr)) of
 411         Just (tc,_) | isUnboxedTupleTyCon tc -> UbxTupAlt tc
 412                     | isUnLiftedTyCon tc     -> PrimAlt tc
 413                     | isHiBootTyCon tc       -> look_for_better_tycon
 414                     | isAlgTyCon tc          -> AlgAlt tc
 415                     | otherwise              -> ASSERT( _is_poly_alt_tycon tc )
 416                                                 PolyAlt
 417         Nothing                              -> PolyAlt
 418
 419   where
 420    _is_poly_alt_tycon tc
 421         =  isFunTyCon tc
 422         || isPrimTyCon tc   -- "Any" is lifted but primitive
 423         || isOpenTyCon tc   -- Type family; e.g. arising from strict
 424                             -- function application where argument has a
 425                             -- type-family type
 426
 427    -- Sometimes, the TyCon is a HiBootTyCon which may not have any
 428    -- constructors inside it.  Then we can get a better TyCon by
 429    -- grabbing the one from a constructor alternative
 430    -- if one exists.
 431    look_for_better_tycon
 432         | ((DataAlt con, _, _) : _) <- data_alts =
 433                 AlgAlt (dataConTyCon con)
 434         | otherwise =
 435                 ASSERT(null data_alts)
 436                 PolyAlt
 437         where
 438                 (data_alts, _deflt) = findDefault alts
 439 \end{code}
 440
 441
 442 -- ---------------------------------------------------------------------------
 443 -- Applications
 444 -- ---------------------------------------------------------------------------
 445
 446 \begin{code}
 447 coreToStgApp
 448          :: Maybe UpdateFlag            -- Just upd <=> this application is
 449                                         -- the rhs of a thunk binding
 450                                         --      x = [...] \upd [] -> the_app
 451                                         -- with specified update flag
 452         -> Id                           -- Function
 453         -> [CoreArg]                    -- Arguments
 454         -> LneM (StgExpr, FreeVarsInfo, EscVarsSet)
 455
 456
 457 coreToStgApp maybe_thunk_body f args = do
 458     (args', args_fvs) <- coreToStgArgs args
 459     how_bound <- lookupVarLne f
 460
 461     let
 462         n_val_args       = valArgCount args
 463         not_letrec_bound = not (isLetBound how_bound)
 464         fun_fvs
 465           = let fvs = singletonFVInfo f how_bound fun_occ in
 466             -- e.g. (f :: a -> int) (x :: a)
 467             -- Here the free variables are "f", "x" AND the type variable "a"
 468             -- coreToStgArgs will deal with the arguments recursively
 469             if opt_RuntimeTypes then
 470               fvs `unionFVInfo` tyvarFVInfo (tyVarsOfType (idType f))
 471             else fvs
 472
 473         -- Mostly, the arity info of a function is in the fn's IdInfo
 474         -- But new bindings introduced by CoreSat may not have no
 475         -- arity info; it would do us no good anyway.  For example:
 476         --      let f = \ab -> e in f
 477         -- No point in having correct arity info for f!
 478         -- Hence the hasArity stuff below.
 479         -- NB: f_arity is only consulted for LetBound things
 480         f_arity   = stgArity f how_bound
 481         saturated = f_arity <= n_val_args
 482
 483         fun_occ
 484          | not_letrec_bound         = noBinderInfo      -- Uninteresting variable
 485          | f_arity > 0 && saturated = stgSatOcc -- Saturated or over-saturated function call
 486          | otherwise                = stgUnsatOcc       -- Unsaturated function or thunk
 487
 488         fun_escs
 489          | not_letrec_bound      = emptyVarSet  -- Only letrec-bound escapees are interesting
 490          | f_arity == n_val_args = emptyVarSet  -- A function *or thunk* with an exactly
 491                                                 -- saturated call doesn't escape
 492                                                 -- (let-no-escape applies to 'thunks' too)
 493
 494          | otherwise         = unitVarSet f     -- Inexact application; it does escape
 495
 496         -- At the moment of the call:
 497
 498         --  either the function is *not* let-no-escaped, in which case
 499         --         nothing is live except live_in_cont
 500         --      or the function *is* let-no-escaped in which case the
 501         --         variables it uses are live, but still the function
 502         --         itself is not.  PS.  In this case, the function's
 503         --         live vars should already include those of the
 504         --         continuation, but it does no harm to just union the
 505         --         two regardless.
 506
 507         res_ty = exprType (mkApps (Var f) args)
 508         app = case globalIdDetails f of
 509                 DataConWorkId dc | saturated -> StgConApp dc args'
 510                 PrimOpId op      -> ASSERT( saturated )
 511                                     StgOpApp (StgPrimOp op) args' res_ty
 512                 FCallId call     -> ASSERT( saturated )
 513                                     StgOpApp (StgFCallOp call (idUnique f)) args' res_ty
 514                 TickBoxOpId {}   -> pprPanic "coreToStg TickBox" $ ppr (f,args')
 515                 _other           -> StgApp f args'
 516
 517     return (
 518         app,
 519         fun_fvs  `unionFVInfo` args_fvs,
 520         fun_escs `unionVarSet` (getFVSet args_fvs)
 521                                 -- All the free vars of the args are disqualified
 522                                 -- from being let-no-escaped.
 523      )
 524
 525
 526
 527 -- ---------------------------------------------------------------------------
 528 -- Argument lists
 529 -- This is the guy that turns applications into A-normal form
 530 -- ---------------------------------------------------------------------------
 531
 532 coreToStgArgs :: [CoreArg] -> LneM ([StgArg], FreeVarsInfo)
 533 coreToStgArgs []
 534   = return ([], emptyFVInfo)
 535
 536 coreToStgArgs (Type ty : args) = do     -- Type argument
 537     (args', fvs) <- coreToStgArgs args
 538     if opt_RuntimeTypes then
 539         return (StgTypeArg ty : args', fvs `unionFVInfo` tyvarFVInfo (tyVarsOfType ty))
 540      else
 541         return (args', fvs)
 542
 543 coreToStgArgs (arg : args) = do         -- Non-type argument
 544     (stg_args, args_fvs) <- coreToStgArgs args
 545     (arg', arg_fvs, escs) <- coreToStgExpr arg
 546     let
 547         fvs = args_fvs `unionFVInfo` arg_fvs
 548         stg_arg = case arg' of
 549                        StgApp v []      -> StgVarArg v
 550                        StgConApp con [] -> StgVarArg (dataConWorkId con)
 551                        StgLit lit       -> StgLitArg lit
 552                        _                -> pprPanic "coreToStgArgs" (ppr arg)
 553
 554         -- WARNING: what if we have an argument like (v `cast` co)
 555         --          where 'co' changes the representation type?
 556         --          (This really only happens if co is unsafe.)
 557         -- Then all the getArgAmode stuff in CgBindery will set the
 558         -- cg_rep of the CgIdInfo based on the type of v, rather
 559         -- than the type of 'co'.
 560         -- This matters particularly when the function is a primop
 561         -- or foreign call.
 562         -- Wanted: a better solution than this hacky warning
 563     let
 564         arg_ty = exprType arg
 565         stg_arg_ty = stgArgType stg_arg
 566         bad_args = (isUnLiftedType arg_ty && not (isUnLiftedType stg_arg_ty))
 567                 || (typePrimRep arg_ty /= typePrimRep stg_arg_ty)
 568         -- In GHCi we coerce an argument of type BCO# (unlifted) to HValue (lifted),
 569         -- and pass it to a function expecting an HValue (arg_ty).  This is ok because
 570         -- we can treat an unlifted value as lifted.  But the other way round
 571         -- we complain.
 572         -- We also want to check if a pointer is cast to a non-ptr etc
 573
 574     WARN( bad_args, ptext SLIT("Dangerous-looking argument. Probable cause: bad unsafeCoerce#") $$ ppr arg )
 575      return (stg_arg : stg_args, fvs)
 576
 577
 578 -- ---------------------------------------------------------------------------
 579 -- The magic for lets:
 580 -- ---------------------------------------------------------------------------
 581
 582 coreToStgLet
 583          :: Bool        -- True <=> yes, we are let-no-escaping this let
 584          -> CoreBind    -- bindings
 585          -> CoreExpr    -- body
 586          -> LneM (StgExpr,      -- new let
 587                   FreeVarsInfo, -- variables free in the whole let
 588                   EscVarsSet,   -- variables that escape from the whole let
 589                   Bool)         -- True <=> none of the binders in the bindings
 590                                 -- is among the escaping vars
 591
 592 coreToStgLet let_no_escape bind body = do
 593     (bind2, bind_fvs, bind_escs, bind_lvs,
 594      body2, body_fvs, body_escs, body_lvs)
 595        <- mfix $ \ ~(_, _, _, _, _, rec_body_fvs, _, _) -> do
 596
 597           -- Do the bindings, setting live_in_cont to empty if
 598           -- we ain't in a let-no-escape world
 599           live_in_cont <- getVarsLiveInCont
 600           ( bind2, bind_fvs, bind_escs, bind_lv_info, env_ext)
 601                 <- setVarsLiveInCont (if let_no_escape
 602                                           then live_in_cont
 603                                           else emptyLiveInfo)
 604                                      (vars_bind rec_body_fvs bind)
 605
 606           -- Do the body
 607           extendVarEnvLne env_ext $ do
 608              (body2, body_fvs, body_escs) <- coreToStgExpr body
 609              body_lv_info <- freeVarsToLiveVars body_fvs
 610
 611              return (bind2, bind_fvs, bind_escs, getLiveVars bind_lv_info,
 612                      body2, body_fvs, body_escs, getLiveVars body_lv_info)
 613
 614
 615         -- Compute the new let-expression
 616     let
 617         new_let | let_no_escape = StgLetNoEscape live_in_whole_let bind_lvs bind2 body2
 618                 | otherwise     = StgLet bind2 body2
 619
 620         free_in_whole_let
 621           = binders `minusFVBinders` (bind_fvs `unionFVInfo` body_fvs)
 622
 623         live_in_whole_let
 624           = bind_lvs `unionVarSet` (body_lvs `delVarSetList` binders)
 625
 626         real_bind_escs = if let_no_escape then
 627                             bind_escs
 628                          else
 629                             getFVSet bind_fvs
 630                             -- Everything escapes which is free in the bindings
 631
 632         let_escs = (real_bind_escs `unionVarSet` body_escs) `delVarSetList` binders
 633
 634         all_escs = bind_escs `unionVarSet` body_escs    -- Still includes binders of
 635                                                         -- this let(rec)
 636
 637         no_binder_escapes = isEmptyVarSet (set_of_binders `intersectVarSet` all_escs)
 638
 639 #ifdef DEBUG
 640         -- Debugging code as requested by Andrew Kennedy
 641         checked_no_binder_escapes
 642                 | not no_binder_escapes && any is_join_var binders
 643                 = pprTrace "Interesting!  A join var that isn't let-no-escaped" (ppr binders)
 644                   False
 645                 | otherwise = no_binder_escapes
 646 #else
 647         checked_no_binder_escapes = no_binder_escapes
 648 #endif
 649
 650                 -- Mustn't depend on the passed-in let_no_escape flag, since
 651                 -- no_binder_escapes is used by the caller to derive the flag!
 652     return (
 653         new_let,
 654         free_in_whole_let,
 655         let_escs,
 656         checked_no_binder_escapes
 657       )
 658   where
 659     set_of_binders = mkVarSet binders
 660     binders        = bindersOf bind
 661
 662     mk_binding bind_lv_info binder rhs
 663         = (binder, LetBound (NestedLet live_vars) (manifestArity rhs))
 664         where
 665            live_vars | let_no_escape = addLiveVar bind_lv_info binder
 666                      | otherwise     = unitLiveVar binder
 667                 -- c.f. the invariant on NestedLet
 668
 669     vars_bind :: FreeVarsInfo           -- Free var info for body of binding
 670               -> CoreBind
 671               -> LneM (StgBinding,
 672                        FreeVarsInfo,
 673                        EscVarsSet,        -- free vars; escapee vars
 674                        LiveInfo,          -- Vars and CAFs live in binding
 675                        [(Id, HowBound)])  -- extension to environment
 676
 677
 678     vars_bind body_fvs (NonRec binder rhs) = do
 679         (rhs2, bind_fvs, bind_lv_info, escs) <- coreToStgRhs body_fvs [] (binder,rhs)
 680         let
 681             env_ext_item = mk_binding bind_lv_info binder rhs
 682
 683         return (StgNonRec binder rhs2,
 684                 bind_fvs, escs, bind_lv_info, [env_ext_item])
 685
 686
 687     vars_bind body_fvs (Rec pairs)
 688       = mfix $ \ ~(_, rec_rhs_fvs, _, bind_lv_info, _) ->
 689            let
 690                 rec_scope_fvs = unionFVInfo body_fvs rec_rhs_fvs
 691                 binders = map fst pairs
 692                 env_ext = [ mk_binding bind_lv_info b rhs
 693                           | (b,rhs) <- pairs ]
 694            in
 695            extendVarEnvLne env_ext $ do
 696               (rhss2, fvss, lv_infos, escss)
 697                      <- mapAndUnzip4M (coreToStgRhs rec_scope_fvs binders) pairs
 698               let
 699                         bind_fvs = unionFVInfos fvss
 700                         bind_lv_info = foldr unionLiveInfo emptyLiveInfo lv_infos
 701                         escs     = unionVarSets escss
 702
 703               return (StgRec (binders `zip` rhss2),
 704                       bind_fvs, escs, bind_lv_info, env_ext)
 705
 706
 707 is_join_var :: Id -> Bool
 708 -- A hack (used only for compiler debuggging) to tell if
 709 -- a variable started life as a join point ($j)
 710 is_join_var j = occNameString (getOccName j) == "$j"
 711 \end{code}
 712
 713 \begin{code}
 714 coreToStgRhs :: FreeVarsInfo            -- Free var info for the scope of the binding
 715              -> [Id]
 716              -> (Id,CoreExpr)
 717              -> LneM (StgRhs, FreeVarsInfo, LiveInfo, EscVarsSet)
 718
 719 coreToStgRhs scope_fv_info binders (bndr, rhs) = do
 720     (new_rhs, rhs_fvs, rhs_escs) <- coreToStgExpr rhs
 721     env <- getEnvLne
 722     lv_info <- freeVarsToLiveVars (binders `minusFVBinders` rhs_fvs)
 723     return (mkStgRhs rhs_fvs (mkSRT lv_info) bndr_info new_rhs,
 724             rhs_fvs, lv_info, rhs_escs)
 725   where
 726     bndr_info = lookupFVInfo scope_fv_info bndr
 727
 728 mkStgRhs :: FreeVarsInfo -> SRT -> StgBinderInfo -> StgExpr -> StgRhs
 729
 730 mkStgRhs rhs_fvs srt binder_info (StgConApp con args)
 731   = StgRhsCon noCCS con args
 732
 733 mkStgRhs rhs_fvs srt binder_info (StgLam _ bndrs body)
 734   = StgRhsClosure noCCS binder_info
 735                   (getFVs rhs_fvs)
 736                   ReEntrant
 737                   srt bndrs body
 738
 739 mkStgRhs rhs_fvs srt binder_info rhs
 740   = StgRhsClosure noCCS binder_info
 741                   (getFVs rhs_fvs)
 742                   upd_flag srt [] rhs
 743   where
 744    upd_flag = Updatable
 745   {-
 746     SDM: disabled.  Eval/Apply can't handle functions with arity zero very
 747     well; and making these into simple non-updatable thunks breaks other
 748     assumptions (namely that they will be entered only once).
 749
 750     upd_flag | isPAP env rhs  = ReEntrant
 751              | otherwise      = Updatable
 752   -}
 753
 754 {- ToDo:
 755           upd = if isOnceDem dem
 756                     then (if isNotTop toplev
 757                             then SingleEntry    -- HA!  Paydirt for "dem"
 758                             else
 759 #ifdef DEBUG
 760                      trace "WARNING: SE CAFs unsupported, forcing UPD instead" $
 761 #endif
 762                      Updatable)
 763                 else Updatable
 764         -- For now we forbid SingleEntry CAFs; they tickle the
 765         -- ASSERT in rts/Storage.c line 215 at newCAF() re mut_link,
 766         -- and I don't understand why.  There's only one SE_CAF (well,
 767         -- only one that tickled a great gaping bug in an earlier attempt
 768         -- at ClosureInfo.getEntryConvention) in the whole of nofib,
 769         -- specifically Main.lvl6 in spectral/cryptarithm2.
 770         -- So no great loss.  KSW 2000-07.
 771 -}
 772 \end{code}
 773
 774 Detect thunks which will reduce immediately to PAPs, and make them
 775 non-updatable.  This has several advantages:
 776
 777         - the non-updatable thunk behaves exactly like the PAP,
 778
 779         - the thunk is more efficient to enter, because it is
 780           specialised to the task.
 781
 782         - we save one update frame, one stg_update_PAP, one update
 783           and lots of PAP_enters.
 784
 785         - in the case where the thunk is top-level, we save building
 786           a black hole and futhermore the thunk isn't considered to
 787           be a CAF any more, so it doesn't appear in any SRTs.
 788
 789 We do it here, because the arity information is accurate, and we need
 790 to do it before the SRT pass to save the SRT entries associated with
 791 any top-level PAPs.
 792
 793 isPAP env (StgApp f args) = listLengthCmp args arity == LT -- idArity f > length args
 794                           where
 795                             arity = stgArity f (lookupBinding env f)
 796 isPAP env _               = False
 797
 798
 799 %************************************************************************
 800 %*                                                                      *
 801 \subsection[LNE-monad]{A little monad for this let-no-escaping pass}
 802 %*                                                                      *
 803 %************************************************************************
 804
 805 There's a lot of stuff to pass around, so we use this @LneM@ monad to
 806 help.  All the stuff here is only passed *down*.
 807
 808 \begin{code}
 809 newtype LneM a = LneM
 810     { unLneM :: IdEnv HowBound
 811              -> LiveInfo                -- Vars and CAFs live in continuation
 812              -> a
 813     }
 814
 815 type LiveInfo = (StgLiveVars,   -- Dynamic live variables;
 816                                 -- i.e. ones with a nested (non-top-level) binding
 817                  CafSet)        -- Static live variables;
 818                                 -- i.e. top-level variables that are CAFs or refer to them
 819
 820 type EscVarsSet = IdSet
 821 type CafSet     = IdSet
 822
 823 data HowBound
 824   = ImportBound         -- Used only as a response to lookupBinding; never
 825                         -- exists in the range of the (IdEnv HowBound)
 826
 827   | LetBound            -- A let(rec) in this module
 828         LetInfo         -- Whether top level or nested
 829         Arity           -- Its arity (local Ids don't have arity info at this point)
 830
 831   | LambdaBound         -- Used for both lambda and case
 832
 833 data LetInfo
 834   = TopLet              -- top level things
 835   | NestedLet LiveInfo  -- For nested things, what is live if this
 836                         -- thing is live?  Invariant: the binder
 837                         -- itself is always a member of
 838                         -- the dynamic set of its own LiveInfo
 839
 840 isLetBound (LetBound _ _) = True
 841 isLetBound other          = False
 842
 843 topLevelBound ImportBound         = True
 844 topLevelBound (LetBound TopLet _) = True
 845 topLevelBound other               = False
 846 \end{code}
 847
 848 For a let(rec)-bound variable, x, we record LiveInfo, the set of
 849 variables that are live if x is live.  This LiveInfo comprises
 850         (a) dynamic live variables (ones with a non-top-level binding)
 851         (b) static live variabes (CAFs or things that refer to CAFs)
 852
 853 For "normal" variables (a) is just x alone.  If x is a let-no-escaped
 854 variable then x is represented by a code pointer and a stack pointer
 855 (well, one for each stack).  So all of the variables needed in the
 856 execution of x are live if x is, and are therefore recorded in the
 857 LetBound constructor; x itself *is* included.
 858
 859 The set of dynamic live variables is guaranteed ot have no further let-no-escaped
 860 variables in it.
 861
 862 \begin{code}
 863 emptyLiveInfo :: LiveInfo
 864 emptyLiveInfo = (emptyVarSet,emptyVarSet)
 865
 866 unitLiveVar :: Id -> LiveInfo
 867 unitLiveVar lv = (unitVarSet lv, emptyVarSet)
 868
 869 unitLiveCaf :: Id -> LiveInfo
 870 unitLiveCaf caf = (emptyVarSet, unitVarSet caf)
 871
 872 addLiveVar :: LiveInfo -> Id -> LiveInfo
 873 addLiveVar (lvs, cafs) id = (lvs `extendVarSet` id, cafs)
 874
 875 unionLiveInfo :: LiveInfo -> LiveInfo -> LiveInfo
 876 unionLiveInfo (lv1,caf1) (lv2,caf2) = (lv1 `unionVarSet` lv2, caf1 `unionVarSet` caf2)
 877
 878 mkSRT :: LiveInfo -> SRT
 879 mkSRT (_, cafs) = SRTEntries cafs
 880
 881 getLiveVars :: LiveInfo -> StgLiveVars
 882 getLiveVars (lvs, _) = lvs
 883 \end{code}
 884
 885
 886 The std monad functions:
 887 \begin{code}
 888 initLne :: IdEnv HowBound -> LneM a -> a
 889 initLne env m = unLneM m env emptyLiveInfo
 890
 891
 892
 893 {-# INLINE thenLne #-}
 894 {-# INLINE returnLne #-}
 895
 896 returnLne :: a -> LneM a
 897 returnLne e = LneM $ \env lvs_cont -> e
 898
 899 thenLne :: LneM a -> (a -> LneM b) -> LneM b
 900 thenLne m k = LneM $ \env lvs_cont
 901   -> unLneM (k (unLneM m env lvs_cont)) env lvs_cont
 902
 903 instance Monad LneM where
 904     return = returnLne
 905     (>>=)  = thenLne
 906
 907 instance MonadFix LneM where
 908     mfix expr = LneM $ \env lvs_cont ->
 909                        let result = unLneM (expr result) env lvs_cont
 910                        in  result
 911 \end{code}
 912
 913 Functions specific to this monad:
 914
 915 \begin{code}
 916 getVarsLiveInCont :: LneM LiveInfo
 917 getVarsLiveInCont = LneM $ \env lvs_cont -> lvs_cont
 918
 919 setVarsLiveInCont :: LiveInfo -> LneM a -> LneM a
 920 setVarsLiveInCont new_lvs_cont expr
 921    =    LneM $   \env lvs_cont
 922    -> unLneM expr env new_lvs_cont
 923
 924 extendVarEnvLne :: [(Id, HowBound)] -> LneM a -> LneM a
 925 extendVarEnvLne ids_w_howbound expr
 926    =    LneM $   \env lvs_cont
 927    -> unLneM expr (extendVarEnvList env ids_w_howbound) lvs_cont
 928
 929 lookupVarLne :: Id -> LneM HowBound
 930 lookupVarLne v = LneM $ \env lvs_cont -> lookupBinding env v
 931
 932 getEnvLne :: LneM (IdEnv HowBound)
 933 getEnvLne = LneM $ \env lvs_cont -> env
 934
 935 lookupBinding :: IdEnv HowBound -> Id -> HowBound
 936 lookupBinding env v = case lookupVarEnv env v of
 937                         Just xx -> xx
 938                         Nothing -> ASSERT2( isGlobalId v, ppr v ) ImportBound
 939
 940
 941 -- The result of lookupLiveVarsForSet, a set of live variables, is
 942 -- only ever tacked onto a decorated expression. It is never used as
 943 -- the basis of a control decision, which might give a black hole.
 944
 945 freeVarsToLiveVars :: FreeVarsInfo -> LneM LiveInfo
 946 freeVarsToLiveVars fvs = LneM freeVarsToLiveVars'
 947  where
 948   freeVarsToLiveVars' env live_in_cont = live_info
 949    where
 950     live_info    = foldr unionLiveInfo live_in_cont lvs_from_fvs
 951     lvs_from_fvs = map do_one (allFreeIds fvs)
 952
 953     do_one (v, how_bound)
 954       = case how_bound of
 955           ImportBound                     -> unitLiveCaf v      -- Only CAF imports are
 956                                                                 -- recorded in fvs
 957           LetBound TopLet _
 958                 | mayHaveCafRefs (idCafInfo v) -> unitLiveCaf v
 959                 | otherwise                    -> emptyLiveInfo
 960
 961           LetBound (NestedLet lvs) _      -> lvs        -- lvs already contains v
 962                                                         -- (see the invariant on NestedLet)
 963
 964           _lambda_or_case_binding         -> unitLiveVar v      -- Bound by lambda or case
 965 \end{code}
 966
 967 %************************************************************************
 968 %*                                                                      *
 969 \subsection[Free-var info]{Free variable information}
 970 %*                                                                      *
 971 %************************************************************************
 972
 973 \begin{code}
 974 type FreeVarsInfo = VarEnv (Var, HowBound, StgBinderInfo)
 975         -- The Var is so we can gather up the free variables
 976         -- as a set.
 977         --
 978         -- The HowBound info just saves repeated lookups;
 979         -- we look up just once when we encounter the occurrence.
 980         -- INVARIANT: Any ImportBound Ids are HaveCafRef Ids
 981         --            Imported Ids without CAF refs are simply
 982         --            not put in the FreeVarsInfo for an expression.
 983         --            See singletonFVInfo and freeVarsToLiveVars
 984         --
 985         -- StgBinderInfo records how it occurs; notably, we
 986         -- are interested in whether it only occurs in saturated
 987         -- applications, because then we don't need to build a
 988         -- curried version.
 989         -- If f is mapped to noBinderInfo, that means
 990         -- that f *is* mentioned (else it wouldn't be in the
 991         -- IdEnv at all), but perhaps in an unsaturated applications.
 992         --
 993         -- All case/lambda-bound things are also mapped to
 994         -- noBinderInfo, since we aren't interested in their
 995         -- occurence info.
 996         --
 997         -- For ILX we track free var info for type variables too;
 998         -- hence VarEnv not IdEnv
 999 \end{code}
1000
1001 \begin{code}
1002 emptyFVInfo :: FreeVarsInfo
1003 emptyFVInfo = emptyVarEnv
1004
1005 singletonFVInfo :: Id -> HowBound -> StgBinderInfo -> FreeVarsInfo
1006 -- Don't record non-CAF imports at all, to keep free-var sets small
1007 singletonFVInfo id ImportBound info
1008    | mayHaveCafRefs (idCafInfo id) = unitVarEnv id (id, ImportBound, info)
1009    | otherwise                     = emptyVarEnv
1010 singletonFVInfo id how_bound info  = unitVarEnv id (id, how_bound, info)
1011
1012 tyvarFVInfo :: TyVarSet -> FreeVarsInfo
1013 tyvarFVInfo tvs = foldVarSet add emptyFVInfo tvs
1014         where
1015           add tv fvs = extendVarEnv fvs tv (tv, LambdaBound, noBinderInfo)
1016                 -- Type variables must be lambda-bound
1017
1018 unionFVInfo :: FreeVarsInfo -> FreeVarsInfo -> FreeVarsInfo
1019 unionFVInfo fv1 fv2 = plusVarEnv_C plusFVInfo fv1 fv2
1020
1021 unionFVInfos :: [FreeVarsInfo] -> FreeVarsInfo
1022 unionFVInfos fvs = foldr unionFVInfo emptyFVInfo fvs
1023
1024 minusFVBinders :: [Id] -> FreeVarsInfo -> FreeVarsInfo
1025 minusFVBinders vs fv = foldr minusFVBinder fv vs
1026
1027 minusFVBinder :: Id -> FreeVarsInfo -> FreeVarsInfo
1028 minusFVBinder v fv | isId v && opt_RuntimeTypes
1029                    = (fv `delVarEnv` v) `unionFVInfo`
1030                      tyvarFVInfo (tyVarsOfType (idType v))
1031                    | otherwise = fv `delVarEnv` v
1032         -- When removing a binder, remember to add its type variables
1033         -- c.f. CoreFVs.delBinderFV
1034
1035 elementOfFVInfo :: Id -> FreeVarsInfo -> Bool
1036 elementOfFVInfo id fvs = maybeToBool (lookupVarEnv fvs id)
1037
1038 lookupFVInfo :: FreeVarsInfo -> Id -> StgBinderInfo
1039 -- Find how the given Id is used.
1040 -- Externally visible things may be used any old how
1041 lookupFVInfo fvs id
1042   | isExternalName (idName id) = noBinderInfo
1043   | otherwise = case lookupVarEnv fvs id of
1044                         Nothing         -> noBinderInfo
1045                         Just (_,_,info) -> info
1046
1047 allFreeIds :: FreeVarsInfo -> [(Id,HowBound)]   -- Both top level and non-top-level Ids
1048 allFreeIds fvs = [(id,how_bound) | (id,how_bound,_) <- varEnvElts fvs, isId id]
1049
1050 -- Non-top-level things only, both type variables and ids
1051 -- (type variables only if opt_RuntimeTypes)
1052 getFVs :: FreeVarsInfo -> [Var]
1053 getFVs fvs = [id | (id, how_bound, _) <- varEnvElts fvs,
1054                     not (topLevelBound how_bound) ]
1055
1056 getFVSet :: FreeVarsInfo -> VarSet
1057 getFVSet fvs = mkVarSet (getFVs fvs)
1058
1059 plusFVInfo (id1,hb1,info1) (id2,hb2,info2)
1060   = ASSERT (id1 == id2 && hb1 `check_eq_how_bound` hb2)
1061     (id1, hb1, combineStgBinderInfo info1 info2)
1062
1063 -- The HowBound info for a variable in the FVInfo should be consistent
1064 check_eq_how_bound ImportBound        ImportBound        = True
1065 check_eq_how_bound LambdaBound        LambdaBound        = True
1066 check_eq_how_bound (LetBound li1 ar1) (LetBound li2 ar2) = ar1 == ar2 && check_eq_li li1 li2
1067 check_eq_how_bound hb1                hb2                = False
1068
1069 check_eq_li (NestedLet _) (NestedLet _) = True
1070 check_eq_li TopLet        TopLet        = True
1071 check_eq_li li1           li2           = False
1072 \end{code}
1073
1074 Misc.
1075 \begin{code}
1076 filterStgBinders :: [Var] -> [Var]
1077 filterStgBinders bndrs
1078   | opt_RuntimeTypes = bndrs
1079   | otherwise        = filter isId bndrs
1080 \end{code}
1081
1082
1083 \begin{code}
1084         -- Ignore all notes except SCC
1085 myCollectBinders expr
1086   = go [] expr
1087   where
1088     go bs (Lam b e)          = go (b:bs) e
1089     go bs e@(Note (SCC _) _) = (reverse bs, e)
1090     go bs (Cast e co)        = go bs e
1091     go bs (Note _ e)         = go bs e
1092     go bs e                  = (reverse bs, e)
1093
1094 myCollectArgs :: CoreExpr -> (Id, [CoreArg])
1095         -- We assume that we only have variables
1096         -- in the function position by now
1097 myCollectArgs expr
1098   = go expr []
1099   where
1100     go (Var v)          as = (v, as)
1101     go (App f a) as        = go f (a:as)
1102     go (Note (SCC _) e) as = pprPanic "CoreToStg.myCollectArgs" (ppr expr)
1103     go (Cast e co)      as = go e as
1104     go (Note n e)       as = go e as
1105     go _                as = pprPanic "CoreToStg.myCollectArgs" (ppr expr)
1106 \end{code}
1107
1108 \begin{code}
1109 stgArity :: Id -> HowBound -> Arity
1110 stgArity f (LetBound _ arity) = arity
1111 stgArity f ImportBound        = idArity f
1112 stgArity f LambdaBound        = 0
1113 \end{code}