-import HsSyn ( IE(..), ieName, ImportDecl(..),
+import HsSyn ( IE(..), ieName, ImportDecl(..), LImportDecl,
import RnEnv
import IfaceEnv ( lookupOrig, newGlobalBinder )
import LoadIface ( loadSrcInterface )
import TcRnMonad
import FiniteMap
import RnEnv
import IfaceEnv ( lookupOrig, newGlobalBinder )
import LoadIface ( loadSrcInterface )
import TcRnMonad
import FiniteMap
-import PrelNames ( pRELUDE_Name, isBuiltInSyntaxName, isUnboundName )
+import PrelNames ( pRELUDE_Name, isBuiltInSyntaxName, isUnboundName,
+ main_RDR_Unqual )
import Module ( Module, ModuleName, moduleName, mkPackageModule,
moduleNameUserString, isHomeModule,
unitModuleEnvByName, unitModuleEnv,
import Module ( Module, ModuleName, moduleName, mkPackageModule,
moduleNameUserString, isHomeModule,
unitModuleEnvByName, unitModuleEnv,
isLocalGRE, pprNameProvenance )
import Outputable
import Maybes ( isJust, isNothing, catMaybes, mapCatMaybes )
isLocalGRE, pprNameProvenance )
import Outputable
import Maybes ( isJust, isNothing, catMaybes, mapCatMaybes )
import ListSetOps ( removeDups )
import Util ( sortLt, notNull )
import List ( partition, insert )
import ListSetOps ( removeDups )
import Util ( sortLt, notNull )
import List ( partition, insert )
-- Do the non {- SOURCE -} ones first, so that we get a helpful
-- warning for {- SOURCE -} ones that are unnecessary
getModule `thenM` \ this_mod ->
-- Do the non {- SOURCE -} ones first, so that we get a helpful
-- warning for {- SOURCE -} ones that are unnecessary
getModule `thenM` \ this_mod ->
-- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
-- because the former doesn't even look at Prelude.hi for instance
-- declarations, whereas the latter does.
-- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
-- because the former doesn't even look at Prelude.hi for instance
-- declarations, whereas the latter does.
False {- Not a boot interface -}
False {- Not qualified -}
Nothing {- No "as" -}
Nothing {- No import list -}
False {- Not a boot interface -}
False {- Not qualified -}
Nothing {- No "as" -}
Nothing {- No import list -}
-> RnM (GlobalRdrEnv, ImportAvails)
importsFromImportDecl this_mod
-> RnM (GlobalRdrEnv, ImportAvails)
importsFromImportDecl this_mod
-- If there's an error in loadInterface, (e.g. interface
-- file not found) we get lots of spurious errors from 'filterImports'
let
-- If there's an error in loadInterface, (e.g. interface
-- file not found) we get lots of spurious errors from 'filterImports'
let
-- module M ( module P ) where ...
-- Then we must export whatever came from P unqualified.
imp_spec = ImportSpec { is_mod = imp_mod_name, is_qual = qual_only,
-- module M ( module P ) where ...
-- Then we must export whatever came from P unqualified.
imp_spec = ImportSpec { is_mod = imp_mod_name, is_qual = qual_only,
mk_deprec = mi_dep_fn iface
gres = [ GRE { gre_name = name,
gre_prov = Imported [imp_spec] (name `elemNameSet` explicits),
mk_deprec = mi_dep_fn iface
gres = [ GRE { gre_name = name,
gre_prov = Imported [imp_spec] (name `elemNameSet` explicits),
-@getLocalDeclBinders@ returns the names for a @RdrNameHsDecl@. It's
-used for both source code (from @importsFromLocalDecls@) and interface
-files (@loadDecl@ calls @getTyClDeclBinders@).
+@getLocalDeclBinders@ returns the names for an @HsDecl@. It's
+used for source code.
- val_hs_bndrs = collectLocatedHsBinders val_decls
- for_hs_bndrs = [(nm,loc) | ForeignImport nm _ _ _ loc <- foreign_decls]
+ val_hs_bndrs = collectGroupBinders val_decls
+ for_hs_bndrs = [nm | L _ (ForeignImport nm _ _ _) <- foreign_decls]
new_tc tc_decl
= newTopSrcBinder mod Nothing main_rdr `thenM` \ main_name ->
mappM (newTopSrcBinder mod (Just main_name)) sub_rdrs `thenM` \ sub_names ->
returnM (AvailTC main_name (main_name : sub_names))
where
new_tc tc_decl
= newTopSrcBinder mod Nothing main_rdr `thenM` \ main_name ->
mappM (newTopSrcBinder mod (Just main_name)) sub_rdrs `thenM` \ sub_names ->
returnM (AvailTC main_name (main_name : sub_names))
where
\begin{code}
filterImports :: Module -- The module being imported
-> IsBootInterface -- Tells whether it's a {-# SOURCE #-} import
\begin{code}
filterImports :: Module -- The module being imported
-> IsBootInterface -- Tells whether it's a {-# SOURCE #-} import
-> [AvailInfo] -- What's available
-> RnM ([AvailInfo], -- What's imported
NameSet) -- What was imported explicitly
-> [AvailInfo] -- What's available
-> RnM ([AvailInfo], -- What's imported
NameSet) -- What was imported explicitly
= returnM (imports, emptyNameSet)
filterImports mod from (Just (want_hiding, import_items)) total_avails
= returnM (imports, emptyNameSet)
filterImports mod from (Just (want_hiding, import_items)) total_avails
let
(item_avails, explicits_s) = unzip (concat avails_w_explicits_s)
explicits = foldl addListToNameSet emptyNameSet explicits_s
let
(item_avails, explicits_s) = unzip (concat avails_w_explicits_s)
explicits = foldl addListToNameSet emptyNameSet explicits_s
-- Empty list for a bad item.
-- Singleton is typical case.
-- Can have two when we are hiding, and mention C which might be
-- Empty list for a bad item.
-- Singleton is typical case.
-- Can have two when we are hiding, and mention C which might be
-- The [Name] is the list of explicitly-mentioned names
get_item item@(IEModuleContents _) = bale_out item
-- The [Name] is the list of explicitly-mentioned names
get_item item@(IEModuleContents _) = bale_out item
= case check_item item of
Nothing -> bale_out item
Just avail@(AvailTC _ [n]) -> -- This occurs when you import T(..), but
-- only export T abstractly. The single [n]
-- in the AvailTC is the type or class itself
= case check_item item of
Nothing -> bale_out item
Just avail@(AvailTC _ [n]) -> -- This occurs when you import T(..), but
-- only export T abstractly. The single [n]
-- in the AvailTC is the type or class itself
returnM [(avail, [availName avail])]
Just avail -> returnM [(avail, [availName avail])]
returnM [(avail, [availName avail])]
Just avail -> returnM [(avail, [availName avail])]
-> AvailInfo -- Available
-> Maybe AvailInfo -- Resulting available;
-- Nothing if (any of the) wanted stuff isn't there
-> AvailInfo -- Available
-> Maybe AvailInfo -- Resulting available;
-- Nothing if (any of the) wanted stuff isn't there
-- so we can common-up related AvailInfos
emptyExportAccum = ([], emptyFM, emptyAvailEnv)
-- so we can common-up related AvailInfos
emptyExportAccum = ([], emptyFM, emptyAvailEnv)
-- Tracks what a particular exported OccName
-- in an export list refers to, and which item
-- it came from. It's illegal to export two distinct things
-- that have the same occurrence name
-- Tracks what a particular exported OccName
-- in an export list refers to, and which item
-- it came from. It's illegal to export two distinct things
-- that have the same occurrence name
-exportsFromAvail :: Maybe Module -- Nothing => no 'module M(..) where' header at all
- -> Maybe [RdrNameIE] -- Nothing => no explicit export list
+exportsFromAvail :: Bool -- False => no 'module M(..) where' header at all
+ -> Maybe [Located (IE RdrName)] -- Nothing => no explicit export list
-> RnM Avails
-- Complains if two distinct exports have same OccName
-- Warns about identical exports.
-- Complains about exports items not in scope
-> RnM Avails
-- Complains if two distinct exports have same OccName
-- Warns about identical exports.
-- Complains about exports items not in scope
= do { TcGblEnv { tcg_rdr_env = rdr_env,
tcg_imports = imports } <- getGblEnv ;
= do { TcGblEnv { tcg_rdr_env = rdr_env,
tcg_imports = imports } <- getGblEnv ;
- = case maybe_mod of
- Just mod -> exports
- Nothing | ghci_mode == Interactive -> Nothing
- | otherwise -> Just [IEVar main_RDR_Unqual] } ;
-
+ | explicit_mod = exports
+ | ghci_mode == Interactive = Nothing
+ | otherwise = Just [noLoc (IEVar main_RDR_Unqual)] } ;
exports_from_avail Nothing rdr_env
imports@(ImportAvails { imp_env = entity_avail_env })
= -- Export all locally-defined things
exports_from_avail Nothing rdr_env
imports@(ImportAvails { imp_env = entity_avail_env })
= -- Export all locally-defined things
exports_from_avail (Just export_items) rdr_env
(ImportAvails { imp_qual = mod_avail_env,
imp_env = entity_avail_env })
exports_from_avail (Just export_items) rdr_env
(ImportAvails { imp_qual = mod_avail_env,
imp_env = entity_avail_env })
export_items `thenM` \ (_, _, export_avail_map) ->
returnM (nameEnvElts export_avail_map)
where
export_items `thenM` \ (_, _, export_avail_map) ->
returnM (nameEnvElts export_avail_map)
where
exports_from_item acc@(mods, occs, avails) ie@(IEModuleContents mod)
| mod `elem` mods -- Duplicate export of M
= do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
exports_from_item acc@(mods, occs, avails) ie@(IEModuleContents mod)
| mod `elem` mods -- Duplicate export of M
= do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
check_occs ie occs export_avail `thenM` \ occs' ->
returnM (mods, occs', addAvail avails export_avail)
}
check_occs ie occs export_avail `thenM` \ occs' ->
returnM (mods, occs', addAvail avails export_avail)
}
-- This occurs when you import T(..), but
-- only export T abstractly. The single [n]
-- in the AvailTC is the type or class itself
-- This occurs when you import T(..), but
-- only export T abstractly. The single [n]
-- in the AvailTC is the type or class itself
-- modules even if we use nothing from them; see notes above]
unused_imp_mods = [m | m <- direct_import_mods,
isNothing (lookupFM minimal_imports1 m),
-- modules even if we use nothing from them; see notes above]
unused_imp_mods = [m | m <- direct_import_mods,
isNothing (lookupFM minimal_imports1 m),
dodgyImportWarn mod item = dodgyMsg (ptext SLIT("import")) item
dodgyExportWarn item = dodgyMsg (ptext SLIT("export")) item
dodgyImportWarn mod item = dodgyMsg (ptext SLIT("import")) item
dodgyExportWarn item = dodgyMsg (ptext SLIT("export")) item
-dodgyMsg kind item@(IEThingAll tc)
- = sep [ ptext SLIT("The") <+> kind <+> ptext SLIT("item") <+> quotes (ppr item),
+dodgyMsg kind tc
+ = sep [ ptext SLIT("The") <+> kind <+> ptext SLIT("item") <+> quotes (ppr (IEThingAll tc)),
ptext SLIT("suggests that") <+> quotes (ppr tc) <+> ptext SLIT("has constructor or class methods"),
ptext SLIT("but it has none; it is a type synonym or abstract type or class") ]
ptext SLIT("suggests that") <+> quotes (ppr tc) <+> ptext SLIT("has constructor or class methods"),
ptext SLIT("but it has none; it is a type synonym or abstract type or class") ]