ghc/compiler/typecheck/TcEnv.lhs

   1 \begin{code}
   2 module TcEnv(
   3         TcId, TcIdSet,
   4         TyThing(..), TyThingDetails(..), TcTyThing(..),
   5
   6         -- Getting stuff from the environment
   7         TcEnv, initTcEnv,
   8         tcEnvTyCons, tcEnvClasses, tcEnvIds, tcEnvTcIds, tcEnvTyVars,
   9         getTcGEnv,
  10
  11         -- Instance environment, and InstInfo type
  12         tcGetInstEnv, tcSetInstEnv,
  13         InstInfo(..), pprInstInfo,
  14         simpleInstInfoTy, simpleInstInfoTyCon,
  15
  16         -- Global environment
  17         tcExtendGlobalEnv, tcExtendGlobalValEnv,
  18         tcLookupTyCon, tcLookupClass, tcLookupGlobalId, tcLookupDataCon,
  19         tcLookupGlobal_maybe, tcLookupGlobal, tcLookupSyntaxId, tcLookupSyntaxName,
  20
  21         -- Local environment
  22         tcExtendKindEnv,  tcLookupLocalIds,
  23         tcExtendTyVarEnv, tcExtendTyVarEnvForMeths,
  24         tcExtendLocalValEnv, tcLookup, tcLookup_maybe,
  25
  26         -- Global type variables
  27         tcGetGlobalTyVars, tcExtendGlobalTyVars,
  28
  29         -- Random useful things
  30         RecTcEnv, tcAddImportedIdInfo, tcLookupRecId, tcLookupRecId_maybe,
  31
  32         -- New Ids
  33         newLocalId, newSpecPragmaId,
  34         newDFunName,
  35
  36         -- Misc
  37         isLocalThing, tcSetEnv
  38   ) where
  39
  40 #include "HsVersions.h"
  41
  42 import RnHsSyn          ( RenamedMonoBinds, RenamedSig )
  43 import TcMonad
  44 import TcType           ( TcKind,  TcType, TcTyVar, TcTyVarSet,
  45                           zonkTcTyVarsAndFV
  46                         )
  47 import Id               ( idName, mkUserLocal, isDataConWrapId_maybe )
  48 import IdInfo           ( constantIdInfo )
  49 import MkId             ( mkSpecPragmaId )
  50 import Var              ( TyVar, Id, idType, lazySetIdInfo, idInfo )
  51 import VarSet
  52 import Type             ( Type,
  53                           tyVarsOfTypes, splitDFunTy,
  54                           getDFunTyKey, tyConAppTyCon
  55                         )
  56 import DataCon          ( DataCon )
  57 import TyCon            ( TyCon )
  58 import Class            ( Class, ClassOpItem, ClassContext )
  59 import Name             ( Name, OccName, NamedThing(..),
  60                           nameOccName, getSrcLoc, mkLocalName, isLocalName,
  61                           nameIsLocalOrFrom, nameModule_maybe
  62                         )
  63 import Name             ( NameEnv, lookupNameEnv, nameEnvElts, extendNameEnvList, emptyNameEnv )
  64 import OccName          ( mkDFunOcc, occNameString )
  65 import HscTypes         ( DFunId, TypeEnv, HomeSymbolTable, PackageTypeEnv,
  66                           typeEnvTyCons, typeEnvClasses, typeEnvIds
  67                         )
  68 import Module           ( Module )
  69 import InstEnv          ( InstEnv, emptyInstEnv )
  70 import HscTypes         ( lookupType, TyThing(..) )
  71 import Util             ( zipEqual )
  72 import SrcLoc           ( SrcLoc )
  73 import qualified PrelNames
  74 import Outputable
  75
  76 import IOExts           ( newIORef )
  77 \end{code}
  78
  79 %************************************************************************
  80 %*                                                                      *
  81 \subsection{TcEnv}
  82 %*                                                                      *
  83 %************************************************************************
  84
  85 \begin{code}
  86 type TcId    = Id                       -- Type may be a TcType
  87 type TcIdSet = IdSet
  88
  89 data TcEnv
  90   = TcEnv {
  91         tcSyntaxMap :: PrelNames.SyntaxMap,     -- The syntax map (usually the identity)
  92
  93         tcGST    :: Name -> Maybe TyThing,      -- The type environment at the moment we began this compilation
  94
  95         tcInsts  :: InstEnv,            -- All instances (both imported and in this module)
  96
  97         tcGEnv   :: TypeEnv,            -- The global type environment we've accumulated while
  98                  {- NameEnv TyThing-}   -- compiling this module:
  99                                         --      types and classes (both imported and local)
 100                                         --      imported Ids
 101                                         -- (Ids defined in this module are in the local envt)
 102
 103         tcLEnv   :: NameEnv TcTyThing,  -- The local type environment: Ids and TyVars
 104                                         -- defined in this module
 105
 106         tcTyVars :: TcRef TcTyVarSet    -- The "global tyvars"
 107                                         -- Namely, the in-scope TyVars bound in tcLEnv, plus the tyvars
 108                                         -- mentioned in the types of Ids bound in tcLEnv
 109                                         -- Why mutable? see notes with tcGetGlobalTyVars
 110     }
 111
 112 \end{code}
 113
 114 The Global-Env/Local-Env story
 115 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 116 During type checking, we keep in the GlobalEnv
 117         * All types and classes
 118         * All Ids derived from types and classes (constructors, selectors)
 119         * Imported Ids
 120
 121 At the end of type checking, we zonk the local bindings,
 122 and as we do so we add to the GlobalEnv
 123         * Locally defined top-level Ids
 124
 125 Why?  Because they are now Ids not TcIds.  This final GlobalEnv is
 126 used thus:
 127         a) fed back (via the knot) to typechecking the
 128            unfoldings of interface signatures
 129
 130         b) used to augment the GlobalSymbolTable
 131
 132
 133 \begin{code}
 134 data TcTyThing
 135   = AGlobal TyThing     -- Used only in the return type of a lookup
 136   | ATcId  TcId         -- Ids defined in this module
 137   | ATyVar TyVar        -- Type variables
 138   | AThing TcKind       -- Used temporarily, during kind checking
 139 -- Here's an example of how the AThing guy is used
 140 -- Suppose we are checking (forall a. T a Int):
 141 --      1. We first bind (a -> AThink kv), where kv is a kind variable.
 142 --      2. Then we kind-check the (T a Int) part.
 143 --      3. Then we zonk the kind variable.
 144 --      4. Now we know the kind for 'a', and we add (a -> ATyVar a::K) to the environment
 145
 146 initTcEnv :: PrelNames.SyntaxMap -> HomeSymbolTable -> PackageTypeEnv -> IO TcEnv
 147 initTcEnv syntax_map hst pte
 148   = do { gtv_var <- newIORef emptyVarSet ;
 149          return (TcEnv { tcSyntaxMap = syntax_map,
 150                          tcGST    = lookup,
 151                          tcGEnv   = emptyNameEnv,
 152                          tcInsts  = emptyInstEnv,
 153                          tcLEnv   = emptyNameEnv,
 154                          tcTyVars = gtv_var
 155          })}
 156   where
 157     lookup name | isLocalName name = Nothing
 158                 | otherwise        = lookupType hst pte name
 159
 160
 161 tcEnvClasses env = typeEnvClasses (tcGEnv env)
 162 tcEnvTyCons  env = typeEnvTyCons  (tcGEnv env)
 163 tcEnvIds     env = typeEnvIds     (tcGEnv env)
 164 tcEnvTyVars  env = [tv | ATyVar tv <- nameEnvElts (tcLEnv env)]
 165 tcEnvTcIds   env = [id | ATcId  id <- nameEnvElts (tcLEnv env)]
 166
 167 getTcGEnv (TcEnv { tcGEnv = genv }) = genv
 168
 169 -- This data type is used to help tie the knot
 170 -- when type checking type and class declarations
 171 data TyThingDetails = SynTyDetails Type
 172                     | DataTyDetails ClassContext [DataCon] [Id]
 173                     | ClassDetails ClassContext [Id] [ClassOpItem] DataCon
 174 \end{code}
 175
 176
 177 %************************************************************************
 178 %*                                                                      *
 179 \subsection{Basic lookups}
 180 %*                                                                      *
 181 %************************************************************************
 182
 183 \begin{code}
 184 lookup_global :: TcEnv -> Name -> Maybe TyThing
 185         -- Try the global envt and then the global symbol table
 186 lookup_global env name
 187   = case lookupNameEnv (tcGEnv env) name of
 188         Just thing -> Just thing
 189         Nothing    -> tcGST env name
 190
 191 lookup_local :: TcEnv -> Name -> Maybe TcTyThing
 192         -- Try the local envt and then try the global
 193 lookup_local env name
 194   = case lookupNameEnv (tcLEnv env) name of
 195         Just thing -> Just thing
 196         Nothing    -> case lookup_global env name of
 197                         Just thing -> Just (AGlobal thing)
 198                         Nothing    -> Nothing
 199 \end{code}
 200
 201 \begin{code}
 202 type RecTcEnv = TcEnv
 203 -- This environment is used for getting the 'right' IdInfo
 204 -- on imported things and for looking up Ids in unfoldings
 205 -- The environment doesn't have any local Ids in it
 206
 207 tcAddImportedIdInfo :: RecTcEnv -> Id -> Id
 208 tcAddImportedIdInfo env id
 209   = id `lazySetIdInfo` new_info
 210         -- The Id must be returned without a data dependency on maybe_id
 211   where
 212     new_info = case tcLookupRecId_maybe env (idName id) of
 213                   Nothing          -> pprTrace "tcAddIdInfo" (ppr id) constantIdInfo
 214                   Just imported_id -> idInfo imported_id
 215                 -- ToDo: could check that types are the same
 216
 217 tcLookupRecId_maybe :: RecTcEnv -> Name -> Maybe Id
 218 tcLookupRecId_maybe env name = case lookup_global env name of
 219                                    Just (AnId id) -> Just id
 220                                    other          -> Nothing
 221
 222 tcLookupRecId ::  RecTcEnv -> Name -> Id
 223 tcLookupRecId env name = case lookup_global env name of
 224                                 Just (AnId id) -> id
 225                                 Nothing        -> pprPanic "tcLookupRecId" (ppr name)
 226 \end{code}
 227
 228 %************************************************************************
 229 %*                                                                      *
 230 \subsection{Making new Ids}
 231 %*                                                                      *
 232 %************************************************************************
 233
 234 Constructing new Ids
 235
 236 \begin{code}
 237 newLocalId :: OccName -> TcType -> SrcLoc -> NF_TcM TcId
 238 newLocalId name ty loc
 239   = tcGetUnique         `thenNF_Tc` \ uniq ->
 240     returnNF_Tc (mkUserLocal name uniq ty loc)
 241
 242 newSpecPragmaId :: Name -> TcType -> NF_TcM TcId
 243 newSpecPragmaId name ty
 244   = tcGetUnique         `thenNF_Tc` \ uniq ->
 245     returnNF_Tc (mkSpecPragmaId (nameOccName name) uniq ty (getSrcLoc name))
 246 \end{code}
 247
 248 Make a name for the dict fun for an instance decl.
 249 It's a *local* name for the moment.  The CoreTidy pass
 250 will globalise it.
 251
 252 \begin{code}
 253 newDFunName :: Class -> [Type] -> SrcLoc -> NF_TcM Name
 254 newDFunName clas (ty:_) loc
 255   = tcGetUnique                 `thenNF_Tc` \ uniq ->
 256     returnNF_Tc (mkLocalName uniq (mkDFunOcc dfun_string) loc)
 257   where
 258         -- Any string that is somewhat unique will do
 259     dfun_string = occNameString (getOccName clas) ++ occNameString (getDFunTyKey ty)
 260
 261 newDFunName clas [] loc = pprPanic "newDFunName" (ppr clas <+> ppr loc)
 262 \end{code}
 263
 264 \begin{code}
 265 isLocalThing :: NamedThing a => Module -> a -> Bool
 266 isLocalThing mod thing = nameIsLocalOrFrom mod (getName thing)
 267 \end{code}
 268
 269 %************************************************************************
 270 %*                                                                      *
 271 \subsection{The global environment}
 272 %*                                                                      *
 273 %************************************************************************
 274
 275 \begin{code}
 276 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
 277 tcExtendGlobalEnv things thing_inside
 278   = tcGetEnv                            `thenNF_Tc` \ env ->
 279     let
 280         ge' = extendNameEnvList (tcGEnv env) [(getName thing, thing) | thing <- things]
 281     in
 282     tcSetEnv (env {tcGEnv = ge'}) thing_inside
 283
 284 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
 285 tcExtendGlobalValEnv ids thing_inside
 286   = tcGetEnv                            `thenNF_Tc` \ env ->
 287     let
 288         ge' = extendNameEnvList (tcGEnv env) [(getName id, AnId id) | id <- ids]
 289     in
 290     tcSetEnv (env {tcGEnv = ge'}) thing_inside
 291 \end{code}
 292
 293
 294 \begin{code}
 295 tcLookupGlobal_maybe :: Name -> NF_TcM (Maybe TyThing)
 296 tcLookupGlobal_maybe name
 297   = tcGetEnv            `thenNF_Tc` \ env ->
 298     returnNF_Tc (lookup_global env name)
 299 \end{code}
 300
 301 A variety of global lookups, when we know what we are looking for.
 302
 303 \begin{code}
 304 tcLookupGlobal :: Name -> NF_TcM TyThing
 305 tcLookupGlobal name
 306   = tcLookupGlobal_maybe name   `thenNF_Tc` \ maybe_thing ->
 307     case maybe_thing of
 308         Just thing -> returnNF_Tc thing
 309         other      -> notFound "tcLookupGlobal" name
 310
 311 tcLookupGlobalId :: Name -> NF_TcM Id
 312 tcLookupGlobalId name
 313   = tcLookupGlobal_maybe name   `thenNF_Tc` \ maybe_id ->
 314     case maybe_id of
 315         Just (AnId id) -> returnNF_Tc id
 316         other          -> notFound "tcLookupGlobalId" name
 317
 318 tcLookupDataCon :: Name -> TcM DataCon
 319 tcLookupDataCon con_name
 320   = tcLookupGlobalId con_name           `thenNF_Tc` \ con_id ->
 321     case isDataConWrapId_maybe con_id of
 322         Just data_con -> returnTc data_con
 323         Nothing       -> failWithTc (badCon con_id)
 324
 325
 326 tcLookupClass :: Name -> NF_TcM Class
 327 tcLookupClass name
 328   = tcLookupGlobal_maybe name   `thenNF_Tc` \ maybe_clas ->
 329     case maybe_clas of
 330         Just (AClass clas) -> returnNF_Tc clas
 331         other              -> notFound "tcLookupClass" name
 332
 333 tcLookupTyCon :: Name -> NF_TcM TyCon
 334 tcLookupTyCon name
 335   = tcLookupGlobal_maybe name   `thenNF_Tc` \ maybe_tc ->
 336     case maybe_tc of
 337         Just (ATyCon tc) -> returnNF_Tc tc
 338         other            -> notFound "tcLookupTyCon" name
 339
 340 tcLookupLocalIds :: [Name] -> NF_TcM [TcId]
 341 tcLookupLocalIds ns
 342   = tcGetEnv            `thenNF_Tc` \ env ->
 343     returnNF_Tc (map (lookup (tcLEnv env)) ns)
 344   where
 345     lookup lenv name = case lookupNameEnv lenv name of
 346                         Just (ATcId id) -> id
 347                         other           -> pprPanic "tcLookupLocalIds" (ppr name)
 348
 349 tcLookupSyntaxId :: Name -> NF_TcM Id
 350 -- Lookup a name like PrelNum.fromInt, and return the corresponding Id,
 351 -- after mapping through the SyntaxMap.  This may give us the Id for
 352 -- (say) MyPrelude.fromInteger
 353 tcLookupSyntaxId name
 354   = tcGetEnv            `thenNF_Tc` \ env ->
 355     returnNF_Tc (case lookup_global env (tcSyntaxMap env name) of
 356                         Just (AnId id) -> id
 357                         other          -> pprPanic "tcLookupSyntaxId" (ppr name))
 358
 359 tcLookupSyntaxName :: Name -> NF_TcM Name
 360 tcLookupSyntaxName name
 361   = tcGetEnv            `thenNF_Tc` \ env ->
 362     returnNF_Tc (tcSyntaxMap env name)
 363 \end{code}
 364
 365
 366 %************************************************************************
 367 %*                                                                      *
 368 \subsection{The local environment}
 369 %*                                                                      *
 370 %************************************************************************
 371
 372 \begin{code}
 373 tcLookup_maybe :: Name -> NF_TcM (Maybe TcTyThing)
 374 tcLookup_maybe name
 375   = tcGetEnv            `thenNF_Tc` \ env ->
 376     returnNF_Tc (lookup_local env name)
 377
 378 tcLookup :: Name -> NF_TcM TcTyThing
 379 tcLookup name
 380   = tcLookup_maybe name         `thenNF_Tc` \ maybe_thing ->
 381     case maybe_thing of
 382         Just thing -> returnNF_Tc thing
 383         other      -> notFound "tcLookup" name
 384         -- Extract the IdInfo from an IfaceSig imported from an interface file
 385 \end{code}
 386
 387
 388 \begin{code}
 389 tcExtendKindEnv :: [(Name,TcKind)] -> TcM r -> TcM r
 390 tcExtendKindEnv pairs thing_inside
 391   = tcGetEnv                            `thenNF_Tc` \ env ->
 392     let
 393         le' = extendNameEnvList (tcLEnv env) [(n, AThing k) | (n,k) <- pairs]
 394         -- No need to extend global tyvars for kind checking
 395     in
 396     tcSetEnv (env {tcLEnv = le'}) thing_inside
 397
 398 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
 399 tcExtendTyVarEnv tyvars thing_inside
 400   = tcGetEnv                    `thenNF_Tc` \ env@(TcEnv {tcLEnv = le, tcTyVars = gtvs}) ->
 401     let
 402         le'        = extendNameEnvList le [ (getName tv, ATyVar tv) | tv <- tyvars]
 403         new_tv_set = mkVarSet tyvars
 404     in
 405         -- It's important to add the in-scope tyvars to the global tyvar set
 406         -- as well.  Consider
 407         --      f (x::r) = let g y = y::r in ...
 408         -- Here, g mustn't be generalised.  This is also important during
 409         -- class and instance decls, when we mustn't generalise the class tyvars
 410         -- when typechecking the methods.
 411     tc_extend_gtvs gtvs new_tv_set              `thenNF_Tc` \ gtvs' ->
 412     tcSetEnv (env {tcLEnv = le', tcTyVars = gtvs'}) thing_inside
 413
 414 -- This variant, tcExtendTyVarEnvForMeths, takes *two* bunches of tyvars:
 415 --      the signature tyvars contain the original names
 416 --      the instance  tyvars are what those names should be mapped to
 417 -- It's needed when typechecking the method bindings of class and instance decls
 418 -- It does *not* extend the global tyvars; tcMethodBind does that for itself
 419
 420 tcExtendTyVarEnvForMeths :: [TyVar] -> [TcTyVar] -> TcM r -> TcM r
 421 tcExtendTyVarEnvForMeths sig_tyvars inst_tyvars thing_inside
 422   = tcGetEnv                                    `thenNF_Tc` \ env ->
 423     let
 424         le'   = extendNameEnvList (tcLEnv env) stuff
 425         stuff = [ (getName sig_tv, ATyVar inst_tv)
 426                 | (sig_tv, inst_tv) <- zipEqual "tcMeth" sig_tyvars inst_tyvars
 427                 ]
 428     in
 429     tcSetEnv (env {tcLEnv = le'}) thing_inside
 430 \end{code}
 431
 432
 433 \begin{code}
 434 tcExtendLocalValEnv :: [(Name,TcId)] -> TcM a -> TcM a
 435 tcExtendLocalValEnv names_w_ids thing_inside
 436   = tcGetEnv            `thenNF_Tc` \ env ->
 437     let
 438         extra_global_tyvars = tyVarsOfTypes [idType id | (name,id) <- names_w_ids]
 439         extra_env           = [(name, ATcId id) | (name,id) <- names_w_ids]
 440         le'                 = extendNameEnvList (tcLEnv env) extra_env
 441     in
 442     tc_extend_gtvs (tcTyVars env) extra_global_tyvars   `thenNF_Tc` \ gtvs' ->
 443     tcSetEnv (env {tcLEnv = le', tcTyVars = gtvs'}) thing_inside
 444 \end{code}
 445
 446
 447 %************************************************************************
 448 %*                                                                      *
 449 \subsection{The global tyvars}
 450 %*                                                                      *
 451 %************************************************************************
 452
 453 \begin{code}
 454 tcExtendGlobalTyVars extra_global_tvs thing_inside
 455   = tcGetEnv                                            `thenNF_Tc` \ env ->
 456     tc_extend_gtvs (tcTyVars env) extra_global_tvs      `thenNF_Tc` \ gtvs' ->
 457     tcSetEnv (env {tcTyVars = gtvs'}) thing_inside
 458
 459 tc_extend_gtvs gtvs extra_global_tvs
 460   = tcReadMutVar gtvs                   `thenNF_Tc` \ global_tvs ->
 461     tcNewMutVar (global_tvs `unionVarSet` extra_global_tvs)
 462 \end{code}
 463
 464 @tcGetGlobalTyVars@ returns a fully-zonked set of tyvars free in the environment.
 465 To improve subsequent calls to the same function it writes the zonked set back into
 466 the environment.
 467
 468 \begin{code}
 469 tcGetGlobalTyVars :: NF_TcM TcTyVarSet
 470 tcGetGlobalTyVars
 471   = tcGetEnv                                    `thenNF_Tc` \ (TcEnv {tcTyVars = gtv_var}) ->
 472     tcReadMutVar gtv_var                        `thenNF_Tc` \ gbl_tvs ->
 473     zonkTcTyVarsAndFV (varSetElems gbl_tvs)     `thenNF_Tc` \ gbl_tvs' ->
 474     tcWriteMutVar gtv_var gbl_tvs'              `thenNF_Tc_`
 475     returnNF_Tc gbl_tvs'
 476 \end{code}
 477
 478
 479 %************************************************************************
 480 %*                                                                      *
 481 \subsection{The instance environment}
 482 %*                                                                      *
 483 %************************************************************************
 484
 485 \begin{code}
 486 tcGetInstEnv :: NF_TcM InstEnv
 487 tcGetInstEnv = tcGetEnv         `thenNF_Tc` \ env ->
 488                returnNF_Tc (tcInsts env)
 489
 490 tcSetInstEnv :: InstEnv -> TcM a -> TcM a
 491 tcSetInstEnv ie thing_inside
 492   = tcGetEnv    `thenNF_Tc` \ env ->
 493     tcSetEnv (env {tcInsts = ie}) thing_inside
 494 \end{code}
 495
 496
 497 %************************************************************************
 498 %*                                                                      *
 499 \subsection{The InstInfo type}
 500 %*                                                                      *
 501 %************************************************************************
 502
 503 The InstInfo type summarises the information in an instance declaration
 504
 505     instance c => k (t tvs) where b
 506
 507 \begin{code}
 508 data InstInfo
 509   = InstInfo {
 510       iDFunId :: DFunId,                -- The dfun id
 511       iBinds  :: RenamedMonoBinds,      -- Bindings, b
 512       iPrags  :: [RenamedSig]           -- User pragmas recorded for generating specialised instances
 513     }
 514
 515 pprInstInfo info = vcat [ptext SLIT("InstInfo:") <+> ppr (idType (iDFunId info)),
 516                          nest 4 (ppr (iBinds info))]
 517
 518 simpleInstInfoTy :: InstInfo -> Type
 519 simpleInstInfoTy info = case splitDFunTy (idType (iDFunId info)) of
 520                           (_, _, _, [ty]) -> ty
 521
 522 simpleInstInfoTyCon :: InstInfo -> TyCon
 523   -- Gets the type constructor for a simple instance declaration,
 524   -- i.e. one of the form       instance (...) => C (T a b c) where ...
 525 simpleInstInfoTyCon inst = tyConAppTyCon (simpleInstInfoTy inst)
 526 \end{code}
 527
 528
 529 %************************************************************************
 530 %*                                                                      *
 531 \subsection{Errors}
 532 %*                                                                      *
 533 %************************************************************************
 534
 535 \begin{code}
 536 badCon con_id = quotes (ppr con_id) <+> ptext SLIT("is not a data constructor")
 537
 538 notFound wheRe name = failWithTc (text wheRe <> colon <+> quotes (ppr name) <+>
 539                                   ptext SLIT("is not in scope"))
 540 \end{code}