From: simonpj Date: Mon, 30 Oct 2000 17:18:28 +0000 (+0000) Subject: [project @ 2000-10-30 17:18:26 by simonpj] X-Git-Tag: Approximately_9120_patches~3464 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=256f3fb8b794549227f7476cf3882f634c3e0e7a;p=ghc-hetmet.git [project @ 2000-10-30 17:18:26 by simonpj] Renamer tidying up --- diff --git a/ghc/compiler/basicTypes/Module.lhs b/ghc/compiler/basicTypes/Module.lhs index 276a0e4..5c2b423 100644 --- a/ghc/compiler/basicTypes/Module.lhs +++ b/ghc/compiler/basicTypes/Module.lhs @@ -60,6 +60,8 @@ module Module , moduleEnvElts, unitModuleEnv, isEmptyModuleEnv, foldModuleEnv , lookupModuleEnvByName, extendModuleEnv_C + , ModuleSet, emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet + ) where #include "HsVersions.h" @@ -69,6 +71,7 @@ import CmdLineOpts ( opt_InPackage ) import FastString ( FastString, uniqueOfFS ) import Unique ( Uniquable(..), mkUniqueGrimily ) import UniqFM +import UniqSet \end{code} @@ -317,3 +320,19 @@ unitModuleEnv = unitUFM isEmptyModuleEnv = isNullUFM foldModuleEnv = foldUFM \end{code} + +\begin{code} + +type ModuleSet = UniqSet Module +mkModuleSet :: [Module] -> ModuleSet +extendModuleSet :: ModuleSet -> Module -> ModuleSet +emptyModuleSet :: ModuleSet +moduleSetElts :: ModuleSet -> [Module] +elemModuleSet :: Module -> ModuleSet -> Bool + +emptyModuleSet = emptyUniqSet +mkModuleSet = mkUniqSet +extendModuleSet = addOneToUniqSet +moduleSetElts = uniqSetToList +elemModuleSet = elementOfUniqSet +\end{code} diff --git a/ghc/compiler/deSugar/DsMonad.lhs b/ghc/compiler/deSugar/DsMonad.lhs index ecddeb4..bca30af 100644 --- a/ghc/compiler/deSugar/DsMonad.lhs +++ b/ghc/compiler/deSugar/DsMonad.lhs @@ -40,7 +40,7 @@ import Unique ( Unique ) import Util ( zipWithEqual ) import Name ( Name, lookupNameEnv ) import HscTypes ( HomeSymbolTable, PersistentCompilerState(..), - TyThing(..), TypeEnv, lookupTypeEnv ) + TyThing(..), TypeEnv, lookupType ) import CmdLineOpts ( DynFlags ) infixr 9 `thenDs` @@ -82,17 +82,14 @@ initDs dflags init_us (hst,pcs,local_type_env) mod action -- such as fold, build, cons etc, so the chances are -- it'll be found in the package symbol table. That's -- why we don't merge all these tables - pst = pcs_PST pcs - lookup n = case lookupTypeEnv pst n of { - Just (AnId v) -> v ; - other -> - case lookupTypeEnv hst n of { + pte = pcs_PTE pcs + lookup n = case lookupType hst pte n of { Just (AnId v) -> v ; other -> case lookupNameEnv local_type_env n of Just (AnId v) -> v ; other -> pprPanic "initDS: lookup:" (ppr n) - }} + } thenDs :: DsM a -> (a -> DsM b) -> DsM b andDs :: (a -> a -> a) -> DsM a -> DsM a -> DsM a diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index 49e5297..db3f9d7 100644 --- a/ghc/compiler/main/HscMain.lhs +++ b/ghc/compiler/main/HscMain.lhs @@ -20,7 +20,7 @@ import SrcLoc ( mkSrcLoc ) import Rename ( renameModule, checkOldIface, closeIfaceDecls ) import Rules ( emptyRuleBase ) -import PrelInfo ( wiredInThings ) +import PrelInfo ( wiredInThingEnv, wiredInThings ) import PrelNames ( knownKeyNames ) import PrelRules ( builtinRules ) import MkIface ( completeIface, mkModDetailsFromIface, mkModDetails, @@ -38,7 +38,7 @@ import SimplStg ( stg2stg ) import CodeGen ( codeGen ) import CodeOutput ( codeOutput ) -import Module ( ModuleName, moduleName, emptyModuleEnv, mkModuleInThisPackage ) +import Module ( ModuleName, moduleName, mkModuleInThisPackage ) import CmdLineOpts import ErrUtils ( dumpIfSet_dyn ) import UniqSupply ( mkSplitUniqSupply ) @@ -49,9 +49,8 @@ import StgInterp ( stgToInterpSyn ) import HscStats ( ppSourceStats ) import HscTypes ( ModDetails, ModIface(..), PersistentCompilerState(..), PersistentRenamerState(..), ModuleLocation(..), - HomeSymbolTable, PackageSymbolTable, + HomeSymbolTable, OrigNameEnv(..), PackageRuleBase, HomeIfaceTable, - extendTypeEnv, groupTyThings, typeEnvClasses, typeEnvTyCons, emptyIfaceTable ) import InterpSyn ( UnlinkedIBind ) import StgInterp ( ItblEnv ) @@ -356,18 +355,13 @@ initPersistentCompilerState = do prs <- initPersistentRenamerState return ( PCS { pcs_PIT = emptyIfaceTable, - pcs_PST = initPackageDetails, + pcs_PTE = wiredInThingEnv, pcs_insts = emptyInstEnv, pcs_rules = emptyRuleBase, pcs_PRS = prs } ) -initPackageDetails :: PackageSymbolTable -initPackageDetails = extendTypeEnv emptyModuleEnv (groupTyThings wiredInThings) - ---initPackageDetails = panic "initPackageDetails" - initPersistentRenamerState :: IO PersistentRenamerState = do ns <- mkSplitUniqSupply 'r' return ( diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 1d6e371..1f97736 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -7,18 +7,19 @@ module HscTypes ( ModuleLocation(..), - ModDetails(..), ModIface(..), GlobalSymbolTable, - HomeSymbolTable, PackageSymbolTable, + ModDetails(..), ModIface(..), + HomeSymbolTable, PackageTypeEnv, HomeIfaceTable, PackageIfaceTable, emptyIfaceTable, lookupTable, lookupTableByModName, + emptyModIface, IfaceDecls(..), VersionInfo(..), initialVersionInfo, - TyThing(..), groupTyThings, isTyClThing, + TyThing(..), isTyClThing, - TypeEnv, extendTypeEnv, lookupTypeEnv, + TypeEnv, lookupType, mkTypeEnv, extendTypeEnvList, typeEnvClasses, typeEnvTyCons, WhetherHasOrphans, ImportVersion, WhatsImported(..), @@ -45,13 +46,13 @@ module HscTypes ( import RdrName ( RdrNameEnv, emptyRdrEnv ) import Name ( Name, NameEnv, NamedThing, - emptyNameEnv, unitNameEnv, extendNameEnv, plusNameEnv, + emptyNameEnv, extendNameEnv, lookupNameEnv, emptyNameEnv, getName, nameModule, nameSrcLoc, nameEnvElts ) import NameSet ( NameSet ) import OccName ( OccName ) import Module ( Module, ModuleName, ModuleEnv, - extendModuleEnv, lookupModuleEnv, lookupModuleEnvByName + lookupModuleEnv, lookupModuleEnvByName ) import Rules ( RuleBase ) import VarSet ( TyVarSet ) @@ -68,7 +69,7 @@ import RnHsSyn ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl ) import CoreSyn ( IdCoreRule ) import Type ( Type ) -import FiniteMap ( FiniteMap, emptyFM, addToFM, lookupFM, foldFM ) +import FiniteMap ( FiniteMap ) import Bag ( Bag ) import Maybes ( seqMaybe ) import UniqFM ( UniqFM, emptyUFM ) @@ -123,6 +124,7 @@ data ModIface mi_module :: Module, -- Complete with package info mi_version :: VersionInfo, -- Module version number mi_orphan :: WhetherHasOrphans, -- Whether this module has orphans + mi_boot :: IsBootInterface, -- Whether this interface was read from an hi-boot file mi_usages :: [ImportVersion Name], -- Usages; kept sorted so that it's easy -- to decide whether to write a new iface file @@ -167,9 +169,15 @@ emptyModDetails emptyModIface :: Module -> ModIface emptyModIface mod = ModIface { mi_module = mod, + mi_version = initialVersionInfo, + mi_usages = [], + mi_orphan = False, + mi_boot = False, mi_exports = [], + mi_fixities = emptyNameEnv, mi_globals = emptyRdrEnv, - mi_deprecs = NoDeprecs + mi_deprecs = NoDeprecs, + mi_decls = panic "emptyModIface: decls" } \end{code} @@ -183,8 +191,6 @@ type HomeIfaceTable = IfaceTable type PackageIfaceTable = IfaceTable type HomeSymbolTable = SymbolTable -- Domain = modules in the home package -type PackageSymbolTable = SymbolTable -- Domain = modules in the some other package -type GlobalSymbolTable = SymbolTable -- Domain = all modules emptyIfaceTable :: IfaceTable emptyIfaceTable = emptyUFM @@ -214,9 +220,6 @@ lookupTableByModName ht pt mod %************************************************************************ \begin{code} -type TypeEnv = NameEnv TyThing -emptyTypeEnv = emptyNameEnv - data TyThing = AnId Id | ATyCon TyCon | AClass Class @@ -238,41 +241,28 @@ typeEnvTyCons env = [tc | ATyCon tc <- nameEnvElts env] \begin{code} -lookupTypeEnv :: SymbolTable -> Name -> Maybe TyThing -lookupTypeEnv tbl name - = case lookupModuleEnv tbl (nameModule name) of - Just details -> lookupNameEnv (md_types details) name - Nothing -> Nothing +type TypeEnv = NameEnv TyThing +emptyTypeEnv = emptyNameEnv -groupTyThings :: [TyThing] -> FiniteMap Module TypeEnv - -- Finite map because we want the range too -groupTyThings things - = foldl add emptyFM things - where - add :: FiniteMap Module TypeEnv -> TyThing -> FiniteMap Module TypeEnv - add tbl thing = addToFM tbl mod new_env - where - name = getName thing - mod = nameModule name - new_env = case lookupFM tbl mod of - Nothing -> unitNameEnv name thing - Just env -> extendNameEnv env name thing +mkTypeEnv :: [TyThing] -> TypeEnv +mkTypeEnv things = extendTypeEnvList emptyTypeEnv things -extendTypeEnv :: SymbolTable -> FiniteMap Module TypeEnv -> SymbolTable -extendTypeEnv tbl things - = foldFM add tbl things +extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv +extendTypeEnvList env things + = foldl add_thing env things where - add mod type_env tbl - = extendModuleEnv tbl mod new_details - where - new_details - = case lookupModuleEnv tbl mod of - Nothing -> emptyModDetails {md_types = type_env} - Just details -> details {md_types = md_types details - `plusNameEnv` type_env} + add_thing :: TypeEnv -> TyThing -> TypeEnv + add_thing env thing = extendNameEnv env (getName thing) thing \end{code} +\begin{code} +lookupType :: HomeSymbolTable -> PackageTypeEnv -> Name -> Maybe TyThing +lookupType hst pte name + = case lookupModuleEnv hst (nameModule name) of + Just details -> lookupNameEnv (md_types details) name + Nothing -> lookupNameEnv pte name +\end{code} %************************************************************************ %* * @@ -396,7 +386,7 @@ data PersistentCompilerState pcs_PIT :: PackageIfaceTable, -- Domain = non-home-package modules -- the mi_decls component is empty - pcs_PST :: PackageSymbolTable, -- Domain = non-home-package modules + pcs_PTE :: PackageTypeEnv, -- Domain = non-home-package modules -- except that the InstEnv components is empty pcs_insts :: PackageInstEnv, -- The total InstEnv accumulated from all @@ -416,7 +406,9 @@ It contains: * A name supply, which deals with allocating unique names to (Module,OccName) original names, - * An accumulated InstEnv from all the modules in pcs_PST + * An accumulated TypeEnv from all the modules in imported packages + + * An accumulated InstEnv from all the modules in imported packages The point is that we don't want to keep recreating it whenever we compile a new module. The InstEnv component of pcPST is empty. (This means we might "see" instances that we shouldn't "really" see; @@ -429,6 +421,7 @@ It contains: interface files but not yet sucked in, renamed, and typechecked \begin{code} +type PackageTypeEnv = TypeEnv type PackageRuleBase = RuleBase type PackageInstEnv = InstEnv diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs index 8c5ceb6..e62d663 100644 --- a/ghc/compiler/prelude/PrelInfo.lhs +++ b/ghc/compiler/prelude/PrelInfo.lhs @@ -37,15 +37,13 @@ import MkId ( mkPrimOpId, wiredInIds ) import MkId -- All of it, for re-export import TysPrim ( primTyCons ) import TysWiredIn ( wiredInTyCons ) -import HscTypes ( TyThing(..) ) +import HscTypes ( TyThing(..), TypeEnv, mkTypeEnv ) -- others: -import Name ( getName, NameEnv, mkNameEnv ) import TyCon ( tyConDataConsIfAvailable, TyCon ) import Class ( Class, classKey ) import Type ( funTyCon ) import Util ( isIn ) -import Outputable ( ppr, pprPanic ) \end{code} %************************************************************************ @@ -77,8 +75,8 @@ wiredInTyConThings tc n <- [dataConId dc, dataConWrapId dc] ] -- Synonyms return empty list of constructors -wiredInThingEnv :: NameEnv TyThing -wiredInThingEnv = mkNameEnv [ (getName thing, thing) | thing <- wiredInThings ] +wiredInThingEnv :: TypeEnv +wiredInThingEnv = mkTypeEnv wiredInThings \end{code} We let a lot of "non-standard" values be visible, so that we can make diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs index a19c541..9b9258e 100644 --- a/ghc/compiler/rename/Rename.lhs +++ b/ghc/compiler/rename/Rename.lhs @@ -33,7 +33,7 @@ import RnEnv ( availName, lookupOrigNames, lookupGlobalRn, newGlobalName ) import Module ( Module, ModuleName, WhereFrom(..), - moduleNameUserString, moduleName + moduleNameUserString, moduleName, moduleEnvElts ) import Name ( Name, isLocallyDefined, NamedThing(..), getSrcLoc, nameOccName, nameModule, @@ -52,7 +52,7 @@ import PrelInfo ( derivingOccurrences ) import Type ( funTyCon ) import ErrUtils ( dumpIfSet ) import Bag ( bagToList ) -import FiniteMap ( FiniteMap, eltsFM, fmToList, emptyFM, lookupFM, +import FiniteMap ( FiniteMap, fmToList, emptyFM, lookupFM, addToFM_C, elemFM, addToFM ) import UniqFM ( lookupUFM ) @@ -176,6 +176,7 @@ rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc) mod_iface = ModIface { mi_module = this_module, mi_version = initialVersionInfo, + mi_boot = False, mi_orphan = any isOrphanDecl rn_local_decls, mi_exports = my_exports, mi_globals = gbl_env, @@ -429,9 +430,9 @@ loadOldIface iface_path Nothing dcl_insts = new_insts } mod_iface = ModIface { mi_module = mod, mi_version = version, - mi_exports = avails, mi_orphan = pi_orphan iface, + mi_exports = avails, mi_usages = usages, + mi_boot = False, mi_orphan = pi_orphan iface, mi_fixities = fix_env, mi_deprecs = deprec_env, - mi_usages = usages, mi_decls = decls, mi_globals = panic "No mi_globals in old interface" } @@ -724,7 +725,8 @@ getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc getRnStats imported_decls ifaces = hcat [text "Renamer stats: ", stats] where - n_mods = length [() | (_, _, True) <- eltsFM (iImpModInfo ifaces)] + n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)] + -- This is really only right for a one-shot compile decls_read = [decl | (avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces), -- Data, newtype, and class decls are in the decls_fm diff --git a/ghc/compiler/rename/RnHiFiles.lhs b/ghc/compiler/rename/RnHiFiles.lhs index a81141a..55e8549 100644 --- a/ghc/compiler/rename/RnHiFiles.lhs +++ b/ghc/compiler/rename/RnHiFiles.lhs @@ -18,7 +18,14 @@ module RnHiFiles ( #include "HsVersions.h" import CmdLineOpts ( opt_IgnoreIfacePragmas ) -import HscTypes +import HscTypes ( ModuleLocation(..), + ModIface(..), emptyModIface, + VersionInfo(..), + lookupTableByModName, + ImportVersion, WhetherHasOrphans, IsBootInterface, + DeclsMap, GatedDecl, IfaceInsts, IfaceRules, + AvailInfo, GenAvailInfo(..), Avails, Deprecations(..) + ) import HsSyn ( HsDecl(..), TyClDecl(..), InstDecl(..), HsType(..), ConDecl(..), FixitySig(..), RuleDecl(..), @@ -37,14 +44,14 @@ import Name ( Name {-instance NamedThing-}, nameOccName, NamedThing(..), mkNameEnv, extendNameEnv ) -import Module ( Module, +import Module ( Module, moduleName, isModuleInThisPackage, ModuleName, WhereFrom(..), - extendModuleEnv, lookupModuleEnvByName, + extendModuleEnv, mkVanillaModule ) import RdrName ( RdrName, rdrNameOcc ) import NameSet -import SrcLoc ( mkSrcLoc, SrcLoc ) +import SrcLoc ( mkSrcLoc ) import Maybes ( maybeToBool, orElse ) import StringBuffer ( hGetStringBuffer ) import FastString ( mkFastString ) @@ -64,7 +71,7 @@ import Bag %********************************************************* \begin{code} -loadHomeInterface :: SDoc -> Name -> RnM d Ifaces +loadHomeInterface :: SDoc -> Name -> RnM d ModIface loadHomeInterface doc_str name = loadInterface doc_str (moduleName (nameModule name)) ImportBySystem @@ -79,14 +86,14 @@ loadOrphanModules mods load mod = loadInterface (mk_doc mod) mod ImportBySystem mk_doc mod = ppr mod <+> ptext SLIT("is a orphan-instance module") -loadInterface :: SDoc -> ModuleName -> WhereFrom -> RnM d Ifaces +loadInterface :: SDoc -> ModuleName -> WhereFrom -> RnM d ModIface loadInterface doc mod from = tryLoadInterface doc mod from `thenRn` \ (ifaces, maybe_err) -> case maybe_err of Nothing -> returnRn ifaces Just err -> failWithRn ifaces err -tryLoadInterface :: SDoc -> ModuleName -> WhereFrom -> RnM d (Ifaces, Maybe Message) +tryLoadInterface :: SDoc -> ModuleName -> WhereFrom -> RnM d (ModIface, Maybe Message) -- Returns (Just err) if an error happened -- It *doesn't* add an error to the monad, because sometimes it's ok to fail... -- Specifically, when we read the usage information from an interface file, @@ -97,12 +104,12 @@ tryLoadInterface :: SDoc -> ModuleName -> WhereFrom -> RnM d (Ifaces, Maybe Mess -- (If the load fails, we plug in a vanilla placeholder) tryLoadInterface doc_str mod_name from = getHomeIfaceTableRn `thenRn` \ hit -> - getIfacesRn `thenRn` \ ifaces -> + getIfacesRn `thenRn` \ ifaces@(Ifaces { iPIT = pit }) -> - -- Check whether we have it already in the home package - case lookupModuleEnvByName hit mod_name of { - Just _ -> returnRn (ifaces, Nothing) ; -- In the home package - Nothing -> + -- CHECK WHETHER WE HAVE IT ALREADY + case lookupTableByModName hit pit mod_name of { + Just iface -> returnRn (iface, Nothing) ; -- Already loaded + Nothing -> let mod_map = iImpModInfo ifaces @@ -110,10 +117,10 @@ tryLoadInterface doc_str mod_name from hi_boot_file = case (from, mod_info) of - (ImportByUser, _) -> False -- Not hi-boot - (ImportByUserSource, _) -> True -- hi-boot - (ImportBySystem, Just (_, is_boot, _)) -> is_boot -- - (ImportBySystem, Nothing) -> False + (ImportByUser, _) -> False -- Not hi-boot + (ImportByUserSource, _) -> True -- hi-boot + (ImportBySystem, Just (_, is_boot)) -> is_boot + (ImportBySystem, Nothing) -> False -- We're importing a module we know absolutely -- nothing about, so we assume it's from -- another package, where we aren't doing @@ -121,16 +128,9 @@ tryLoadInterface doc_str mod_name from redundant_source_import = case (from, mod_info) of - (ImportByUserSource, Just (_,False,_)) -> True - other -> False + (ImportByUserSource, Just (_,False)) -> True + other -> False in - -- CHECK WHETHER WE HAVE IT ALREADY - case mod_info of { - Just (_, _, True) - -> -- We're read it already so don't re-read it - returnRn (ifaces, Nothing) ; - - _ -> -- Issue a warning for a redundant {- SOURCE -} import -- NB that we arrange to read all the ordinary imports before @@ -144,11 +144,12 @@ tryLoadInterface doc_str mod_name from Left err -> -- Not found, so add an empty export env to the Ifaces map -- so that we don't look again let - new_mod_map = addToFM mod_map mod_name (False, False, True) - new_ifaces = ifaces { iImpModInfo = new_mod_map } + fake_mod = mkVanillaModule mod_name + fake_iface = emptyModIface fake_mod + new_ifaces = ifaces { iPIT = extendModuleEnv pit fake_mod fake_iface } in setIfacesRn new_ifaces `thenRn_` - returnRn (new_ifaces, Just err) ; + returnRn (fake_iface, Just err) ; -- Found and parsed! Right (mod, iface) -> @@ -182,17 +183,19 @@ tryLoadInterface doc_str mod_name from -- For an explicit user import, add to mod_map info about -- the things the imported module depends on, extracted - -- from its usage info. + -- from its usage info; and delete the module itself, which is now in the PIT mod_map1 = case from of - ImportByUser -> addModDeps mod (pi_usages iface) mod_map + ImportByUser -> addModDeps mod is_loaded (pi_usages iface) mod_map other -> mod_map - mod_map2 = addToFM mod_map1 mod_name (has_orphans, hi_boot_file, True) + mod_map2 = delFromFM mod_map1 mod_name + is_loaded m = maybeToBool (lookupTableByModName hit pit m) -- Now add info about this module to the PIT has_orphans = pi_orphan iface - new_pit = extendModuleEnv (iPIT ifaces) mod mod_iface + new_pit = extendModuleEnv pit mod mod_iface mod_iface = ModIface { mi_module = mod, mi_version = version, - mi_exports = avails, mi_orphan = has_orphans, + mi_orphan = has_orphans, mi_boot = hi_boot_file, + mi_exports = avails, mi_fixities = fix_env, mi_deprecs = deprec_env, mi_usages = [], -- Will be filled in later mi_decls = panic "No mi_decls in PIT", @@ -206,41 +209,42 @@ tryLoadInterface doc_str mod_name from iImpModInfo = mod_map2 } in setIfacesRn new_ifaces `thenRn_` - returnRn (new_ifaces, Nothing) - }}} + returnRn (mod_iface, Nothing) + }} ----------------------------------------------------- -- Adding module dependencies from the -- import decls in the interface file ----------------------------------------------------- -addModDeps :: Module -> [ImportVersion a] +addModDeps :: Module + -> (ModuleName -> Bool) -- True for module interfaces + -> [ImportVersion a] -> ImportedModuleInfo -> ImportedModuleInfo -- (addModDeps M ivs deps) -- We are importing module M, and M.hi contains 'import' decls given by ivs -addModDeps mod new_deps mod_deps +addModDeps mod is_loaded new_deps mod_deps = foldr add mod_deps filtered_new_deps where -- Don't record dependencies when importing a module from another package -- Except for its descendents which contain orphans, -- and in that case, forget about the boot indicator - filtered_new_deps :: [(ModuleName, (WhetherHasOrphans, IsBootInterface, IsLoaded))] + filtered_new_deps :: [(ModuleName, (WhetherHasOrphans, IsBootInterface))] filtered_new_deps | isModuleInThisPackage mod - = [ (imp_mod, (has_orphans, is_boot, False)) - | (imp_mod, has_orphans, is_boot, _) <- new_deps + = [ (imp_mod, (has_orphans, is_boot)) + | (imp_mod, has_orphans, is_boot, _) <- new_deps, + not (is_loaded imp_mod) ] - | otherwise = [ (imp_mod, (True, False, False)) - | (imp_mod, has_orphans, _, _) <- new_deps, - has_orphans + | otherwise = [ (imp_mod, (True, False)) + | (imp_mod, has_orphans, _, _) <- new_deps, + not (is_loaded imp_mod) && has_orphans ] add (imp_mod, dep) deps = addToFM_C combine deps imp_mod dep - combine old@(_, old_is_boot, old_is_loaded) new - | old_is_loaded || not old_is_boot = old -- Keep the old info if it's already loaded - -- or if it's a non-boot pending load - | otherwise = new -- Otherwise pick new info - + combine old@(old_has_orphans, old_is_boot) new@(new_has_orphans, new_is_boot) + | old_is_boot = new -- Record the best is_boot info + | otherwise = old ----------------------------------------------------- -- Loading the export list @@ -562,10 +566,8 @@ lookupFixityRn name -- When we come across a use of 'f', we need to know its fixity, and it's then, -- and only then, that we load B.hi. That is what's happening here. = getHomeIfaceTableRn `thenRn` \ hit -> - loadHomeInterface doc name `thenRn` \ ifaces -> - case lookupTable hit (iPIT ifaces) name of - Just iface -> returnRn (lookupNameEnv (mi_fixities iface) name `orElse` defaultFixity) - Nothing -> returnRn defaultFixity + loadHomeInterface doc name `thenRn` \ iface -> + returnRn (lookupNameEnv (mi_fixities iface) name `orElse` defaultFixity) where doc = ptext SLIT("Checking fixity for") <+> ppr name \end{code} diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs index cdb542c..e351248 100644 --- a/ghc/compiler/rename/RnIfaces.lhs +++ b/ghc/compiler/rename/RnIfaces.lhs @@ -18,7 +18,7 @@ where #include "HsVersions.h" -import CmdLineOpts ( opt_IgnoreIfacePragmas ) +import CmdLineOpts ( opt_IgnoreIfacePragmas, opt_NoPruneDecls ) import HscTypes import HsSyn ( HsDecl(..), Sig(..), TyClDecl(..), ConDecl(..), ConDetails(..), InstDecl(..), HsType(..), hsTyVarNames, getBangType @@ -40,11 +40,12 @@ import Name ( Name {-instance NamedThing-}, nameOccName, NamedThing(..), elemNameEnv ) -import Module ( Module, ModuleEnv, mkVanillaModule, +import Module ( Module, ModuleEnv, moduleName, isModuleInThisPackage, ModuleName, WhereFrom(..), - emptyModuleEnv, lookupModuleEnvByName, - extendModuleEnv_C, lookupWithDefaultModuleEnv + emptyModuleEnv, + extendModuleEnv_C, foldModuleEnv, lookupModuleEnv, + elemModuleSet, extendModuleSet ) import NameSet import PrelInfo ( wiredInThingEnv, fractionalClassKeys ) @@ -53,8 +54,7 @@ import Maybes ( orElse ) import FiniteMap import Outputable import Bag - -import List ( nub ) +import Util ( sortLt ) \end{code} @@ -69,20 +69,9 @@ import List ( nub ) \begin{code} getInterfaceExports :: ModuleName -> WhereFrom -> RnMG (Module, [(ModuleName,Avails)]) getInterfaceExports mod_name from - = getHomeIfaceTableRn `thenRn` \ hit -> - case lookupModuleEnvByName hit mod_name of { - Just mi -> returnRn (mi_module mi, mi_exports mi) ; - Nothing -> - - loadInterface doc_str mod_name from `thenRn` \ ifaces -> - case lookupModuleEnvByName (iPIT ifaces) mod_name of - Just mi -> returnRn (mi_module mi, mi_exports mi) ; - -- loadInterface always puts something in the map - -- even if it's a fake - Nothing -> returnRn (mkVanillaModule mod_name, []) - -- pprPanic "getInterfaceExports" (ppr mod_name) - } - where + = loadInterface doc_str mod_name from `thenRn` \ iface -> + returnRn (mi_module iface, mi_exports iface) + where doc_str = sep [ppr mod_name, ptext SLIT("is directly imported")] \end{code} @@ -101,7 +90,7 @@ getImportedInstDecls gates getIfacesRn `thenRn` \ ifaces -> let orphan_mods = - [mod | (mod, (True, _, False)) <- fmToList (iImpModInfo ifaces)] + [mod | (mod, (True, _)) <- fmToList (iImpModInfo ifaces)] in loadOrphanModules orphan_mods `thenRn_` @@ -227,93 +216,99 @@ mkImportInfo this_mod imports = getIfacesRn `thenRn` \ ifaces -> getHomeIfaceTableRn `thenRn` \ hit -> let + (imp_pkg_mods, imp_home_names) = iVSlurp ifaces + pit = iPIT ifaces + import_all_mods :: [ModuleName] -- Modules where we imported all the names -- (apart from hiding some, perhaps) - import_all_mods = nub [ m | ImportDecl m _ _ _ imp_list _ <- imports, - import_all imp_list ] + import_all_mods = [ m | ImportDecl m _ _ _ imp_list _ <- imports, + import_all imp_list ] + where + import_all (Just (False, _)) = False -- Imports are specified explicitly + import_all other = True -- Everything is imported + + -- mv_map groups together all the things imported and used + -- from a particular module in this package + -- We use a finite map because we want the domain + mv_map :: ModuleEnv [Name] + mv_map = foldNameSet add_mv emptyModuleEnv imp_home_names + add_mv name mv_map = extendModuleEnv_C add_item mv_map mod [name] + where + mod = nameModule name + add_item names _ = name:names + + -- In our usage list we record + -- a) Specifically: Detailed version info for imports from modules in this package + -- Gotten from iVSlurp plus import_all_mods + -- + -- b) Everything: Just the module version for imports from modules in other packages + -- Gotten from iVSlurp plus import_all_mods + -- + -- c) NothingAtAll: The name only of modules, Baz, in this package that are 'below' us, + -- but which we didn't need at all (this is needed only to decide whether + -- to open Baz.hi or Baz.hi-boot higher up the tree). + -- This happens when a module, Foo, that we explicitly imported has + -- 'import Baz' in its interface file, recording that Baz is below + -- Foo in the module dependency hierarchy. We want to propagate this info. + -- These modules are in a combination of HIT/PIT and iImpModInfo + -- + -- d) NothingAtAll: The name only of all orphan modules we know of (this is needed + -- so that anyone who imports us can find the orphan modules) + -- These modules are in a combination of HIT/PIT and iImpModInfo + + import_info0 = foldModuleEnv mk_imp_info [] pit + import_info1 = foldModuleEnv mk_imp_info import_info0 hit + import_info = [ (mod_name, orphans, is_boot, NothingAtAll) + | (mod_name, (orphans, is_boot)) <- fmToList (iImpModInfo ifaces) ] ++ + import_info1 + + mk_imp_info :: ModIface -> [ImportVersion Name] -> [ImportVersion Name] + mk_imp_info iface so_far - import_all (Just (False, _)) = False -- Imports are specified explicitly - import_all other = True -- Everything is imported + | Just ns <- lookupModuleEnv mv_map mod -- Case (a) + = go_for_it (Specifically mod_vers maybe_export_vers + (mk_import_items ns) rules_vers) - mod_map = iImpModInfo ifaces - imp_names = iVSlurp ifaces - pit = iPIT ifaces + | mod `elemModuleSet` imp_pkg_mods -- Case (b) + = go_for_it (Everything mod_vers) - -- mv_map groups together all the things imported from a particular module. - mv_map :: ModuleEnv [Name] - mv_map = foldr add_mv emptyModuleEnv imp_names - - add_mv name mv_map = addItem mv_map (nameModule name) name - - -- Build the result list by adding info for each module. - -- For (a) a library module, we don't record it at all unless it contains orphans - -- (We must never lose track of orphans.) - -- - -- (b) a home-package module - - mk_imp_info mod_name (has_orphans, is_boot, opened) so_far - | mod_name == this_mod -- Check if M appears in the set of modules 'below' M - -- This seems like a convenient place to check - = WARN( not is_boot, ptext SLIT("Wierd:") <+> ppr this_mod <+> - ptext SLIT("imports itself (perhaps indirectly)") ) - so_far - - | not opened -- We didn't even open the interface - = -- This happens when a module, Foo, that we explicitly imported has - -- 'import Baz' in its interface file, recording that Baz is below - -- Foo in the module dependency hierarchy. We want to propagate this - -- information. The Nothing says that we didn't even open the interface - -- file but we must still propagate the dependency info. - -- The module in question must be a local module (in the same package) - go_for_it NothingAtAll - - - | is_lib_module - -- Ignore modules from other packages, unless it has - -- orphans, in which case we must remember it in our - -- dependencies. But in that case we only record the - -- module version, nothing more detailed - = if has_orphans then - go_for_it (Everything module_vers) - else - so_far - - | otherwise - = go_for_it whats_imported - - where - go_for_it exports = (mod_name, has_orphans, is_boot, exports) : so_far - mod_iface = lookupTableByModName hit pit mod_name `orElse` panic "mkImportInfo" - mod = mi_module mod_iface - is_lib_module = not (isModuleInThisPackage mod) - version_info = mi_version mod_iface - version_env = vers_decls version_info - module_vers = vers_module version_info - - whats_imported = Specifically module_vers - export_vers import_items - (vers_rules version_info) - - import_items = [(n,v) | n <- lookupWithDefaultModuleEnv mv_map [] mod, - let v = lookupNameEnv version_env n `orElse` - pprPanic "mk_whats_imported" (ppr n) - ] - export_vers | moduleName mod `elem` import_all_mods - = Just (vers_exports version_info) - | otherwise - = Nothing - - import_info = foldFM mk_imp_info [] mod_map + | import_all_mod -- Case (a) and (b); the import-all part + = if is_home_pkg_mod then + go_for_it (Specifically mod_vers (Just export_vers) [] rules_vers) + else + go_for_it (Everything mod_vers) + + | is_home_pkg_mod || has_orphans -- Case (c) or (d) + = go_for_it NothingAtAll + + | otherwise = so_far + where + go_for_it exports = (mod_name, has_orphans, mi_boot iface, exports) : so_far + + mod = mi_module iface + mod_name = moduleName mod + is_home_pkg_mod = isModuleInThisPackage mod + version_info = mi_version iface + version_env = vers_decls version_info + mod_vers = vers_module version_info + rules_vers = vers_rules version_info + export_vers = vers_exports version_info + import_all_mod = mod_name `elem` import_all_mods + has_orphans = mi_orphan iface + + -- The sort is to put them into canonical order + mk_import_items ns = [(n,v) | n <- sortLt lt_occ ns, + let v = lookupNameEnv version_env n `orElse` + pprPanic "mk_whats_imported" (ppr n) + ] + where + lt_occ n1 n2 = nameOccName n1 < nameOccName n2 + + maybe_export_vers | import_all_mod = Just (vers_exports version_info) + | otherwise = Nothing in - traceRn (text "Modules in Ifaces: " <+> fsep (map ppr (keysFM mod_map))) `thenRn_` returnRn import_info - - -addItem :: ModuleEnv [a] -> Module -> a -> ModuleEnv [a] -addItem fm mod x = extendModuleEnv_C add_item fm mod [x] - where - add_item xs _ = x:xs \end{code} %********************************************************* @@ -461,13 +456,17 @@ getSlurped = getIfacesRn `thenRn` \ ifaces -> returnRn (iSlurp ifaces) -recordSlurp ifaces@(Ifaces { iSlurp = slurped_names, iVSlurp = imp_names }) +recordSlurp ifaces@(Ifaces { iSlurp = slurped_names, iVSlurp = (imp_mods, imp_names) }) avail = let new_slurped_names = addAvailToNameSet slurped_names avail - new_imp_names = availName avail : imp_names + new_vslurp | isModuleInThisPackage mod = (imp_mods, addOneToNameSet imp_names name) + | otherwise = (extendModuleSet imp_mods mod, imp_names) + where + mod = nameModule name + name = availName avail in - ifaces { iSlurp = new_slurped_names, iVSlurp = new_imp_names } + ifaces { iSlurp = new_slurped_names, iVSlurp = new_vslurp } recordLocalSlurps local_avails = getIfacesRn `thenRn` \ ifaces -> @@ -682,7 +681,8 @@ importDecl name getNonWiredInDecl :: Name -> RnMG ImportDeclResult getNonWiredInDecl needed_name = traceRn doc_str `thenRn_` - loadHomeInterface doc_str needed_name `thenRn` \ ifaces -> + loadHomeInterface doc_str needed_name `thenRn_` + getIfacesRn `thenRn` \ ifaces -> case lookupNameEnv (iDecls ifaces) needed_name of {- OMIT DEFERRED STUFF FOR NOW, TILL GHCI WORKS @@ -830,7 +830,7 @@ checkModUsage (mod_name, _, _, NothingAtAll) = up_to_date (ptext SLIT("Nothing used from:") <+> ppr mod_name) checkModUsage (mod_name, _, _, whats_imported) - = tryLoadInterface doc_str mod_name ImportBySystem `thenRn` \ (ifaces, maybe_err) -> + = tryLoadInterface doc_str mod_name ImportBySystem `thenRn` \ (iface, maybe_err) -> case maybe_err of { Just err -> out_of_date (sep [ptext SLIT("Can't find version number for module"), ppr mod_name]) ; @@ -839,12 +839,8 @@ checkModUsage (mod_name, _, _, whats_imported) -- the current module doesn't need that import and it's been deleted Nothing -> - - getHomeIfaceTableRn `thenRn` \ hit -> let - mod_details = lookupTableByModName hit (iPIT ifaces) mod_name - `orElse` panic "checkModUsage" - new_vers = mi_version mod_details + new_vers = mi_version iface new_decl_vers = vers_decls new_vers in case whats_imported of { -- NothingAtAll dealt with earlier diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs index bb8c295..d2dfc42 100644 --- a/ghc/compiler/rename/RnMonad.lhs +++ b/ghc/compiler/rename/RnMonad.lhs @@ -35,12 +35,12 @@ import IOExts ( IORef, newIORef, readIORef, writeIORef, unsafePerformIO ) import HsSyn import RdrHsSyn import RnHsSyn ( RenamedFixitySig ) -import HscTypes ( AvailEnv, lookupTypeEnv, +import HscTypes ( AvailEnv, lookupType, OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv, WhetherHasOrphans, ImportVersion, PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap, IfaceInsts, IfaceRules, - HomeSymbolTable, PackageSymbolTable, + HomeSymbolTable, PackageTypeEnv, PersistentCompilerState(..), GlobalRdrEnv, HomeIfaceTable, PackageIfaceTable, RdrAvailInfo ) @@ -58,7 +58,7 @@ import Name ( Name, OccName, NamedThing(..), getSrcLoc, NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, extendNameEnvList ) -import Module ( Module, ModuleName ) +import Module ( Module, ModuleName, ModuleSet, emptyModuleSet ) import NameSet import CmdLineOpts ( DynFlags, DynFlag(..), dopt ) import SrcLoc ( SrcLoc, generatedSrcLoc, noSrcLoc ) @@ -261,19 +261,24 @@ data Ifaces = Ifaces { -- All the names (whether "big" or "small", whether wired-in or not, -- whether locally defined or not) that have been slurped in so far. - iVSlurp :: [Name] - -- All the (a) non-wired-in (b) "big" (c) non-locally-defined + iVSlurp :: (ModuleSet, NameSet) + -- The Names are all the (a) non-wired-in + -- (b) "big" + -- (c) non-locally-defined + -- (d) home-package -- names that have been slurped in so far, with their versions. -- This is used to generate the "usage" information for this module. -- Subset of the previous field. + -- The module set is the non-home-package modules from which we have + -- slurped at least one name. -- It's worth keeping separately, because there's no very easy -- way to distinguish the "big" names from the "non-big" ones. -- But this is a decision we might want to revisit. } -type ImportedModuleInfo = FiniteMap ModuleName - (WhetherHasOrphans, IsBootInterface, IsLoaded) -type IsLoaded = Bool +type ImportedModuleInfo = FiniteMap ModuleName (WhetherHasOrphans, IsBootInterface) + -- Contains info ONLY about modules that have not yet + --- been loaded into the iPIT \end{code} @@ -295,7 +300,7 @@ initRn :: DynFlags initRn dflags hit hst pcs mod do_rn = do let prs = pcs_PRS pcs - let pst = pcs_PST pcs + let pte = pcs_PTE pcs let ifaces = Ifaces { iPIT = pcs_PIT pcs, iDecls = prsDecls prs, iInsts = prsInsts prs, @@ -306,7 +311,7 @@ initRn dflags hit hst pcs mod do_rn -- Pretend that the dummy unbound name has already been -- slurped. This is what's returned for an out-of-scope name, -- and we don't want thereby to try to suck it in! - iVSlurp = [] + iVSlurp = (emptyModuleSet, emptyNameSet) } let uniqs = prsNS prs @@ -319,7 +324,7 @@ initRn dflags hit hst pcs mod do_rn rn_dflags = dflags, rn_hit = hit, - rn_done = is_done hst pst, + rn_done = is_done hst pte, rn_ns = names_var, rn_errs = errs_var, @@ -347,9 +352,9 @@ initRn dflags hit hst pcs mod do_rn return (new_pcs, not (isEmptyBag errs), res) -is_done :: HomeSymbolTable -> PackageSymbolTable -> Name -> Bool +is_done :: HomeSymbolTable -> PackageTypeEnv -> Name -> Bool -- Returns True iff the name is in either symbol table -is_done hst pst n = maybeToBool (lookupTypeEnv pst n `seqMaybe` lookupTypeEnv hst n) +is_done hst pte n = maybeToBool (lookupType hst pte n) initRnMS rn_env fixity_env mode thing_inside rn_down g_down = let diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs index 9ce440b..88d0159 100644 --- a/ghc/compiler/typecheck/TcEnv.lhs +++ b/ghc/compiler/typecheck/TcEnv.lhs @@ -6,7 +6,7 @@ module TcEnv( -- Getting stuff from the environment TcEnv, initTcEnv, tcEnvTyCons, tcEnvClasses, tcEnvIds, tcEnvTcIds, tcEnvTyVars, - getTcGST, getTcGEnv, + getTcGEnv, -- Instance environment, and InstInfo type tcGetInstEnv, tcSetInstEnv, @@ -65,10 +65,10 @@ import Name ( Name, OccName, NamedThing(..), extendNameEnvList, emptyNameEnv ) import OccName ( mkDFunOcc, mkDefaultMethodOcc, occNameString ) -import HscTypes ( DFunId, TypeEnv ) +import HscTypes ( DFunId, TypeEnv, HomeSymbolTable, PackageTypeEnv ) import Module ( Module ) import InstEnv ( InstEnv, emptyInstEnv ) -import HscTypes ( lookupTypeEnv, TyThing(..), GlobalSymbolTable ) +import HscTypes ( lookupType, TyThing(..) ) import Util ( zipEqual ) import SrcLoc ( SrcLoc ) import Outputable @@ -88,12 +88,12 @@ type TcIdSet = IdSet data TcEnv = TcEnv { - tcGST :: GlobalSymbolTable, -- The symbol table at the moment we began this compilation + tcGST :: Name -> Maybe TyThing, -- The type environment at the moment we began this compilation tcInsts :: InstEnv, -- All instances (both imported and in this module) tcGEnv :: TypeEnv, -- The global type environment we've accumulated while - {- NameEnv TyThing-}-- compiling this module: + {- NameEnv TyThing-} -- compiling this module: -- types and classes (both imported and local) -- imported Ids -- (Ids defined in this module are in the local envt) @@ -141,15 +141,18 @@ data TcTyThing -- 3. Then we zonk the kind variable. -- 4. Now we know the kind for 'a', and we add (a -> ATyVar a::K) to the environment -initTcEnv :: GlobalSymbolTable -> IO TcEnv -initTcEnv gst +initTcEnv :: HomeSymbolTable -> PackageTypeEnv -> IO TcEnv +initTcEnv hst pte = do { gtv_var <- newIORef emptyVarSet ; - return (TcEnv { tcGST = gst, + return (TcEnv { tcGST = lookup, tcGEnv = emptyNameEnv, tcInsts = emptyInstEnv, tcLEnv = emptyNameEnv, tcTyVars = gtv_var })} + where + lookup name = lookupType hst pte name + tcEnvClasses env = [cl | AClass cl <- nameEnvElts (tcGEnv env)] tcEnvTyCons env = [tc | ATyCon tc <- nameEnvElts (tcGEnv env)] @@ -157,7 +160,6 @@ tcEnvIds env = [id | AnId id <- nameEnvElts (tcGEnv env)] tcEnvTyVars env = [tv | ATyVar tv <- nameEnvElts (tcLEnv env)] tcEnvTcIds env = [id | ATcId id <- nameEnvElts (tcLEnv env)] -getTcGST (TcEnv { tcGST = gst }) = gst getTcGEnv (TcEnv { tcGEnv = genv }) = genv -- This data type is used to help tie the knot @@ -180,7 +182,7 @@ lookup_global :: TcEnv -> Name -> Maybe TyThing lookup_global env name = case lookupNameEnv (tcGEnv env) name of Just thing -> Just thing - Nothing -> lookupTypeEnv (tcGST env) name + Nothing -> tcGST env name lookup_local :: TcEnv -> Name -> Maybe TcTyThing -- Try the local envt and then try the global diff --git a/ghc/compiler/typecheck/TcModule.lhs b/ghc/compiler/typecheck/TcModule.lhs index 6565f1e..0e13efb 100644 --- a/ghc/compiler/typecheck/TcModule.lhs +++ b/ghc/compiler/typecheck/TcModule.lhs @@ -42,9 +42,9 @@ import Type ( funResultTy, splitForAllTys ) import Bag ( isEmptyBag ) import ErrUtils ( printErrorsAndWarnings, dumpIfSet_dyn ) import Id ( idType, idName, idUnfolding ) -import Module ( Module, plusModuleEnv ) -import Name ( Name, nameOccName, isLocallyDefined, isGlobalName, getName, - toRdrName, nameEnvElts, lookupNameEnv, mkNameEnv +import Module ( Module ) +import Name ( Name, nameOccName, isLocallyDefined, isGlobalName, + toRdrName, nameEnvElts, lookupNameEnv, ) import TyCon ( tyConGenInfo, isClassTyCon ) import OccName ( isSysOcc ) @@ -54,9 +54,9 @@ import BasicTypes ( EP(..), Fixity ) import Bag ( isEmptyBag ) import Outputable import HscTypes ( PersistentCompilerState(..), HomeSymbolTable, HomeIfaceTable, - PackageSymbolTable, DFunId, ModIface(..), - TypeEnv, extendTypeEnv, lookupTable, - TyThing(..), groupTyThings ) + PackageTypeEnv, DFunId, ModIface(..), + TypeEnv, extendTypeEnvList, lookupTable, + TyThing(..), mkTypeEnv ) import List ( partition ) \end{code} @@ -87,7 +87,7 @@ typecheckModule -> IO (Maybe TcResults) typecheckModule dflags this_mod pcs hst hit decls - = do env <- initTcEnv global_symbol_table + = do env <- initTcEnv hst (pcs_PTE pcs) (maybe_result, (warns,errs)) <- initTc dflags env tc_module @@ -104,8 +104,6 @@ typecheckModule dflags this_mod pcs hst hit decls else return Nothing where - global_symbol_table = pcs_PST pcs `plusModuleEnv` hst - tc_module :: TcM (TcEnv, TcResults) tc_module = fixTc (\ ~(unf_env ,_) -> tcModule pcs hst get_fixity this_mod decls unf_env) @@ -243,13 +241,13 @@ tcModule pcs hst get_fixity this_mod decls unf_env (nameEnvElts (getTcGEnv final_env)) local_type_env :: TypeEnv - local_type_env = mkNameEnv [(getName thing, thing) | thing <- local_things] + local_type_env = mkTypeEnv local_things - new_pst :: PackageSymbolTable - new_pst = extendTypeEnv (pcs_PST pcs) (groupTyThings imported_things) + new_pte :: PackageTypeEnv + new_pte = extendTypeEnvList (pcs_PTE pcs) imported_things final_pcs :: PersistentCompilerState - final_pcs = pcs { pcs_PST = new_pst, + final_pcs = pcs { pcs_PTE = new_pte, pcs_insts = new_pcs_insts, pcs_rules = new_pcs_rules }