\begin{code}
module RnNames (
rnImports, importsFromLocalDecls, exportsFromAvail,
- reportUnusedNames, mkModDeps
+ reportUnusedNames, mkModDeps, main_RDR_Unqual
) where
#include "HsVersions.h"
import Name ( Name, nameSrcLoc, nameOccName, nameModule, isExternalName )
import NameSet
import NameEnv
-import OccName ( OccName, dataName, isTcOcc )
+import OccName ( OccName, srcDataName, isTcOcc )
import HscTypes ( Provenance(..), ImportReason(..), GlobalRdrEnv,
GenAvailInfo(..), AvailInfo, Avails,
- IsBootInterface, WhetherHasOrphans,
+ IsBootInterface,
availName, availNames, availsToNameSet,
- Deprecations(..), ModIface(..),
- GlobalRdrElt(..), unQualInScope, isLocalGRE
+ Deprecations(..), ModIface(..), Dependencies(..),
+ GlobalRdrElt(..), unQualInScope, isLocalGRE, pprNameProvenance
)
-import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace,
- emptyRdrEnv, foldRdrEnv, isQual )
+import OccName ( varName )
+import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace, lookupRdrEnv, rdrEnvToList,
+ emptyRdrEnv, foldRdrEnv, rdrEnvElts, mkRdrUnqual, isQual, mkUnqual )
import Outputable
-import Maybes ( maybeToBool, catMaybes )
+import Maybe ( isJust, isNothing, catMaybes, fromMaybe )
+import Maybes ( orElse, expectJust )
import ListSetOps ( removeDups )
import Util ( sortLt, notNull )
import List ( partition, insert )
avails_by_module = mi_exports iface
deprecs = mi_deprecs iface
is_orph = mi_orphan iface
+ deps = mi_deps iface
avails :: Avails
avails = [ avail | (mod_name, avails) <- avails_by_module,
filterImports imp_mod is_boot imp_spec avails `thenM` \ (filtered_avails, explicits) ->
let
- (sub_dep_mods, sub_dep_pkgs) = mi_deps iface
+ -- Compute new transitive dependencies
+ orphans | is_orph = insert imp_mod_name (dep_orphs deps)
+ | otherwise = dep_orphs deps
- -- Compute new transitive dependencies: take the ones in
- -- the interface and add
(dependent_mods, dependent_pkgs)
| isHomeModule imp_mod
= -- Imported module is from the home package
-- (a) remove this_mod (might be there as a hi-boot)
-- (b) add imp_mod itself
-- Take its dependent packages unchanged
- ((imp_mod_name, is_orph, is_boot) : filter not_self sub_dep_mods,
- sub_dep_pkgs)
+ ((imp_mod_name, is_boot) : filter not_self (dep_mods deps), dep_pkgs deps)
+
| otherwise
= -- Imported module is from another package
- -- Take only the orphan modules from its dependent modules
- -- (sigh! it would be better to dump them entirely)
+ -- Dump the dependent modules
-- Add the package imp_mod comes from to the dependent packages
-- from imp_mod
- (filter sub_is_orph sub_dep_mods,
- insert (mi_package iface) sub_dep_pkgs)
+ ([], insert (mi_package iface) (dep_pkgs deps))
- not_self (m, _, _) = m /= this_mod_name
- sub_is_orph (_, orph, _) = orph
+ not_self (m, _) = m /= this_mod_name
import_all = case imp_spec of
(Just (False, _)) -> False -- Imports are spec'd explicitly
qual_mod_name = case as_mod of
Nothing -> imp_mod_name
Just another_name -> another_name
-
+
-- unqual_avails is the Avails that are visible in *unqualified* form
-- We need to know this so we know what to export when we see
-- module M ( module P ) where ...
-- Then we must export whatever came from P unqualified.
avail_env = mkAvailEnv filtered_avails
- unqual_avails | qual_only = emptyAvailEnv -- Qualified import
- | otherwise = avail_env -- Unqualified import
mk_prov name = NonLocalDef (UserImport imp_mod iloc (name `elemNameSet` explicits))
gbl_env = mkGlobalRdrEnv qual_mod_name (not qual_only)
mk_prov filtered_avails deprecs
imports = ImportAvails {
- imp_unqual = unitModuleEnvByName qual_mod_name unqual_avails,
- imp_env = avail_env,
- imp_mods = unitModuleEnv imp_mod (imp_mod, import_all),
- dep_mods = mkModDeps dependent_mods,
- dep_pkgs = dependent_pkgs }
+ imp_qual = unitModuleEnvByName qual_mod_name avail_env,
+ imp_env = avail_env,
+ imp_mods = unitModuleEnv imp_mod (imp_mod, import_all),
+ imp_orphs = orphans,
+ imp_dep_mods = mkModDeps dependent_mods,
+ imp_dep_pkgs = dependent_pkgs }
in
-- Complain if we import a deprecated module
returnM (gbl_env, imports)
}
-mkModDeps :: [(ModuleName, WhetherHasOrphans, IsBootInterface)]
- -> ModuleEnv (ModuleName, WhetherHasOrphans, IsBootInterface)
+mkModDeps :: [(ModuleName, IsBootInterface)]
+ -> ModuleEnv (ModuleName, IsBootInterface)
mkModDeps deps = foldl add emptyModuleEnv deps
where
- add env elt@(m,_,_) = extendModuleEnvByName env m elt
+ add env elt@(m,_) = extendModuleEnvByName env m elt
\end{code}
avail_env = mkAvailEnv avails'
imports = emptyImportAvails {
- imp_unqual = unitModuleEnv this_mod avail_env,
- imp_env = avail_env
+ imp_qual = unitModuleEnv this_mod avail_env,
+ imp_env = avail_env
}
in
returnM (gbl_env, imports)
avails -> returnM [(a, []) | a <- avails]
-- The 'explicits' list is irrelevant when hiding
where
- data_n = setRdrNameSpace n dataName
+ data_n = setRdrNameSpace n srcDataName
get_item item
= case check_item item of
Just avail -> returnM [(avail, availNames avail)]
check_item item
- | not (maybeToBool maybe_in_import_avails) ||
- not (maybeToBool maybe_filtered_avail)
+ | isNothing maybe_in_import_avails ||
+ isNothing maybe_filtered_avail
= Nothing
| otherwise
-- Complains if two distinct exports have same OccName
-- Warns about identical exports.
-- Complains about exports items not in scope
-exportsFromAvail Nothing
+
+exportsFromAvail exports
+ = do { TcGblEnv { tcg_rdr_env = rdr_env,
+ tcg_imports = imports } <- getGblEnv ;
+ exports_from_avail exports rdr_env imports }
+
+exports_from_avail Nothing rdr_env
+ imports@(ImportAvails { imp_env = entity_avail_env })
= do { this_mod <- getModule ;
if moduleName this_mod == mAIN_Name then
- return []
- -- Export nothing; Main.$main is automatically exported
- else
- exportsFromAvail (Just [IEModuleContents (moduleName this_mod)])
- -- but for all other modules export everything.
+ exports_from_avail (Just [IEVar main_RDR_Unqual]) rdr_env imports
+ -- Behave just as if we'd said module Main(main)
+ -- This is particularly important if we compile module Main,
+ -- but then use ghci to call it... we jolly well expect to
+ -- see 'main'!
+ else
+ -- Export all locally-defined things
+ -- We do this by filtering the global RdrEnv,
+ -- keeping only things that are (a) qualified,
+ -- (b) locally defined, (c) a 'main' name
+ -- Then we look up in the entity-avail-env
+ return [ avail
+ | (rdr_name, gres) <- rdrEnvToList rdr_env,
+ isQual rdr_name, -- Avoid duplicates
+ GRE { gre_name = name,
+ gre_parent = Nothing, -- Main things only
+ gre_prov = LocalDef } <- gres,
+ let avail = expectJust "exportsFromAvail"
+ (lookupAvailEnv entity_avail_env name)
+ ]
}
-exportsFromAvail (Just exports)
- = do { TcGblEnv { tcg_imports = imports } <- getGblEnv ;
- warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
- exports_from_avail exports warn_dup_exports imports }
-
-exports_from_avail export_items warn_dup_exports
- (ImportAvails { imp_unqual = 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 })
= foldlM exports_from_item emptyExportAccum
export_items `thenM` \ (_, _, export_avail_map) ->
returnM (nameEnvElts export_avail_map)
exports_from_item acc@(mods, occs, avails) ie@(IEModuleContents mod)
| mod `elem` mods -- Duplicate export of M
- = warnIf warn_dup_exports (dupModuleExport mod) `thenM_`
- returnM acc
+ = do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
+ warnIf warn_dup_exports (dupModuleExport mod) ;
+ returnM acc }
| otherwise
= case lookupModuleEnvByName mod_avail_env mod of
- Nothing -> addErr (modExportErr mod) `thenM_`
- returnM acc
+ Nothing -> addErr (modExportErr mod) `thenM_`
+ returnM acc
+
Just avail_env
-> let
- mod_avails = availEnvElts avail_env
+ mod_avails = [ filtered_avail
+ | avail <- availEnvElts avail_env,
+ let mb_avail = filter_unqual rdr_env avail,
+ isJust mb_avail,
+ let Just filtered_avail = mb_avail]
+
avails' = foldl addAvail avails mod_avails
in
- foldlM (check_occs warn_dup_exports ie)
- occs mod_avails `thenM` \ occs' ->
+ -- 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.
+ foldlM (check_occs ie) occs mod_avails `thenM` \ occs' ->
returnM (mod:mods, occs', avails')
exports_from_item acc@(mods, occs, avails) ie
= lookupGRE (ieName ie) `thenM` \ mb_gre ->
case mb_gre of {
- Nothing -> addErr (unknownNameErr (ieName ie)) `thenM_`
- returnM acc ;
- Just gre ->
+ Nothing -> addErr (unknownNameErr (ieName ie)) `thenM_`
+ returnM acc ;
+ Just gre ->
-- Get the AvailInfo for the parent of the specified name
- case lookupAvailEnv entity_avail_env (gre_parent gre) of {
- Nothing -> pprPanic "exportsFromAvail"
- ((ppr (ieName ie)) <+> ppr gre) ;
- Just avail ->
-
+ let
+ parent = gre_parent gre `orElse` gre_name gre
+ avail = expectJust "exportsFromAvail2"
+ (lookupAvailEnv entity_avail_env parent)
+ in
-- Filter out the bits we want
case filterAvail ie avail of {
Nothing -> -- Not enough availability
-- Phew! It's OK! Now to check the occurrence stuff!
warnIf (not (ok_item ie avail)) (dodgyExportWarn ie) `thenM_`
- check_occs warn_dup_exports ie occs export_avail `thenM` \ occs' ->
+ check_occs ie occs export_avail `thenM` \ occs' ->
returnM (mods, occs', addAvail avails export_avail)
- }}}
+ }}
+
+
+-------------------------------
+filter_unqual :: GlobalRdrEnv -> AvailInfo -> Maybe AvailInfo
+-- Filter the Avail by what's in scope unqualified
+filter_unqual env (Avail n)
+ | in_scope env n = Just (Avail n)
+ | otherwise = Nothing
+filter_unqual env (AvailTC n ns)
+ | not (null ns') = Just (AvailTC n ns')
+ | otherwise = Nothing
+ where
+ ns' = filter (in_scope env) ns
+in_scope :: GlobalRdrEnv -> Name -> Bool
+-- Checks whether the Name is in scope unqualified,
+-- regardless of whether it's ambiguous or not
+in_scope env n
+ = case lookupRdrEnv env (mkRdrUnqual (nameOccName n)) of
+ Nothing -> False
+ Just gres -> or [n == gre_name g | g <- gres]
+-------------------------------
ok_item (IEThingAll _) (AvailTC _ [n]) = False
-- This occurs when you import T(..), but
-- only export T abstractly. The single [n]
-- in the AvailTC is the type or class itself
ok_item _ _ = True
-check_occs :: Bool -> RdrNameIE -> ExportOccMap -> AvailInfo -> TcRn m ExportOccMap
-check_occs warn_dup_exports ie occs avail
+-------------------------------
+check_occs :: RdrNameIE -> ExportOccMap -> AvailInfo -> TcRn m ExportOccMap
+check_occs ie occs avail
= foldlM check occs (availNames avail)
where
check occs name
= case lookupFM occs name_occ of
- Nothing -> returnM (addToFM occs name_occ (name, ie))
+ Nothing -> returnM (addToFM occs name_occ (name, ie))
+
Just (name', ie')
- | name == name' -> -- Duplicate export
- warnIf warn_dup_exports
- (dupExportWarn name_occ ie ie')
- `thenM_` returnM occs
-
- | otherwise -> -- Same occ name but different names: an error
- addErr (exportClashErr name_occ ie ie') `thenM_`
- returnM occs
+ | name == name' -- Duplicate export
+ -> do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
+ warnIf warn_dup_exports (dupExportWarn name_occ ie ie') ;
+ returnM occs }
+
+ | otherwise -- Same occ name but different names: an error
+ -> do { global_env <- getGlobalRdrEnv ;
+ addErr (exportClashErr global_env name name' ie ie') ;
+ returnM occs }
where
name_occ = nameOccName name
+
+----------------------------
+main_RDR_Unqual :: RdrName
+main_RDR_Unqual = mkUnqual varName FSLIT("main")
+ -- Don't get a RdrName from PrelNames.mainName, because
+ -- nameRdrNamegets an Orig RdrName, and we want a Qual or Unqual one.
+ -- An Unqual one will do just fine
\end{code}
%*********************************************************
-- if C was brought into scope by T(..) or T(C)
really_used_names :: NameSet
really_used_names = used_names `unionNameSets`
- mkNameSet [ gre_parent gre
- | gre <- defined_names,
- gre_name gre `elemNameSet` used_names]
+ mkNameSet [ parent
+ | GRE{ gre_name = name,
+ gre_parent = Just parent }
+ <- defined_names,
+ name `elemNameSet` used_names]
-- Collect the defined names from the in-scope environment
-- Look for the qualified ones only, else get duplicates
= acc
-- n is the name of the thing, p is the name of its parent
- mk_avail n p | n/=p = AvailTC p [p,n]
- | isTcOcc (nameOccName p) = AvailTC n [n]
- | otherwise = Avail n
+ mk_avail n (Just p) = AvailTC p [p,n]
+ mk_avail n Nothing | isTcOcc (nameOccName n) = AvailTC n [n]
+ | otherwise = Avail n
add_inst_mod m acc
| m `elemFM` acc = acc -- We import something already
-- [Note: not 'minimal_imports', because that includes direcly-imported
-- modules even if we use nothing from them; see notes above]
unused_imp_mods = [m | m <- direct_import_mods,
- not (maybeToBool (lookupFM minimal_imports1 m)),
+ isNothing (lookupFM minimal_imports1 m),
m /= pRELUDE_Name]
module_unused :: Module -> Bool
= sep [ ptext SLIT("The export item") <+> quotes (ppr export_item),
ptext SLIT("attempts to export constructors or class methods that are not visible here") ]
-exportClashErr occ_name ie1 ie2
- = hsep [ptext SLIT("The export items"), quotes (ppr ie1)
- ,ptext SLIT("and"), quotes (ppr ie2)
- ,ptext SLIT("create conflicting exports for"), quotes (ppr occ_name)]
+exportClashErr global_env name1 name2 ie1 ie2
+ = vcat [ ptext SLIT("Conflicting exports for") <+> quotes (ppr occ) <> colon
+ , ppr_export ie1 name1
+ , ppr_export ie2 name2 ]
+ where
+ occ = nameOccName name1
+ ppr_export ie name = nest 2 (quotes (ppr ie) <+> ptext SLIT("exports") <+>
+ quotes (ppr name) <+> pprNameProvenance (get_gre name))
+
+ -- get_gre finds a GRE for the Name, in a very inefficient way
+ -- There isn't a more efficient way to do it, because we don't necessarily
+ -- know the RdrName under which this Name is in scope. So we just
+ -- search linearly. Shouldn't matter because this only happens
+ -- in an error message.
+ get_gre name
+ = case [gre | gres <- rdrEnvElts global_env,
+ gre <- gres,
+ gre_name gre == name] of
+ (gre:_) -> gre
+ [] -> pprPanic "exportClashErr" (ppr name)
dupDeclErr (n:ns)
= vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr n),
projects / ghc-hetmet.git / blobdiff