From: simonpj Date: Wed, 11 Oct 2000 16:31:27 +0000 (+0000) Subject: [project @ 2000-10-11 16:31:27 by simonpj] X-Git-Tag: Approximately_9120_patches~3631 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=e73218c6a995e56a60eab34594802d6a1067a604;p=ghc-hetmet.git [project @ 2000-10-11 16:31:27 by simonpj] Beginnings of renamer and typechecker stuff --- diff --git a/ghc/compiler/ghci/CmCompile.lhs b/ghc/compiler/ghci/CmCompile.lhs index b61d1b5..0a78637 100644 --- a/ghc/compiler/ghci/CmCompile.lhs +++ b/ghc/compiler/ghci/CmCompile.lhs @@ -68,6 +68,102 @@ cmCompile finder summary old_iface hst pcs [] ) +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 + [SDoc] -- warnings + + | CompErrs 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 HomeSymbolTable = ModuleEnv ModDetails -- ditto +type HomeInterfaceTable = ModuleEnv ModIFace +\end{code} + + +%************************************************************************ +%* * +\subsection{Module details} +%* * +%************************************************************************ + +A @ModDetails@ summarises everything we know about a compiled module + +\begin{code} +data ModDetails + = ModDetails { + moduleExports :: Avails, -- What it exports + moduleEnv :: GlobalRdrEnv, -- Its top level environment + + fixityEnv :: NameEnv Fixity, + deprecEnv :: NameEnv DeprecTxt, + typeEnv :: NameEnv TcEnv.TyThing, + + instEnv :: InstEnv, + ruleEnv :: IdEnv [CoreRule] -- Domain includes Ids from other modules + } +\end{code} + +Auxiliary definitions + +\begin{code} +type DeprecationEnv = NameEnv DeprecTxt -- Give reason for deprecation + +type GlobalRdrEnv = RdrNameEnv [Name] -- The list is because there may be name clashes + -- These only get reported on lookup, + -- not on construction + +data GenAvailInfo name = Avail name -- An ordinary identifier + | AvailTC name -- The name of the type or class + [name] -- The available pieces of type/class. + -- NB: If the type or class is itself + -- to be in scope, it must be in this list. + -- Thus, typically: AvailTC Eq [Eq, ==, /=] + 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 AvailInfo = GenAvailInfo Name +type RdrAvailInfo = GenAvailInfo OccName +type Avails = [AvailInfo] +\end{code} + + +%************************************************************************ +%* * +\subsection{The persistent compiler state} +%* * +%************************************************************************ + +\begin{code} +data PersistentCompilerState + = PCS { + pcsPST :: PackageSymbolTable, -- Domain = non-home-package modules + pcsHP :: RnMonad.HoldingPen, -- Pre-slurped interface bits and pieces + pcsNS :: NameSupply -- Allocate uniques for names + } + +type PackageSymbolTable = ModuleEnv ModDetails + +data NameSupply + = NS { nsUniqs :: UniqSupply, + nsNames :: FiniteMap (Module,OccName) Name -- Ensures that one original name gets one unique + nsIParam :: FiniteMap OccName Name -- Ensures that one implicit parameter name gets one unique + } +======= +>>>>>>> 1.9 +======= + -- should be somewhere else? emptyPCS :: IO PersistentCompilerState emptyPCS = return (PersistentCompilerState @@ -75,5 +171,6 @@ emptyPCS = return (PersistentCompilerState pcs_pit = emptyPIT, pcs_pst = emptyPST, pcs_hp = emptyHoldingPen }) +>>>>>>> 1.10 \end{code} diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index e274124..64e2a6b 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -13,7 +13,7 @@ where %************************************************************************ %* * -\subsection{Module details} +\subsection{Symbol tables and Module details} %* * %************************************************************************ @@ -34,9 +34,22 @@ data ModDetails } \end{code} +Symbol tables map modules to ModDetails: + +\begin{code} +type HomeSymbolTable = ModuleEnv ModDetails -- Domain = modules in the home package +type PackageSymbolTable = ModuleEnv ModDetails -- Domain = modules in the some other package +type GlobalSymbolTable = ModuleEnv ModDetails -- Domain = all modules +\end{code} + + Auxiliary definitions \begin{code} +data TyThing = AnId Id + | ATyCon TyCon + | AClass Class + type DeprecationEnv = NameEnv DeprecTxt -- Give reason for deprecation type GlobalRdrEnv = RdrNameEnv [Name] -- The list is because there may be name clashes @@ -84,6 +97,7 @@ data ModIFace } \end{code} + %************************************************************************ %* * \subsection{The persistent compiler state} @@ -93,20 +107,47 @@ data ModIFace \begin{code} data PersistentCompilerState = PCS { - pcsPST :: PackageSymbolTable, -- Domain = non-home-package modules - pcsHP :: HoldingPen, -- Pre-slurped interface bits and pieces - pcsNS :: NameSupply -- Allocate uniques for names + pcsPST :: PackageSymbolTable, -- Domain = non-home-package modules + pcsPRS :: PersistentRenamerState } +\end{code} + +The @PersistentRenamerState@ persists across successive calls to the +compiler. -type PackageSymbolTable = ModuleEnv ModDetails +It contains: + * a name supply, which deals with allocating unique names to + (Module,OccName) original names, + + * a "holding pen" for declarations that have been read out of + interface files but not yet sucked in, renamed, and typechecked + +\begin{code} +data PersistentRenamerState + = PRS { prsNS :: NameSupply, + prsDecls :: DeclsMap, + prsInsts :: IfaceInsts, + prsRules :: IfaceRules, + } data NameSupply = NS { nsUniqs :: UniqSupply, nsNames :: FiniteMap (Module,OccName) Name -- Ensures that one original name gets one unique nsIParam :: FiniteMap OccName Name -- Ensures that one implicit parameter name gets one unique } + +type DeclsMap = NameEnv (Version, AvailInfo, Bool, (Module, RdrNameHsDecl)) + -- A DeclsMap contains a binding for each Name in the declaration + -- including the constructors of a type decl etc. + -- The Bool is True just for the 'main' Name. + +type IfaceInsts = Bag GatedDecl +type IfaceRules = Bag GatedDecl + +type GatedDecl = (NameSet, (Module, RdrNameHsDecl)) \end{code} + %************************************************************************ %* * \subsection{The result of compiling one module} @@ -119,12 +160,12 @@ data CompResult (Maybe (ModIFace, Linkable)) -- summary and code; Nothing => compilation not reqd -- (old summary and code are still valid) - PersistentCompilerState -- updated PCS - [SDoc] -- warnings + PersistentCompilerState -- updated PCS + (Bag WarnMsg) -- warnings - | CompErrs PersistentCompilerState -- updated PCS - [SDoc] -- errors - [SDoc] -- warnings + | CompErrs PersistentCompilerState -- updated PCS + (Bag ErrMsg) -- errors + (Bag WarnMsg) -- warnings -- The driver sits between 'compile' and 'hscMain', translating calls @@ -146,15 +187,12 @@ data HscResult [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 HomeSymbolTable = ModuleEnv ModDetails -- ditto type HomeInterfaceTable = ModuleEnv ModIFace - \end{code} diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs index 93437ca..cc228ae 100644 --- a/ghc/compiler/rename/Rename.lhs +++ b/ghc/compiler/rename/Rename.lhs @@ -80,12 +80,13 @@ type RenameResult = ( Module -- This module , FixityEnv -- The fixity environment; for derivings , [Module]) -- Imported modules -renameModule :: UniqSupply -> RdrNameHsModule -> IO (Maybe RenameResult) -renameModule us this_mod@(HsModule mod_name vers exports imports local_decls _ loc) +renameModule :: PersistentCompilerState -> RdrNameHsModule -> IO (Maybe RenameResult) +renameModule pcs this_mod@(HsModule mod_name vers exports imports local_decls _ loc) = -- Initialise the renamer monad do { ((maybe_rn_stuff, dump_action), rn_errs_bag, rn_warns_bag) - <- initRn (mkThisModule mod_name) us + <- initRn pcs + (mkThisModule mod_name) (mkSearchPath opt_HiMap) loc (rename this_mod) ; diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs index c6f6c1e..f266b24 100644 --- a/ghc/compiler/rename/RnMonad.lhs +++ b/ghc/compiler/rename/RnMonad.lhs @@ -103,24 +103,27 @@ type RnMS r = RnM SDown r -- Renaming source type RnMG r = RnM () r -- Getting global names etc -- Common part -data RnDown = RnDown { - rn_mod :: Module, - rn_loc :: SrcLoc, - rn_ns :: IORef RnNameSupply, - rn_errs :: IORef (Bag WarnMsg, Bag ErrMsg), - rn_ifaces :: IORef Ifaces, - rn_hi_maps :: (SearchPath, -- For error messages - ModuleHiMap, -- for .hi files - ModuleHiMap) -- for .hi-boot files - } +data RnDown + = RnDown { + rn_mod :: Module, -- This module + rn_loc :: SrcLoc, -- Current locn + + rn_finder :: Finder, + rn_flags :: DynFlags, + rn_gst :: GlobalSymbolTable, -- Both home modules and packages, + -- at the moment we started compiling + -- this module + + rn_errs :: IORef (Bag WarnMsg, Bag ErrMsg), + rn_ns :: IORef NameSupply, + rn_ifaces :: IORef Ifaces, + } -- For renaming source code data SDown = SDown { rn_mode :: RnMode, - rn_genv :: GlobalRdrEnv, - -- Global envt; the fixity component gets extended - -- with local fixity decls + rn_genv :: GlobalRdrEnv, -- Global envt rn_lenv :: LocalRdrEnv, -- Local name envt -- Does *not* include global name envt; may shadow it @@ -162,46 +165,15 @@ lookupFixity env name = case lookupNameEnv env name of Just (FixitySig _ fix _) -> fix Nothing -> defaultFixity - --------------------------------- -type DeprecationEnv = NameEnv DeprecTxt \end{code} \begin{code} --------------------------------- -type RnNameSupply - = ( UniqSupply - - , FiniteMap (ModuleName, OccName) Name - -- Ensures that one (module,occname) pair gets one unique - , FiniteMap OccName Name - -- Ensures that one implicit parameter name gets one unique - ) - - --------------------------------- -type Avails = [AvailInfo] - type ExportAvails = (FiniteMap ModuleName Avails, -- Used to figure out "module M" export specifiers -- Includes avails only from *unqualified* imports -- (see 1.4 Report Section 5.1.1) AvailEnv) -- Used to figure out all other export specifiers. - - -data GenAvailInfo name = Avail name -- An ordinary identifier - | AvailTC name -- The name of the type or class - [name] -- The available pieces of type/class. - -- NB: If the type or class is itself - -- to be in scope, it must be in this list. - -- Thus, typically: AvailTC Eq [Eq, ==, /=] - 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 AvailInfo = GenAvailInfo Name -type RdrAvailInfo = GenAvailInfo OccName \end{code} %=================================================== @@ -264,7 +236,16 @@ data ParsedIface type RdrNamePragma = () -- Fudge for now ------------------- +%************************************************************************ +%* * +\subsection{The renamer state} +%* * +%************************************************************************ + +\begin{code} data Ifaces = Ifaces { + + -- PERSISTENT FIELDS iImpModInfo :: ImportedModuleInfo, -- Modules this one depends on: that is, the union -- of the modules its *direct* imports depend on. @@ -272,26 +253,8 @@ data Ifaces = Ifaces { -- dependencies (direct or not) of the imported module. iDecls :: DeclsMap, -- A single, global map of Names to decls - - iDeferred :: NameSet, -- data (not newtype) TyCons that have been slurped, - -- but none of their constructors have. - -- If this is still the case right at the end -- we can get away with importing them abstractly - iFixes :: FixityEnv, - -- A single, global map of Names to fixities - -- See comments with RnIfaces.lookupFixity - - iSlurp :: NameSet, - -- All the names (whether "big" or "small", whether wired-in or not, - -- whether locally defined or not) that have been slurped in so far. - - iVSlurp :: [(Name,Version)], - -- All the (a) non-wired-in (b) "big" (c) non-locally-defined - -- names that have been slurped in so far, with their versions. - -- This is used to generate the "usage" information for this module. - -- Subset of the previous field. - iInsts :: IfaceInsts, -- The as-yet un-slurped instance decls; this bag is depleted when we -- slurp an instance decl so that we don't slurp the same one twice. @@ -301,13 +264,31 @@ data Ifaces = Ifaces { iRules :: IfaceRules, -- Similar to instance decls, only for rules - iDeprecs :: DeprecationEnv - } + -- SEMI-EPHEMERAL FIELDS + -- iFixes and iDeprecs are accumulated here while one module + -- is compiled, but are transferred to the package symbol table + -- at the end. We don't add them to the table as we encounter them + -- because doing so would require us to have a mutable symbol table + -- which is yukky. + + iFixes :: FixityEnv, -- A single, global map of Names to fixities + -- See comments with RnIfaces.lookupFixity + iDeprecs :: DeprecationEnv, -type IfaceInsts = Bag GatedDecl -type IfaceRules = Bag GatedDecl -type GatedDecl = (NameSet, (Module, RdrNameHsDecl)) + -- EPHEMERAL FIELDS + -- These fields persist during the compilation of a single module only + + iSlurp :: NameSet, + -- All the names (whether "big" or "small", whether wired-in or not, + -- whether locally defined or not) that have been slurped in so far. + + iVSlurp :: [(Name,Version)], + -- All the (a) non-wired-in (b) "big" (c) non-locally-defined + -- names that have been slurped in so far, with their versions. + -- This is used to generate the "usage" information for this module. + -- Subset of the previous field. + } type ImportedModuleInfo = FiniteMap ModuleName (WhetherHasOrphans, IsBootInterface, @@ -332,11 +313,6 @@ type ImportedModuleInfo -- A.hi or A.hi-boot when importing A.f. -- Basically, we look for A.hi if A is in the map, and A.hi-boot -- otherwise - -type DeclsMap = NameEnv (Version, AvailInfo, Bool, (Module, RdrNameHsDecl)) - -- A DeclsMap contains a binding for each Name in the declaration - -- including the constructors of a type decl etc. - -- The Bool is True just for the 'main' Name. \end{code} @@ -347,21 +323,29 @@ type DeclsMap = NameEnv (Version, AvailInfo, Bool, (Module, RdrNameHsDecl)) %************************************************************************ \begin{code} -initRn :: Module -> UniqSupply -> SearchPath -> SrcLoc +initRn :: DynFlags -> Finder -> GlobalSymbolTable + -> PersistentRenamerState + -> Module -> SrcLoc -> RnMG r -> IO (r, Bag ErrMsg, Bag WarnMsg) -initRn mod us dirs loc do_rn = do +initRn flags finder gst prs mod loc do_rn = do himaps <- mkModuleHiMaps dirs - names_var <- newIORef (us, builtins, emptyFM) + names_var <- newIORef (prsNS pcs) errs_var <- newIORef (emptyBag,emptyBag) - iface_var <- newIORef emptyIfaces + iface_var <- newIORef (initIfaces prs) let - rn_down = RnDown { rn_loc = loc, rn_ns = names_var, - rn_errs = errs_var, - rn_hi_maps = himaps, + rn_down = RnDown { rn_mod = mod, + rn_loc = loc, + + rn_finder = finder, + rn_flags = flags, + rn_gst = gst, + + rn_ns = names_var, + rn_errs = errs_var, rn_ifaces = iface_var, - rn_mod = mod } + } -- do the business res <- do_rn rn_down () @@ -372,6 +356,25 @@ initRn mod us dirs loc do_rn = do return (res, errs, warns) +initIfaces :: PersistentRenamerState -> Ifaces +initIfaces prs + = Ifaces { iDecls = prsDecls prs, + iInsts = prsInsts prs, + iRules = prsRules rules, + + iFixes = emptyNameEnv, + iDeprecs = emptyNameEnv, + + iImpModInfo = emptyFM, + iDeferred = emptyNameSet, + iSlurp = unitNameSet (mkUnboundName dummyRdrVarName), + -- Pretend that the dummy unbound name has already been + -- slurped. This is what's returned for an out-of-scope name, + -- and we don't want thereby to try to suck it in! + iVSlurp = [] + } + + initRnMS :: GlobalRdrEnv -> FixityEnv -> RnMode -> RnMS r -> RnM d r initRnMS rn_env fixity_env mode thing_inside rn_down g_down = let @@ -385,21 +388,6 @@ initIfaceRnMS mod thing_inside = initRnMS emptyRdrEnv emptyNameEnv InterfaceMode $ setModuleRn mod thing_inside -emptyIfaces :: Ifaces -emptyIfaces = Ifaces { iImpModInfo = emptyFM, - iDecls = emptyNameEnv, - iDeferred = emptyNameSet, - iFixes = emptyNameEnv, - iSlurp = unitNameSet (mkUnboundName dummyRdrVarName), - -- Pretend that the dummy unbound name has already been - -- slurped. This is what's returned for an out-of-scope name, - -- and we don't want thereby to try to suck it in! - iVSlurp = [], - iInsts = emptyBag, - iRules = emptyBag, - iDeprecs = emptyNameEnv - } - builtins :: FiniteMap (ModuleName,OccName) Name builtins = listToFM wired_in `plusFM` listToFM known_key where @@ -415,12 +403,12 @@ that is, not as part of the main renamer. Sole examples: derived definitions, which are only generated in the type checker. -The @RnNameSupply@ includes a @UniqueSupply@, so if you call it more than +The @NameSupply@ includes a @UniqueSupply@, so if you call it more than once you must either split it, or install a fresh unique supply. \begin{code} renameSourceCode :: Module - -> RnNameSupply + -> NameSupply -> RnMS r -> r @@ -604,11 +592,11 @@ getSrcLocRn down l_down %===================== \begin{code} -getNameSupplyRn :: RnM d RnNameSupply +getNameSupplyRn :: RnM d NameSupply getNameSupplyRn rn_down l_down = readIORef (rn_ns rn_down) -setNameSupplyRn :: RnNameSupply -> RnM d () +setNameSupplyRn :: NameSupply -> RnM d () setNameSupplyRn names' (RnDown {rn_ns = names_var}) l_down = writeIORef names_var names' diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs index bde67ba..b1fd639 100644 --- a/ghc/compiler/typecheck/TcEnv.lhs +++ b/ghc/compiler/typecheck/TcEnv.lhs @@ -145,27 +145,37 @@ Data type declarations ~~~~~~~~~~~~~~~~~~~~~ \begin{code} -data TcEnv = TcEnv - UsageEnv - TypeEnv - ValueEnv - InstEnv - (TcTyVarSet, -- The in-scope TyVars - TcRef TcTyVarSet) -- Free type variables of the value env - -- ...why mutable? see notes with tcGetGlobalTyVars - -- Includes the in-scope tyvars +data TcEnv + = TcEnv { + tcGST :: GlobalSymbolTable, -- The symbol table at the moment we began this compilation + + tcGEnv :: NameEnv TyThing -- The global type environment we've accumulated while + -- compiling this module: + -- types and classes (both imported and local) + -- imported Ids + -- (Ids defined in this module are in the local envt) + -- When type checking is over we'll augment the + -- global symbol table with everything in tcGEnv + + tcInst :: InstEnv, -- All instances (both imported and in this module) + + tcLEnv :: NameEnv TcTyThing, -- The local type environment: Ids and TyVars + -- defined in this module + + tcTyVars :: FreeTyVars -- Type variables free in tcLST + } -type UsageEnv = NameEnv UVar -type TypeEnv = NameEnv TyThing -type ValueEnv = NameEnv Id + +type InScopeTyVars = (TcTyVarSet, -- The in-scope TyVars + TcRef TcTyVarSet) -- Free type variables of the value env + -- ...why mutable? see notes with tcGetGlobalTyVars valueEnvIds :: ValueEnv -> [Id] valueEnvIds ve = nameEnvElts ve -data TyThing = ATyVar TyVar - | ATyCon TyCon - | AClass Class - | AThing TcKind -- Used temporarily, during kind checking +data TcTyThing = ATyVar TyVar + | ATcId TcId + | AThing TcKind -- Used temporarily, during kind checking -- For example, when checking (forall a. T a Int): -- 1. We first bind (a -> AThink kv), where kv is a kind variable. -- 2. Then we kind-check the (T a Int) part.