X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FHscTypes.lhs;h=c8cf4c79f3785aba291a13a4b3d2a139c4c93c8e;hb=16e4ce4c0c02650082f2e11982017c903c549ad5;hp=10b390d27df91c54ccdaa405a7e147c6ce23b40f;hpb=cbb5beb0ecef58ae6e47fa62e144a0855644f50a;p=ghc-hetmet.git diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 10b390d..c8cf4c7 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -14,7 +14,7 @@ module HscTypes ( HomePackageTable, HomeModInfo(..), emptyHomePackageTable, - ExternalPackageState(..), + ExternalPackageState(..), emptyExternalPackageState, PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable, lookupIface, lookupIfaceByModName, moduleNameToModule, emptyModIface, @@ -26,14 +26,14 @@ module HscTypes ( VersionInfo(..), initialVersionInfo, lookupVersion, FixityEnv, lookupFixity, collectFixities, emptyFixityEnv, - TyThing(..), isTyClThing, implicitTyThingIds, + TyThing(..), implicitTyThings, TypeEnv, lookupType, mkTypeEnv, emptyTypeEnv, 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, @@ -78,26 +78,29 @@ import Module import InstEnv ( InstEnv, ClsInstEnv, DFunId ) import Rules ( RuleBase ) 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 Id ( Id, idName ) +import Class ( Class, classSelIds, classTyCon ) +import TyCon ( TyCon, tyConName, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataCons ) +import TcType ( TyThing(..) ) +import DataCon ( dataConWorkId, dataConWrapId, dataConWrapId_maybe ) +import Packages ( PackageName, basePackage ) import CmdLineOpts ( DynFlags ) import BasicTypes ( Version, initialVersion, IPName, Fixity, FixitySig(..), defaultFixity ) -import HsSyn ( DeprecTxt, TyClDecl, InstDecl, RuleDecl, - tyClDeclName, ifaceRuleDeclName, tyClDeclNames ) +import HsSyn ( DeprecTxt, TyClDecl, InstDecl, RuleDecl, + tyClDeclName, ifaceRuleDeclName, tyClDeclNames, + instDeclDFun ) import RnHsSyn ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl ) import CoreSyn ( IdCoreRule ) import PrelNames ( isBuiltInSyntaxName ) +import InstEnv ( emptyInstEnv ) +import Rules ( emptyRuleBase ) import FiniteMap -import Bag ( Bag ) +import Bag ( Bag, emptyBag ) import Maybes ( orElse ) import Outputable import SrcLoc ( SrcLoc, isGoodSrcLoc ) @@ -146,14 +149,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 +194,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 +235,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 +243,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 +311,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,7 +361,8 @@ 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, TyClDecl RdrName)], -- Local definitions pi_fixity :: [FixitySig RdrName], -- Local fixity declarations, @@ -416,24 +425,6 @@ typeEnvElts env = nameEnvElts env typeEnvClasses env = [cl | AClass cl <- typeEnvElts env] typeEnvTyCons env = [tc | ATyCon tc <- typeEnvElts env] typeEnvIds env = [id | AnId id <- typeEnvElts env] - -implicitTyThingIds :: [TyThing] -> [Id] --- Add the implicit data cons and selectors etc -implicitTyThingIds things - = concat (map go things) - where - go (AnId f) = [] - go (AClass cl) = classSelIds cl - go (ATyCon tc) = tyConGenIds tc ++ - tyConSelIds tc ++ - [ n | dc <- tyConDataCons_maybe tc `orElse` [], - n <- implicitConIds tc dc] - -- Synonyms return empty list of constructors and selectors - - implicitConIds tc dc -- Newtypes have a constructor wrapper, - -- but no worker - | isNewTyCon tc = [dataConWrapId dc] - | otherwise = [dataConWorkId dc, dataConWrapId dc] \end{code} @@ -446,8 +437,45 @@ mkTypeEnv :: [TyThing] -> TypeEnv mkTypeEnv things = extendTypeEnvList emptyTypeEnv things extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv +-- Extend the type environment extendTypeEnvList env things - = extendNameEnvList env [(getName thing, thing) | thing <- things] + = foldl extend env things + where + extend env thing = extendNameEnv env (getName thing) thing + +implicitTyThings :: [TyThing] -> [TyThing] +implicitTyThings things + = concatMap extras things + where + extras_plus thing = thing : extras thing + + extras (AnId id) = [] + + -- For type constructors, add the data cons (and their extras), + -- and the selectors and generic-programming Ids too + -- + -- Newtypes don't have a worker Id, so don't generate that + extras (ATyCon tc) = map AnId (tyConGenIds tc ++ tyConSelIds tc) ++ data_con_stuff + where + data_con_stuff | isNewTyCon tc = [ADataCon dc1, AnId (dataConWrapId dc1)] + | otherwise = concatMap (extras_plus . ADataCon) dcs + dcs = tyConDataCons tc + dc1 = head dcs + + -- For classes, add the class TyCon too (and its extras) + -- and the class selector Ids + extras (AClass cl) = map AnId (classSelIds cl) ++ + extras_plus (ATyCon (classTyCon cl)) + + + -- For data cons add the worker and wrapper (if any) + extras (ADataCon dc) + = AnId (dataConWorkId dc) : wrap_id_stuff + where + -- May or may not have a wrapper + wrap_id_stuff = case dataConWrapId_maybe dc of + Just id -> [AnId id] + Nothing -> [] extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv extendTypeEnvWithIds env ids @@ -604,33 +632,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 - - | Everything Version -- Used for modules from other packages; - -- we record only the module's version number +type IsBootInterface = Bool - | 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} @@ -649,7 +679,8 @@ compiler. data PersistentCompilerState = PCS { pcs_nc :: !NameCache, - pcs_EPS :: !ExternalPackageState + pcs_EPS :: ExternalPackageState + -- non-strict because we fill it with error in HscMain } \end{code} @@ -674,11 +705,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 @@ -706,6 +732,17 @@ data ExternalPackageState -- for the home package we have all the instance -- declarations anyhow } + +emptyExternalPackageState = EPS { + eps_decls = (emptyNameEnv, 0), + eps_insts = (emptyBag, 0), + eps_inst_gates = emptyNameSet, + eps_rules = (emptyBag, 0), + eps_PIT = emptyPackageIfaceTable, + eps_PTE = emptyTypeEnv, + eps_inst_env = emptyInstEnv, + eps_rule_base = emptyRuleBase + } \end{code} The NameCache makes sure that there is just one Unique assigned for @@ -730,20 +767,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 @@ -859,18 +890,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 @@ -974,6 +1011,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}