X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRename.lhs;h=265a34f086339eb5220fe3c3b6dbc7682f1ea6a4;hb=17d765ce13bf28d9b79672a567d7faf28c822c76;hp=76575cdb6c4cf7ccd57297f16d11beecbfcdd86d;hpb=ee7e91f59a9533d22648e89343aa2613e0e0b7f1;p=ghc-hetmet.git diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs index 76575cd..265a34f 100644 --- a/ghc/compiler/rename/Rename.lhs +++ b/ghc/compiler/rename/Rename.lhs @@ -14,7 +14,7 @@ import RdrHsSyn ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation, RdrNameStmt ) import RnHsSyn ( RenamedHsDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl, - extractHsTyNames, RenamedStmt, + RenamedStmt, instDeclFVs, tyClDeclFVs, ruleDeclFVs ) @@ -27,26 +27,25 @@ import RnIfaces ( slurpImpDecls, mkImportInfo, recordLocalSlurps, closeDecls, RecompileRequired, outOfDate, recompileRequired ) -import RnHiFiles ( readIface, removeContext, loadInterface, +import RnHiFiles ( readIface, loadInterface, loadExports, loadFixDecls, loadDeprecs, ) -import MkIface ( pprUsage ) import RnEnv ( availsToNameSet, mkIfaceGlobalRdrEnv, emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, groupAvails, warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules, - lookupSrcName, addImplicitFVs, + lookupSrcName, getImplicitStmtFVs, getImplicitModuleFVs, rnSyntaxNames, newGlobalName, unQualInScope,, ubiquitousNames ) import Module ( Module, ModuleName, WhereFrom(..), moduleNameUserString, moduleName, moduleEnvElts ) -import Name ( Name, nameIsLocalOrFrom, nameModule ) -import Name ( mkNameEnv, nameEnvElts, extendNameEnv ) -import RdrName ( foldRdrEnv, isQual ) +import Name ( Name, nameModule ) +import NameEnv import NameSet -import PrelNames ( SyntaxMap, pRELUDE_Name ) +import RdrName ( foldRdrEnv, isQual ) +import PrelNames ( SyntaxMap, vanillaSyntaxMap, pRELUDE_Name ) import ErrUtils ( dumpIfSet, dumpIfSet_dyn, showPass, printErrorsAndWarnings, errorsFound ) import Bag ( bagToList ) @@ -61,7 +60,7 @@ import HscTypes ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable, VersionInfo(..), ImportVersion, IsExported, IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts, GlobalRdrEnv, GlobalRdrElt(..), pprGlobalRdrEnv, - AvailEnv, GenAvailInfo(..), AvailInfo, Avails, + AvailEnv, GenAvailInfo(..), AvailInfo, Provenance(..), ImportReason(..), initialVersionInfo, Deprecations(..), LocalRdrEnv @@ -134,15 +133,16 @@ renameStmt dflags hit hst pcs scope_module this_module local_env stmt doDump [] stmt [] `thenRn_` returnRn (print_unqual, Nothing) else - let filtered_fvs = fvs `delListFromNameSet` rdrEnvElts local_env in - -- Add implicit free vars, and close decls - addImplicitFVs rdr_env Nothing filtered_fvs - `thenRn` \ (slurp_fvs, syntax_map) -> - slurpImpDecls slurp_fvs `thenRn` \ decls -> + getImplicitStmtFVs `thenRn` \ implicit_fvs -> + let + filtered_fvs = fvs `delListFromNameSet` rdrEnvElts local_env + source_fvs = implicit_fvs `plusFV` filtered_fvs + in + slurpImpDecls source_fvs `thenRn` \ decls -> doDump binders stmt decls `thenRn_` - returnRn (print_unqual, Just (binders, (syntax_map, stmt, decls))) + returnRn (print_unqual, Just (binders, (vanillaSyntaxMap, stmt, decls))) where doc = text "context for compiling expression" @@ -238,15 +238,30 @@ rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec else -- SLURP IN ALL THE NEEDED DECLARATIONS - addImplicitFVs gbl_env (Just (mod_name, rn_local_decls)) - source_fvs `thenRn` \ (slurp_fvs, sugar_map) -> - traceRn (text "Source FVs:" <+> fsep (map ppr (nameSetToList slurp_fvs))) `thenRn_` - slurpImpDecls slurp_fvs `thenRn` \ rn_imp_decls -> + -- Find out what re-bindable names to use for desugaring + getImplicitModuleFVs mod_name rn_local_decls `thenRn` \ implicit_fvs -> + rnSyntaxNames gbl_env source_fvs `thenRn` \ (source_fvs1, sugar_map) -> + let + export_fvs = availsToNameSet export_avails + source_fvs2 = source_fvs1 `plusFV` export_fvs + -- The export_fvs make the exported names look just as if they + -- occurred in the source program. For the reasoning, see the + -- comments with RnIfaces.mkImportInfo + -- It also helps reportUnusedNames, which of course must not complain + -- that 'f' isn't mentioned if it is mentioned in the export list + + source_fvs3 = implicit_fvs `plusFV` source_fvs2 + -- It's important to do the "plus" this way round, so that + -- when compiling the prelude, locally-defined (), Bool, etc + -- override the implicit ones. + in + traceRn (text "Source FVs:" <+> fsep (map ppr (nameSetToList source_fvs3))) `thenRn_` + slurpImpDecls source_fvs3 `thenRn` \ rn_imp_decls -> rnDump rn_imp_decls rn_local_decls `thenRn_` -- GENERATE THE VERSION/USAGE INFO - mkImportInfo mod_name imports `thenRn` \ my_usages -> + mkImportInfo mod_name imports `thenRn` \ my_usages -> -- BUILD THE MODULE INTERFACE let @@ -260,13 +275,12 @@ rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec my_exports = groupAvails this_module export_avails final_decls = rn_local_decls ++ rn_imp_decls - is_orphan = any (isOrphanDecl this_module) rn_local_decls mod_iface = ModIface { mi_module = this_module, mi_version = initialVersionInfo, mi_usages = my_usages, mi_boot = False, - mi_orphan = is_orphan, + mi_orphan = panic "is_orphan", mi_exports = my_exports, mi_globals = gbl_env, mi_fixities = fixities, @@ -281,42 +295,15 @@ rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec -- REPORT UNUSED NAMES, AND DEBUG DUMP reportUnusedNames mod_iface print_unqualified imports global_avail_env - source_fvs export_avails rn_imp_decls `thenRn_` + source_fvs2 rn_imp_decls `thenRn_` + -- NB: source_fvs2: include exports (else we get bogus + -- warnings of unused things) but not implicit FVs. returnRn (print_unqualified, Just (is_exported, mod_iface, (sugar_map, final_decls))) where mod_name = moduleName this_module \end{code} -\begin{code} -isOrphanDecl this_mod (InstD (InstDecl inst_ty _ _ _ _)) - = not (foldNameSet ((||) . nameIsLocalOrFrom this_mod) False - (extractHsTyNames (removeContext inst_ty))) - -- The 'removeContext' is because of - -- instance Foo a => Baz T where ... - -- The decl is an orphan if Baz and T are both not locally defined, - -- even if Foo *is* locally defined - -isOrphanDecl this_mod (RuleD (HsRule _ _ _ lhs _ _)) - = check lhs - where - -- At the moment we just check for common LHS forms - -- Expand as necessary. Getting it wrong just means - -- more orphans than necessary - check (HsVar v) = not (nameIsLocalOrFrom this_mod v) - check (HsApp f a) = check f && check a - check (HsLit _) = False - check (HsOverLit _) = False - check (OpApp l o _ r) = check l && check o && check r - check (NegApp e) = check e - check (HsPar e) = check e - check (SectionL e o) = check e && check o - check (SectionR o e) = check e && check o - - check other = True -- Safe fall through - -isOrphanDecl _ _ = False -\end{code} %********************************************************* @@ -583,11 +570,10 @@ reportUnusedNames :: ModIface -> PrintUnqualified -> [RdrNameImportDecl] -> AvailEnv -> NameSet -- Used in this module - -> Avails -- Exported by this module -> [RenamedHsDecl] -> RnMG () reportUnusedNames my_mod_iface unqual imports avail_env - source_fvs export_avails imported_decls + used_names imported_decls = warnUnusedModules unused_imp_mods `thenRn_` warnUnusedLocalBinds bad_locals `thenRn_` warnUnusedImports bad_imp_names `thenRn_` @@ -596,11 +582,6 @@ reportUnusedNames my_mod_iface unqual imports avail_env this_mod = mi_module my_mod_iface gbl_env = mi_globals my_mod_iface - -- The export_fvs make the exported names look just as if they - -- occurred in the source program. - export_fvs = availsToNameSet export_avails - used_names = source_fvs `plusFV` export_fvs - -- Now, a use of C implies a use of T, -- if C was brought into scope by T(..) or T(C) really_used_names = used_names `unionNameSets`