X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRename.lhs;h=2534f5f3f433311b8a2d08f8709b8a4a9953b3f3;hb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;hp=e221088e3333f939c197245fc67458ada38091b2;hpb=be33dbc967b4915cfdb0307ae1b7ae3cee651b8c;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index e221088..2534f5f 100644
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -1,5 +1,5 @@
 %
-% (c) The GRASP Project, Glasgow University, 1992-1996
+% (c) The GRASP Project, Glasgow University, 1992-1998
 %
 \section[Rename]{Renaming and dependency analysis passes}
 
@@ -23,24 +23,24 @@ import RnIfaces		( getImportedInstDecls, importDecl, getImportVersions, getSpeci
 			  getDeferredDataDecls,
 			  mkSearchPath, getSlurpedNames, getRnStats
 			)
-import RnEnv		( addImplicitOccsRn )
-import Name		( Name, PrintUnqualified, Provenance, isLocallyDefined,
-			  NameSet(..),
-			  nameSetToList, minusNameSet, NamedThing(..),
+import RnEnv		( addImplicitOccsRn, availNames )
+import Name		( Name, isLocallyDefined,
+			  NamedThing(..),
 			  nameModule, pprModule, pprOccName, nameOccName
 			)
-import TysWiredIn	( unitTyCon, intTyCon, doubleTyCon )
+import NameSet
 import TyCon		( TyCon )
 import PrelMods		( mAIN, pREL_MAIN )
-import PrelInfo		( ioTyCon_NAME )
+import TysWiredIn	( unitTyCon, intTyCon, doubleTyCon )
+import PrelInfo		( ioTyCon_NAME, thinAirIdNames )
 import ErrUtils		( pprBagOfErrors, pprBagOfWarnings,
 			  doIfSet, dumpIfSet, ghcExit
 			)
 import Bag		( isEmptyBag )
+import FiniteMap	( fmToList, delListFromFM )
 import UniqSupply	( UniqSupply )
 import Util		( equivClasses )
 import Maybes		( maybeToBool )
-import List		( partition )
 import Outputable
 \end{code}
 
@@ -49,10 +49,12 @@ import Outputable
 \begin{code}
 renameModule :: UniqSupply
 	     -> RdrNameHsModule
-	     -> IO (Maybe (RenamedHsModule, 	-- Output, after renaming
-			   InterfaceDetails,	-- Interface; for interface file generatino
-			   RnNameSupply,	-- Final env; for renaming derivings
-			   [Module]))	   	-- Imported modules; for profiling
+	     -> IO (Maybe 
+	              ( RenamedHsModule   -- Output, after renaming
+		      , InterfaceDetails  -- Interface; for interface file generatino
+		      , RnNameSupply      -- Final env; for renaming derivings
+		      , [Module]	  -- Imported modules; for profiling
+		      ))
 
 renameModule us this_mod@(HsModule mod_name vers exports imports fixities local_decls loc)
   = 	-- Initialise the renamer monad
@@ -95,7 +97,7 @@ rename this_mod@(HsModule mod_name vers exports imports fixities local_decls loc
 	returnRn Nothing
     else
     let
-  	Just (export_env, rn_env, explicit_names, print_unqual) = maybe_stuff
+  	Just (export_env, rn_env, explicit_info, print_unqual) = maybe_stuff
     in
 
 	-- RENAME THE SOURCE
@@ -120,7 +122,7 @@ rename this_mod@(HsModule mod_name vers exports imports fixities local_decls loc
     getNameSupplyRn					`thenRn` \ name_supply ->
 
 	-- REPORT UNUSED NAMES
-    reportUnusedNames explicit_names			`thenRn_`
+    reportUnusedNames export_env explicit_info		`thenRn_`
 
 	-- GENERATE THE SPECIAL-INSTANCE MODULE LIST
 	-- The "special instance" modules are those modules that contain instance
@@ -161,18 +163,18 @@ mentioned explicitly, but which might be needed by the type checker.
 
 \begin{code}
 addImplicits mod_name
-  = addImplicitOccsRn (implicit_main ++ default_tys)
+  = addImplicitOccsRn (implicit_main ++ default_tys ++ thinAirIdNames)
   where
 	-- Add occurrences for Int, Double, and (), because they
 	-- are the types to which ambigious type variables may be defaulted by
-	-- the type checker; so they won't every appear explicitly.
+	-- the type checker; so they won't always appear explicitly.
 	-- [The () one is a GHC extension for defaulting CCall results.]
     default_tys = [getName intTyCon, getName doubleTyCon, getName unitTyCon ]
 
 	-- Add occurrences for IO or PrimIO
     implicit_main |  mod_name == mAIN
 		  || mod_name == pREL_MAIN = [ioTyCon_NAME]
-		  |  otherwise 		  = []
+		  |  otherwise 		   = []
 \end{code}
 
 
@@ -262,29 +264,48 @@ rn_data_decl mode (tycon_name,ty_decl) = rn_iface_decl mod_name mode (TyD ty_dec
 \end{code}
 
 \begin{code}
-reportUnusedNames explicit_avail_names
+reportUnusedNames (ExportEnv export_avails _) explicit_info
+  | not (opt_WarnUnusedBinds || opt_WarnUnusedImports)
+  = returnRn ()
+
+  | otherwise
   = getSlurpedNames			`thenRn` \ slurped_names ->
     let
-	unused	      = explicit_avail_names `minusNameSet` slurped_names
-	(local_unused, imported_unused) = partition isLocallyDefined (nameSetToList unused)
-	imports_by_module = equivClasses cmp imported_unused
-	name1 `cmp` name2 = nameModule name1 `compare` nameModule name2 
-
-	pp_imp = sep [text "Warning: the following unqualified imports are unused:",
-			  nest 4 (vcat (map pp_group imports_by_module))]
-	pp_group (n:ns) = sep [hcat [text "Module ", pprModule (nameModule n), char ':'],
-				   nest 4 (sep (map (pprOccName . nameOccName) (n:ns)))]
-
-	pp_local = sep [text "Warning: the following local top-level definitions are unused:",
-			    nest 4 (sep (map (pprOccName . nameOccName) local_unused))]
-    in
-    (if not opt_WarnUnusedImports || null imported_unused
-     then returnRn ()
-     else addWarnRn pp_imp)	`thenRn_`
+	unused_info :: FiniteMap Name HowInScope
+	unused_info = foldl delListFromFM
+			    (delListFromFM explicit_info (nameSetToList slurped_names))
+			    (map availNames export_avails)
+	unused_list = fmToList unused_info
+
+	groups = filter wanted (equivClasses cmp unused_list)
+	       where
+		 (name1, his1) `cmp` (name2, his2) = his1 `cmph` his2
+		 
+		 (FromLocalDefn _)     `cmph` (FromImportDecl _ _)  = LT
+		 (FromLocalDefn _)     `cmph` (FromLocalDefn _)     = EQ
+		 (FromImportDecl m1 _) `cmph` (FromImportDecl m2 _) = m1 `compare` m2
+		 h1		       `cmph` h2		    = GT
+
+	wanted ((_,FromImportDecl _ _) : _) = opt_WarnUnusedImports
+	wanted ((_,FromLocalDefn _)    : _) = opt_WarnUnusedImports
+
+	pp_imp = sep [text "Warning: the following are unused:",
+		      nest 4 (vcat (map pp_group groups))]
+
+	pp_group group = sep [msg <> char ':',
+		              nest 4 (sep (map (pprOccName . nameOccName . fst) group))]
+		       where
+			 his = case group of
+				  ((_,his) : _) -> his
+
+			 msg = case his of
+				  FromImportDecl m _ -> text "Imported from" <+> pprModule m
+				  FromLocalDefn _    -> text "Locally defined"   
 
-    (if not opt_WarnUnusedBinds || null local_unused
-     then returnRn ()
-     else addWarnRn pp_local)
+    in
+    if null groups
+    then returnRn ()
+    else addWarnRn pp_imp
 
 rnStats :: [RenamedHsDecl] -> RnMG ()
 rnStats all_decls