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

Commit the rest of today's stuff

diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs
index f18b11e..b457bff 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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}