loadExports, loadFixDecls, loadDeprecs,
)
import RnEnv ( availsToNameSet, mkIfaceGlobalRdrEnv,
- unitAvailEnv, availEnvElts,
+ unitAvailEnv, availEnvElts, availNames,
plusAvailEnv, groupAvails, warnUnusedImports,
warnUnusedLocalBinds, warnUnusedModules,
lookupSrcName, getImplicitStmtFVs,
= pushSrcLocRn loc $
-- FIND THE GLOBAL NAME ENVIRONMENT
- getGlobalNames this_module contents `thenRn` \ (gbl_env, local_gbl_env, all_avails@(_, global_avail_env)) ->
+ getGlobalNames this_module contents `thenRn` \ (gbl_env, local_gbl_env,
+ (mod_avail_env, global_avail_env)) ->
let
print_unqualified = unQualInScope gbl_env
+
+ full_avail_env :: NameEnv AvailInfo
+ -- The domain of global_avail_env is just the 'major' things;
+ -- variables, type constructors, classes.
+ -- E.g. Functor |-> Functor( Functor, fmap )
+ -- The domain of full_avail_env is everything in scope
+ -- E.g. Functor |-> Functor( Functor, fmap )
+ -- fmap |-> Functor( Functor, fmap )
+ --
+ -- This filled-out avail_env is needed to generate
+ -- exports (mkExportAvails), and for generating minimal
+ -- exports (reportUnusedNames)
+ full_avail_env = mkNameEnv [ (name,avail)
+ | avail <- availEnvElts global_avail_env,
+ name <- availNames avail]
in
-- Exit if we've found any errors
checkErrsRn `thenRn` \ no_errs_so_far ->
else
-- PROCESS EXPORT LIST
- exportsFromAvail mod_name exports all_avails gbl_env `thenRn` \ export_avails ->
+ exportsFromAvail mod_name exports mod_avail_env
+ full_avail_env gbl_env `thenRn` \ export_avails ->
traceRn (text "Local top-level environment" $$
nest 4 (pprGlobalRdrEnv local_gbl_env)) `thenRn_`
-- REPORT UNUSED NAMES, AND DEBUG DUMP
reportUnusedNames mod_iface print_unqualified
- imports global_avail_env
+ imports full_avail_env
source_fvs2 rn_imp_decls `thenRn_`
-- NB: source_fvs2: include exports (else we get bogus
-- warnings of unused things) but not implicit FVs.
to_ie (AvailTC n [m]) = ASSERT( n==m )
returnRn (IEThingAbs n)
to_ie (AvailTC n ns)
- = loadInterface (text "Compute minimal imports from" <+> ppr n_mod) n_mod ImportBySystem `thenRn` \ iface ->
+ = loadInterface (text "Compute minimal imports from" <+> ppr n_mod)
+ n_mod ImportBySystem `thenRn` \ iface ->
case [xs | (m,as) <- mi_exports iface,
m == n_mod,
AvailTC x xs <- as,
import BasicTypes ( mapIPName )
import List ( nub )
import UniqFM ( lookupWithDefaultUFM )
+import Maybe ( mapMaybe )
import CmdLineOpts
import FastString ( FastString )
\end{code}
| otherwise
= getGlobalAvails `thenRn` \ avail_env ->
case lookupNameEnv avail_env cls_name of
- -- class not in scope; don't fail as later checks will catch this,
- -- but just return (bogus) name. Icky.
+ -- The class itself isn't in scope, so cls_name is unboundName
+ -- e.g. import Prelude hiding( Ord )
+ -- instance Ord T where ...
+ -- The program is wrong, but that should not cause a crash.
Nothing -> returnRn (mkUnboundName rdr_name)
Just (AvailTC _ ns) -> case [n | n <- ns, nameOccName n == occ] of
(n:ns)-> ASSERT( null ns ) returnRn n
-> Bool -- True <=> want unqualified import
-> (Name -> Provenance)
-> Avails -- Whats imported
- -> Avails -- What's to be hidden
- -- I.e. import (imports - hides)
-> Deprecations
-> GlobalRdrEnv
-mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails hides deprecs
- = gbl_env3
+mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails deprecs
+ = gbl_env2
where
-- Make the name environment. We're talking about a
-- single module here, so there must be no name clashes.
-- (Qualified names are always imported)
gbl_env1 = foldl add_avail emptyRdrEnv avails
- -- Delete (qualified names of) things that are hidden
- gbl_env2 = foldl del_avail gbl_env1 hides
-
-- Add unqualified names
- gbl_env3 | unqual_imp = foldl add_unqual gbl_env2 (rdrEnvToList gbl_env2)
- | otherwise = gbl_env2
+ gbl_env2 | unqual_imp = foldl add_unqual gbl_env1 (rdrEnvToList gbl_env1)
+ | otherwise = gbl_env1
add_unqual env (qual_name, elts)
= foldl add_one env elts
-- the module (multiple bindings for the same name) we may get
-- duplicates. So the simple thing is to do the fold.
- del_avail env avail
- = foldl delOneFromGlobalRdrEnv env rdr_names
- where
- rdr_names = map (mkRdrQual this_mod . nameOccName)
- (availNames avail)
-
-
add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
add_avail env avail = foldl add_name env (availNames avail)
= foldl add emptyRdrEnv m_avails
where
add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True
- (\n -> LocalDef) avails [] NoDeprecs)
+ (\n -> LocalDef) avails NoDeprecs)
-- The NoDeprecs is a bit of a hack I suppose
\end{code}
\begin{code}
unQualInScope :: GlobalRdrEnv -> Name -> Bool
--- True if 'f' is in scope, and has only one binding
+-- True if 'f' is in scope, and has only one binding,
+-- and the thing it is bound to is the name we are looking for
-- (i.e. false if A.f and B.f are both in scope as unqualified 'f')
+--
+-- This fn is only efficient if the shared
+-- partial application is used a lot.
unQualInScope env
= (`elemNameSet` unqual_names)
where
n1 `lt` n2 = nameOccName n1 < nameOccName n2
\end{code}
+\begin{code}
+pruneAvails :: (Name -> Bool) -- Keep if this is True
+ -> [AvailInfo]
+ -> [AvailInfo]
+pruneAvails keep avails
+ = mapMaybe del avails
+ where
+ del :: AvailInfo -> Maybe AvailInfo -- Nothing => nothing left!
+ del (Avail n) | keep n = Just (Avail n)
+ | otherwise = Nothing
+ del (AvailTC n ns) | null ns' = Nothing
+ | otherwise = Just (AvailTC n ns')
+ where
+ ns' = filter keep ns
+\end{code}
%************************************************************************
%* *
\begin{code}
module RnNames (
- getGlobalNames, exportsFromAvail
+ ExportAvails, getGlobalNames, exportsFromAvail
) where
#include "HsVersions.h"
) `thenRn_`
-- Filter the imports according to the import list
- filterImports imp_mod_name from import_spec avails `thenRn` \ (filtered_avails, hides, explicits) ->
+ filterImports imp_mod_name from import_spec avails `thenRn` \ (filtered_avails, explicits) ->
let
unqual_imp = not qual_only -- Maybe want unqualified names
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 hides deprecs
- exports = mkExportAvails qual_mod unqual_imp gbl_env hides filtered_avails
+ gbl_env = mkGlobalRdrEnv qual_mod unqual_imp mk_prov filtered_avails deprecs
+ exports = mkExportAvails qual_mod unqual_imp gbl_env filtered_avails
in
returnRn (gbl_env, exports)
\end{code}
mod_name = moduleName this_mod
unqual_imp = True -- Want unqualified names
mk_prov n = LocalDef -- Provenance is local
- hides = [] -- Hide nothing
- gbl_env = mkGlobalRdrEnv mod_name unqual_imp mk_prov avails hides NoDeprecs
+ 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
-- Also we may use a deprecated thing in the defn of another
-- the defn of a non-deprecated thing, when changing a module's
-- interface
- exports = mkExportAvails mod_name unqual_imp gbl_env hides avails
+ exports = mkExportAvails mod_name unqual_imp gbl_env avails
in
returnRn (gbl_env, exports)
-> WhereFrom -- Tells whether it's a {-# SOURCE #-} import
-> Maybe (Bool, [RdrNameIE]) -- Import spec; True => hiding
-> [AvailInfo] -- What's available
- -> RnMG ([AvailInfo], -- "chosens"
- [AvailInfo], -- "hides"
- -- The true imports are "chosens" - "hides"
- -- (It's convenient to return both the above sets, because
- -- the substraction can be done more efficiently when
- -- building the environment.)
+ -> RnMG ([AvailInfo], -- What's imported
NameSet) -- What was imported explicitly
-- Complains if import spec mentions things that the module doesn't export
-- Warns/informs if import spec contains duplicates.
filterImports mod from Nothing imports
- = returnRn (imports, [], emptyNameSet)
+ = returnRn (imports, emptyNameSet)
filterImports mod from (Just (want_hiding, import_items)) total_avails
= flatMapRn get_item import_items `thenRn` \ avails_w_explicits ->
(item_avails, explicits_s) = unzip avails_w_explicits
explicits = foldl addListToNameSet emptyNameSet explicits_s
in
- if want_hiding
- then
- -- All imported; item_avails to be hidden
- returnRn (total_avails, item_avails, emptyNameSet)
+ if want_hiding then
+ let -- All imported; item_avails to be hidden
+ hidden = availsToNameSet item_avails
+ keep n = not (n `elemNameSet` hidden)
+ in
+ returnRn (pruneAvails keep total_avails, emptyNameSet)
else
-- Just item_avails imported; nothing to be hidden
- returnRn (item_avails, [], explicits)
+ returnRn (item_avails, explicits)
where
import_fm :: FiniteMap OccName AvailInfo
import_fm = listToFM [ (nameOccName name, avail)
%************************************************************************
\begin{code}
+type ExportAvails
+ = (FiniteMap ModuleName Avails,
+ -- Used to figure out "module M" export specifiers
+ -- Includes avails only from *unqualified* imports
+ -- (see 1.4 Report Section 5.1.1)
+
+ AvailEnv) -- All the things that are available.
+ -- Its domain is all the "main" things;
+ -- i.e. *excluding* class ops and constructors
+ -- (which appear inside their parent AvailTC)
+
mkEmptyExportAvails :: ModuleName -> ExportAvails
mkEmptyExportAvails mod_name = (unitFM mod_name [], emptyNameEnv)
-mkExportAvails :: ModuleName -> Bool -> GlobalRdrEnv -> [AvailInfo] -> [AvailInfo] -> ExportAvails
-mkExportAvails mod_name unqual_imp gbl_env hides avails
+plusExportAvails :: ExportAvails -> ExportAvails -> ExportAvails
+plusExportAvails (m1, e1) (m2, e2) = (plusFM_C (++) m1 m2, plusAvailEnv e1 e2)
+
+mkExportAvails :: ModuleName -> Bool -> GlobalRdrEnv -> [AvailInfo] -> ExportAvails
+mkExportAvails mod_name unqual_imp gbl_env avails
= (mod_avail_env, entity_avail_env)
where
mod_avail_env = unitFM mod_name unqual_avails
- -- unqual_avails is the Avails that are visible in *unqualfied* form
- -- (1.4 Report, Section 5.1.1)
- -- For example, in
- -- import T hiding( f )
- -- we delete f from avails
+ -- 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.
unqual_avails | not unqual_imp = [] -- Short cut when no unqualified imports
- | otherwise = mapMaybe prune avails
-
- prune (Avail n) | unqual_in_scope n = Just (Avail n)
- | otherwise = Nothing
- prune (AvailTC n ns) | null uqs = Nothing
- | otherwise = Just (AvailTC n uqs)
- where
- uqs = filter unqual_in_scope ns
-
- unqual_in_scope n = unQualInScope gbl_env n
-
+ | otherwise = pruneAvails (unQualInScope gbl_env) avails
- entity_avail_env = mkNameEnv ([ (availName avail,avail) | avail <- effective_avails ] ++
- -- sigh - need to have the method/field names in
- -- the environment also, so that export lists
- -- can be computed precisely (cf. exportsFromAvail)
- [ (name,avail) | avail <- effective_avails,
- name <- avNames avail ] )
-
- avNames (Avail n) = [n]
- avNames (AvailTC n ns) = filter (/=n) ns
-
- -- remove 'hides' names from the avail list.
- effective_avails = foldl wipeOut avails hides
- where
- wipeOut as (Avail n) = mapMaybe (delName n) as
- wipeOut as (AvailTC n ns) = foldl wipeOut as (map Avail ns)
-
- delName x a@(Avail n)
- | n == x = Nothing
- | otherwise = Just a
- delName x (AvailTC n ns)
- = case (filter (/=x) ns) of
- [] -> Nothing
- xs -> Just (AvailTC n xs)
-
-plusExportAvails :: ExportAvails -> ExportAvails -> ExportAvails
-plusExportAvails (m1, e1) (m2, e2)
- = (plusFM_C (++) m1 m2, plusAvailEnv e1 e2)
- -- ToDo: wasteful: we do this once for each constructor!
+ entity_avail_env = mkNameEnv [(availName avail, avail) | avail <- avails]
\end{code}
exportsFromAvail :: ModuleName
- -> Maybe [RdrNameIE] -- Export spec
- -> ExportAvails
+ -> Maybe [RdrNameIE] -- Export spec
+ -> FiniteMap ModuleName Avails -- Used for (module M) exports
+ -> NameEnv AvailInfo -- Domain is every in-scope thing
-> GlobalRdrEnv
-> RnMG Avails
-- Complains if two distinct exports have same OccName
-- Warns about identical exports.
-- Complains about exports items not in scope
-exportsFromAvail this_mod Nothing export_avails global_name_env
- = exportsFromAvail this_mod true_exports export_avails global_name_env
+exportsFromAvail this_mod Nothing
+ mod_avail_env entity_avail_env global_name_env
+ = exportsFromAvail this_mod true_exports mod_avail_env entity_avail_env global_name_env
where
true_exports = Just $ if this_mod == mAIN_Name
then [IEVar main_RDR_Unqual]
-- but for all other modules export everything.
exportsFromAvail this_mod (Just export_items)
- (mod_avail_env, entity_avail_env)
- global_name_env
+ mod_avail_env entity_avail_env global_name_env
= doptRn Opt_WarnDuplicateExports `thenRn` \ warn_dup_exports ->
foldlRn (exports_from_item warn_dup_exports)
([], emptyFM, emptyAvailEnv) export_items
projects / ghc-hetmet.git / commitdiff