ghc/compiler/typecheck/TcRnDriver.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[TcModule]{Typechecking a whole module}
   5
   6 \begin{code}
   7 module TcRnDriver (
   8 #ifdef GHCI
   9         mkExportEnv, getModuleContents, tcRnStmt,
  10         tcRnThing, tcRnExpr, tcRnType,
  11 #endif
  12         tcRnModule,
  13         tcTopSrcDecls,
  14         tcRnExtCore
  15     ) where
  16
  17 #include "HsVersions.h"
  18
  19 #ifdef GHCI
  20 import {-# SOURCE #-} TcSplice ( tcSpliceDecls )
  21 #endif
  22
  23 import CmdLineOpts      ( DynFlag(..), opt_PprStyle_Debug, dopt )
  24 import DriverState      ( v_MainModIs, v_MainFunIs )
  25 import HsSyn            ( HsModule(..), HsExtCore(..), HsGroup(..), LHsDecl, SpliceDecl(..), HsBind(..),
  26                           nlHsApp, nlHsVar )
  27 import RdrHsSyn         ( findSplice )
  28
  29 import PrelNames        ( runIOName, rootMainName, mAIN_Name,
  30                           main_RDR_Unqual )
  31 import RdrName          ( RdrName, mkRdrUnqual, emptyGlobalRdrEnv,
  32                           plusGlobalRdrEnv )
  33 import TcHsSyn          ( zonkTopDecls )
  34 import TcExpr           ( tcInferRho )
  35 import TcRnMonad
  36 import TcType           ( tidyTopType )
  37 import Inst             ( showLIE )
  38 import TcBinds          ( tcTopBinds )
  39 import TcDefaults       ( tcDefaults )
  40 import TcEnv            ( tcExtendGlobalValEnv )
  41 import TcRules          ( tcRules )
  42 import TcForeign        ( tcForeignImports, tcForeignExports )
  43 import TcInstDcls       ( tcInstDecls1, tcInstDecls2 )
  44 import TcIface          ( tcExtCoreBindings )
  45 import TcSimplify       ( tcSimplifyTop )
  46 import TcTyClsDecls     ( tcTyAndClassDecls )
  47 import LoadIface        ( loadOrphanModules )
  48 import RnNames          ( importsFromLocalDecls, rnImports, exportsFromAvail,
  49                           reportUnusedNames, reportDeprecations )
  50 import RnEnv            ( lookupSrcOcc_maybe )
  51 import RnSource         ( rnSrcDecls, rnTyClDecls, checkModDeprec )
  52 import PprCore          ( pprIdRules, pprCoreBindings )
  53 import CoreSyn          ( IdCoreRule, bindersOfBinds )
  54 import ErrUtils         ( Messages, mkDumpDoc, showPass )
  55 import Id               ( mkExportedLocalId, isLocalId, idName, idType )
  56 import Var              ( Var )
  57 import Module           ( mkHomeModule, mkModuleName, moduleName, moduleEnvElts )
  58 import OccName          ( mkVarOcc )
  59 import Name             ( Name, isExternalName, getSrcLoc, getOccName )
  60 import NameSet
  61 import TyCon            ( tyConHasGenerics )
  62 import SrcLoc           ( srcLocSpan, Located(..), noLoc )
  63 import Outputable
  64 import HscTypes         ( ModGuts(..), HscEnv(..),
  65                           GhciMode(..), noDependencies,
  66                           Deprecs( NoDeprecs ), plusDeprecs,
  67                           ForeignStubs(NoStubs), TypeEnv,
  68                           extendTypeEnvWithIds, typeEnvIds, typeEnvTyCons,
  69                           emptyFixityEnv
  70                         )
  71 #ifdef GHCI
  72 import HsSyn            ( HsStmtContext(..), Stmt(..), HsExpr(..), HsBindGroup(..),
  73                           LStmt, LHsExpr, LHsType,
  74                           collectStmtsBinders, mkSimpleMatch, placeHolderType,
  75                           nlLetStmt, nlExprStmt, nlBindStmt, nlResultStmt, nlVarPat )
  76 import RdrName          ( GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..),
  77                           Provenance(..), ImportSpec(..),
  78                           lookupLocalRdrEnv, extendLocalRdrEnv )
  79 import RnSource         ( addTcgDUs )
  80 import TcHsSyn          ( mkHsLet, zonkTopLExpr, zonkTopBndrs )
  81 import TcHsType         ( kcHsType )
  82 import TcExpr           ( tcCheckRho )
  83 import TcMType          ( zonkTcType )
  84 import TcMatches        ( tcStmtsAndThen, TcStmtCtxt(..) )
  85 import TcSimplify       ( tcSimplifyInteractive, tcSimplifyInfer )
  86 import TcType           ( Type, mkForAllTys, mkFunTys, mkTyConApp, tyVarsOfType )
  87 import TcEnv            ( tcLookupTyCon, tcLookupId, tcLookupGlobal )
  88 import RnTypes          ( rnLHsType )
  89 import Inst             ( tcStdSyntaxName )
  90 import RnExpr           ( rnStmts, rnLExpr )
  91 import RnNames          ( exportsToAvails )
  92 import LoadIface        ( loadSrcInterface )
  93 import IfaceSyn         ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..),
  94                           IfaceExtName(..), IfaceConDecls(..),
  95                           tyThingToIfaceDecl )
  96 import RnEnv            ( lookupOccRn, dataTcOccs, lookupFixityRn )
  97 import Id               ( Id, isImplicitId )
  98 import MkId             ( unsafeCoerceId )
  99 import TysWiredIn       ( mkListTy, unitTy )
 100 import IdInfo           ( GlobalIdDetails(..) )
 101 import SrcLoc           ( interactiveSrcLoc, unLoc )
 102 import Kind             ( Kind )
 103 import Var              ( globaliseId )
 104 import Name             ( nameOccName, nameModuleName )
 105 import NameEnv          ( delListFromNameEnv )
 106 import PrelNames        ( iNTERACTIVE, ioTyConName, printName, monadNames, itName, returnIOName )
 107 import Module           ( ModuleName, lookupModuleEnvByName )
 108 import HscTypes         ( InteractiveContext(..),
 109                           HomeModInfo(..), typeEnvElts,
 110                           TyThing(..), availName, availNames, icPrintUnqual,
 111                           ModIface(..), ModDetails(..) )
 112 import BasicTypes       ( RecFlag(..), Fixity )
 113 import Bag              ( unitBag )
 114 import Panic            ( ghcError, GhcException(..) )
 115 #endif
 116
 117 import FastString       ( mkFastString )
 118 import Util             ( sortLt )
 119 import Bag              ( unionBags, snocBag )
 120
 121 import Maybe            ( isJust )
 122 \end{code}
 123
 124
 125
 126 %************************************************************************
 127 %*                                                                      *
 128         Typecheck and rename a module
 129 %*                                                                      *
 130 %************************************************************************
 131
 132
 133 \begin{code}
 134 tcRnModule :: HscEnv
 135            -> Located (HsModule RdrName)
 136            -> IO (Messages, Maybe TcGblEnv)
 137
 138 tcRnModule hsc_env (L loc (HsModule maybe_mod exports
 139                                 import_decls local_decls mod_deprec))
 140  = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
 141
 142    let { this_mod = case maybe_mod of
 143                         Nothing  -> mkHomeModule mAIN_Name
 144                                         -- 'module M where' is omitted
 145                         Just (L _ mod) -> mod } ;
 146                                         -- The normal case
 147
 148    initTc hsc_env this_mod $
 149    addSrcSpan loc $
 150    do {         -- Deal with imports; sets tcg_rdr_env, tcg_imports
 151         (rdr_env, imports) <- rnImports import_decls ;
 152         updGblEnv ( \ gbl -> gbl { tcg_rdr_env = rdr_env,
 153                                    tcg_imports = tcg_imports gbl `plusImportAvails` imports })
 154                      $ do {
 155         traceRn (text "rn1" <+> ppr (imp_dep_mods imports)) ;
 156                 -- Fail if there are any errors so far
 157                 -- The error printing (if needed) takes advantage
 158                 -- of the tcg_env we have now set
 159         failIfErrsM ;
 160
 161                 -- Load any orphan-module interfaces, so that
 162                 -- their rules and instance decls will be found
 163         loadOrphanModules (imp_orphs imports) ;
 164
 165         traceRn (text "rn1a") ;
 166                 -- Rename and type check the declarations
 167         tcg_env <- tcRnSrcDecls local_decls ;
 168         setGblEnv tcg_env               $ do {
 169
 170         traceRn (text "rn3") ;
 171
 172                 -- Report the use of any deprecated things
 173                 -- We do this before processsing the export list so
 174                 -- that we don't bleat about re-exporting a deprecated
 175                 -- thing (especially via 'module Foo' export item)
 176                 -- Only uses in the body of the module are complained about
 177         reportDeprecations tcg_env ;
 178
 179                 -- Process the export list
 180         exports <- exportsFromAvail (isJust maybe_mod) exports ;
 181
 182 {-      Jan 04: I don't think this is necessary any more; usage info is derived from tcg_dus
 183                 -- Get any supporting decls for the exports that have not already
 184                 -- been sucked in for the declarations in the body of the module.
 185                 -- (This can happen if something is imported only to be re-exported.)
 186                 --
 187                 -- Importing these supporting declarations is required
 188                 --      *only* to gether usage information
 189                 --      (see comments with MkIface.mkImportInfo for why)
 190                 -- We don't need the results, but sucking them in may side-effect
 191                 -- the ExternalPackageState, apart from recording usage
 192         mappM (tcLookupGlobal . availName) export_avails ;
 193 -}
 194
 195                 -- Check whether the entire module is deprecated
 196                 -- This happens only once per module
 197         let { mod_deprecs = checkModDeprec mod_deprec } ;
 198
 199                 -- Add exports and deprecations to envt
 200         let { final_env  = tcg_env { tcg_exports = exports,
 201                                      tcg_dus = tcg_dus tcg_env `plusDU` usesOnly exports,
 202                                      tcg_deprecs = tcg_deprecs tcg_env `plusDeprecs`
 203                                                    mod_deprecs }
 204                 -- A module deprecation over-rides the earlier ones
 205              } ;
 206
 207                 -- Report unused names
 208         reportUnusedNames final_env ;
 209
 210                 -- Dump output and return
 211         tcDump final_env ;
 212         return final_env
 213     }}}}
 214 \end{code}
 215
 216
 217 %************************************************************************
 218 %*                                                                      *
 219                 The interactive interface
 220 %*                                                                      *
 221 %************************************************************************
 222
 223 \begin{code}
 224 #ifdef GHCI
 225 tcRnStmt :: HscEnv
 226          -> InteractiveContext
 227          -> LStmt RdrName
 228          -> IO (Maybe (InteractiveContext, [Name], LHsExpr Id))
 229                 -- The returned [Name] is the same as the input except for
 230                 -- ExprStmt, in which case the returned [Name] is [itName]
 231                 --
 232                 -- The returned TypecheckedHsExpr is of type IO [ () ],
 233                 -- a list of the bound values, coerced to ().
 234
 235 tcRnStmt hsc_env ictxt rdr_stmt
 236   = initTcPrintErrors hsc_env iNTERACTIVE $
 237     setInteractiveContext ictxt $ do {
 238
 239     -- Rename; use CmdLineMode because tcRnStmt is only used interactively
 240     ([rn_stmt], fvs) <- rnStmts DoExpr [rdr_stmt] ;
 241     traceRn (text "tcRnStmt" <+> vcat [ppr rdr_stmt, ppr rn_stmt, ppr fvs]) ;
 242     failIfErrsM ;
 243
 244     -- The real work is done here
 245     (bound_ids, tc_expr) <- tcUserStmt rn_stmt ;
 246
 247     traceTc (text "tcs 1") ;
 248     let {       -- Make all the bound ids "global" ids, now that
 249                 -- they're notionally top-level bindings.  This is
 250                 -- important: otherwise when we come to compile an expression
 251                 -- using these ids later, the byte code generator will consider
 252                 -- the occurrences to be free rather than global.
 253         global_ids     = map (globaliseId VanillaGlobal) bound_ids ;
 254
 255                 -- Update the interactive context
 256         rn_env   = ic_rn_local_env ictxt ;
 257         type_env = ic_type_env ictxt ;
 258
 259         bound_names = map idName global_ids ;
 260         new_rn_env  = extendLocalRdrEnv rn_env bound_names ;
 261
 262                 -- Remove any shadowed bindings from the type_env;
 263                 -- they are inaccessible but might, I suppose, cause
 264                 -- a space leak if we leave them there
 265         shadowed = [ n | name <- bound_names,
 266                          let rdr_name = mkRdrUnqual (nameOccName name),
 267                          Just n <- [lookupLocalRdrEnv rn_env rdr_name] ] ;
 268
 269         filtered_type_env = delListFromNameEnv type_env shadowed ;
 270         new_type_env = extendTypeEnvWithIds filtered_type_env global_ids ;
 271
 272         new_ic = ictxt { ic_rn_local_env = new_rn_env,
 273                          ic_type_env     = new_type_env }
 274     } ;
 275
 276     dumpOptTcRn Opt_D_dump_tc
 277         (vcat [text "Bound Ids" <+> pprWithCommas ppr global_ids,
 278                text "Typechecked expr" <+> ppr tc_expr]) ;
 279
 280     returnM (new_ic, bound_names, tc_expr)
 281     }
 282 \end{code}
 283
 284
 285 Here is the grand plan, implemented in tcUserStmt
 286
 287         What you type                   The IO [HValue] that hscStmt returns
 288         -------------                   ------------------------------------
 289         let pat = expr          ==>     let pat = expr in return [coerce HVal x, coerce HVal y, ...]
 290                                         bindings: [x,y,...]
 291
 292         pat <- expr             ==>     expr >>= \ pat -> return [coerce HVal x, coerce HVal y, ...]
 293                                         bindings: [x,y,...]
 294
 295         expr (of IO type)       ==>     expr >>= \ v -> return [coerce HVal v]
 296           [NB: result not printed]      bindings: [it]
 297
 298         expr (of non-IO type,   ==>     let v = expr in print v >> return [coerce HVal v]
 299           result showable)              bindings: [it]
 300
 301         expr (of non-IO type,
 302           result not showable)  ==>     error
 303
 304
 305 \begin{code}
 306 ---------------------------
 307 tcUserStmt :: LStmt Name -> TcM ([Id], LHsExpr Id)
 308 tcUserStmt (L _ (ExprStmt expr _))
 309   = newUnique           `thenM` \ uniq ->
 310     let
 311         fresh_it = itName uniq
 312         the_bind = noLoc $ FunBind (noLoc fresh_it) False
 313                         [ mkSimpleMatch [] expr placeHolderType ]
 314     in
 315     tryTcLIE_ (do {     -- Try this if the other fails
 316                 traceTc (text "tcs 1b") ;
 317                 tc_stmts [
 318                     nlLetStmt [HsBindGroup (unitBag the_bind) [] NonRecursive],
 319                     nlExprStmt (nlHsApp (nlHsVar printName)
 320                                               (nlHsVar fresh_it))
 321                 ] })
 322           (do {         -- Try this first
 323                 traceTc (text "tcs 1a") ;
 324                 tc_stmts [nlBindStmt (nlVarPat fresh_it) expr] })
 325
 326 tcUserStmt stmt = tc_stmts [stmt]
 327
 328 ---------------------------
 329 tc_stmts stmts
 330  = do { ioTyCon <- tcLookupTyCon ioTyConName ;
 331         let {
 332             ret_ty    = mkListTy unitTy ;
 333             io_ret_ty = mkTyConApp ioTyCon [ret_ty] ;
 334
 335             names = map unLoc (collectStmtsBinders stmts) ;
 336
 337             stmt_ctxt = SC { sc_what = DoExpr,
 338                              sc_rhs  = check_rhs,
 339                              sc_body = check_body,
 340                              sc_ty   = ret_ty } ;
 341
 342             check_rhs rhs rhs_ty = tcCheckRho rhs  (mkTyConApp ioTyCon [rhs_ty]) ;
 343             check_body body      = tcCheckRho body io_ret_ty ;
 344
 345                 -- mk_return builds the expression
 346                 --      returnIO @ [()] [coerce () x, ..,  coerce () z]
 347                 --
 348                 -- Despite the inconvenience of building the type applications etc,
 349                 -- this *has* to be done in type-annotated post-typecheck form
 350                 -- because we are going to return a list of *polymorphic* values
 351                 -- coerced to type (). If we built a *source* stmt
 352                 --      return [coerce x, ..., coerce z]
 353                 -- then the type checker would instantiate x..z, and we wouldn't
 354                 -- get their *polymorphic* values.  (And we'd get ambiguity errs
 355                 -- if they were overloaded, since they aren't applied to anything.)
 356             mk_return ret_id ids = nlHsApp (noLoc $ TyApp (nlHsVar ret_id) [ret_ty])
 357                                            (noLoc $ ExplicitList unitTy (map mk_item ids)) ;
 358             mk_item id = nlHsApp (noLoc $ TyApp (nlHsVar unsafeCoerceId) [idType id, unitTy])
 359                                (nlHsVar id) ;
 360
 361             io_ty = mkTyConApp ioTyCon []
 362          } ;
 363
 364         -- OK, we're ready to typecheck the stmts
 365         traceTc (text "tcs 2") ;
 366         ((ids, tc_expr), lie) <- getLIE $ do {
 367             (ids, tc_stmts) <- tcStmtsAndThen combine stmt_ctxt stmts   $
 368                         do {
 369                             -- Look up the names right in the middle,
 370                             -- where they will all be in scope
 371                             ids <- mappM tcLookupId names ;
 372                             ret_id <- tcLookupId returnIOName ;         -- return @ IO
 373                             return (ids, [nlResultStmt (mk_return ret_id ids)]) } ;
 374
 375             io_ids <- mappM (tcStdSyntaxName DoOrigin io_ty) monadNames ;
 376             return (ids, noLoc (HsDo DoExpr tc_stmts io_ids io_ret_ty))
 377         } ;
 378
 379         -- Simplify the context right here, so that we fail
 380         -- if there aren't enough instances.  Notably, when we see
 381         --              e
 382         -- we use recoverTc_ to try     it <- e
 383         -- and then                     let it = e
 384         -- It's the simplify step that rejects the first.
 385         traceTc (text "tcs 3") ;
 386         const_binds <- tcSimplifyInteractive lie ;
 387
 388         -- Build result expression and zonk it
 389         let { expr = mkHsLet const_binds tc_expr } ;
 390         zonked_expr <- zonkTopLExpr expr ;
 391         zonked_ids  <- zonkTopBndrs ids ;
 392
 393         return (zonked_ids, zonked_expr)
 394         }
 395   where
 396     combine stmt (ids, stmts) = (ids, stmt:stmts)
 397 \end{code}
 398
 399
 400 tcRnExpr just finds the type of an expression
 401
 402 \begin{code}
 403 tcRnExpr :: HscEnv
 404          -> InteractiveContext
 405          -> LHsExpr RdrName
 406          -> IO (Maybe Type)
 407 tcRnExpr hsc_env ictxt rdr_expr
 408   = initTcPrintErrors hsc_env iNTERACTIVE $
 409     setInteractiveContext ictxt $ do {
 410
 411     (rn_expr, fvs) <- rnLExpr rdr_expr ;
 412     failIfErrsM ;
 413
 414         -- Now typecheck the expression;
 415         -- it might have a rank-2 type (e.g. :t runST)
 416     ((tc_expr, res_ty), lie)       <- getLIE (tcInferRho rn_expr) ;
 417     ((qtvs, _, dict_ids), lie_top) <- getLIE (tcSimplifyInfer smpl_doc (tyVarsOfType res_ty) lie)  ;
 418     tcSimplifyInteractive lie_top ;
 419
 420     let { all_expr_ty = mkForAllTys qtvs                $
 421                         mkFunTys (map idType dict_ids)  $
 422                         res_ty } ;
 423     zonkTcType all_expr_ty
 424     }
 425   where
 426     smpl_doc = ptext SLIT("main expression")
 427 \end{code}
 428
 429 tcRnExpr just finds the kind of a type
 430
 431 \begin{code}
 432 tcRnType :: HscEnv
 433          -> InteractiveContext
 434          -> LHsType RdrName
 435          -> IO (Maybe Kind)
 436 tcRnType hsc_env ictxt rdr_type
 437   = initTcPrintErrors hsc_env iNTERACTIVE $
 438     setInteractiveContext ictxt $ do {
 439
 440     rn_type <- rnLHsType doc rdr_type ;
 441     failIfErrsM ;
 442
 443         -- Now kind-check the type
 444     (ty', kind) <- kcHsType rn_type ;
 445     return kind
 446     }
 447   where
 448     doc = ptext SLIT("In GHCi input")
 449 \end{code}
 450
 451 \begin{code}
 452 tcRnThing :: HscEnv
 453           -> InteractiveContext
 454           -> RdrName
 455           -> IO (Maybe [(IfaceDecl, Fixity)])
 456 -- Look up a RdrName and return all the TyThings it might be
 457 -- A capitalised RdrName is given to us in the DataName namespace,
 458 -- but we want to treat it as *both* a data constructor
 459 -- *and* as a type or class constructor;
 460 -- hence the call to dataTcOccs, and we return up to two results
 461 tcRnThing hsc_env ictxt rdr_name
 462   = initTcPrintErrors hsc_env iNTERACTIVE $
 463     setInteractiveContext ictxt $ do {
 464
 465         -- If the identifier is a constructor (begins with an
 466         -- upper-case letter), then we need to consider both
 467         -- constructor and type class identifiers.
 468     let { rdr_names = dataTcOccs rdr_name } ;
 469
 470         -- results :: [(Messages, Maybe Name)]
 471     results <- mapM (tryTc . lookupOccRn) rdr_names ;
 472
 473         -- The successful lookups will be (Just name)
 474     let { (warns_s, good_names) = unzip [ (msgs, name)
 475                                         | (msgs, Just name) <- results] ;
 476           errs_s = [msgs | (msgs, Nothing) <- results] } ;
 477
 478         -- Fail if nothing good happened, else add warnings
 479     if null good_names then
 480                 -- No lookup succeeded, so
 481                 -- pick the first error message and report it
 482                 -- ToDo: If one of the errors is "could be Foo.X or Baz.X",
 483                 --       while the other is "X is not in scope",
 484                 --       we definitely want the former; but we might pick the latter
 485         do { addMessages (head errs_s) ; failM }
 486       else                      -- Add deprecation warnings
 487         mapM_ addMessages warns_s ;
 488
 489         -- And lookup up the entities
 490     mapM do_one good_names
 491     }
 492   where
 493     do_one name = do { thing <- tcLookupGlobal name
 494                      ; fixity <- lookupFixityRn name
 495                      ; return (toIfaceDecl ictxt thing, fixity) }
 496
 497 toIfaceDecl :: InteractiveContext -> TyThing -> IfaceDecl
 498 toIfaceDecl ictxt thing
 499   = tyThingToIfaceDecl True {- Discard IdInfo -} emptyNameSet {- Show data cons -}
 500                        ext_nm thing
 501   where
 502     unqual = icPrintUnqual ictxt
 503     ext_nm n | unqual n  = LocalTop (nameOccName n)     -- What a hack
 504              | otherwise = ExtPkg (nameModuleName n) (nameOccName n)
 505 \end{code}
 506
 507
 508 \begin{code}
 509 setInteractiveContext :: InteractiveContext -> TcRn a -> TcRn a
 510 setInteractiveContext icxt thing_inside
 511   = traceTc (text "setIC" <+> ppr (ic_type_env icxt))   `thenM_`
 512     (updGblEnv (\env -> env {tcg_rdr_env  = ic_rn_gbl_env icxt,
 513                              tcg_type_env = ic_type_env   icxt}) $
 514      updLclEnv (\env -> env {tcl_rdr = ic_rn_local_env icxt})   $
 515                thing_inside)
 516 #endif /* GHCI */
 517 \end{code}
 518
 519 %************************************************************************
 520 %*                                                                      *
 521         Type-checking external-core modules
 522 %*                                                                      *
 523 %************************************************************************
 524
 525 \begin{code}
 526 tcRnExtCore :: HscEnv
 527             -> HsExtCore RdrName
 528             -> IO (Messages, Maybe ModGuts)
 529         -- Nothing => some error occurred
 530
 531 tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
 532         -- The decls are IfaceDecls; all names are original names
 533  = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
 534
 535    initTc hsc_env this_mod $ do {
 536
 537    let { ldecls  = map noLoc decls } ;
 538
 539         -- Deal with the type declarations; first bring their stuff
 540         -- into scope, then rname them, then type check them
 541    (rdr_env, imports) <- importsFromLocalDecls (mkFakeGroup ldecls) ;
 542
 543    updGblEnv (\gbl -> gbl { tcg_rdr_env = rdr_env `plusGlobalRdrEnv` tcg_rdr_env gbl,
 544                             tcg_imports = imports `plusImportAvails` tcg_imports gbl })
 545                   $ do {
 546
 547    rn_decls <- rnTyClDecls ldecls ;
 548    failIfErrsM ;
 549
 550         -- Dump trace of renaming part
 551    rnDump (ppr rn_decls) ;
 552
 553         -- Typecheck them all together so that
 554         -- any mutually recursive types are done right
 555    tcg_env <- checkNoErrs (tcTyAndClassDecls rn_decls) ;
 556         -- Make the new type env available to stuff slurped from interface files
 557
 558    setGblEnv tcg_env $ do {
 559
 560         -- Now the core bindings
 561    core_binds <- initIfaceExtCore (tcExtCoreBindings this_mod src_binds) ;
 562
 563         -- Wrap up
 564    let {
 565         bndrs      = bindersOfBinds core_binds ;
 566         my_exports = mkNameSet (map idName bndrs) ;
 567                 -- ToDo: export the data types also?
 568
 569         final_type_env = extendTypeEnvWithIds (tcg_type_env tcg_env) bndrs ;
 570
 571         mod_guts = ModGuts {    mg_module   = this_mod,
 572                                 mg_usages   = [],               -- ToDo: compute usage
 573                                 mg_dir_imps = [],               -- ??
 574                                 mg_deps     = noDependencies,   -- ??
 575                                 mg_exports  = my_exports,
 576                                 mg_types    = final_type_env,
 577                                 mg_insts    = tcg_insts tcg_env,
 578                                 mg_rules    = [],
 579                                 mg_binds    = core_binds,
 580
 581                                 -- Stubs
 582                                 mg_rdr_env  = emptyGlobalRdrEnv,
 583                                 mg_fix_env  = emptyFixityEnv,
 584                                 mg_deprecs  = NoDeprecs,
 585                                 mg_foreign  = NoStubs
 586                     } } ;
 587
 588    tcCoreDump mod_guts ;
 589
 590    return mod_guts
 591    }}}}
 592
 593 mkFakeGroup decls -- Rather clumsy; lots of unused fields
 594   = HsGroup {   hs_tyclds = decls,      -- This is the one we want
 595                 hs_valds = [], hs_fords = [],
 596                 hs_instds = [], hs_fixds = [], hs_depds = [],
 597                 hs_ruleds = [], hs_defds = [] }
 598 \end{code}
 599
 600
 601 %************************************************************************
 602 %*                                                                      *
 603         Type-checking the top level of a module
 604 %*                                                                      *
 605 %************************************************************************
 606
 607 \begin{code}
 608 tcRnSrcDecls :: [LHsDecl RdrName] -> TcM TcGblEnv
 609         -- Returns the variables free in the decls
 610         -- Reason: solely to report unused imports and bindings
 611 tcRnSrcDecls decls
 612  = do {         -- Do all the declarations
 613         (tc_envs, lie) <- getLIE (tc_rn_src_decls decls) ;
 614
 615              -- tcSimplifyTop deals with constant or ambiguous InstIds.
 616              -- How could there be ambiguous ones?  They can only arise if a
 617              -- top-level decl falls under the monomorphism
 618              -- restriction, and no subsequent decl instantiates its
 619              -- type.  (Usually, ambiguous type variables are resolved
 620              -- during the generalisation step.)
 621         traceTc (text "Tc8") ;
 622         inst_binds <- setEnvs tc_envs (tcSimplifyTop lie) ;
 623                 -- Setting the global env exposes the instances to tcSimplifyTop
 624                 -- Setting the local env exposes the local Ids to tcSimplifyTop,
 625                 -- so that we get better error messages (monomorphism restriction)
 626
 627             -- Backsubstitution.  This must be done last.
 628             -- Even tcSimplifyTop may do some unification.
 629         traceTc (text "Tc9") ;
 630         let { (tcg_env, _) = tc_envs ;
 631               TcGblEnv { tcg_type_env = type_env, tcg_binds = binds,
 632                          tcg_rules = rules, tcg_fords = fords } = tcg_env } ;
 633
 634         (bind_ids, binds', fords', rules') <- zonkTopDecls (binds `unionBags` inst_binds)
 635                                                            rules fords ;
 636
 637         let { final_type_env = extendTypeEnvWithIds type_env bind_ids } ;
 638
 639         -- Make the new type env available to stuff slurped from interface files
 640         writeMutVar (tcg_type_env_var tcg_env) final_type_env ;
 641
 642         return (tcg_env { tcg_type_env = final_type_env,
 643                           tcg_binds = binds', tcg_rules = rules', tcg_fords = fords' })
 644    }
 645
 646 tc_rn_src_decls :: [LHsDecl RdrName] -> TcM (TcGblEnv, TcLclEnv)
 647 -- Loops around dealing with each top level inter-splice group
 648 -- in turn, until it's dealt with the entire module
 649 tc_rn_src_decls ds
 650  = do { let { (first_group, group_tail) = findSplice ds } ;
 651                 -- If ds is [] we get ([], Nothing)
 652
 653         -- Type check the decls up to, but not including, the first splice
 654         tc_envs@(tcg_env,tcl_env) <- tcRnGroup first_group ;
 655
 656         -- Bale out if errors; for example, error recovery when checking
 657         -- the RHS of 'main' can mean that 'main' is not in the envt for
 658         -- the subsequent checkMain test
 659         failIfErrsM ;
 660
 661         setEnvs tc_envs $
 662
 663         -- If there is no splice, we're nearly done
 664         case group_tail of {
 665            Nothing -> do {      -- Last thing: check for `main'
 666                            tcg_env <- checkMain ;
 667                            return (tcg_env, tcl_env)
 668                       } ;
 669
 670         -- If there's a splice, we must carry on
 671            Just (SpliceDecl splice_expr, rest_ds) -> do {
 672 #ifndef GHCI
 673         failWithTc (text "Can't do a top-level splice; need a bootstrapped compiler")
 674 #else
 675
 676         -- Rename the splice expression, and get its supporting decls
 677         (rn_splice_expr, splice_fvs) <- rnLExpr splice_expr ;
 678         failIfErrsM ;   -- Don't typecheck if renaming failed
 679
 680         -- Execute the splice
 681         spliced_decls <- tcSpliceDecls rn_splice_expr ;
 682
 683         -- Glue them on the front of the remaining decls and loop
 684         setGblEnv (tcg_env `addTcgDUs` usesOnly splice_fvs) $
 685         tc_rn_src_decls (spliced_decls ++ rest_ds)
 686 #endif /* GHCI */
 687     }}}
 688 \end{code}
 689
 690
 691 %************************************************************************
 692 %*                                                                      *
 693         Type-checking the top level of a module
 694 %*                                                                      *
 695 %************************************************************************
 696
 697 tcRnGroup takes a bunch of top-level source-code declarations, and
 698  * renames them
 699  * gets supporting declarations from interface files
 700  * typechecks them
 701  * zonks them
 702  * and augments the TcGblEnv with the results
 703
 704 In Template Haskell it may be called repeatedly for each group of
 705 declarations.  It expects there to be an incoming TcGblEnv in the
 706 monad; it augments it and returns the new TcGblEnv.
 707
 708 \begin{code}
 709 tcRnGroup :: HsGroup RdrName -> TcM (TcGblEnv, TcLclEnv)
 710         -- Returns the variables free in the decls, for unused-binding reporting
 711 tcRnGroup decls
 712  = do {         -- Rename the declarations
 713         (tcg_env, rn_decls) <- rnTopSrcDecls decls ;
 714         setGblEnv tcg_env $ do {
 715
 716                 -- Typecheck the declarations
 717         tcTopSrcDecls rn_decls
 718   }}
 719
 720 ------------------------------------------------
 721 rnTopSrcDecls :: HsGroup RdrName -> TcM (TcGblEnv, HsGroup Name)
 722 rnTopSrcDecls group
 723  = do {         -- Bring top level binders into scope
 724         (rdr_env, imports) <- importsFromLocalDecls group ;
 725         updGblEnv (\gbl -> gbl { tcg_rdr_env = rdr_env `plusGlobalRdrEnv` tcg_rdr_env gbl,
 726                                  tcg_imports = imports `plusImportAvails` tcg_imports gbl })
 727                   $ do {
 728
 729         traceRn (ptext SLIT("rnTopSrcDecls") <+> ppr rdr_env) ;
 730         failIfErrsM ;   -- No point in continuing if (say) we have duplicate declarations
 731
 732                 -- Rename the source decls
 733         (tcg_env, rn_decls) <- rnSrcDecls group ;
 734         failIfErrsM ;
 735
 736                 -- Dump trace of renaming part
 737         rnDump (ppr rn_decls) ;
 738
 739         return (tcg_env, rn_decls)
 740    }}
 741
 742 ------------------------------------------------
 743 tcTopSrcDecls :: HsGroup Name -> TcM (TcGblEnv, TcLclEnv)
 744 tcTopSrcDecls
 745         (HsGroup { hs_tyclds = tycl_decls,
 746                    hs_instds = inst_decls,
 747                    hs_fords  = foreign_decls,
 748                    hs_defds  = default_decls,
 749                    hs_ruleds = rule_decls,
 750                    hs_valds  = val_binds })
 751  = do {         -- Type-check the type and class decls, and all imported decls
 752                 -- The latter come in via tycl_decls
 753         traceTc (text "Tc2") ;
 754
 755         tcg_env <- checkNoErrs (tcTyAndClassDecls tycl_decls) ;
 756         -- tcTyAndClassDecls recovers internally, but if anything gave rise to
 757         -- an error we'd better stop now, to avoid a cascade
 758
 759         -- Make these type and class decls available to stuff slurped from interface files
 760         writeMutVar (tcg_type_env_var tcg_env) (tcg_type_env tcg_env) ;
 761
 762
 763         setGblEnv tcg_env       $ do {
 764                 -- Source-language instances, including derivings,
 765                 -- and import the supporting declarations
 766         traceTc (text "Tc3") ;
 767         (tcg_env, inst_infos, deriv_binds) <- tcInstDecls1 tycl_decls inst_decls ;
 768         setGblEnv tcg_env       $ do {
 769
 770                 -- Foreign import declarations next.  No zonking necessary
 771                 -- here; we can tuck them straight into the global environment.
 772         traceTc (text "Tc4") ;
 773         (fi_ids, fi_decls) <- tcForeignImports foreign_decls ;
 774         tcExtendGlobalValEnv fi_ids     $ do {
 775
 776                 -- Default declarations
 777         traceTc (text "Tc4a") ;
 778         default_tys <- tcDefaults default_decls ;
 779         updGblEnv (\gbl -> gbl { tcg_default = default_tys }) $ do {
 780
 781                 -- Value declarations next
 782                 -- We also typecheck any extra binds that came out
 783                 -- of the "deriving" process (deriv_binds)
 784         traceTc (text "Tc5") ;
 785         (tc_val_binds, lcl_env) <- tcTopBinds (val_binds ++ deriv_binds) ;
 786         setLclTypeEnv lcl_env   $ do {
 787
 788                 -- Second pass over class and instance declarations,
 789         traceTc (text "Tc6") ;
 790         (tcl_env, inst_binds) <- tcInstDecls2 tycl_decls inst_infos ;
 791         showLIE (text "after instDecls2") ;
 792
 793                 -- Foreign exports
 794                 -- They need to be zonked, so we return them
 795         traceTc (text "Tc7") ;
 796         (foe_binds, foe_decls) <- tcForeignExports foreign_decls ;
 797
 798                 -- Rules
 799         rules <- tcRules rule_decls ;
 800
 801                 -- Wrap up
 802         traceTc (text "Tc7a") ;
 803         tcg_env <- getGblEnv ;
 804         let { all_binds = tc_val_binds   `unionBags`
 805                           inst_binds     `unionBags`
 806                           foe_binds  ;
 807
 808                 -- Extend the GblEnv with the (as yet un-zonked)
 809                 -- bindings, rules, foreign decls
 810               tcg_env' = tcg_env {  tcg_binds = tcg_binds tcg_env `unionBags` all_binds,
 811                                     tcg_rules = tcg_rules tcg_env ++ rules,
 812                                     tcg_fords = tcg_fords tcg_env ++ foe_decls ++ fi_decls } } ;
 813         return (tcg_env', lcl_env)
 814     }}}}}}
 815 \end{code}
 816
 817
 818 %*********************************************************
 819 %*                                                       *
 820         mkGlobalContext: make up an interactive context
 821
 822         Used for initialising the lexical environment
 823         of the interactive read-eval-print loop
 824 %*                                                       *
 825 %*********************************************************
 826
 827 \begin{code}
 828 #ifdef GHCI
 829 mkExportEnv :: HscEnv -> [ModuleName]   -- Expose these modules' exports only
 830             -> IO GlobalRdrEnv
 831
 832 mkExportEnv hsc_env exports
 833   = do  { mb_envs <- initTcPrintErrors hsc_env iNTERACTIVE $
 834                      mappM getModuleExports exports
 835         ; case mb_envs of
 836              Just envs -> return (foldr plusGlobalRdrEnv emptyGlobalRdrEnv envs)
 837              Nothing   -> return emptyGlobalRdrEnv
 838                              -- Some error; initTc will have printed it
 839     }
 840
 841 getModuleExports :: ModuleName -> TcM GlobalRdrEnv
 842 getModuleExports mod
 843   = do  { iface <- load_iface mod
 844         ; avails <- exportsToAvails (mi_exports iface)
 845         ; let { gres =  [ GRE  { gre_name = name, gre_prov = vanillaProv mod }
 846                         | avail <- avails, name <- availNames avail ] }
 847         ; returnM (mkGlobalRdrEnv gres) }
 848
 849 vanillaProv :: ModuleName -> Provenance
 850 -- We're building a GlobalRdrEnv as if the user imported
 851 -- all the specified modules into the global interactive module
 852 vanillaProv mod = Imported [ImportSpec mod mod False
 853                              (srcLocSpan interactiveSrcLoc)] False
 854 \end{code}
 855
 856 \begin{code}
 857 getModuleContents
 858   :: HscEnv
 859   -> InteractiveContext
 860   -> ModuleName                 -- Module to inspect
 861   -> Bool                       -- Grab just the exports, or the whole toplev
 862   -> IO (Maybe [IfaceDecl])
 863
 864 getModuleContents hsc_env ictxt mod exports_only
 865  = initTcPrintErrors hsc_env iNTERACTIVE (get_mod_contents exports_only)
 866  where
 867    get_mod_contents exports_only
 868       | not exports_only        -- We want the whole top-level type env
 869                           -- so it had better be a home module
 870       = do { hpt <- getHpt
 871            ; case lookupModuleEnvByName hpt mod of
 872                Just mod_info -> return (map (toIfaceDecl ictxt) $
 873                                         filter wantToSee $
 874                                         typeEnvElts $
 875                                         md_types (hm_details mod_info))
 876                Nothing -> ghcError (ProgramError (showSDoc (noRdrEnvErr mod)))
 877                           -- This is a system error; the module should be in the HPT
 878            }
 879
 880       | otherwise               -- Want the exports only
 881       = do { iface <- load_iface mod
 882            ; avails <- exportsToAvails (mi_exports iface)
 883            ; mappM get_decl avails
 884         }
 885
 886    get_decl avail
 887         = do { thing <- tcLookupGlobal (availName avail)
 888              ; return (filter_decl (availOccs avail) (toIfaceDecl ictxt thing)) }
 889
 890 ---------------------
 891 filter_decl occs decl@(IfaceClass {ifSigs = sigs})
 892   = decl { ifSigs = filter (keep_sig occs) sigs }
 893 filter_decl occs decl@(IfaceData {ifCons = IfDataTyCon cons})
 894   = decl { ifCons = IfDataTyCon (filter (keep_con occs) cons) }
 895 filter_decl occs decl@(IfaceData {ifCons = IfNewTyCon con})
 896   | keep_con occs con = decl
 897   | otherwise         = decl {ifCons = IfAbstractTyCon} -- Hmm?
 898 filter_decl occs decl
 899   = decl
 900
 901 keep_sig occs (IfaceClassOp occ _ _)       = occ `elem` occs
 902 keep_con occs (IfaceConDecl occ _ _ _ _ _) = occ `elem` occs
 903
 904 availOccs avail = map nameOccName (availNames avail)
 905
 906 wantToSee (AnId id)    = not (isImplicitId id)
 907 wantToSee (ADataCon _) = False  -- They'll come via their TyCon
 908 wantToSee _            = True
 909
 910 ---------------------
 911 load_iface mod = loadSrcInterface doc mod False {- Not boot iface -}
 912                where
 913                  doc = ptext SLIT("context for compiling statements")
 914
 915 ---------------------
 916 noRdrEnvErr mod = ptext SLIT("No top-level environment available for module")
 917                   <+> quotes (ppr mod)
 918 #endif
 919 \end{code}
 920
 921 %************************************************************************
 922 %*                                                                      *
 923         Checking for 'main'
 924 %*                                                                      *
 925 %************************************************************************
 926
 927 \begin{code}
 928 checkMain
 929   = do { ghci_mode <- getGhciMode ;
 930          tcg_env   <- getGblEnv ;
 931
 932          mb_main_mod <- readMutVar v_MainModIs ;
 933          mb_main_fn  <- readMutVar v_MainFunIs ;
 934          let { main_mod = case mb_main_mod of {
 935                                 Just mod -> mkModuleName mod ;
 936                                 Nothing  -> mAIN_Name } ;
 937                main_fn  = case mb_main_fn of {
 938                                 Just fn -> mkRdrUnqual (mkVarOcc (mkFastString fn)) ;
 939                                 Nothing -> main_RDR_Unqual } } ;
 940
 941          check_main ghci_mode tcg_env main_mod main_fn
 942     }
 943
 944
 945 check_main ghci_mode tcg_env main_mod main_fn
 946      -- If we are in module Main, check that 'main' is defined.
 947      -- It may be imported from another module!
 948      --
 949      -- ToDo: We have to return the main_name separately, because it's a
 950      -- bona fide 'use', and should be recorded as such, but the others
 951      -- aren't
 952      --
 953      -- Blimey: a whole page of code to do this...
 954  | mod_name /= main_mod
 955  = return tcg_env
 956
 957  | otherwise
 958  = addErrCtxt mainCtxt                  $
 959    do   { mb_main <- lookupSrcOcc_maybe main_fn
 960                 -- Check that 'main' is in scope
 961                 -- It might be imported from another module!
 962         ; case mb_main of {
 963              Nothing -> do { complain_no_main
 964                            ; return tcg_env } ;
 965              Just main_name -> do
 966         { let { rhs = nlHsApp (nlHsVar runIOName) (nlHsVar main_name) }
 967                         -- :Main.main :: IO () = runIO main
 968
 969         ; (main_expr, ty) <- addSrcSpan (srcLocSpan (getSrcLoc main_name)) $
 970                              tcInferRho rhs
 971
 972         ; let { root_main_id = mkExportedLocalId rootMainName ty ;
 973                 main_bind    = noLoc (VarBind root_main_id main_expr) }
 974
 975         ; return (tcg_env { tcg_binds = tcg_binds tcg_env
 976                                         `snocBag` main_bind,
 977                             tcg_dus   = tcg_dus tcg_env
 978                                         `plusDU` usesOnly (unitFV main_name)
 979                  })
 980     }}}
 981   where
 982     mod_name = moduleName (tcg_mod tcg_env)
 983
 984     complain_no_main | ghci_mode == Interactive = return ()
 985                      | otherwise                = failWithTc noMainMsg
 986         -- In interactive mode, don't worry about the absence of 'main'
 987         -- In other modes, fail altogether, so that we don't go on
 988         -- and complain a second time when processing the export list.
 989
 990     mainCtxt  = ptext SLIT("When checking the type of the main function") <+> quotes (ppr main_fn)
 991     noMainMsg = ptext SLIT("The main function") <+> quotes (ppr main_fn)
 992                 <+> ptext SLIT("is not defined in module") <+> quotes (ppr main_mod)
 993 \end{code}
 994
 995
 996 %************************************************************************
 997 %*                                                                      *
 998                 Degugging output
 999 %*                                                                      *
1000 %************************************************************************
1001
1002 \begin{code}
1003 rnDump :: SDoc -> TcRn ()
1004 -- Dump, with a banner, if -ddump-rn
1005 rnDump doc = do { dumpOptTcRn Opt_D_dump_rn (mkDumpDoc "Renamer" doc) }
1006
1007 tcDump :: TcGblEnv -> TcRn ()
1008 tcDump env
1009  = do { dflags <- getDOpts ;
1010
1011         -- Dump short output if -ddump-types or -ddump-tc
1012         ifM (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
1013             (dumpTcRn short_dump) ;
1014
1015         -- Dump bindings if -ddump-tc
1016         dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump)
1017    }
1018   where
1019     short_dump = pprTcGblEnv env
1020     full_dump  = ppr (tcg_binds env)
1021         -- NB: foreign x-d's have undefined's in their types;
1022         --     hence can't show the tc_fords
1023
1024 tcCoreDump mod_guts
1025  = do { dflags <- getDOpts ;
1026         ifM (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
1027             (dumpTcRn (pprModGuts mod_guts)) ;
1028
1029         -- Dump bindings if -ddump-tc
1030         dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump) }
1031   where
1032     full_dump = pprCoreBindings (mg_binds mod_guts)
1033
1034 -- It's unpleasant having both pprModGuts and pprModDetails here
1035 pprTcGblEnv :: TcGblEnv -> SDoc
1036 pprTcGblEnv (TcGblEnv { tcg_type_env = type_env,
1037                         tcg_insts    = dfun_ids,
1038                         tcg_rules    = rules,
1039                         tcg_imports  = imports })
1040   = vcat [ ppr_types dfun_ids type_env
1041          , ppr_insts dfun_ids
1042          , vcat (map ppr rules)
1043          , ppr_gen_tycons (typeEnvTyCons type_env)
1044          , ptext SLIT("Dependent modules:") <+> ppr (moduleEnvElts (imp_dep_mods imports))
1045          , ptext SLIT("Dependent packages:") <+> ppr (imp_dep_pkgs imports)]
1046
1047 pprModGuts :: ModGuts -> SDoc
1048 pprModGuts (ModGuts { mg_types = type_env,
1049                       mg_rules = rules })
1050   = vcat [ ppr_types [] type_env,
1051            ppr_rules rules ]
1052
1053
1054 ppr_types :: [Var] -> TypeEnv -> SDoc
1055 ppr_types dfun_ids type_env
1056   = text "TYPE SIGNATURES" $$ nest 4 (ppr_sigs ids)
1057   where
1058     ids = [id | id <- typeEnvIds type_env, want_sig id]
1059     want_sig id | opt_PprStyle_Debug = True
1060                 | otherwise          = isLocalId id &&
1061                                        isExternalName (idName id) &&
1062                                        not (id `elem` dfun_ids)
1063         -- isLocalId ignores data constructors, records selectors etc.
1064         -- The isExternalName ignores local dictionary and method bindings
1065         -- that the type checker has invented.  Top-level user-defined things
1066         -- have External names.
1067
1068 ppr_insts :: [Var] -> SDoc
1069 ppr_insts []       = empty
1070 ppr_insts dfun_ids = text "INSTANCES" $$ nest 4 (ppr_sigs dfun_ids)
1071
1072 ppr_sigs :: [Var] -> SDoc
1073 ppr_sigs ids
1074         -- Print type signatures; sort by OccName
1075   = vcat (map ppr_sig (sortLt lt_sig ids))
1076   where
1077     lt_sig id1 id2 = getOccName id1 < getOccName id2
1078     ppr_sig id = ppr id <+> dcolon <+> ppr (tidyTopType (idType id))
1079
1080 ppr_rules :: [IdCoreRule] -> SDoc
1081 ppr_rules [] = empty
1082 ppr_rules rs = vcat [ptext SLIT("{-# RULES"),
1083                       nest 4 (pprIdRules rs),
1084                       ptext SLIT("#-}")]
1085
1086 ppr_gen_tycons []  = empty
1087 ppr_gen_tycons tcs = vcat [ptext SLIT("Tycons with generics:"),
1088                            nest 2 (fsep (map ppr (filter tyConHasGenerics tcs)))]
1089 \end{code}