Commit 435b542f authored by sewardj's avatar sewardj
Browse files

[project @ 2000-10-12 16:26:41 by sewardj]

Commit the rest of today's stuff
parent 3c973b80
......@@ -9,6 +9,29 @@ where
#include "HsVersions.h"
import Name ( Name, NameEnv )
import Module ( Module, ModuleName )
import Class ( Class )
import OccName ( OccName )
import RdrName ( RdrNameEnv )
import Outputable ( SDoc )
import UniqFM ( UniqFM )
import FiniteMap ( FiniteMap )
import Bag ( Bag )
import Id ( Id )
import VarEnv ( IdEnv )
import BasicTypes ( Version, Fixity )
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 RnMonad ( ImportVersion, ExportItem, WhetherHasOrphans )
import NameSet ( NameSet )
\end{code}
%************************************************************************
......@@ -17,7 +40,7 @@ where
%* *
%************************************************************************
A @ModDetails@ summarises everything we know about a compiled module
A @ModDetails@ summarises everything we know about a compiled module.
\begin{code}
data ModDetails
......@@ -56,8 +79,7 @@ type PackageSymbolTable = SymbolTable -- Domain = modules in the some other pack
type GlobalSymbolTable = SymbolTable -- Domain = all modules
\end{code}
Simple lookups in the symbol table
Simple lookups in the symbol table.
\begin{code}
lookupFixityEnv :: SymbolTable -> Name -> Fixity
......@@ -235,12 +257,19 @@ data PersistentRenamerState
= PRS { prsOrig :: OrigNameEnv,
prsDecls :: DeclsMap,
prsInsts :: IfaceInsts,
prsRules :: IfaceRules,
prsRules :: IfaceRules
}
<<<<<<< HscTypes.lhs
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
=======
data OrigNameEnv
= Orig { origNames :: FiniteMap (Module,OccName) Name -- Ensures that one original name gets one unique
origIParam :: FiniteMap OccName Name -- Ensures that one implicit parameter name gets one unique
>>>>>>> 1.6
}
type DeclsMap = NameEnv (Version, AvailInfo, Bool, (Module, RdrNameHsDecl))
......
......@@ -329,29 +329,29 @@ initRn :: DynFlags -> Finder -> GlobalSymbolTable
-> Module -> SrcLoc
initRn dflags finder gst prs mod loc do_rn
= do { uniqs <- mkSplitUniqSupply 'r'
names_var <- newIORef (uniqs, prsOrig pcs)
errs_var <- newIORef (emptyBag,emptyBag)
iface_var <- newIORef (initIfaces prs)
let rn_down = RnDown { rn_mod = mod,
rn_loc = loc,
rn_finder = finder,
rn_dflags = dflags,
rn_gst = gst,
= do uniqs <- mkSplitUniqSupply 'r'
names_var <- newIORef (uniqs, prsOrig pcs)
errs_var <- newIORef (emptyBag,emptyBag)
iface_var <- newIORef (initIfaces prs)
let rn_down = RnDown { rn_mod = mod,
rn_loc = loc,
rn_finder = finder,
rn_dflags = dflags,
rn_gst = gst,
rn_ns = names_var,
rn_errs = errs_var,
rn_ifaces = iface_var,
}
rn_ns = names_var,
rn_errs = errs_var,
rn_ifaces = iface_var,
}
-- do the business
res <- do_rn rn_down ()
-- do the business
res <- do_rn rn_down ()
-- grab errors and return
(warns, errs) <- readIORef errs_var
-- grab errors and return
(warns, errs) <- readIORef errs_var
return (res, errs, warns)
return (res, errs, warns)
initIfaces :: PersistentRenamerState -> Ifaces
......
......@@ -89,7 +89,7 @@ data TcEnv
tcInsts :: InstEnv, -- All instances (both imported and in this module)
tcGEnv :: NameEnv TyThing -- The global type environment we've accumulated while
tcGEnv :: NameEnv TyThing, -- The global type environment we've accumulated while
-- compiling this module:
-- types and classes (both imported and local)
-- imported Ids
......@@ -172,15 +172,15 @@ data TyThingDetails = SynTyDetails Type
lookup_global :: TcEnv -> Name -> Maybe TyThing
-- Try the global envt and then the global symbol table
lookup_global env name
= case lookupNameEnv (tcGEnv env) name of {
Just thing -> Just thing ;
= case lookupNameEnv (tcGEnv env) name of
Just thing -> Just thing
Nothing -> lookupTypeEnv (tcGST env) name
lookup_local :: TcEnv -> Name -> Maybe TcTyThing
-- Try the local envt and then try the global
lookup_local env name
= case lookupNameEnv (tcLEnv env) name of
Just thing -> Just thing ;
= case lookupNameEnv (tcLEnv env) name of
Just thing -> Just thing
Nothing -> case lookup_global env name of
Just thing -> AGlobal thing
Nothing -> Nothing
......@@ -323,9 +323,9 @@ tcLookupGlobalId name
tcLookupDataCon :: Name -> TcM DataCon
tcLookupDataCon con_name
= tcLookupGlobalId con_name `thenNF_Tc` \ con_id ->
case isDataConWrapId_maybe con_id of {
case isDataConWrapId_maybe con_id of
Just data_con -> returnTc data_con
Nothing -> failWithTc (badCon con_id);
Nothing -> failWithTc (badCon con_id)
tcLookupClass :: Name -> NF_TcM Class
......@@ -435,7 +435,7 @@ tcExtendLocalValEnv names_w_ids thing_inside
tcExtendGlobalTyVars extra_global_tvs thing_inside
= tcGetEnv `thenNF_Tc` \ env ->
tc_extend_gtvs (tcTyVars env) extra_global_tvs `thenNF_Tc` \ gtvs' ->
tcSetEnv (env {tcTyVars = gtvs') thing_inside
tcSetEnv (env {tcTyVars = gtvs'}) thing_inside
tc_extend_gtvs gtvs extra_global_tvs
= tcReadMutVar gtvs `thenNF_Tc` \ global_tvs ->
......@@ -487,6 +487,6 @@ tcSetInstEnv ie thing_inside
\begin{code}
badCon con_id = quotes (ppr con_id) <+> ptext SLIT("is not a data constructor")
notFound where name = failWithTc (text where <> colon <+> quotes (ppr name) <+>
notFound wheRe name = failWithTc (text wheRe <> colon <+> quotes (ppr name) <+>
ptext SLIT("is not in scope"))
\end{code}
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