[project @ 2005-05-03 11:10:08 by simonpj]

Improve generation of 'duplicate import' warnings.
This involved changing (actually simplifying) the
definition of RdrName.ImportSpec.

I'm not sure whether this one merits merging or not.
Perhaps worth a try.

ghc/compiler/basicTypes/RdrName.lhs

@@ -372,13 +372,13 @@ isLocalGRE other    		         = False
 
 unQualOK :: GlobalRdrElt -> Bool
 -- An unqualifed version of this thing is in scope
-unQualOK (GRE {gre_prov = LocalDef _})    = True
-unQualOK (GRE {gre_prov = Imported is _}) = not (all is_qual is)
+unQualOK (GRE {gre_prov = LocalDef _})  = True
+unQualOK (GRE {gre_prov = Imported is}) = not (all is_qual is)
 
 hasQual :: Module -> GlobalRdrElt -> Bool
 -- A qualified version of this thing is in scope
-hasQual mod (GRE {gre_prov = LocalDef m})    = m == mod
-hasQual mod (GRE {gre_prov = Imported is _}) = any ((== mod) . is_as) is
+hasQual mod (GRE {gre_prov = LocalDef m})  = m == mod
+hasQual mod (GRE {gre_prov = Imported is}) = any ((== mod) . is_as) is
 
 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
 plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2
@@ -422,27 +422,34 @@ data Provenance
 
   | Imported 		-- Imported
 	[ImportSpec]	-- INVARIANT: non-empty
-	Bool		-- True iff the thing was named *explicitly* 
-			-- in *any* of the import specs rather than being 
-			-- imported as part of a group; 
-	-- e.g.
-	--	import B
-	--	import C( T(..) )
-	-- Here, everything imported by B, and the constructors of T
-	-- are not named explicitly; only T is named explicitly.
-	-- This info is used when warning of unused names.
 
 data ImportSpec		-- Describes a particular import declaration
-			-- Shared among all the Provenaces for a particular
-			-- import declaration
+			-- Shared among all the Provenaces for a
+			-- import-all declaration; otherwise it's done
+			-- per explictly-named item
   = ImportSpec {
-	is_mod  :: Module,		-- 'import Muggle'
-					-- Note the Muggle may well not be 
-					-- the defining module for this thing!
-	is_as   :: Module,		-- 'as M' (or 'Muggle' if there is no 'as' clause)
-	is_qual :: Bool,		-- True <=> qualified (only)
-	is_loc  :: SrcSpan }		-- Location of import statment
+	is_mod      :: Module,	-- 'import Muggle'
+				-- Note the Muggle may well not be 
+				-- the defining module for this thing!
+	is_as       :: Module,	-- 'as M' (or 'Muggle' if there is no 'as' clause)
+	is_qual     :: Bool,	-- True <=> qualified (only)
+	is_explicit :: Bool,	-- True <=> explicit import (see below)
+	is_loc      :: SrcSpan	-- Location of import item
+    }
+	-- The is_explicit field is True iff the thing was named 
+	-- *explicitly* in the import specs rather 
+	-- than being imported as part of a group 
+	-- e.g.		import B
+	--		import C( T(..) )
+	-- Here, everything imported by B, and the constructors of T
+	-- are not named explicitly; only T is named explicitly.
+	-- This info is used when warning of unused names.
+	--
+	-- We keep ImportSpec separate from the Bool so that the
+	-- former can be shared between all Provenances for a particular
+	-- import declaration.  
 
+-- Note [Comparing provenance]
 -- Comparison of provenance is just used for grouping 
 -- error messages (in RnEnv.warnUnusedBinds)
 instance Eq Provenance where
@@ -452,10 +459,11 @@ instance Eq ImportSpec where
   p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
 
 instance Ord Provenance where
-   compare (LocalDef _) (LocalDef _)   = EQ
-   compare (LocalDef _) (Imported _ _) = LT
-   compare (Imported _ _) (LocalDef _) = GT
-   compare (Imported is1 _) (Imported is2 _) = compare (head is1) (head is2)
+   compare (LocalDef _) (LocalDef _)   	 = EQ
+   compare (LocalDef _) (Imported _) 	 = LT
+   compare (Imported _ ) (LocalDef _)    = GT
+   compare (Imported is1) (Imported is2) = compare (head is1) 
+	{- See Note [Comparing provenance] -}	   (head is2)
 
 instance Ord ImportSpec where
    compare is1 is2 = (is_mod is1 `compare` is_mod is2) `thenCmp` 
