[project @ 2001-04-30 13:50:59 by panne]
[ghc-hetmet.git] / ghc / compiler / rename / RnNames.lhs
index d56b708..a54dbd8 100644 (file)
@@ -14,7 +14,7 @@ import CmdLineOpts    ( DynFlag(..) )
 
 import HsSyn           ( HsModule(..), HsDecl(..), IE(..), ieName, ImportDecl(..),
                          ForeignDecl(..), ForKind(..), isDynamicExtName,
-                         collectTopBinders
+                         collectLocatedHsBinders
                        )
 import RdrHsSyn                ( RdrNameIE, RdrNameImportDecl,
                          RdrNameHsModule, RdrNameHsDecl
@@ -26,21 +26,19 @@ import RnMonad
 
 import FiniteMap
 import PrelNames       ( pRELUDE_Name, mAIN_Name, main_RDR_Unqual, isUnboundName )
-import UniqFM          ( lookupUFM )
-import Bag             ( bagToList )
 import Module          ( ModuleName, moduleName, WhereFrom(..) )
+import Name            ( Name, nameSrcLoc, nameOccName )
 import NameSet
-import Name            ( Name, nameSrcLoc, nameOccName,  nameEnvElts )
+import NameEnv
 import HscTypes                ( Provenance(..), ImportReason(..), GlobalRdrEnv,
                          GenAvailInfo(..), AvailInfo, Avails, AvailEnv, 
                          Deprecations(..), ModIface(..)
                        )
-import RdrName         ( RdrName, rdrNameOcc, setRdrNameOcc )
+import RdrName         ( rdrNameOcc, setRdrNameOcc )
 import OccName         ( setOccNameSpace, dataName )
 import NameSet         ( elemNameSet, emptyNameSet )
 import Outputable
 import Maybes          ( maybeToBool, catMaybes, mapMaybe )
-import UniqFM          ( emptyUFM, listToUFM )
 import ListSetOps      ( removeDups )
 import Util            ( sortLt )
 import List            ( partition )
@@ -163,9 +161,10 @@ importsFromImportDecl this_mod_name (ImportDecl imp_mod_name from qual_only as_m
     else
 
        -- Complain if we import a deprecated module
-    (case deprecs of   
-       DeprecAll txt -> addWarnRn (moduleDeprec imp_mod_name txt)
-       other         -> returnRn ()
+    ifOptRn Opt_WarnDeprecations       (
+       case deprecs of 
+         DeprecAll txt -> addWarnRn (moduleDeprec imp_mod_name txt)
+         other         -> returnRn ()
     )                                                  `thenRn_`
 
        -- Filter the imports according to the import list
@@ -199,6 +198,9 @@ importsFromLocalDecls this_mod decls
        (_, dups) = removeDups compare all_names
     in
        -- Check for duplicate definitions
+       -- The complaint will come out as "Multiple declarations of Foo.f" because
+       -- since 'f' is in the env twice, the unQualInScope used by the error-msg
+       -- printer returns False.  It seems awkward to fix, unfortunately.
     mapRn_ (addErrRn . dupDeclErr) dups                        `thenRn_` 
 
 
@@ -236,7 +238,7 @@ getLocalDeclBinders mod (TyClD tycl_decl)
     returnRn [avail]
 
 getLocalDeclBinders mod (ValD binds)
-  = mapRn new (bagToList (collectTopBinders binds))    `thenRn` \ avails ->
+  = mapRn new (collectLocatedHsBinders binds)          `thenRn` \ avails ->
     returnRn avails
   where
     new (rdr_name, loc) = newTopBinder mod rdr_name loc        `thenRn` \ name ->
@@ -322,7 +324,7 @@ filterImports mod from (Just (want_hiding, import_items)) total_avails
          Just avail@(AvailTC _ [n]) ->         -- This occurs when you import T(..), but
                                                -- only export T abstractly.  The single [n]
                                                -- in the AvailTC is the type or class itself
-                                       addWarnRn (dodgyImportWarn mod item)    `thenRn_`
+                                       ifOptRn Opt_WarnMisc (addWarnRn (dodgyImportWarn mod item))     `thenRn_`
                                        returnRn [(avail, [availName avail])]
          Just avail                 -> returnRn [(avail, [availName avail])]
 
@@ -368,7 +370,7 @@ filterImports mod from (Just (want_hiding, import_items)) total_avails
 
 \begin{code}
 mkEmptyExportAvails :: ModuleName -> ExportAvails
-mkEmptyExportAvails mod_name = (unitFM mod_name [], emptyUFM)
+mkEmptyExportAvails mod_name = (unitFM mod_name [], emptyNameEnv)
 
 mkExportAvails :: ModuleName -> Bool -> GlobalRdrEnv -> [AvailInfo] -> ExportAvails
 mkExportAvails mod_name unqual_imp gbl_env avails
@@ -394,7 +396,7 @@ mkExportAvails mod_name unqual_imp gbl_env avails
 
     unqual_in_scope n = unQualInScope gbl_env n
 
-    entity_avail_env = listToUFM [ (name,avail) | avail <- avails, 
+    entity_avail_env = mkNameEnv [ (name,avail) | avail <- avails, 
                                                  name  <- availNames avail]
 
 plusExportAvails ::  ExportAvails ->  ExportAvails ->  ExportAvails
@@ -489,7 +491,7 @@ exportsFromAvail this_mod (Just export_items)
        = lookupSrcName global_name_env (ieName ie)     `thenRn` \ name -> 
 
                -- See what's available in the current environment
-         case lookupUFM entity_avail_env name of {
+         case lookupNameEnv entity_avail_env name of {
            Nothing ->  -- Presumably this happens because lookupSrcName didn't find
                        -- the name and returned an unboundName, which won't be in
                        -- the entity_avail_env, of course