X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2Frename%2FRnNames.lhs;h=877974c87f48afe41fb64e0a121e56880d08290f;hb=9bedea20f62a1da832c69833c39dd1d15e6ee9a3;hp=71bd508b5ddf52a7ccf7600c01bffa71eb14d2be;hpb=341daf1cd88470e480092adb7e5105ae9b4e3b02;p=ghc-hetmet.git diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index 71bd508..877974c 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/ghc/compiler/rename/RnNames.lhs @@ -10,44 +10,40 @@ module RnNames ( #include "HsVersions.h" -import CmdLineOpts ( opt_NoImplicitPrelude, opt_WarnDuplicateExports, - opt_SourceUnchanged, opt_WarnUnusedBinds - ) - -import HsSyn ( HsModule(..), HsDecl(..), TyClDecl(..), - IE(..), ieName, - ForeignDecl(..), ForKind(..), isDynamicExtName, - FixitySig(..), Sig(..), ImportDecl(..), - collectTopBinders - ) -import RdrHsSyn ( RdrNameIE, RdrNameImportDecl, - RdrNameHsModule, RdrNameHsDecl - ) -import RnIfaces ( getInterfaceExports, getDeclBinders, getDeclSysBinders, - recordLocalSlurps, checkModUsage, findAndReadIface, outOfDate - ) +import CmdLineOpts ( DynFlags, DynFlag(..), dopt, opt_NoImplicitPrelude ) + +import HsSyn ( HsModule(..), HsDecl(..), IE(..), ieName, ImportDecl(..), + collectTopBinders + ) +import RdrHsSyn ( RdrNameIE, RdrNameImportDecl, + RdrNameHsModule, RdrNameHsDecl + ) +import RnIfaces ( getInterfaceExports, getDeclBinders, + recordLocalSlurps, checkModUsage, + outOfDate, findAndReadIface ) import RnEnv import RnMonad import FiniteMap -import PrelInfo ( pRELUDE_Name, mAIN_Name, main_RDR ) -import UniqFM ( lookupUFM ) -import Bag ( bagToList ) -import Module ( ModuleName, mkThisModule, pprModuleName, WhereFrom(..) ) +import PrelNames ( pRELUDE_Name, mAIN_Name, main_RDR ) +import UniqFM ( lookupUFM ) +import Bag ( bagToList ) +import Module ( ModuleName, mkModuleInThisPackage, WhereFrom(..) ) import NameSet -import Name ( Name, ExportFlag(..), ImportReason(..), Provenance(..), - isLocallyDefined, setNameProvenance, - nameOccName, getSrcLoc, pprProvenance, getNameProvenance, - nameEnvElts - ) -import RdrName ( RdrName, rdrNameOcc, setRdrNameOcc, mkRdrQual, mkRdrUnqual, isQual, isUnqual ) -import OccName ( setOccNameSpace, dataName ) -import NameSet ( elemNameSet, emptyNameSet ) +import Name ( Name, nameSrcLoc, + setLocalNameSort, nameOccName, nameEnvElts ) +import HscTypes ( Provenance(..), ImportReason(..), GlobalRdrEnv, + GenAvailInfo(..), AvailInfo, Avails, AvailEnv ) +import RdrName ( RdrName, rdrNameOcc, setRdrNameOcc, mkRdrQual, mkRdrUnqual, + isQual, isUnqual ) +import OccName ( setOccNameSpace, dataName ) +import NameSet ( elemNameSet, emptyNameSet ) import Outputable -import Maybes ( maybeToBool, catMaybes, mapMaybe ) -import UniqFM ( emptyUFM, listToUFM, plusUFM_C ) -import Util ( removeDups, equivClassesByUniq, sortLt ) -import List ( partition ) +import Maybes ( maybeToBool, catMaybes, mapMaybe ) +import UniqFM ( emptyUFM, listToUFM ) +import ListSetOps ( removeDups ) +import Util ( sortLt ) +import List ( partition ) \end{code} @@ -78,7 +74,7 @@ getGlobalNames (HsModule this_mod _ exports imports decls _ mod_loc) rec_unqual_fn :: Name -> Bool -- Is this chap in scope unqualified? rec_unqual_fn = unQualInScope rec_gbl_env - rec_exp_fn :: Name -> ExportFlag + rec_exp_fn :: Name -> Bool rec_exp_fn = mk_export_fn (availsToNameSet rec_export_avails) in @@ -143,14 +139,6 @@ getGlobalNames (HsModule this_mod _ exports imports decls _ mod_loc) returnRn Nothing else - -- RECORD BETTER PROVENANCES IN THE CACHE - -- The names in the envirnoment have better provenances (e.g. imported on line x) - -- than the names in the name cache. We update the latter now, so that we - -- we start renaming declarations we'll get the good names - -- The isQual is because the qualified name is always in scope - updateProvenances (concat [names | (rdr_name, names) <- rdrEnvToList gbl_env, - isQual rdr_name]) `thenRn_` - -- PROCESS EXPORT LISTS exportsFromAvail this_mod exports all_avails gbl_env `thenRn` \ export_avails -> @@ -190,12 +178,12 @@ checkEarlyExit mod_name -- CHECK WHETHER WE HAVE IT ALREADY case maybe_iface of Left err -> -- Old interface file not found, so we'd better bail out - traceRn (vcat [ptext SLIT("No old interface file for") <+> pprModuleName mod_name, + traceRn (vcat [ptext SLIT("No old interface file for") <+> ppr mod_name, err]) `thenRn_` returnRn (outOfDate, Nothing) Right iface - | not opt_SourceUnchanged + | panic "checkEarlyExit: ???: not opt_SourceUnchanged" -> -- Source code changed traceRn (nest 4 (text "source file changed or recompilation check turned off")) `thenRn_` returnRn (False, Just iface) @@ -206,7 +194,7 @@ checkEarlyExit mod_name returnRn (up_to_date, Just iface) where -- Only look in current directory, with suffix .hi - doc_str = sep [ptext SLIT("need usage info from"), pprModuleName mod_name] + doc_str = sep [ptext SLIT("need usage info from"), ppr mod_name] \end{code} \begin{code} @@ -227,27 +215,16 @@ importsFromImportDecl is_unqual (ImportDecl imp_mod_name from qual_only as_mod i filterImports imp_mod_name import_spec avails `thenRn` \ (filtered_avails, hides, explicits) -> + let + mk_provenance name = NonLocalDef (UserImport imp_mod iloc (name `elemNameSet` explicits)) + (is_unqual name) + in + 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 - = map improve_avail avails - where - improve_avail (Avail n) = Avail (improve n) - improve_avail (AvailTC n ns) = AvailTC (improve n) (map improve ns) - - improve name = setNameProvenance name - (NonLocalDef (UserImport imp_mod iloc (is_explicit name)) - (is_unqual name)) - is_explicit name = name `elemNameSet` explicits + mk_provenance + filtered_avails \end{code} @@ -272,15 +249,16 @@ importsFromLocalDecls mod_name rec_exp_fn decls -- Build the environment qualifyImports mod_name - True -- Want unqualified names - Nothing -- no 'as M' - [] -- Hide nothing + True -- Want unqualified names + Nothing -- no 'as M' + [] -- Hide nothing + (\n -> LocalDef) -- Provenance is local avails - where - mod = mkThisModule mod_name + mod = mkModuleInThisPackage mod_name -getLocalDeclBinders :: Module -> (Name -> ExportFlag) +getLocalDeclBinders :: Module + -> (Name -> Bool) -- Is-exported predicate -> RdrNameHsDecl -> RnMG Avails getLocalDeclBinders mod rec_exp_fn (ValD binds) = mapRn do_one (bagToList (collectTopBinders binds)) @@ -295,9 +273,9 @@ getLocalDeclBinders mod rec_exp_fn decl Just avail -> returnRn [avail] newLocalName mod rec_exp_fn rdr_name loc - = check_unqual rdr_name loc `thenRn_` - newTopBinder mod (rdrNameOcc rdr_name) `thenRn` \ name -> - returnRn (setNameProvenance name (LocalDef loc (rec_exp_fn name))) + = check_unqual rdr_name loc `thenRn_` + newTopBinder mod rdr_name loc `thenRn` \ name -> + returnRn (setLocalNameSort name (rec_exp_fn name)) where -- There should never be a qualified name in a binding position (except in instance decls) -- The parser doesn't check this because the same parser parses instance decls @@ -421,10 +399,11 @@ qualifyImports :: ModuleName -- Imported module -> Bool -- True <=> want unqualified import -> Maybe ModuleName -- Optional "as M" part -> [AvailInfo] -- What's to be hidden + -> (Name -> Provenance) -> Avails -- Whats imported and how -> RnMG (GlobalRdrEnv, ExportAvails) -qualifyImports this_mod unqual_imp as_mod hides avails +qualifyImports this_mod unqual_imp as_mod hides mk_provenance avails = -- Make the name environment. We're talking about a -- single module here, so there must be no name clashes. @@ -454,9 +433,10 @@ qualifyImports this_mod unqual_imp as_mod hides avails | unqual_imp = env2 | otherwise = env1 where - env1 = addOneToGlobalRdrEnv env (mkRdrQual qual_mod occ) name - env2 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) name + env1 = addOneToGlobalRdrEnv env (mkRdrQual qual_mod occ) (name,prov) + env2 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) (name,prov) occ = nameOccName name + prov = mk_provenance name del_avail env avail = foldl delOneFromGlobalRdrEnv env rdr_names where @@ -553,8 +533,10 @@ exportsFromAvail this_mod Nothing export_avails global_name_env exportsFromAvail this_mod (Just export_items) (mod_avail_env, entity_avail_env) global_name_env - = foldlRn exports_from_item - ([], emptyFM, emptyAvailEnv) export_items `thenRn` \ (_, _, export_avail_map) -> + = doptRn Opt_WarnDuplicateExports `thenRn` \ warn_dup_exports -> + foldlRn (exports_from_item warn_dup_exports) + ([], emptyFM, emptyAvailEnv) export_items + `thenRn` \ (_, _, export_avail_map) -> let export_avails :: [AvailInfo] export_avails = nameEnvElts export_avail_map @@ -562,12 +544,11 @@ exportsFromAvail this_mod (Just export_items) returnRn export_avails where - exports_from_item :: ExportAccum -> RdrNameIE -> RnMG ExportAccum + exports_from_item :: Bool -> ExportAccum -> RdrNameIE -> RnMG ExportAccum - exports_from_item acc@(mods, occs, avails) ie@(IEModuleContents mod) + exports_from_item warn_dups acc@(mods, occs, avails) ie@(IEModuleContents mod) | mod `elem` mods -- Duplicate export of M - = warnCheckRn opt_WarnDuplicateExports - (dupModuleExport mod) `thenRn_` + = warnCheckRn warn_dups (dupModuleExport mod) `thenRn_` returnRn acc | otherwise @@ -580,12 +561,12 @@ exportsFromAvail this_mod (Just export_items) in returnRn (mod:mods, occs', avails') - exports_from_item acc@(mods, occs, avails) ie + exports_from_item warn_dups acc@(mods, occs, avails) ie | not (maybeToBool maybe_in_scope) = failWithRn acc (unknownNameErr (ieName ie)) | not (null dup_names) - = addNameClashErrRn rdr_name (name:dup_names) `thenRn_` + = addNameClashErrRn rdr_name ((name,prov):dup_names) `thenRn_` returnRn acc #ifdef DEBUG @@ -609,7 +590,7 @@ exportsFromAvail this_mod (Just export_items) where rdr_name = ieName ie maybe_in_scope = lookupFM global_name_env rdr_name - Just (name:dup_names) = maybe_in_scope + Just ((name,prov):dup_names) = maybe_in_scope maybe_avail = lookupUFM entity_avail_env name Just avail = maybe_avail maybe_export_avail = filterAvail ie avail @@ -624,14 +605,15 @@ exportsFromAvail this_mod (Just export_items) check_occs :: RdrNameIE -> ExportOccMap -> AvailInfo -> RnMG ExportOccMap check_occs ie occs avail - = foldlRn check occs (availNames avail) + = doptRn Opt_WarnDuplicateExports `thenRn` \ warn_dup_exports -> + foldlRn (check warn_dup_exports) occs (availNames avail) where - check occs name + check warn_dup occs name = case lookupFM occs name_occ of Nothing -> returnRn (addToFM occs name_occ (name, ie)) Just (name', ie') | name == name' -> -- Duplicate export - warnCheckRn opt_WarnDuplicateExports + warnCheckRn warn_dup (dupExportWarn name_occ ie ie') `thenRn_` returnRn occs @@ -640,11 +622,8 @@ check_occs ie occs avail where name_occ = nameOccName name -mk_export_fn :: NameSet -> (Name -> ExportFlag) -mk_export_fn exported_names - = \name -> if name `elemNameSet` exported_names - then Exported - else NotExported +mk_export_fn :: NameSet -> (Name -> Bool) -- True => exported +mk_export_fn exported_names = \name -> name `elemNameSet` exported_names \end{code} %************************************************************************ @@ -655,7 +634,7 @@ mk_export_fn exported_names \begin{code} badImportItemErr mod ie - = sep [ptext SLIT("Module"), quotes (pprModuleName mod), + = sep [ptext SLIT("Module"), quotes (ppr mod), ptext SLIT("does not export"), quotes (ppr ie)] dodgyImportWarn mod item = dodgyMsg (ptext SLIT("import")) item @@ -667,7 +646,7 @@ dodgyMsg kind item@(IEThingAll tc) ptext SLIT("but it has none; it is a type synonym or abstract type or class") ] modExportErr mod - = hsep [ ptext SLIT("Unknown module in export list: module"), quotes (pprModuleName mod)] + = hsep [ ptext SLIT("Unknown module in export list: module"), quotes (ppr mod)] exportItemErr export_item = sep [ ptext SLIT("The export item") <+> quotes (ppr export_item), @@ -680,13 +659,10 @@ exportClashErr occ_name ie1 ie2 dupDeclErr (n:ns) = vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr n), - nest 4 (vcat (map pp sorted_ns))] + nest 4 (vcat (map ppr sorted_locs))] where - sorted_ns = sortLt occ'ed_before (n:ns) - - occ'ed_before a b = LT == compare (getSrcLoc a) (getSrcLoc b) - - pp n = pprProvenance (getNameProvenance n) + sorted_locs = sortLt occ'ed_before (map nameSrcLoc (n:ns)) + occ'ed_before a b = LT == compare a b dupExportWarn occ_name ie1 ie2 = hsep [quotes (ppr occ_name), @@ -695,6 +671,6 @@ dupExportWarn occ_name ie1 ie2 dupModuleExport mod = hsep [ptext SLIT("Duplicate"), - quotes (ptext SLIT("Module") <+> pprModuleName mod), + quotes (ptext SLIT("Module") <+> ppr mod), ptext SLIT("in export list")] \end{code}