X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnNames.lhs;h=4e745f192a523f80739c7f1a7da433c88a62d9f5;hb=9c26739695219d8343505a88457cb55c76b65449;hp=37870ef0efd9d900b46739eac90bba74d594154e;hpb=fd88875df8059df92bd9361e0e61128dddb9c4d0;p=ghc-hetmet.git diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index 37870ef..4e745f1 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/ghc/compiler/rename/RnNames.lhs @@ -72,13 +72,13 @@ getGlobalNames m@(HsModule this_mod _ exports imports _ _ mod_loc) 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) @@ -86,7 +86,7 @@ getGlobalNames m@(HsModule this_mod _ exports imports _ _ mod_loc) 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 @@ -110,12 +110,13 @@ getGlobalNames m@(HsModule this_mod _ exports imports _ _ mod_loc) | 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} @@ -144,11 +145,11 @@ checkEarlyExit mod \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 @@ -266,7 +267,7 @@ filterImports mod (Just (want_hiding, import_items)) 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} @@ -276,37 +277,36 @@ qualifyImports :: Module -- Imported module -> 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 @@ -394,15 +394,17 @@ includes ConcBase.StateAndSynchVar#, and so on... \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 @@ -413,18 +415,9 @@ exportsFromAvail this_mod (Just export_items) all_avails (RnEnv name_env fixity_ 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 @@ -448,7 +441,7 @@ exportsFromAvail this_mod (Just export_items) all_avails (RnEnv name_env fixity_ 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} @@ -524,11 +517,11 @@ exportItemErr export_item NotAvailable sty 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}