2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[TcModule]{Typechecking a whole module}
9 mkExportEnv, getModuleContents, tcRnStmt,
10 tcRnGetInfo, GetInfoResult,
19 #include "HsVersions.h"
23 import {-# SOURCE #-} TcSplice ( tcSpliceDecls )
26 import DynFlags ( DynFlag(..), DynFlags(..), dopt, GhcMode(..) )
27 import StaticFlags ( opt_PprStyle_Debug )
28 import Packages ( moduleToPackageConfig, mkPackageId, package,
30 import HsSyn ( HsModule(..), HsExtCore(..), HsGroup(..), LHsDecl,
31 SpliceDecl(..), HsBind(..), LHsBinds,
32 emptyGroup, appendGroups,
33 nlHsApp, nlHsVar, pprLHsBinds )
34 import RdrHsSyn ( findSplice )
36 import PrelNames ( runMainIOName, rootMainName, mAIN,
38 import RdrName ( RdrName, mkRdrUnqual, emptyGlobalRdrEnv )
39 import TcHsSyn ( zonkTopDecls )
40 import TcExpr ( tcInferRho )
42 import TcType ( tidyTopType, tcEqType, mkTyVarTys, substTyWith )
43 import Inst ( showLIE )
44 import InstEnv ( extendInstEnvList, Instance, pprInstances, instanceDFunId )
45 import TcBinds ( tcTopBinds, tcHsBootSigs )
46 import TcDefaults ( tcDefaults )
47 import TcEnv ( tcExtendGlobalValEnv, iDFunId )
48 import TcRules ( tcRules )
49 import TcForeign ( tcForeignImports, tcForeignExports )
50 import TcInstDcls ( tcInstDecls1, tcInstDecls2 )
51 import TcIface ( tcExtCoreBindings, tcHiBootIface )
52 import TcSimplify ( tcSimplifyTop )
53 import TcTyClsDecls ( tcTyAndClassDecls )
54 import LoadIface ( loadOrphanModules )
55 import RnNames ( importsFromLocalDecls, rnImports, exportsFromAvail,
56 reportUnusedNames, reportDeprecations )
57 import RnEnv ( lookupSrcOcc_maybe )
58 import RnSource ( rnSrcDecls, rnTyClDecls, checkModDeprec )
59 import PprCore ( pprRules, pprCoreBindings )
60 import CoreSyn ( CoreRule, bindersOfBinds )
61 import DataCon ( dataConWrapId )
62 import ErrUtils ( Messages, mkDumpDoc, showPass )
63 import Id ( Id, mkExportedLocalId, isLocalId, idName, idType )
65 import Module ( Module, ModuleEnv, mkModule, moduleEnvElts, elemModuleEnv )
66 import OccName ( mkVarOcc )
67 import Name ( Name, NamedThing(..), isExternalName, getSrcLoc, isWiredInName )
69 import TyCon ( tyConHasGenerics, isSynTyCon, getSynTyConDefn, tyConKind )
70 import SrcLoc ( srcLocSpan, Located(..), noLoc )
71 import DriverPhases ( HscSource(..), isHsBoot )
72 import HscTypes ( ModGuts(..), ModDetails(..), emptyModDetails,
73 HscEnv(..), ExternalPackageState(..),
74 IsBootInterface, noDependencies,
75 Deprecs( NoDeprecs ), plusDeprecs,
76 ForeignStubs(NoStubs), TyThing(..),
77 TypeEnv, lookupTypeEnv, hptInstances,
78 extendTypeEnvWithIds, typeEnvIds, typeEnvTyCons, typeEnvElts,
84 import HsSyn ( HsStmtContext(..), Stmt(..), HsExpr(..), HsBindGroup(..),
85 LStmt, LHsExpr, LHsType, mkMatchGroup,
86 collectLStmtsBinders, mkSimpleMatch, nlVarPat,
87 placeHolderType, noSyntaxExpr )
88 import RdrName ( GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..),
89 Provenance(..), ImportSpec(..), globalRdrEnvElts,
90 unQualOK, lookupLocalRdrEnv, extendLocalRdrEnv )
91 import RnSource ( addTcgDUs )
92 import TcHsSyn ( mkHsLet, zonkTopLExpr, zonkTopBndrs )
93 import TcHsType ( kcHsType )
94 import TcMType ( zonkTcType, zonkQuantifiedTyVar )
95 import TcMatches ( tcStmts, tcDoStmt )
96 import TcSimplify ( tcSimplifyInteractive, tcSimplifyInfer )
97 import TcType ( Type, mkForAllTys, mkFunTys, mkTyConApp, tyVarsOfType,
98 isUnLiftedType, tyClsNamesOfDFunHead, tyClsNamesOfType )
99 import TcEnv ( tcLookupTyCon, tcLookupId, tcLookupGlobal )
100 import RnTypes ( rnLHsType )
101 import Inst ( tcGetInstEnvs )
102 import InstEnv ( classInstances, instEnvElts )
103 import RnExpr ( rnStmts, rnLExpr )
104 import LoadIface ( loadSrcInterface, loadSysInterface )
105 import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..),
106 IfaceExtName(..), IfaceConDecls(..),
108 import IfaceType ( IfaceType, toIfaceType,
109 interactiveExtNameFun )
110 import IfaceEnv ( lookupOrig, ifaceExportNames )
111 import Module ( lookupModuleEnv, moduleSetElts, mkModuleSet )
112 import RnEnv ( lookupOccRn, dataTcOccs, lookupFixityRn )
113 import Id ( isImplicitId, setIdType, globalIdDetails )
114 import MkId ( unsafeCoerceId )
115 import DataCon ( dataConTyCon )
116 import TyCon ( tyConName )
117 import TysWiredIn ( mkListTy, unitTy )
118 import IdInfo ( GlobalIdDetails(..) )
119 import SrcLoc ( interactiveSrcLoc, unLoc )
121 import Var ( globaliseId )
122 import Name ( nameOccName, nameModule )
123 import OccName ( occNameUserString, isTcOcc )
124 import NameEnv ( delListFromNameEnv )
125 import PrelNames ( iNTERACTIVE, ioTyConName, printName, itName,
126 bindIOName, thenIOName, returnIOName )
127 import HscTypes ( InteractiveContext(..), HomeModInfo(..),
128 availNames, availName, ModIface(..), icPrintUnqual,
130 import BasicTypes ( RecFlag(..), Fixity )
131 import ListSetOps ( removeDups )
132 import Panic ( ghcError, GhcException(..) )
133 import SrcLoc ( SrcLoc )
136 import FastString ( mkFastString )
137 import Util ( sortLe )
138 import Bag ( unionBags, snocBag, emptyBag, unitBag, unionManyBags )
140 import Maybe ( isJust )
145 %************************************************************************
147 Typecheck and rename a module
149 %************************************************************************
155 -> Bool -- True <=> save renamed syntax
156 -> Located (HsModule RdrName)
157 -> IO (Messages, Maybe TcGblEnv)
159 tcRnModule hsc_env hsc_src save_rn_decls
160 (L loc (HsModule maybe_mod export_ies
161 import_decls local_decls mod_deprec))
162 = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
164 let { this_mod = case maybe_mod of
165 Nothing -> mAIN -- 'module M where' is omitted
166 Just (L _ mod) -> mod } ; -- The normal case
168 initTc hsc_env hsc_src this_mod $
171 checkForPackageModule (hsc_dflags hsc_env) this_mod;
173 -- Deal with imports; sets tcg_rdr_env, tcg_imports
174 (rdr_env, imports) <- rnImports import_decls ;
176 let { dep_mods :: ModuleEnv (Module, IsBootInterface)
177 ; dep_mods = imp_dep_mods imports
179 -- We want instance declarations from all home-package
180 -- modules below this one, including boot modules, except
181 -- ourselves. The 'except ourselves' is so that we don't
182 -- get the instances from this module's hs-boot file
183 ; want_instances :: Module -> Bool
184 ; want_instances mod = mod `elemModuleEnv` dep_mods
186 ; home_insts = hptInstances hsc_env want_instances
189 -- Record boot-file info in the EPS, so that it's
190 -- visible to loadHiBootInterface in tcRnSrcDecls,
191 -- and any other incrementally-performed imports
192 updateEps_ (\eps -> eps { eps_is_boot = dep_mods }) ;
194 -- Update the gbl env
196 gbl { tcg_rdr_env = rdr_env,
197 tcg_inst_env = extendInstEnvList (tcg_inst_env gbl) home_insts,
198 tcg_imports = tcg_imports gbl `plusImportAvails` imports,
199 tcg_rn_decls = if save_rn_decls then
205 traceRn (text "rn1" <+> ppr (imp_dep_mods imports)) ;
206 -- Fail if there are any errors so far
207 -- The error printing (if needed) takes advantage
208 -- of the tcg_env we have now set
211 -- Load any orphan-module interfaces, so that
212 -- their rules and instance decls will be found
213 loadOrphanModules (imp_orphs imports) ;
215 traceRn (text "rn1a") ;
216 -- Rename and type check the declarations
217 tcg_env <- if isHsBoot hsc_src then
218 tcRnHsBootDecls local_decls
220 tcRnSrcDecls local_decls ;
221 setGblEnv tcg_env $ do {
223 traceRn (text "rn3") ;
225 -- Report the use of any deprecated things
226 -- We do this before processsing the export list so
227 -- that we don't bleat about re-exporting a deprecated
228 -- thing (especially via 'module Foo' export item)
229 -- Only uses in the body of the module are complained about
230 reportDeprecations tcg_env ;
232 -- Process the export list
233 exports <- exportsFromAvail (isJust maybe_mod) export_ies ;
235 -- Check whether the entire module is deprecated
236 -- This happens only once per module
237 let { mod_deprecs = checkModDeprec mod_deprec } ;
239 -- Add exports and deprecations to envt
240 let { final_env = tcg_env { tcg_exports = exports,
241 tcg_dus = tcg_dus tcg_env `plusDU` usesOnly exports,
242 tcg_deprecs = tcg_deprecs tcg_env `plusDeprecs`
244 -- A module deprecation over-rides the earlier ones
247 -- Report unused names
248 reportUnusedNames export_ies final_env ;
250 -- Dump output and return
255 -- This is really a sanity check that the user has given -package-name
256 -- if necessary. -package-name is only necessary when the package database
257 -- already contains the current package, because then we can't tell
258 -- whether a given module is in the current package or not, without knowing
259 -- the name of the current package.
260 checkForPackageModule dflags this_mod
261 | not (isHomeModule dflags this_mod),
262 Just (pkg,_) <- moduleToPackageConfig dflags this_mod =
264 ppr_pkg = ppr (mkPackageId (package pkg))
266 addErr (ptext SLIT("Module") <+> quotes (ppr this_mod) <+>
267 ptext SLIT("is a member of package") <+> ppr_pkg <> char '.' $$
268 ptext SLIT("To compile this module, please use -ignore-package") <+> ppr_pkg <> char '.')
269 | otherwise = return ()
273 %************************************************************************
275 Type-checking external-core modules
277 %************************************************************************
280 tcRnExtCore :: HscEnv
282 -> IO (Messages, Maybe ModGuts)
283 -- Nothing => some error occurred
285 tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
286 -- The decls are IfaceDecls; all names are original names
287 = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
289 initTc hsc_env ExtCoreFile this_mod $ do {
291 let { ldecls = map noLoc decls } ;
293 -- Deal with the type declarations; first bring their stuff
294 -- into scope, then rname them, then type check them
295 tcg_env <- importsFromLocalDecls (mkFakeGroup ldecls) ;
297 setGblEnv tcg_env $ do {
299 rn_decls <- rnTyClDecls ldecls ;
302 -- Dump trace of renaming part
303 rnDump (ppr rn_decls) ;
305 -- Typecheck them all together so that
306 -- any mutually recursive types are done right
307 tcg_env <- checkNoErrs (tcTyAndClassDecls emptyModDetails rn_decls) ;
308 -- Make the new type env available to stuff slurped from interface files
310 setGblEnv tcg_env $ do {
312 -- Now the core bindings
313 core_binds <- initIfaceExtCore (tcExtCoreBindings src_binds) ;
317 bndrs = bindersOfBinds core_binds ;
318 my_exports = mkNameSet (map idName bndrs) ;
319 -- ToDo: export the data types also?
321 final_type_env = extendTypeEnvWithIds (tcg_type_env tcg_env) bndrs ;
323 mod_guts = ModGuts { mg_module = this_mod,
325 mg_usages = [], -- ToDo: compute usage
326 mg_dir_imps = [], -- ??
327 mg_deps = noDependencies, -- ??
328 mg_exports = my_exports,
329 mg_types = final_type_env,
330 mg_insts = tcg_insts tcg_env,
332 mg_binds = core_binds,
335 mg_rdr_env = emptyGlobalRdrEnv,
336 mg_fix_env = emptyFixityEnv,
337 mg_deprecs = NoDeprecs,
341 tcCoreDump mod_guts ;
346 mkFakeGroup decls -- Rather clumsy; lots of unused fields
347 = HsGroup { hs_tyclds = decls, -- This is the one we want
348 hs_valds = [], hs_fords = [],
349 hs_instds = [], hs_fixds = [], hs_depds = [],
350 hs_ruleds = [], hs_defds = [] }
354 %************************************************************************
356 Type-checking the top level of a module
358 %************************************************************************
361 tcRnSrcDecls :: [LHsDecl RdrName] -> TcM TcGblEnv
362 -- Returns the variables free in the decls
363 -- Reason: solely to report unused imports and bindings
365 = do { -- Load the hi-boot interface for this module, if any
366 -- We do this now so that the boot_names can be passed
367 -- to tcTyAndClassDecls, because the boot_names are
368 -- automatically considered to be loop breakers
370 boot_iface <- tcHiBootIface mod ;
372 -- Do all the declarations
373 (tc_envs, lie) <- getLIE (tc_rn_src_decls boot_iface decls) ;
375 -- tcSimplifyTop deals with constant or ambiguous InstIds.
376 -- How could there be ambiguous ones? They can only arise if a
377 -- top-level decl falls under the monomorphism
378 -- restriction, and no subsequent decl instantiates its
379 -- type. (Usually, ambiguous type variables are resolved
380 -- during the generalisation step.)
381 traceTc (text "Tc8") ;
382 inst_binds <- setEnvs tc_envs (tcSimplifyTop lie) ;
383 -- Setting the global env exposes the instances to tcSimplifyTop
384 -- Setting the local env exposes the local Ids to tcSimplifyTop,
385 -- so that we get better error messages (monomorphism restriction)
387 -- Backsubstitution. This must be done last.
388 -- Even tcSimplifyTop may do some unification.
389 traceTc (text "Tc9") ;
390 let { (tcg_env, _) = tc_envs ;
391 TcGblEnv { tcg_type_env = type_env, tcg_binds = binds,
392 tcg_rules = rules, tcg_fords = fords } = tcg_env } ;
394 (bind_ids, binds', fords', rules') <- zonkTopDecls (binds `unionBags` inst_binds)
397 let { final_type_env = extendTypeEnvWithIds type_env bind_ids
398 ; tcg_env' = tcg_env { tcg_type_env = final_type_env,
401 tcg_fords = fords' } } ;
403 -- Make the new type env available to stuff slurped from interface files
404 writeMutVar (tcg_type_env_var tcg_env) final_type_env ;
406 -- Compare the hi-boot iface (if any) with the real thing
407 dfun_binds <- checkHiBootIface tcg_env' boot_iface ;
409 return (tcg_env' { tcg_binds = tcg_binds tcg_env' `unionBags` dfun_binds })
412 tc_rn_src_decls :: ModDetails -> [LHsDecl RdrName] -> TcM (TcGblEnv, TcLclEnv)
413 -- Loops around dealing with each top level inter-splice group
414 -- in turn, until it's dealt with the entire module
415 tc_rn_src_decls boot_details ds
416 = do { let { (first_group, group_tail) = findSplice ds } ;
417 -- If ds is [] we get ([], Nothing)
419 -- Type check the decls up to, but not including, the first splice
420 tc_envs@(tcg_env,tcl_env) <- tcRnGroup boot_details first_group ;
422 -- Bale out if errors; for example, error recovery when checking
423 -- the RHS of 'main' can mean that 'main' is not in the envt for
424 -- the subsequent checkMain test
429 -- If there is no splice, we're nearly done
431 Nothing -> do { -- Last thing: check for `main'
432 tcg_env <- checkMain ;
433 return (tcg_env, tcl_env)
436 -- If there's a splice, we must carry on
437 Just (SpliceDecl splice_expr, rest_ds) -> do {
439 failWithTc (text "Can't do a top-level splice; need a bootstrapped compiler")
442 -- Rename the splice expression, and get its supporting decls
443 (rn_splice_expr, splice_fvs) <- rnLExpr splice_expr ;
444 failIfErrsM ; -- Don't typecheck if renaming failed
446 -- Execute the splice
447 spliced_decls <- tcSpliceDecls rn_splice_expr ;
449 -- Glue them on the front of the remaining decls and loop
450 setGblEnv (tcg_env `addTcgDUs` usesOnly splice_fvs) $
451 tc_rn_src_decls boot_details (spliced_decls ++ rest_ds)
456 %************************************************************************
458 Compiling hs-boot source files, and
459 comparing the hi-boot interface with the real thing
461 %************************************************************************
464 tcRnHsBootDecls :: [LHsDecl RdrName] -> TcM TcGblEnv
465 tcRnHsBootDecls decls
466 = do { let { (first_group, group_tail) = findSplice decls }
469 Just stuff -> spliceInHsBootErr stuff
472 -- Rename the declarations
473 ; (tcg_env, rn_group) <- rnTopSrcDecls first_group
474 ; setGblEnv tcg_env $ do {
476 -- Todo: check no foreign decls, no rules, no default decls
478 -- Typecheck type/class decls
479 ; traceTc (text "Tc2")
480 ; let tycl_decls = hs_tyclds rn_group
481 ; tcg_env <- checkNoErrs (tcTyAndClassDecls emptyModDetails tycl_decls)
482 ; setGblEnv tcg_env $ do {
484 -- Typecheck instance decls
485 ; traceTc (text "Tc3")
486 ; (tcg_env, inst_infos, _binds) <- tcInstDecls1 tycl_decls (hs_instds rn_group)
487 ; setGblEnv tcg_env $ do {
489 -- Typecheck value declarations
490 ; traceTc (text "Tc5")
491 ; val_ids <- tcHsBootSigs (hs_valds rn_group)
494 -- No simplification or zonking to do
495 ; traceTc (text "Tc7a")
496 ; gbl_env <- getGblEnv
498 -- Make the final type-env
499 -- Include the dfun_ids so that their type sigs get
500 -- are written into the interface file
501 ; let { type_env0 = tcg_type_env gbl_env
502 ; type_env1 = extendTypeEnvWithIds type_env0 val_ids
503 ; type_env2 = extendTypeEnvWithIds type_env1 dfun_ids
504 ; dfun_ids = map iDFunId inst_infos }
505 ; return (gbl_env { tcg_type_env = type_env2 })
508 spliceInHsBootErr (SpliceDecl (L loc _), _)
509 = addErrAt loc (ptext SLIT("Splices are not allowed in hs-boot files"))
512 Once we've typechecked the body of the module, we want to compare what
513 we've found (gathered in a TypeEnv) with the hi-boot details (if any).
516 checkHiBootIface :: TcGblEnv -> ModDetails -> TcM (LHsBinds Id)
517 -- Compare the hi-boot file for this module (if there is one)
518 -- with the type environment we've just come up with
519 -- In the common case where there is no hi-boot file, the list
520 -- of boot_names is empty.
522 -- The bindings we return give bindings for the dfuns defined in the
523 -- hs-boot file, such as $fbEqT = $fEqT
526 (TcGblEnv { tcg_insts = local_insts, tcg_type_env = local_type_env })
527 (ModDetails { md_insts = boot_insts, md_types = boot_type_env })
528 = do { mapM_ check_one (typeEnvElts boot_type_env)
529 ; dfun_binds <- mapM check_inst boot_insts
530 ; return (unionManyBags dfun_binds) }
536 = case lookupTypeEnv local_type_env name of
537 Nothing -> addErrTc (missingBootThing boot_thing)
538 Just real_thing -> check_thing boot_thing real_thing
540 name = getName boot_thing
542 no_check name = isWiredInName name -- No checking for wired-in names. In particular,
543 -- 'error' is handled by a rather gross hack
544 -- (see comments in GHC.Err.hs-boot)
545 || name `elem` dfun_names
546 dfun_names = map getName boot_insts
549 = case [dfun | inst <- local_insts,
550 let dfun = instanceDFunId inst,
551 idType dfun `tcEqType` boot_inst_ty ] of
552 [] -> do { addErrTc (instMisMatch boot_inst); return emptyBag }
553 (dfun:_) -> return (unitBag $ noLoc $ VarBind local_boot_dfun (nlHsVar dfun))
555 boot_dfun = instanceDFunId boot_inst
556 boot_inst_ty = idType boot_dfun
557 local_boot_dfun = mkExportedLocalId (idName boot_dfun) boot_inst_ty
560 check_thing (ATyCon boot_tc) (ATyCon real_tc)
561 | isSynTyCon boot_tc && isSynTyCon real_tc,
562 defn1 `tcEqType` substTyWith tvs2 (mkTyVarTys tvs1) defn2
565 | tyConKind boot_tc == tyConKind real_tc
568 (tvs1, defn1) = getSynTyConDefn boot_tc
569 (tvs2, defn2) = getSynTyConDefn boot_tc
571 check_thing (AnId boot_id) (AnId real_id)
572 | idType boot_id `tcEqType` idType real_id
575 check_thing (ADataCon dc1) (ADataCon dc2)
576 | idType (dataConWrapId dc1) `tcEqType` idType (dataConWrapId dc2)
579 -- Can't declare a class in a hi-boot file
581 check_thing boot_thing real_thing -- Default case; failure
582 = addErrAt (srcLocSpan (getSrcLoc real_thing))
583 (bootMisMatch real_thing)
586 missingBootThing thing
587 = ppr thing <+> ptext SLIT("is defined in the hs-boot file, but not in the module")
589 = ppr thing <+> ptext SLIT("has conflicting definitions in the module and its hs-boot file")
592 2 (ptext SLIT("is defined in the hs-boot file, but not in the module"))
596 %************************************************************************
598 Type-checking the top level of a module
600 %************************************************************************
602 tcRnGroup takes a bunch of top-level source-code declarations, and
604 * gets supporting declarations from interface files
607 * and augments the TcGblEnv with the results
609 In Template Haskell it may be called repeatedly for each group of
610 declarations. It expects there to be an incoming TcGblEnv in the
611 monad; it augments it and returns the new TcGblEnv.
614 tcRnGroup :: ModDetails -> HsGroup RdrName -> TcM (TcGblEnv, TcLclEnv)
615 -- Returns the variables free in the decls, for unused-binding reporting
616 tcRnGroup boot_details decls
617 = do { -- Rename the declarations
618 (tcg_env, rn_decls) <- rnTopSrcDecls decls ;
619 setGblEnv tcg_env $ do {
621 -- Typecheck the declarations
622 tcTopSrcDecls boot_details rn_decls
625 ------------------------------------------------
626 rnTopSrcDecls :: HsGroup RdrName -> TcM (TcGblEnv, HsGroup Name)
628 = do { -- Bring top level binders into scope
629 tcg_env <- importsFromLocalDecls group ;
630 setGblEnv tcg_env $ do {
632 failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
634 -- Rename the source decls
635 (tcg_env, rn_decls) <- rnSrcDecls group ;
638 -- save the renamed syntax, if we want it
640 | Just grp <- tcg_rn_decls tcg_env
641 = tcg_env{ tcg_rn_decls = Just (appendGroups grp rn_decls) }
645 -- Dump trace of renaming part
646 rnDump (ppr rn_decls) ;
648 return (tcg_env', rn_decls)
651 ------------------------------------------------
652 tcTopSrcDecls :: ModDetails -> HsGroup Name -> TcM (TcGblEnv, TcLclEnv)
653 tcTopSrcDecls boot_details
654 (HsGroup { hs_tyclds = tycl_decls,
655 hs_instds = inst_decls,
656 hs_fords = foreign_decls,
657 hs_defds = default_decls,
658 hs_ruleds = rule_decls,
659 hs_valds = val_binds })
660 = do { -- Type-check the type and class decls, and all imported decls
661 -- The latter come in via tycl_decls
662 traceTc (text "Tc2") ;
664 tcg_env <- checkNoErrs (tcTyAndClassDecls boot_details tycl_decls) ;
665 -- tcTyAndClassDecls recovers internally, but if anything gave rise to
666 -- an error we'd better stop now, to avoid a cascade
668 -- Make these type and class decls available to stuff slurped from interface files
669 writeMutVar (tcg_type_env_var tcg_env) (tcg_type_env tcg_env) ;
672 setGblEnv tcg_env $ do {
673 -- Source-language instances, including derivings,
674 -- and import the supporting declarations
675 traceTc (text "Tc3") ;
676 (tcg_env, inst_infos, deriv_binds) <- tcInstDecls1 tycl_decls inst_decls ;
677 setGblEnv tcg_env $ do {
679 -- Foreign import declarations next. No zonking necessary
680 -- here; we can tuck them straight into the global environment.
681 traceTc (text "Tc4") ;
682 (fi_ids, fi_decls) <- tcForeignImports foreign_decls ;
683 tcExtendGlobalValEnv fi_ids $ do {
685 -- Default declarations
686 traceTc (text "Tc4a") ;
687 default_tys <- tcDefaults default_decls ;
688 updGblEnv (\gbl -> gbl { tcg_default = default_tys }) $ do {
690 -- Value declarations next
691 -- We also typecheck any extra binds that came out
692 -- of the "deriving" process (deriv_binds)
693 traceTc (text "Tc5") ;
694 (tc_val_binds, lcl_env) <- tcTopBinds (val_binds ++ deriv_binds) ;
695 setLclTypeEnv lcl_env $ do {
697 -- Second pass over class and instance declarations,
698 traceTc (text "Tc6") ;
699 (tcl_env, inst_binds) <- tcInstDecls2 tycl_decls inst_infos ;
700 showLIE (text "after instDecls2") ;
703 -- They need to be zonked, so we return them
704 traceTc (text "Tc7") ;
705 (foe_binds, foe_decls) <- tcForeignExports foreign_decls ;
708 rules <- tcRules rule_decls ;
711 traceTc (text "Tc7a") ;
712 tcg_env <- getGblEnv ;
713 let { all_binds = tc_val_binds `unionBags`
714 inst_binds `unionBags`
717 -- Extend the GblEnv with the (as yet un-zonked)
718 -- bindings, rules, foreign decls
719 tcg_env' = tcg_env { tcg_binds = tcg_binds tcg_env `unionBags` all_binds,
720 tcg_rules = tcg_rules tcg_env ++ rules,
721 tcg_fords = tcg_fords tcg_env ++ foe_decls ++ fi_decls } } ;
722 return (tcg_env', lcl_env)
727 %************************************************************************
731 %************************************************************************
735 = do { ghci_mode <- getGhciMode ;
736 tcg_env <- getGblEnv ;
738 let { main_mod = case mainModIs dflags of {
739 Just mod -> mkModule mod ;
741 main_fn = case mainFunIs dflags of {
742 Just fn -> mkRdrUnqual (mkVarOcc (mkFastString fn)) ;
743 Nothing -> main_RDR_Unqual } } ;
745 check_main ghci_mode tcg_env main_mod main_fn
749 check_main ghci_mode tcg_env main_mod main_fn
750 -- If we are in module Main, check that 'main' is defined.
751 -- It may be imported from another module!
754 -- Blimey: a whole page of code to do this...
759 = addErrCtxt mainCtxt $
760 do { mb_main <- lookupSrcOcc_maybe main_fn
761 -- Check that 'main' is in scope
762 -- It might be imported from another module!
764 Nothing -> do { complain_no_main
767 { let { rhs = nlHsApp (nlHsVar runMainIOName) (nlHsVar main_name) }
768 -- :Main.main :: IO () = runMainIO main
770 ; (main_expr, ty) <- setSrcSpan (srcLocSpan (getSrcLoc main_name)) $
773 ; let { root_main_id = mkExportedLocalId rootMainName ty ;
774 main_bind = noLoc (VarBind root_main_id main_expr) }
776 ; return (tcg_env { tcg_binds = tcg_binds tcg_env
778 tcg_dus = tcg_dus tcg_env
779 `plusDU` usesOnly (unitFV main_name)
780 -- Record the use of 'main', so that we don't
781 -- complain about it being defined but not used
785 mod = tcg_mod tcg_env
787 complain_no_main | ghci_mode == Interactive = return ()
788 | otherwise = failWithTc noMainMsg
789 -- In interactive mode, don't worry about the absence of 'main'
790 -- In other modes, fail altogether, so that we don't go on
791 -- and complain a second time when processing the export list.
793 mainCtxt = ptext SLIT("When checking the type of the main function") <+> quotes (ppr main_fn)
794 noMainMsg = ptext SLIT("The main function") <+> quotes (ppr main_fn)
795 <+> ptext SLIT("is not defined in module") <+> quotes (ppr main_mod)
798 %*********************************************************
802 %*********************************************************
806 setInteractiveContext :: HscEnv -> InteractiveContext -> TcRn a -> TcRn a
807 setInteractiveContext hsc_env icxt thing_inside
809 -- Initialise the tcg_inst_env with instances
810 -- from all home modules. This mimics the more selective
811 -- call to hptInstances in tcRnModule
812 dfuns = hptInstances hsc_env (\mod -> True)
814 updGblEnv (\env -> env {
815 tcg_rdr_env = ic_rn_gbl_env icxt,
816 tcg_type_env = ic_type_env icxt,
817 tcg_inst_env = extendInstEnvList (tcg_inst_env env) dfuns }) $
819 updLclEnv (\env -> env { tcl_rdr = ic_rn_local_env icxt }) $
821 do { traceTc (text "setIC" <+> ppr (ic_type_env icxt))
828 -> InteractiveContext
830 -> IO (Maybe (InteractiveContext, [Name], LHsExpr Id))
831 -- The returned [Name] is the same as the input except for
832 -- ExprStmt, in which case the returned [Name] is [itName]
834 -- The returned TypecheckedHsExpr is of type IO [ () ],
835 -- a list of the bound values, coerced to ().
837 tcRnStmt hsc_env ictxt rdr_stmt
838 = initTcPrintErrors hsc_env iNTERACTIVE $
839 setInteractiveContext hsc_env ictxt $ do {
841 -- Rename; use CmdLineMode because tcRnStmt is only used interactively
842 (([rn_stmt], _), fvs) <- rnStmts DoExpr [rdr_stmt] (return ((), emptyFVs)) ;
843 traceRn (text "tcRnStmt" <+> vcat [ppr rdr_stmt, ppr rn_stmt, ppr fvs]) ;
846 -- The real work is done here
847 (bound_ids, tc_expr) <- tcUserStmt rn_stmt ;
849 traceTc (text "tcs 1") ;
850 let { -- (a) Make all the bound ids "global" ids, now that
851 -- they're notionally top-level bindings. This is
852 -- important: otherwise when we come to compile an expression
853 -- using these ids later, the byte code generator will consider
854 -- the occurrences to be free rather than global.
856 -- (b) Tidy their types; this is important, because :info may
857 -- ask to look at them, and :info expects the things it looks
858 -- up to have tidy types
859 global_ids = map globaliseAndTidy bound_ids ;
861 -- Update the interactive context
862 rn_env = ic_rn_local_env ictxt ;
863 type_env = ic_type_env ictxt ;
865 bound_names = map idName global_ids ;
866 new_rn_env = extendLocalRdrEnv rn_env bound_names ;
868 -- Remove any shadowed bindings from the type_env;
869 -- they are inaccessible but might, I suppose, cause
870 -- a space leak if we leave them there
871 shadowed = [ n | name <- bound_names,
872 let rdr_name = mkRdrUnqual (nameOccName name),
873 Just n <- [lookupLocalRdrEnv rn_env rdr_name] ] ;
875 filtered_type_env = delListFromNameEnv type_env shadowed ;
876 new_type_env = extendTypeEnvWithIds filtered_type_env global_ids ;
878 new_ic = ictxt { ic_rn_local_env = new_rn_env,
879 ic_type_env = new_type_env }
882 dumpOptTcRn Opt_D_dump_tc
883 (vcat [text "Bound Ids" <+> pprWithCommas ppr global_ids,
884 text "Typechecked expr" <+> ppr tc_expr]) ;
886 returnM (new_ic, bound_names, tc_expr)
889 globaliseAndTidy :: Id -> Id
891 -- Give the Id a Global Name, and tidy its type
892 = setIdType (globaliseId VanillaGlobal id) tidy_type
894 tidy_type = tidyTopType (idType id)
897 Here is the grand plan, implemented in tcUserStmt
899 What you type The IO [HValue] that hscStmt returns
900 ------------- ------------------------------------
901 let pat = expr ==> let pat = expr in return [coerce HVal x, coerce HVal y, ...]
904 pat <- expr ==> expr >>= \ pat -> return [coerce HVal x, coerce HVal y, ...]
907 expr (of IO type) ==> expr >>= \ it -> return [coerce HVal it]
908 [NB: result not printed] bindings: [it]
910 expr (of non-IO type, ==> let it = expr in print it >> return [coerce HVal it]
911 result showable) bindings: [it]
913 expr (of non-IO type,
914 result not showable) ==> error
918 ---------------------------
919 tcUserStmt :: LStmt Name -> TcM ([Id], LHsExpr Id)
920 tcUserStmt (L loc (ExprStmt expr _ _))
921 = newUnique `thenM` \ uniq ->
923 fresh_it = itName uniq
924 the_bind = noLoc $ FunBind (noLoc fresh_it) False
925 (mkMatchGroup [mkSimpleMatch [] expr])
927 tryTcLIE_ (do { -- Try this if the other fails
928 traceTc (text "tcs 1b") ;
929 tc_stmts (map (L loc) [
930 LetStmt [HsBindGroup (unitBag the_bind) [] NonRecursive],
931 ExprStmt (nlHsApp (nlHsVar printName) (nlHsVar fresh_it))
932 (HsVar thenIOName) placeHolderType
934 (do { -- Try this first
935 traceTc (text "tcs 1a") ;
936 tc_stmts [L loc (BindStmt (nlVarPat fresh_it) expr
937 (HsVar bindIOName) noSyntaxExpr) ] })
939 tcUserStmt stmt = tc_stmts [stmt]
941 ---------------------------
942 tc_stmts :: [LStmt Name] -> TcM ([Id], LHsExpr Id)
944 = do { ioTyCon <- tcLookupTyCon ioTyConName ;
946 ret_ty = mkListTy unitTy ;
947 io_ret_ty = mkTyConApp ioTyCon [ret_ty] ;
949 names = map unLoc (collectLStmtsBinders stmts) ;
951 -- mk_return builds the expression
952 -- returnIO @ [()] [coerce () x, .., coerce () z]
954 -- Despite the inconvenience of building the type applications etc,
955 -- this *has* to be done in type-annotated post-typecheck form
956 -- because we are going to return a list of *polymorphic* values
957 -- coerced to type (). If we built a *source* stmt
958 -- return [coerce x, ..., coerce z]
959 -- then the type checker would instantiate x..z, and we wouldn't
960 -- get their *polymorphic* values. (And we'd get ambiguity errs
961 -- if they were overloaded, since they aren't applied to anything.)
962 mk_return ret_id ids = nlHsApp (noLoc $ TyApp (nlHsVar ret_id) [ret_ty])
963 (noLoc $ ExplicitList unitTy (map mk_item ids)) ;
964 mk_item id = nlHsApp (noLoc $ TyApp (nlHsVar unsafeCoerceId) [idType id, unitTy])
967 io_ty = mkTyConApp ioTyCon []
970 -- OK, we're ready to typecheck the stmts
971 traceTc (text "tcs 2") ;
972 ((ids, tc_expr), lie) <- getLIE $ do {
973 (tc_stmts, ids) <- tcStmts DoExpr (tcDoStmt io_ty io_ret_ty) stmts $
975 -- Look up the names right in the middle,
976 -- where they will all be in scope
977 ids <- mappM tcLookupId names ;
980 ret_id <- tcLookupId returnIOName ; -- return @ IO
981 return (ids, noLoc (HsDo DoExpr tc_stmts (mk_return ret_id ids) io_ret_ty))
984 -- Simplify the context right here, so that we fail
985 -- if there aren't enough instances. Notably, when we see
987 -- we use recoverTc_ to try it <- e
988 -- and then let it = e
989 -- It's the simplify step that rejects the first.
990 traceTc (text "tcs 3") ;
991 const_binds <- tcSimplifyInteractive lie ;
993 -- Build result expression and zonk it
994 let { expr = mkHsLet const_binds tc_expr } ;
995 zonked_expr <- zonkTopLExpr expr ;
996 zonked_ids <- zonkTopBndrs ids ;
998 -- None of the Ids should be of unboxed type, because we
999 -- cast them all to HValues in the end!
1000 mappM bad_unboxed (filter (isUnLiftedType . idType) zonked_ids) ;
1002 return (zonked_ids, zonked_expr)
1005 bad_unboxed id = addErr (sep [ptext SLIT("GHCi can't bind a variable of unlifted type:"),
1006 nest 2 (ppr id <+> dcolon <+> ppr (idType id))])
1010 tcRnExpr just finds the type of an expression
1014 -> InteractiveContext
1017 tcRnExpr hsc_env ictxt rdr_expr
1018 = initTcPrintErrors hsc_env iNTERACTIVE $
1019 setInteractiveContext hsc_env ictxt $ do {
1021 (rn_expr, fvs) <- rnLExpr rdr_expr ;
1024 -- Now typecheck the expression;
1025 -- it might have a rank-2 type (e.g. :t runST)
1026 ((tc_expr, res_ty), lie) <- getLIE (tcInferRho rn_expr) ;
1027 ((qtvs, _, dict_ids), lie_top) <- getLIE (tcSimplifyInfer smpl_doc (tyVarsOfType res_ty) lie) ;
1028 tcSimplifyInteractive lie_top ;
1029 qtvs' <- mappM zonkQuantifiedTyVar qtvs ;
1031 let { all_expr_ty = mkForAllTys qtvs' $
1032 mkFunTys (map idType dict_ids) $
1034 zonkTcType all_expr_ty
1037 smpl_doc = ptext SLIT("main expression")
1040 tcRnType just finds the kind of a type
1044 -> InteractiveContext
1047 tcRnType hsc_env ictxt rdr_type
1048 = initTcPrintErrors hsc_env iNTERACTIVE $
1049 setInteractiveContext hsc_env ictxt $ do {
1051 rn_type <- rnLHsType doc rdr_type ;
1054 -- Now kind-check the type
1055 (ty', kind) <- kcHsType rn_type ;
1059 doc = ptext SLIT("In GHCi input")
1065 %************************************************************************
1067 More GHCi stuff, to do with browsing and getting info
1069 %************************************************************************
1073 mkExportEnv :: HscEnv -> [Module] -- Expose these modules' exports only
1075 mkExportEnv hsc_env exports
1076 = do { mb_envs <- initTcPrintErrors hsc_env iNTERACTIVE $
1077 mappM getModuleExports exports
1079 Just envs -> return (foldr plusGlobalRdrEnv emptyGlobalRdrEnv envs)
1080 Nothing -> return emptyGlobalRdrEnv
1081 -- Some error; initTc will have printed it
1084 getModuleExports :: Module -> TcM GlobalRdrEnv
1085 getModuleExports mod
1086 = do { iface <- load_iface mod
1087 ; loadOrphanModules (dep_orphs (mi_deps iface))
1088 -- Load any orphan-module interfaces,
1089 -- so their instances are visible
1090 ; names <- ifaceExportNames (mi_exports iface)
1091 ; let { gres = [ GRE { gre_name = name, gre_prov = vanillaProv mod }
1092 | name <- nameSetToList names ] }
1093 ; returnM (mkGlobalRdrEnv gres) }
1095 vanillaProv :: Module -> Provenance
1096 -- We're building a GlobalRdrEnv as if the user imported
1097 -- all the specified modules into the global interactive module
1098 vanillaProv mod = Imported [ImportSpec mod mod False
1099 (srcLocSpan interactiveSrcLoc)] False
1105 -> Module -- Module to inspect
1106 -> Bool -- Grab just the exports, or the whole toplev
1107 -> IO (Maybe [IfaceDecl])
1109 getModuleContents hsc_env mod exports_only
1110 = initTcPrintErrors hsc_env iNTERACTIVE (get_mod_contents exports_only)
1112 get_mod_contents exports_only
1113 | not exports_only -- We want the whole top-level type env
1114 -- so it had better be a home module
1115 = do { hpt <- getHpt
1116 ; case lookupModuleEnv hpt mod of
1117 Just mod_info -> return (map (toIfaceDecl ext_nm) $
1120 md_types (hm_details mod_info))
1121 Nothing -> ghcError (ProgramError (showSDoc (noRdrEnvErr mod)))
1122 -- This is a system error; the module should be in the HPT
1125 | otherwise -- Want the exports only
1126 = do { iface <- load_iface mod
1127 ; mappM get_decl [ (mod,avail) | (mod, avails) <- mi_exports iface
1131 get_decl (mod, avail)
1132 = do { main_name <- lookupOrig mod (availName avail)
1133 ; thing <- tcLookupGlobal main_name
1134 ; return (filter_decl (availNames avail) (toIfaceDecl ext_nm thing)) }
1136 ext_nm = interactiveExtNameFun (icPrintUnqual (hsc_IC hsc_env))
1138 ---------------------
1139 filter_decl occs decl@(IfaceClass {ifSigs = sigs})
1140 = decl { ifSigs = filter (keep_sig occs) sigs }
1141 filter_decl occs decl@(IfaceData {ifCons = IfDataTyCon cons})
1142 = decl { ifCons = IfDataTyCon (filter (keep_con occs) cons) }
1143 filter_decl occs decl@(IfaceData {ifCons = IfNewTyCon con})
1144 | keep_con occs con = decl
1145 | otherwise = decl {ifCons = IfAbstractTyCon} -- Hmm?
1146 filter_decl occs decl
1149 keep_sig occs (IfaceClassOp occ _ _) = occ `elem` occs
1150 keep_con occs con = ifConOcc con `elem` occs
1152 wantToSee (AnId id) = not (isImplicitId id)
1153 wantToSee (ADataCon _) = False -- They'll come via their TyCon
1156 ---------------------
1157 load_iface mod = loadSrcInterface doc mod False {- Not boot iface -}
1159 doc = ptext SLIT("context for compiling statements")
1161 ---------------------
1162 noRdrEnvErr mod = ptext SLIT("No top-level environment available for module")
1163 <+> quotes (ppr mod)
1167 type GetInfoResult = (String, IfaceDecl, Fixity, SrcLoc,
1168 [(IfaceType,SrcLoc)] -- Instances
1171 tcRnLookupRdrName :: HscEnv -> RdrName -> IO (Maybe [Name])
1173 tcRnLookupRdrName hsc_env rdr_name
1174 = initTcPrintErrors hsc_env iNTERACTIVE $
1175 setInteractiveContext hsc_env (hsc_IC hsc_env) $
1176 lookup_rdr_name rdr_name
1179 lookup_rdr_name rdr_name = do {
1180 -- If the identifier is a constructor (begins with an
1181 -- upper-case letter), then we need to consider both
1182 -- constructor and type class identifiers.
1183 let { rdr_names = dataTcOccs rdr_name } ;
1185 -- results :: [(Messages, Maybe Name)]
1186 results <- mapM (tryTc . lookupOccRn) rdr_names ;
1188 traceRn (text "xx" <+> vcat [ppr rdr_names, ppr (map snd results)]);
1189 -- The successful lookups will be (Just name)
1190 let { (warns_s, good_names) = unzip [ (msgs, name)
1191 | (msgs, Just name) <- results] ;
1192 errs_s = [msgs | (msgs, Nothing) <- results] } ;
1194 -- Fail if nothing good happened, else add warnings
1195 if null good_names then
1196 -- No lookup succeeded, so
1197 -- pick the first error message and report it
1198 -- ToDo: If one of the errors is "could be Foo.X or Baz.X",
1199 -- while the other is "X is not in scope",
1200 -- we definitely want the former; but we might pick the latter
1201 do { addMessages (head errs_s) ; failM }
1202 else -- Add deprecation warnings
1203 mapM_ addMessages warns_s ;
1209 tcRnGetInfo :: HscEnv
1210 -> InteractiveContext
1212 -> IO (Maybe [GetInfoResult])
1214 -- Used to implemnent :info in GHCi
1216 -- Look up a RdrName and return all the TyThings it might be
1217 -- A capitalised RdrName is given to us in the DataName namespace,
1218 -- but we want to treat it as *both* a data constructor
1219 -- *and* as a type or class constructor;
1220 -- hence the call to dataTcOccs, and we return up to two results
1221 tcRnGetInfo hsc_env ictxt rdr_name
1222 = initTcPrintErrors hsc_env iNTERACTIVE $
1223 setInteractiveContext hsc_env ictxt $ do {
1225 -- Load the interface for all unqualified types and classes
1226 -- That way we will find all the instance declarations
1227 -- (Packages have not orphan modules, and we assume that
1228 -- in the home package all relevant modules are loaded.)
1229 loadUnqualIfaces ictxt ;
1231 good_names <- lookup_rdr_name rdr_name ;
1233 -- And lookup up the entities, avoiding duplicates, which arise
1234 -- because constructors and record selectors are represented by
1235 -- their parent declaration
1236 let { do_one name = do { thing <- tcLookupGlobal name
1237 ; fixity <- lookupFixityRn name
1238 ; ispecs <- lookupInsts print_unqual thing
1239 ; return (str, toIfaceDecl ext_nm thing, fixity,
1241 [(toIfaceType ext_nm (idType dfun), getSrcLoc dfun)
1242 | dfun <- map instanceDFunId ispecs ]
1245 -- str is the the naked occurrence name
1246 -- after stripping off qualification and parens (+)
1247 str = occNameUserString (nameOccName name)
1250 -- For the SrcLoc, the 'thing' has better info than
1251 -- the 'name' because getting the former forced the
1252 -- declaration to be loaded into the cache
1254 results <- mapM do_one good_names ;
1255 return (fst (removeDups cmp results))
1258 cmp (_,d1,_,_,_) (_,d2,_,_,_) = ifName d1 `compare` ifName d2
1259 ext_nm = interactiveExtNameFun print_unqual
1260 print_unqual = icPrintUnqual ictxt
1262 lookupInsts :: PrintUnqualified -> TyThing -> TcM [Instance]
1263 -- Filter the instances by the ones whose tycons (or clases resp)
1264 -- are in scope unqualified. Otherwise we list a whole lot too many!
1265 lookupInsts print_unqual (AClass cls)
1266 = do { inst_envs <- tcGetInstEnvs
1268 | ispec <- classInstances inst_envs cls
1269 , plausibleDFun print_unqual (instanceDFunId ispec) ] }
1271 lookupInsts print_unqual (ATyCon tc)
1272 = do { eps <- getEps -- Load all instances for all classes that are
1273 -- in the type environment (which are all the ones
1274 -- we've seen in any interface file so far)
1275 ; (pkg_ie, home_ie) <- tcGetInstEnvs -- Search all
1277 | ispec <- instEnvElts home_ie ++ instEnvElts pkg_ie
1278 , let dfun = instanceDFunId ispec
1280 , plausibleDFun print_unqual dfun ] }
1282 relevant df = tc_name `elemNameSet` tyClsNamesOfDFunHead (idType df)
1283 tc_name = tyConName tc
1285 lookupInsts print_unqual other = return []
1287 plausibleDFun print_unqual dfun -- Dfun involving only names that print unqualified
1288 = all ok (nameSetToList (tyClsNamesOfType (idType dfun)))
1290 ok name | isExternalName name = print_unqual (nameModule name) (nameOccName name)
1293 toIfaceDecl :: (Name -> IfaceExtName) -> TyThing -> IfaceDecl
1294 toIfaceDecl ext_nm thing
1295 = tyThingToIfaceDecl ext_nm (munge thing)
1297 -- munge transforms a thing to its "parent" thing
1298 munge (ADataCon dc) = ATyCon (dataConTyCon dc)
1299 munge (AnId id) = case globalIdDetails id of
1300 RecordSelId tc lbl -> ATyCon tc
1301 ClassOpId cls -> AClass cls
1303 munge other_thing = other_thing
1305 loadUnqualIfaces :: InteractiveContext -> TcM ()
1306 -- Load the home module for everything that is in scope unqualified
1307 -- This is so that we can accurately report the instances for
1309 loadUnqualIfaces ictxt
1311 mapM_ (loadSysInterface doc) (moduleSetElts (mkModuleSet unqual_mods))
1313 unqual_mods = [ nameModule name
1314 | gre <- globalRdrEnvElts (ic_rn_gbl_env ictxt),
1315 let name = gre_name gre,
1316 isTcOcc (nameOccName name), -- Types and classes only
1317 unQualOK gre ] -- In scope unqualified
1318 doc = ptext SLIT("Need interface for module whose export(s) are in scope unqualified")
1322 %************************************************************************
1326 %************************************************************************
1329 rnDump :: SDoc -> TcRn ()
1330 -- Dump, with a banner, if -ddump-rn
1331 rnDump doc = do { dumpOptTcRn Opt_D_dump_rn (mkDumpDoc "Renamer" doc) }
1333 tcDump :: TcGblEnv -> TcRn ()
1335 = do { dflags <- getDOpts ;
1337 -- Dump short output if -ddump-types or -ddump-tc
1338 ifM (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
1339 (dumpTcRn short_dump) ;
1341 -- Dump bindings if -ddump-tc
1342 dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump)
1345 short_dump = pprTcGblEnv env
1346 full_dump = pprLHsBinds (tcg_binds env)
1347 -- NB: foreign x-d's have undefined's in their types;
1348 -- hence can't show the tc_fords
1351 = do { dflags <- getDOpts ;
1352 ifM (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
1353 (dumpTcRn (pprModGuts mod_guts)) ;
1355 -- Dump bindings if -ddump-tc
1356 dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump) }
1358 full_dump = pprCoreBindings (mg_binds mod_guts)
1360 -- It's unpleasant having both pprModGuts and pprModDetails here
1361 pprTcGblEnv :: TcGblEnv -> SDoc
1362 pprTcGblEnv (TcGblEnv { tcg_type_env = type_env,
1363 tcg_insts = dfun_ids,
1365 tcg_imports = imports })
1366 = vcat [ ppr_types dfun_ids type_env
1367 , ppr_insts dfun_ids
1368 , vcat (map ppr rules)
1369 , ppr_gen_tycons (typeEnvTyCons type_env)
1370 , ptext SLIT("Dependent modules:") <+> ppr (moduleEnvElts (imp_dep_mods imports))
1371 , ptext SLIT("Dependent packages:") <+> ppr (imp_dep_pkgs imports)]
1373 pprModGuts :: ModGuts -> SDoc
1374 pprModGuts (ModGuts { mg_types = type_env,
1376 = vcat [ ppr_types [] type_env,
1380 ppr_types :: [Instance] -> TypeEnv -> SDoc
1381 ppr_types ispecs type_env
1382 = text "TYPE SIGNATURES" $$ nest 4 (ppr_sigs ids)
1384 dfun_ids = map instanceDFunId ispecs
1385 ids = [id | id <- typeEnvIds type_env, want_sig id]
1386 want_sig id | opt_PprStyle_Debug = True
1387 | otherwise = isLocalId id &&
1388 isExternalName (idName id) &&
1389 not (id `elem` dfun_ids)
1390 -- isLocalId ignores data constructors, records selectors etc.
1391 -- The isExternalName ignores local dictionary and method bindings
1392 -- that the type checker has invented. Top-level user-defined things
1393 -- have External names.
1395 ppr_insts :: [Instance] -> SDoc
1396 ppr_insts [] = empty
1397 ppr_insts ispecs = text "INSTANCES" $$ nest 2 (pprInstances ispecs)
1399 ppr_sigs :: [Var] -> SDoc
1401 -- Print type signatures; sort by OccName
1402 = vcat (map ppr_sig (sortLe le_sig ids))
1404 le_sig id1 id2 = getOccName id1 <= getOccName id2
1405 ppr_sig id = ppr id <+> dcolon <+> ppr (tidyTopType (idType id))
1407 ppr_rules :: [CoreRule] -> SDoc
1408 ppr_rules [] = empty
1409 ppr_rules rs = vcat [ptext SLIT("{-# RULES"),
1410 nest 4 (pprRules rs),
1413 ppr_gen_tycons [] = empty
1414 ppr_gen_tycons tcs = vcat [ptext SLIT("Tycons with generics:"),
1415 nest 2 (fsep (map ppr (filter tyConHasGenerics tcs)))]