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,
92 import RnSource ( addTcgDUs )
93 import TcHsSyn ( mkHsLet, zonkTopLExpr, zonkTopBndrs )
94 import TcHsType ( kcHsType )
95 import TcMType ( zonkTcType, zonkQuantifiedTyVar )
96 import TcMatches ( tcStmts, tcDoStmt )
97 import TcSimplify ( tcSimplifyInteractive, tcSimplifyInfer )
98 import TcType ( Type, mkForAllTys, mkFunTys, mkTyConApp, tyVarsOfType,
99 isUnLiftedType, tyClsNamesOfDFunHead, tyClsNamesOfType )
100 import TcEnv ( tcLookupTyCon, tcLookupId, tcLookupGlobal )
101 import RnTypes ( rnLHsType )
102 import Inst ( tcGetInstEnvs )
103 import InstEnv ( classInstances, instEnvElts )
104 import RnExpr ( rnStmts, rnLExpr )
105 import LoadIface ( loadSrcInterface, loadSysInterface )
106 import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..),
107 IfaceExtName(..), IfaceConDecls(..),
109 import IfaceType ( IfaceType, toIfaceType,
110 interactiveExtNameFun )
111 import IfaceEnv ( lookupOrig, ifaceExportNames )
112 import Module ( lookupModuleEnv, moduleSetElts, mkModuleSet )
113 import RnEnv ( lookupOccRn, dataTcOccs, lookupFixityRn )
114 import Id ( isImplicitId, setIdType, globalIdDetails )
115 import MkId ( unsafeCoerceId )
116 import DataCon ( dataConTyCon )
117 import TyCon ( tyConName )
118 import TysWiredIn ( mkListTy, unitTy )
119 import IdInfo ( GlobalIdDetails(..) )
120 import SrcLoc ( interactiveSrcLoc, unLoc )
122 import Var ( globaliseId )
123 import Name ( nameOccName, nameModule )
124 import OccName ( occNameUserString, isTcOcc )
125 import NameEnv ( delListFromNameEnv )
126 import PrelNames ( iNTERACTIVE, ioTyConName, printName, itName,
127 bindIOName, thenIOName, returnIOName )
128 import HscTypes ( InteractiveContext(..), HomeModInfo(..),
129 availNames, availName, ModIface(..), icPrintUnqual,
131 import BasicTypes ( RecFlag(..), Fixity )
132 import ListSetOps ( removeDups )
133 import Panic ( ghcError, GhcException(..) )
134 import SrcLoc ( SrcLoc )
137 import FastString ( mkFastString )
138 import Util ( sortLe )
139 import Bag ( unionBags, snocBag, emptyBag, unitBag, unionManyBags )
141 import Maybe ( isJust )
146 %************************************************************************
148 Typecheck and rename a module
150 %************************************************************************
156 -> Bool -- True <=> save renamed syntax
157 -> Located (HsModule RdrName)
158 -> IO (Messages, Maybe TcGblEnv)
160 tcRnModule hsc_env hsc_src save_rn_decls
161 (L loc (HsModule maybe_mod export_ies
162 import_decls local_decls mod_deprec))
163 = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
165 let { this_mod = case maybe_mod of
166 Nothing -> mAIN -- 'module M where' is omitted
167 Just (L _ mod) -> mod } ; -- The normal case
169 initTc hsc_env hsc_src this_mod $
172 checkForPackageModule (hsc_dflags hsc_env) this_mod;
174 -- Deal with imports; sets tcg_rdr_env, tcg_imports
175 (rdr_env, imports) <- rnImports import_decls ;
177 let { dep_mods :: ModuleEnv (Module, IsBootInterface)
178 ; dep_mods = imp_dep_mods imports
180 -- We want instance declarations from all home-package
181 -- modules below this one, including boot modules, except
182 -- ourselves. The 'except ourselves' is so that we don't
183 -- get the instances from this module's hs-boot file
184 ; want_instances :: Module -> Bool
185 ; want_instances mod = mod `elemModuleEnv` dep_mods
187 ; home_insts = hptInstances hsc_env want_instances
190 -- Record boot-file info in the EPS, so that it's
191 -- visible to loadHiBootInterface in tcRnSrcDecls,
192 -- and any other incrementally-performed imports
193 updateEps_ (\eps -> eps { eps_is_boot = dep_mods }) ;
195 -- Update the gbl env
197 gbl { tcg_rdr_env = rdr_env,
198 tcg_inst_env = extendInstEnvList (tcg_inst_env gbl) home_insts,
199 tcg_imports = tcg_imports gbl `plusImportAvails` imports,
200 tcg_rn_decls = if save_rn_decls then
206 traceRn (text "rn1" <+> ppr (imp_dep_mods imports)) ;
207 -- Fail if there are any errors so far
208 -- The error printing (if needed) takes advantage
209 -- of the tcg_env we have now set
212 -- Load any orphan-module interfaces, so that
213 -- their rules and instance decls will be found
214 loadOrphanModules (imp_orphs imports) ;
216 traceRn (text "rn1a") ;
217 -- Rename and type check the declarations
218 tcg_env <- if isHsBoot hsc_src then
219 tcRnHsBootDecls local_decls
221 tcRnSrcDecls local_decls ;
222 setGblEnv tcg_env $ do {
224 traceRn (text "rn3") ;
226 -- Report the use of any deprecated things
227 -- We do this before processsing the export list so
228 -- that we don't bleat about re-exporting a deprecated
229 -- thing (especially via 'module Foo' export item)
230 -- Only uses in the body of the module are complained about
231 reportDeprecations tcg_env ;
233 -- Process the export list
234 exports <- exportsFromAvail (isJust maybe_mod) export_ies ;
236 -- Check whether the entire module is deprecated
237 -- This happens only once per module
238 let { mod_deprecs = checkModDeprec mod_deprec } ;
240 -- Add exports and deprecations to envt
241 let { final_env = tcg_env { tcg_exports = exports,
242 tcg_dus = tcg_dus tcg_env `plusDU` usesOnly exports,
243 tcg_deprecs = tcg_deprecs tcg_env `plusDeprecs`
245 -- A module deprecation over-rides the earlier ones
248 -- Report unused names
249 reportUnusedNames export_ies final_env ;
251 -- Dump output and return
256 -- This is really a sanity check that the user has given -package-name
257 -- if necessary. -package-name is only necessary when the package database
258 -- already contains the current package, because then we can't tell
259 -- whether a given module is in the current package or not, without knowing
260 -- the name of the current package.
261 checkForPackageModule dflags this_mod
262 | not (isHomeModule dflags this_mod),
263 Just (pkg,_) <- moduleToPackageConfig dflags this_mod =
265 ppr_pkg = ppr (mkPackageId (package pkg))
267 addErr (ptext SLIT("Module") <+> quotes (ppr this_mod) <+>
268 ptext SLIT("is a member of package") <+> ppr_pkg <> char '.' $$
269 ptext SLIT("To compile this module, please use -ignore-package") <+> ppr_pkg <> char '.')
270 | otherwise = return ()
274 %************************************************************************
276 Type-checking external-core modules
278 %************************************************************************
281 tcRnExtCore :: HscEnv
283 -> IO (Messages, Maybe ModGuts)
284 -- Nothing => some error occurred
286 tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
287 -- The decls are IfaceDecls; all names are original names
288 = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
290 initTc hsc_env ExtCoreFile this_mod $ do {
292 let { ldecls = map noLoc decls } ;
294 -- Deal with the type declarations; first bring their stuff
295 -- into scope, then rname them, then type check them
296 tcg_env <- importsFromLocalDecls (mkFakeGroup ldecls) ;
298 setGblEnv tcg_env $ do {
300 rn_decls <- rnTyClDecls ldecls ;
303 -- Dump trace of renaming part
304 rnDump (ppr rn_decls) ;
306 -- Typecheck them all together so that
307 -- any mutually recursive types are done right
308 tcg_env <- checkNoErrs (tcTyAndClassDecls emptyModDetails rn_decls) ;
309 -- Make the new type env available to stuff slurped from interface files
311 setGblEnv tcg_env $ do {
313 -- Now the core bindings
314 core_binds <- initIfaceExtCore (tcExtCoreBindings src_binds) ;
318 bndrs = bindersOfBinds core_binds ;
319 my_exports = mkNameSet (map idName bndrs) ;
320 -- ToDo: export the data types also?
322 final_type_env = extendTypeEnvWithIds (tcg_type_env tcg_env) bndrs ;
324 mod_guts = ModGuts { mg_module = this_mod,
326 mg_usages = [], -- ToDo: compute usage
327 mg_dir_imps = [], -- ??
328 mg_deps = noDependencies, -- ??
329 mg_exports = my_exports,
330 mg_types = final_type_env,
331 mg_insts = tcg_insts tcg_env,
333 mg_binds = core_binds,
336 mg_rdr_env = emptyGlobalRdrEnv,
337 mg_fix_env = emptyFixityEnv,
338 mg_deprecs = NoDeprecs,
342 tcCoreDump mod_guts ;
347 mkFakeGroup decls -- Rather clumsy; lots of unused fields
348 = HsGroup { hs_tyclds = decls, -- This is the one we want
349 hs_valds = [], hs_fords = [],
350 hs_instds = [], hs_fixds = [], hs_depds = [],
351 hs_ruleds = [], hs_defds = [] }
355 %************************************************************************
357 Type-checking the top level of a module
359 %************************************************************************
362 tcRnSrcDecls :: [LHsDecl RdrName] -> TcM TcGblEnv
363 -- Returns the variables free in the decls
364 -- Reason: solely to report unused imports and bindings
366 = do { -- Load the hi-boot interface for this module, if any
367 -- We do this now so that the boot_names can be passed
368 -- to tcTyAndClassDecls, because the boot_names are
369 -- automatically considered to be loop breakers
371 boot_iface <- tcHiBootIface mod ;
373 -- Do all the declarations
374 (tc_envs, lie) <- getLIE (tc_rn_src_decls boot_iface decls) ;
376 -- tcSimplifyTop deals with constant or ambiguous InstIds.
377 -- How could there be ambiguous ones? They can only arise if a
378 -- top-level decl falls under the monomorphism
379 -- restriction, and no subsequent decl instantiates its
380 -- type. (Usually, ambiguous type variables are resolved
381 -- during the generalisation step.)
382 traceTc (text "Tc8") ;
383 inst_binds <- setEnvs tc_envs (tcSimplifyTop lie) ;
384 -- Setting the global env exposes the instances to tcSimplifyTop
385 -- Setting the local env exposes the local Ids to tcSimplifyTop,
386 -- so that we get better error messages (monomorphism restriction)
388 -- Backsubstitution. This must be done last.
389 -- Even tcSimplifyTop may do some unification.
390 traceTc (text "Tc9") ;
391 let { (tcg_env, _) = tc_envs ;
392 TcGblEnv { tcg_type_env = type_env, tcg_binds = binds,
393 tcg_rules = rules, tcg_fords = fords } = tcg_env } ;
395 (bind_ids, binds', fords', rules') <- zonkTopDecls (binds `unionBags` inst_binds)
398 let { final_type_env = extendTypeEnvWithIds type_env bind_ids
399 ; tcg_env' = tcg_env { tcg_type_env = final_type_env,
402 tcg_fords = fords' } } ;
404 -- Make the new type env available to stuff slurped from interface files
405 writeMutVar (tcg_type_env_var tcg_env) final_type_env ;
407 -- Compare the hi-boot iface (if any) with the real thing
408 dfun_binds <- checkHiBootIface tcg_env' boot_iface ;
410 return (tcg_env' { tcg_binds = tcg_binds tcg_env' `unionBags` dfun_binds })
413 tc_rn_src_decls :: ModDetails -> [LHsDecl RdrName] -> TcM (TcGblEnv, TcLclEnv)
414 -- Loops around dealing with each top level inter-splice group
415 -- in turn, until it's dealt with the entire module
416 tc_rn_src_decls boot_details ds
417 = do { let { (first_group, group_tail) = findSplice ds } ;
418 -- If ds is [] we get ([], Nothing)
420 -- Type check the decls up to, but not including, the first splice
421 tc_envs@(tcg_env,tcl_env) <- tcRnGroup boot_details first_group ;
423 -- Bale out if errors; for example, error recovery when checking
424 -- the RHS of 'main' can mean that 'main' is not in the envt for
425 -- the subsequent checkMain test
430 -- If there is no splice, we're nearly done
432 Nothing -> do { -- Last thing: check for `main'
433 tcg_env <- checkMain ;
434 return (tcg_env, tcl_env)
437 -- If there's a splice, we must carry on
438 Just (SpliceDecl splice_expr, rest_ds) -> do {
440 failWithTc (text "Can't do a top-level splice; need a bootstrapped compiler")
443 -- Rename the splice expression, and get its supporting decls
444 (rn_splice_expr, splice_fvs) <- rnLExpr splice_expr ;
445 failIfErrsM ; -- Don't typecheck if renaming failed
447 -- Execute the splice
448 spliced_decls <- tcSpliceDecls rn_splice_expr ;
450 -- Glue them on the front of the remaining decls and loop
451 setGblEnv (tcg_env `addTcgDUs` usesOnly splice_fvs) $
452 tc_rn_src_decls boot_details (spliced_decls ++ rest_ds)
457 %************************************************************************
459 Compiling hs-boot source files, and
460 comparing the hi-boot interface with the real thing
462 %************************************************************************
465 tcRnHsBootDecls :: [LHsDecl RdrName] -> TcM TcGblEnv
466 tcRnHsBootDecls decls
467 = do { let { (first_group, group_tail) = findSplice decls }
470 Just stuff -> spliceInHsBootErr stuff
473 -- Rename the declarations
474 ; (tcg_env, rn_group) <- rnTopSrcDecls first_group
475 ; setGblEnv tcg_env $ do {
477 -- Todo: check no foreign decls, no rules, no default decls
479 -- Typecheck type/class decls
480 ; traceTc (text "Tc2")
481 ; let tycl_decls = hs_tyclds rn_group
482 ; tcg_env <- checkNoErrs (tcTyAndClassDecls emptyModDetails tycl_decls)
483 ; setGblEnv tcg_env $ do {
485 -- Typecheck instance decls
486 ; traceTc (text "Tc3")
487 ; (tcg_env, inst_infos, _binds) <- tcInstDecls1 tycl_decls (hs_instds rn_group)
488 ; setGblEnv tcg_env $ do {
490 -- Typecheck value declarations
491 ; traceTc (text "Tc5")
492 ; val_ids <- tcHsBootSigs (hs_valds rn_group)
495 -- No simplification or zonking to do
496 ; traceTc (text "Tc7a")
497 ; gbl_env <- getGblEnv
499 -- Make the final type-env
500 -- Include the dfun_ids so that their type sigs get
501 -- are written into the interface file
502 ; let { type_env0 = tcg_type_env gbl_env
503 ; type_env1 = extendTypeEnvWithIds type_env0 val_ids
504 ; type_env2 = extendTypeEnvWithIds type_env1 dfun_ids
505 ; dfun_ids = map iDFunId inst_infos }
506 ; return (gbl_env { tcg_type_env = type_env2 })
509 spliceInHsBootErr (SpliceDecl (L loc _), _)
510 = addErrAt loc (ptext SLIT("Splices are not allowed in hs-boot files"))
513 Once we've typechecked the body of the module, we want to compare what
514 we've found (gathered in a TypeEnv) with the hi-boot details (if any).
517 checkHiBootIface :: TcGblEnv -> ModDetails -> TcM (LHsBinds Id)
518 -- Compare the hi-boot file for this module (if there is one)
519 -- with the type environment we've just come up with
520 -- In the common case where there is no hi-boot file, the list
521 -- of boot_names is empty.
523 -- The bindings we return give bindings for the dfuns defined in the
524 -- hs-boot file, such as $fbEqT = $fEqT
527 (TcGblEnv { tcg_insts = local_insts, tcg_type_env = local_type_env })
528 (ModDetails { md_insts = boot_insts, md_types = boot_type_env })
529 = do { mapM_ check_one (typeEnvElts boot_type_env)
530 ; dfun_binds <- mapM check_inst boot_insts
531 ; return (unionManyBags dfun_binds) }
537 = case lookupTypeEnv local_type_env name of
538 Nothing -> addErrTc (missingBootThing boot_thing)
539 Just real_thing -> check_thing boot_thing real_thing
541 name = getName boot_thing
543 no_check name = isWiredInName name -- No checking for wired-in names. In particular,
544 -- 'error' is handled by a rather gross hack
545 -- (see comments in GHC.Err.hs-boot)
546 || name `elem` dfun_names
547 dfun_names = map getName boot_insts
550 = case [dfun | inst <- local_insts,
551 let dfun = instanceDFunId inst,
552 idType dfun `tcEqType` boot_inst_ty ] of
553 [] -> do { addErrTc (instMisMatch boot_inst); return emptyBag }
554 (dfun:_) -> return (unitBag $ noLoc $ VarBind local_boot_dfun (nlHsVar dfun))
556 boot_dfun = instanceDFunId boot_inst
557 boot_inst_ty = idType boot_dfun
558 local_boot_dfun = mkExportedLocalId (idName boot_dfun) boot_inst_ty
561 check_thing (ATyCon boot_tc) (ATyCon real_tc)
562 | isSynTyCon boot_tc && isSynTyCon real_tc,
563 defn1 `tcEqType` substTyWith tvs2 (mkTyVarTys tvs1) defn2
566 | tyConKind boot_tc == tyConKind real_tc
569 (tvs1, defn1) = getSynTyConDefn boot_tc
570 (tvs2, defn2) = getSynTyConDefn boot_tc
572 check_thing (AnId boot_id) (AnId real_id)
573 | idType boot_id `tcEqType` idType real_id
576 check_thing (ADataCon dc1) (ADataCon dc2)
577 | idType (dataConWrapId dc1) `tcEqType` idType (dataConWrapId dc2)
580 -- Can't declare a class in a hi-boot file
582 check_thing boot_thing real_thing -- Default case; failure
583 = addErrAt (srcLocSpan (getSrcLoc real_thing))
584 (bootMisMatch real_thing)
587 missingBootThing thing
588 = ppr thing <+> ptext SLIT("is defined in the hs-boot file, but not in the module")
590 = ppr thing <+> ptext SLIT("has conflicting definitions in the module and its hs-boot file")
593 2 (ptext SLIT("is defined in the hs-boot file, but not in the module"))
597 %************************************************************************
599 Type-checking the top level of a module
601 %************************************************************************
603 tcRnGroup takes a bunch of top-level source-code declarations, and
605 * gets supporting declarations from interface files
608 * and augments the TcGblEnv with the results
610 In Template Haskell it may be called repeatedly for each group of
611 declarations. It expects there to be an incoming TcGblEnv in the
612 monad; it augments it and returns the new TcGblEnv.
615 tcRnGroup :: ModDetails -> HsGroup RdrName -> TcM (TcGblEnv, TcLclEnv)
616 -- Returns the variables free in the decls, for unused-binding reporting
617 tcRnGroup boot_details decls
618 = do { -- Rename the declarations
619 (tcg_env, rn_decls) <- rnTopSrcDecls decls ;
620 setGblEnv tcg_env $ do {
622 -- Typecheck the declarations
623 tcTopSrcDecls boot_details rn_decls
626 ------------------------------------------------
627 rnTopSrcDecls :: HsGroup RdrName -> TcM (TcGblEnv, HsGroup Name)
629 = do { -- Bring top level binders into scope
630 tcg_env <- importsFromLocalDecls group ;
631 setGblEnv tcg_env $ do {
633 failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
635 -- Rename the source decls
636 (tcg_env, rn_decls) <- rnSrcDecls group ;
639 -- save the renamed syntax, if we want it
641 | Just grp <- tcg_rn_decls tcg_env
642 = tcg_env{ tcg_rn_decls = Just (appendGroups grp rn_decls) }
646 -- Dump trace of renaming part
647 rnDump (ppr rn_decls) ;
649 return (tcg_env', rn_decls)
652 ------------------------------------------------
653 tcTopSrcDecls :: ModDetails -> HsGroup Name -> TcM (TcGblEnv, TcLclEnv)
654 tcTopSrcDecls boot_details
655 (HsGroup { hs_tyclds = tycl_decls,
656 hs_instds = inst_decls,
657 hs_fords = foreign_decls,
658 hs_defds = default_decls,
659 hs_ruleds = rule_decls,
660 hs_valds = val_binds })
661 = do { -- Type-check the type and class decls, and all imported decls
662 -- The latter come in via tycl_decls
663 traceTc (text "Tc2") ;
665 tcg_env <- checkNoErrs (tcTyAndClassDecls boot_details tycl_decls) ;
666 -- tcTyAndClassDecls recovers internally, but if anything gave rise to
667 -- an error we'd better stop now, to avoid a cascade
669 -- Make these type and class decls available to stuff slurped from interface files
670 writeMutVar (tcg_type_env_var tcg_env) (tcg_type_env tcg_env) ;
673 setGblEnv tcg_env $ do {
674 -- Source-language instances, including derivings,
675 -- and import the supporting declarations
676 traceTc (text "Tc3") ;
677 (tcg_env, inst_infos, deriv_binds) <- tcInstDecls1 tycl_decls inst_decls ;
678 setGblEnv tcg_env $ do {
680 -- Foreign import declarations next. No zonking necessary
681 -- here; we can tuck them straight into the global environment.
682 traceTc (text "Tc4") ;
683 (fi_ids, fi_decls) <- tcForeignImports foreign_decls ;
684 tcExtendGlobalValEnv fi_ids $ do {
686 -- Default declarations
687 traceTc (text "Tc4a") ;
688 default_tys <- tcDefaults default_decls ;
689 updGblEnv (\gbl -> gbl { tcg_default = default_tys }) $ do {
691 -- Value declarations next
692 -- We also typecheck any extra binds that came out
693 -- of the "deriving" process (deriv_binds)
694 traceTc (text "Tc5") ;
695 (tc_val_binds, lcl_env) <- tcTopBinds (val_binds ++ deriv_binds) ;
696 setLclTypeEnv lcl_env $ do {
698 -- Second pass over class and instance declarations,
699 traceTc (text "Tc6") ;
700 (tcl_env, inst_binds) <- tcInstDecls2 tycl_decls inst_infos ;
701 showLIE (text "after instDecls2") ;
704 -- They need to be zonked, so we return them
705 traceTc (text "Tc7") ;
706 (foe_binds, foe_decls) <- tcForeignExports foreign_decls ;
709 rules <- tcRules rule_decls ;
712 traceTc (text "Tc7a") ;
713 tcg_env <- getGblEnv ;
714 let { all_binds = tc_val_binds `unionBags`
715 inst_binds `unionBags`
718 -- Extend the GblEnv with the (as yet un-zonked)
719 -- bindings, rules, foreign decls
720 tcg_env' = tcg_env { tcg_binds = tcg_binds tcg_env `unionBags` all_binds,
721 tcg_rules = tcg_rules tcg_env ++ rules,
722 tcg_fords = tcg_fords tcg_env ++ foe_decls ++ fi_decls } } ;
723 return (tcg_env', lcl_env)
728 %************************************************************************
732 %************************************************************************
736 = do { ghci_mode <- getGhciMode ;
737 tcg_env <- getGblEnv ;
739 let { main_mod = case mainModIs dflags of {
740 Just mod -> mkModule mod ;
742 main_fn = case mainFunIs dflags of {
743 Just fn -> mkRdrUnqual (mkVarOcc (mkFastString fn)) ;
744 Nothing -> main_RDR_Unqual } } ;
746 check_main ghci_mode tcg_env main_mod main_fn
750 check_main ghci_mode tcg_env main_mod main_fn
751 -- If we are in module Main, check that 'main' is defined.
752 -- It may be imported from another module!
755 -- Blimey: a whole page of code to do this...
760 = addErrCtxt mainCtxt $
761 do { mb_main <- lookupSrcOcc_maybe main_fn
762 -- Check that 'main' is in scope
763 -- It might be imported from another module!
765 Nothing -> do { complain_no_main
768 { let { rhs = nlHsApp (nlHsVar runMainIOName) (nlHsVar main_name) }
769 -- :Main.main :: IO () = runMainIO main
771 ; (main_expr, ty) <- setSrcSpan (srcLocSpan (getSrcLoc main_name)) $
774 ; let { root_main_id = mkExportedLocalId rootMainName ty ;
775 main_bind = noLoc (VarBind root_main_id main_expr) }
777 ; return (tcg_env { tcg_binds = tcg_binds tcg_env
779 tcg_dus = tcg_dus tcg_env
780 `plusDU` usesOnly (unitFV main_name)
781 -- Record the use of 'main', so that we don't
782 -- complain about it being defined but not used
786 mod = tcg_mod tcg_env
788 complain_no_main | ghci_mode == Interactive = return ()
789 | otherwise = failWithTc noMainMsg
790 -- In interactive mode, don't worry about the absence of 'main'
791 -- In other modes, fail altogether, so that we don't go on
792 -- and complain a second time when processing the export list.
794 mainCtxt = ptext SLIT("When checking the type of the main function") <+> quotes (ppr main_fn)
795 noMainMsg = ptext SLIT("The main function") <+> quotes (ppr main_fn)
796 <+> ptext SLIT("is not defined in module") <+> quotes (ppr main_mod)
799 %*********************************************************
803 %*********************************************************
807 setInteractiveContext :: HscEnv -> InteractiveContext -> TcRn a -> TcRn a
808 setInteractiveContext hsc_env icxt thing_inside
810 -- Initialise the tcg_inst_env with instances
811 -- from all home modules. This mimics the more selective
812 -- call to hptInstances in tcRnModule
813 dfuns = hptInstances hsc_env (\mod -> True)
815 updGblEnv (\env -> env {
816 tcg_rdr_env = ic_rn_gbl_env icxt,
817 tcg_type_env = ic_type_env icxt,
818 tcg_inst_env = extendInstEnvList (tcg_inst_env env) dfuns }) $
820 updLclEnv (\env -> env { tcl_rdr = ic_rn_local_env icxt }) $
822 do { traceTc (text "setIC" <+> ppr (ic_type_env icxt))
829 -> InteractiveContext
831 -> IO (Maybe (InteractiveContext, [Name], LHsExpr Id))
832 -- The returned [Name] is the same as the input except for
833 -- ExprStmt, in which case the returned [Name] is [itName]
835 -- The returned TypecheckedHsExpr is of type IO [ () ],
836 -- a list of the bound values, coerced to ().
838 tcRnStmt hsc_env ictxt rdr_stmt
839 = initTcPrintErrors hsc_env iNTERACTIVE $
840 setInteractiveContext hsc_env ictxt $ do {
842 -- Rename; use CmdLineMode because tcRnStmt is only used interactively
843 (([rn_stmt], _), fvs) <- rnStmts DoExpr [rdr_stmt] (return ((), emptyFVs)) ;
844 traceRn (text "tcRnStmt" <+> vcat [ppr rdr_stmt, ppr rn_stmt, ppr fvs]) ;
847 -- The real work is done here
848 (bound_ids, tc_expr) <- tcUserStmt rn_stmt ;
850 traceTc (text "tcs 1") ;
851 let { -- (a) Make all the bound ids "global" ids, now that
852 -- they're notionally top-level bindings. This is
853 -- important: otherwise when we come to compile an expression
854 -- using these ids later, the byte code generator will consider
855 -- the occurrences to be free rather than global.
857 -- (b) Tidy their types; this is important, because :info may
858 -- ask to look at them, and :info expects the things it looks
859 -- up to have tidy types
860 global_ids = map globaliseAndTidy bound_ids ;
862 -- Update the interactive context
863 rn_env = ic_rn_local_env ictxt ;
864 type_env = ic_type_env ictxt ;
866 bound_names = map idName global_ids ;
867 new_rn_env = extendLocalRdrEnv rn_env bound_names ;
869 -- Remove any shadowed bindings from the type_env;
870 -- they are inaccessible but might, I suppose, cause
871 -- a space leak if we leave them there
872 shadowed = [ n | name <- bound_names,
873 let rdr_name = mkRdrUnqual (nameOccName name),
874 Just n <- [lookupLocalRdrEnv rn_env rdr_name] ] ;
876 filtered_type_env = delListFromNameEnv type_env shadowed ;
877 new_type_env = extendTypeEnvWithIds filtered_type_env global_ids ;
879 new_ic = ictxt { ic_rn_local_env = new_rn_env,
880 ic_type_env = new_type_env }
883 dumpOptTcRn Opt_D_dump_tc
884 (vcat [text "Bound Ids" <+> pprWithCommas ppr global_ids,
885 text "Typechecked expr" <+> ppr tc_expr]) ;
887 returnM (new_ic, bound_names, tc_expr)
890 globaliseAndTidy :: Id -> Id
892 -- Give the Id a Global Name, and tidy its type
893 = setIdType (globaliseId VanillaGlobal id) tidy_type
895 tidy_type = tidyTopType (idType id)
898 Here is the grand plan, implemented in tcUserStmt
900 What you type The IO [HValue] that hscStmt returns
901 ------------- ------------------------------------
902 let pat = expr ==> let pat = expr in return [coerce HVal x, coerce HVal y, ...]
905 pat <- expr ==> expr >>= \ pat -> return [coerce HVal x, coerce HVal y, ...]
908 expr (of IO type) ==> expr >>= \ it -> return [coerce HVal it]
909 [NB: result not printed] bindings: [it]
911 expr (of non-IO type, ==> let it = expr in print it >> return [coerce HVal it]
912 result showable) bindings: [it]
914 expr (of non-IO type,
915 result not showable) ==> error
919 ---------------------------
920 tcUserStmt :: LStmt Name -> TcM ([Id], LHsExpr Id)
921 tcUserStmt (L loc (ExprStmt expr _ _))
922 = newUnique `thenM` \ uniq ->
924 fresh_it = itName uniq
925 the_bind = noLoc $ FunBind (noLoc fresh_it) False
926 (mkMatchGroup [mkSimpleMatch [] expr])
928 tryTcLIE_ (do { -- Try this if the other fails
929 traceTc (text "tcs 1b") ;
930 tc_stmts (map (L loc) [
931 LetStmt [HsBindGroup (unitBag the_bind) [] NonRecursive],
932 ExprStmt (nlHsApp (nlHsVar printName) (nlHsVar fresh_it))
933 (HsVar thenIOName) placeHolderType
935 (do { -- Try this first
936 traceTc (text "tcs 1a") ;
937 tc_stmts [L loc (BindStmt (nlVarPat fresh_it) expr
938 (HsVar bindIOName) noSyntaxExpr) ] })
940 tcUserStmt stmt = tc_stmts [stmt]
942 ---------------------------
943 tc_stmts :: [LStmt Name] -> TcM ([Id], LHsExpr Id)
945 = do { ioTyCon <- tcLookupTyCon ioTyConName ;
947 ret_ty = mkListTy unitTy ;
948 io_ret_ty = mkTyConApp ioTyCon [ret_ty] ;
950 names = map unLoc (collectLStmtsBinders stmts) ;
952 -- mk_return builds the expression
953 -- returnIO @ [()] [coerce () x, .., coerce () z]
955 -- Despite the inconvenience of building the type applications etc,
956 -- this *has* to be done in type-annotated post-typecheck form
957 -- because we are going to return a list of *polymorphic* values
958 -- coerced to type (). If we built a *source* stmt
959 -- return [coerce x, ..., coerce z]
960 -- then the type checker would instantiate x..z, and we wouldn't
961 -- get their *polymorphic* values. (And we'd get ambiguity errs
962 -- if they were overloaded, since they aren't applied to anything.)
963 mk_return ret_id ids = nlHsApp (noLoc $ TyApp (nlHsVar ret_id) [ret_ty])
964 (noLoc $ ExplicitList unitTy (map mk_item ids)) ;
965 mk_item id = nlHsApp (noLoc $ TyApp (nlHsVar unsafeCoerceId) [idType id, unitTy])
968 io_ty = mkTyConApp ioTyCon []
971 -- OK, we're ready to typecheck the stmts
972 traceTc (text "tcs 2") ;
973 ((ids, tc_expr), lie) <- getLIE $ do {
974 (tc_stmts, ids) <- tcStmts DoExpr (tcDoStmt io_ty io_ret_ty) stmts $
976 -- Look up the names right in the middle,
977 -- where they will all be in scope
978 ids <- mappM tcLookupId names ;
981 ret_id <- tcLookupId returnIOName ; -- return @ IO
982 return (ids, noLoc (HsDo DoExpr tc_stmts (mk_return ret_id ids) io_ret_ty))
985 -- Simplify the context right here, so that we fail
986 -- if there aren't enough instances. Notably, when we see
988 -- we use recoverTc_ to try it <- e
989 -- and then let it = e
990 -- It's the simplify step that rejects the first.
991 traceTc (text "tcs 3") ;
992 const_binds <- tcSimplifyInteractive lie ;
994 -- Build result expression and zonk it
995 let { expr = mkHsLet const_binds tc_expr } ;
996 zonked_expr <- zonkTopLExpr expr ;
997 zonked_ids <- zonkTopBndrs ids ;
999 -- None of the Ids should be of unboxed type, because we
1000 -- cast them all to HValues in the end!
1001 mappM bad_unboxed (filter (isUnLiftedType . idType) zonked_ids) ;
1003 return (zonked_ids, zonked_expr)
1006 bad_unboxed id = addErr (sep [ptext SLIT("GHCi can't bind a variable of unlifted type:"),
1007 nest 2 (ppr id <+> dcolon <+> ppr (idType id))])
1011 tcRnExpr just finds the type of an expression
1015 -> InteractiveContext
1018 tcRnExpr hsc_env ictxt rdr_expr
1019 = initTcPrintErrors hsc_env iNTERACTIVE $
1020 setInteractiveContext hsc_env ictxt $ do {
1022 (rn_expr, fvs) <- rnLExpr rdr_expr ;
1025 -- Now typecheck the expression;
1026 -- it might have a rank-2 type (e.g. :t runST)
1027 ((tc_expr, res_ty), lie) <- getLIE (tcInferRho rn_expr) ;
1028 ((qtvs, _, dict_ids), lie_top) <- getLIE (tcSimplifyInfer smpl_doc (tyVarsOfType res_ty) lie) ;
1029 tcSimplifyInteractive lie_top ;
1030 qtvs' <- mappM zonkQuantifiedTyVar qtvs ;
1032 let { all_expr_ty = mkForAllTys qtvs' $
1033 mkFunTys (map idType dict_ids) $
1035 zonkTcType all_expr_ty
1038 smpl_doc = ptext SLIT("main expression")
1041 tcRnType just finds the kind of a type
1045 -> InteractiveContext
1048 tcRnType hsc_env ictxt rdr_type
1049 = initTcPrintErrors hsc_env iNTERACTIVE $
1050 setInteractiveContext hsc_env ictxt $ do {
1052 rn_type <- rnLHsType doc rdr_type ;
1055 -- Now kind-check the type
1056 (ty', kind) <- kcHsType rn_type ;
1060 doc = ptext SLIT("In GHCi input")
1066 %************************************************************************
1068 More GHCi stuff, to do with browsing and getting info
1070 %************************************************************************
1074 mkExportEnv :: HscEnv -> [Module] -- Expose these modules' exports only
1076 mkExportEnv hsc_env exports
1077 = do { mb_envs <- initTcPrintErrors hsc_env iNTERACTIVE $
1078 mappM getModuleExports exports
1080 Just envs -> return (foldr plusGlobalRdrEnv emptyGlobalRdrEnv envs)
1081 Nothing -> return emptyGlobalRdrEnv
1082 -- Some error; initTc will have printed it
1085 getModuleExports :: Module -> TcM GlobalRdrEnv
1086 getModuleExports mod
1087 = do { iface <- load_iface mod
1088 ; loadOrphanModules (dep_orphs (mi_deps iface))
1089 -- Load any orphan-module interfaces,
1090 -- so their instances are visible
1091 ; names <- ifaceExportNames (mi_exports iface)
1092 ; let { gres = [ GRE { gre_name = name, gre_prov = vanillaProv mod }
1093 | name <- nameSetToList names ] }
1094 ; returnM (mkGlobalRdrEnv gres) }
1096 vanillaProv :: Module -> Provenance
1097 -- We're building a GlobalRdrEnv as if the user imported
1098 -- all the specified modules into the global interactive module
1099 vanillaProv mod = Imported [ImportSpec { is_mod = mod, is_as = mod,
1100 is_qual = False, is_explicit = False,
1101 is_loc = srcLocSpan interactiveSrcLoc }]
1107 -> Module -- Module to inspect
1108 -> Bool -- Grab just the exports, or the whole toplev
1109 -> IO (Maybe [IfaceDecl])
1111 getModuleContents hsc_env mod exports_only
1112 = initTcPrintErrors hsc_env iNTERACTIVE (get_mod_contents exports_only)
1114 get_mod_contents exports_only
1115 | not exports_only -- We want the whole top-level type env
1116 -- so it had better be a home module
1117 = do { hpt <- getHpt
1118 ; case lookupModuleEnv hpt mod of
1119 Just mod_info -> return (map (toIfaceDecl ext_nm) $
1122 md_types (hm_details mod_info))
1123 Nothing -> ghcError (ProgramError (showSDoc (noRdrEnvErr mod)))
1124 -- This is a system error; the module should be in the HPT
1127 | otherwise -- Want the exports only
1128 = do { iface <- load_iface mod
1129 ; mappM get_decl [ (mod,avail) | (mod, avails) <- mi_exports iface
1133 get_decl (mod, avail)
1134 = do { main_name <- lookupOrig mod (availName avail)
1135 ; thing <- tcLookupGlobal main_name
1136 ; return (filter_decl (availNames avail) (toIfaceDecl ext_nm thing)) }
1138 ext_nm = interactiveExtNameFun (icPrintUnqual (hsc_IC hsc_env))
1140 ---------------------
1141 filter_decl occs decl@(IfaceClass {ifSigs = sigs})
1142 = decl { ifSigs = filter (keep_sig occs) sigs }
1143 filter_decl occs decl@(IfaceData {ifCons = IfDataTyCon cons})
1144 = decl { ifCons = IfDataTyCon (filter (keep_con occs) cons) }
1145 filter_decl occs decl@(IfaceData {ifCons = IfNewTyCon con})
1146 | keep_con occs con = decl
1147 | otherwise = decl {ifCons = IfAbstractTyCon} -- Hmm?
1148 filter_decl occs decl
1151 keep_sig occs (IfaceClassOp occ _ _) = occ `elem` occs
1152 keep_con occs con = ifConOcc con `elem` occs
1154 wantToSee (AnId id) = not (isImplicitId id)
1155 wantToSee (ADataCon _) = False -- They'll come via their TyCon
1158 ---------------------
1159 load_iface mod = loadSrcInterface doc mod False {- Not boot iface -}
1161 doc = ptext SLIT("context for compiling statements")
1163 ---------------------
1164 noRdrEnvErr mod = ptext SLIT("No top-level environment available for module")
1165 <+> quotes (ppr mod)
1169 type GetInfoResult = (String, IfaceDecl, Fixity, SrcLoc,
1170 [(IfaceType,SrcLoc)] -- Instances
1173 tcRnLookupRdrName :: HscEnv -> RdrName -> IO (Maybe [Name])
1175 tcRnLookupRdrName hsc_env rdr_name
1176 = initTcPrintErrors hsc_env iNTERACTIVE $
1177 setInteractiveContext hsc_env (hsc_IC hsc_env) $
1178 lookup_rdr_name rdr_name
1181 lookup_rdr_name rdr_name = do {
1182 -- If the identifier is a constructor (begins with an
1183 -- upper-case letter), then we need to consider both
1184 -- constructor and type class identifiers.
1185 let { rdr_names = dataTcOccs rdr_name } ;
1187 -- results :: [(Messages, Maybe Name)]
1188 results <- mapM (tryTc . lookupOccRn) rdr_names ;
1190 traceRn (text "xx" <+> vcat [ppr rdr_names, ppr (map snd results)]);
1191 -- The successful lookups will be (Just name)
1192 let { (warns_s, good_names) = unzip [ (msgs, name)
1193 | (msgs, Just name) <- results] ;
1194 errs_s = [msgs | (msgs, Nothing) <- results] } ;
1196 -- Fail if nothing good happened, else add warnings
1197 if null good_names then
1198 -- No lookup succeeded, so
1199 -- pick the first error message and report it
1200 -- ToDo: If one of the errors is "could be Foo.X or Baz.X",
1201 -- while the other is "X is not in scope",
1202 -- we definitely want the former; but we might pick the latter
1203 do { addMessages (head errs_s) ; failM }
1204 else -- Add deprecation warnings
1205 mapM_ addMessages warns_s ;
1211 tcRnGetInfo :: HscEnv
1212 -> InteractiveContext
1214 -> IO (Maybe [GetInfoResult])
1216 -- Used to implemnent :info in GHCi
1218 -- Look up a RdrName and return all the TyThings it might be
1219 -- A capitalised RdrName is given to us in the DataName namespace,
1220 -- but we want to treat it as *both* a data constructor
1221 -- *and* as a type or class constructor;
1222 -- hence the call to dataTcOccs, and we return up to two results
1223 tcRnGetInfo hsc_env ictxt rdr_name
1224 = initTcPrintErrors hsc_env iNTERACTIVE $
1225 setInteractiveContext hsc_env ictxt $ do {
1227 -- Load the interface for all unqualified types and classes
1228 -- That way we will find all the instance declarations
1229 -- (Packages have not orphan modules, and we assume that
1230 -- in the home package all relevant modules are loaded.)
1231 loadUnqualIfaces ictxt ;
1233 good_names <- lookup_rdr_name rdr_name ;
1235 -- And lookup up the entities, avoiding duplicates, which arise
1236 -- because constructors and record selectors are represented by
1237 -- their parent declaration
1238 let { do_one name = do { thing <- tcLookupGlobal name
1239 ; fixity <- lookupFixityRn name
1240 ; ispecs <- lookupInsts print_unqual thing
1241 ; return (str, toIfaceDecl ext_nm thing, fixity,
1243 [(toIfaceType ext_nm (idType dfun), getSrcLoc dfun)
1244 | dfun <- map instanceDFunId ispecs ]
1247 -- str is the the naked occurrence name
1248 -- after stripping off qualification and parens (+)
1249 str = occNameUserString (nameOccName name)
1252 -- For the SrcLoc, the 'thing' has better info than
1253 -- the 'name' because getting the former forced the
1254 -- declaration to be loaded into the cache
1256 results <- mapM do_one good_names ;
1257 return (fst (removeDups cmp results))
1260 cmp (_,d1,_,_,_) (_,d2,_,_,_) = ifName d1 `compare` ifName d2
1261 ext_nm = interactiveExtNameFun print_unqual
1262 print_unqual = icPrintUnqual ictxt
1264 lookupInsts :: PrintUnqualified -> TyThing -> TcM [Instance]
1265 -- Filter the instances by the ones whose tycons (or clases resp)
1266 -- are in scope unqualified. Otherwise we list a whole lot too many!
1267 lookupInsts print_unqual (AClass cls)
1268 = do { inst_envs <- tcGetInstEnvs
1270 | ispec <- classInstances inst_envs cls
1271 , plausibleDFun print_unqual (instanceDFunId ispec) ] }
1273 lookupInsts print_unqual (ATyCon tc)
1274 = do { eps <- getEps -- Load all instances for all classes that are
1275 -- in the type environment (which are all the ones
1276 -- we've seen in any interface file so far)
1277 ; (pkg_ie, home_ie) <- tcGetInstEnvs -- Search all
1279 | ispec <- instEnvElts home_ie ++ instEnvElts pkg_ie
1280 , let dfun = instanceDFunId ispec
1282 , plausibleDFun print_unqual dfun ] }
1284 relevant df = tc_name `elemNameSet` tyClsNamesOfDFunHead (idType df)
1285 tc_name = tyConName tc
1287 lookupInsts print_unqual other = return []
1289 plausibleDFun print_unqual dfun -- Dfun involving only names that print unqualified
1290 = all ok (nameSetToList (tyClsNamesOfType (idType dfun)))
1292 ok name | isExternalName name = print_unqual (nameModule name) (nameOccName name)
1295 toIfaceDecl :: (Name -> IfaceExtName) -> TyThing -> IfaceDecl
1296 toIfaceDecl ext_nm thing
1297 = tyThingToIfaceDecl ext_nm (munge thing)
1299 -- munge transforms a thing to its "parent" thing
1300 munge (ADataCon dc) = ATyCon (dataConTyCon dc)
1301 munge (AnId id) = case globalIdDetails id of
1302 RecordSelId tc lbl -> ATyCon tc
1303 ClassOpId cls -> AClass cls
1305 munge other_thing = other_thing
1307 loadUnqualIfaces :: InteractiveContext -> TcM ()
1308 -- Load the home module for everything that is in scope unqualified
1309 -- This is so that we can accurately report the instances for
1311 loadUnqualIfaces ictxt
1313 mapM_ (loadSysInterface doc) (moduleSetElts (mkModuleSet unqual_mods))
1315 unqual_mods = [ nameModule name
1316 | gre <- globalRdrEnvElts (ic_rn_gbl_env ictxt),
1317 let name = gre_name gre,
1318 isTcOcc (nameOccName name), -- Types and classes only
1319 unQualOK gre ] -- In scope unqualified
1320 doc = ptext SLIT("Need interface for module whose export(s) are in scope unqualified")
1324 %************************************************************************
1328 %************************************************************************
1331 rnDump :: SDoc -> TcRn ()
1332 -- Dump, with a banner, if -ddump-rn
1333 rnDump doc = do { dumpOptTcRn Opt_D_dump_rn (mkDumpDoc "Renamer" doc) }
1335 tcDump :: TcGblEnv -> TcRn ()
1337 = do { dflags <- getDOpts ;
1339 -- Dump short output if -ddump-types or -ddump-tc
1340 ifM (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
1341 (dumpTcRn short_dump) ;
1343 -- Dump bindings if -ddump-tc
1344 dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump)
1347 short_dump = pprTcGblEnv env
1348 full_dump = pprLHsBinds (tcg_binds env)
1349 -- NB: foreign x-d's have undefined's in their types;
1350 -- hence can't show the tc_fords
1353 = do { dflags <- getDOpts ;
1354 ifM (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
1355 (dumpTcRn (pprModGuts mod_guts)) ;
1357 -- Dump bindings if -ddump-tc
1358 dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump) }
1360 full_dump = pprCoreBindings (mg_binds mod_guts)
1362 -- It's unpleasant having both pprModGuts and pprModDetails here
1363 pprTcGblEnv :: TcGblEnv -> SDoc
1364 pprTcGblEnv (TcGblEnv { tcg_type_env = type_env,
1365 tcg_insts = dfun_ids,
1367 tcg_imports = imports })
1368 = vcat [ ppr_types dfun_ids type_env
1369 , ppr_insts dfun_ids
1370 , vcat (map ppr rules)
1371 , ppr_gen_tycons (typeEnvTyCons type_env)
1372 , ptext SLIT("Dependent modules:") <+> ppr (moduleEnvElts (imp_dep_mods imports))
1373 , ptext SLIT("Dependent packages:") <+> ppr (imp_dep_pkgs imports)]
1375 pprModGuts :: ModGuts -> SDoc
1376 pprModGuts (ModGuts { mg_types = type_env,
1378 = vcat [ ppr_types [] type_env,
1382 ppr_types :: [Instance] -> TypeEnv -> SDoc
1383 ppr_types ispecs type_env
1384 = text "TYPE SIGNATURES" $$ nest 4 (ppr_sigs ids)
1386 dfun_ids = map instanceDFunId ispecs
1387 ids = [id | id <- typeEnvIds type_env, want_sig id]
1388 want_sig id | opt_PprStyle_Debug = True
1389 | otherwise = isLocalId id &&
1390 isExternalName (idName id) &&
1391 not (id `elem` dfun_ids)
1392 -- isLocalId ignores data constructors, records selectors etc.
1393 -- The isExternalName ignores local dictionary and method bindings
1394 -- that the type checker has invented. Top-level user-defined things
1395 -- have External names.
1397 ppr_insts :: [Instance] -> SDoc
1398 ppr_insts [] = empty
1399 ppr_insts ispecs = text "INSTANCES" $$ nest 2 (pprInstances ispecs)
1401 ppr_sigs :: [Var] -> SDoc
1403 -- Print type signatures; sort by OccName
1404 = vcat (map ppr_sig (sortLe le_sig ids))
1406 le_sig id1 id2 = getOccName id1 <= getOccName id2
1407 ppr_sig id = ppr id <+> dcolon <+> ppr (tidyTopType (idType id))
1409 ppr_rules :: [CoreRule] -> SDoc
1410 ppr_rules [] = empty
1411 ppr_rules rs = vcat [ptext SLIT("{-# RULES"),
1412 nest 4 (pprRules rs),
1415 ppr_gen_tycons [] = empty
1416 ppr_gen_tycons tcs = vcat [ptext SLIT("Tycons with generics:"),
1417 nest 2 (fsep (map ppr (filter tyConHasGenerics tcs)))]