X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FHscTypes.lhs;h=89a854c97123114d4a00e24e5b73c21bc13c5c53;hb=b0c44859840c251bac0d199fad94645031579096;hp=983a3e9d76beabb77566f3b28518fbf6da7db679;hpb=9af77fa423926fbda946b31e174173d0ec5ebac8;p=ghc-hetmet.git diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 983a3e9..89a854c 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -32,8 +32,8 @@ module HscTypes ( extendTypeEnvList, extendTypeEnvWithIds, typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds, - ImportedModuleInfo, WhetherHasOrphans, ImportVersion, WhatsImported(..), - IsBootInterface, DeclsMap, + WhetherHasOrphans, IsBootInterface, DeclsMap, Usage(..), + Dependencies(..), noDependencies, IfaceInsts, IfaceRules, GatedDecl, GatedDecls, GateFn, NameCache(..), OrigNameCache, OrigIParamCache, Avails, availsToNameSet, availName, availNames, @@ -81,16 +81,17 @@ import CoreSyn ( CoreBind ) import Id ( Id ) import Class ( Class, classSelIds ) import TyCon ( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataCons_maybe ) +import Type ( TyThing(..), isTyClThing ) import DataCon ( dataConWorkId, dataConWrapId ) -import Packages ( PackageName, preludePackage ) +import Packages ( PackageName, basePackage ) import CmdLineOpts ( DynFlags ) import BasicTypes ( Version, initialVersion, IPName, Fixity, FixitySig(..), defaultFixity ) -import HsSyn ( DeprecTxt, TyClDecl, tyClDeclName, ifaceRuleDeclName, - tyClDeclNames ) -import RdrHsSyn ( RdrNameInstDecl, RdrNameRuleDecl, RdrNameTyClDecl ) +import HsSyn ( DeprecTxt, TyClDecl, InstDecl, RuleDecl, + tyClDeclName, ifaceRuleDeclName, tyClDeclNames, + instDeclDFun ) import RnHsSyn ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl ) import CoreSyn ( IdCoreRule ) @@ -146,14 +147,12 @@ data HomeModInfo = HomeModInfo { hm_iface :: ModIface, Simple lookups in the symbol table. \begin{code} -lookupIface :: HomePackageTable -> PackageIfaceTable -> Name -> Maybe ModIface +lookupIface :: HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface -- We often have two IfaceTables, and want to do a lookup -lookupIface hpt pit name +lookupIface hpt pit mod = case lookupModuleEnv hpt mod of Just mod_info -> Just (hm_iface mod_info) Nothing -> lookupModuleEnv pit mod - where - mod = nameModule name lookupIfaceByModName :: HomePackageTable -> PackageIfaceTable -> ModuleName -> Maybe ModIface -- We often have two IfaceTables, and want to do a lookup @@ -193,15 +192,20 @@ data ModIface = ModIface { mi_module :: !Module, mi_package :: !PackageName, -- Which package the module comes from - mi_version :: !VersionInfo, -- Module version number + mi_version :: !VersionInfo, -- Version info for everything in this module mi_orphan :: !WhetherHasOrphans, -- Whether this module has orphans mi_boot :: !IsBootInterface, -- Read from an hi-boot file? - mi_usages :: [ImportVersion Name], + mi_deps :: Dependencies, + -- This is consulted for directly-imported modules, but + -- not for anything else + + mi_usages :: [Usage Name], -- Usages; kept sorted so that it's easy to decide -- whether to write a new iface file (changing usages -- doesn't affect the version of this module) -- NOT STRICT! we read this field lazily from the interface file + -- It is *only* consulted by the recompilation checker mi_exports :: ![ExportItem], -- What it exports Kept sorted by (mod,occ), to make @@ -229,8 +233,6 @@ data ModDetails md_rules :: ![IdCoreRule] -- Domain may include Ids from other modules } - - -- A ModGuts is carried through the compiler, accumulating stuff as it goes -- There is only one ModGuts at any time, the one for the module -- being compiled right now. Once it is compiled, a ModIface and @@ -239,10 +241,11 @@ data ModDetails data ModGuts = ModGuts { mg_module :: !Module, - mg_exports :: !Avails, -- What it exports - mg_usages :: ![ImportVersion Name], -- What it imports, directly or otherwise - -- ...exactly as in ModIface - mg_dir_imps :: ![Module], -- Directly imported modules + mg_exports :: !Avails, -- What it exports + mg_deps :: !Dependencies, -- What is below it, directly or otherwise + mg_dir_imps :: ![Module], -- Directly-imported modules; used to + -- generate initialisation code + mg_usages :: ![Usage Name], -- Version info for what it needed mg_rdr_env :: !GlobalRdrEnv, -- Top-level lexical environment mg_fix_env :: !FixityEnv, -- Fixity env, for things declared in this module @@ -306,22 +309,25 @@ data IfaceDecls = IfaceDecls { dcl_tycl :: [RenamedTyClDecl], -- Sorted dcl_insts :: [RenamedInstDecl] } -- Unsorted mkIfaceDecls :: [RenamedTyClDecl] -> [RenamedRuleDecl] -> [RenamedInstDecl] -> IfaceDecls +-- Sort to put them in canonical order for version comparison mkIfaceDecls tycls rules insts = IfaceDecls { dcl_tycl = sortLt lt_tycl tycls, dcl_rules = sortLt lt_rule rules, - dcl_insts = insts } + dcl_insts = sortLt lt_inst insts } where d1 `lt_tycl` d2 = tyClDeclName d1 < tyClDeclName d2 r1 `lt_rule` r2 = ifaceRuleDeclName r1 < ifaceRuleDeclName r2 + i1 `lt_inst` i2 = instDeclDFun i1 < instDeclDFun i2 \end{code} \begin{code} emptyModIface :: Module -> ModIface emptyModIface mod = ModIface { mi_module = mod, - mi_package = preludePackage, -- XXX fully bogus + mi_package = basePackage, -- XXX fully bogus mi_version = initialVersionInfo, mi_usages = [], + mi_deps = noDependencies, mi_orphan = False, mi_boot = False, mi_exports = [], @@ -353,12 +359,13 @@ data ParsedIface pi_pkg :: PackageName, pi_vers :: Version, -- Module version number pi_orphan :: WhetherHasOrphans, -- Whether this module has orphans - pi_usages :: [ImportVersion OccName], -- Usages + pi_deps :: Dependencies, -- What it depends on + pi_usages :: [Usage OccName], -- Usages pi_exports :: (Version, [RdrExportItem]), -- Exports - pi_decls :: [(Version, RdrNameTyClDecl)], -- Local definitions + pi_decls :: [(Version, TyClDecl RdrName)], -- Local definitions pi_fixity :: [FixitySig RdrName], -- Local fixity declarations, - pi_insts :: [RdrNameInstDecl], -- Local instance declarations - pi_rules :: (Version, [RdrNameRuleDecl]), -- Rules, with their version + pi_insts :: [InstDecl RdrName], -- Local instance declarations + pi_rules :: (Version, [RuleDecl RdrName]), -- Rules, with their version pi_deprecs :: IfaceDeprecs -- Deprecations } \end{code} @@ -407,26 +414,6 @@ icPrintUnqual ictxt = unQualInScope (ic_rn_gbl_env ictxt) %************************************************************************ \begin{code} -data TyThing = AnId Id - | ATyCon TyCon - | AClass Class - -isTyClThing :: TyThing -> Bool -isTyClThing (ATyCon _) = True -isTyClThing (AClass _) = True -isTyClThing (AnId _) = False - -instance NamedThing TyThing where - getName (AnId id) = getName id - getName (ATyCon tc) = getName tc - getName (AClass cl) = getName cl - -instance Outputable TyThing where - ppr (AnId id) = ptext SLIT("AnId") <+> ppr id - ppr (ATyCon tc) = ptext SLIT("ATyCon") <+> ppr tc - ppr (AClass cl) = ptext SLIT("AClass") <+> ppr cl - - typeEnvElts :: TypeEnv -> [TyThing] typeEnvClasses :: TypeEnv -> [Class] typeEnvTyCons :: TypeEnv -> [TyCon] @@ -624,33 +611,35 @@ type WhetherHasOrphans = Bool -- * a transformation rule in a module other than the one defining -- the function in the head of the rule. -type IsBootInterface = Bool - -type ImportVersion name = (ModuleName, WhetherHasOrphans, IsBootInterface, WhatsImported name) - -data WhatsImported name = NothingAtAll -- The module is below us in the - -- hierarchy, but we import nothing - -- Used for orphan modules, so they appear - -- in the usage list +type IsBootInterface = Bool - | Everything Version -- Used for modules from other packages; - -- we record only the module's version number - - | Specifically - Version -- Module version - (Maybe Version) -- Export-list version, if we depend on it - [(name,Version)] -- List guaranteed non-empty - Version -- Rules version - - deriving( Eq ) - -- 'Specifically' doesn't let you say "I imported f but none of the rules in +-- Dependency info about modules and packages below this one +-- in the import hierarchy. See TcRnTypes.ImportAvails for details. +-- +-- Invariant: the dependencies of a module M never includes M +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) + +noDependencies :: Dependencies +noDependencies = Deps [] [] [] + +data Usage name + = Usage { usg_name :: ModuleName, -- Name of the module + usg_mod :: Version, -- Module version + usg_exports :: Maybe Version, -- Export-list version, if we depend on it + usg_entities :: [(name,Version)], -- Sorted by occurrence name + usg_rules :: Version -- Rules version + } deriving( Eq ) + -- This type doesn't let you say "I imported f but none of the rules in -- the module". If you use anything in the module you get its rule version -- So if the rules change, you'll recompile, even if you don't use them. -- This is easy to implement, and it's safer: you might not have used the rules last -- time round, but if someone has added a new rule you might need it this time -- The export list field is (Just v) if we depend on the export list: - -- we imported the module without saying exactly what we imported + -- i.e. we imported the module without saying exactly what we imported -- We need to recompile if the module exports changes, because we might -- now have a name clash in the importing module. \end{code} @@ -694,11 +683,6 @@ data ExternalPackageState -- * Fixities -- * Deprecations - eps_imp_mods :: !ImportedModuleInfo, - -- Modules that we know something about, because they are mentioned - -- in interface files, BUT which we have not loaded yet. - -- No module is both in here and in the PIT - eps_PTE :: !PackageTypeEnv, -- Domain = external-package modules eps_inst_env :: !PackageInstEnv, -- The total InstEnv accumulated from @@ -750,20 +734,14 @@ data NameCache -- Ensures that one implicit parameter name gets one unique } -type OrigNameCache = FiniteMap (ModuleName,OccName) Name -type OrigIParamCache = FiniteMap (IPName RdrName) (IPName Name) -\end{code} - -@ImportedModuleInfo@ contains info ONLY about modules that have not yet -been loaded into the iPIT. These modules are mentioned in interfaces we've -already read, so we know a tiny bit about them, but we havn't yet looked -at the interface file for the module itself. It needs to persist across -invocations of the renamer, at least from Rename.checkOldIface to Rename.renameSource. -And there's no harm in it persisting across multiple compilations. +type OrigNameCache = ModuleEnv (Module, OccNameCache) + -- Maps a module *name* to a Module, + -- plus the OccNameEnv fot that module +type OccNameCache = FiniteMap OccName Name + -- Maps the OccName to a Name + -- A FiniteMap because OccNames have a Namespace/Faststring pair -\begin{code} -type ImportedModuleInfo - = FiniteMap ModuleName (WhetherHasOrphans, IsBootInterface) +type OrigIParamCache = FiniteMap (IPName RdrName) (IPName Name) \end{code} A DeclsMap contains a binding for each Name in the declaration @@ -771,11 +749,11 @@ including the constructors of a type decl etc. The Bool is True just for the 'main' Name. \begin{code} -type DeclsMap = (NameEnv (AvailInfo, Bool, (Module, RdrNameTyClDecl)), Int) +type DeclsMap = (NameEnv (AvailInfo, Bool, (Module, TyClDecl RdrName)), Int) -- The Int says how many have been sucked in -type IfaceInsts = GatedDecls RdrNameInstDecl -type IfaceRules = GatedDecls RdrNameRuleDecl +type IfaceInsts = GatedDecls (InstDecl RdrName) +type IfaceRules = GatedDecls (RuleDecl RdrName) type GatedDecls d = (Bag (GatedDecl d), Int) -- The Int says how many have been sucked in type GatedDecl d = (GateFn, (Module, d)) @@ -879,18 +857,24 @@ emptyGlobalRdrEnv = emptyRdrEnv data GlobalRdrElt = GRE { gre_name :: Name, - gre_parent :: Name, -- Name of the "parent" structure - -- * the tycon of a data con - -- * the class of a class op - -- For others it's just the same as gre_name - gre_prov :: Provenance, -- Why it's in scope - gre_deprec :: Maybe DeprecTxt -- Whether this name is deprecated + gre_parent :: Maybe Name, -- Name of the "parent" structure, for + -- * the tycon of a data con + -- * the class of a class op + -- For others it's Nothing + -- Invariant: gre_name g /= gre_parent g + -- when the latter is a Just + + gre_prov :: Provenance, -- Why it's in scope + gre_deprec :: Maybe DeprecTxt -- Whether this name is deprecated } instance Outputable GlobalRdrElt where ppr gre = ppr (gre_name gre) <+> - parens (hsep [text "parent:" <+> ppr (gre_parent gre) <> comma, - pprNameProvenance gre]) + parens (pp_parent (gre_parent gre) <+> pprNameProvenance gre) + where + pp_parent (Just p) = text "parent:" <+> ppr p <> comma + pp_parent Nothing = empty + pprGlobalRdrEnv env = vcat (map pp (rdrEnvToList env)) where @@ -994,6 +978,6 @@ pprNameProvenance (GRE {gre_name = name, gre_prov = prov}) ppr_reason ImplicitImport = ptext SLIT("implicitly imported") ppr_reason (UserImport mod loc _) = ptext SLIT("imported from") <+> ppr mod <+> ptext SLIT("at") <+> ppr loc -ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("at") <+> ppr loc) +ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("defined at") <+> ppr loc) | otherwise = empty \end{code}