else
-- COMBINE RESULTS
- -- We put the local env first, so that a local provenance
+ -- We put the local env second, so that a local provenance
-- "wins", even if a module imports itself.
foldlRn plusRnEnv emptyRnEnv imp_rn_envs `thenRn` \ imp_rn_env ->
- plusRnEnv local_rn_env imp_rn_env `thenRn` \ rn_env ->
+ plusRnEnv imp_rn_env local_rn_env `thenRn` \ rn_env ->
let
- all_avails :: ModuleAvails
- all_avails = foldr plusModuleAvails local_mod_avails imp_avails_s
+ export_avails :: ExportAvails
+ export_avails = foldr plusExportAvails local_mod_avails imp_avails_s
explicit_names :: NameSet -- locally defined or explicitly imported
explicit_names = foldr add_on emptyNameSet (local_avails : explicit_imports_s)
in
-- PROCESS EXPORT LISTS
- exportsFromAvail this_mod exports all_avails rn_env
+ exportsFromAvail this_mod exports export_avails rn_env
`thenRn` \ (export_fn, export_env) ->
-- RECORD THAT LOCALLY DEFINED THINGS ARE AVAILABLE
| otherwise = [ImportDecl pRELUDE
False {- Not qualified -}
+ False {- Not source imported -}
Nothing {- No "as" -}
Nothing {- No import list -}
mod_loc]
explicit_prelude_import
- = not (null [ () | (ImportDecl mod qual _ _ _) <- imports, mod == pRELUDE ])
+ = not (null [ () | (ImportDecl mod qual _ _ _ _) <- imports, mod == pRELUDE ])
\end{code}
\begin{code}
\begin{code}
importsFromImportDecl :: RdrNameImportDecl
- -> RnMG (RnEnv, ModuleAvails, [AvailInfo])
+ -> RnMG (RnEnv, ExportAvails, [AvailInfo])
-importsFromImportDecl (ImportDecl mod qual_only as_mod import_spec loc)
+importsFromImportDecl (ImportDecl mod qual_only as_source as_mod import_spec loc)
= pushSrcLocRn loc $
- getInterfaceExports mod `thenRn` \ (avails, fixities) ->
+ getInterfaceExports mod as_source `thenRn` \ (avails, fixities) ->
filterImports mod import_spec avails `thenRn` \ (filtered_avails, hides, explicits) ->
let
filtered_avails' = map set_avail_prov filtered_avails
@qualifyImports@ takes the @ExportEnv@ after filtering through the import spec
of an import decl, and deals with producing an @RnEnv@ with the
-right qaulified names. It also turns the @Names@ in the @ExportEnv@ into
+right qualified names. It also turns the @Names@ in the @ExportEnv@ into
fully fledged @Names@.
\begin{code}
-> Maybe Module -- Optional "as M" part
-> ExportEnv -- What's imported
-> [AvailInfo] -- What's to be hidden
- -> RnMG (RnEnv, ModuleAvails)
+ -> RnMG (RnEnv, ExportAvails)
qualifyImports this_mod qual_imp unqual_imp as_mod (ExportEnv avails fixities) hides
- = let
- -- Make the name environment. Since we're talking about a single import module
- -- there can't be name clashes, so we don't need to be in the monad
- name_env1 = foldl add_avail emptyNameEnv avails
-
+ =
+ -- Make the name environment. Even though we're talking about a
+ -- single import module there might still be name clashes,
+ -- because it might be the module being compiled.
+ foldlRn add_avail emptyNameEnv avails `thenRn` \ name_env1 ->
+ let
-- Delete things that are hidden
name_env2 = foldl del_avail name_env1 hides
-- Create the fixity env
fixity_env = foldl (add_fixity name_env2) emptyFixityEnv fixities
- -- The "module M" syntax only applies to *unqualified* imports (1.4 Report, Section 5.1.1)
- mod_avail_env | unqual_imp = unitFM qual_mod avails
- | otherwise = emptyFM
+ -- Create the export-availability info
+ export_avails = mkExportAvails unqual_imp qual_mod avails
in
- returnRn (RnEnv name_env2 fixity_env, mod_avail_env)
+ returnRn (RnEnv name_env2 fixity_env, export_avails)
where
qual_mod = case as_mod of
Nothing -> this_mod
Just another_name -> another_name
- add_avail env avail = foldl add_name env (availNames avail)
- add_name env name = env2
+ add_avail env avail = foldlRn add_name env (availNames avail)
+ add_name env name = add qual_imp env (Qual qual_mod occ) `thenRn` \ env1 ->
+ add unqual_imp env1 (Unqual occ)
where
- env1 | qual_imp = addOneToNameEnv env (Qual qual_mod occ) name
- | otherwise = env
- env2 | unqual_imp = addOneToNameEnv env1 (Unqual occ) name
- | otherwise = env1
+ add False env rdr_name = returnRn env
+ add True env rdr_name = addOneToNameEnv env rdr_name name
occ = nameOccName name
del_avail env avail = foldl delOneFromNameEnv env rdr_names
\begin{code}
exportsFromAvail :: Module
-> Maybe [RdrNameIE] -- Export spec
- -> ModuleAvails
+ -> ExportAvails
-> RnEnv
-> RnMG (Name -> ExportFlag, ExportEnv)
-- Complains if two distinct exports have same OccName
-- Complains about exports items not in scope
-exportsFromAvail this_mod Nothing all_avails rn_env
- = exportsFromAvail this_mod (Just [IEModuleContents this_mod]) all_avails rn_env
+exportsFromAvail this_mod Nothing export_avails rn_env
+ = exportsFromAvail this_mod (Just [IEModuleContents this_mod]) export_avails rn_env
-exportsFromAvail this_mod (Just export_items) all_avails (RnEnv name_env fixity_env)
+exportsFromAvail this_mod (Just export_items)
+ (mod_avail_env, entity_avail_env)
+ (RnEnv name_env fixity_env)
= mapRn exports_from_item export_items `thenRn` \ avail_envs ->
foldlRn plusAvailEnv emptyAvailEnv avail_envs `thenRn` \ export_avail_env ->
let
returnRn (export_fn, ExportEnv export_avails export_fixities)
where
- full_avail_env :: UniqFM AvailInfo
- full_avail_env = addListToUFM_C plusAvail emptyUFM
- [(name, avail) | avail <- concat (eltsFM all_avails),
- name <- availEntityNames avail
- ]
-
- -- NB: full_avail_env will contain bindings for class ops but not constructors
- -- (see defn of availEntityNames)
-
exports_from_item :: RdrNameIE -> RnMG AvailEnv
exports_from_item ie@(IEModuleContents mod)
- = case lookupFM all_avails mod of
+ = case lookupFM mod_avail_env mod of
Nothing -> failWithRn emptyAvailEnv (modExportErr mod)
Just avails -> listToAvailEnv ie avails
where
maybe_in_scope = lookupNameEnv name_env (ieName ie)
Just name = maybe_in_scope
- maybe_avail = lookupUFM full_avail_env name
+ maybe_avail = lookupUFM entity_avail_env name
Just avail = maybe_avail
export_avail = filterAvail ie avail
enough_avail = case export_avail of {NotAvailable -> False; other -> True}
exportItemErr export_item avail sty
= hang (ptext SLIT("Export item not fully in scope:"))
- 4 (vcat [hsep [ptext SLIT("Wanted: "), ppr sty export_item],
- hsep [ptext SLIT("Available: "), ppr sty (ieOcc export_item), pprAvail sty avail]])
+ 4 (vcat [hsep [ptext SLIT("Wanted: "), ppr sty export_item],
+ hsep [ptext SLIT("Available:"), ppr sty (ieOcc export_item), pprAvail sty avail]])
availClashErr (occ_name, ((ie1,avail1), (ie2,avail2))) sty
- = hang (hsep [ptext SLIT("Conflicting exports for local name: "), ppr sty occ_name])
- 4 (vcat [ppr sty ie1, ppr sty ie2])
+ = hsep [ptext SLIT("The export items"), ppr sty ie1, ptext SLIT("and"), ppr sty ie2,
+ ptext SLIT("create conflicting exports for"), ppr sty occ_name]
\end{code}
projects / ghc-hetmet.git / blobdiff