import RnEnv
import RnHsDoc ( rnHsDoc )
import IfaceEnv ( ifaceExportNames )
-import LoadIface ( loadSrcInterface, loadSysInterface )
+import LoadIface ( loadSrcInterface )
import TcRnMonad
import HeaderInfo ( mkPrelImports )
-- Do the non {- SOURCE -} ones first, so that we get a helpful
-- warning for {- SOURCE -} ones that are unnecessary
= do this_mod <- getModule
- implicit_prelude <- doptM Opt_ImplicitPrelude
+ implicit_prelude <- xoptM Opt_ImplicitPrelude
let prel_imports = mkPrelImports (moduleName this_mod) implicit_prelude imports
(source, ordinary) = partition is_source_import imports
is_source_import (L _ (ImportDecl _ _ is_boot _ _ _)) = is_boot
- ifOptM Opt_WarnImplicitPrelude (
+ ifDOptM Opt_WarnImplicitPrelude (
when (notNull prel_imports) $ addWarn (implicitPreludeWarn)
)
-> LImportDecl RdrName
-> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails,AnyHpcUsage)
-rnImportDecl this_mod implicit_prelude (L loc (ImportDecl loc_imp_mod_name mb_pkg want_boot
- qual_only as_mod imp_details))
+rnImportDecl this_mod implicit_prelude
+ (L loc (ImportDecl { ideclName = loc_imp_mod_name, ideclPkgQual = mb_pkg
+ , ideclSource = want_boot, ideclQualified = qual_only
+ , ideclAs = as_mod, ideclHiding = imp_details }))
= setSrcSpan loc $ do
when (isJust mb_pkg) $ do
- pkg_imports <- doptM Opt_PackageImports
+ pkg_imports <- xoptM Opt_PackageImports
when (not pkg_imports) $ addErr packageImportErr
-- If there's an error in loadInterface, (e.g. interface
return ()
_ ->
unless implicit_prelude $
- ifOptM Opt_WarnMissingImportList (addWarn (missingImportListWarn imp_mod_name))
+ ifDOptM Opt_WarnMissingImportList (addWarn (missingImportListWarn imp_mod_name))
iface <- loadSrcInterface doc imp_mod_name want_boot mb_pkg
}
-- Complain if we import a deprecated module
- ifOptM Opt_WarnWarningsDeprecations (
+ ifDOptM Opt_WarnWarningsDeprecations (
case warns of
WarnAll txt -> addWarn (moduleWarn imp_mod_name txt)
_ -> return ()
filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails
= do -- check for errors, convert RdrNames to Names
- opt_typeFamilies <- doptM Opt_TypeFamilies
+ opt_typeFamilies <- xoptM Opt_TypeFamilies
items1 <- mapM (lookup_lie opt_typeFamilies) import_items
let items2 :: [(LIE Name, AvailInfo)]
-- Warn when importing T(..) if T was exported abstractly
checkDodgyImport stuff
| IEThingAll n <- ieRdr, (_, AvailTC _ [_]):_ <- stuff
- = ifOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn n))
+ = ifDOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn n))
-- NB. use the RdrName for reporting the warning
checkDodgyImport _
= return ()
return acc }
| otherwise
- = do { implicit_prelude <- doptM Opt_ImplicitPrelude
+ = do { implicit_prelude <- xoptM Opt_ImplicitPrelude
; warnDodgyExports <- doptM Opt_WarnDodgyExports
; let { exportValid = (mod `elem` imported_modules)
|| (moduleName this_mod == mod)
then do addErr (exportItemErr ie)
return (IEThingWith name [], AvailTC name [name])
else do let names = catMaybes mb_names
- optTyFam <- doptM Opt_TypeFamilies
+ optTyFam <- xoptM Opt_TypeFamilies
when (not optTyFam && any isTyConName names) $
addErr (typeItemErr ( head
. filter isTyConName
-- All this happens only once per module
finishWarnings dflags mod_warn tcg_env
= do { (eps,hpt) <- getEpsAndHpt
- ; ifOptM Opt_WarnWarningsDeprecations $
+ ; ifDOptM Opt_WarnWarningsDeprecations $
mapM_ (check hpt (eps_PIT eps)) all_gres
-- By this time, typechecking is complete,
-- so the PIT is fully populated
its interface (although we could).
b) It might be GHC.Real.fromRational, or GHC.Num.fromInteger
- These are seen as "used" by the renamer (if -XNoImplicitPrelude)
+ These are seen as "used" by the renamer (if -XRebindableSyntax)
is on), but the typechecker may discard their uses
if in fact the in-scope fromRational is GHC.Read.fromRational,
(see tcPat.tcOverloadedLit), and the typechecker sees that the type
; let usage :: [ImportDeclUsage]
usage = findImportUsage imports rdr_env (Set.elems uses)
- ; ifOptM Opt_WarnUnusedImports $
+ ; ifDOptM Opt_WarnUnusedImports $
mapM_ warnUnusedImport usage
- ; ifOptM Opt_D_dump_minimal_imports $
+ ; ifDOptM Opt_D_dump_minimal_imports $
printMinimalImports usage }
where
explicit_import (L loc _) = isGoodSrcSpan loc
= map unused_decl imports
where
import_usage :: ImportMap
- import_usage = foldr add_rdr Map.empty rdrs
+ import_usage = foldr (addUsedRdrName rdr_env) Map.empty rdrs
unused_decl decl@(L loc (ImportDecl { ideclHiding = imps }))
= (decl, nubAvails used_avails, unused_imps)
where
used_avails = Map.lookup (srcSpanStart loc) import_usage `orElse` []
- used_names = availsToNameSet used_avails
+ dont_report_as_unused = foldr add emptyNameSet used_avails
+ add (Avail n) s = s `addOneToNameSet` n
+ add (AvailTC n ns) s = s `addListToNameSet` (n:ns)
+ -- If you use 'signum' from Num, then the user may well have
+ -- imported Num(signum). We don't want to complain that
+ -- Num is not itself mentioned. Hence adding 'n' as
+ -- well to the list of of "don't report if unused" names
unused_imps = case imps of
Just (False, imp_ies) -> nameSetToList unused_imps
where
imp_names = mkNameSet (concatMap (ieNames . unLoc) imp_ies)
- unused_imps = imp_names `minusNameSet` used_names
+ unused_imps = imp_names `minusNameSet` dont_report_as_unused
_other -> [] -- No explicit import list => no unused-name list
- add_rdr :: RdrName -> ImportMap -> ImportMap
- add_rdr rdr iu
- = case lookupGRE_RdrName rdr rdr_env of
- [gre] | Imported imps <- gre_prov gre
- -> add_imp gre (bestImport imps) iu
- _other -> iu
-
+addUsedRdrName :: GlobalRdrEnv -> RdrName -> ImportMap -> ImportMap
+-- For a used RdrName, find all the import decls that brought
+-- it into scope; choose one of them (bestImport), and record
+-- the RdrName in that import decl's entry in the ImportMap
+addUsedRdrName rdr_env rdr imp_map
+ | [gre] <- lookupGRE_RdrName rdr rdr_env
+ , Imported imps <- gre_prov gre
+ = add_imp gre (bestImport imps) imp_map
+ | otherwise
+ = imp_map
+ where
add_imp :: GlobalRdrElt -> ImportSpec -> ImportMap -> ImportMap
- add_imp gre (ImpSpec { is_decl = imp_decl_spec }) iu
- = Map.insertWith add decl_loc [avail] iu
+ add_imp gre (ImpSpec { is_decl = imp_decl_spec }) imp_map
+ = Map.insertWith add decl_loc [avail] imp_map
where
add _ avails = avail : avails -- add is really just a specialised (++)
decl_loc = srcSpanStart (is_dloc imp_decl_spec)
name = gre_name gre
avail = case gre_par gre of
- ParentIs p -> AvailTC p [p,name]
+ ParentIs p -> AvailTC p [name]
NoParent | isTyConName name -> AvailTC name [name]
| otherwise -> Avail name
- -- If you use (+) from Num, then for this purpose we want
- -- to say that Num is used as well. That is why in the
- -- ParentIs case we have [p,name] in the ParentIs case
-
-bestImport :: [ImportSpec] -> ImportSpec
-bestImport iss
- = case partition isImpAll iss of
- ([], imp_somes) -> textuallyFirst imp_somes
- (imp_alls, _) -> textuallyFirst imp_alls
-
-textuallyFirst :: [ImportSpec] -> ImportSpec
-textuallyFirst iss = case sortWith (is_dloc . is_decl) iss of
- [] -> pprPanic "textuallyFirst" (ppr iss)
- (is:_) -> is
-
-isImpAll :: ImportSpec -> Bool
-isImpAll (ImpSpec { is_item = ImpAll }) = True
-isImpAll _other = False
+
+ bestImport :: [ImportSpec] -> ImportSpec
+ bestImport iss
+ = case partition isImpAll iss of
+ ([], imp_somes) -> textuallyFirst imp_somes
+ (imp_alls, _) -> textuallyFirst imp_alls
+
+ textuallyFirst :: [ImportSpec] -> ImportSpec
+ textuallyFirst iss = case sortWith (is_dloc . is_decl) iss of
+ [] -> pprPanic "textuallyFirst" (ppr iss)
+ (is:_) -> is
+
+ isImpAll :: ImportSpec -> Bool
+ isImpAll (ImpSpec { is_item = ImpAll }) = True
+ isImpAll _other = False
\end{code}
\begin{code}
, Just (False, _) <- ideclHiding decl
= return (L l decl)
| otherwise
- = do { ies <- initIfaceTcRn $ mapM to_ie used
- ; return (L l (decl { ideclHiding = Just (False, map (L l) ies) })) }
+ = do { let ImportDecl { ideclName = L _ mod_name
+ , ideclSource = is_boot
+ , ideclPkgQual = mb_pkg } = decl
+ ; iface <- loadSrcInterface doc mod_name is_boot mb_pkg
+ ; let lies = map (L l) (concatMap (to_ie iface) used)
+ ; return (L l (decl { ideclHiding = Just (False, lies) })) }
+ where
+ doc = text "Compute minimal imports for" <+> ppr decl
- to_ie :: AvailInfo -> IfG (IE Name)
+ to_ie :: ModIface -> AvailInfo -> [IE Name]
-- The main trick here is that if we're importing all the constructors
-- we want to say "T(..)", but if we're importing only a subset we want
-- to say "T(A,B,C)". So we have to find out what the module exports.
- to_ie (Avail n) = return (IEVar n)
- to_ie (AvailTC n [m]) = ASSERT( n==m )
- return (IEThingAbs n)
- to_ie (AvailTC n ns) = do
- iface <- loadSysInterface doc n_mod
- case [xs | (m,as) <- mi_exports iface,
- m == n_mod,
- AvailTC x xs <- as,
- x == nameOccName n] of
- [xs] | all_used xs -> return (IEThingAll n)
- | otherwise -> return (IEThingWith n (filter (/= n) ns))
- other -> pprTrace "to_ie" (ppr n <+> ppr n_mod <+> ppr other) $
- return (IEVar n)
+ to_ie _ (Avail n)
+ = [IEVar n]
+ to_ie _ (AvailTC n [m])
+ | n==m = [IEThingAbs n]
+ to_ie iface (AvailTC n ns)
+ = case [xs | (m,as) <- mi_exports iface
+ , m == n_mod
+ , AvailTC x xs <- as
+ , x == nameOccName n
+ , x `elem` xs -- Note [Partial export]
+ ] of
+ [xs] | all_used xs -> [IEThingAll n]
+ | otherwise -> [IEThingWith n (filter (/= n) ns)]
+ _other -> (map IEVar ns)
where
all_used avail_occs = all (`elem` map nameOccName ns) avail_occs
- doc = text "Compute minimal imports from" <+> ppr n
n_mod = ASSERT( isExternalName n ) nameModule n
\end{code}
+Note [Partial export]
+~~~~~~~~~~~~~~~~~~~~~
+Suppose we have
+
+ module A( op ) where
+ class C a where
+ op :: a -> a
+
+ module B where
+ import A
+ f = ..op...
+
+Then the minimal import for module B is
+ import A( op )
+not
+ import A( C( op ) )
+which we would usually generate if C was exported from B. Hence
+the (x `elem` xs) test when deciding what to generate.
+
+
%************************************************************************
%* *
\subsection{Errors}
projects / ghc-hetmet.git / blobdiff