ghc/compiler/coreSyn/CoreSyn.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[CoreSyn]{A data type for the Haskell compiler midsection}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module CoreSyn (
  10         GenCoreBinding(..), GenCoreExpr(..),
  11         GenCoreArg(..), GenCoreBinder(..), GenCoreCaseAlts(..),
  12         GenCoreCaseDefault(..),
  13
  14         bindersOf, pairsFromCoreBinds, rhssOfBind,
  15
  16         mkGenApp, mkValApp, mkTyApp, mkUseApp,
  17         mkApp, mkCon, mkPrim,
  18         mkValLam, mkTyLam, mkUseLam,
  19         mkLam,
  20         collectBinders,
  21
  22         collectArgs, isValArg, notValArg, numValArgs,
  23
  24         mkCoLetAny, mkCoLetNoUnboxed, mkCoLetUnboxedToCase,
  25         mkCoLetsAny, mkCoLetsNoUnboxed, mkCoLetsUnboxedToCase,
  26         mkCoLetrecAny, mkCoLetrecNoUnboxed,
  27
  28         rhssOfAlts,
  29
  30         -- Common type instantiation...
  31         CoreBinding(..),
  32         CoreExpr(..),
  33         CoreBinder(..),
  34         CoreArg(..),
  35         CoreCaseAlts(..),
  36         CoreCaseDefault(..),
  37
  38         -- And not-so-common type instantiations...
  39         TaggedCoreBinding(..),
  40         TaggedCoreExpr(..),
  41         TaggedCoreBinder(..),
  42         TaggedCoreArg(..),
  43         TaggedCoreCaseAlts(..),
  44         TaggedCoreCaseDefault(..),
  45
  46         SimplifiableCoreBinding(..),
  47         SimplifiableCoreExpr(..),
  48         SimplifiableCoreBinder(..),
  49         SimplifiableCoreArg(..),
  50         SimplifiableCoreCaseAlts(..),
  51         SimplifiableCoreCaseDefault(..)
  52
  53         -- and to make the interface self-sufficient ...
  54
  55     ) where
  56
  57 import Ubiq{-uitous-}
  58
  59 import CostCentre       ( showCostCentre, CostCentre )
  60 import Id               ( idType )
  61 import Usage            ( UVar(..) )
  62 import Util             ( panic, assertPanic )
  63
  64 isUnboxedDataType = panic "CoreSyn.isUnboxedDataType"
  65 --eqId :: Id -> Id -> Bool
  66 eqId = panic "CoreSyn.eqId"
  67 \end{code}
  68
  69 %************************************************************************
  70 %*                                                                      *
  71 \subsection[CoreTopBinding_and_CoreBinding]{@CoreTopBinding@ and @GenCoreBinding@}
  72 %*                                                                      *
  73 %************************************************************************
  74
  75 Core programs, bindings, expressions, etc., are parameterised with
  76 respect to the information kept about binding and bound occurrences of
  77 variables, called {\em binders} and {\em val_occ tyvar uvars}, respectively.  [I
  78 don't really like the pair of names; I prefer {\em binder} and {\em
  79 bounder}.  Or {\em binder} and {\em var}.]
  80
  81 A @GenCoreBinding@ is either a single non-recursive binding of a
  82 ``binder'' to an expression, or a mutually-recursive blob of same.
  83 \begin{code}
  84 data GenCoreBinding val_bdr val_occ tyvar uvar
  85   = NonRec      val_bdr (GenCoreExpr val_bdr val_occ tyvar uvar)
  86   | Rec         [(val_bdr, GenCoreExpr val_bdr val_occ tyvar uvar)]
  87 \end{code}
  88
  89 \begin{code}
  90 bindersOf :: GenCoreBinding val_bdr val_occ tyvar uvar -> [val_bdr]
  91
  92 pairsFromCoreBinds ::
  93   [GenCoreBinding val_bdr val_occ tyvar uvar] ->
  94   [(val_bdr, GenCoreExpr val_bdr val_occ tyvar uvar)]
  95
  96 rhssOfBind :: GenCoreBinding val_bdr val_occ tyvar uvar -> [GenCoreExpr val_bdr val_occ tyvar uvar]
  97
  98 bindersOf (NonRec binder _) = [binder]
  99 bindersOf (Rec pairs)       = [binder | (binder, _) <- pairs]
 100
 101 pairsFromCoreBinds []                  = []
 102 pairsFromCoreBinds ((NonRec b e) : bs) = (b,e) :  pairsFromCoreBinds bs
 103 pairsFromCoreBinds ((Rec  pairs) : bs) = pairs ++ pairsFromCoreBinds bs
 104
 105 rhssOfBind (NonRec _ rhs) = [rhs]
 106 rhssOfBind (Rec pairs)    = [rhs | (_,rhs) <- pairs]
 107 \end{code}
 108
 109 %************************************************************************
 110 %*                                                                      *
 111 \subsection[GenCoreExpr]{Core expressions: @GenCoreExpr@}
 112 %*                                                                      *
 113 %************************************************************************
 114
 115 @GenCoreExpr@ is the heart of the ``core'' data types; it is
 116 (more-or-less) boiled-down second-order polymorphic lambda calculus.
 117 For types in the core world, we just keep using @Types@.
 118 \begin{code}
 119 data GenCoreExpr val_bdr val_occ tyvar uvar
 120      = Var    val_occ
 121      | Lit    Literal   -- literal constants
 122 \end{code}
 123
 124 @Cons@ and @Prims@ are saturated constructor and primitive-op
 125 applications (see the comment).  Note: @Con@s are only set up by the
 126 simplifier (and by the desugarer when it knows what it's doing).  The
 127 desugarer sets up constructors as applications of global @Vars@s.
 128
 129 \begin{code}
 130      | Con      Id [GenCoreArg val_occ tyvar uvar]
 131                 -- Saturated constructor application:
 132                 -- The constructor is a function of the form:
 133                 --      /\ a1 -> ... /\ am -> \ b1 -> ... \ bn ->
 134                 -- <expr> where "/\" is a type lambda and "\" the
 135                 -- regular kind; there will be "m" Types and
 136                 -- "n" bindees in the Con args.
 137
 138      | Prim     PrimOp [GenCoreArg val_occ tyvar uvar]
 139                 -- saturated primitive operation;
 140                 -- comment on Cons applies here, too.
 141 \end{code}
 142
 143 Ye olde abstraction and application operators.
 144 \begin{code}
 145      | Lam      (GenCoreBinder val_bdr tyvar uvar)
 146                 (GenCoreExpr   val_bdr val_occ tyvar uvar)
 147
 148      | App      (GenCoreExpr val_bdr val_occ tyvar uvar)
 149                 (GenCoreArg  val_occ tyvar uvar)
 150 \end{code}
 151
 152 Case expressions (\tr{case <expr> of <List of alternatives>}): there
 153 are really two flavours masquerading here---those for scrutinising
 154 {\em algebraic} types and those for {\em primitive} types.  Please see
 155 under @GenCoreCaseAlts@.
 156 \begin{code}
 157      | Case     (GenCoreExpr val_bdr val_occ tyvar uvar)
 158                 (GenCoreCaseAlts val_bdr val_occ tyvar uvar)
 159 \end{code}
 160
 161 A Core case expression \tr{case e of v -> ...} implies evaluation of
 162 \tr{e}; it is not equivalent to \tr{let v = in ...} (as with a Haskell
 163 \tr{case}).
 164
 165 Non-recursive @Lets@ only have one binding; having more than one
 166 doesn't buy you much, and it is an easy way to mess up variable
 167 scoping.
 168 \begin{code}
 169      | Let      (GenCoreBinding val_bdr val_occ tyvar uvar)
 170                 (GenCoreExpr val_bdr val_occ tyvar uvar)
 171                 -- both recursive and non-.
 172                 -- The "GenCoreBinding" records that information
 173 \end{code}
 174
 175 For cost centre scc expressions we introduce a new core construct
 176 @SCC@ so transforming passes have to deal with it explicitly. The
 177 alternative of using a new PrimativeOp may result in a bad
 178 transformations of which we are unaware.
 179 \begin{code}
 180      | SCC      CostCentre                                  -- label of scc
 181                 (GenCoreExpr val_bdr val_occ tyvar uvar)    -- scc expression
 182 \end{code}
 183
 184
 185 %************************************************************************
 186 %*                                                                      *
 187 \subsection{Core-constructing functions with checking}
 188 %*                                                                      *
 189 %************************************************************************
 190
 191 When making @Lets@, we may want to take evasive action if the thing
 192 being bound has unboxed type. We have different variants ...
 193
 194 @mkCoLet(s|rec)Any@             let-binds any binding, regardless of type
 195 @mkCoLet(s|rec)NoUnboxed@       prohibits unboxed bindings
 196 @mkCoLet(s)UnboxedToCase@       converts an unboxed binding to a case
 197                                 (unboxed bindings in a letrec are still prohibited)
 198
 199 \begin{code}
 200 mkCoLetAny :: GenCoreBinding val_bdr val_occ tyvar uvar
 201            -> GenCoreExpr    val_bdr val_occ tyvar uvar
 202            -> GenCoreExpr    val_bdr val_occ tyvar uvar
 203 mkCoLetsAny :: [GenCoreBinding val_bdr val_occ tyvar uvar] ->
 204                 GenCoreExpr val_bdr val_occ tyvar uvar ->
 205                 GenCoreExpr val_bdr val_occ tyvar uvar
 206 mkCoLetrecAny :: [(val_bdr, GenCoreExpr val_bdr val_occ tyvar uvar)]
 207               -> GenCoreExpr val_bdr val_occ tyvar uvar
 208               -> GenCoreExpr val_bdr val_occ tyvar uvar
 209
 210 mkCoLetrecAny []    body = body
 211 mkCoLetrecAny binds body = Let (Rec binds) body
 212
 213 mkCoLetsAny []    expr = expr
 214 mkCoLetsAny binds expr = foldr mkCoLetAny expr binds
 215
 216 mkCoLetAny bind@(Rec binds) body = mkCoLetrecAny binds body
 217 mkCoLetAny bind@(NonRec binder rhs) body
 218   = case body of
 219       Var binder2 | binder `eqId` binder2
 220          -> rhs   -- hey, I have the rhs
 221       other
 222          -> Let bind body
 223 \end{code}
 224
 225 \begin{code}
 226 --mkCoLetNoUnboxed ::
 227 --  GenCoreBinding val_bdr val_occ tyvar uvar ->
 228 --  GenCoreExpr val_bdr val_occ tyvar uvar ->
 229 --  GenCoreExpr val_bdr val_occ tyvar uvar
 230
 231 mkCoLetNoUnboxed bind@(Rec binds) body
 232   = mkCoLetrecNoUnboxed binds body
 233 mkCoLetNoUnboxed bind@(NonRec binder rhs) body
 234   = --ASSERT (not (isUnboxedDataType (idType binder)))
 235     case body of
 236       Var binder2 | binder `eqId` binder2
 237          -> rhs   -- hey, I have the rhs
 238       other
 239          -> Let bind body
 240
 241 mkCoLetsNoUnboxed []    expr = expr
 242 mkCoLetsNoUnboxed binds expr = foldr mkCoLetNoUnboxed expr binds
 243
 244 --mkCoLetrecNoUnboxed :: [(Id, CoreExpr)]       -- bindings
 245 --                  -> CoreExpr         -- body
 246 --                  -> CoreExpr                 -- result
 247
 248 mkCoLetrecNoUnboxed []    body = body
 249 mkCoLetrecNoUnboxed binds body
 250   = ASSERT (all is_boxed_bind binds)
 251     Let (Rec binds) body
 252   where
 253     is_boxed_bind (binder, rhs)
 254       = (not . isUnboxedDataType . idType) binder
 255 \end{code}
 256
 257 \begin{code}
 258 --mkCoLetUnboxedToCase ::
 259 --  GenCoreBinding val_bdr val_occ tyvar uvar ->
 260 --  GenCoreExpr val_bdr val_occ tyvar uvar ->
 261 --  GenCoreExpr val_bdr val_occ tyvar uvar
 262
 263 mkCoLetUnboxedToCase bind@(Rec binds) body
 264   = mkCoLetrecNoUnboxed binds body
 265 mkCoLetUnboxedToCase bind@(NonRec binder rhs) body
 266   = case body of
 267       Var binder2 | binder `eqId` binder2
 268          -> rhs   -- hey, I have the rhs
 269       other
 270          -> if (not (isUnboxedDataType (idType binder))) then
 271                 Let bind body            -- boxed...
 272             else
 273                 Case rhs                  -- unboxed...
 274                   (PrimAlts []
 275                     (BindDefault binder body))
 276
 277 mkCoLetsUnboxedToCase []    expr = expr
 278 mkCoLetsUnboxedToCase binds expr = foldr mkCoLetUnboxedToCase expr binds
 279 \end{code}
 280
 281 %************************************************************************
 282 %*                                                                      *
 283 \subsection{Case alternatives in @GenCoreExpr@}
 284 %*                                                                      *
 285 %************************************************************************
 286
 287 We have different kinds of @case@s, the differences being reflected in
 288 the kinds of alternatives a case has.  We maintain a distinction
 289 between cases for scrutinising algebraic datatypes, as opposed to
 290 primitive types.  In both cases, we carry around a @TyCon@, as a
 291 handle with which we can get info about the case (e.g., total number
 292 of data constructors for this type).
 293
 294 For example:
 295 \begin{verbatim}
 296 let# x=e in b
 297 \end{verbatim}
 298 becomes
 299 \begin{verbatim}
 300 Case e [ BindDefaultAlt x -> b ]
 301 \end{verbatim}
 302
 303 \begin{code}
 304 data GenCoreCaseAlts val_bdr val_occ tyvar uvar
 305   = AlgAlts     [(Id,                           -- alts: data constructor,
 306                   [val_bdr],                    -- constructor's parameters,
 307                   GenCoreExpr val_bdr val_occ tyvar uvar)]      -- rhs.
 308                 (GenCoreCaseDefault val_bdr val_occ tyvar uvar)
 309
 310   | PrimAlts    [(Literal,                      -- alts: unboxed literal,
 311                   GenCoreExpr val_bdr val_occ tyvar uvar)]      -- rhs.
 312                 (GenCoreCaseDefault val_bdr val_occ tyvar uvar)
 313
 314 -- obvious things: if there are no alts in the list, then the default
 315 -- can't be NoDefault.
 316
 317 data GenCoreCaseDefault val_bdr val_occ tyvar uvar
 318   = NoDefault                                   -- small con family: all
 319                                                 -- constructor accounted for
 320   | BindDefault val_bdr                         -- form: var -> expr;
 321                 (GenCoreExpr val_bdr val_occ tyvar uvar)        -- "val_bdr" may or may not
 322                                                 -- be used in RHS.
 323 \end{code}
 324
 325 \begin{code}
 326 rhssOfAlts (AlgAlts alts deflt)  = rhssOfDeflt deflt ++ [rhs | (_,_,rhs) <- alts]
 327 rhssOfAlts (PrimAlts alts deflt) = rhssOfDeflt deflt ++ [rhs | (_,rhs)   <- alts]
 328
 329 rhssOfDeflt NoDefault           = []
 330 rhssOfDeflt (BindDefault _ rhs) = [rhs]
 331 \end{code}
 332
 333 %************************************************************************
 334 %*                                                                      *
 335 \subsection{Core binders}
 336 %*                                                                      *
 337 %************************************************************************
 338
 339 \begin{code}
 340 data GenCoreBinder val_bdr tyvar uvar
 341   = ValBinder   val_bdr
 342   | TyBinder    tyvar
 343   | UsageBinder uvar
 344 \end{code}
 345
 346 Clump Lams together if possible.
 347
 348 \begin{code}
 349 mkValLam :: [val_bdr]
 350          -> GenCoreExpr val_bdr val_occ tyvar uvar
 351          -> GenCoreExpr val_bdr val_occ tyvar uvar
 352 mkTyLam  :: [tyvar]
 353          -> GenCoreExpr val_bdr val_occ tyvar uvar
 354          -> GenCoreExpr val_bdr val_occ tyvar uvar
 355 mkUseLam :: [uvar]
 356          -> GenCoreExpr val_bdr val_occ tyvar uvar
 357          -> GenCoreExpr val_bdr val_occ tyvar uvar
 358
 359 mkValLam binders body = foldr (Lam . ValBinder)   body binders
 360 mkTyLam  binders body = foldr (Lam . TyBinder)    body binders
 361 mkUseLam binders body = foldr (Lam . UsageBinder) body binders
 362
 363 mkLam :: [tyvar] -> [val_bdr] -- ToDo: could add a [uvar] arg...
 364          -> GenCoreExpr val_bdr val_occ tyvar uvar
 365          -> GenCoreExpr val_bdr val_occ tyvar uvar
 366
 367 mkLam tyvars valvars body
 368   = mkTyLam tyvars (mkValLam valvars body)
 369 \end{code}
 370
 371 We often want to strip off leading lambdas before getting down to
 372 business.  @collectBinders@ is your friend.
 373
 374 We expect (by convention) usage-, type-, and value- lambdas in that
 375 order.
 376
 377 \begin{code}
 378 collectBinders ::
 379   GenCoreExpr val_bdr val_occ tyvar uvar ->
 380   ([uvar], [tyvar], [val_bdr], GenCoreExpr val_bdr val_occ tyvar uvar)
 381
 382 collectBinders (Lam (UsageBinder u) body)
 383   = let
 384         (uvars, tyvars, args, final_body) = collectBinders body
 385     in
 386     (u:uvars, tyvars, args, final_body)
 387
 388 collectBinders other
 389   = let
 390         (tyvars, args, body) = dig_for_tyvars other
 391     in
 392     ([], tyvars, args, body)
 393   where
 394     dig_for_tyvars (Lam (TyBinder tv) body)
 395       = let
 396             (tyvars, args, body2) = dig_for_tyvars body
 397         in
 398         (tv : tyvars, args, body2)
 399
 400     dig_for_tyvars body
 401       = ASSERT(not (usage_lambda body))
 402         let
 403             (args, body2) = dig_for_valvars body
 404         in
 405         ([], args, body2)
 406
 407     ---------------------------------------
 408     dig_for_valvars (Lam (ValBinder v) body)
 409       = let
 410             (args, body2) = dig_for_valvars body
 411         in
 412         (v : args, body2)
 413
 414     dig_for_valvars body
 415       = ASSERT(not (usage_lambda body))
 416         ASSERT(not (tyvar_lambda body))
 417         ([], body)
 418
 419     ---------------------------------------
 420     usage_lambda (Lam (UsageBinder _) _) = True
 421     usage_lambda _                       = False
 422
 423     tyvar_lambda (Lam (TyBinder _) _)    = True
 424     tyvar_lambda _                       = False
 425 \end{code}
 426
 427 %************************************************************************
 428 %*                                                                      *
 429 \subsection{Core arguments (atoms)}
 430 %*                                                                      *
 431 %************************************************************************
 432
 433 \begin{code}
 434 data GenCoreArg val_occ tyvar uvar
 435   = LitArg      Literal
 436   | VarArg      val_occ
 437   | TyArg       (GenType tyvar uvar)
 438   | UsageArg    (GenUsage uvar)
 439 \end{code}
 440
 441 General and specific forms:
 442 \begin{code}
 443 mkGenApp :: GenCoreExpr val_bdr val_occ tyvar uvar
 444          -> [GenCoreArg val_occ tyvar uvar]
 445          -> GenCoreExpr val_bdr val_occ tyvar uvar
 446 mkTyApp  :: GenCoreExpr val_bdr val_occ tyvar uvar
 447          -> [GenType tyvar uvar]
 448          -> GenCoreExpr val_bdr val_occ tyvar uvar
 449 mkUseApp :: GenCoreExpr val_bdr val_occ tyvar uvar
 450          -> [GenUsage uvar]
 451          -> GenCoreExpr val_bdr val_occ tyvar uvar
 452 mkValApp :: GenCoreExpr val_bdr val_occ tyvar uvar
 453          -> [GenCoreArg val_occ tyvar uvar] -- but we ASSERT they are LitArg or VarArg
 454          -> GenCoreExpr val_bdr val_occ tyvar uvar
 455
 456 mkGenApp f args = foldl App                                f args
 457 mkTyApp  f args = foldl (\ e a -> App e (TyArg a))         f args
 458 mkUseApp f args = foldl (\ e a -> App e (UsageArg a))      f args
 459 mkValApp f args = foldl (\ e a -> App e (is_Lit_or_Var a)) f args
 460
 461 #ifndef DEBUG
 462 is_Lit_or_Var a = a
 463 #else
 464 is_Lit_or_Var a
 465   = if isValArg a then a else panic "CoreSyn.mkValApps:not LitArg or VarArg"
 466 #endif
 467
 468 isValArg (LitArg _) = True  -- often used for sanity-checking
 469 isValArg (VarArg _) = True
 470 isValArg _          = False
 471
 472 notValArg = not . isValArg -- exists only because it's a common use of isValArg
 473
 474 numValArgs as = length [ a | a <- as, isValArg a ] -- again, convenience
 475 \end{code}
 476
 477 \begin{code}
 478 mkApp  fun = mk_thing (mkGenApp fun)
 479 mkCon  con = mk_thing (Con      con)
 480 mkPrim op  = mk_thing (Prim     op)
 481
 482 mk_thing thing uses tys vals
 483   = thing (map UsageArg uses ++ map TyArg tys ++ map is_Lit_or_Var vals)
 484 \end{code}
 485
 486 @collectArgs@ takes an application expression, returning the function
 487 and the arguments to which it is applied.
 488
 489 \begin{code}
 490 collectArgs :: GenCoreExpr val_bdr val_occ tyvar uvar
 491             -> (GenCoreExpr val_bdr val_occ tyvar uvar,
 492                 [GenCoreArg val_occ tyvar uvar])
 493
 494 collectArgs expr
 495   = collect expr []
 496   where
 497     collect (App fun arg) args = collect fun (arg : args)
 498     collect fun           args = (fun, args)
 499 \end{code}
 500
 501 %************************************************************************
 502 %*                                                                      *
 503 \subsection{The main @Core*@ instantiation of the @GenCore*@ types}
 504 %*                                                                      *
 505 %************************************************************************
 506
 507 \begin{code}
 508 type CoreBinding = GenCoreBinding  Id Id TyVar UVar
 509 type CoreExpr    = GenCoreExpr     Id Id TyVar UVar
 510 type CoreBinder  = GenCoreBinder   Id    TyVar UVar
 511 type CoreArg     = GenCoreArg         Id TyVar UVar
 512
 513 type CoreCaseAlts    = GenCoreCaseAlts    Id Id TyVar UVar
 514 type CoreCaseDefault = GenCoreCaseDefault Id Id TyVar UVar
 515 \end{code}
 516
 517 %************************************************************************
 518 %*                                                                      *
 519 \subsection{The @TaggedCore*@ instantiation of the @GenCore*@ types}
 520 %*                                                                      *
 521 %************************************************************************
 522
 523 Binders are ``tagged'' with a \tr{t}:
 524 \begin{code}
 525 type Tagged t = (Id, t)
 526
 527 type TaggedCoreBinding t = GenCoreBinding (Tagged t) Id TyVar UVar
 528 type TaggedCoreExpr    t = GenCoreExpr    (Tagged t) Id TyVar UVar
 529 type TaggedCoreBinder  t = GenCoreBinder  (Tagged t)    TyVar UVar
 530 type TaggedCoreArg     t = GenCoreArg                Id TyVar UVar
 531
 532 type TaggedCoreCaseAlts    t = GenCoreCaseAlts    (Tagged t) Id TyVar UVar
 533 type TaggedCoreCaseDefault t = GenCoreCaseDefault (Tagged t) Id TyVar UVar
 534 \end{code}
 535
 536 %************************************************************************
 537 %*                                                                      *
 538 \subsection{The @SimplifiableCore*@ instantiation of the @GenCore*@ types}
 539 %*                                                                      *
 540 %************************************************************************
 541
 542 Binders are tagged with @BinderInfo@:
 543 \begin{code}
 544 type Simplifiable = (Id, BinderInfo)
 545
 546 type SimplifiableCoreBinding = GenCoreBinding Simplifiable Id TyVar UVar
 547 type SimplifiableCoreExpr    = GenCoreExpr    Simplifiable Id TyVar UVar
 548 type SimplifiableCoreBinder  = GenCoreBinder  Simplifiable    TyVar UVar
 549 type SimplifiableCoreArg     = GenCoreArg                  Id TyVar UVar
 550
 551 type SimplifiableCoreCaseAlts    = GenCoreCaseAlts    Simplifiable Id TyVar UVar
 552 type SimplifiableCoreCaseDefault = GenCoreCaseDefault Simplifiable Id TyVar UVar
 553 \end{code}