@@ -470,17 +478,15 @@ plusProv :: Provenance -> Provenance -> Provenance
 -- defined, and one might refer to it with a qualified name from
 -- the import -- but I'm going to ignore that because it makes
 -- the isLocalGRE predicate so much nicer this way
-plusProv (LocalDef m1) (LocalDef m2) 
-  = pprPanic "plusProv" (ppr m1 <+> ppr m2)
-plusProv p1@(LocalDef _) p2 = p1
-plusProv p1 p2@(LocalDef _) = p2
-plusProv (Imported is1 ex1) (Imported is2 ex2) 
-  = Imported (is1++is2) (ex1 || ex2)
+plusProv (LocalDef m1) (LocalDef m2)     = pprPanic "plusProv" (ppr m1 <+> ppr m2)
+plusProv p1@(LocalDef _) p2		 = p1
+plusProv p1 		 p2@(LocalDef _) = p2
+plusProv (Imported is1)  (Imported is2)  = Imported (is1++is2)
 
 pprNameProvenance :: GlobalRdrElt -> SDoc
 pprNameProvenance (GRE {gre_name = name, gre_prov = LocalDef _})
   = ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
-pprNameProvenance (GRE {gre_name = name, gre_prov = Imported (why:whys) _})
+pprNameProvenance (GRE {gre_name = name, gre_prov = Imported (why:whys)})
   = sep [ppr why, nest 2 (ppr_defn (nameSrcLoc name))]
 
 -- If we know the exact definition point (which we may do with GHCi)

ghc/compiler/rename/RnEnv.lhs

@@ -745,12 +745,11 @@ warnUnusedName (name, prov)
 	-- TODO should be a proper span
   where
     (loc,msg) = case prov of
-		  Just (Imported is _) -> 
-		     ( is_loc (head is), imp_from (is_mod imp_spec) )
-		     where
-			 imp_spec = head is
-		  other -> 
-		     ( srcLocSpan (nameSrcLoc name), unused_msg )
+		  Just (Imported is)
+		        -> (is_loc imp_spec, imp_from (is_mod imp_spec))
+		        where
+			  imp_spec = head is
+		  other -> (srcLocSpan (nameSrcLoc name), unused_msg)
 
     unused_msg   = text "Defined but not used"
     imp_from mod = text "Imported from" <+> quotes (ppr mod) <+> text "but not used"

ghc/compiler/rename/RnNames.lhs

@@ -53,7 +53,8 @@ import SrcLoc		( Located(..), mkGeneralSrcSpan,
 			  unLoc, noLoc, srcLocSpan, SrcSpan )
 import BasicTypes	( DeprecTxt )
 import DriverPhases	( isHsBoot )
-import Util		( notNull, isSingleton )
+import Util		( notNull, isSingleton, thenCmp )
+import ListSetOps	( equivClasses )
 import List		( partition )
 import IO		( openFile, IOMode(..) )
 \end{code}
@@ -181,7 +182,7 @@ importsFromImportDecl this_mod
 			  Nothing  	    -> imp_mod_name
 			  Just another_name -> another_name
 	imp_spec  = ImportSpec { is_mod = imp_mod_name, is_qual = qual_only,  
-		  		 is_loc = loc, is_as = qual_mod_name }
+		  		 is_loc = loc, is_as = qual_mod_name, is_explicit = False }
     in
 	-- Get the total imports, and filter them according to the import list
     ifaceExportNames filtered_exports		`thenM` \ total_avails ->
@@ -388,7 +389,7 @@ filterImports :: ModIface
         -- Warns/informs if import spec contains duplicates.
 			
 mkGenericRdrEnv imp_spec names
