2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[TcModule]{Typechecking a whole module}
9 mkGlobalContext, getModuleContents,
11 tcRnModule, checkOldIface,
12 importSupportingDecls, tcTopSrcDecls,
13 tcRnIface, tcRnExtCore, tcRnStmt, tcRnExpr, tcRnThing
16 #include "HsVersions.h"
19 import {-# SOURCE #-} TcSplice ( tcSpliceDecls )
20 import DsMeta ( templateHaskellNames )
23 import CmdLineOpts ( DynFlag(..), opt_PprStyle_Debug, dopt )
24 import HsSyn ( HsModule(..), HsBinds(..), MonoBinds(..), HsExpr(..),
25 Stmt(..), Pat(VarPat), HsStmtContext(..), RuleDecl(..),
26 HsGroup(..), SpliceDecl(..),
27 mkSimpleMatch, placeHolderType, toHsType, andMonoBinds,
28 isSrcRule, collectStmtsBinders
30 import RdrHsSyn ( RdrNameHsModule, RdrNameHsDecl, RdrNameStmt, RdrNameHsExpr,
31 emptyGroup, mkGroup, findSplice, addImpDecls )
33 import PrelNames ( iNTERACTIVE, ioTyConName, printName,
34 returnIOName, bindIOName, failIOName, thenIOName, runIOName,
35 dollarMainName, itName, mAIN_Name
37 import MkId ( unsafeCoerceId )
38 import RdrName ( RdrName, getRdrName, mkRdrUnqual,
39 lookupRdrEnv, elemRdrEnv )
41 import RnHsSyn ( RenamedStmt, RenamedTyClDecl,
42 ruleDeclFVs, instDeclFVs, tyClDeclFVs )
43 import TcHsSyn ( TypecheckedHsExpr, TypecheckedRuleDecl,
44 zonkTopBinds, zonkTopDecls, mkHsLet,
45 zonkTopExpr, zonkTopBndrs
48 import TcExpr ( tcExpr_id )
50 import TcMType ( newTyVarTy, zonkTcType )
51 import TcType ( Type, liftedTypeKind,
52 tyVarsOfType, tcFunResultTy,
53 mkForAllTys, mkFunTys, mkTyConApp, tcSplitForAllTys
55 import TcMatches ( tcStmtsAndThen )
56 import Inst ( showLIE )
57 import TcBinds ( tcTopBinds )
58 import TcClassDcl ( tcClassDecls2 )
59 import TcDefaults ( tcDefaults )
60 import TcEnv ( RecTcGblEnv,
63 tcExtendInstEnv, tcExtendRules,
64 tcLookupTyCon, tcLookupGlobal,
67 import TcRules ( tcRules )
68 import TcForeign ( tcForeignImports, tcForeignExports )
69 import TcIfaceSig ( tcInterfaceSigs, tcCoreBinds )
70 import TcInstDcls ( tcInstDecls1, tcIfaceInstDecls, tcInstDecls2 )
71 import TcSimplify ( tcSimplifyTop, tcSimplifyInfer )
72 import TcTyClsDecls ( tcTyAndClassDecls )
74 import RnNames ( importsFromLocalDecls, rnImports, exportsFromAvail,
75 reportUnusedNames, main_RDR_Unqual )
76 import RnIfaces ( slurpImpDecls, checkVersions, RecompileRequired, outOfDate )
77 import RnHiFiles ( readIface, loadOldIface )
78 import RnEnv ( lookupSrcName, lookupOccRn, plusGlobalRdrEnv,
79 ubiquitousNames, implicitModuleFVs, implicitStmtFVs, dataTcOccs )
80 import RnExpr ( rnStmts, rnExpr )
81 import RnSource ( rnSrcDecls, checkModDeprec, rnStats )
83 import CoreUnfold ( unfoldingTemplate )
84 import CoreSyn ( IdCoreRule, Bind(..) )
85 import PprCore ( pprIdRules, pprCoreBindings )
86 import TysWiredIn ( mkListTy, unitTy )
87 import ErrUtils ( mkDumpDoc, showPass )
88 import Id ( Id, mkLocalId, isLocalId, idName, idType, idUnfolding, setIdLocalExported )
89 import IdInfo ( GlobalIdDetails(..) )
90 import Var ( Var, setGlobalIdDetails )
91 import Module ( Module, moduleName, moduleUserString, moduleEnvElts )
92 import Name ( Name, isExternalName, getSrcLoc, nameOccName )
93 import NameEnv ( delListFromNameEnv )
95 import TyCon ( tyConGenInfo )
96 import BasicTypes ( EP(..), RecFlag(..) )
97 import SrcLoc ( noSrcLoc )
99 import HscTypes ( PersistentCompilerState(..), InteractiveContext(..),
100 ModIface, ModDetails(..), ModGuts(..),
102 ModIface(..), ModDetails(..), IfaceDecls(..),
103 GhciMode(..), noDependencies,
104 Deprecations(..), plusDeprecs,
106 GenAvailInfo(Avail), availsToNameSet,
108 TypeEnv, TyThing, typeEnvTyCons,
109 extendTypeEnvWithIds, typeEnvIds, typeEnvTyCons,
110 extendLocalRdrEnv, emptyFixityEnv
113 import RdrName ( rdrEnvElts )
114 import RnHiFiles ( loadInterface )
115 import RnEnv ( mkGlobalRdrEnv )
116 import HscTypes ( GlobalRdrElt(..), GlobalRdrEnv, ImportReason(..), Provenance(..),
120 import Maybe ( catMaybes )
121 import Panic ( showException )
122 import List ( partition )
123 import Util ( sortLt )
128 %************************************************************************
130 Typecheck and rename a module
132 %************************************************************************
136 tcRnModule :: HscEnv -> PersistentCompilerState
138 -> IO (PersistentCompilerState, Maybe TcGblEnv)
140 tcRnModule hsc_env pcs
141 (HsModule this_mod _ exports import_decls local_decls mod_deprec loc)
142 = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
144 initTc hsc_env pcs this_mod $ addSrcLoc loc $
145 do { -- Deal with imports; sets tcg_rdr_env, tcg_imports
146 (rdr_env, imports) <- rnImports import_decls ;
147 updGblEnv ( \ gbl -> gbl { tcg_rdr_env = rdr_env,
148 tcg_imports = tcg_imports gbl `plusImportAvails` imports })
150 traceRn (text "rn1" <+> ppr (imp_dep_mods imports)) ;
151 -- Fail if there are any errors so far
152 -- The error printing (if needed) takes advantage
153 -- of the tcg_env we have now set
156 traceRn (text "rn1a") ;
157 -- Rename and type check the declarations
158 (tcg_env, src_fvs) <- tcRnSrcDecls local_decls ;
159 setGblEnv tcg_env $ do {
160 traceRn (text "rn2") ;
163 (tcg_env, main_fvs) <- checkMain ;
164 setGblEnv tcg_env $ do {
166 traceRn (text "rn3") ;
167 -- Check whether the entire module is deprecated
168 -- This happens only once per module
169 -- Returns the full new deprecations; a module deprecation
170 -- over-rides the earlier ones
171 let { mod_deprecs = checkModDeprec mod_deprec } ;
172 updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` mod_deprecs })
175 -- Process the export list
176 export_avails <- exportsFromAvail exports ;
177 updGblEnv (\gbl -> gbl { tcg_exports = export_avails })
180 -- Get any supporting decls for the exports that have not already
181 -- been sucked in for the declarations in the body of the module.
182 -- (This can happen if something is imported only to be re-exported.)
184 -- Importing these supporting declarations is required
185 -- *only* to gether usage information
186 -- (see comments with MkIface.mkImportInfo for why)
187 -- For OneShot compilation we could just throw away the decls
188 -- but for Batch or Interactive we must put them in the type
189 -- envt because they've been removed from the holding pen
190 let { export_fvs = availsToNameSet export_avails } ;
191 tcg_env <- importSupportingDecls export_fvs ;
192 setGblEnv tcg_env $ do {
194 -- Report unused names
195 let { used_fvs = src_fvs `plusFV` main_fvs `plusFV` export_fvs } ;
196 reportUnusedNames tcg_env used_fvs ;
198 -- Dump output and return
205 %*********************************************************
207 \subsection{Closing up the interface decls}
209 %*********************************************************
211 Suppose we discover we don't need to recompile. Then we start from the
212 IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
216 -> PersistentCompilerState
217 -> ModIface -- Get the decls from here
218 -> IO (PersistentCompilerState, Maybe ModDetails)
219 -- Nothing <=> errors happened
220 tcRnIface hsc_env pcs
221 (ModIface {mi_module = mod, mi_decls = iface_decls})
222 = initTc hsc_env pcs mod $ do {
224 -- Get the supporting decls, and typecheck them all together
225 -- so that any mutually recursive types are done right
226 extra_decls <- slurpImpDecls needed ;
227 env <- typecheckIfaceDecls (group `addImpDecls` extra_decls) ;
229 returnM (ModDetails { md_types = tcg_type_env env,
230 md_insts = tcg_insts env,
231 md_rules = hsCoreRules (tcg_rules env)
232 -- All the rules from an interface are of the IfaceRuleOut form
235 rule_decls = dcl_rules iface_decls
236 inst_decls = dcl_insts iface_decls
237 tycl_decls = dcl_tycl iface_decls
238 group = emptyGroup { hs_ruleds = rule_decls,
239 hs_instds = inst_decls,
240 hs_tyclds = tycl_decls }
241 needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
242 unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
243 unionManyNameSets (map tyClDeclFVs tycl_decls) `unionNameSets`
245 -- Data type decls with record selectors,
246 -- which may appear in the decls, need unpackCString
247 -- and friends. It's easier to just grab them right now.
249 hsCoreRules :: [TypecheckedRuleDecl] -> [IdCoreRule]
250 -- All post-typechecking Iface rules have the form IfaceRuleOut
251 hsCoreRules rules = [(id,rule) | IfaceRuleOut id rule <- rules]
255 %************************************************************************
257 The interactive interface
259 %************************************************************************
262 tcRnStmt :: HscEnv -> PersistentCompilerState
263 -> InteractiveContext
265 -> IO (PersistentCompilerState,
266 Maybe (InteractiveContext, [Name], TypecheckedHsExpr))
267 -- The returned [Name] is the same as the input except for
268 -- ExprStmt, in which case the returned [Name] is [itName]
270 -- The returned TypecheckedHsExpr is of type IO [ () ],
271 -- a list of the bound values, coerced to ().
273 tcRnStmt hsc_env pcs ictxt rdr_stmt
274 = initTc hsc_env pcs iNTERACTIVE $
275 setInteractiveContext ictxt $ do {
277 -- Rename; use CmdLineMode because tcRnStmt is only used interactively
278 ([rn_stmt], fvs) <- initRnInteractive ictxt
279 (rnStmts DoExpr [rdr_stmt]) ;
280 traceRn (text "tcRnStmt" <+> vcat [ppr rdr_stmt, ppr rn_stmt, ppr fvs]) ;
283 -- Suck in the supporting declarations and typecheck them
284 tcg_env <- importSupportingDecls (fvs `plusFV` implicitStmtFVs fvs) ;
285 -- NB: an earlier version deleted (rdrEnvElts local_env) from
286 -- the fvs. But (a) that isn't necessary, because previously
287 -- bound things in the local_env will be in the TypeEnv, and
288 -- the renamer doesn't re-slurp such things, and
289 -- (b) it's WRONG to delete them. Consider in GHCi:
290 -- Mod> let x = e :: T
291 -- Mod> let y = x + 3
292 -- We need to pass 'x' among the fvs to slurpImpDecls, so that
293 -- the latter can see that T is a gate, and hence import the Num T
294 -- instance decl. (See the InTypEnv case in RnIfaces.slurpSourceRefs.)
295 setGblEnv tcg_env $ do {
297 -- The real work is done here
298 ((bound_ids, tc_expr), lie) <- getLIE (tcUserStmt rn_stmt) ;
300 traceTc (text "tcs 1") ;
301 let { -- Make all the bound ids "global" ids, now that
302 -- they're notionally top-level bindings. This is
303 -- important: otherwise when we come to compile an expression
304 -- using these ids later, the byte code generator will consider
305 -- the occurrences to be free rather than global.
306 global_ids = map globaliseId bound_ids ;
307 globaliseId id = setGlobalIdDetails id VanillaGlobal ;
309 -- Update the interactive context
310 rn_env = ic_rn_local_env ictxt ;
311 type_env = ic_type_env ictxt ;
313 bound_names = map idName global_ids ;
314 new_rn_env = extendLocalRdrEnv rn_env bound_names ;
316 -- Remove any shadowed bindings from the type_env;
317 -- they are inaccessible but might, I suppose, cause
318 -- a space leak if we leave them there
319 shadowed = [ n | name <- bound_names,
320 let rdr_name = mkRdrUnqual (nameOccName name),
321 Just n <- [lookupRdrEnv rn_env rdr_name] ] ;
323 filtered_type_env = delListFromNameEnv type_env shadowed ;
324 new_type_env = extendTypeEnvWithIds filtered_type_env global_ids ;
326 new_ic = ictxt { ic_rn_local_env = new_rn_env,
327 ic_type_env = new_type_env }
330 dumpOptTcRn Opt_D_dump_tc
331 (vcat [text "Bound Ids" <+> pprWithCommas ppr global_ids,
332 text "Typechecked expr" <+> ppr tc_expr]) ;
334 returnM (new_ic, bound_names, tc_expr)
339 Here is the grand plan, implemented in tcUserStmt
341 What you type The IO [HValue] that hscStmt returns
342 ------------- ------------------------------------
343 let pat = expr ==> let pat = expr in return [coerce HVal x, coerce HVal y, ...]
346 pat <- expr ==> expr >>= \ pat -> return [coerce HVal x, coerce HVal y, ...]
349 expr (of IO type) ==> expr >>= \ v -> return [coerce HVal v]
350 [NB: result not printed] bindings: [it]
352 expr (of non-IO type, ==> let v = expr in print v >> return [coerce HVal v]
353 result showable) bindings: [it]
355 expr (of non-IO type,
356 result not showable) ==> error
360 ---------------------------
361 tcUserStmt :: RenamedStmt -> TcM ([Id], TypecheckedHsExpr)
362 tcUserStmt (ExprStmt expr _ loc)
363 = newUnique `thenM` \ uniq ->
365 fresh_it = itName uniq
366 the_bind = FunMonoBind fresh_it False
367 [ mkSimpleMatch [] expr placeHolderType loc ] loc
369 tryTcLIE_ (do { -- Try this if the other fails
370 traceTc (text "tcs 1b") ;
372 LetStmt (MonoBind the_bind [] NonRecursive),
373 ExprStmt (HsApp (HsVar printName) (HsVar fresh_it))
374 placeHolderType loc] })
375 (do { -- Try this first
376 traceTc (text "tcs 1a") ;
377 tc_stmts [BindStmt (VarPat fresh_it) expr loc] })
379 tcUserStmt stmt = tc_stmts [stmt]
381 ---------------------------
383 = do { io_ids <- mappM tcLookupId
384 [returnIOName, failIOName, bindIOName, thenIOName] ;
385 ioTyCon <- tcLookupTyCon ioTyConName ;
386 res_ty <- newTyVarTy liftedTypeKind ;
388 names = collectStmtsBinders stmts ;
389 return_id = head io_ids ; -- Rather gruesome
391 io_ty = (\ ty -> mkTyConApp ioTyCon [ty], res_ty) ;
393 -- mk_return builds the expression
394 -- returnIO @ [()] [coerce () x, .., coerce () z]
395 mk_return ids = HsApp (TyApp (HsVar return_id) [mkListTy unitTy])
396 (ExplicitList unitTy (map mk_item ids)) ;
398 mk_item id = HsApp (TyApp (HsVar unsafeCoerceId) [idType id, unitTy])
401 -- OK, we're ready to typecheck the stmts
402 traceTc (text "tcs 2") ;
403 ((ids, tc_stmts), lie) <-
404 getLIE $ tcStmtsAndThen combine DoExpr io_ty stmts $
406 -- Look up the names right in the middle,
407 -- where they will all be in scope
408 ids <- mappM tcLookupId names ;
409 return (ids, [ResultStmt (mk_return ids) noSrcLoc])
412 -- Simplify the context right here, so that we fail
413 -- if there aren't enough instances. Notably, when we see
415 -- we use recoverTc_ to try it <- e
416 -- and then let it = e
417 -- It's the simplify step that rejects the first.
418 traceTc (text "tcs 3") ;
419 const_binds <- tcSimplifyTop lie ;
421 -- Build result expression and zonk it
422 let { expr = mkHsLet const_binds $
423 HsDo DoExpr tc_stmts io_ids
424 (mkTyConApp ioTyCon [mkListTy unitTy]) noSrcLoc } ;
425 zonked_expr <- zonkTopExpr expr ;
426 zonked_ids <- zonkTopBndrs ids ;
428 return (zonked_ids, zonked_expr)
431 combine stmt (ids, stmts) = (ids, stmt:stmts)
435 tcRnExpr just finds the type of an expression
438 tcRnExpr :: HscEnv -> PersistentCompilerState
439 -> InteractiveContext
441 -> IO (PersistentCompilerState, Maybe Type)
442 tcRnExpr hsc_env pcs ictxt rdr_expr
443 = initTc hsc_env pcs iNTERACTIVE $
444 setInteractiveContext ictxt $ do {
446 (rn_expr, fvs) <- initRnInteractive ictxt (rnExpr rdr_expr) ;
449 -- Suck in the supporting declarations and typecheck them
450 tcg_env <- importSupportingDecls (fvs `plusFV` ubiquitousNames) ;
451 setGblEnv tcg_env $ do {
453 -- Now typecheck the expression;
454 -- it might have a rank-2 type (e.g. :t runST)
455 -- Hence the hole type (c.f. TcExpr.tcExpr_id)
456 ((tc_expr, res_ty), lie) <- getLIE (tcExpr_id rn_expr) ;
457 ((qtvs, _, dict_ids), lie_top) <- getLIE (tcSimplifyInfer smpl_doc (tyVarsOfType res_ty) lie) ;
458 tcSimplifyTop lie_top ;
460 let { all_expr_ty = mkForAllTys qtvs $
461 mkFunTys (map idType dict_ids) $
463 zonkTcType all_expr_ty
466 smpl_doc = ptext SLIT("main expression")
471 tcRnThing :: HscEnv -> PersistentCompilerState
472 -> InteractiveContext
474 -> IO (PersistentCompilerState, Maybe [TyThing])
475 -- Look up a RdrName and return all the TyThings it might be
476 -- We treat a capitalised RdrName as both a data constructor
477 -- and as a type or class constructor; hence we return up to two results
478 tcRnThing hsc_env pcs ictxt rdr_name
479 = initTc hsc_env pcs iNTERACTIVE $
480 setInteractiveContext ictxt $ do {
482 -- If the identifier is a constructor (begins with an
483 -- upper-case letter), then we need to consider both
484 -- constructor and type class identifiers.
485 let { rdr_names = dataTcOccs rdr_name } ;
487 (msgs_s, mb_names) <- initRnInteractive ictxt
488 (mapAndUnzipM (tryTc . lookupOccRn) rdr_names) ;
489 let { names = catMaybes mb_names } ;
492 do { addMessages (head msgs_s) ; failM }
495 -- Add deprecation warnings
496 mapM_ addMessages msgs_s ;
498 -- Slurp in the supporting declarations
499 tcg_env <- importSupportingDecls (mkFVs names) ;
500 setGblEnv tcg_env $ do {
502 -- And lookup up the entities
503 mapM tcLookupGlobal names
509 setInteractiveContext :: InteractiveContext -> TcRn m a -> TcRn m 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 })
516 initRnInteractive :: InteractiveContext -> RnM a -> TcM a
517 -- Set the local RdrEnv from the interactive context
518 initRnInteractive ictxt rn_thing
519 = initRn CmdLineMode $
520 setLocalRdrEnv (ic_rn_local_env ictxt) $
524 %************************************************************************
526 Type-checking external-core modules
528 %************************************************************************
531 tcRnExtCore :: HscEnv -> PersistentCompilerState
533 -> IO (PersistentCompilerState, Maybe ModGuts)
534 -- Nothing => some error occurred
536 tcRnExtCore hsc_env pcs
537 (HsModule this_mod _ _ _ local_decls _ loc)
538 -- Rename the (Core) module. It's a bit like an interface
539 -- file: all names are original names
540 = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
542 initTc hsc_env pcs this_mod $ addSrcLoc loc $ do {
544 -- Rename the source, only in interface mode.
545 -- rnSrcDecls handles fixity decls etc too, which won't occur
546 -- but that doesn't matter
547 let { local_group = mkGroup local_decls } ;
548 (_, rn_local_decls, fvs) <- initRn (InterfaceMode this_mod)
549 (rnSrcDecls local_group) ;
552 -- Get the supporting decls, and typecheck them all together
553 -- so that any mutually recursive types are done right
554 extra_decls <- slurpImpDecls fvs ;
555 tcg_env <- typecheckIfaceDecls (rn_local_decls `addImpDecls` extra_decls) ;
556 setGblEnv tcg_env $ do {
558 -- Now the core bindings
559 core_prs <- tcCoreBinds (hs_coreds rn_local_decls) ;
560 tcExtendGlobalValEnv (map fst core_prs) $ do {
564 bndrs = map fst core_prs ;
565 my_exports = map (Avail . idName) bndrs ;
566 -- ToDo: export the data types also?
568 final_type_env = extendTypeEnvWithIds (tcg_type_env tcg_env) bndrs ;
570 mod_guts = ModGuts { mg_module = this_mod,
571 mg_usages = [], -- ToDo: compute usage
572 mg_dir_imps = [], -- ??
573 mg_deps = noDependencies, -- ??
574 mg_exports = my_exports,
575 mg_types = final_type_env,
576 mg_insts = tcg_insts tcg_env,
577 mg_rules = hsCoreRules (tcg_rules tcg_env),
578 mg_binds = [Rec core_prs],
581 mg_rdr_env = emptyGlobalRdrEnv,
582 mg_fix_env = emptyFixityEnv,
583 mg_deprecs = NoDeprecs,
587 tcCoreDump mod_guts ;
594 %************************************************************************
596 Type-checking the top level of a module
598 %************************************************************************
601 tcRnSrcDecls :: [RdrNameHsDecl] -> TcM (TcGblEnv, FreeVars)
602 -- Returns the variables free in the decls
603 -- Reason: solely to report unused imports and bindings
604 tcRnSrcDecls [] = do { tcg_env <- getGblEnv ; return (tcg_env, emptyFVs) }
606 = do { let { (first_group, group_tail) = findSplice ds } ;
608 -- Type check the decls up to, but not including, the first splice
609 (tcg_env, src_fvs1) <- tcRnGroup first_group ;
611 -- Bale out if errors; for example, error recovery when checking
612 -- the RHS of 'main' can mean that 'main' is not in the envt for
613 -- the subsequent checkMain test
616 -- If there is no splice, we're done
618 Nothing -> return (tcg_env, src_fvs1) ;
619 Just (SpliceDecl splice_expr splice_loc, rest_ds) ->
621 failWithTc (text "Can't do a top-level splice; need a bootstrapped compiler")
623 setGblEnv tcg_env $ do {
625 -- Rename the splice expression, and get its supporting decls
626 (rn_splice_expr, fvs) <- initRn SourceMode $
627 addSrcLoc splice_loc $
629 tcg_env <- importSupportingDecls (fvs `plusFV` templateHaskellNames) ;
630 setGblEnv tcg_env $ do {
632 -- Execute the splice
633 spliced_decls <- tcSpliceDecls rn_splice_expr ;
635 -- Glue them on the front of the remaining decls and loop
636 (tcg_env, src_fvs2) <- tcRnSrcDecls (spliced_decls ++ rest_ds) ;
638 return (tcg_env, src_fvs1 `plusFV` src_fvs2)
645 %************************************************************************
647 Type-checking the top level of a module
649 %************************************************************************
651 tcRnGroup takes a bunch of top-level source-code declarations, and
653 * gets supporting declarations from interface files
656 * and augments the TcGblEnv with the results
658 In Template Haskell it may be called repeatedly for each group of
659 declarations. It expects there to be an incoming TcGblEnv in the
660 monad; it augments it and returns the new TcGblEnv.
663 tcRnGroup :: HsGroup RdrName -> TcM (TcGblEnv, FreeVars)
664 -- Returns the variables free in the decls
666 = do { -- Rename the declarations
667 (tcg_env, rn_decls, src_fvs) <- rnTopSrcDecls decls ;
668 setGblEnv tcg_env $ do {
670 -- Typecheck the declarations
671 tcg_env <- tcTopSrcDecls rn_decls ;
672 return (tcg_env, src_fvs)
675 ------------------------------------------------
676 rnTopSrcDecls :: HsGroup RdrName -> TcM (TcGblEnv, HsGroup Name, FreeVars)
678 = do { -- Bring top level binders into scope
679 (rdr_env, imports) <- importsFromLocalDecls group ;
680 updGblEnv (\gbl -> gbl { tcg_rdr_env = rdr_env `plusGlobalRdrEnv`
682 tcg_imports = imports `plusImportAvails`
686 failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
688 -- Rename the source decls
689 (tcg_env, rn_src_decls, src_fvs) <- initRn SourceMode (rnSrcDecls group) ;
690 setGblEnv tcg_env $ do {
694 -- Import consquential imports
695 rn_imp_decls <- slurpImpDecls (src_fvs `plusFV` implicitModuleFVs src_fvs) ;
696 let { rn_decls = rn_src_decls `addImpDecls` rn_imp_decls } ;
698 -- Dump trace of renaming part
699 rnDump (ppr rn_decls) ;
700 rnStats rn_imp_decls ;
702 return (tcg_env, rn_decls, src_fvs)
705 ------------------------------------------------
706 tcTopSrcDecls :: HsGroup Name -> TcM TcGblEnv
707 tcTopSrcDecls rn_decls
708 = do { -- Do the main work
709 ((tcg_env, lcl_env, binds, rules, fords), lie) <- getLIE (
710 tc_src_decls rn_decls
713 -- tcSimplifyTop deals with constant or ambiguous InstIds.
714 -- How could there be ambiguous ones? They can only arise if a
715 -- top-level decl falls under the monomorphism
716 -- restriction, and no subsequent decl instantiates its
717 -- type. (Usually, ambiguous type variables are resolved
718 -- during the generalisation step.)
719 traceTc (text "Tc8") ;
720 inst_binds <- setGblEnv tcg_env $
721 setLclTypeEnv lcl_env $
723 -- The setGblEnv exposes the instances to tcSimplifyTop
724 -- The setLclTypeEnv exposes the local Ids, so that
725 -- we get better error messages (monomorphism restriction)
727 -- Backsubstitution. This must be done last.
728 -- Even tcSimplifyTop may do some unification.
729 traceTc (text "Tc9") ;
730 (bind_ids, binds', fords', rules') <- zonkTopDecls (binds `andMonoBinds` inst_binds)
733 let { tcg_env' = tcg_env { tcg_type_env = extendTypeEnvWithIds (tcg_type_env tcg_env)
735 tcg_binds = tcg_binds tcg_env `andMonoBinds` binds',
736 tcg_rules = tcg_rules tcg_env ++ rules',
737 tcg_fords = tcg_fords tcg_env ++ fords' } } ;
743 (HsGroup { hs_tyclds = tycl_decls,
744 hs_instds = inst_decls,
745 hs_fords = foreign_decls,
746 hs_defds = default_decls,
747 hs_ruleds = rule_decls,
748 hs_valds = val_binds })
749 = do { -- Type-check the type and class decls, and all imported decls
750 traceTc (text "Tc2") ;
751 tcg_env <- tcTyClDecls tycl_decls ;
752 setGblEnv tcg_env $ do {
754 -- Source-language instances, including derivings,
755 -- and import the supporting declarations
756 traceTc (text "Tc3") ;
757 (tcg_env, inst_infos, deriv_binds, fvs) <- tcInstDecls1 tycl_decls inst_decls ;
758 setGblEnv tcg_env $ do {
759 tcg_env <- importSupportingDecls fvs ;
760 setGblEnv tcg_env $ do {
762 -- Foreign import declarations next. No zonking necessary
763 -- here; we can tuck them straight into the global environment.
764 traceTc (text "Tc4") ;
765 (fi_ids, fi_decls) <- tcForeignImports foreign_decls ;
766 tcExtendGlobalValEnv fi_ids $
767 updGblEnv (\gbl -> gbl { tcg_fords = tcg_fords gbl ++ fi_decls })
770 -- Default declarations
771 traceTc (text "Tc4a") ;
772 default_tys <- tcDefaults default_decls ;
773 updGblEnv (\gbl -> gbl { tcg_default = default_tys }) $ do {
775 -- Value declarations next
776 -- We also typecheck any extra binds that came out
777 -- of the "deriving" process
778 traceTc (text "Tc5") ;
779 (tc_val_binds, lcl_env) <- tcTopBinds (val_binds `ThenBinds` deriv_binds) ;
780 setLclTypeEnv lcl_env $ do {
782 -- Second pass over class and instance declarations,
783 -- plus rules and foreign exports, to generate bindings
784 traceTc (text "Tc6") ;
785 (cls_dm_binds, dm_ids) <- tcClassDecls2 tycl_decls ;
786 tcExtendGlobalValEnv dm_ids $ do {
787 inst_binds <- tcInstDecls2 inst_infos ;
788 showLIE "after instDecls2" ;
791 -- They need to be zonked, so we return them
792 traceTc (text "Tc7") ;
793 (foe_binds, foe_decls) <- tcForeignExports foreign_decls ;
796 -- Need to partition them because the source rules
797 -- must be zonked before adding them to tcg_rules
798 -- NB: built-in rules come in as IfaceRuleOut's, and
799 -- get added to tcg_rules right here by tcExtendRules
800 rules <- tcRules rule_decls ;
801 let { (src_rules, iface_rules) = partition isSrcRule rules } ;
802 tcExtendRules iface_rules $ do {
805 tcg_env <- getGblEnv ;
806 let { all_binds = tc_val_binds `AndMonoBinds`
807 inst_binds `AndMonoBinds`
808 cls_dm_binds `AndMonoBinds`
811 return (tcg_env, lcl_env, all_binds, src_rules, foe_decls)
816 tcTyClDecls :: [RenamedTyClDecl]
819 -- tcTyClDecls deals with
820 -- type and class decls (some source, some imported)
821 -- interface signatures (checked lazily)
823 -- It returns the TcGblEnv for this module, and side-effects the
824 -- persistent compiler state to reflect the things imported from
827 tcTyClDecls tycl_decls
829 -- tcTyAndClassDecls recovers internally, but if anything gave rise to
830 -- an error we'd better stop now, to avoid a cascade
832 traceTc (text "TyCl1") `thenM_`
833 tcTyAndClassDecls tycl_decls `thenM` \ tycl_things ->
834 tcExtendGlobalEnv tycl_things $
836 traceTc (text "TyCl2") `thenM_`
837 tcInterfaceSigs tycl_decls `thenM` \ tcg_env ->
838 -- Returns the extended environment
845 %************************************************************************
847 Load the old interface file for this module (unless
848 we have it aleady), and check whether it is up to date
851 %************************************************************************
854 checkOldIface :: HscEnv
855 -> PersistentCompilerState
857 -> FilePath -- Where the interface file is
858 -> Bool -- Source unchanged
859 -> Maybe ModIface -- Old interface from compilation manager, if any
860 -> IO (PersistentCompilerState, Maybe (RecompileRequired, Maybe ModIface))
861 -- Nothing <=> errors happened
863 checkOldIface hsc_env pcs mod iface_path source_unchanged maybe_iface
864 = do { showPass (hsc_dflags hsc_env)
865 ("Checking old interface for " ++ moduleUserString mod) ;
867 initTc hsc_env pcs mod
868 (check_old_iface iface_path source_unchanged maybe_iface)
871 check_old_iface iface_path source_unchanged maybe_iface
872 = -- CHECK WHETHER THE SOURCE HAS CHANGED
873 ifM (not source_unchanged)
874 (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
877 -- If the source has changed and we're in interactive mode, avoid reading
878 -- an interface; just return the one we might have been supplied with.
879 getGhciMode `thenM` \ ghci_mode ->
880 if (ghci_mode == Interactive) && not source_unchanged then
881 returnM (outOfDate, maybe_iface)
885 Just old_iface -> -- Use the one we already have
886 checkVersions source_unchanged old_iface `thenM` \ recomp ->
887 returnM (recomp, Just old_iface)
889 Nothing -- Try and read it from a file
890 -> getModule `thenM` \ this_mod ->
891 readIface this_mod iface_path False `thenM` \ read_result ->
893 Left err -> -- Old interface file not found, or garbled; give up
895 text "Cannot read old interface file:"
896 $$ nest 4 (text (showException err))) `thenM_`
897 returnM (outOfDate, Nothing)
899 Right parsed_iface ->
900 initRn (InterfaceMode this_mod)
901 (loadOldIface parsed_iface) `thenM` \ m_iface ->
902 checkVersions source_unchanged m_iface `thenM` \ recomp ->
903 returnM (recomp, Just m_iface)
907 %************************************************************************
909 Type-check and rename supporting declarations
910 This is used to deal with the free vars of a splice,
911 or derived code: slurp in the necessary declarations,
912 typecheck them, and add them to the EPS
914 %************************************************************************
917 importSupportingDecls :: FreeVars -> TcM TcGblEnv
918 -- Completely deal with the supporting imports needed
919 -- by the specified free-var set
920 importSupportingDecls fvs
921 = do { traceRn (text "Import supporting decls for" <+> ppr (nameSetToList fvs)) ;
922 decls <- slurpImpDecls fvs ;
923 traceRn (text "...namely:" <+> vcat (map ppr decls)) ;
924 typecheckIfaceDecls (mkGroup decls) }
926 typecheckIfaceDecls :: HsGroup Name -> TcM TcGblEnv
927 -- The decls are all interface-file declarations
928 -- Usually they are all from other modules, but when we are reading
929 -- this module's interface from a file, it's possible that some of
930 -- them are for the module being compiled.
931 -- That is why the tcExtendX functions need to do partitioning.
933 -- If all the decls are from other modules, the returned TcGblEnv
934 -- will have an empty tc_genv, but its tc_inst_env and tc_ist
935 -- caches may have been augmented.
936 typecheckIfaceDecls (HsGroup { hs_tyclds = tycl_decls,
937 hs_instds = inst_decls,
938 hs_ruleds = rule_decls })
939 = do { -- Typecheck the type, class, and interface-sig decls
940 tcg_env <- tcTyClDecls tycl_decls ;
941 setGblEnv tcg_env $ do {
943 -- Typecheck the instance decls, and rules
944 -- Note that imported dictionary functions are already
945 -- in scope from the preceding tcTyClDecls
946 tcIfaceInstDecls inst_decls `thenM` \ dfuns ->
947 tcExtendInstEnv dfuns $
948 tcRules rule_decls `thenM` \ rules ->
949 tcExtendRules rules $
951 getGblEnv -- Return the environment
957 %*********************************************************
959 mkGlobalContext: make up an interactive context
961 Used for initialising the lexical environment
962 of the interactive read-eval-print loop
964 %*********************************************************
969 :: HscEnv -> PersistentCompilerState
970 -> [Module] -- Expose these modules' top-level scope
971 -> [Module] -- Expose these modules' exports only
972 -> IO (PersistentCompilerState, Maybe GlobalRdrEnv)
974 mkGlobalContext hsc_env pcs toplevs exports
975 = initTc hsc_env pcs iNTERACTIVE $ do {
977 toplev_envs <- mappM getTopLevScope toplevs ;
978 export_envs <- mappM getModuleExports exports ;
979 returnM (foldr plusGlobalRdrEnv emptyGlobalRdrEnv
980 (toplev_envs ++ export_envs))
983 getTopLevScope :: Module -> TcRn m GlobalRdrEnv
985 = do { iface <- loadInterface contextDoc (moduleName mod) (ImportByUser False) ;
986 case mi_globals iface of
987 Nothing -> panic "getTopLevScope"
988 Just env -> returnM env }
990 getModuleExports :: Module -> TcRn m GlobalRdrEnv
992 = do { iface <- loadInterface contextDoc (moduleName mod) (ImportByUser False) ;
993 returnM (foldl add emptyGlobalRdrEnv (mi_exports iface)) }
995 prov_fn n = NonLocalDef ImplicitImport
997 = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True prov_fn avails NoDeprecs)
999 contextDoc = text "context for compiling statements"
1005 -> PersistentCompilerState -- IN: persistent compiler state
1006 -> Module -- module to inspect
1007 -> Bool -- grab just the exports, or the whole toplev
1008 -> IO (PersistentCompilerState, Maybe [TyThing])
1010 getModuleContents hsc_env pcs mod exports_only
1011 = initTc hsc_env pcs iNTERACTIVE $ do {
1013 -- Load the interface if necessary (a home module will certainly
1014 -- alraedy be loaded, but a package module might not be)
1015 iface <- loadInterface contextDoc (moduleName mod) (ImportByUser False) ;
1017 let { export_names = availsToNameSet export_avails ;
1018 export_avails = [ avail | (mn, avails) <- mi_exports iface,
1019 avail <- avails ] } ;
1021 all_names <- if exports_only then
1023 else case mi_globals iface of {
1025 return (get_locals rdr_env) ;
1027 Nothing -> do { addErr (noRdrEnvErr mod) ;
1028 return export_names } } ;
1029 -- Invariant; we only have (not exports_only)
1030 -- for a home module so it must already be in the HIT
1031 -- So the Nothing case is a bug
1033 env <- importSupportingDecls all_names ;
1034 setGblEnv env (mappM tcLookupGlobal (nameSetToList all_names))
1037 -- Grab all the things from the global env that are locally def'd
1038 get_locals rdr_env = mkNameSet [ gre_name gre
1039 | elts <- rdrEnvElts rdr_env,
1042 -- Make a set because a name is often in the envt in
1043 -- both qualified and unqualified forms
1045 noRdrEnvErr mod = ptext SLIT("No top-level environment available for module")
1046 <+> quotes (ppr mod)
1050 %************************************************************************
1054 %************************************************************************
1058 = do { ghci_mode <- getGhciMode ;
1059 tcg_env <- getGblEnv ;
1060 check_main ghci_mode tcg_env
1063 check_main ghci_mode tcg_env
1064 -- If we are in module Main, check that 'main' is defined.
1065 -- It may be imported from another module, in which case
1066 -- we have to drag in its.
1068 -- Also form the definition
1069 -- $main = runIO main
1070 -- so we need to slurp in runIO too.
1072 -- ToDo: We have to return the main_name separately, because it's a
1073 -- bona fide 'use', and should be recorded as such, but the others
1076 -- Blimey: a whole page of code to do this...
1078 | mod_name /= mAIN_Name
1079 = return (tcg_env, emptyFVs)
1081 -- Check that 'main' is in scope
1082 -- It might be imported from another module!
1084 -- We use a guard for this (rather than letting lookupSrcName fail)
1085 -- because it's not an error in ghci)
1086 | not (main_RDR_Unqual `elemRdrEnv` rdr_env)
1087 = do { complain_no_main; return (tcg_env, emptyFVs) }
1090 = do { main_name <- lookupSrcName main_RDR_Unqual ;
1092 tcg_env <- importSupportingDecls (unitFV runIOName) ;
1093 setGblEnv tcg_env $ do {
1095 -- $main :: IO () = runIO main
1096 let { rhs = HsApp (HsVar runIOName) (HsVar main_name) } ;
1098 (main_bind, top_lie) <- getLIE (
1099 addSrcLoc (getSrcLoc main_name) $
1100 addErrCtxt mainCtxt $ do {
1101 (main_expr, ty) <- tcExpr_id rhs ;
1102 let { dollar_main_id = setIdLocalExported (mkLocalId dollarMainName ty) } ;
1103 return (VarMonoBind dollar_main_id main_expr)
1106 inst_binds <- tcSimplifyTop top_lie ;
1108 (ids, binds') <- zonkTopBinds (main_bind `andMonoBinds` inst_binds) ;
1110 let { tcg_env' = tcg_env {
1111 tcg_type_env = extendTypeEnvWithIds (tcg_type_env tcg_env) ids,
1112 tcg_binds = tcg_binds tcg_env `andMonoBinds` binds' } } ;
1114 return (tcg_env', unitFV main_name)
1117 mod_name = moduleName (tcg_mod tcg_env)
1118 rdr_env = tcg_rdr_env tcg_env
1120 complain_no_main | ghci_mode == Interactive = return ()
1121 | otherwise = failWithTc noMainMsg
1122 -- In interactive mode, don't worry about the absence of 'main'
1123 -- In other modes, fail altogether, so that we don't go on
1124 -- and complain a second time when processing the export list.
1126 mainCtxt = ptext SLIT("When checking the type of 'main'")
1127 noMainMsg = ptext SLIT("No 'main' defined in module Main")
1131 %************************************************************************
1135 %************************************************************************
1138 rnDump :: SDoc -> TcRn m ()
1139 -- Dump, with a banner, if -ddump-rn
1140 rnDump doc = dumpOptTcRn Opt_D_dump_rn (mkDumpDoc "Renamer" doc)
1142 tcDump :: TcGblEnv -> TcRn m ()
1144 = do { dflags <- getDOpts ;
1146 -- Dump short output if -ddump-types or -ddump-tc
1147 ifM (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
1148 (dumpTcRn short_dump) ;
1150 -- Dump bindings if -ddump-tc
1151 dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump)
1154 short_dump = pprTcGblEnv env
1155 full_dump = ppr (tcg_binds env)
1156 -- NB: foreign x-d's have undefined's in their types;
1157 -- hence can't show the tc_fords
1160 = do { dflags <- getDOpts ;
1161 ifM (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
1162 (dumpTcRn (pprModGuts mod_guts)) ;
1164 -- Dump bindings if -ddump-tc
1165 dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump) }
1167 full_dump = pprCoreBindings (mg_binds mod_guts)
1169 -- It's unpleasant having both pprModGuts and pprModDetails here
1170 pprTcGblEnv :: TcGblEnv -> SDoc
1171 pprTcGblEnv (TcGblEnv { tcg_type_env = type_env,
1172 tcg_insts = dfun_ids,
1174 tcg_imports = imports })
1175 = vcat [ ppr_types dfun_ids type_env
1176 , ppr_insts dfun_ids
1177 , vcat (map ppr rules)
1178 , ppr_gen_tycons (typeEnvTyCons type_env)
1179 , ppr (moduleEnvElts (imp_dep_mods imports))
1180 , ppr (imp_dep_pkgs imports)]
1182 pprModGuts :: ModGuts -> SDoc
1183 pprModGuts (ModGuts { mg_types = type_env,
1185 = vcat [ ppr_types [] type_env,
1189 ppr_types :: [Var] -> TypeEnv -> SDoc
1190 ppr_types dfun_ids type_env
1191 = text "TYPE SIGNATURES" $$ nest 4 (ppr_sigs ids)
1193 ids = [id | id <- typeEnvIds type_env, want_sig id]
1194 want_sig id | opt_PprStyle_Debug = True
1195 | otherwise = isLocalId id &&
1196 isExternalName (idName id) &&
1197 not (id `elem` dfun_ids)
1198 -- isLocalId ignores data constructors, records selectors etc.
1199 -- The isExternalName ignores local dictionary and method bindings
1200 -- that the type checker has invented. Top-level user-defined things
1201 -- have External names.
1203 ppr_insts :: [Var] -> SDoc
1204 ppr_insts [] = empty
1205 ppr_insts dfun_ids = text "INSTANCES" $$ nest 4 (ppr_sigs dfun_ids)
1207 ppr_sigs :: [Var] -> SDoc
1209 -- Print type signatures
1210 -- Convert to HsType so that we get source-language style printing
1211 -- And sort by RdrName
1212 = vcat $ map ppr_sig $ sortLt lt_sig $
1213 [ (getRdrName id, toHsType (idType id))
1216 lt_sig (n1,_) (n2,_) = n1 < n2
1217 ppr_sig (n,t) = ppr n <+> dcolon <+> ppr t
1220 ppr_rules :: [IdCoreRule] -> SDoc
1221 ppr_rules [] = empty
1222 ppr_rules rs = vcat [ptext SLIT("{-# RULES"),
1223 nest 4 (pprIdRules rs),
1226 ppr_gen_tycons [] = empty
1227 ppr_gen_tycons tcs = vcat [ptext SLIT("{-# Generic type constructor details"),
1228 vcat (map ppr_gen_tycon tcs),
1232 -- x&y are now Id's, not CoreExpr's
1234 | Just ep <- tyConGenInfo tycon
1235 = (ppr tycon <> colon) $$ nest 4 (ppr_ep ep)
1237 | otherwise = ppr tycon <> colon <+> ptext SLIT("Not derivable")
1240 = vcat [ ptext SLIT("Rep type:") <+> ppr (tcFunResultTy from_tau),
1241 ptext SLIT("From:") <+> ppr (unfoldingTemplate (idUnfolding from)),
1242 ptext SLIT("To:") <+> ppr (unfoldingTemplate (idUnfolding to))
1245 (_,from_tau) = tcSplitForAllTys (idType from)