From 435b542fea3ccda11376b0422a5ee564ddeba5c7 Mon Sep 17 00:00:00 2001 From: sewardj Date: Thu, 12 Oct 2000 16:26:41 +0000 Subject: [PATCH] [project @ 2000-10-12 16:26:41 by sewardj] Commit the rest of today's stuff --- ghc/compiler/main/HscTypes.lhs | 37 +++++++++++++++++++++++++++++++++---- ghc/compiler/rename/RnMonad.lhs | 38 +++++++++++++++++++------------------- ghc/compiler/typecheck/TcEnv.lhs | 18 +++++++++--------- 3 files changed, 61 insertions(+), 32 deletions(-) diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index f18b11e..b457bff 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -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)) diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs index 6f8c17c..6e81a9d 100644 --- a/ghc/compiler/rename/RnMonad.lhs +++ b/ghc/compiler/rename/RnMonad.lhs @@ -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 diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs index fd3d9c1..0444dd9 100644 --- a/ghc/compiler/typecheck/TcEnv.lhs +++ b/ghc/compiler/typecheck/TcEnv.lhs @@ -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} -- 1.7.10.4