-  = mkGlobalRdrEnv [ GRE { gre_name = name, gre_prov = Imported [imp_spec] False }
+  = mkGlobalRdrEnv [ GRE { gre_name = name, gre_prov = Imported [imp_spec] }
 		   | name <- nameSetToList names ]
 
 filterImports iface imp_spec Nothing all_names
@@ -428,9 +429,10 @@ filterImports iface imp_spec (Just (want_hiding, import_items)) all_names
 	   ; returnM (map (mk_gre loc) names) }
       where
 	mk_gre loc name = GRE { gre_name = name, 
-				gre_prov = Imported [this_imp_spec loc] (explicit name) }
-	this_imp_spec loc = imp_spec { is_loc = loc }
-	explicit name = all_explicit || isNothing (nameParent_maybe name)
+				gre_prov = Imported [imp_spec'] }
+	  where
+	    imp_spec' = imp_spec { is_loc = loc, is_explicit = explicit }
+	    explicit = all_explicit || isNothing (nameParent_maybe name)
 
     get_item :: IE RdrName -> RnM [GlobalRdrElt]
 	-- Empty result for a bad item.
@@ -673,7 +675,7 @@ reportDeprecations tcg_env
     used_names = findUses (tcg_dus tcg_env) emptyNameSet
     all_gres   = globalRdrEnvElts (tcg_rdr_env tcg_env)
 
-    check hpt pit (GRE {gre_name = name, gre_prov = Imported (imp_spec:_) _})
+    check hpt pit (GRE {gre_name = name, gre_prov = Imported (imp_spec:_)})
       | name `elemNameSet` used_names
       ,	Just deprec_txt <- lookupDeprec hpt pit name
       = setSrcSpan (is_loc imp_spec) $
@@ -729,7 +731,7 @@ reportUnusedNames export_decls gbl_env
   = do	{ warnUnusedTopBinds   unused_locals
 	; warnUnusedModules    unused_imp_mods
 	; warnUnusedImports    unused_imports	
-	; warnDuplicateImports dup_imps
+	; warnDuplicateImports defined_and_used
 	; printMinimalImports  minimal_imports }
   where
     used_names, all_used_names :: NameSet
@@ -750,11 +752,6 @@ reportUnusedNames export_decls gbl_env
     (defined_and_used, defined_but_not_used) 
 	= partition (gre_is_used all_used_names) defined_names
     
-	-- Find the duplicate imports
-    dup_imps = filter is_dup defined_and_used
-    is_dup (GRE {gre_prov = Imported imp_spec True}) = not (isSingleton imp_spec)
-    is_dup other				     = False
-
 	-- Filter out the ones that are 
 	--  (a) defined in this module, and
 	--  (b) not defined by a 'deriving' clause 
@@ -766,8 +763,9 @@ reportUnusedNames export_decls gbl_env
     
     unused_imports :: [GlobalRdrElt]
     unused_imports = filter unused_imp defined_but_not_used
-    unused_imp (GRE {gre_prov = Imported imp_specs True}) 
+    unused_imp (GRE {gre_prov = Imported imp_specs}) 
 	= not (all (module_unused . is_mod) imp_specs)
+	  && any is_explicit imp_specs
 		-- Don't complain about unused imports if we've already said the
 		-- entire import is unused
     unused_imp other = False
@@ -799,7 +797,7 @@ reportUnusedNames export_decls gbl_env
 	-- We've carefully preserved the provenance so that we can
 	-- construct minimal imports that import the name by (one of)
 	-- the same route(s) as the programmer originally did.
-    add_name (GRE {gre_name = n, gre_prov = Imported imp_specs _}) acc 
+    add_name (GRE {gre_name = n, gre_prov = Imported imp_specs}) acc 
 	= addToFM_C plusAvailEnv acc (is_mod (head imp_specs))
 		    (unitAvailEnv (mk_avail n (nameParent_maybe n)))
     add_name other acc 
@@ -864,16 +862,53 @@ reportUnusedNames export_decls gbl_env
 
 ---------------------
 warnDuplicateImports :: [GlobalRdrElt] -> RnM ()
+-- Given the GREs for names that are used, figure out which imports 
+-- could be omitted without changing the top-level environment.
+--
+-- NB: Given import Foo( T )
+--     	     import qualified Foo
+-- we do not report a duplicate import, even though Foo.T is brought
+-- into scope by both, because there's nothing you can *omit* without
+-- changing the top-level environment.  So we complain only if it's
+-- explicitly named in both imports or neither.
+--
+-- Furthermore, we complain about Foo.T only if 
+-- there is no complaint about (unqualified) T
+
 warnDuplicateImports gres
-  = ifOptM Opt_WarnUnusedImports (mapM_ warn gres)
+  = ifOptM Opt_WarnUnusedImports $ 
+    sequenceM_	[ warn name (head dup_imps) 
+			-- The 'head' picks the first offending group
+			-- for this particular name
+		| GRE { gre_name = name, gre_prov = Imported imps } <- gres
+		, let dup_imps = dups imps
+		, not (null dup_imps) ]	
   where
-    warn (GRE { gre_name = name, gre_prov = Imported imps _ })
-	= addWarn ((quotes (ppr name) <+> ptext SLIT("is imported more than once:")) 
-	       $$ nest 2 (vcat (map ppr imps)))
-    warn gre = panic "warnDuplicateImports"
-	-- The GREs should all have Imported provenance
-			      
-
+    warn name [] 
+	= panic "warnDuplicateImports"	-- equivClasses never returns empty lists
+    warn name dup_imps@(imp1:_)
+	= addWarnAt (is_loc imp1)
+		 ((quotes pp_name <+> ptext SLIT("is imported more than once:")) 
+	           $$ nest 2 (vcat (map ppr dup_imps)))
+	where
+	  pp_name | is_qual imp1 = ppr (is_as imp1) <> dot <> ppr occ
+		  | otherwise	 = ppr occ
+	  occ = nameOccName name
+    
+    dups :: [ImportSpec] -> [[ImportSpec]]
+    dups [imp] = []	-- Very common case
+    dups imps  = filter (not . isSingleton) (unqual_dups ++ qual_dups)
+	where
+	  unqual_dups = equivClasses cmp_unqual (filter (not . is_qual) imps)
+	  qual_dups   = equivClasses cmp_qual   imps
+
+    cmp_unqual imp1 imp2	-- Make explicit come first
+	= not (is_explicit imp1) `compare` not (is_explicit imp2)
+		
+    cmp_qual imp1 imp2		-- Group by explicit-ness, then by module qualifier
+	= (imp1 `cmp_unqual` imp2) `thenCmp` 
+	  (is_as imp1 `compare` is_as imp2)
+	
 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
 printMinimalImports :: FiniteMap Module AvailEnv	-- Minimal imports
 		    -> RnM ()

ghc/compiler/typecheck/TcRnDriver.lhs

@@ -87,7 +87,8 @@ import HsSyn		( HsStmtContext(..), Stmt(..), HsExpr(..), HsBindGroup(..),
 		   	  placeHolderType, noSyntaxExpr )
 import RdrName		( GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..),
 			  Provenance(..), ImportSpec(..), globalRdrEnvElts,
-			  unQualOK, lookupLocalRdrEnv, extendLocalRdrEnv )
+			  unQualOK, lookupLocalRdrEnv, extendLocalRdrEnv,
+			  plusGlobalRdrEnv )
 import RnSource		( addTcgDUs )
 import TcHsSyn		( mkHsLet, zonkTopLExpr, zonkTopBndrs )
 import TcHsType		( kcHsType )
