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 ( tcExtendGlobalValEnv,
62 tcExtendInstEnv, tcExtendRules,
63 tcLookupTyCon, tcLookupGlobal,
66 import TcRules ( tcRules )
67 import TcForeign ( tcForeignImports, tcForeignExports )
68 import TcIfaceSig ( tcInterfaceSigs, tcCoreBinds )
69 import TcInstDcls ( tcInstDecls1, tcIfaceInstDecls, tcInstDecls2 )
70 import TcSimplify ( tcSimplifyTop, tcSimplifyInfer )
71 import TcTyClsDecls ( tcTyAndClassDecls )
73 import RnNames ( importsFromLocalDecls, rnImports, exportsFromAvail,
74 reportUnusedNames, main_RDR_Unqual )
75 import RnIfaces ( slurpImpDecls, checkVersions, RecompileRequired, outOfDate )
76 import RnHiFiles ( readIface, loadOldIface )
77 import RnEnv ( lookupSrcName, lookupOccRn, plusGlobalRdrEnv,
78 ubiquitousNames, implicitModuleFVs, implicitStmtFVs, dataTcOccs )
79 import RnExpr ( rnStmts, rnExpr )
80 import RnSource ( rnSrcDecls, checkModDeprec, rnStats )
82 import CoreUnfold ( unfoldingTemplate )
83 import CoreSyn ( IdCoreRule, Bind(..) )
84 import PprCore ( pprIdRules, pprCoreBindings )
85 import TysWiredIn ( mkListTy, unitTy )
86 import ErrUtils ( mkDumpDoc, showPass )
87 import Id ( Id, mkLocalId, isLocalId, idName, idType, idUnfolding, setIdLocalExported )
88 import IdInfo ( GlobalIdDetails(..) )
89 import Var ( Var, setGlobalIdDetails )
90 import Module ( Module, moduleName, moduleUserString, moduleEnvElts )
91 import Name ( Name, isExternalName, getSrcLoc, nameOccName )
92 import NameEnv ( delListFromNameEnv )
94 import TyCon ( tyConGenInfo )
95 import BasicTypes ( EP(..), RecFlag(..) )
96 import SrcLoc ( noSrcLoc )
98 import HscTypes ( PersistentCompilerState(..), InteractiveContext(..),
99 ModIface, ModDetails(..), ModGuts(..),
101 ModIface(..), ModDetails(..), IfaceDecls(..),
102 GhciMode(..), noDependencies,
103 Deprecations(..), plusDeprecs,
105 GenAvailInfo(Avail), availsToNameSet,
107 TypeEnv, TyThing, typeEnvTyCons,
108 extendTypeEnvWithIds, typeEnvIds, typeEnvTyCons,
109 extendLocalRdrEnv, emptyFixityEnv
112 import RdrName ( rdrEnvElts )
113 import RnHiFiles ( loadInterface )
114 import RnEnv ( mkGlobalRdrEnv )
115 import HscTypes ( GlobalRdrElt(..), GlobalRdrEnv, ImportReason(..), Provenance(..),
119 import Maybe ( catMaybes )
120 import Panic ( showException )
121 import List ( partition )
122 import Util ( sortLt )
127 %************************************************************************
129 Typecheck and rename a module
131 %************************************************************************
135 tcRnModule :: HscEnv -> PersistentCompilerState
137 -> IO (PersistentCompilerState, Maybe TcGblEnv)
139 tcRnModule hsc_env pcs
140 (HsModule this_mod _ exports import_decls local_decls mod_deprec loc)
141 = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
143 initTc hsc_env pcs this_mod $ addSrcLoc loc $
144 do { -- Deal with imports; sets tcg_rdr_env, tcg_imports
145 (rdr_env, imports) <- rnImports import_decls ;
146 updGblEnv ( \ gbl -> gbl { tcg_rdr_env = rdr_env,
147 tcg_imports = tcg_imports gbl `plusImportAvails` imports })
149 traceRn (text "rn1" <+> ppr (imp_dep_mods imports)) ;
150 -- Fail if there are any errors so far
151 -- The error printing (if needed) takes advantage
152 -- of the tcg_env we have now set
155 traceRn (text "rn1a") ;
156 -- Rename and type check the declarations
157 (tcg_env, src_fvs) <- tcRnSrcDecls local_decls ;
158 setGblEnv tcg_env $ do {
160 traceRn (text "rn3") ;
161 -- Check whether the entire module is deprecated
162 -- This happens only once per module
163 -- Returns the full new deprecations; a module deprecation
164 -- over-rides the earlier ones
165 let { mod_deprecs = checkModDeprec mod_deprec } ;
166 updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` mod_deprecs })
169 -- Process the export list
170 export_avails <- exportsFromAvail exports ;
171 updGblEnv (\gbl -> gbl { tcg_exports = export_avails })
174 -- Get any supporting decls for the exports that have not already
175 -- been sucked in for the declarations in the body of the module.
176 -- (This can happen if something is imported only to be re-exported.)
178 -- Importing these supporting declarations is required
179 -- *only* to gether usage information
180 -- (see comments with MkIface.mkImportInfo for why)
181 -- For OneShot compilation we could just throw away the decls
182 -- but for Batch or Interactive we must put them in the type
183 -- envt because they've been removed from the holding pen
184 let { export_fvs = availsToNameSet export_avails } ;
185 tcg_env <- importSupportingDecls export_fvs ;
186 setGblEnv tcg_env $ do {
188 -- Report unused names
189 let { used_fvs = src_fvs `plusFV` export_fvs } ;
190 reportUnusedNames tcg_env used_fvs ;
192 -- Dump output and return
199 %*********************************************************
201 \subsection{Closing up the interface decls}
203 %*********************************************************
205 Suppose we discover we don't need to recompile. Then we start from the
206 IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
210 -> PersistentCompilerState
211 -> ModIface -- Get the decls from here
212 -> IO (PersistentCompilerState, Maybe ModDetails)
213 -- Nothing <=> errors happened
214 tcRnIface hsc_env pcs
215 (ModIface {mi_module = mod, mi_decls = iface_decls})
216 = initTc hsc_env pcs mod $ do {
218 -- Get the supporting decls, and typecheck them all together
219 -- so that any mutually recursive types are done right
220 extra_decls <- slurpImpDecls needed ;
221 env <- typecheckIfaceDecls (group `addImpDecls` extra_decls) ;
223 returnM (ModDetails { md_types = tcg_type_env env,
224 md_insts = tcg_insts env,
225 md_rules = hsCoreRules (tcg_rules env)
226 -- All the rules from an interface are of the IfaceRuleOut form
229 rule_decls = dcl_rules iface_decls
230 inst_decls = dcl_insts iface_decls
231 tycl_decls = dcl_tycl iface_decls
232 group = emptyGroup { hs_ruleds = rule_decls,
233 hs_instds = inst_decls,
234 hs_tyclds = tycl_decls }
235 needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
236 unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
237 unionManyNameSets (map tyClDeclFVs tycl_decls) `unionNameSets`
239 -- Data type decls with record selectors,
240 -- which may appear in the decls, need unpackCString
241 -- and friends. It's easier to just grab them right now.
243 hsCoreRules :: [TypecheckedRuleDecl] -> [IdCoreRule]
244 -- All post-typechecking Iface rules have the form IfaceRuleOut
245 hsCoreRules rules = [(id,rule) | IfaceRuleOut id rule <- rules]
249 %************************************************************************
251 The interactive interface
253 %************************************************************************
256 tcRnStmt :: HscEnv -> PersistentCompilerState
257 -> InteractiveContext
259 -> IO (PersistentCompilerState,
260 Maybe (InteractiveContext, [Name], TypecheckedHsExpr))
261 -- The returned [Name] is the same as the input except for
262 -- ExprStmt, in which case the returned [Name] is [itName]
264 -- The returned TypecheckedHsExpr is of type IO [ () ],
265 -- a list of the bound values, coerced to ().
267 tcRnStmt hsc_env pcs ictxt rdr_stmt
268 = initTc hsc_env pcs iNTERACTIVE $
269 setInteractiveContext ictxt $ do {
271 -- Rename; use CmdLineMode because tcRnStmt is only used interactively
272 ([rn_stmt], fvs) <- initRnInteractive ictxt
273 (rnStmts DoExpr [rdr_stmt]) ;
274 traceRn (text "tcRnStmt" <+> vcat [ppr rdr_stmt, ppr rn_stmt, ppr fvs]) ;
277 -- Suck in the supporting declarations and typecheck them
278 tcg_env <- importSupportingDecls (fvs `plusFV` implicitStmtFVs fvs) ;
279 -- NB: an earlier version deleted (rdrEnvElts local_env) from
280 -- the fvs. But (a) that isn't necessary, because previously
281 -- bound things in the local_env will be in the TypeEnv, and
282 -- the renamer doesn't re-slurp such things, and
283 -- (b) it's WRONG to delete them. Consider in GHCi:
284 -- Mod> let x = e :: T
285 -- Mod> let y = x + 3
286 -- We need to pass 'x' among the fvs to slurpImpDecls, so that
287 -- the latter can see that T is a gate, and hence import the Num T
288 -- instance decl. (See the InTypEnv case in RnIfaces.slurpSourceRefs.)
289 setGblEnv tcg_env $ do {
291 -- The real work is done here
292 ((bound_ids, tc_expr), lie) <- getLIE (tcUserStmt rn_stmt) ;
294 traceTc (text "tcs 1") ;
295 let { -- Make all the bound ids "global" ids, now that
296 -- they're notionally top-level bindings. This is
297 -- important: otherwise when we come to compile an expression
298 -- using these ids later, the byte code generator will consider
299 -- the occurrences to be free rather than global.
300 global_ids = map globaliseId bound_ids ;
301 globaliseId id = setGlobalIdDetails id VanillaGlobal ;
303 -- Update the interactive context
304 rn_env = ic_rn_local_env ictxt ;
305 type_env = ic_type_env ictxt ;
307 bound_names = map idName global_ids ;
308 new_rn_env = extendLocalRdrEnv rn_env bound_names ;
310 -- Remove any shadowed bindings from the type_env;
311 -- they are inaccessible but might, I suppose, cause
312 -- a space leak if we leave them there
313 shadowed = [ n | name <- bound_names,
314 let rdr_name = mkRdrUnqual (nameOccName name),
315 Just n <- [lookupRdrEnv rn_env rdr_name] ] ;
317 filtered_type_env = delListFromNameEnv type_env shadowed ;
318 new_type_env = extendTypeEnvWithIds filtered_type_env global_ids ;
320 new_ic = ictxt { ic_rn_local_env = new_rn_env,
321 ic_type_env = new_type_env }
324 dumpOptTcRn Opt_D_dump_tc
325 (vcat [text "Bound Ids" <+> pprWithCommas ppr global_ids,
326 text "Typechecked expr" <+> ppr tc_expr]) ;
328 returnM (new_ic, bound_names, tc_expr)
333 Here is the grand plan, implemented in tcUserStmt
335 What you type The IO [HValue] that hscStmt returns
336 ------------- ------------------------------------
337 let pat = expr ==> let pat = expr in return [coerce HVal x, coerce HVal y, ...]
340 pat <- expr ==> expr >>= \ pat -> return [coerce HVal x, coerce HVal y, ...]
343 expr (of IO type) ==> expr >>= \ v -> return [coerce HVal v]
344 [NB: result not printed] bindings: [it]
346 expr (of non-IO type, ==> let v = expr in print v >> return [coerce HVal v]
347 result showable) bindings: [it]
349 expr (of non-IO type,
350 result not showable) ==> error
354 ---------------------------
355 tcUserStmt :: RenamedStmt -> TcM ([Id], TypecheckedHsExpr)
356 tcUserStmt (ExprStmt expr _ loc)
357 = newUnique `thenM` \ uniq ->
359 fresh_it = itName uniq
360 the_bind = FunMonoBind fresh_it False
361 [ mkSimpleMatch [] expr placeHolderType loc ] loc
363 tryTcLIE_ (do { -- Try this if the other fails
364 traceTc (text "tcs 1b") ;
366 LetStmt (MonoBind the_bind [] NonRecursive),
367 ExprStmt (HsApp (HsVar printName) (HsVar fresh_it))
368 placeHolderType loc] })
369 (do { -- Try this first
370 traceTc (text "tcs 1a") ;
371 tc_stmts [BindStmt (VarPat fresh_it) expr loc] })
373 tcUserStmt stmt = tc_stmts [stmt]
375 ---------------------------
377 = do { io_ids <- mappM tcLookupId
378 [returnIOName, failIOName, bindIOName, thenIOName] ;
379 ioTyCon <- tcLookupTyCon ioTyConName ;
380 res_ty <- newTyVarTy liftedTypeKind ;
382 names = collectStmtsBinders stmts ;
383 return_id = head io_ids ; -- Rather gruesome
385 io_ty = (\ ty -> mkTyConApp ioTyCon [ty], res_ty) ;
387 -- mk_return builds the expression
388 -- returnIO @ [()] [coerce () x, .., coerce () z]
389 mk_return ids = HsApp (TyApp (HsVar return_id) [mkListTy unitTy])
390 (ExplicitList unitTy (map mk_item ids)) ;
392 mk_item id = HsApp (TyApp (HsVar unsafeCoerceId) [idType id, unitTy])
395 -- OK, we're ready to typecheck the stmts
396 traceTc (text "tcs 2") ;
397 ((ids, tc_stmts), lie) <-
398 getLIE $ tcStmtsAndThen combine DoExpr io_ty stmts $
400 -- Look up the names right in the middle,
401 -- where they will all be in scope
402 ids <- mappM tcLookupId names ;
403 return (ids, [ResultStmt (mk_return ids) noSrcLoc])
406 -- Simplify the context right here, so that we fail
407 -- if there aren't enough instances. Notably, when we see
409 -- we use recoverTc_ to try it <- e
410 -- and then let it = e
411 -- It's the simplify step that rejects the first.
412 traceTc (text "tcs 3") ;
413 const_binds <- tcSimplifyTop lie ;
415 -- Build result expression and zonk it
416 let { expr = mkHsLet const_binds $
417 HsDo DoExpr tc_stmts io_ids
418 (mkTyConApp ioTyCon [mkListTy unitTy]) noSrcLoc } ;
419 zonked_expr <- zonkTopExpr expr ;
420 zonked_ids <- zonkTopBndrs ids ;
422 return (zonked_ids, zonked_expr)
425 combine stmt (ids, stmts) = (ids, stmt:stmts)
429 tcRnExpr just finds the type of an expression
432 tcRnExpr :: HscEnv -> PersistentCompilerState
433 -> InteractiveContext
435 -> IO (PersistentCompilerState, Maybe Type)
436 tcRnExpr hsc_env pcs ictxt rdr_expr
437 = initTc hsc_env pcs iNTERACTIVE $
438 setInteractiveContext ictxt $ do {
440 (rn_expr, fvs) <- initRnInteractive ictxt (rnExpr rdr_expr) ;
443 -- Suck in the supporting declarations and typecheck them
444 tcg_env <- importSupportingDecls (fvs `plusFV` ubiquitousNames) ;
445 setGblEnv tcg_env $ do {
447 -- Now typecheck the expression;
448 -- it might have a rank-2 type (e.g. :t runST)
449 -- Hence the hole type (c.f. TcExpr.tcExpr_id)
450 ((tc_expr, res_ty), lie) <- getLIE (tcExpr_id rn_expr) ;
451 ((qtvs, _, dict_ids), lie_top) <- getLIE (tcSimplifyInfer smpl_doc (tyVarsOfType res_ty) lie) ;
452 tcSimplifyTop lie_top ;
454 let { all_expr_ty = mkForAllTys qtvs $
455 mkFunTys (map idType dict_ids) $
457 zonkTcType all_expr_ty
460 smpl_doc = ptext SLIT("main expression")
465 tcRnThing :: HscEnv -> PersistentCompilerState
466 -> InteractiveContext
468 -> IO (PersistentCompilerState, Maybe [TyThing])
469 -- Look up a RdrName and return all the TyThings it might be
470 -- We treat a capitalised RdrName as both a data constructor
471 -- and as a type or class constructor; hence we return up to two results
472 tcRnThing hsc_env pcs ictxt rdr_name
473 = initTc hsc_env pcs iNTERACTIVE $
474 setInteractiveContext ictxt $ do {
476 -- If the identifier is a constructor (begins with an
477 -- upper-case letter), then we need to consider both
478 -- constructor and type class identifiers.
479 let { rdr_names = dataTcOccs rdr_name } ;
481 -- results :: [(Messages, Maybe Name)]
482 results <- initRnInteractive ictxt
483 (mapM (tryTc . lookupOccRn) rdr_names) ;
485 -- The successful lookups will be (Just name)
486 let { (warns_s, good_names) = unzip [ (msgs, name)
487 | (msgs, Just name) <- results] ;
488 errs_s = [msgs | (msgs, Nothing) <- results] } ;
490 -- Fail if nothing good happened, else add warnings
491 if null good_names then -- Fail
492 do { addMessages (head errs_s) ; failM }
493 else -- Add deprecation warnings
494 mapM_ addMessages warns_s ;
496 -- Slurp in the supporting declarations
497 tcg_env <- importSupportingDecls (mkFVs good_names) ;
498 setGblEnv tcg_env $ do {
500 -- And lookup up the entities
501 mapM tcLookupGlobal good_names
507 setInteractiveContext :: InteractiveContext -> TcRn m a -> TcRn m a
508 setInteractiveContext icxt thing_inside
509 = traceTc (text "setIC" <+> ppr (ic_type_env icxt)) `thenM_`
510 updGblEnv (\ env -> env { tcg_rdr_env = ic_rn_gbl_env icxt,
511 tcg_type_env = ic_type_env icxt })
514 initRnInteractive :: InteractiveContext -> RnM a -> TcM a
515 -- Set the local RdrEnv from the interactive context
516 initRnInteractive ictxt rn_thing
517 = initRn CmdLineMode $
518 setLocalRdrEnv (ic_rn_local_env ictxt) $
522 %************************************************************************
524 Type-checking external-core modules
526 %************************************************************************
529 tcRnExtCore :: HscEnv -> PersistentCompilerState
531 -> IO (PersistentCompilerState, Maybe ModGuts)
532 -- Nothing => some error occurred
534 tcRnExtCore hsc_env pcs
535 (HsModule this_mod _ _ _ local_decls _ loc)
536 -- Rename the (Core) module. It's a bit like an interface
537 -- file: all names are original names
538 = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
540 initTc hsc_env pcs this_mod $ addSrcLoc loc $ do {
542 -- Rename the source, only in interface mode.
543 -- rnSrcDecls handles fixity decls etc too, which won't occur
544 -- but that doesn't matter
545 let { local_group = mkGroup local_decls } ;
546 (_, rn_local_decls, fvs) <- initRn (InterfaceMode this_mod)
547 (rnSrcDecls local_group) ;
550 -- Get the supporting decls
551 rn_imp_decls <- slurpImpDecls fvs ;
552 let { rn_decls = rn_local_decls `addImpDecls` rn_imp_decls } ;
554 -- Dump trace of renaming part
555 rnDump (ppr rn_decls) ;
556 rnStats rn_imp_decls ;
558 -- Typecheck them all together so that
559 -- any mutually recursive types are done right
560 tcg_env <- typecheckIfaceDecls rn_decls ;
561 setGblEnv tcg_env $ do {
563 -- Now the core bindings
564 core_prs <- tcCoreBinds (hs_coreds rn_local_decls) ;
565 tcExtendGlobalValEnv (map fst core_prs) $ do {
569 bndrs = map fst core_prs ;
570 my_exports = map (Avail . idName) bndrs ;
571 -- ToDo: export the data types also?
573 final_type_env = extendTypeEnvWithIds (tcg_type_env tcg_env) bndrs ;
575 mod_guts = ModGuts { mg_module = this_mod,
576 mg_usages = [], -- ToDo: compute usage
577 mg_dir_imps = [], -- ??
578 mg_deps = noDependencies, -- ??
579 mg_exports = my_exports,
580 mg_types = final_type_env,
581 mg_insts = tcg_insts tcg_env,
582 mg_rules = hsCoreRules (tcg_rules tcg_env),
583 mg_binds = [Rec core_prs],
586 mg_rdr_env = emptyGlobalRdrEnv,
587 mg_fix_env = emptyFixityEnv,
588 mg_deprecs = NoDeprecs,
592 tcCoreDump mod_guts ;
599 %************************************************************************
601 Type-checking the top level of a module
603 %************************************************************************
606 tcRnSrcDecls :: [RdrNameHsDecl] -> TcM (TcGblEnv, FreeVars)
607 -- Returns the variables free in the decls
608 -- Reason: solely to report unused imports and bindings
611 = do { -- Do all the declarations
612 ((tc_envs, fvs), lie) <- getLIE (tc_rn_src_decls decls) ;
614 -- tcSimplifyTop deals with constant or ambiguous InstIds.
615 -- How could there be ambiguous ones? They can only arise if a
616 -- top-level decl falls under the monomorphism
617 -- restriction, and no subsequent decl instantiates its
618 -- type. (Usually, ambiguous type variables are resolved
619 -- during the generalisation step.)
620 traceTc (text "Tc8") ;
621 setEnvs tc_envs $ do {
622 -- Setting the global env exposes the instances to tcSimplifyTop
623 -- Setting the local env exposes the local Ids, so that
624 -- we get better error messages (monomorphism restriction)
625 inst_binds <- tcSimplifyTop lie ;
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 } ;
634 (bind_ids, binds', fords', rules') <- zonkTopDecls (binds `andMonoBinds` inst_binds)
637 return (tcg_env { tcg_type_env = extendTypeEnvWithIds type_env bind_ids,
638 tcg_binds = binds', tcg_rules = rules', tcg_fords = fords' },
642 tc_rn_src_decls :: [RdrNameHsDecl] -> TcM ((TcGblEnv, TcLclEnv), FreeVars)
645 = do { let { (first_group, group_tail) = findSplice ds } ;
646 -- If ds is [] we get ([], Nothing)
648 -- Type check the decls up to, but not including, the first splice
649 (tc_envs@(_,tcl_env), src_fvs1) <- tcRnGroup first_group ;
651 -- Bale out if errors; for example, error recovery when checking
652 -- the RHS of 'main' can mean that 'main' is not in the envt for
653 -- the subsequent checkMain test
658 -- If there is no splice, we're nearlydone
660 Nothing -> do { -- Last thing: check for `main'
661 (tcg_env, main_fvs) <- checkMain ;
662 return ((tcg_env, tcl_env), src_fvs1 `plusFV` main_fvs)
665 -- If there's a splice, we must carry on
666 Just (SpliceDecl splice_expr splice_loc, rest_ds) -> do {
668 failWithTc (text "Can't do a top-level splice; need a bootstrapped compiler")
671 -- Rename the splice expression, and get its supporting decls
672 (rn_splice_expr, fvs) <- initRn SourceMode $
673 addSrcLoc splice_loc $
675 tcg_env <- importSupportingDecls (fvs `plusFV` templateHaskellNames) ;
676 setGblEnv tcg_env $ do {
678 -- Execute the splice
679 spliced_decls <- tcSpliceDecls rn_splice_expr ;
681 -- Glue them on the front of the remaining decls and loop
682 (tc_envs, src_fvs2) <- tc_rn_src_decls (spliced_decls ++ rest_ds) ;
684 return (tc_envs, src_fvs1 `plusFV` src_fvs2)
691 %************************************************************************
693 Type-checking the top level of a module
695 %************************************************************************
697 tcRnGroup takes a bunch of top-level source-code declarations, and
699 * gets supporting declarations from interface files
702 * and augments the TcGblEnv with the results
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.
709 tcRnGroup :: HsGroup RdrName -> TcM ((TcGblEnv, TcLclEnv), FreeVars)
710 -- Returns the variables free in the decls, for unused-binding reporting
712 = do { showLIE (text "start of tcRnGroup" ++ ppr decls) ;
714 -- Rename the declarations
715 (tcg_env, rn_decls, src_fvs) <- rnTopSrcDecls decls ;
716 setGblEnv tcg_env $ do {
718 -- Typecheck the declarations
719 tc_envs <- tcTopSrcDecls rn_decls ;
721 showLIE (text "end of tcRnGroup" ++ ppr decls)
722 return (tc_envs, src_fvs)
725 ------------------------------------------------
726 rnTopSrcDecls :: HsGroup RdrName -> TcM (TcGblEnv, HsGroup Name, FreeVars)
728 = do { -- Bring top level binders into scope
729 (rdr_env, imports) <- importsFromLocalDecls group ;
730 updGblEnv (\gbl -> gbl { tcg_rdr_env = rdr_env `plusGlobalRdrEnv`
732 tcg_imports = imports `plusImportAvails`
736 failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
738 -- Rename the source decls
739 (tcg_env, rn_src_decls, src_fvs) <- initRn SourceMode (rnSrcDecls group) ;
740 setGblEnv tcg_env $ do {
744 -- Import consquential imports
745 rn_imp_decls <- slurpImpDecls (src_fvs `plusFV` implicitModuleFVs src_fvs) ;
746 let { rn_decls = rn_src_decls `addImpDecls` rn_imp_decls } ;
748 -- Dump trace of renaming part
749 rnDump (ppr rn_decls) ;
750 rnStats rn_imp_decls ;
752 return (tcg_env, rn_decls, src_fvs)
755 ------------------------------------------------
756 tcTopSrcDecls :: HsGroup Name -> TcM (TcGblEnv, TcLclEnv)
758 (HsGroup { hs_tyclds = tycl_decls,
759 hs_instds = inst_decls,
760 hs_fords = foreign_decls,
761 hs_defds = default_decls,
762 hs_ruleds = rule_decls,
763 hs_valds = val_binds })
764 = do { -- Type-check the type and class decls, and all imported decls
765 -- The latter come in via tycl_decls
766 traceTc (text "Tc2") ;
767 tcg_env <- tcTyClDecls tycl_decls ;
768 setGblEnv tcg_env $ do {
770 -- Source-language instances, including derivings,
771 -- and import the supporting declarations
772 traceTc (text "Tc3") ;
773 (tcg_env, inst_infos, deriv_binds, fvs) <- tcInstDecls1 tycl_decls inst_decls ;
774 setGblEnv tcg_env $ do {
775 tcg_env <- importSupportingDecls fvs ;
776 setGblEnv tcg_env $ do {
778 -- Foreign import declarations next. No zonking necessary
779 -- here; we can tuck them straight into the global environment.
780 traceTc (text "Tc4") ;
781 (fi_ids, fi_decls) <- tcForeignImports foreign_decls ;
782 tcExtendGlobalValEnv fi_ids $
783 updGblEnv (\gbl -> gbl { tcg_fords = tcg_fords gbl ++ fi_decls })
786 -- Default declarations
787 traceTc (text "Tc4a") ;
788 default_tys <- tcDefaults default_decls ;
789 updGblEnv (\gbl -> gbl { tcg_default = default_tys }) $ do {
791 -- Value declarations next
792 -- We also typecheck any extra binds that came out
793 -- of the "deriving" process
794 traceTc (text "Tc5") ;
795 (tc_val_binds, lcl_env) <- tcTopBinds (val_binds `ThenBinds` deriv_binds) ;
796 setLclTypeEnv lcl_env $ do {
798 -- Second pass over class and instance declarations,
799 -- plus rules and foreign exports, to generate bindings
800 traceTc (text "Tc6") ;
801 (cls_dm_binds, dm_ids) <- tcClassDecls2 tycl_decls ;
802 tcExtendGlobalValEnv dm_ids $ do {
803 inst_binds <- tcInstDecls2 inst_infos ;
804 showLIE (text "after instDecls2") ;
807 -- They need to be zonked, so we return them
808 traceTc (text "Tc7") ;
809 (foe_binds, foe_decls) <- tcForeignExports foreign_decls ;
812 -- Need to partition them because the source rules
813 -- must be zonked before adding them to tcg_rules
814 -- NB: built-in rules come in as IfaceRuleOut's, and
815 -- get added to tcg_rules right here by tcExtendRules
816 rules <- tcRules rule_decls ;
817 let { (src_rules, iface_rules) = partition isSrcRule rules } ;
818 tcExtendRules iface_rules $ do {
821 tcg_env <- getGblEnv ;
822 let { all_binds = tc_val_binds `AndMonoBinds`
823 inst_binds `AndMonoBinds`
824 cls_dm_binds `AndMonoBinds`
827 -- Extend the GblEnv with the (as yet un-zonked)
828 -- bindings, rules, foreign decls
829 tcg_env' = tcg_env { tcg_binds = tcg_binds tcg_env `andMonoBinds` all_binds,
830 tcg_rules = tcg_rules tcg_env ++ src_rules,
831 tcg_fords = tcg_fords tcg_env ++ foe_decls } } ;
833 return (tcg_env', lcl_env)
838 tcTyClDecls :: [RenamedTyClDecl]
841 -- tcTyClDecls deals with
842 -- type and class decls (some source, some imported)
843 -- interface signatures (checked lazily)
845 -- It returns the TcGblEnv for this module, and side-effects the
846 -- persistent compiler state to reflect the things imported from
849 tcTyClDecls tycl_decls
851 -- tcTyAndClassDecls recovers internally, but if anything gave rise to
852 -- an error we'd better stop now, to avoid a cascade
854 traceTc (text "TyCl1") `thenM_`
855 tcTyAndClassDecls tycl_decls `thenM` \ tcg_env ->
856 -- Returns the extended environment
859 traceTc (text "TyCl2") `thenM_`
860 tcInterfaceSigs tycl_decls `thenM` \ tcg_env ->
861 -- Returns the extended environment
868 %************************************************************************
870 Load the old interface file for this module (unless
871 we have it aleady), and check whether it is up to date
874 %************************************************************************
877 checkOldIface :: HscEnv
878 -> PersistentCompilerState
880 -> FilePath -- Where the interface file is
881 -> Bool -- Source unchanged
882 -> Maybe ModIface -- Old interface from compilation manager, if any
883 -> IO (PersistentCompilerState, Maybe (RecompileRequired, Maybe ModIface))
884 -- Nothing <=> errors happened
886 checkOldIface hsc_env pcs mod iface_path source_unchanged maybe_iface
887 = do { showPass (hsc_dflags hsc_env)
888 ("Checking old interface for " ++ moduleUserString mod) ;
890 initTc hsc_env pcs mod
891 (check_old_iface iface_path source_unchanged maybe_iface)
894 check_old_iface iface_path source_unchanged maybe_iface
895 = -- CHECK WHETHER THE SOURCE HAS CHANGED
896 ifM (not source_unchanged)
897 (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
900 -- If the source has changed and we're in interactive mode, avoid reading
901 -- an interface; just return the one we might have been supplied with.
902 getGhciMode `thenM` \ ghci_mode ->
903 if (ghci_mode == Interactive) && not source_unchanged then
904 returnM (outOfDate, maybe_iface)
908 Just old_iface -> -- Use the one we already have
909 checkVersions source_unchanged old_iface `thenM` \ recomp ->
910 returnM (recomp, Just old_iface)
912 Nothing -- Try and read it from a file
913 -> getModule `thenM` \ this_mod ->
914 readIface this_mod iface_path False `thenM` \ read_result ->
916 Left err -> -- Old interface file not found, or garbled; give up
918 text "Cannot read old interface file:"
919 $$ nest 4 (text (showException err))) `thenM_`
920 returnM (outOfDate, Nothing)
922 Right parsed_iface ->
923 initRn (InterfaceMode this_mod)
924 (loadOldIface parsed_iface) `thenM` \ m_iface ->
925 checkVersions source_unchanged m_iface `thenM` \ recomp ->
926 returnM (recomp, Just m_iface)
930 %************************************************************************
932 Type-check and rename supporting declarations
933 This is used to deal with the free vars of a splice,
934 or derived code: slurp in the necessary declarations,
935 typecheck them, and add them to the EPS
937 %************************************************************************
940 importSupportingDecls :: FreeVars -> TcM TcGblEnv
941 -- Completely deal with the supporting imports needed
942 -- by the specified free-var set
943 importSupportingDecls fvs
944 = do { traceRn (text "Import supporting decls for" <+> ppr (nameSetToList fvs)) ;
945 decls <- slurpImpDecls fvs ;
946 traceRn (text "...namely:" <+> vcat (map ppr decls)) ;
947 typecheckIfaceDecls (mkGroup decls) }
949 typecheckIfaceDecls :: HsGroup Name -> TcM TcGblEnv
950 -- The decls are all interface-file declarations
951 -- Usually they are all from other modules, but when we are reading
952 -- this module's interface from a file, it's possible that some of
953 -- them are for the module being compiled.
954 -- That is why the tcExtendX functions need to do partitioning.
956 -- If all the decls are from other modules, the returned TcGblEnv
957 -- will have an empty tc_genv, but its tc_inst_env
958 -- cache may have been augmented.
959 typecheckIfaceDecls (HsGroup { hs_tyclds = tycl_decls,
960 hs_instds = inst_decls,
961 hs_ruleds = rule_decls })
962 = do { -- Typecheck the type, class, and interface-sig decls
963 tcg_env <- tcTyClDecls tycl_decls ;
964 setGblEnv tcg_env $ do {
966 -- Typecheck the instance decls, and rules
967 -- Note that imported dictionary functions are already
968 -- in scope from the preceding tcTyClDecls
969 tcIfaceInstDecls inst_decls `thenM` \ dfuns ->
970 tcExtendInstEnv dfuns $
971 tcRules rule_decls `thenM` \ rules ->
972 tcExtendRules rules $
974 getGblEnv -- Return the environment
980 %*********************************************************
982 mkGlobalContext: make up an interactive context
984 Used for initialising the lexical environment
985 of the interactive read-eval-print loop
987 %*********************************************************
992 :: HscEnv -> PersistentCompilerState
993 -> [Module] -- Expose these modules' top-level scope
994 -> [Module] -- Expose these modules' exports only
995 -> IO (PersistentCompilerState, Maybe GlobalRdrEnv)
997 mkGlobalContext hsc_env pcs toplevs exports
998 = initTc hsc_env pcs iNTERACTIVE $ do {
1000 toplev_envs <- mappM getTopLevScope toplevs ;
1001 export_envs <- mappM getModuleExports exports ;
1002 returnM (foldr plusGlobalRdrEnv emptyGlobalRdrEnv
1003 (toplev_envs ++ export_envs))
1006 getTopLevScope :: Module -> TcRn m GlobalRdrEnv
1008 = do { iface <- loadInterface contextDoc (moduleName mod) (ImportByUser False) ;
1009 case mi_globals iface of
1010 Nothing -> panic "getTopLevScope"
1011 Just env -> returnM env }
1013 getModuleExports :: Module -> TcRn m GlobalRdrEnv
1014 getModuleExports mod
1015 = do { iface <- loadInterface contextDoc (moduleName mod) (ImportByUser False) ;
1016 returnM (foldl add emptyGlobalRdrEnv (mi_exports iface)) }
1018 prov_fn n = NonLocalDef ImplicitImport
1019 add env (mod,avails)
1020 = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True prov_fn avails NoDeprecs)
1022 contextDoc = text "context for compiling statements"
1028 -> PersistentCompilerState -- IN: persistent compiler state
1029 -> Module -- module to inspect
1030 -> Bool -- grab just the exports, or the whole toplev
1031 -> IO (PersistentCompilerState, Maybe [TyThing])
1033 getModuleContents hsc_env pcs mod exports_only
1034 = initTc hsc_env pcs iNTERACTIVE $ do {
1036 -- Load the interface if necessary (a home module will certainly
1037 -- alraedy be loaded, but a package module might not be)
1038 iface <- loadInterface contextDoc (moduleName mod) (ImportByUser False) ;
1040 let { export_names = availsToNameSet export_avails ;
1041 export_avails = [ avail | (mn, avails) <- mi_exports iface,
1042 avail <- avails ] } ;
1044 all_names <- if exports_only then
1046 else case mi_globals iface of {
1048 return (get_locals rdr_env) ;
1050 Nothing -> do { addErr (noRdrEnvErr mod) ;
1051 return export_names } } ;
1052 -- Invariant; we only have (not exports_only)
1053 -- for a home module so it must already be in the HIT
1054 -- So the Nothing case is a bug
1056 env <- importSupportingDecls all_names ;
1057 setGblEnv env (mappM tcLookupGlobal (nameSetToList all_names))
1060 -- Grab all the things from the global env that are locally def'd
1061 get_locals rdr_env = mkNameSet [ gre_name gre
1062 | elts <- rdrEnvElts rdr_env,
1065 -- Make a set because a name is often in the envt in
1066 -- both qualified and unqualified forms
1068 noRdrEnvErr mod = ptext SLIT("No top-level environment available for module")
1069 <+> quotes (ppr mod)
1073 %************************************************************************
1077 %************************************************************************
1081 = do { ghci_mode <- getGhciMode ;
1082 tcg_env <- getGblEnv ;
1083 check_main ghci_mode tcg_env
1086 check_main ghci_mode tcg_env
1087 -- If we are in module Main, check that 'main' is defined.
1088 -- It may be imported from another module, in which case
1089 -- we have to drag in its.
1091 -- Also form the definition
1092 -- $main = runIO main
1093 -- so we need to slurp in runIO too.
1095 -- ToDo: We have to return the main_name separately, because it's a
1096 -- bona fide 'use', and should be recorded as such, but the others
1099 -- Blimey: a whole page of code to do this...
1101 | mod_name /= mAIN_Name
1102 = return (tcg_env, emptyFVs)
1104 -- Check that 'main' is in scope
1105 -- It might be imported from another module!
1107 -- We use a guard for this (rather than letting lookupSrcName fail)
1108 -- because it's not an error in ghci)
1109 | not (main_RDR_Unqual `elemRdrEnv` rdr_env)
1110 = do { complain_no_main; return (tcg_env, emptyFVs) }
1113 = do { main_name <- lookupSrcName main_RDR_Unqual ;
1115 tcg_env <- importSupportingDecls (unitFV runIOName) ;
1117 addSrcLoc (getSrcLoc main_name) $
1118 addErrCtxt mainCtxt $
1119 setGblEnv tcg_env $ do {
1121 -- $main :: IO () = runIO main
1122 let { rhs = HsApp (HsVar runIOName) (HsVar main_name) } ;
1123 (main_expr, ty) <- tcExpr_id rhs ;
1125 let { dollar_main_id = setIdLocalExported (mkLocalId dollarMainName ty) ;
1126 main_bind = VarMonoBind dollar_main_id main_expr ;
1127 tcg_env' = tcg_env { tcg_binds = tcg_binds tcg_env
1128 `andMonoBinds` main_bind } } ;
1130 return (tcg_env', unitFV main_name)
1133 mod_name = moduleName (tcg_mod tcg_env)
1134 rdr_env = tcg_rdr_env tcg_env
1136 complain_no_main | ghci_mode == Interactive = return ()
1137 | otherwise = failWithTc noMainMsg
1138 -- In interactive mode, don't worry about the absence of 'main'
1139 -- In other modes, fail altogether, so that we don't go on
1140 -- and complain a second time when processing the export list.
1142 mainCtxt = ptext SLIT("When checking the type of 'main'")
1143 noMainMsg = ptext SLIT("No 'main' defined in module Main")
1147 %************************************************************************
1151 %************************************************************************
1154 rnDump :: SDoc -> TcRn m ()
1155 -- Dump, with a banner, if -ddump-rn
1156 rnDump doc = dumpOptTcRn Opt_D_dump_rn (mkDumpDoc "Renamer" doc)
1158 tcDump :: TcGblEnv -> TcRn m ()
1160 = do { dflags <- getDOpts ;
1162 -- Dump short output if -ddump-types or -ddump-tc
1163 ifM (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
1164 (dumpTcRn short_dump) ;
1166 -- Dump bindings if -ddump-tc
1167 dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump)
1170 short_dump = pprTcGblEnv env
1171 full_dump = ppr (tcg_binds env)
1172 -- NB: foreign x-d's have undefined's in their types;
1173 -- hence can't show the tc_fords
1176 = do { dflags <- getDOpts ;
1177 ifM (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
1178 (dumpTcRn (pprModGuts mod_guts)) ;
1180 -- Dump bindings if -ddump-tc
1181 dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump) }
1183 full_dump = pprCoreBindings (mg_binds mod_guts)
1185 -- It's unpleasant having both pprModGuts and pprModDetails here
1186 pprTcGblEnv :: TcGblEnv -> SDoc
1187 pprTcGblEnv (TcGblEnv { tcg_type_env = type_env,
1188 tcg_insts = dfun_ids,
1190 tcg_imports = imports })
1191 = vcat [ ppr_types dfun_ids type_env
1192 , ppr_insts dfun_ids
1193 , vcat (map ppr rules)
1194 , ppr_gen_tycons (typeEnvTyCons type_env)
1195 , ppr (moduleEnvElts (imp_dep_mods imports))
1196 , ppr (imp_dep_pkgs imports)]
1198 pprModGuts :: ModGuts -> SDoc
1199 pprModGuts (ModGuts { mg_types = type_env,
1201 = vcat [ ppr_types [] type_env,
1205 ppr_types :: [Var] -> TypeEnv -> SDoc
1206 ppr_types dfun_ids type_env
1207 = text "TYPE SIGNATURES" $$ nest 4 (ppr_sigs ids)
1209 ids = [id | id <- typeEnvIds type_env, want_sig id]
1210 want_sig id | opt_PprStyle_Debug = True
1211 | otherwise = isLocalId id &&
1212 isExternalName (idName id) &&
1213 not (id `elem` dfun_ids)
1214 -- isLocalId ignores data constructors, records selectors etc.
1215 -- The isExternalName ignores local dictionary and method bindings
1216 -- that the type checker has invented. Top-level user-defined things
1217 -- have External names.
1219 ppr_insts :: [Var] -> SDoc
1220 ppr_insts [] = empty
1221 ppr_insts dfun_ids = text "INSTANCES" $$ nest 4 (ppr_sigs dfun_ids)
1223 ppr_sigs :: [Var] -> SDoc
1225 -- Print type signatures
1226 -- Convert to HsType so that we get source-language style printing
1227 -- And sort by RdrName
1228 = vcat $ map ppr_sig $ sortLt lt_sig $
1229 [ (getRdrName id, toHsType (idType id))
1232 lt_sig (n1,_) (n2,_) = n1 < n2
1233 ppr_sig (n,t) = ppr n <+> dcolon <+> ppr t
1236 ppr_rules :: [IdCoreRule] -> SDoc
1237 ppr_rules [] = empty
1238 ppr_rules rs = vcat [ptext SLIT("{-# RULES"),
1239 nest 4 (pprIdRules rs),
1242 ppr_gen_tycons [] = empty
1243 ppr_gen_tycons tcs = vcat [ptext SLIT("{-# Generic type constructor details"),
1244 vcat (map ppr_gen_tycon tcs),
1248 -- x&y are now Id's, not CoreExpr's
1250 | Just ep <- tyConGenInfo tycon
1251 = (ppr tycon <> colon) $$ nest 4 (ppr_ep ep)
1253 | otherwise = ppr tycon <> colon <+> ptext SLIT("Not derivable")
1256 = vcat [ ptext SLIT("Rep type:") <+> ppr (tcFunResultTy from_tau),
1257 ptext SLIT("From:") <+> ppr (unfoldingTemplate (idUnfolding from)),
1258 ptext SLIT("To:") <+> ppr (unfoldingTemplate (idUnfolding to))
1261 (_,from_tau) = tcSplitForAllTys (idType from)