X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FHscTypes.lhs;h=5a0b167acedaaf84dc7fe3f24a3bd0ffbd99bf6b;hb=ac80e0dececb68ed6385e3b34765fd8f9c019767;hp=41d38dee9c8c8a92d0eb3a5e2067470260430279;hpb=da95f4a039f7bc12b625338353df8399dec41c5e;p=ghc-hetmet.git diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 41d38de..5a0b167 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -12,17 +12,17 @@ module HscTypes ( ModGuts(..), ModImports(..), ForeignStubs(..), HomePackageTable, HomeModInfo(..), emptyHomePackageTable, + hptInstances, hptRules, ExternalPackageState(..), EpsStats(..), addEpsInStats, PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable, - lookupIface, lookupIfaceByModName, moduleNameToModule, - emptyModIface, + lookupIface, lookupIfaceByModule, emptyModIface, InteractiveContext(..), emptyInteractiveContext, icPrintUnqual, unQualInScope, ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache, - emptyIfaceDepCache, + emptyIfaceDepCache, Deprecs(..), IfaceDeprecs, @@ -64,7 +64,7 @@ import ByteCodeAsm ( CompiledByteCode ) import RdrName ( GlobalRdrEnv, emptyGlobalRdrEnv, LocalRdrEnv, emptyLocalRdrEnv, GlobalRdrElt(..), mkRdrUnqual, lookupGRE_RdrName ) -import Name ( Name, NamedThing, getName, nameOccName, nameModule, nameModuleName ) +import Name ( Name, NamedThing, getName, nameOccName, nameModule ) import NameEnv import NameSet import OccName ( OccName, OccEnv, lookupOccEnv, mkOccEnv, emptyOccEnv, @@ -79,7 +79,7 @@ import Type ( TyThing(..) ) import Class ( Class, classSelIds, classTyCon ) import TyCon ( TyCon, tyConSelIds, tyConDataCons ) import DataCon ( dataConImplicitIds ) -import Packages ( PackageName ) +import Packages ( PackageIdH, PackageId ) import CmdLineOpts ( DynFlags ) import BasicTypes ( Version, initialVersion, IPName, @@ -89,11 +89,10 @@ import IfaceSyn ( IfaceInst, IfaceRule, IfaceDecl(ifName) ) import FiniteMap ( FiniteMap ) import CoreSyn ( IdCoreRule ) -import Maybes ( orElse ) +import Maybes ( orElse, fromJust ) import Outputable import SrcLoc ( SrcSpan ) import UniqSupply ( UniqSupply ) -import Maybe ( fromJust ) import FastString ( FastString ) import DATA_IOREF ( IORef, readIORef ) @@ -127,6 +126,10 @@ data HscEnv -- hsc_HPT is not mutable because we only demand-load -- external packages; the home package is eagerly -- loaded, module by module, by the compilation manager. + -- + -- The HPT may contain modules compiled earlier by --make + -- but not actually below the current module in the dependency + -- graph. (This changes a previous invariant: changed Jan 05.) -- The next two are side-effected by compiling -- to reflect sucking in interface files @@ -176,21 +179,59 @@ lookupIface hpt pit mod Just mod_info -> Just (hm_iface mod_info) Nothing -> lookupModuleEnv pit mod -lookupIfaceByModName :: HomePackageTable -> PackageIfaceTable -> ModuleName -> Maybe ModIface +lookupIfaceByModule :: HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface -- We often have two IfaceTables, and want to do a lookup -lookupIfaceByModName hpt pit mod - = case lookupModuleEnvByName hpt mod of +lookupIfaceByModule hpt pit mod + = case lookupModuleEnv hpt mod of Just mod_info -> Just (hm_iface mod_info) - Nothing -> lookupModuleEnvByName pit mod + Nothing -> lookupModuleEnv pit mod \end{code} + \begin{code} --- Use instead of Finder.findModule if possible: this way doesn't --- require filesystem operations, and it is guaranteed not to fail --- when the IfaceTables are properly populated (i.e. after the renamer). -moduleNameToModule :: HomePackageTable -> PackageIfaceTable -> ModuleName -> Module -moduleNameToModule hpt pit mod - = mi_module (fromJust (lookupIfaceByModName hpt pit mod)) +hptInstances :: HscEnv -> [(Module, IsBootInterface)] -> [DFunId] +-- Find all the instance declarations that are in modules imported +-- by this one, directly or indirectly, and are in the Home Package Table +-- This ensures that we don't see instances from modules --make compiled +-- before this one, but which are not below this one +hptInstances hsc_env deps + | isOneShot (hsc_mode hsc_env) = [] -- In one-shot mode, the HPT is empty + | otherwise + = let + hpt = hsc_HPT hsc_env + in + [ dfun + | -- Find each non-hi-boot module below me + (mod, False) <- deps + + -- Look it up in the HPT + , let mod_info = ASSERT2( mod `elemModuleEnv` hpt, ppr mod $$ vcat (map ppr_hm (moduleEnvElts hpt))) + fromJust (lookupModuleEnv hpt mod) + + -- And get its dfuns + , dfun <- md_insts (hm_details mod_info) ] + where + ppr_hm hm = ppr (mi_module (hm_iface hm)) + +hptRules :: HscEnv -> [(Module, IsBootInterface)] -> [IdCoreRule] +-- Get rules from modules "below" this one (in the dependency sense) +-- C.f Inst.hptInstances +hptRules hsc_env deps + | isOneShot (hsc_mode hsc_env) = [] + | otherwise + = let + hpt = hsc_HPT hsc_env + in + [ rule + | -- Find each non-hi-boot module below me + (mod, False) <- deps + + -- Look it up in the HPT + , let mod_info = ASSERT( mod `elemModuleEnv` hpt ) + fromJust (lookupModuleEnv hpt mod) + + -- And get its dfuns + , rule <- md_rules (hm_details mod_info) ] \end{code} @@ -212,7 +253,7 @@ the declarations into a single indexed map in the @PersistentRenamerState@. \begin{code} data ModIface = ModIface { - mi_package :: !PackageName, -- Which package the module comes from + mi_package :: !PackageIdH, -- Which package the module comes from mi_module :: !Module, mi_mod_vers :: !Version, -- Module version: changes when anything changes @@ -348,10 +389,10 @@ data ForeignStubs = NoStubs \end{code} \begin{code} -emptyModIface :: PackageName -> ModuleName -> ModIface +emptyModIface :: PackageIdH -> Module -> ModIface emptyModIface pkg mod = ModIface { mi_package = pkg, - mi_module = mkModule pkg mod, + mi_module = mod, mi_mod_vers = initialVersion, mi_orphan = False, mi_boot = False, @@ -421,7 +462,7 @@ unQualInScope :: GlobalRdrEnv -> PrintUnqualified -- [Out of date] Also checks for built-in syntax, which is always 'in scope' unQualInScope env mod occ = case lookupGRE_RdrName (mkRdrUnqual occ) env of - [gre] -> nameModuleName (gre_name gre) == mod + [gre] -> nameModule (gre_name gre) == mod other -> False \end{code} @@ -585,7 +626,7 @@ data GenAvailInfo name = Avail name -- An ordinary identifier deriving( Eq ) -- Equality used when deciding if the interface has changed -type IfaceExport = (ModuleName, [GenAvailInfo OccName]) +type IfaceExport = (Module, [GenAvailInfo OccName]) availsToNameSet :: [AvailInfo] -> NameSet availsToNameSet avails = foldl add emptyNameSet avails @@ -662,15 +703,17 @@ type IsBootInterface = Bool -- Invariant: the dependencies of a module M never includes M -- Invariant: the lists are unordered, with no duplicates data Dependencies - = Deps { dep_mods :: [(ModuleName,IsBootInterface)], -- Home-package module dependencies - dep_pkgs :: [PackageName], -- External package dependencies - dep_orphs :: [ModuleName] } -- Orphan modules (whether home or external pkg) + = Deps { dep_mods :: [(Module,IsBootInterface)], -- Home-package module dependencies + dep_pkgs :: [PackageId], -- External package dependencies + dep_orphs :: [Module] } -- Orphan modules (whether home or external pkg) + deriving( Eq ) + -- Equality used only for old/new comparison in MkIface.addVersionInfo noDependencies :: Dependencies noDependencies = Deps [] [] [] data Usage - = Usage { usg_name :: ModuleName, -- Name of the module + = Usage { usg_name :: Module, -- Name of the module usg_mod :: Version, -- Module version usg_entities :: [(OccName,Version)], -- Sorted by occurrence name usg_exports :: Maybe Version, -- Export-list version, if we depend on it @@ -703,14 +746,14 @@ type PackageInstEnv = InstEnv data ExternalPackageState = EPS { - eps_is_boot :: !(ModuleEnv (ModuleName, IsBootInterface)), + eps_is_boot :: !(ModuleEnv (Module, IsBootInterface)), -- In OneShot mode (only), home-package modules accumulate in the -- external package state, and are sucked in lazily. -- For these home-pkg modules (only) we need to record which are -- boot modules. We set this field after loading all the -- explicitly-imported interfaces, but before doing anything else -- - -- The ModuleName part is not necessary, but it's useful for + -- The Module part is not necessary, but it's useful for -- debug prints, and it's convenient because this field comes -- direct from TcRnTypes.ImportAvails.imp_dep_mods @@ -783,9 +826,10 @@ type OrigIParamCache = FiniteMap (IPName OccName) (IPName Name) \end{code} \begin{code} -type Gated d = ([Name], (ModuleName, d)) -- The [Name] 'gate' the declaration; always non-empty - -- ModuleName records which iface file this - -- decl came from +type Gated d = ([Name], (Module, SDoc, d)) + -- The [Name] 'gate' the declaration; always non-empty + -- Module records which module this decl belongs to + -- SDoc records the pathname of the file, or similar err-ctxt info type RulePool = [Gated IfaceRule] @@ -838,7 +882,7 @@ data Linkable = LM { linkableTime :: ClockTime, -- Time at which this linkable was built -- (i.e. when the bytecodes were produced, -- or the mod date on the files) - linkableModName :: ModuleName, -- Should be Module, but see below + linkableModule :: Module, -- Should be Module, but see below linkableUnlinked :: [Unlinked] }