From 348639a37fdc4da2b12fb07c5819176bb1d5f098 Mon Sep 17 00:00:00 2001 From: sewardj Date: Mon, 16 Oct 2000 13:29:14 +0000 Subject: [PATCH] [project @ 2000-10-16 13:29:13 by sewardj] make HscTypes and RnMonad compilable --- ghc/compiler/ghci/CmCompile.lhs | 2 +- ghc/compiler/main/HscMain.lhs | 8 ++++---- ghc/compiler/main/HscTypes.lhs | 18 +++++++++++------- ghc/compiler/rename/RnMonad.lhs | 25 ++++++++++++++----------- ghc/compiler/typecheck/TcInstDcls.lhs | 8 ++++---- ghc/compiler/typecheck/TcModule.lhs | 6 +++--- 6 files changed, 37 insertions(+), 30 deletions(-) diff --git a/ghc/compiler/ghci/CmCompile.lhs b/ghc/compiler/ghci/CmCompile.lhs index f06b793..4081c53 100644 --- a/ghc/compiler/ghci/CmCompile.lhs +++ b/ghc/compiler/ghci/CmCompile.lhs @@ -135,7 +135,7 @@ type Avails = [AvailInfo] \begin{code} data PersistentCompilerState = PCS { - pcsPST :: PackageSymbolTable, -- Domain = non-home-package modules + pcs_PST :: PackageSymbolTable, -- Domain = non-home-package modules pcsHP :: RnMonad.HoldingPen, -- Pre-slurped interface bits and pieces pcsNS :: NameSupply -- Allocate uniques for names } diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index 9259a52..e9684bd 100644 --- a/ghc/compiler/main/HscMain.lhs +++ b/ghc/compiler/main/HscMain.lhs @@ -241,10 +241,10 @@ hscMain flags core_cmds stg_cmds summary maybe_old_iface \begin{code} initPersistentCompilerState :: PersistentCompilerState initPersistentCompilerState - = PCS { pcsPST = initPackageDetails, - pcsInsts = emptyInstEnv, - pcsRules = emptyRuleEnv, - pcsPRS = initPersistentRenamerState } + = PCS { pcs_PST = initPackageDetails, + pcs_insts = emptyInstEnv, + pcs_rules = emptyRuleEnv, + pcs_PRS = initPersistentRenamerState } initPackageDetails :: PackageSymbolTable initPackageDetails = extendTypeEnv emptyModuleEnv wiredInThings diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index afc710a..05f39e5 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -6,15 +6,19 @@ \begin{code} module HscTypes ( ModDetails(..), GlobalSymbolTable, + HomeSymbolTable, PackageSymbolTable, TyThing(..), lookupTypeEnv, WhetherHasOrphans, ImportVersion, ExportItem, PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap, IfaceInsts, IfaceRules, DeprecationEnv, OrigNameEnv, AvailEnv, + PersistentCompilerState(..), InstEnv, + GlobalRdrEnv, + -- Provenance Provenance(..), ImportReason(..), PrintUnqualified, pprProvenance, hasBetterProv @@ -290,13 +294,13 @@ data WhatsImported name = NothingAtAll -- The module is below us in the \begin{code} data PersistentCompilerState = PCS { - pcsPST :: PackageSymbolTable, -- Domain = non-home-package modules - -- except that the InstEnv components is empty - pcsInsts :: InstEnv, -- The total InstEnv accumulated from all - -- the non-home-package modules - pcsRules :: RuleEnv, -- Ditto RuleEnv + pcs_PST :: PackageSymbolTable, -- Domain = non-home-package modules + -- except that the InstEnv components is empty + pcs_insts :: InstEnv, -- The total InstEnv accumulated from all + -- the non-home-package modules + pcs_rules :: RuleEnv, -- Ditto RuleEnv - pcsPRS :: PersistentRenamerState + pcs_PRS :: PersistentRenamerState } \end{code} @@ -307,7 +311,7 @@ It contains: * A name supply, which deals with allocating unique names to (Module,OccName) original names, - * An accumulated InstEnv from all the modules in pcsPST + * An accumulated InstEnv from all the modules in pcs_PST The point is that we don't want to keep recreating it whenever we compile a new module. The InstEnv component of pcPST is empty. (This means we might "see" instances that we shouldn't "really" see; diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs index 97b01fc..95e2cb7 100644 --- a/ghc/compiler/rename/RnMonad.lhs +++ b/ghc/compiler/rename/RnMonad.lhs @@ -52,7 +52,7 @@ import Name ( Name, OccName, NamedThing(..), getSrcLoc, import Module ( Module, ModuleName, WhereFrom, moduleName ) import NameSet import CmdLineOpts ( DynFlags, dopt_D_dump_rn_trace ) -import SrcLoc ( SrcLoc, mkGeneratedSrcLoc ) +import SrcLoc ( SrcLoc, generatedSrcLoc ) import Unique ( Unique ) import FiniteMap ( FiniteMap, emptyFM, listToFM, plusFM ) import Bag ( Bag, mapBag, emptyBag, isEmptyBag, snocBag ) @@ -63,7 +63,9 @@ import PrelNames ( mkUnboundName ) import HscTypes ( GlobalSymbolTable, OrigNameEnv, AvailEnv, WhetherHasOrphans, ImportVersion, ExportItem, PersistentRenamerState(..), IsBootInterface, Avails, - DeclsMap, IfaceInsts, IfaceRules, DeprecationEnv ) + DeclsMap, IfaceInsts, IfaceRules, DeprecationEnv, + HomeSymbolTable, PackageSymbolTable, + PersistentCompilerState(..), GlobalRdrEnv ) infixr 9 `thenRn`, `thenRn_` \end{code} @@ -158,7 +160,7 @@ type LocalFixityEnv = NameEnv RenamedFixitySig -- can report line-number info when there is a duplicate -- fixity declaration -lookupLocalFixity :: FixityEnv -> Name -> Fixity +lookupLocalFixity :: LocalFixityEnv -> Name -> Fixity lookupLocalFixity env name = case lookupNameEnv env name of Just (FixitySig _ fix _) -> fix @@ -250,8 +252,9 @@ data Ifaces = Ifaces { -- Subset of the previous field. } -type ImportedModuleInfo = FiniteMap ModuleName (WhetherHasOrphans, IsBootInterface, IsLoaded) -type IsLoaded = True +type ImportedModuleInfo = FiniteMap ModuleName + (WhetherHasOrphans, IsBootInterface, IsLoaded) +type IsLoaded = Bool \end{code} @@ -270,7 +273,7 @@ initRn :: DynFlags -> Finder -> HomeSymbolTable initRn dflags finder hst pcs mod loc do_rn = do - let prs = pcsPRS pcs + let prs = pcs_PRS pcs uniqs <- mkSplitUniqSupply 'r' names_var <- newIORef (uniqs, prsOrig prs) errs_var <- newIORef (emptyBag,emptyBag) @@ -299,14 +302,14 @@ initRn dflags finder hst pcs mod loc do_rn prsDecls = iDecls new_ifaces, prsInsts = iInsts new_ifaces, prsRules = iRules new_ifaces } - let new_pcs = pcs { pcsPST = iPST new_ifaces, - pcsPRS = new_prs } + let new_pcs = pcs { pcs_PST = iPST new_ifaces, + pcs_PRS = new_prs } return (res, new_pcs, (warns, errs)) initIfaces :: PersistentCompilerState -> Ifaces -initIfaces (PCS { pcsPST = pst, psrPRS = prs }) +initIfaces (PCS { pcs_PST = pst, pcs_PRS = prs }) = Ifaces { iPST = pst, iDecls = prsDecls prs, iInsts = prsInsts prs, @@ -321,7 +324,7 @@ initIfaces (PCS { pcsPST = pst, psrPRS = prs }) } -initRnMS :: GlobalRdrEnv -> FixityEnv -> RnMode -> RnMS r -> RnM d r +initRnMS :: GlobalRdrEnv -> LocalFixityEnv -> RnMode -> RnMS r -> RnM d r initRnMS rn_env fixity_env mode thing_inside rn_down g_down = let s_down = SDown { rn_genv = rn_env, rn_lenv = emptyRdrEnv, @@ -362,7 +365,7 @@ renameSourceCode dflags mod prs m newIORef (emptyBag,emptyBag) >>= \ errs_var -> let rn_down = RnDown { rn_dflags = dflags, - rn_loc = mkGeneratedSrcLoc, rn_ns = names_var, + rn_loc = generatedSrcLoc, rn_ns = names_var, rn_errs = errs_var, rn_mod = mod, rn_ifaces = panic "rnameSourceCode: rn_ifaces" -- Not required diff --git a/ghc/compiler/typecheck/TcInstDcls.lhs b/ghc/compiler/typecheck/TcInstDcls.lhs index 26616bc..5bdec50 100644 --- a/ghc/compiler/typecheck/TcInstDcls.lhs +++ b/ghc/compiler/typecheck/TcInstDcls.lhs @@ -182,7 +182,7 @@ tcInstDecls1 pcs hst unf_env this_mod decls mod getGenericInstances mod clas_decls `thenTc` \ generic_inst_info -> -- Next, consruct the instance environment so far, consisting of - -- a) cached non-home-package InstEnv (gotten from pcs) pcsInsts pcs + -- a) cached non-home-package InstEnv (gotten from pcs) pcs_insts pcs -- b) imported instance decls (not in the home package) inst_env1 -- c) other modules in this package (gotten from hst) inst_env2 -- d) local instance decls inst_env3 @@ -195,7 +195,7 @@ tcInstDecls1 pcs hst unf_env this_mod decls mod imported_dfuns = map (tcAddImportedIdInfo unf_env . instInfoDFun) imported_inst_info hst_dfuns = foldModuleEnv ((++) . md_insts) [] hst in - addInstDFuns (pcsInsts pcs) imported_dfuns `thenNF_Tc` \ inst_env1 -> + addInstDFuns (pcs_insts pcs) imported_dfuns `thenNF_Tc` \ inst_env1 -> addInstDFuns inst_env1 hst_dfuns `thenNF_Tc` \ inst_env2 -> addInstInfos inst_env2 local_inst_info `thenNF_Tc` \ inst_env3 -> addInstInfos inst_env3 generic_inst_info `thenNF_Tc` \ inst_env4 -> @@ -206,10 +206,10 @@ tcInstDecls1 pcs hst unf_env this_mod decls mod -- we ignore deriving decls from interfaces! -- This stuff computes a context for the derived instance decl, so it -- needs to know about all the instances possible; hecne inst_env4 - tcDeriving (pcsPRS pcs) this_mod inst_env4 local_tycons `thenTc` \ (deriv_inst_info, deriv_binds) -> + tcDeriving (pcs_PRS pcs) this_mod inst_env4 local_tycons `thenTc` \ (deriv_inst_info, deriv_binds) -> addInstInfos inst_env4 deriv_inst_info `thenNF_Tc` \ final_inst_env -> - returnTc (pcs { pcsInsts = inst_env1 }, + returnTc (pcs { pcs_insts = inst_env1 }, final_inst_env, generic_inst_info ++ deriv_inst_info ++ local_inst_info, deriv_binds) diff --git a/ghc/compiler/typecheck/TcModule.lhs b/ghc/compiler/typecheck/TcModule.lhs index 8b72465..9bb9fbf 100644 --- a/ghc/compiler/typecheck/TcModule.lhs +++ b/ghc/compiler/typecheck/TcModule.lhs @@ -100,7 +100,7 @@ typecheckModule pcs hst (HsModule mod_name _ _ _ decls _ src_loc) } where this_mod = mkThisModule - global_symbol_table = pcsPST pcs `plusModuleEnv` hst + global_symbol_table = pcs_PST pcs `plusModuleEnv` hst tc_module = fixTc (\ ~(unf_env ,_) -> tcModule pcs hst this_mod decls unf_env) \end{code} @@ -237,10 +237,10 @@ tcModule pcs hst this_mod decls unf_env local_type_env = lookupWithDefaultFM groups this_mod emptyNameEnv new_pst :: PackageSymbolTable - new_pst = extendTypeEnv (pcsPST pcs) (delFromFM groups this_mod) + new_pst = extendTypeEnv (pcs_PST pcs) (delFromFM groups this_mod) final_pcs :: PersistentCompilerState - final_pcs = pcs_with_insts {pcsPST = new_pst} + final_pcs = pcs_with_insts {pcs_PST = new_pst} in returnTc (really_final_env, TcResults { tc_pcs = final_pcs, -- 1.7.10.4