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.
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
| 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
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`
-- 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)
-- 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"
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}
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 ->
-- 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
; 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.
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) $
= 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
(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
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
-- 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
---------------------
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 ()
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 )
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}
-- Standard combinators, specialised
returnM, thenM, thenM_, failM,
- mappM, mappM_, mapSndM, sequenceM, foldlM,
+ mappM, mappM_, mapSndM, sequenceM, sequenceM_,
+ foldlM,
mapAndUnzipM, mapAndUnzip3M,
checkM, ifM, zipWithM, zipWithM_,
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])
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 }
projects / ghc-hetmet.git / commitdiff