X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FHscTypes.lhs;h=5bd9e1630b1506c1ed06dd9f0fb05c283d05aef8;hb=61fae1d3fb61c5f53c3fbcb94afe7c548ad31591;hp=7667b4517dcaa97f6ed73ca2098e7a8fad8a5e7a;hpb=b506bbfb8480556d40fce2f488daf85181344d96;p=ghc-hetmet.git diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 7667b45..5bd9e16 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -5,6 +5,8 @@ \begin{code} module HscTypes ( + GhciMode(..), + ModuleLocation(..), ModDetails(..), ModIface(..), @@ -24,13 +26,14 @@ module HscTypes ( TypeEnv, lookupType, mkTypeEnv, emptyTypeEnv, extendTypeEnvList, extendTypeEnvWithIds, - typeEnvClasses, typeEnvTyCons, typeEnvIds, + typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds, ImportedModuleInfo, WhetherHasOrphans, ImportVersion, WhatsImported(..), PersistentRenamerState(..), IsBootInterface, DeclsMap, - IfaceInsts, IfaceRules, GatedDecl, GatedDecls, IsExported, + IfaceInsts, IfaceRules, GatedDecl, GatedDecls, GateFn, IsExported, NameSupply(..), OrigNameCache, OrigIParamCache, - Avails, AvailEnv, GenAvailInfo(..), AvailInfo, RdrAvailInfo, + Avails, AvailEnv, emptyAvailEnv, + GenAvailInfo(..), AvailInfo, RdrAvailInfo, PersistentCompilerState(..), Deprecations(..), lookupDeprec, @@ -50,7 +53,8 @@ module HscTypes ( #include "HsVersions.h" -import RdrName ( RdrNameEnv, addListToRdrEnv, emptyRdrEnv, mkRdrUnqual, rdrEnvToList ) +import RdrName ( RdrName, RdrNameEnv, addListToRdrEnv, emptyRdrEnv, + mkRdrUnqual, rdrEnvToList ) import Name ( Name, NamedThing, getName, nameOccName, nameModule, nameSrcLoc ) import NameEnv import OccName ( OccName ) @@ -62,10 +66,10 @@ import Rules ( RuleBase ) import CoreSyn ( CoreBind ) import Id ( Id ) import Class ( Class, classSelIds ) -import TyCon ( TyCon, tyConGenIds, tyConSelIds, tyConDataConsIfAvailable ) +import TyCon ( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataConsIfAvailable ) import DataCon ( dataConId, dataConWrapId ) -import BasicTypes ( Version, initialVersion, Fixity ) +import BasicTypes ( Version, initialVersion, Fixity, IPName ) import HsSyn ( DeprecTxt, tyClDeclName, ifaceRuleDeclName ) import RdrHsSyn ( RdrNameInstDecl, RdrNameRuleDecl, RdrNameTyClDecl ) @@ -84,6 +88,18 @@ import UniqSupply ( UniqSupply ) %************************************************************************ %* * +\subsection{Which mode we're in +%* * +%************************************************************************ + +\begin{code} +data GhciMode = Batch | Interactive | OneShot + deriving Eq +\end{code} + + +%************************************************************************ +%* * \subsection{Module locations} %* * %************************************************************************ @@ -93,7 +109,7 @@ data ModuleLocation = ModuleLocation { ml_hs_file :: Maybe FilePath, ml_hspp_file :: Maybe FilePath, -- path of preprocessed source - ml_hi_file :: Maybe FilePath, + ml_hi_file :: FilePath, ml_obj_file :: Maybe FilePath } deriving Show @@ -125,26 +141,26 @@ 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_boot :: IsBootInterface, -- Whether this interface was read from an hi-boot file + mi_module :: !Module, -- Complete with package info + mi_version :: !VersionInfo, -- Module version number + mi_orphan :: WhetherHasOrphans, -- Whether this module has orphans + mi_boot :: !IsBootInterface, -- 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 - -- (changing usages doesn't affect the version of - -- this module) + 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_exports :: ![(ModuleName,Avails)], + -- What it exports Kept sorted by (mod,occ), to make + -- version comparisons easier - mi_globals :: GlobalRdrEnv, -- Its top level environment + mi_globals :: !GlobalRdrEnv, -- Its top level environment - mi_fixities :: NameEnv Fixity, -- Fixities - mi_deprecs :: Deprecations, -- Deprecations + mi_fixities :: !(NameEnv Fixity), -- Fixities + mi_deprecs :: !Deprecations, -- Deprecations - mi_decls :: IfaceDecls -- The RnDecls form of ModDetails + mi_decls :: IfaceDecls -- The RnDecls form of ModDetails } data IfaceDecls = IfaceDecls { dcl_tycl :: [RenamedTyClDecl], -- Sorted @@ -166,16 +182,16 @@ mkIfaceDecls tycls rules insts data ModDetails = ModDetails { -- 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 :: [IdCoreRule], -- Domain may include Ids from other modules - md_binds :: [CoreBind] + md_types :: !TypeEnv, + md_insts :: ![DFunId], -- Dfun-ids for the instances in this module + md_rules :: ![IdCoreRule], -- Domain may include Ids from other modules + md_binds :: ![CoreBind] } -- The ModDetails takes on several slightly different forms: -- -- After typecheck + desugar --- md_types Contains TyCons, Classes, and hasNoBinding Ids +-- md_types Contains TyCons, Classes, and implicit Ids -- md_insts All instances from this module (incl derived ones) -- md_rules All rules from this module -- md_binds Desugared bindings @@ -207,13 +223,6 @@ data ModDetails \end{code} \begin{code} -emptyModDetails :: ModDetails -emptyModDetails - = ModDetails { md_types = emptyTypeEnv, - md_insts = [], - md_rules = [] - } - emptyModIface :: Module -> ModIface emptyModIface mod = ModIface { mi_module = mod, @@ -310,9 +319,16 @@ instance Outputable TyThing where ppr (ATyCon tc) = ptext SLIT("ATyCon") <+> ppr tc ppr (AClass cl) = ptext SLIT("AClass") <+> ppr cl -typeEnvClasses env = [cl | AClass cl <- nameEnvElts env] -typeEnvTyCons env = [tc | ATyCon tc <- nameEnvElts env] -typeEnvIds env = [id | AnId id <- nameEnvElts env] + +typeEnvElts :: TypeEnv -> [TyThing] +typeEnvClasses :: TypeEnv -> [Class] +typeEnvTyCons :: TypeEnv -> [TyCon] +typeEnvIds :: TypeEnv -> [Id] + +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 @@ -324,8 +340,13 @@ implicitTyThingIds things go (ATyCon tc) = tyConGenIds tc ++ tyConSelIds tc ++ [ n | dc <- tyConDataConsIfAvailable tc, - n <- [dataConId dc, dataConWrapId dc] ] + 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 = [dataConId dc, dataConWrapId dc] \end{code} @@ -424,7 +445,10 @@ data GenAvailInfo name = Avail name -- An ordinary identifier deriving( Eq ) -- Equality used when deciding if the interface has changed -type AvailEnv = NameEnv AvailInfo -- Maps a Name to the AvailInfo that contains it +type AvailEnv = NameEnv AvailInfo -- Maps a Name to the AvailInfo that contains it + +emptyAvailEnv :: AvailEnv +emptyAvailEnv = emptyNameEnv instance Outputable n => Outputable (GenAvailInfo n) where ppr = pprAvail @@ -493,18 +517,18 @@ type IsExported = Name -> Bool -- True for names that are exported from this mo \begin{code} data PersistentCompilerState = PCS { - pcs_PIT :: PackageIfaceTable, -- Domain = non-home-package modules + pcs_PIT :: !PackageIfaceTable, -- Domain = non-home-package modules -- the mi_decls component is empty - pcs_PTE :: PackageTypeEnv, -- 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 + pcs_insts :: !PackageInstEnv, -- The total InstEnv accumulated from all -- the non-home-package modules - pcs_rules :: PackageRuleBase, -- Ditto RuleEnv + pcs_rules :: !PackageRuleBase, -- Ditto RuleEnv - pcs_PRS :: PersistentRenamerState + pcs_PRS :: !PersistentRenamerState } \end{code} @@ -535,11 +559,11 @@ type PackageRuleBase = RuleBase type PackageInstEnv = InstEnv data PersistentRenamerState - = PRS { prsOrig :: NameSupply, - prsImpMods :: ImportedModuleInfo, - prsDecls :: DeclsMap, - prsInsts :: IfaceInsts, - prsRules :: IfaceRules + = PRS { prsOrig :: !NameSupply, + prsImpMods :: !ImportedModuleInfo, + prsDecls :: !DeclsMap, + prsInsts :: !IfaceInsts, + prsRules :: !IfaceRules } \end{code} @@ -566,7 +590,7 @@ data NameSupply } type OrigNameCache = FiniteMap (ModuleName,OccName) Name -type OrigIParamCache = FiniteMap OccName Name +type OrigIParamCache = FiniteMap (IPName RdrName) (IPName Name) \end{code} @ImportedModuleInfo@ contains info ONLY about modules that have not yet @@ -592,7 +616,13 @@ type IfaceInsts = GatedDecls RdrNameInstDecl type IfaceRules = GatedDecls RdrNameRuleDecl type GatedDecls d = (Bag (GatedDecl d), Int) -- The Int says how many have been sucked in -type GatedDecl d = ([Name], (Module, d)) +type GatedDecl d = (GateFn, (Module, d)) +type GateFn = (Name -> Bool) -> Bool -- Returns True <=> gate is open + -- The (Name -> Bool) fn returns True for visible Names + -- For example, suppose this is in an interface file + -- instance C T where ... + -- We want to slurp this decl if both C and T are "visible" in + -- the importing module. See "The gating story" in RnIfaces for details. \end{code}