Commit 348639a3 authored by sewardj's avatar sewardj
Browse files

[project @ 2000-10-16 13:29:13 by sewardj]

make HscTypes and RnMonad compilable
parent bc28a148
......@@ -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
}
......
......@@ -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
......
......@@ -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;
......
......@@ -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
......
......@@ -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)
......
......@@ -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,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment