\begin{code}
module RnNames (
rnImports, importsFromLocalDecls,
+ rnExports,
getLocalDeclBinders, extendRdrEnvRn,
reportUnusedNames, reportDeprecations,
- mkModDeps, exportsFromAvail
+ mkModDeps
) where
#include "HsVersions.h"
GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..),
emptyGlobalRdrEnv, plusGlobalRdrEnv, globalRdrEnvElts,
extendGlobalRdrEnv, lookupGlobalRdrEnv, unQualOK, lookupGRE_Name,
- Provenance(..), ImportSpec(..),
- isLocalGRE, pprNameProvenance )
+ Provenance(..), ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
+ importSpecLoc, importSpecModule, isLocalGRE, pprNameProvenance )
import Outputable
import Maybes ( isNothing, catMaybes, mapCatMaybes, seqMaybe, orElse )
import SrcLoc ( Located(..), mkGeneralSrcSpan,
unLoc, noLoc, srcLocSpan, SrcSpan )
import BasicTypes ( DeprecTxt )
import DriverPhases ( isHsBoot )
-import Util ( notNull, isSingleton, thenCmp )
-import ListSetOps ( equivClasses )
+import Util ( notNull )
import List ( partition )
import IO ( openFile, IOMode(..) )
\end{code}
qual_mod_name = case as_mod of
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_explicit = False }
+ imp_spec = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,
+ is_dloc = loc, is_as = qual_mod_name }
in
-- Get the total imports, and filter them according to the import list
ifaceExportNames filtered_exports `thenM` \ total_avails ->
\begin{code}
filterImports :: ModIface
- -> ImportSpec -- The span for the entire import decl
+ -> ImpDeclSpec -- The span for the entire import decl
-> Maybe (Bool, [Located (IE RdrName)]) -- Import spec; True => hiding
-> NameSet -- What's available
-> RnM (NameSet, -- What's imported (qualified or unqualified)
-- Complains if import spec mentions things that the module doesn't export
-- Warns/informs if import spec contains duplicates.
-mkGenericRdrEnv imp_spec names
+mkGenericRdrEnv decl_spec names
= mkGlobalRdrEnv [ GRE { gre_name = name, gre_prov = Imported [imp_spec] }
| name <- nameSetToList names ]
+ where
+ imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
-filterImports iface imp_spec Nothing all_names
- = returnM (all_names, mkGenericRdrEnv imp_spec all_names)
+filterImports iface decl_spec Nothing all_names
+ = returnM (all_names, mkGenericRdrEnv decl_spec all_names)
-filterImports iface imp_spec (Just (want_hiding, import_items)) all_names
+filterImports iface decl_spec (Just (want_hiding, import_items)) all_names
= mappM (addLocM get_item) import_items `thenM` \ gres_s ->
let
gres = concat gres_s
keep n = not (n `elemNameSet` specified_names)
pruned_avails = filterNameSet keep all_names
in
- return (pruned_avails, mkGenericRdrEnv imp_spec pruned_avails)
+ return (pruned_avails, mkGenericRdrEnv decl_spec pruned_avails)
where
occ_env :: OccEnv Name -- Maps OccName to corresponding Name
sub_env :: NameEnv [Name]
sub_env = mkSubNameEnv all_names
- bale_out item = addErr (badImportItemErr iface imp_spec item) `thenM_`
+ bale_out item = addErr (badImportItemErr iface decl_spec item) `thenM_`
returnM []
succeed_with :: Bool -> [Name] -> RnM [GlobalRdrElt]
; returnM (map (mk_gre loc) names) }
where
mk_gre loc name = GRE { gre_name = name,
- gre_prov = Imported [imp_spec'] }
+ gre_prov = Imported [imp_spec] }
where
- imp_spec' = imp_spec { is_loc = loc, is_explicit = explicit }
- explicit = all_explicit || isNothing (nameParent_maybe name)
+ imp_spec = ImpSpec { is_decl = decl_spec, is_item = item_spec }
+ item_spec = ImpSome { is_explicit = explicit, is_iloc = loc }
+ explicit = all_explicit || isNothing (nameParent_maybe name)
get_item :: IE RdrName -> RnM [GlobalRdrElt]
-- Empty result for a bad item.
\begin{code}
type ExportAccum -- The type of the accumulating parameter of
- -- the main worker function in exportsFromAvail
+ -- the main worker function in rnExports
= ([Module], -- 'module M's seen so far
ExportOccMap, -- Tracks exported occurrence names
NameSet) -- The accumulated exported stuff
-- that have the same occurrence name
-exportsFromAvail :: Bool -- False => no 'module M(..) where' header at all
- -> Maybe [Located (IE RdrName)] -- Nothing => no explicit export list
- -> RnM NameSet
+rnExports :: Bool -- False => no 'module M(..) where' header at all
+ -> Maybe [Located (IE RdrName)] -- Nothing => no explicit export list
+ -> RnM NameSet
-- Complains if two distinct exports have same OccName
-- Warns about identical exports.
-- Complains about exports items not in scope
-exportsFromAvail explicit_mod exports
+rnExports explicit_mod exports
= do { TcGblEnv { tcg_rdr_env = rdr_env,
tcg_imports = imports } <- getGblEnv ;
| explicit_mod = exports
| ghci_mode == Interactive = Nothing
| otherwise = Just [noLoc (IEVar main_RDR_Unqual)] } ;
+ -- ToDo: the 'noLoc' here is unhelpful if 'main' turns out to be out of scope
exports_from_avail real_exports rdr_env imports }
reportDeprecations tcg_env
= ifOptM Opt_WarnDeprecations $
do { (eps,hpt) <- getEpsAndHpt
+ -- By this time, typechecking is complete,
+ -- so the PIT is fully populated
; mapM_ (check hpt (eps_PIT eps)) all_gres }
where
- used_names = findUses (tcg_dus tcg_env) emptyNameSet
+ used_names = allUses (tcg_dus tcg_env)
+ -- Report on all deprecated uses; hence allUses
all_gres = globalRdrEnvElts (tcg_rdr_env tcg_env)
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) $
+ = setSrcSpan (importSpecLoc imp_spec) $
addWarn (sep [ptext SLIT("Deprecated use of") <+>
occNameFlavour (nameOccName name) <+>
quotes (ppr name),
- (parens imp_msg),
+ (parens imp_msg) <> colon,
(ppr deprec_txt) ])
where
name_mod = nameModule name
- imp_mod = is_mod imp_spec
+ imp_mod = importSpecModule imp_spec
imp_msg = ptext SLIT("imported from") <+> ppr imp_mod <> extra
extra | imp_mod == name_mod = empty
| otherwise = ptext SLIT(", but defined in") <+> ppr name_mod
where
used_names, all_used_names :: NameSet
used_names = findUses (tcg_dus gbl_env) emptyNameSet
+ -- NB: currently, if f x = g, we only treat 'g' as used if 'f' is used
+ -- Hence findUses
+
all_used_names = used_names `unionNameSets`
mkNameSet (mapCatMaybes nameParent_maybe (nameSetToList used_names))
-- A use of C implies a use of T,
unused_imports :: [GlobalRdrElt]
unused_imports = filter unused_imp defined_but_not_used
unused_imp (GRE {gre_prov = Imported imp_specs})
- = not (all (module_unused . is_mod) imp_specs)
- && any is_explicit imp_specs
+ = not (all (module_unused . importSpecModule) imp_specs)
+ && or [exp | ImpSpec { is_item = ImpSome { is_explicit = exp } } <- imp_specs]
-- Don't complain about unused imports if we've already said the
-- entire import is unused
unused_imp other = False
-- 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
- = addToFM_C plusAvailEnv acc (is_mod (head imp_specs))
+ = addToFM_C plusAvailEnv acc (importSpecModule (head imp_specs))
(unitAvailEnv (mk_avail n (nameParent_maybe n)))
add_name other acc
= acc
warnDuplicateImports gres
= ifOptM Opt_WarnUnusedImports $
- sequenceM_ [ warn name (head dup_imps)
+ sequenceM_ [ warn name pr
-- 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) ]
+ , pr <- redundants imps ]
where
- 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)))
+ warn name (red_imp, cov_imp)
+ = addWarnAt (importSpecLoc red_imp)
+ (vcat [ptext SLIT("Redundant import of:") <+> quotes pp_name,
+ ptext SLIT("It is also") <+> ppr cov_imp])
where
- pp_name | is_qual imp1 = ppr (is_as imp1) <> dot <> ppr occ
- | otherwise = ppr occ
+ pp_name | is_qual red_decl = ppr (is_as red_decl) <> dot <> ppr occ
+ | otherwise = ppr occ
occ = nameOccName name
+ red_decl = is_decl red_imp
- dups :: [ImportSpec] -> [[ImportSpec]]
- dups [imp] = [] -- Very common case
- dups imps = filter (not . isSingleton) (unqual_dups ++ qual_dups)
+ redundants :: [ImportSpec] -> [(ImportSpec,ImportSpec)]
+ -- The returned pair is (redundant-import, covering-import)
+ redundants imps
+ = [ (red_imp, cov_imp)
+ | red_imp <- imps
+ , cov_imp <- take 1 (filter (covers red_imp) imps) ]
+
+ -- "red_imp" is a putative redundant import
+ -- "cov_imp" potentially covers it
+ -- This test decides whether red_imp could be dropped
+ --
+ -- NOTE: currently the test does not warn about
+ -- import M( x )
+ -- imoprt N( x )
+ -- even if the same underlying 'x' is involved, because dropping
+ -- either import would change the qualified names in scope (M.x, N.x)
+ -- But if the qualified names aren't used, the import is indeed redundant
+ -- Sadly we don't know that. Oh well.
+ covers red_imp@(ImpSpec { is_decl = red_decl, is_item = red_item })
+ cov_imp@(ImpSpec { is_decl = cov_decl, is_item = cov_item })
+ | red_loc == cov_loc
+ = False -- Ignore diagonal elements
+ | not (is_as red_decl == is_as cov_decl)
+ = False -- They bring into scope different qualified names
+ | not (is_qual red_decl) && is_qual cov_decl
+ = False -- Covering one doesn't bring unqualified name into scope
+ | red_selective
+ = not cov_selective -- Redundant one is selective and covering one isn't
+ || red_later -- Both are explicit; tie-break using red_later
+ | otherwise
+ = not cov_selective -- Neither import is selective
+ && (is_mod red_decl == is_mod cov_decl) -- They import the same module
+ && red_later -- Tie-break
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)
-
+ red_loc = importSpecLoc red_imp
+ cov_loc = importSpecLoc cov_imp
+ red_later = red_loc > cov_loc
+ cov_selective = selectiveImpItem cov_item
+ red_selective = selectiveImpItem red_item
+
+selectiveImpItem :: ImpItemSpec -> Bool
+selectiveImpItem ImpAll = False
+selectiveImpItem (ImpSome {}) = True
+
-- ToDo: deal with original imports with 'qualified' and 'as M' clauses
printMinimalImports :: FiniteMap Module AvailEnv -- Minimal imports
-> RnM ()
%************************************************************************
\begin{code}
-badImportItemErr iface imp_spec ie
- = sep [ptext SLIT("Module"), quotes (ppr (is_mod imp_spec)), source_import,
+badImportItemErr iface decl_spec ie
+ = sep [ptext SLIT("Module"), quotes (ppr (is_mod decl_spec)), source_import,
ptext SLIT("does not export"), quotes (ppr ie)]
where
source_import | mi_boot iface = ptext SLIT("(hi-boot interface)")
[] -> pprPanic "exportClashErr" (ppr name)
addDupDeclErr :: Name -> Name -> TcRn ()
-addDupDeclErr name1 name2
+addDupDeclErr name_a name_b
= addErrAt (srcLocSpan loc2) $
vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr name1),
ptext SLIT("Declared at:") <+> vcat [ppr (nameSrcLoc name1), ppr loc2]]
where
- loc2 = nameSrcLoc name2
+ loc2 = nameSrcLoc name2
+ (name1,name2) | nameSrcLoc name_a > nameSrcLoc name_b = (name_b,name_a)
+ | otherwise = (name_a,name_b)
+ -- Report the error at the later location
dupExportWarn occ_name ie1 ie2
= hsep [quotes (ppr occ_name),
projects / ghc-hetmet.git / blobdiff