X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FHscTypes.lhs;h=e7f639d33ddb51ab6de351e634edf6d301af4b3d;hb=2ecf1c9f639dc75f1078e88c2e551116923f742a;hp=bddcc22d92906fa968c8a697492f2b23c6edbe06;hpb=5cbfe81e433d1ca3aed41d5b5522bc1377e6af94;p=ghc-hetmet.git diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index bddcc22..e7f639d 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -5,18 +5,33 @@ \begin{code} module HscTypes ( - ModDetails(..), GlobalSymbolTable, + ModuleLocation(..), + + ModDetails(..), ModIface(..), GlobalSymbolTable, HomeSymbolTable, PackageSymbolTable, + HomeIfaceTable, PackageIfaceTable, emptyIfaceTable, + lookupTable, lookupTableByModName, + + IfaceDecls(..), + + VersionInfo(..), initialVersionInfo, - TyThing(..), lookupTypeEnv, + TyThing(..), groupTyThings, isTyClThing, - WhetherHasOrphans, ImportVersion, ExportItem, + TypeEnv, extendTypeEnv, lookupTypeEnv, + typeEnvClasses, typeEnvTyCons, + + WhetherHasOrphans, ImportVersion, WhatsImported(..), PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap, - IfaceInsts, IfaceRules, DeprecationEnv, OrigNameEnv, + IfaceInsts, IfaceRules, GatedDecl, + OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv, AvailEnv, AvailInfo, GenAvailInfo(..), PersistentCompilerState(..), + Deprecations(..), lookupDeprec, + InstEnv, ClsInstEnv, DFunId, + PackageInstEnv, PackageRuleBase, GlobalRdrEnv, RdrAvailInfo, @@ -28,72 +43,133 @@ module HscTypes ( #include "HsVersions.h" +import RdrName ( RdrNameEnv, emptyRdrEnv ) import Name ( Name, NameEnv, NamedThing, - unitNameEnv, extendNameEnv, plusNameEnv, + emptyNameEnv, unitNameEnv, extendNameEnv, plusNameEnv, lookupNameEnv, emptyNameEnv, getName, nameModule, - nameSrcLoc ) -import Module ( Module, ModuleName, - extendModuleEnv, lookupModuleEnv ) -import Class ( Class ) + nameSrcLoc, nameEnvElts ) +import NameSet ( NameSet ) import OccName ( OccName ) -import RdrName ( RdrNameEnv, emptyRdrEnv ) -import Outputable ( SDoc ) -import UniqFM ( UniqFM ) -import FiniteMap ( FiniteMap, emptyFM, addToFM, lookupFM, foldFM ) -import Bag ( Bag ) +import Module ( Module, ModuleName, ModuleEnv, + extendModuleEnv, lookupModuleEnv, lookupModuleEnvByName + ) +import Rules ( RuleBase ) +import VarSet ( TyVarSet ) import Id ( Id ) -import VarEnv ( IdEnv, emptyVarEnv ) -import BasicTypes ( Version, Fixity, defaultFixity ) +import Class ( Class ) import TyCon ( TyCon ) -import ErrUtils ( ErrMsg, WarnMsg ) -import CmLink ( Linkable ) -import RdrHsSyn ( RdrNameInstDecl, RdrNameRuleDecl, RdrNameHsDecl, - RdrNameDeprecation, RdrNameFixitySig ) -import UniqSupply ( UniqSupply ) -import HsDecls ( DeprecTxt ) -import CoreSyn ( CoreRule ) -import NameSet ( NameSet ) + +import BasicTypes ( Version, initialVersion, Fixity ) + +import HsSyn ( DeprecTxt ) +import RdrHsSyn ( RdrNameHsDecl, RdrNameTyClDecl ) +import RnHsSyn ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl ) + +import CoreSyn ( IdCoreRule ) import Type ( Type ) -import VarSet ( TyVarSet ) -import Panic ( panic ) + +import FiniteMap ( FiniteMap, emptyFM, addToFM, lookupFM, foldFM ) +import Bag ( Bag ) +import Maybes ( seqMaybe ) +import UniqFM ( UniqFM, emptyUFM ) import Outputable import SrcLoc ( SrcLoc, isGoodSrcLoc ) +import Util ( thenCmp ) +import UniqSupply ( UniqSupply ) \end{code} %************************************************************************ %* * +\subsection{Module locations} +%* * +%************************************************************************ + +\begin{code} +data ModuleLocation + = ModuleLocation { + hs_file :: FilePath, + hi_file :: FilePath, + obj_file :: FilePath + } + deriving Show + +instance Outputable ModuleLocation where + ppr = text . show +\end{code} + +For a module in another package, the hs_file and obj_file +components of ModuleLocation are undefined. + +The locations specified by a ModuleLocation may or may not +correspond to actual files yet: for example, even if the object +file doesn't exist, the ModuleLocation still contains the path to +where the object file will reside if/when it is created. + + +%************************************************************************ +%* * \subsection{Symbol tables and Module details} %* * %************************************************************************ -A @ModDetails@ summarises everything we know about a compiled module. +A @ModIface@ plus a @ModDetails@ summarises everything we know +about a compiled module. The @ModIface@ is the stuff *before* linking, +and can be written out to an interface file. The @ModDetails@ is after +linking; it is the "linked" form of the mi_decls field. \begin{code} +data ModIface + = ModIface { + mi_module :: Module, -- Complete with package info + mi_version :: VersionInfo, -- Module version number + mi_orphan :: WhetherHasOrphans, -- Whether this module has orphans + + mi_usages :: [ImportVersion 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) + + mi_exports :: [(ModuleName,Avails)], -- What it exports + -- Kept sorted by (mod,occ), + -- to make version comparisons easier + + mi_globals :: GlobalRdrEnv, -- Its top level environment + + mi_fixities :: NameEnv Fixity, -- Fixities + mi_deprecs :: Deprecations, -- Deprecations + + mi_decls :: IfaceDecls -- The RnDecls form of ModDetails + } + +data IfaceDecls = IfaceDecls { dcl_tycl :: [RenamedTyClDecl], -- Sorted + dcl_rules :: [RenamedRuleDecl], -- Sorted + dcl_insts :: [RenamedInstDecl] } -- Unsorted + +-- typechecker should only look at this, not ModIface +-- Should be able to construct ModDetails from mi_decls in ModIface data ModDetails = ModDetails { - md_id :: Module, - md_exports :: Avails, -- What it exports - md_version :: VersionInfo, - md_globals :: GlobalRdrEnv, -- Its top level environment - - md_fixities :: NameEnv Fixity, - md_deprecs :: NameEnv DeprecTxt, + -- The next three fields are created by the typechecker md_types :: TypeEnv, - md_insts :: [DFunId], -- Dfun-ids for the instances in this module - md_rules :: RuleEnv -- Domain may include Id from other modules + md_rules :: [IdCoreRule] -- Domain may include Ids from other modules } +\end{code} + +\begin{code} +emptyModDetails :: ModDetails +emptyModDetails + = ModDetails { md_types = emptyTypeEnv, + md_insts = [], + md_rules = [] + } -emptyModDetails :: Module -> ModDetails -emptyModDetails mod - = ModDetails { md_id = mod, - md_exports = [], - md_globals = emptyRdrEnv, - md_fixities = emptyNameEnv, - md_deprecs = emptyNameEnv, - md_types = emptyNameEnv, - md_insts = [], - md_rules = emptyRuleEnv +emptyModIface :: Module -> ModIface +emptyModIface mod + = ModIface { mi_module = mod, + mi_exports = [], + mi_globals = emptyRdrEnv, + mi_deprecs = NoDeprecs } \end{code} @@ -101,20 +177,33 @@ Symbol tables map modules to ModDetails: \begin{code} type SymbolTable = ModuleEnv ModDetails +type IfaceTable = ModuleEnv ModIface + +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 \end{code} Simple lookups in the symbol table. \begin{code} -lookupFixityEnv :: SymbolTable -> Name -> Maybe Fixity - -- Returns defaultFixity if there isn't an explicit fixity -lookupFixityEnv tbl name - = case lookupModuleEnv tbl (nameModule name) of - Nothing -> Nothing - Just details -> lookupNameEnv (md_fixities details) name +lookupTable :: ModuleEnv a -> ModuleEnv a -> Name -> Maybe a +-- We often have two Symbol- or IfaceTables, and want to do a lookup +lookupTable ht pt name + = lookupModuleEnv ht mod `seqMaybe` lookupModuleEnv pt mod + where + mod = nameModule name + +lookupTableByModName :: ModuleEnv a -> ModuleEnv a -> ModuleName -> Maybe a +-- We often have two Symbol- or IfaceTables, and want to do a lookup +lookupTableByModName ht pt mod + = lookupModuleEnvByName ht mod `seqMaybe` lookupModuleEnvByName pt mod \end{code} @@ -126,15 +215,25 @@ lookupFixityEnv tbl name \begin{code} type TypeEnv = NameEnv TyThing +emptyTypeEnv = emptyNameEnv 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 + +typeEnvClasses env = [cl | AClass cl <- nameEnvElts env] +typeEnvTyCons env = [tc | ATyCon tc <- nameEnvElts env] + \end{code} @@ -165,11 +264,11 @@ extendTypeEnv tbl things = foldFM add tbl things where add mod type_env tbl - = panic "extendTypeEnv" --extendModuleEnv mod new_details + = extendModuleEnv tbl mod new_details where new_details = case lookupModuleEnv tbl mod of - Nothing -> (emptyModDetails mod) {md_types = type_env} + Nothing -> emptyModDetails {md_types = type_env} Just details -> details {md_types = md_types details `plusNameEnv` type_env} \end{code} @@ -187,21 +286,39 @@ but they are mostly elaborated elsewhere \begin{code} data VersionInfo = VersionInfo { - modVers :: Version, - fixVers :: Version, - ruleVers :: Version, - declVers :: NameEnv Version + vers_module :: Version, -- Changes when anything changes + vers_exports :: Version, -- Changes when export list changes + vers_rules :: Version, -- Changes when any rule changes + vers_decls :: NameEnv Version + -- Versions for "big" names only (not data constructors, class ops) + -- The version of an Id changes if its fixity changes + -- Ditto data constructors, class operations, except that the version of + -- the parent class/tycon changes } -type DeprecationEnv = NameEnv DeprecTxt -- Give reason for deprecation +initialVersionInfo :: VersionInfo +initialVersionInfo = VersionInfo { vers_module = initialVersion, + vers_exports = initialVersion, + vers_rules = initialVersion, + vers_decls = emptyNameEnv } + +data Deprecations = NoDeprecs + | DeprecAll DeprecTxt -- Whole module deprecated + | DeprecSome (NameEnv (Name,DeprecTxt)) -- Some things deprecated + -- Just "big" names + -- We keep the Name in the range, so we can print them out + +lookupDeprec :: Deprecations -> Name -> Maybe DeprecTxt +lookupDeprec NoDeprecs name = Nothing +lookupDeprec (DeprecAll txt) name = Just txt +lookupDeprec (DeprecSome env) name = case lookupNameEnv env name of + Just (_, txt) -> Just txt + Nothing -> Nothing type InstEnv = UniqFM ClsInstEnv -- Maps Class to instances for that class + type ClsInstEnv = [(TyVarSet, [Type], DFunId)] -- The instances for a particular class type DFunId = Id - -type RuleEnv = IdEnv [CoreRule] - -emptyRuleEnv = emptyVarEnv \end{code} @@ -230,31 +347,6 @@ type AvailEnv = NameEnv AvailInfo -- Maps a Name to the AvailInfo that contain %************************************************************************ \begin{code} --- ModIFace is nearly the same as RnMonad.ParsedIface. --- Right now it's identical :) -data ModIFace - = ModIFace { - mi_mod :: Module, -- Complete with package info - mi_vers :: Version, -- Module version number - mi_orphan :: WhetherHasOrphans, -- Whether this module has orphans - mi_usages :: [ImportVersion OccName], -- Usages - mi_exports :: [ExportItem], -- Exports - mi_insts :: [RdrNameInstDecl], -- Local instance declarations - mi_decls :: [(Version, RdrNameHsDecl)], -- Local definitions - mi_fixity :: (Version, [RdrNameFixitySig]), -- Local fixity declarations, - -- with their version - mi_rules :: (Version, [RdrNameRuleDecl]), -- Rules, with their version - mi_deprecs :: [RdrNameDeprecation] -- Deprecations - } - -type ExportItem = (ModuleName, [RdrAvailInfo]) - -type ImportVersion name = (ModuleName, WhetherHasOrphans, IsBootInterface, WhatsImported name) - -type ModVersionInfo = (Version, -- Version of the whole module - Version, -- Version number for all fixity decls together - Version) -- ...ditto all rules together - type WhetherHasOrphans = Bool -- An "orphan" is -- * an instance decl in a module other than the defn module for @@ -264,25 +356,31 @@ type WhetherHasOrphans = Bool 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 - | Everything Version -- The module version + | 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 - | Specifically Version -- Module version - Version -- Fixity version - Version -- Rules version - [(name,Version)] -- List guaranteed non-empty deriving( Eq ) - -- 'Specifically' doesn't let you say "I imported f but none of the fixities in - -- the module". If you use anything in the module you get its fixity and rule version - -- So if the fixities or rules change, you'll recompile, even if you don't use either. + -- 'Specifically' 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 - -- 'Everything' means there was a "module M" in - -- this module's export list, so we just have to go by M's version, - -- not the list of (name,version) pairs + -- The export list field is (Just v) if we depend on the export list: + -- 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} @@ -295,14 +393,20 @@ data WhatsImported name = NothingAtAll -- The module is below us in the \begin{code} data PersistentCompilerState = PCS { + pcs_PIT :: PackageIfaceTable, -- Domain = non-home-package modules + -- the mi_decls component is empty + pcs_PST :: PackageSymbolTable, -- Domain = non-home-package modules -- except that the InstEnv components is empty - pcs_insts :: InstEnv, -- The total InstEnv accumulated from all + + pcs_insts :: PackageInstEnv, -- The total InstEnv accumulated from all -- the non-home-package modules - pcs_rules :: RuleEnv, -- Ditto RuleEnv + + pcs_rules :: PackageRuleBase, -- Ditto RuleEnv pcs_PRS :: PersistentRenamerState } + \end{code} The @PersistentRenamerState@ persists across successive calls to the @@ -325,11 +429,15 @@ It contains: interface files but not yet sucked in, renamed, and typechecked \begin{code} +type PackageRuleBase = RuleBase +type PackageInstEnv = InstEnv + data PersistentRenamerState = PRS { prsOrig :: OrigNameEnv, prsDecls :: DeclsMap, prsInsts :: IfaceInsts, - prsRules :: IfaceRules + prsRules :: IfaceRules, + prsNS :: UniqSupply } \end{code} @@ -347,9 +455,14 @@ we just store junk. Then when we find the binding site, we fix it up. \begin{code} data OrigNameEnv - = Orig { origNames :: FiniteMap (ModuleName,OccName) Name, -- Ensures that one original name gets one unique - origIParam :: FiniteMap OccName Name -- Ensures that one implicit parameter name gets one unique + = Orig { origNames :: OrigNameNameEnv, + -- Ensures that one original name gets one unique + origIParam :: OrigNameIParamEnv + -- Ensures that one implicit parameter name gets one unique } + +type OrigNameNameEnv = FiniteMap (ModuleName,OccName) Name +type OrigNameIParamEnv = FiniteMap OccName Name \end{code} @@ -358,7 +471,7 @@ 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, RdrNameHsDecl)) +type DeclsMap = NameEnv (AvailInfo, Bool, (Module, RdrNameTyClDecl)) type IfaceInsts = Bag GatedDecl type IfaceRules = Bag GatedDecl @@ -369,54 +482,6 @@ type GatedDecl = (NameSet, (Module, RdrNameHsDecl)) %************************************************************************ %* * -\subsection{The result of compiling one module} -%* * -%************************************************************************ - -\begin{code} -data CompResult - = CompOK ModDetails -- new details (HST additions) - (Maybe (ModIFace, Linkable)) - -- summary and code; Nothing => compilation not reqd - -- (old summary and code are still valid) - PersistentCompilerState -- updated PCS - (Bag WarnMsg) -- warnings - - | CompErrs PersistentCompilerState -- updated PCS - (Bag ErrMsg) -- errors - (Bag WarnMsg) -- warnings - - --- The driver sits between 'compile' and 'hscMain', translating calls --- to the former into calls to the latter, and results from the latter --- into results from the former. It does things like preprocessing --- the .hs file if necessary, and compiling up the .stub_c files to --- generate Linkables. - -data HscResult - = HscOK ModDetails -- new details (HomeSymbolTable additions) - (Maybe ModIFace) -- new iface (if any compilation was done) - (Maybe String) -- generated stub_h filename (in /tmp) - (Maybe String) -- generated stub_c filename (in /tmp) - PersistentCompilerState -- updated PCS - [SDoc] -- warnings - - | HscErrs PersistentCompilerState -- updated PCS - [SDoc] -- errors - [SDoc] -- warnings - - --- These two are only here to avoid recursion between CmCompile and --- CompManager. They really ought to be in the latter. -type ModuleEnv a = UniqFM a -- Domain is Module - -type HomeModMap = FiniteMap ModuleName Module -- domain: home mods only -type HomeInterfaceTable = ModuleEnv ModIFace -\end{code} - - -%************************************************************************ -%* * \subsection{Provenance and export info} %* * %************************************************************************ @@ -440,15 +505,28 @@ data Provenance ImportReason PrintUnqualified -{- -Moved here from Name. -pp_prov (LocalDef _ Exported) = char 'x' -pp_prov (LocalDef _ NotExported) = char 'l' -pp_prov (NonLocalDef ImplicitImport _) = char 'j' -pp_prov (NonLocalDef (UserImport _ _ True ) _) = char 'I' -- Imported by name -pp_prov (NonLocalDef (UserImport _ _ False) _) = char 'i' -- Imported by .. -pp_prov SystemProv = char 's' --} +-- Just used for grouping error messages (in RnEnv.warnUnusedBinds) +instance Eq Provenance where + p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False + +instance Eq ImportReason where + p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False + +instance Ord Provenance where + compare LocalDef LocalDef = EQ + compare LocalDef (NonLocalDef _ _) = LT + compare (NonLocalDef _ _) LocalDef = GT + + compare (NonLocalDef reason1 _) (NonLocalDef reason2 _) + = compare reason1 reason2 + +instance Ord ImportReason where + compare ImplicitImport ImplicitImport = EQ + compare ImplicitImport (UserImport _ _ _) = LT + compare (UserImport _ _ _) ImplicitImport = GT + compare (UserImport m1 loc1 _) (UserImport m2 loc2 _) + = (m1 `compare` m2) `thenCmp` (loc1 `compare` loc2) + data ImportReason = UserImport Module SrcLoc Bool -- Imported from module M on line L @@ -482,7 +560,7 @@ hasBetterProv (NonLocalDef (UserImport _ _ _ ) _) (NonLocalDef ImplicitImport hasBetterProv _ _ = False pprNameProvenance :: Name -> Provenance -> SDoc -pprNameProvenance name LocalDef = ptext SLIT("defined at") <+> ppr (nameSrcLoc name) +pprNameProvenance name LocalDef = ptext SLIT("defined at") <+> ppr (nameSrcLoc name) pprNameProvenance name (NonLocalDef why _) = sep [ppr_reason why, nest 2 (parens (ppr_defn (nameSrcLoc name)))]