\begin{code}
module RnNames (
- rnImports, importsFromLocalDecls, exportsFromAvail,
+ rnImports, importsFromLocalDecls,
reportUnusedNames, reportDeprecations,
- mkModDeps, exportsToAvails
+ mkModDeps, exportsToAvails, exportsFromAvail
) where
#include "HsVersions.h"
import PrelNames ( pRELUDE, isUnboundName, main_RDR_Unqual )
import Module ( Module, moduleUserString,
unitModuleEnv, unitModuleEnv,
- lookupModuleEnv, moduleEnvElts )
+ lookupModuleEnv, moduleEnvElts, foldModuleEnv )
import Name ( Name, nameSrcLoc, nameOccName, nameModule, isWiredInName,
nameParent, nameParent_maybe, isExternalName,
isBuiltInSyntax )
import NameSet
+import NameEnv
import OccName ( srcDataName, isTcOcc, occNameFlavour, OccEnv,
mkOccEnv, lookupOccEnv, emptyOccEnv, extendOccEnv )
-import HscTypes ( GenAvailInfo(..), AvailInfo, Avails, GhciMode(..),
+import HscTypes ( GenAvailInfo(..), AvailInfo, GhciMode(..),
IfaceExport, HomePackageTable, PackageIfaceTable,
- availName, availNames, availsToNameSet, unQualInScope,
+ availNames, unQualInScope,
Deprecs(..), ModIface(..), Dependencies(..),
lookupIface, ExternalPackageState(..),
IfacePackage(..)
Provenance(..), ImportSpec(..),
isLocalGRE, pprNameProvenance )
import Outputable
-import Maybes ( isNothing, catMaybes, mapCatMaybes, seqMaybe )
+import Maybes ( isNothing, catMaybes, mapCatMaybes, seqMaybe, orElse )
import SrcLoc ( noSrcLoc, Located(..), mkGeneralSrcSpan,
unLoc, noLoc, srcLocSpan, combineSrcSpans, SrcSpan )
import BasicTypes ( DeprecTxt )
imp_spec = ImportSpec { is_mod = imp_mod_name, is_qual = qual_only,
is_loc = loc, is_as = qual_mod_name }
in
-
-- Get the total imports, and filter them according to the import list
exportsToAvails filtered_exports `thenM` \ total_avails ->
filterImports iface imp_spec
-- module M ( module P ) where ...
-- Then we must export whatever came from P unqualified.
imports = ImportAvails {
- imp_qual = unitModuleEnv qual_mod_name avail_env,
- imp_env = avail_env,
+ imp_env = unitModuleEnv qual_mod_name avail_env,
imp_mods = unitModuleEnv imp_mod (imp_mod, import_all, loc),
imp_orphs = orphans,
imp_dep_mods = mkModDeps dependent_mods,
returnM (gbl_env, imports)
-exportsToAvails :: [IfaceExport] -> TcRnIf gbl lcl Avails
+exportsToAvails :: [IfaceExport] -> TcRnIf gbl lcl NameSet
exportsToAvails exports
- = do { avails_by_module <- mappM do_one exports
- ; return (concat avails_by_module) }
+ = foldlM do_one emptyNameSet exports
where
- do_one (mod_name, exports) = mapM (do_avail mod_name) exports
- do_avail mod (Avail n) = do { n' <- lookupOrig mod n;
- ; return (Avail n') }
- do_avail mod (AvailTC n ns) = do { n' <- lookupOrig mod n
- ; ns' <- mappM (lookup_sub n') ns
- ; return (AvailTC n' ns') }
+ do_one acc (mod, exports) = foldlM (do_avail mod) acc exports
+ do_avail mod acc (Avail n) = do { n' <- lookupOrig mod n;
+ ; return (addOneToNameSet acc n') }
+ do_avail mod acc (AvailTC n ns) = do { n' <- lookupOrig mod n
+ ; ns' <- mappM (lookup_sub n') ns
+ ; return (addListToNameSet acc (n':ns')) }
where
lookup_sub parent occ = newGlobalBinder mod occ (Just parent) noSrcLoc
-- Hack alert! Notice the newGlobalBinder. It ensures that the subordinate
-- It's worth doing because it makes the environment smaller for
-- every module that imports the Prelude
--
- -- Note: don't filter the gbl_env (hence avails, not avails' in
- -- defn of gbl_env above). Stupid reason: when parsing
+ -- Note: don't filter the gbl_env (hence all_names, not filered_all_names
+ -- in defn of gres above). Stupid reason: when parsing
-- data type decls, the constructors start as Exact tycon-names,
-- and then get turned into data con names by zapping the name space;
-- but that stops them being Exact, so they get looked up.
-- Ditto in fixity decls; e.g. infix 5 :
-- Sigh. It doesn't matter because it only affects the Data.Tuple really.
-- The important thing is to trim down the exports.
+ filtered_names
+ | implicit_prelude = filter (not . isBuiltInSyntax) all_names
+ | otherwise = all_names
- avails' | implicit_prelude = filter not_built_in_syntax avails
- | otherwise = avails
- not_built_in_syntax a = not (all isBuiltInSyntax (availNames a))
- -- Only filter it if all the names of the avail are built-in
- -- In particular, lists have (:) which is not built in syntax
- -- so we don't filter it out. [Sept 03: wrong: see isBuiltInSyntax]
-
- avail_env = mkAvailEnv avails'
- imports = emptyImportAvails {
- imp_qual = unitModuleEnv this_mod avail_env,
- imp_env = avail_env
+ imports = emptyImportAvails {
+ imp_env = unitModuleEnv this_mod $
+ mkNameSet filtered_names
}
in
returnM (gbl_env, imports)
filterImports :: ModIface
-> ImportSpec -- The span for the entire import decl
-> Maybe (Bool, [Located (IE RdrName)]) -- Import spec; True => hiding
- -> [AvailInfo] -- What's available
- -> RnM (AvailEnv, -- What's imported (qualified or unqualified)
+ -> NameSet -- What's available
+ -> RnM (NameSet, -- What's imported (qualified or unqualified)
GlobalRdrEnv) -- Same again, but in GRE form
-- Complains if import spec mentions things that the module doesn't export
-- Warns/informs if import spec contains duplicates.
-mkGenericRdrEnv imp_spec avails
+mkGenericRdrEnv imp_spec names
= mkGlobalRdrEnv [ GRE { gre_name = name, gre_prov = Imported [imp_spec] False }
- | avail <- avails, name <- availNames avail ]
+ | name <- nameSetToList names ]
-filterImports iface imp_spec Nothing total_avails
- = returnM (mkAvailEnv total_avails,
- mkGenericRdrEnv imp_spec total_avails)
+filterImports iface imp_spec Nothing all_names
+ = returnM (all_names, mkGenericRdrEnv imp_spec all_names)
-filterImports iface imp_spec (Just (want_hiding, import_items)) total_avails
- = mapAndUnzipM (addLocM get_item) import_items `thenM` \ (avails_s, gres) ->
+filterImports iface imp_spec (Just (want_hiding, import_items)) all_names
+ = mappM (addLocM get_item) import_items `thenM` \ gres_s ->
let
- avails = concat avails_s
+ gres = concat gres_s
+ specified_names = mkNameSet (map gre_name gres)
in
if not want_hiding then
- return (mkAvailEnv avails,
- foldr plusGlobalRdrEnv emptyGlobalRdrEnv gres)
+ return (specified_names, mkGlobalRdrEnv gres)
else
- let
- hidden = availsToNameSet avails
- keep n = not (n `elemNameSet` hidden)
- pruned_avails = pruneAvails keep total_avails
- in
- return (mkAvailEnv pruned_avails,
- mkGenericRdrEnv imp_spec pruned_avails)
+ let
+ keep n = not (n `elemNameSet` specified_names)
+ pruned_avails = filterNameSet keep all_names
+ in
+ return (pruned_avails, mkGenericRdrEnv imp_spec pruned_avails)
where
- import_fm :: OccEnv AvailInfo
- import_fm = mkOccEnv [ (nameOccName name, avail)
- | avail <- total_avails,
- name <- availNames avail]
- -- Even though availNames returns data constructors too,
+ occ_env :: OccEnv Name -- Maps OccName to corresponding Name
+ occ_env = mkOccEnv [(nameOccName n, n) | n <- nameSetToList all_names]
+ -- This env will have entries for data constructors too,
-- they won't make any difference because naked entities like T
-- in an import list map to TcOccs, not VarOccs.
- bale_out item = addErr (badImportItemErr iface imp_spec item) `thenM_`
- returnM ([], emptyGlobalRdrEnv)
+ sub_env :: NameEnv [Name]
+ sub_env = mkSubNameEnv all_names
+
+ bale_out item = addErr (badImportItemErr iface imp_spec item) `thenM_`
+ returnM []
- succeed_with :: Bool -> AvailInfo -> RnM ([AvailInfo], GlobalRdrEnv)
- succeed_with all_explicit avail
+ succeed_with :: Bool -> [Name] -> RnM [GlobalRdrElt]
+ succeed_with all_explicit names
= do { loc <- getSrcSpanM
- ; returnM ([avail],
- mkGlobalRdrEnv (map (mk_gre loc) (availNames avail))) }
+ ; 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 || name == main_name
- main_name = availName avail
+ explicit name = all_explicit || isNothing (nameParent_maybe name)
- get_item :: IE RdrName -> RnM ([AvailInfo], GlobalRdrEnv)
+ get_item :: IE RdrName -> RnM [GlobalRdrElt]
-- Empty result for a bad item.
-- Singleton result is typical case.
-- Can have two when we are hiding, and mention C which might be
get_item item@(IEThingAll tc)
= 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
- ifOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn tc)) `thenM_`
- succeed_with False avail
- Just avail -> succeed_with False avail
+ [] -> bale_out item
+
+ [n] -> -- This occurs when you import T(..), but
+ -- only export T abstractly. The single [n]
+ -- in the AvailTC is the type or class itself
+ ifOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn tc)) `thenM_`
+ succeed_with False [n]
+
+ names -> succeed_with False names
get_item item@(IEThingAbs n)
| want_hiding -- hiding( C )
-- Here the 'C' can be a data constructor
-- *or* a type/class, or even both
- = case catMaybes [check_item item, check_item (IEVar data_n)] of
- [] -> bale_out item
- avails -> returnM (avails, emptyGlobalRdrEnv)
- -- The GlobalRdrEnv result is irrelevant when hiding
+ = case concat [check_item item, check_item (IEVar data_n)] of
+ [] -> bale_out item
+ names -> succeed_with True names
where
data_n = setRdrNameSpace n srcDataName
get_item item
= case check_item item of
- Nothing -> bale_out item
- Just avail -> succeed_with True avail
-
- check_item item
- | isNothing maybe_in_import_avails ||
- isNothing maybe_filtered_avail
- = Nothing
-
- | otherwise
- = Just filtered_avail
-
- where
- wanted_occ = rdrNameOcc (ieName item)
- maybe_in_import_avails = lookupOccEnv import_fm wanted_occ
-
- Just avail = maybe_in_import_avails
- maybe_filtered_avail = filterAvail item avail
- Just filtered_avail = maybe_filtered_avail
-\end{code}
-
-\begin{code}
-filterAvail :: IE RdrName -- Wanted
- -> AvailInfo -- Available
- -> Maybe AvailInfo -- Resulting available;
- -- Nothing if (any of the) wanted stuff isn't there
-
-filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
- | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
- | otherwise = Nothing
- where
- is_wanted name = nameOccName name `elem` wanted_occs
- sub_names_ok = all (`elem` avail_occs) wanted_occs
- avail_occs = map nameOccName ns
- wanted_occs = map rdrNameOcc (want:wants)
-
-filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
- Just (AvailTC n [n])
-
-filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
-
-filterAvail (IEVar _) avail@(Avail n) = Just avail
-filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
- where
- wanted n = nameOccName n == occ
- occ = rdrNameOcc v
- -- The second equation happens if we import a class op, thus
- -- import A( op )
- -- where op is a class operation
-
-filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
- -- We don't complain even if the IE says T(..), but
- -- no constrs/class ops of T are available
- -- Instead that's caught with a warning by the caller
-
-filterAvail ie avail = Nothing
+ [] -> bale_out item
+ names -> succeed_with True names
+
+ check_item :: IE RdrName -> [Name]
+ check_item item
+ = case lookupOccEnv occ_env (rdrNameOcc (ieName item)) of
+ Nothing -> []
+ Just name -> filterAvail item name sub_env
\end{code}
| gre <- globalRdrEnvElts rdr_env,
isLocalGRE gre ])
-exports_from_avail (Just export_items) rdr_env
- (ImportAvails { imp_qual = mod_avail_env,
- imp_env = entity_avail_env })
- = foldlM (exports_from_litem) emptyExportAccum
- export_items `thenM` \ (_, _, exports) ->
+exports_from_avail (Just items) rdr_env (ImportAvails { imp_env = imp_env })
+ = foldlM do_litem emptyExportAccum items `thenM` \ (_, _, exports) ->
returnM exports
-
where
- exports_from_litem :: ExportAccum -> Located (IE RdrName) -> RnM ExportAccum
- exports_from_litem acc = addLocM (exports_from_item acc)
+ sub_env :: NameEnv [Name] -- Classify each name by its parent
+ sub_env = mkSubNameEnv (foldModuleEnv unionNameSets emptyNameSet imp_env)
+
+ do_litem :: ExportAccum -> Located (IE RdrName) -> RnM ExportAccum
+ do_litem acc = addLocM (exports_from_item acc)
exports_from_item :: ExportAccum -> IE RdrName -> RnM ExportAccum
exports_from_item acc@(mods, occs, exports) ie@(IEModuleContents mod)
returnM acc }
| otherwise
- = case lookupModuleEnv mod_avail_env mod of
+ = case lookupModuleEnv imp_env mod of
Nothing -> addErr (modExportErr mod) `thenM_`
returnM acc
-
- Just avail_env
+ Just names
-> let
- new_exports = [ name | avail <- availEnvElts avail_env,
- name <- availNames avail,
- inScopeUnqual rdr_env name ]
+ new_exports = filterNameSet (inScopeUnqual rdr_env) names
in
-- This check_occs not only finds conflicts between this item
-- and others, but also internally within this item. That is,
-- if 'M.x' is in scope in several ways, we'll have several
-- members of mod_avails with the same OccName.
- check_occs ie occs new_exports `thenM` \ occs' ->
- returnM (mod:mods, occs', addListToNameSet exports new_exports)
+ check_occs ie occs (nameSetToList new_exports) `thenM` \ occs' ->
+ returnM (mod:mods, occs', exports `unionNameSets` new_exports)
exports_from_item acc@(mods, occs, exports) ie
= lookupGlobalOccRn (ieName ie) `thenM` \ name ->
if isUnboundName name then
returnM acc -- Avoid error cascade
- else
- -- Get the AvailInfo for the parent of the specified name
- let
- parent = nameParent name
- avail = lookupAvailEnv entity_avail_env parent
- in
- -- Filter out the bits we want
- case filterAvail ie avail of {
- Nothing -> -- Not enough availability
- addErr (exportItemErr ie) `thenM_`
- returnM acc ;
-
- Just export_avail ->
-
- -- Phew! It's OK! Now to check the occurrence stuff!
-
- let
- new_exports = availNames export_avail
+ else let
+ new_exports = filterAvail ie name sub_env
in
- checkForDodgyExport ie new_exports `thenM_`
- check_occs ie occs new_exports `thenM` \ occs' ->
+ checkErr (not (null new_exports)) (exportItemErr ie) `thenM_`
+ checkForDodgyExport ie new_exports `thenM_`
+ check_occs ie occs new_exports `thenM` \ occs' ->
returnM (mods, occs', addListToNameSet exports new_exports)
- }
+
+-------------------------------
+filterAvail :: IE RdrName -- Wanted
+ -> Name -- The Name of the ieName of the item
+ -> NameEnv [Name] -- Maps type/class names to their sub-names
+ -> [Name] -- Empty if even one thing reqd is missing
+
+filterAvail (IEVar _) n subs = [n]
+filterAvail (IEThingAbs _) n subs = [n]
+filterAvail (IEThingAll _) n subs = n : subNames subs n
+filterAvail (IEThingWith _ rdrs) n subs
+ | any isNothing mb_names = []
+ | otherwise = n : catMaybes mb_names
+ where
+ env = mkOccEnv [(nameOccName s, s) | s <- subNames subs n]
+ mb_names = map (lookupOccEnv env . rdrNameOcc) rdrs
+
+subNames :: NameEnv [Name] -> Name -> [Name]
+subNames env n = lookupNameEnv env n `orElse` []
+mkSubNameEnv :: NameSet -> NameEnv [Name]
+-- Maps types and classes to their constructors/classops respectively
+-- This mapping just makes it easier to deal with A(..) export items
+mkSubNameEnv names
+ = foldNameSet add_name emptyNameEnv names
+ where
+ add_name name env
+ | Just parent <- nameParent_maybe name
+ = extendNameEnv_C (\ns _ -> name:ns) env parent [name]
+ | otherwise = env
-------------------------------
inScopeUnqual :: GlobalRdrEnv -> Name -> Bool
-------------------------------
checkForDodgyExport :: IE RdrName -> [Name] -> RnM ()
-checkForDodgyExport (IEThingAll tc) [n] = addWarn (dodgyExportWarn tc)
- -- This occurs when you import T(..), but
- -- only export T abstractly. The single [n]
- -- in the AvailTC is the type or class itself
+checkForDodgyExport ie@(IEThingAll tc) [n]
+ | isTcOcc (nameOccName n) = addWarn (dodgyExportWarn tc)
+ -- This occurs when you export T(..), but
+ -- only import T abstractly, or T is a synonym.
+ -- The single [n] is the type or class itself
+ | otherwise = addErr (exportItemErr ie)
+ -- This happes if you export x(..), which is bogus
checkForDodgyExport _ _ = return ()
-------------------------------
IfGblEnv(..), IfLclEnv(..),
-- Ranamer types
- EntityUsage, emptyUsages, ErrCtxt,
+ ErrCtxt,
ImportAvails(..), emptyImportAvails, plusImportAvails,
plusAvail, pruneAvails,
AvailEnv, emptyAvailEnv, unitAvailEnv, plusAvailEnv,
import RdrName ( GlobalRdrEnv, LocalRdrEnv )
import Name ( Name )
import NameEnv
-import NameSet ( NameSet, emptyNameSet, DefUses )
+import NameSet ( NameSet, unionNameSets, DefUses )
import OccName ( OccEnv )
import Var ( Id, TyVar )
import VarEnv ( TidyEnv )
%************************************************************************
%* *
- EntityUsage
-%* *
-%************************************************************************
-
-EntityUsage tells what things are actually need in order to compile this
-module. It is used for generating the usage-version field of the ModIface.
-
-Note that we do not record version info for entities from
-other (non-home) packages. If the package changes, GHC doesn't help.
-
-\begin{code}
-type EntityUsage = NameSet
- -- The Names are all the (a) home-package
- -- (b) "big" (i.e. no data cons, class ops)
- -- (c) non-locally-defined
- -- (d) non-wired-in
- -- names that have been slurped in so far.
- -- This is used to generate the "usage" information for this module.
-
-emptyUsages :: EntityUsage
-emptyUsages = emptyNameSet
-\end{code}
-
-
-%************************************************************************
-%* *
Operations over ImportAvails
%* *
%************************************************************************
\begin{code}
data ImportAvails
= ImportAvails {
- imp_env :: AvailEnv,
- -- All the things that are available from the import
- -- Its domain is all the "main" things;
- -- i.e. *excluding* class ops and constructors
- -- (which appear inside their parent AvailTC)
-
- imp_qual :: ModuleEnv AvailEnv,
- -- Used to figure out "module M" export specifiers
+ imp_env :: ModuleEnv NameSet,
+ -- All the things imported, classified by
+ -- the *module qualifier* for its import
+ -- e.g. import List as Foo
+ -- would add a binding Foo |-> ...stuff from List...
+ -- to imp_env.
+ --
+ -- We need to classify them like this so that we can figure out
+ -- "module M" export specifiers in an export list
-- (see 1.4 Report Section 5.1.1). Ultimately, we want to find
-- everything that is unambiguously in scope as 'M.x'
-- and where plain 'x' is (perhaps ambiguously) in scope.
-- So the starting point is all things that are in scope as 'M.x',
-- which is what this field tells us.
- --
- -- Domain is the *module qualifier* for imports.
- -- e.g. import List as Foo
- -- would add a binding Foo |-> ...stuff from List...
- -- to imp_qual.
- -- We keep the stuff as an AvailEnv so that it's easy to
- -- combine stuff coming from different (unqualified)
- -- imports of the same module
imp_mods :: ModuleEnv (Module, Maybe Bool, SrcSpan),
-- Domain is all directly-imported modules
add env elt@(m,_) = extendModuleEnv env m elt
emptyImportAvails :: ImportAvails
-emptyImportAvails = ImportAvails { imp_env = emptyAvailEnv,
- imp_qual = emptyModuleEnv,
+emptyImportAvails = ImportAvails { imp_env = emptyModuleEnv,
imp_mods = emptyModuleEnv,
imp_dep_mods = emptyModuleEnv,
imp_dep_pkgs = [],
plusImportAvails :: ImportAvails -> ImportAvails -> ImportAvails
plusImportAvails
- (ImportAvails { imp_env = env1, imp_qual = unqual1, imp_mods = mods1,
+ (ImportAvails { imp_env = env1, imp_mods = mods1,
imp_dep_mods = dmods1, imp_dep_pkgs = dpkgs1, imp_orphs = orphs1 })
- (ImportAvails { imp_env = env2, imp_qual = unqual2, imp_mods = mods2,
+ (ImportAvails { imp_env = env2, imp_mods = mods2,
imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2, imp_orphs = orphs2 })
- = ImportAvails { imp_env = env1 `plusAvailEnv` env2,
- imp_qual = plusModuleEnv_C plusAvailEnv unqual1 unqual2,
+ = ImportAvails { imp_env = plusModuleEnv_C unionNameSets env1 env2,
imp_mods = mods1 `plusModuleEnv` mods2,
imp_dep_mods = plusModuleEnv_C plus_mod_dep dmods1 dmods2,
imp_dep_pkgs = dpkgs1 `unionLists` dpkgs2,
projects / ghc-hetmet.git / commitdiff