import PrelInfo ( main_RDR )
import UniqFM ( lookupUFM )
import Bag ( bagToList )
-import Maybes ( maybeToBool, catMaybes )
import Module ( ModuleName, mkThisModule, pprModuleName, WhereFrom(..) )
import NameSet
import Name ( Name, ExportFlag(..), ImportReason(..), Provenance(..),
import SrcLoc ( SrcLoc )
import NameSet ( elemNameSet, emptyNameSet )
import Outputable
+import Maybes ( maybeToBool, catMaybes, mapMaybe )
+import UniqFM ( emptyUFM, listToUFM, plusUFM_C )
import Unique ( getUnique )
import Util ( removeDups, equivClassesByUniq, sortLt )
import List ( partition )
-> RnMG (Maybe (ExportEnv,
GlobalRdrEnv,
FixityEnv, -- Fixities for local decls only
- NameEnv AvailInfo -- Maps a name to its parent AvailInfo
+ AvailEnv -- Maps a name to its parent AvailInfo
-- Just for in-scope things only
))
-- Nothing => no need to recompile
returnRn (emptyRdrEnv, mkEmptyExportAvails imp_mod_name)
else
- filterImports imp_mod_name import_spec avails
- `thenRn` \ (filtered_avails, hides, explicits) ->
+ filterImports imp_mod_name import_spec avails `thenRn` \ (filtered_avails, hides, explicits) ->
+ qualifyImports imp_mod_name
+ (not qual_only) -- Maybe want unqualified names
+ as_mod hides
+ (improveAvails imp_mod iloc explicits
+ is_unqual filtered_avails)
+
+
+improveAvails imp_mod iloc explicits is_unqual avails
-- We 'improve' the provenance by setting
-- (a) the import-reason field, so that the Name says how it came into scope
-- including whether it's explicitly imported
-- (b) the print-unqualified field
- -- But don't fiddle with wired-in things or we get in a twist
- let
- improve_prov name =
- setNameProvenance name (NonLocalDef (UserImport imp_mod iloc (is_explicit name))
- (is_unqual name))
- is_explicit name = name `elemNameSet` explicits
- in
- qualifyImports imp_mod_name
- (not qual_only) -- Maybe want unqualified names
- as_mod hides
- filtered_avails improve_prov
- `thenRn` \ (rdr_name_env, mod_avails) ->
+ = map improve_avail avails
+ where
+ improve_avail (Avail n) = Avail (improve n)
+ improve_avail (AvailTC n ns) = AvailTC (improve n) (map improve ns)
- returnRn (rdr_name_env, mod_avails)
+ improve name = setNameProvenance name
+ (NonLocalDef (UserImport imp_mod iloc (is_explicit name))
+ (is_unqual name))
+ is_explicit name = name `elemNameSet` explicits
\end{code}
Nothing -- no 'as M'
[] -- Hide nothing
avails
- (\n -> n)
where
mod = mkThisModule mod_name
Nothing -> bale_out item
Just avail -> returnRn [(avail, availNames avail)]
- ok_dotdot_item (AvailTC _ [n]) = False
- ok_dotdot_item other = True
-
check_item item
| not (maybeToBool maybe_in_import_avails) ||
not (maybeToBool maybe_filtered_avail)
-> Maybe ModuleName -- Optional "as M" part
-> [AvailInfo] -- What's to be hidden
-> Avails -- Whats imported and how
- -> (Name -> Name) -- Improves the provenance on imported things
-> RnMG (GlobalRdrEnv, ExportAvails)
- -- NB: the Names in ExportAvails don't have the improve-provenance
- -- function applied to them
- -- We could fix that, but I don't think it matters
-qualifyImports this_mod unqual_imp as_mod hides
- avails improve_prov
+qualifyImports this_mod unqual_imp as_mod hides avails
=
-- Make the name environment. We're talking about a
-- single module here, so there must be no name clashes.
| unqual_imp = env2
| otherwise = env1
where
- env1 = addOneToGlobalRdrEnv env (mkRdrQual qual_mod occ) better_name
- env2 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) better_name
- occ = nameOccName name
- better_name = improve_prov name
+ env1 = addOneToGlobalRdrEnv env (mkRdrQual qual_mod occ) name
+ env2 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) name
+ occ = nameOccName name
del_avail env avail = foldl delOneFromGlobalRdrEnv env rdr_names
where
rdr_names = map (mkRdrUnqual . nameOccName) (availNames avail)
+
+
+mkEmptyExportAvails :: ModuleName -> ExportAvails
+mkEmptyExportAvails mod_name = (unitFM mod_name [], emptyUFM)
+
+mkExportAvails :: ModuleName -> Bool -> GlobalRdrEnv -> [AvailInfo] -> ExportAvails
+mkExportAvails mod_name unqual_imp name_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 | not unqual_imp = [] -- Short cut when no unqualified imports
+ | otherwise = mapMaybe prune avails
+
+ prune (Avail n) | unqual_in_scope n = Just (Avail n)
+ prune (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 name_env n
+
+ entity_avail_env = listToUFM [ (name,avail) | avail <- avails,
+ name <- availNames avail]
+
+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!
\end{code}
-- the main worker function in exportsFromAvail
= ([ModuleName], -- 'module M's seen so far
ExportOccMap, -- Tracks exported occurrence names
- NameEnv AvailInfo) -- The accumulated exported stuff, kept in an env
+ AvailEnv) -- The accumulated exported stuff, kept in an env
-- so we can common-up related AvailInfos
type ExportOccMap = FiniteMap OccName (Name, RdrNameIE)
(mod_avail_env, entity_avail_env)
global_name_env
= foldlRn exports_from_item
- ([], emptyFM, emptyNameEnv) export_items `thenRn` \ (_, _, export_avail_map) ->
+ ([], emptyFM, emptyAvailEnv) export_items `thenRn` \ (_, _, export_avail_map) ->
let
export_avails :: [AvailInfo]
export_avails = nameEnvElts export_avail_map
Just mod_avails -> foldlRn (check_occs ie) occs mod_avails
`thenRn` \ occs' ->
let
- avails' = foldl add_avail avails mod_avails
+ avails' = foldl addAvail avails mod_avails
in
returnRn (mod:mods, occs', avails')
= warnCheckRn (ok_item ie avail) (dodgyExportWarn ie) `thenRn_`
check_occs ie occs export_avail `thenRn` \ occs' ->
- returnRn (mods, occs', add_avail avails export_avail)
+ returnRn (mods, occs', addAvail avails export_avail)
where
rdr_name = ieName ie
-- in the AvailTC is the type or class itself
ok_item _ _ = True
-add_avail avails avail = addToNameEnv_C plusAvail avails (availName avail) avail
-
check_occs :: RdrNameIE -> ExportOccMap -> AvailInfo -> RnMG ExportOccMap
check_occs ie occs avail
= foldlRn check occs (availNames avail)
projects / ghc-hetmet.git / blobdiff