[project @ 2000-09-22 15:56:12 by simonpj]

[ghc-hetmet.git] / ghc / compiler / rename / RnNames.lhs

diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index f07651e..5988b32 100644 (file)
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -10,20 +10,15 @@ module RnNames (
 
 #include "HsVersions.h"
 
-import CmdLineOpts    ( opt_NoImplicitPrelude, opt_WarnDuplicateExports, 
-                       opt_SourceUnchanged, opt_WarnUnusedBinds
-                     )
-
-import HsSyn   ( HsModule(..), HsDecl(..), TyClDecl(..),
-                 IE(..), ieName, 
-                 ForeignDecl(..), ForKind(..), isDynamicExtName,
-                 FixitySig(..), Sig(..), ImportDecl(..),
+import CmdLineOpts    ( opt_NoImplicitPrelude, opt_WarnDuplicateExports, opt_SourceUnchanged )
+
+import HsSyn   ( HsModule(..), HsDecl(..), IE(..), ieName, ImportDecl(..),
                  collectTopBinders
                )
 import RdrHsSyn        ( RdrNameIE, RdrNameImportDecl,
                  RdrNameHsModule, RdrNameHsDecl
                )
-import RnIfaces        ( getInterfaceExports, getDeclBinders, getDeclSysBinders,
+import RnIfaces        ( getInterfaceExports, getDeclBinders, 
                  recordLocalSlurps, checkModUsage, findAndReadIface, outOfDate
                )
 import RnEnv
@@ -36,17 +31,17 @@ import Bag  ( bagToList )
 import Module  ( ModuleName, mkThisModule, pprModuleName, WhereFrom(..) )
 import NameSet
 import Name    ( Name, ExportFlag(..), ImportReason(..), Provenance(..),
-                 isLocallyDefined, setNameProvenance,
-                 nameOccName, getSrcLoc, pprProvenance, getNameProvenance
+                 setNameProvenance,
+                 nameOccName, getSrcLoc, pprProvenance, getNameProvenance,
+                 nameEnvElts
                )
 import RdrName ( RdrName, rdrNameOcc, setRdrNameOcc, mkRdrQual, mkRdrUnqual, isQual, isUnqual )
 import OccName ( setOccNameSpace, dataName )
-import SrcLoc  ( SrcLoc )
 import NameSet ( elemNameSet, emptyNameSet )
 import Outputable
 import Maybes  ( maybeToBool, catMaybes, mapMaybe )
-import UniqFM   ( emptyUFM, listToUFM, plusUFM_C )
-import Util    ( removeDups, equivClassesByUniq, sortLt )
+import UniqFM   ( emptyUFM, listToUFM )
+import Util    ( removeDups, sortLt )
 import List    ( partition )
 \end{code}
 
@@ -81,7 +76,6 @@ getGlobalNames (HsModule this_mod _ exports imports decls _ mod_loc)
           rec_exp_fn :: Name -> ExportFlag
           rec_exp_fn = mk_export_fn (availsToNameSet rec_export_avails)
        in
-       setModuleRn this_mod                    $
 
                -- PROCESS LOCAL DECLS
                -- Do these *first* so that the correct provenance gets
@@ -254,7 +248,7 @@ improveAvails imp_mod iloc explicits is_unqual avails
 
 \begin{code}
 importsFromLocalDecls mod_name rec_exp_fn decls
-  = mapRn (getLocalDeclBinders newLocalName) decls     `thenRn` \ avails_s ->
+  = mapRn (getLocalDeclBinders mod rec_exp_fn) decls   `thenRn` \ avails_s ->
 
     let
        avails = concat avails_s
@@ -281,39 +275,34 @@ importsFromLocalDecls mod_name rec_exp_fn decls
   where
     mod = mkThisModule mod_name
 
-    newLocalName rdr_name loc 
-       = check_unqual rdr_name loc                     `thenRn_`
-         newTopBinder mod (rdrNameOcc rdr_name)        `thenRn` \ name ->
-         returnRn (setNameProvenance name (LocalDef loc (rec_exp_fn name)))
-
-       -- There should never be a qualified name in a binding position (except in instance decls)
-       -- The parser doesn't check this because the same parser parses instance decls
-    check_unqual rdr_name loc
-       | isUnqual rdr_name = returnRn ()
-       | otherwise         = qualNameErr (text "the binding for" <+> quotes (ppr rdr_name)) 
-                                         (rdr_name,loc)
-
-getLocalDeclBinders :: (RdrName -> SrcLoc -> RnMG Name)        -- New-name function
-                   -> RdrNameHsDecl
-                   -> RnMG Avails
-getLocalDeclBinders new_name (ValD binds)
+getLocalDeclBinders :: Module -> (Name -> ExportFlag)
+                   -> RdrNameHsDecl -> RnMG Avails
+getLocalDeclBinders mod rec_exp_fn (ValD binds)
   = mapRn do_one (bagToList (collectTopBinders binds))
   where
-    do_one (rdr_name, loc) = new_name rdr_name loc     `thenRn` \ name ->
+    do_one (rdr_name, loc) = newLocalName mod rec_exp_fn rdr_name loc  `thenRn` \ name ->
                             returnRn (Avail name)
 
-getLocalDeclBinders new_name decl
-  = getDeclBinders new_name decl       `thenRn` \ maybe_avail ->
+getLocalDeclBinders mod rec_exp_fn decl
+  = getDeclBinders (newLocalName mod rec_exp_fn) decl  `thenRn` \ maybe_avail ->
     case maybe_avail of
        Nothing    -> returnRn []               -- Instance decls and suchlike
-       Just avail -> getDeclSysBinders new_sys_name decl               `thenRn_`  
-                     returnRn [avail]
+       Just avail -> returnRn [avail]
+
+newLocalName mod rec_exp_fn rdr_name loc 
+  = check_unqual rdr_name loc                  `thenRn_`
+    newTopBinder mod (rdrNameOcc rdr_name)     `thenRn` \ name ->
+    returnRn (setNameProvenance name (LocalDef loc (rec_exp_fn name)))
   where
-       -- The getDeclSysBinders is just to get the names of superclass selectors
-       -- etc, into the cache
-    new_sys_name rdr_name loc = newImplicitBinder (rdrNameOcc rdr_name) loc
+       -- There should never be a qualified name in a binding position (except in instance decls)
+       -- The parser doesn't check this because the same parser parses instance decls
+    check_unqual rdr_name loc
+       | isUnqual rdr_name = returnRn ()
+       | otherwise         = qualNameErr (text "the binding for" <+> quotes (ppr rdr_name)) 
+                                         (rdr_name,loc)
 \end{code}
 
+
 %************************************************************************
 %*                                                                     *
 \subsection{Filtering imports}