From 56e6b5842accf1efe580483457a10a0e6de8b960 Mon Sep 17 00:00:00 2001 From: simonpj Date: Tue, 3 May 2005 11:10:09 +0000 Subject: [PATCH] [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 | 70 +++++++++++++++------------- ghc/compiler/rename/RnEnv.lhs | 11 ++--- ghc/compiler/rename/RnNames.lhs | 81 +++++++++++++++++++++++---------- ghc/compiler/typecheck/TcRnDriver.lhs | 8 ++-- ghc/compiler/utils/IOEnv.hs | 7 ++- 5 files changed, 112 insertions(+), 65 deletions(-) diff --git a/ghc/compiler/basicTypes/RdrName.lhs b/ghc/compiler/basicTypes/RdrName.lhs index 888d845..9d2e416 100644 --- a/ghc/compiler/basicTypes/RdrName.lhs +++ b/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) diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index 55a3481..9ef2729 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/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" diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index f1dab3f..e452c2c 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/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 () diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs index 460d2b8..88bbc21 100644 --- a/ghc/compiler/typecheck/TcRnDriver.lhs +++ b/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} diff --git a/ghc/compiler/utils/IOEnv.hs b/ghc/compiler/utils/IOEnv.hs index c217c19..7747e33 100644 --- a/ghc/compiler/utils/IOEnv.hs +++ b/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 } -- 1.7.10.4