\begin{code}
module RnNames (
rnImports, importsFromLocalDecls, exportsFromAvail,
- reportUnusedNames
+ reportUnusedNames, mkModDeps
) where
#include "HsVersions.h"
import CmdLineOpts ( DynFlag(..) )
-import HsSyn ( HsDecl(..), IE(..), ieName, ImportDecl(..),
+import HsSyn ( IE(..), ieName, ImportDecl(..),
ForeignDecl(..), HsGroup(..),
collectLocatedHsBinders, tyClDeclNames
)
-import RdrHsSyn ( RdrNameIE, RdrNameImportDecl, RdrNameHsDecl )
+import RdrHsSyn ( RdrNameIE, RdrNameImportDecl )
import RnEnv
import TcRnMonad
import FiniteMap
import PrelNames ( pRELUDE_Name, mAIN_Name, isBuiltInSyntaxName )
-import Module ( Module, ModuleName, moduleName,
- moduleNameUserString,
- unitModuleEnvByName, lookupModuleEnvByName,
- moduleEnvElts )
+import Module ( Module, ModuleName, ModuleEnv, moduleName,
+ moduleNameUserString, isHomeModule,
+ emptyModuleEnv, unitModuleEnvByName, unitModuleEnv,
+ lookupModuleEnvByName, extendModuleEnvByName, moduleEnvElts )
import Name ( Name, nameSrcLoc, nameOccName, nameModule, isExternalName )
import NameSet
import NameEnv
import OccName ( OccName, dataName, isTcOcc )
import HscTypes ( Provenance(..), ImportReason(..), GlobalRdrEnv,
- GenAvailInfo(..), AvailInfo, Avails, IsBootInterface,
+ GenAvailInfo(..), AvailInfo, Avails,
+ IsBootInterface,
availName, availNames, availsToNameSet,
- Deprecations(..), ModIface(..),
+ Deprecations(..), ModIface(..), Dependencies(..),
GlobalRdrElt(..), unQualInScope, isLocalGRE
)
-import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace,
- emptyRdrEnv, foldRdrEnv, isQual )
+import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace, lookupRdrEnv,
+ emptyRdrEnv, foldRdrEnv, mkRdrUnqual, isQual )
import Outputable
-import Maybes ( maybeToBool, catMaybes )
+import Maybe ( isJust, isNothing, catMaybes )
import ListSetOps ( removeDups )
import Util ( sortLt, notNull )
-import List ( partition )
+import List ( partition, insert )
import IO ( openFile, IOMode(..) )
\end{code}
(source, ordinary) = partition is_source_import all_imports
is_source_import (ImportDecl _ is_boot _ _ _ _) = is_boot
- get_imports = importsFromImportDecl (moduleName this_mod)
+ get_imports = importsFromImportDecl this_mod
in
mappM get_imports ordinary `thenM` \ stuff1 ->
mappM get_imports source `thenM` \ stuff2 ->
\end{code}
\begin{code}
-importsFromImportDecl :: ModuleName
+importsFromImportDecl :: Module
-> RdrNameImportDecl
-> TcRn m (GlobalRdrEnv, ImportAvails)
-importsFromImportDecl this_mod_name
- (ImportDecl imp_mod_name is_boot qual_only as_mod import_spec iloc)
+importsFromImportDecl this_mod
+ (ImportDecl imp_mod_name is_boot qual_only as_mod imp_spec iloc)
= addSrcLoc iloc $
let
- doc = ppr imp_mod_name <+> ptext SLIT("is directly imported")
+ doc = ppr imp_mod_name <+> ptext SLIT("is directly imported")
in
-- If there's an error in loadInterface, (e.g. interface
Right iface ->
let
- imp_mod = mi_module iface
+ imp_mod = mi_module iface
avails_by_module = mi_exports iface
- deprecs = mi_deprecs iface
- dir_imp = unitModuleEnvByName imp_mod_name (imp_mod, import_all import_spec)
+ deprecs = mi_deprecs iface
+ is_orph = mi_orphan iface
+ deps = mi_deps iface
avails :: Avails
avails = [ avail | (mod_name, avails) <- avails_by_module,
mod_name /= this_mod_name,
avail <- avails ]
+ this_mod_name = moduleName this_mod
-- If the module exports anything defined in this module, just ignore it.
-- Reason: otherwise it looks as if there are two local definition sites
-- for the thing, and an error gets reported. Easiest thing is just to
-- then you'll get a 'B does not export AType' message. Oh well.
in
+ -- Filter the imports according to the import list
+ filterImports imp_mod is_boot imp_spec avails `thenM` \ (filtered_avails, explicits) ->
+
+ let
+ -- Compute new transitive dependencies
+ orphans | is_orph = insert imp_mod_name (dep_orphs deps)
+ | otherwise = dep_orphs deps
+
+ (dependent_mods, dependent_pkgs)
+ | isHomeModule imp_mod
+ = -- Imported module is from the home package
+ -- Take its dependent modules and
+ -- (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_boot) : filter not_self (dep_mods deps), dep_pkgs deps)
+
+ | otherwise
+ = -- Imported module is from another package
+ -- Dump the dependent modules
+ -- Add the package imp_mod comes from to the dependent packages
+ -- from imp_mod
+ ([], insert (mi_package iface) (dep_pkgs deps))
+
+ not_self (m, _) = m /= this_mod_name
+
+ import_all = case imp_spec of
+ (Just (False, _)) -> False -- Imports are spec'd explicitly
+ other -> True -- Everything is imported,
+ -- (or almost everything [hiding])
+
+ 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
+
+ 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_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
ifOptM Opt_WarnDeprecations (
case deprecs of
other -> returnM ()
) `thenM_`
- -- Filter the imports according to the import list
- filterImports imp_mod_name is_boot import_spec avails `thenM` \ (filtered_avails, explicits) ->
-
- let
- unqual_imp = not qual_only -- Maybe want unqualified names
- qual_mod = case as_mod of
- Nothing -> imp_mod_name
- Just another_name -> another_name
-
- mk_prov name = NonLocalDef (UserImport imp_mod iloc (name `elemNameSet` explicits))
- gbl_env = mkGlobalRdrEnv qual_mod unqual_imp mk_prov filtered_avails deprecs
- imports = mkImportAvails qual_mod unqual_imp gbl_env filtered_avails
- in
- returnM (gbl_env, imports { imp_mods = dir_imp})
+ returnM (gbl_env, imports)
}
-import_all (Just (False, _)) = False -- Imports are spec'd explicitly
-import_all other = True -- Everything is imported
+mkModDeps :: [(ModuleName, IsBootInterface)]
+ -> ModuleEnv (ModuleName, IsBootInterface)
+mkModDeps deps = foldl add emptyModuleEnv deps
+ where
+ add env elt@(m,_) = extendModuleEnvByName env m elt
\end{code}
doptM Opt_NoImplicitPrelude `thenM` \ implicit_prelude ->
let
mod_name = moduleName this_mod
- unqual_imp = True -- Want unqualified names
mk_prov n = LocalDef -- Provenance is local
+ unqual_imp = True -- Want unqualified names in scope
gbl_env = mkGlobalRdrEnv mod_name unqual_imp mk_prov avails NoDeprecs
-- NoDeprecs: don't complain about locally defined names
-- For a start, we may be exporting a deprecated thing
-- Optimisation: filter out names for built-in syntax
-- They just clutter up the environment (esp tuples), and the parser
-- will generate Exact RdrNames for them, so the cluttered
- -- envt is no use. To avoid doing this filter all the type,
+ -- envt is no use. To avoid doing this filter all the time,
-- we use -fno-implicit-prelude as a clue that the filter is
- -- worth while. Really, it's only useful for Base and Tuple.
+ -- worth while. Really, it's only useful for GHC.Base and GHC.Tuple.
--
-- It's worth doing because it makes the environment smaller for
-- every module that imports the Prelude
-- but that stops them being Exact, so they get looked up. Sigh.
-- It doesn't matter because it only affects the Data.Tuple really.
-- The important thing is to trim down the exports.
- imports = mkImportAvails mod_name unqual_imp gbl_env avails'
+
avails' | implicit_prelude = filter not_built_in_syntax avails
| otherwise = avails
not_built_in_syntax a = not (all isBuiltInSyntaxName (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.
+
+ avail_env = mkAvailEnv avails'
+ imports = emptyImportAvails {
+ imp_qual = unitModuleEnv this_mod avail_env,
+ imp_env = avail_env
+ }
in
returnM (gbl_env, imports)
\end{code}
available, and filters it through the import spec (if any).
\begin{code}
-filterImports :: ModuleName -- The module being imported
+filterImports :: Module -- The module being imported
-> IsBootInterface -- Tells whether it's a {-# SOURCE #-} import
-> Maybe (Bool, [RdrNameIE]) -- Import spec; True => hiding
-> [AvailInfo] -- What's available
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
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 })
+ (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)
= case lookupModuleEnvByName mod_avail_env mod of
Nothing -> addErr (modExportErr mod) `thenM_`
returnM acc
- Just mod_avails
- -> foldlM (check_occs warn_dup_exports ie)
- occs mod_avails `thenM` \ occs' ->
- let
+ Just avail_env
+ -> getGlobalRdrEnv `thenM` \ global_env ->
+ let
+ mod_avails = [ filtered_avail
+ | avail <- availEnvElts avail_env,
+ let mb_avail = filter_unqual global_env avail,
+ isJust mb_avail,
+ let Just filtered_avail = mb_avail]
+
avails' = foldl addAvail avails mod_avails
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.
+ foldlM (check_occs warn_dup_exports ie)
+ occs mod_avails `thenM` \ occs' ->
+
returnM (mod:mods, occs', avails')
exports_from_item acc@(mods, occs, avails) ie
}}}
+-------------------------------
+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 = isJust (lookupRdrEnv env (mkRdrUnqual (nameOccName n)))
+
+-------------------------------
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
= foldlM check occs (availNames avail)
`thenM_` returnM occs
| otherwise -> -- Same occ name but different names: an error
- addErr (exportClashErr name_occ ie ie') `thenM_`
+ addErr (exportClashErr name name' ie ie') `thenM_`
returnM occs
where
name_occ = nameOccName name
-- [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 name1 name2 ie1 ie2
+ | different_items
+ = sep [ ptext SLIT("The export items") <+> quotes (ppr ie1)
+ <+> ptext SLIT("and") <+> quotes (ppr ie2)
+ , ptext SLIT("create") <+> name_msg <+> ptext SLIT("respectively") ]
+ | otherwise
+ = sep [ ptext SLIT("The export item") <+> quotes (ppr ie1)
+ , ptext SLIT("creates") <+> name_msg ]
+ where
+ name_msg = ptext SLIT("conflicting exports for") <+> quotes (ppr name1)
+ <+> ptext SLIT("and") <+> quotes (ppr name2)
+ different_items -- This only comes into play when we have a single
+ -- 'module M' export item which gives rise to conflicts
+ = case (ie1,ie2) of
+ (IEModuleContents m1, IEModuleContents m2) -> m1 /= m2
+ other -> True
dupDeclErr (n:ns)
= vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr n),
projects / ghc-hetmet.git / blobdiff