@@ -1095,8 +1096,9 @@ getModuleExports mod
 vanillaProv :: Module -> Provenance
 -- We're building a GlobalRdrEnv as if the user imported
 -- all the specified modules into the global interactive module
-vanillaProv mod = Imported [ImportSpec mod mod False 
-			     (srcLocSpan interactiveSrcLoc)] False
+vanillaProv mod = Imported [ImportSpec { is_mod = mod, is_as = mod, 
+					 is_qual = False, is_explicit = False,
+					 is_loc = srcLocSpan interactiveSrcLoc }]
 \end{code}
 
 \begin{code}

ghc/compiler/utils/IOEnv.hs

@@ -8,7 +8,8 @@ module IOEnv (
 
 	-- Standard combinators, specialised
 	returnM, thenM, thenM_, failM,
-	mappM, mappM_, mapSndM, sequenceM, foldlM, 
+	mappM, mappM_, mapSndM, sequenceM, sequenceM_, 
+	foldlM, 
 	mapAndUnzipM, mapAndUnzip3M, 
 	checkM, ifM, zipWithM, zipWithM_,
 
@@ -151,6 +152,7 @@ mappM_ 	      :: (a -> IOEnv env b) -> [a] -> IOEnv env ()
 mapSndM       :: (b -> IOEnv env c) -> [(a,b)] -> IOEnv env [(a,c)]
 	-- Funny names to avoid clash with Prelude
 sequenceM     :: [IOEnv env a] -> IOEnv env [a]
+sequenceM_    :: [IOEnv env a] -> IOEnv env ()
 foldlM        :: (a -> b -> IOEnv env a)  -> a -> [b] -> IOEnv env a
 mapAndUnzipM  :: (a -> IOEnv env (b,c))   -> [a] -> IOEnv env ([b],[c])
 mapAndUnzip3M :: (a -> IOEnv env (b,c,d)) -> [a] -> IOEnv env ([b],[c],[d])
@@ -179,6 +181,9 @@ zipWithM_ f (a:as) (b:bs) = do { f a b; zipWithM_ f as bs }
 sequenceM [] = return []
 sequenceM (x:xs) = do { r <- x; rs <- sequenceM xs; return (r:rs) }
 
+sequenceM_ []     = return ()
+sequenceM_ (x:xs) = do { x; sequenceM_ xs }
+
 foldlM k z [] = return z
 foldlM k z (x:xs) = do { r <- k z x; foldlM k r xs }