X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnNames.lhs;h=2bfe8a5c46d51bddf2c40efe8bbfe9bbf8ae28e9;hb=52e597cd774f0fc792e4421952cc9f2b55dd7a92;hp=d56b708f5a20b964e14e1074ce2d8226f73b224e;hpb=ee0b0cae12124ee61240d42e795f615e250d99b6;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index d56b708..2bfe8a5 100644
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -13,8 +13,8 @@ module RnNames (
 import CmdLineOpts	( DynFlag(..) )
 
 import HsSyn		( HsModule(..), HsDecl(..), IE(..), ieName, ImportDecl(..),
-			  ForeignDecl(..), ForKind(..), isDynamicExtName,
-			  collectTopBinders
+			  ForeignDecl(..), 
+			  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,23 +238,17 @@ 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 ->
 			  returnRn (Avail name)
 
-getLocalDeclBinders mod (ForD (ForeignDecl nm kind _ ext_nm _ loc))
-  | binds_haskell_name kind
+getLocalDeclBinders mod (ForD (ForeignImport nm _ _ loc))
   = newTopBinder mod nm loc	    `thenRn` \ name ->
     returnRn [Avail name]
-
-  | otherwise 		-- a foreign export
+getLocalDeclBinders mod (ForD _)
   = returnRn []
-  where
-    binds_haskell_name (FoImport _) = True
-    binds_haskell_name FoLabel      = True
-    binds_haskell_name FoExport     = isDynamicExtName ext_nm
 
 getLocalDeclBinders mod (FixD _)    = returnRn []
 getLocalDeclBinders mod (DeprecD _) = returnRn []
@@ -322,7 +318,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 +364,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 +390,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 +485,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