Significant clean-up of the handling of hi-boot files.
Previously, when compling A.hs, we loaded A.hi-boot, and
it went into the External Package Table. It was strange
but it worked. This tidy up stops it going anywhere;
it's just read in, and typechecked into a ModDetails.
All this was on the way to improving the handling of
instances in hs-boot files, something Chris Ryder wanted.
I think they work quite sensibly now.
If I've got all this right (have not had a chance to
fully test it) we can merge it into STABLE.
module IfaceEnv (
newGlobalBinder, newIPName, newImplicitBinder,
lookupIfaceTop, lookupIfaceExt,
- lookupOrig, lookupAvail, lookupIfaceTc,
+ lookupOrig, lookupIfaceTc,
newIfaceName, newIfaceNames,
extendIfaceIdEnv, extendIfaceTyVarEnv,
tcIfaceLclId, tcIfaceTyVar,
+ lookupAvail, ifaceExportNames,
+
-- Name-cache stuff
allocateGlobalBinder, initNameCache,
) where
import TcRnMonad
import IfaceType ( IfaceExtName(..), IfaceTyCon(..), ifaceTyConName )
import TysWiredIn ( tupleTyCon, tupleCon )
-import HscTypes ( NameCache(..), HscEnv(..), GenAvailInfo(..), OrigNameCache )
+import HscTypes ( NameCache(..), HscEnv(..), GenAvailInfo(..),
+ IfaceExport, OrigNameCache )
import TyCon ( TyCon, tyConName )
import DataCon ( dataConWorkId, dataConName )
import Var ( TyVar, Id, varName )
getOccName, nameParent_maybe,
isWiredInName, mkIPName,
mkExternalName, mkInternalName )
-
+import NameSet ( NameSet, emptyNameSet, addListToNameSet )
import OccName ( OccName, isTupleOcc_maybe, tcName, dataName,
lookupOccEnv, unitOccEnv, extendOccEnv, extendOccEnvList )
import PrelNames ( gHC_PRIM, pREL_TUP )
Just parent_name -> parent_name
Nothing -> base_name
+ifaceExportNames :: [IfaceExport] -> TcRnIf gbl lcl NameSet
+ifaceExportNames exports
+ = foldlM do_one emptyNameSet exports
+ where
+ do_one acc (mod, exports) = foldlM (do_avail mod) acc exports
+ do_avail mod acc avail = do { ns <- lookupAvail mod avail
+ ; return (addListToNameSet acc ns) }
+
lookupAvail :: Module -> GenAvailInfo OccName -> TcRnIf a b [Name]
-- Find all the names arising from an import
-- Make sure the parent info is correct, even though we may not
\begin{code}
module LoadIface (
loadHomeInterface, loadInterface, loadDecls,
- loadSrcInterface, loadOrphanModules, loadHiBootInterface,
- readIface, -- Used when reading the module's old interface
+ loadSrcInterface, loadOrphanModules,
+ findAndReadIface, readIface, -- Used when reading the module's old interface
predInstGates, ifaceInstGates, ifaceStats, discardDeclPrags,
initExternalPackageState
) where
-- This is called for each 'import' declaration in the source code
-- On a failure, fail in the monad with an error message
-loadSrcInterface doc mod_name want_boot
- = do { mb_iface <- initIfaceTcRn $ loadInterface doc mod_name
- (ImportByUser want_boot)
+loadSrcInterface doc mod want_boot
+ = do { mb_iface <- initIfaceTcRn $
+ loadInterface doc mod (ImportByUser want_boot)
; case mb_iface of
- Failed err -> failWithTc (elaborate err)
+ Failed err -> failWithTc (elaborate err)
Succeeded iface -> return iface
}
where
elaborate err = hang (ptext SLIT("Failed to load interface for") <+>
- quotes (ppr mod_name) <> colon) 4 err
-
-loadHiBootInterface :: TcRn [Name]
--- Load the hi-boot iface for the module being compiled,
--- if it indeed exists in the transitive closure of imports
--- Return the list of names exported by the hi-boot file
-loadHiBootInterface
- = do { eps <- getEps
- ; mod <- getModule
-
- ; traceIf (text "loadHiBootInterface" <+> ppr mod)
-
- -- We're read all the direct imports by now, so eps_is_boot will
- -- record if any of our imports mention us by way of hi-boot file
- ; case lookupModuleEnv (eps_is_boot eps) mod of {
- Nothing -> return [] ; -- The typical case
-
- Just (_, False) -> -- Someone below us imported us!
- -- This is a loop with no hi-boot in the way
- failWithTc (moduleLoop mod) ;
-
- Just (mod_nm, True) -> -- There's a hi-boot interface below us
-
-
- do { -- Load it (into the PTE), and return the exported names
- iface <- loadSrcInterface (mk_doc mod_nm) mod_nm True
- ; ns_s <- sequenceM [ lookupAvail mod_nm avail
- | (mod,avails) <- mi_exports iface,
- avail <- avails ]
- ; return (concat ns_s)
- }}}
- where
- mk_doc mod = ptext SLIT("Need the hi-boot interface for") <+> ppr mod
- <+> ptext SLIT("to compare against the Real Thing")
-
- moduleLoop mod = ptext SLIT("Circular imports: module") <+> quotes (ppr mod)
- <+> ptext SLIT("depends on itself")
+ quotes (ppr mod) <> colon) 4 err
loadOrphanModules :: [Module] -> TcM ()
loadOrphanModules mods
-> SDoc -> Module
-> IsBootInterface -- True <=> Look for a .hi-boot file
-- False <=> Look for .hi file
- -> IfM lcl (MaybeErr Message (ModIface, FilePath))
+ -> TcRnIf gbl lcl (MaybeErr Message (ModIface, FilePath))
-- Nothing <=> file not found, or unreadable, or illegible
-- Just x <=> successfully found and parsed
\begin{code}
readIface :: Module -> String -> IsBootInterface
- -> IfM lcl (MaybeErr Message ModIface)
+ -> TcRnIf gbl lcl (MaybeErr Message ModIface)
-- Failed err <=> file not found, or unreadable, or illegible
-- Succeeded iface <=> successfully found and parsed
\begin{code}
module TcIface (
- tcImportDecl, typecheckIface, tcIfaceDecl, tcIfaceGlobal,
+ tcImportDecl, tcHiBootIface, typecheckIface,
+ tcIfaceDecl, tcIfaceGlobal,
loadImportedInsts, loadImportedRules,
tcExtCoreBindings
) where
import IfaceSyn
import LoadIface ( loadHomeInterface, loadInterface, predInstGates,
- loadDecls )
+ loadDecls, findAndReadIface )
import IfaceEnv ( lookupIfaceTop, lookupIfaceExt, newGlobalBinder,
extendIfaceIdEnv, extendIfaceTyVarEnv, newIPName,
- tcIfaceTyVar, tcIfaceLclId,
- newIfaceName, newIfaceNames )
+ tcIfaceTyVar, tcIfaceLclId,
+ newIfaceName, newIfaceNames, ifaceExportNames )
import BuildTyCl ( buildSynTyCon, buildAlgTyCon, buildDataCon, buildClass,
mkAbstractTyConRhs, mkDataTyConRhs, mkNewTyConRhs )
import TcRnMonad
import HscTypes ( ExternalPackageState(..), EpsStats(..), PackageInstEnv,
HscEnv, TyThing(..), tyThingClass, tyThingTyCon,
ModIface(..), ModDetails(..), ModGuts,
+ emptyModDetails,
extendTypeEnv, lookupTypeEnv, lookupType, typeEnvIds )
import InstEnv ( extendInstEnvList )
import CoreSyn
isWiredInName, wiredInNameTyThing_maybe, nameParent )
import NameEnv
import OccName ( OccName )
-import Module ( Module )
+import Module ( Module, lookupModuleEnv )
import UniqSupply ( initUs_ )
import Outputable
import ErrUtils ( Message )
and even if they were, the type decls might be mutually recursive.
\begin{code}
-typecheckIface :: HscEnv
- -> ModIface -- Get the decls from here
- -> IO ModDetails
-typecheckIface hsc_env iface
- = initIfaceTc hsc_env iface $ \ tc_env_var -> do
+typecheckIface :: ModIface -- Get the decls from here
+ -> TcRnIf gbl lcl ModDetails
+typecheckIface iface
+ = initIfaceTc iface $ \ tc_env_var -> do
+ -- The tc_env_var is freshly allocated, private to
+ -- type-checking this particular interface
{ -- Get the right set of decls and rules. If we are compiling without -O
-- we discard pragmas before typechecking, so that we don't "see"
-- information that we shouldn't. From a versioning point of view
; dfuns <- mapM tcIfaceInst dfuns
; rules <- mapM tcIfaceRule rules
+ -- Exports
+ ; exports <- ifaceExportNames (mi_exports iface)
+
-- Finished
- ; return (ModDetails { md_types = type_env, md_insts = dfuns, md_rules = rules })
+ ; return (ModDetails { md_types = type_env,
+ md_insts = dfuns,
+ md_rules = rules,
+ md_exports = exports })
}
\end{code}
%* *
%************************************************************************
+\begin{code}
+tcHiBootIface :: Module -> TcRn ModDetails
+-- Load the hi-boot iface for the module being compiled,
+-- if it indeed exists in the transitive closure of imports
+-- Return the ModDetails, empty if no hi-boot iface
+tcHiBootIface mod
+ = do { traceIf (text "loadHiBootInterface" <+> ppr mod)
+
+ -- We're read all the direct imports by now, so eps_is_boot will
+ -- record if any of our imports mention us by way of hi-boot file
+ ; eps <- getEps
+ ; case lookupModuleEnv (eps_is_boot eps) mod of {
+ Nothing -> return emptyModDetails ; -- The typical case
+
+ Just (_, False) -> failWithTc moduleLoop ;
+ -- Someone below us imported us!
+ -- This is a loop with no hi-boot in the way
+
+ Just (mod, True) -> -- There's a hi-boot interface below us
+
+ do { read_result <- findAndReadIface
+ True -- Explicit import?
+ need mod
+ True -- Hi-boot file
+
+ ; case read_result of
+ Failed err -> failWithTc (elaborate err)
+ Succeeded (iface, _path) -> typecheckIface iface
+ }}}
+ where
+ need = ptext SLIT("Need the hi-boot interface for") <+> ppr mod
+ <+> ptext SLIT("to compare against the Real Thing")
+
+ moduleLoop = ptext SLIT("Circular imports: module") <+> quotes (ppr mod)
+ <+> ptext SLIT("depends on itself")
+
+ elaborate err = hang (ptext SLIT("Could not find hi-boot interface for") <+>
+ quotes (ppr mod) <> colon) 4 err
+\end{code}
+
+
+%************************************************************************
+%* *
+ Type and class declarations
+%* *
+%************************************************************************
+
When typechecking a data type decl, we *lazily* (via forkM) typecheck
the constructor argument types. This is in the hope that we may never
poke on those argument types, and hence may never need to load the
import Lexer ( P(..), ParseResult(..), mkPState )
import SrcLoc ( mkSrcLoc )
import TcRnDriver ( tcRnModule, tcRnExtCore )
-import TcRnTypes ( TcGblEnv(..) )
import TcIface ( typecheckIface )
+import TcRnMonad ( initIfaceCheck, TcGblEnv(..) )
import IfaceEnv ( initNameCache )
import LoadIface ( ifaceStats, initExternalPackageState )
import PrelInfo ( wiredInThings, basicKnownKeyNames )
"Skipping " ++ showModMsg have_object mod_summary)
; new_details <- {-# SCC "tcRnIface" #-}
- typecheckIface hsc_env old_iface ;
+ initIfaceCheck hsc_env $
+ typecheckIface old_iface ;
; dumpIfaceStats hsc_env
; return (HscNoRecomp new_details old_iface)
module RnNames (
rnImports, importsFromLocalDecls,
reportUnusedNames, reportDeprecations,
- mkModDeps, exportsToAvails, exportsFromAvail
+ mkModDeps, exportsFromAvail
) where
#include "HsVersions.h"
Sig(..), collectGroupBinders, tyClDeclNames
)
import RnEnv
-import IfaceEnv ( lookupAvail )
+import IfaceEnv ( ifaceExportNames )
import LoadIface ( loadSrcInterface )
import TcRnMonad
is_loc = loc, is_as = qual_mod_name }
in
-- Get the total imports, and filter them according to the import list
- exportsToAvails filtered_exports `thenM` \ total_avails ->
+ ifaceExportNames filtered_exports `thenM` \ total_avails ->
filterImports iface imp_spec
imp_details total_avails `thenM` \ (avail_env, gbl_env) ->
returnM (gbl_env, imports)
-exportsToAvails :: [IfaceExport] -> TcRnIf gbl lcl NameSet
-exportsToAvails exports
- = foldlM do_one emptyNameSet exports
- where
- do_one acc (mod, exports) = foldlM (do_avail mod) acc exports
- do_avail mod acc avail = do { ns <- lookupAvail mod avail
- ; return (addListToNameSet acc ns) }
-
warnRedundantSourceImport mod_name
= ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
<+> quotes (ppr mod_name)
\begin{code}
newDFunName :: Class -> [Type] -> SrcLoc -> TcM Name
newDFunName clas (ty:_) loc
- = newUnique `thenM` \ uniq ->
- returnM (mkInternalName uniq (mkDFunOcc dfun_string) loc)
+ = do { uniq <- newUnique
+ ; return (mkInternalName uniq (mkDFunOcc dfun_string) loc) }
where
-- Any string that is somewhat unique will do
dfun_string = occNameString (getOccName clas) ++ occNameString (getDFunTyKey ty)
import InstEnv ( extendInstEnvList )
import TcBinds ( tcTopBinds, tcHsBootSigs )
import TcDefaults ( tcDefaults )
-import TcEnv ( tcExtendGlobalValEnv )
+import TcEnv ( tcExtendGlobalValEnv, iDFunId )
import TcRules ( tcRules )
import TcForeign ( tcForeignImports, tcForeignExports )
import TcInstDcls ( tcInstDecls1, tcInstDecls2 )
-import TcIface ( tcExtCoreBindings )
+import TcIface ( tcExtCoreBindings, tcHiBootIface )
import TcSimplify ( tcSimplifyTop )
import TcTyClsDecls ( tcTyAndClassDecls )
-import LoadIface ( loadOrphanModules, loadHiBootInterface )
+import LoadIface ( loadOrphanModules )
import RnNames ( importsFromLocalDecls, rnImports, exportsFromAvail,
reportUnusedNames, reportDeprecations )
import RnEnv ( lookupSrcOcc_maybe )
import Var ( Var )
import Module ( Module, ModuleEnv, mkModule, moduleEnvElts, lookupModuleEnv )
import OccName ( mkVarOcc )
-import Name ( Name, isExternalName, getSrcLoc, getOccName, isWiredInName )
+import Name ( Name, NamedThing(..), isExternalName, getSrcLoc,
+ getOccName, isWiredInName )
import NameSet
import TyCon ( tyConHasGenerics, isSynTyCon, getSynTyConDefn, tyConKind )
import SrcLoc ( srcLocSpan, Located(..), noLoc )
import DriverPhases ( HscSource(..), isHsBoot )
-import HscTypes ( ModGuts(..), HscEnv(..), ExternalPackageState(..),
+import HscTypes ( ModGuts(..), ModDetails(..), emptyModDetails,
+ HscEnv(..), ExternalPackageState(..),
IsBootInterface, noDependencies,
Deprecs( NoDeprecs ), plusDeprecs,
ForeignStubs(NoStubs), TyThing(..),
- TypeEnv, lookupTypeEnv, hptInstances, lookupType,
- extendTypeEnvWithIds, typeEnvIds, typeEnvTyCons,
+ TypeEnv, lookupTypeEnv, hptInstances,
+ extendTypeEnvWithIds, typeEnvIds, typeEnvTyCons, typeEnvElts,
emptyFixityEnv
)
import Outputable
import Inst ( tcGetInstEnvs )
import InstEnv ( DFunId, classInstances, instEnvElts )
import RnExpr ( rnStmts, rnLExpr )
-import RnNames ( exportsToAvails )
import LoadIface ( loadSrcInterface, ifaceInstGates )
import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..),
IfaceExtName(..), IfaceConDecls(..), IfaceInst(..),
tyThingToIfaceDecl, dfunToIfaceInst )
import IfaceType ( IfaceTyCon(..), IfaceType, toIfaceType,
interactiveExtNameFun, isLocalIfaceExtName )
-import IfaceEnv ( lookupOrig )
+import IfaceEnv ( lookupOrig, ifaceExportNames )
import RnEnv ( lookupOccRn, dataTcOccs, lookupFixityRn )
import Id ( Id, isImplicitId, setIdType, globalIdDetails )
import MkId ( unsafeCoerceId )
-- Typecheck them all together so that
-- any mutually recursive types are done right
- tcg_env <- checkNoErrs (tcTyAndClassDecls [{- no boot names -}] rn_decls) ;
+ tcg_env <- checkNoErrs (tcTyAndClassDecls emptyModDetails rn_decls) ;
-- Make the new type env available to stuff slurped from interface files
setGblEnv tcg_env $ do {
-- We do this now so that the boot_names can be passed
-- to tcTyAndClassDecls, because the boot_names are
-- automatically considered to be loop breakers
- boot_names <- loadHiBootInterface ;
+ mod <- getModule ;
+ boot_iface <- tcHiBootIface mod ;
-- Do all the declarations
- (tc_envs, lie) <- getLIE (tc_rn_src_decls boot_names decls) ;
+ (tc_envs, lie) <- getLIE (tc_rn_src_decls boot_iface decls) ;
-- tcSimplifyTop deals with constant or ambiguous InstIds.
-- How could there be ambiguous ones? They can only arise if a
(bind_ids, binds', fords', rules') <- zonkTopDecls (binds `unionBags` inst_binds)
rules fords ;
- let { final_type_env = extendTypeEnvWithIds type_env bind_ids } ;
+ let { final_type_env = extendTypeEnvWithIds type_env bind_ids
+ ; tcg_env' = tcg_env { tcg_type_env = final_type_env,
+ tcg_binds = binds', tcg_rules = rules',
+ tcg_fords = fords' } } ;
- -- Compre the hi-boot iface (if any) with the real thing
- checkHiBootIface final_type_env boot_names ;
+ -- Compare the hi-boot iface (if any) with the real thing
+ checkHiBootIface tcg_env' boot_iface ;
-- Make the new type env available to stuff slurped from interface files
writeMutVar (tcg_type_env_var tcg_env) final_type_env ;
- return (tcg_env { tcg_type_env = final_type_env,
- tcg_binds = binds', tcg_rules = rules', tcg_fords = fords' })
+ return tcg_env'
}
-tc_rn_src_decls :: [Name] -> [LHsDecl RdrName] -> TcM (TcGblEnv, TcLclEnv)
+tc_rn_src_decls :: ModDetails -> [LHsDecl RdrName] -> TcM (TcGblEnv, TcLclEnv)
-- Loops around dealing with each top level inter-splice group
-- in turn, until it's dealt with the entire module
-tc_rn_src_decls boot_names ds
+tc_rn_src_decls boot_details ds
= do { let { (first_group, group_tail) = findSplice ds } ;
-- If ds is [] we get ([], Nothing)
-- Type check the decls up to, but not including, the first splice
- tc_envs@(tcg_env,tcl_env) <- tcRnGroup boot_names first_group ;
+ tc_envs@(tcg_env,tcl_env) <- tcRnGroup boot_details first_group ;
-- Bale out if errors; for example, error recovery when checking
-- the RHS of 'main' can mean that 'main' is not in the envt for
-- Glue them on the front of the remaining decls and loop
setGblEnv (tcg_env `addTcgDUs` usesOnly splice_fvs) $
- tc_rn_src_decls boot_names (spliced_decls ++ rest_ds)
+ tc_rn_src_decls boot_details (spliced_decls ++ rest_ds)
#endif /* GHCI */
}}}
\end{code}
-- Typecheck type/class decls
; traceTc (text "Tc2")
; let tycl_decls = hs_tyclds rn_group
- ; tcg_env <- checkNoErrs (tcTyAndClassDecls [{- no boot_names -}] tycl_decls)
+ ; tcg_env <- checkNoErrs (tcTyAndClassDecls emptyModDetails tycl_decls)
; setGblEnv tcg_env $ do {
-- Typecheck instance decls
-- Typecheck value declarations
; traceTc (text "Tc5")
- ; new_ids <- tcHsBootSigs (hs_valds rn_group)
+ ; val_ids <- tcHsBootSigs (hs_valds rn_group)
-- Wrap up
-- No simplification or zonking to do
; traceTc (text "Tc7a")
; gbl_env <- getGblEnv
- ; let { final_type_env = extendTypeEnvWithIds (tcg_type_env gbl_env) new_ids }
- ; return (gbl_env { tcg_type_env = final_type_env })
+ -- Make the final type-env
+ -- Include the dfun_ids so that their type sigs get
+ -- are written into the interface file
+ ; let { type_env0 = tcg_type_env gbl_env
+ ; type_env1 = extendTypeEnvWithIds type_env0 val_ids
+ ; type_env2 = extendTypeEnvWithIds type_env1 dfun_ids
+ ; dfun_ids = map iDFunId inst_infos }
+ ; return (gbl_env { tcg_type_env = type_env2 })
}}}}
spliceInHsBootErr (SpliceDecl (L loc _), _)
the hi-boot interface as our checklist.
\begin{code}
-checkHiBootIface :: TypeEnv -> [Name] -> TcM ()
+checkHiBootIface :: TcGblEnv -> ModDetails -> TcM ()
-- Compare the hi-boot file for this module (if there is one)
-- with the type environment we've just come up with
-- In the common case where there is no hi-boot file, the list
-- of boot_names is empty.
-checkHiBootIface env boot_names
- = mapM_ (check_one env) boot_names
-
-----------------
-check_one local_env name
- | isWiredInName name -- No checking for wired-in names. In particular, 'error'
- = return () -- is handled by a rather gross hack (see comments in GHC.Err.hs-boot)
- | otherwise
- = do { (eps,hpt) <- getEpsAndHpt
-
- -- Look up the hi-boot one;
- -- it should jolly well be there (else GHC bug)
- ; case lookupType hpt (eps_PTE eps) name of {
- Nothing -> pprPanic "checkHiBootIface" (ppr name) ;
- Just boot_thing ->
-
- -- Look it up in the local type env
- -- It should be there, but it's a programmer error if not
- case lookupTypeEnv local_env name of
- Nothing -> addErrTc (missingBootThing boot_thing)
- Just real_thing -> check_thing boot_thing real_thing
- } }
+checkHiBootIface
+ (TcGblEnv { tcg_insts = local_insts, tcg_type_env = local_type_env })
+ (ModDetails { md_insts = boot_insts, md_types = boot_type_env })
+ = do { mapM_ check_inst boot_insts
+ ; mapM_ check_one (typeEnvElts boot_type_env) }
+ where
+ check_one boot_thing
+ | no_check name
+ = return ()
+ | otherwise
+ = case lookupTypeEnv local_type_env name of
+ Nothing -> addErrTc (missingBootThing boot_thing)
+ Just real_thing -> check_thing boot_thing real_thing
+ where
+ name = getName boot_thing
+
+ no_check name = isWiredInName name -- No checking for wired-in names. In particular,
+ -- 'error' is handled by a rather gross hack
+ -- (see comments in GHC.Err.hs-boot)
+ || name `elem` dfun_names
+ dfun_names = map getName boot_insts
+
+ check_inst inst
+ | null [i | i <- local_insts, idType i `tcEqType` idType inst]
+ = addErrTc (instMisMatch inst)
+ | otherwise
+ = return ()
----------------
check_thing (ATyCon boot_tc) (ATyCon real_tc)
= ppr thing <+> ptext SLIT("is defined in the hs-boot file, but not in the module")
bootMisMatch thing
= ppr thing <+> ptext SLIT("has conflicting definitions in the module and its hs-boot file")
+instMisMatch inst
+ = hang (ptext SLIT("instance") <+> ppr (idType inst))
+ 2 (ptext SLIT("is defined in the hs-boot file, but not in the module"))
\end{code}
monad; it augments it and returns the new TcGblEnv.
\begin{code}
-tcRnGroup :: [Name] -> HsGroup RdrName -> TcM (TcGblEnv, TcLclEnv)
+tcRnGroup :: ModDetails -> HsGroup RdrName -> TcM (TcGblEnv, TcLclEnv)
-- Returns the variables free in the decls, for unused-binding reporting
-tcRnGroup boot_names decls
+tcRnGroup boot_details decls
= do { -- Rename the declarations
(tcg_env, rn_decls) <- rnTopSrcDecls decls ;
setGblEnv tcg_env $ do {
-- Typecheck the declarations
- tcTopSrcDecls boot_names rn_decls
+ tcTopSrcDecls boot_details rn_decls
}}
------------------------------------------------
}}
------------------------------------------------
-tcTopSrcDecls :: [Name] -> HsGroup Name -> TcM (TcGblEnv, TcLclEnv)
-tcTopSrcDecls boot_names
+tcTopSrcDecls :: ModDetails -> HsGroup Name -> TcM (TcGblEnv, TcLclEnv)
+tcTopSrcDecls boot_details
(HsGroup { hs_tyclds = tycl_decls,
hs_instds = inst_decls,
hs_fords = foreign_decls,
-- The latter come in via tycl_decls
traceTc (text "Tc2") ;
- tcg_env <- checkNoErrs (tcTyAndClassDecls boot_names tycl_decls) ;
+ tcg_env <- checkNoErrs (tcTyAndClassDecls boot_details tycl_decls) ;
-- tcTyAndClassDecls recovers internally, but if anything gave rise to
-- an error we'd better stop now, to avoid a cascade
; loadOrphanModules (dep_orphs (mi_deps iface))
-- Load any orphan-module interfaces,
-- so their instances are visible
- ; names <- exportsToAvails (mi_exports iface)
+ ; names <- ifaceExportNames (mi_exports iface)
; let { gres = [ GRE { gre_name = name, gre_prov = vanillaProv mod }
| name <- nameSetToList names ] }
; returnM (mkGlobalRdrEnv gres) }
; initTcRnIf 'i' hsc_env gbl_env () do_this
}
-initIfaceTc :: HscEnv -> ModIface
- -> (TcRef TypeEnv -> IfL a) -> IO a
+initIfaceTc :: ModIface
+ -> (TcRef TypeEnv -> IfL a) -> TcRnIf gbl lcl a
-- Used when type-checking checking an up-to-date interface file
-- No type envt from the current module, but we do know the module dependencies
-initIfaceTc hsc_env iface do_this
- = do { tc_env_var <- newIORef emptyTypeEnv
+initIfaceTc iface do_this
+ = do { tc_env_var <- newMutVar emptyTypeEnv
; let { gbl_env = IfGblEnv { if_rec_types = Just (mod, readMutVar tc_env_var) } ;
; if_lenv = mkIfLclEnv mod doc
}
- ; initTcRnIf 'i' hsc_env gbl_env if_lenv (do_this tc_env_var)
+ ; setEnvs (gbl_env, if_lenv) (do_this tc_env_var)
}
where
mod = mi_module iface
import Name ( Name, NamedThing(..), nameOccName, nameModule, isExternalName,
mkInternalName, nameIsLocalOrFrom )
import NameEnv ( lookupNameEnv )
-import HscTypes ( lookupType, ExternalPackageState(..) )
+import HscTypes ( lookupType, ExternalPackageState(..), emptyModDetails )
import OccName
import Var ( Id, TyVar, idType )
import Module ( moduleUserString, mkModule )
-- Result type is Type (= Q Typ)
tc_bracket (DecBr decls)
- = tcTopSrcDecls [{- no boot-names -}] decls `thenM_`
+ = tcTopSrcDecls emptyModDetails decls `thenM_`
-- Typecheck the declarations, dicarding the result
-- We'll get all that stuff later, when we splice it in
)
import HsTypes ( HsBang(..), getBangStrictness )
import BasicTypes ( RecFlag(..), StrictnessMark(..) )
-import HscTypes ( implicitTyThings )
+import HscTypes ( implicitTyThings, ModDetails )
import BuildTyCl ( buildClass, buildAlgTyCon, buildSynTyCon, buildDataCon,
mkDataTyConRhs, mkNewTyConRhs )
import TcRnMonad
@TyThing@s. @rec_vrcs@ is a finite map from @Name@s to @ArgVrcs@s.
\begin{code}
-tcTyAndClassDecls :: [Name] -> [LTyClDecl Name]
+tcTyAndClassDecls :: ModDetails -> [LTyClDecl Name]
-> TcM TcGblEnv -- Input env extended by types and classes
-- and their implicit Ids,DataCons
-tcTyAndClassDecls boot_names decls
+tcTyAndClassDecls boot_details decls
= do { -- First check for cyclic type synonysm or classes
-- See notes with checkCycleErrs
checkCycleErrs decls
; mod <- getModule
- ; traceTc (text "tcTyAndCl" <+> ppr mod <+> ppr boot_names)
+ ; traceTc (text "tcTyAndCl" <+> ppr mod)
; (syn_tycons, alg_tyclss) <- fixM (\ ~(rec_syn_tycons, rec_alg_tyclss) ->
do { let { -- Calculate variances and rec-flag
; (syn_decls, alg_decls) = partition (isSynDecl . unLoc) decls }
{ (kc_syn_decls, kc_alg_decls) <- kcTyClDecls syn_decls alg_decls
; let { calc_vrcs = calcTyConArgVrcs (rec_syn_tycons ++ rec_alg_tyclss)
- ; calc_rec = calcRecFlags boot_names rec_alg_tyclss
+ ; calc_rec = calcRecFlags boot_details rec_alg_tyclss
; tc_decl = addLocM (tcTyClDecl calc_vrcs calc_rec) }
-- Type-check the type synonyms, and extend the envt
; syn_tycons <- tcSynDecls calc_vrcs kc_syn_decls
import HsSyn ( TyClDecl(..), HsPred(..), LTyClDecl, isClassDecl )
import RnHsSyn ( extractHsTyNames )
import Type ( predTypeRep )
-import HscTypes ( TyThing(..) )
+import HscTypes ( TyThing(..), ModDetails(..) )
import TyCon ( TyCon, ArgVrcs, tyConArity, tyConDataCons, tyConTyVars,
getSynTyConDefn, isSynTyCon, isAlgTyCon,
tyConName, isNewTyCon, isProductTyCon, tyConArgVrcs, newTyConRhs )
compiled, plus the outer structure of directly-mentioned types.
\begin{code}
-calcRecFlags :: [Name] -> [TyThing] -> (Name -> RecFlag)
+calcRecFlags :: ModDetails -> [TyThing] -> (Name -> RecFlag)
-- The 'boot_names' are the things declared in M.hi-boot, if M is the current module.
-- Any type constructors in boot_names are automatically considered loop breakers
-calcRecFlags boot_names tyclss
+calcRecFlags boot_details tyclss
= is_rec
where
is_rec n | n `elemNameSet` rec_names = Recursive
| otherwise = NonRecursive
- boot_name_set = mkNameSet boot_names
+ boot_name_set = md_exports boot_details
rec_names = boot_name_set `unionNameSets`
nt_loop_breakers `unionNameSets`
prod_loop_breakers