diff options
Diffstat (limited to 'compiler/rename')
| -rw-r--r-- | compiler/rename/RnEnv.lhs | 45 | ||||
| -rw-r--r-- | compiler/rename/RnExpr.lhs | 4 | ||||
| -rw-r--r-- | compiler/rename/RnNames.lhs | 80 |
3 files changed, 66 insertions, 63 deletions
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index 2be3bfd5c0..1c5a559ee8 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -30,13 +30,14 @@ module RnEnv ( #include "HsVersions.h" -import LoadIface ( loadHomeInterface, loadSrcInterface ) +import LoadIface ( loadInterfaceForName, loadSrcInterface ) import IfaceEnv ( lookupOrig, newGlobalBinder, newIPName ) import HsSyn ( FixitySig(..), HsExpr(..), SyntaxExpr, SyntaxTable, LHsTyVarBndr, LHsType, Fixity, hsLTyVarLocNames, replaceTyVarName ) import RdrHsSyn ( extractHsTyRdrTyVars ) -import RdrName ( RdrName, rdrNameModule, isQual, isUnqual, isOrig, +import RdrName ( RdrName, isQual, isUnqual, isOrig_maybe, + isQual_maybe, mkRdrUnqual, setRdrNameSpace, rdrNameOcc, pprGlobalRdrEnv, lookupGRE_RdrName, isExact_maybe, isSrcRdrName, @@ -52,7 +53,7 @@ import Name ( Name, nameIsLocalOrFrom, mkInternalName, isWiredInName, import NameSet import OccName ( tcName, isDataOcc, pprNonVarNameSpace, occNameSpace, reportIfUnused ) -import Module ( Module ) +import Module ( Module, ModuleName ) import PrelNames ( mkUnboundName, rOOT_MAIN, iNTERACTIVE, consDataConKey, hasKey ) import UniqSupply import BasicTypes ( IPName, mapIPName ) @@ -91,7 +92,7 @@ newTopSrcBinder this_mod mb_parent (L loc rdr_name) returnM name - | isOrig rdr_name + | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name = do checkErr (rdr_mod == this_mod || rdr_mod == rOOT_MAIN) (badOrigBinding rdr_name) -- When reading External Core we get Orig names as binders, @@ -111,13 +112,11 @@ newTopSrcBinder this_mod mb_parent (L loc rdr_name) -- the RdrName, not from the environment. In principle, it'd be fine to -- have an arbitrary mixture of external core definitions in a single module, -- (apart from module-initialisation issues, perhaps). - newGlobalBinder rdr_mod (rdrNameOcc rdr_name) mb_parent + newGlobalBinder rdr_mod rdr_occ mb_parent (srcSpanStart loc) --TODO, should pass the whole span | otherwise = newGlobalBinder this_mod (rdrNameOcc rdr_name) mb_parent (srcSpanStart loc) - where - rdr_mod = rdrNameModule rdr_name \end{code} %********************************************************* @@ -164,13 +163,12 @@ lookupTopBndrRn rdr_name | Just name <- isExact_maybe rdr_name = returnM name - | isOrig rdr_name + | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name -- This deals with the case of derived bindings, where -- we don't bother to call newTopSrcBinder first -- We assume there is no "parent" name = do { loc <- getSrcSpanM - ; newGlobalBinder (rdrNameModule rdr_name) - (rdrNameOcc rdr_name) Nothing (srcSpanStart loc) } + ; newGlobalBinder rdr_mod rdr_occ Nothing (srcSpanStart loc) } | otherwise = do { mb_gre <- lookupGreLocalRn rdr_name @@ -278,9 +276,12 @@ lookupImportedName rdr_name -- This happens in derived code = returnM n - | otherwise -- Always Orig, even when reading a .hi-boot file - = ASSERT( not (isUnqual rdr_name) ) - lookupOrig (rdrNameModule rdr_name) (rdrNameOcc rdr_name) + -- Always Orig, even when reading a .hi-boot file + | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name + = lookupOrig rdr_mod rdr_occ + + | otherwise + = pprPanic "RnEnv.lookupImportedName" (ppr rdr_name) unboundName :: RdrName -> RnM Name unboundName rdr_name @@ -337,13 +338,10 @@ lookupGreRn_help rdr_name lookup -- try to load the interface if we don't already have it. lookupQualifiedName :: RdrName -> RnM Name lookupQualifiedName rdr_name - = let - mod = rdrNameModule rdr_name - occ = rdrNameOcc rdr_name - in + | Just (mod,occ) <- isQual_maybe rdr_name -- Note: we want to behave as we would for a source file import here, -- and respect hiddenness of modules/packages, hence loadSrcInterface. - loadSrcInterface doc mod False `thenM` \ iface -> + = loadSrcInterface doc mod False `thenM` \ iface -> case [ (mod,occ) | (mod,avails) <- mi_exports iface, @@ -353,6 +351,9 @@ lookupQualifiedName rdr_name ((mod,occ):ns) -> ASSERT (null ns) lookupOrig mod occ _ -> unboundName rdr_name + + | otherwise + = pprPanic "RnEnv.lookupQualifiedName" (ppr rdr_name) where doc = ptext SLIT("Need to find") <+> ppr rdr_name \end{code} @@ -421,7 +422,7 @@ lookupFixityRn name else -- It's imported -- For imported names, we have to get their fixities by doing a - -- loadHomeInterface, and consulting the Ifaces that comes back + -- loadInterfaceForName, and consulting the Ifaces that comes back -- from that, because the interface file for the Name might not -- have been loaded yet. Why not? Suppose you import module A, -- which exports a function 'f', thus; @@ -434,9 +435,9 @@ lookupFixityRn name -- 'f', we need to know its fixity, and it's then, and only -- then, that we load B.hi. That is what's happening here. -- - -- loadHomeInterface will find B.hi even if B is a hidden module, + -- loadInterfaceForName will find B.hi even if B is a hidden module, -- and that's what we want. - loadHomeInterface doc name `thenM` \ iface -> + loadInterfaceForName doc name `thenM` \ iface -> returnM (mi_fix_fn iface (nameOccName name)) where doc = ptext SLIT("Checking fixity for") <+> ppr name @@ -705,7 +706,7 @@ mapFvRn f xs = mappM f xs `thenM` \ stuff -> %************************************************************************ \begin{code} -warnUnusedModules :: [(Module,SrcSpan)] -> RnM () +warnUnusedModules :: [(ModuleName,SrcSpan)] -> RnM () warnUnusedModules mods = ifOptM Opt_WarnUnusedImports (mappM_ bleat mods) where diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs index 87af074190..e968590812 100644 --- a/compiler/rename/RnExpr.lhs +++ b/compiler/rename/RnExpr.lhs @@ -44,7 +44,7 @@ import Name ( isTyVarName ) import Name ( Name, nameOccName, nameIsLocalOrFrom ) import NameSet import RdrName ( RdrName, emptyGlobalRdrEnv, extendLocalRdrEnv, lookupLocalRdrEnv ) -import LoadIface ( loadHomeInterface ) +import LoadIface ( loadInterfaceForName ) import UniqFM ( isNullUFM ) import UniqSet ( emptyUniqSet ) import List ( nub ) @@ -550,7 +550,7 @@ rnRbinds str rbinds rnBracket (VarBr n) = do { name <- lookupOccRn n ; this_mod <- getModule ; checkM (nameIsLocalOrFrom this_mod name) $ -- Reason: deprecation checking asumes the - do { loadHomeInterface msg name -- home interface is loaded, and this is the + do { loadInterfaceForName msg name -- home interface is loaded, and this is the ; return () } -- only way that is going to happen ; returnM (VarBr name, unitFV name) } where diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index 658028c3f3..71d5c9b350 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -13,7 +13,7 @@ module RnNames ( #include "HsVersions.h" -import DynFlags ( DynFlag(..), GhcMode(..) ) +import DynFlags ( DynFlag(..), GhcMode(..), DynFlags(..) ) import HsSyn ( IE(..), ieName, ImportDecl(..), LImportDecl, ForeignDecl(..), HsGroup(..), HsValBinds(..), Sig(..), collectHsBindLocatedBinders, tyClDeclNames, @@ -24,9 +24,8 @@ import LoadIface ( loadSrcInterface ) import TcRnMonad hiding (LIE) import FiniteMap -import PrelNames ( pRELUDE, isUnboundName, main_RDR_Unqual ) -import Module ( Module, moduleString, unitModuleEnv, - lookupModuleEnv, moduleEnvElts, foldModuleEnv ) +import PrelNames +import Module import Name ( Name, nameSrcLoc, nameOccName, nameModule, isWiredInName, nameParent, nameParent_maybe, isExternalName, isBuiltInSyntax ) @@ -38,11 +37,10 @@ import OccName ( srcDataName, isTcOcc, pprNonVarNameSpace, extendOccEnv ) import HscTypes ( GenAvailInfo(..), AvailInfo, HomePackageTable, PackageIfaceTable, - unQualInScope, + mkPrintUnqualified, Deprecs(..), ModIface(..), Dependencies(..), - lookupIface, ExternalPackageState(..) + lookupIfaceByModule, ExternalPackageState(..) ) -import Packages ( PackageIdH(..) ) import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace, GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..), emptyGlobalRdrEnv, plusGlobalRdrEnv, globalRdrEnvElts, @@ -50,6 +48,7 @@ import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace, Provenance(..), ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..), importSpecLoc, importSpecModule, isLocalGRE, pprNameProvenance ) import Outputable +import UniqFM import Maybes ( isNothing, catMaybes, mapCatMaybes, seqMaybe, orElse ) import SrcLoc ( Located(..), mkGeneralSrcSpan, unLoc, noLoc, srcLocSpan, SrcSpan ) @@ -96,12 +95,12 @@ rnImports imports | otherwise = [preludeImportDecl] explicit_prelude_import = notNull [ () | L _ (ImportDecl mod _ _ _ _) <- imports, - unLoc mod == pRELUDE ] + unLoc mod == pRELUDE_NAME ] preludeImportDecl :: LImportDecl RdrName preludeImportDecl = L loc $ - ImportDecl (L loc pRELUDE) + ImportDecl (L loc pRELUDE_NAME) False {- Not a boot interface -} False {- Not qualified -} Nothing {- No "as" -} @@ -271,13 +270,14 @@ importsFromImportDecl this_mod let -- Compute new transitive dependencies - orphans | is_orph = ASSERT( not (imp_mod_name `elem` dep_orphs deps) ) - imp_mod_name : dep_orphs deps + orphans | is_orph = ASSERT( not (imp_mod `elem` dep_orphs deps) ) + imp_mod : dep_orphs deps | otherwise = dep_orphs deps + pkg = modulePackageId (mi_module iface) + (dependent_mods, dependent_pkgs) - = case mi_package iface of - HomePackage -> + | pkg == thisPackage dflags = -- Imported module is from the home package -- Take its dependent modules and add imp_mod itself -- Take its dependent packages unchanged @@ -291,7 +291,7 @@ importsFromImportDecl this_mod -- check. See LoadIface.loadHiBootInterface ((imp_mod_name, want_boot) : dep_mods deps, dep_pkgs deps) - ExtPackage pkg -> + | otherwise = -- Imported module is from another package -- Dump the dependent modules -- Add the package imp_mod comes from to the dependent packages @@ -308,7 +308,7 @@ importsFromImportDecl this_mod -- module M ( module P ) where ... -- Then we must export whatever came from P unqualified. imports = ImportAvails { - imp_env = unitModuleEnv qual_mod_name avail_env, + imp_env = unitUFM qual_mod_name avail_env, imp_mods = unitModuleEnv imp_mod (imp_mod, import_all, loc), imp_orphs = orphans, imp_dep_mods = mkModDeps dependent_mods, @@ -376,7 +376,7 @@ importsFromLocalDecls group ; this_mod = tcg_mod gbl_env ; imports = emptyImportAvails { - imp_env = unitModuleEnv this_mod $ + imp_env = unitUFM (moduleName this_mod) $ mkNameSet filtered_names } } @@ -544,7 +544,7 @@ it re-exports @GHC@, which includes @takeMVar#@, whose type includes \begin{code} type ExportAccum -- The type of the accumulating parameter of -- the main worker function in rnExports - = ([Module], -- 'module M's seen so far + = ([ModuleName], -- 'module M's seen so far ExportOccMap, -- Tracks exported occurrence names NameSet) -- The accumulated exported stuff emptyExportAccum = ([], emptyOccEnv, emptyNameSet) @@ -561,7 +561,7 @@ rnExports Nothing = return Nothing rnExports (Just exports) = do TcGblEnv { tcg_imports = ImportAvails { imp_env = imp_env } } <- getGblEnv let sub_env :: NameEnv [Name] -- Classify each name by its parent - sub_env = mkSubNameEnv (foldModuleEnv unionNameSets emptyNameSet imp_env) + sub_env = mkSubNameEnv (foldUFM unionNameSets emptyNameSet imp_env) rnExport (IEVar rdrName) = do name <- lookupGlobalOccRn rdrName return (IEVar name) @@ -631,7 +631,7 @@ exports_from_avail (Just (items,origItems)) rdr_env (ImportAvails { imp_env = im return exports where sub_env :: NameEnv [Name] -- Classify each name by its parent - sub_env = mkSubNameEnv (foldModuleEnv unionNameSets emptyNameSet imp_env) + sub_env = mkSubNameEnv (foldUFM unionNameSets emptyNameSet imp_env) do_litem :: ExportAccum -> (LIE Name, LIE RdrName) -> RnM ExportAccum do_litem acc (ieName, ieRdr) @@ -645,7 +645,7 @@ exports_from_avail (Just (items,origItems)) rdr_env (ImportAvails { imp_env = im returnM acc } | otherwise - = case lookupModuleEnv imp_env mod of + = case lookupUFM imp_env mod of Nothing -> do addErr (modExportErr mod) return acc Just names @@ -738,8 +738,8 @@ check_occs ie occs names %********************************************************* \begin{code} -reportDeprecations :: TcGblEnv -> RnM () -reportDeprecations tcg_env +reportDeprecations :: DynFlags -> TcGblEnv -> RnM () +reportDeprecations dflags tcg_env = ifOptM Opt_WarnDeprecations $ do { (eps,hpt) <- getEpsAndHpt -- By this time, typechecking is complete, @@ -752,7 +752,7 @@ reportDeprecations tcg_env check hpt pit (GRE {gre_name = name, gre_prov = Imported (imp_spec:_)}) | name `elemNameSet` used_names - , Just deprec_txt <- lookupDeprec hpt pit name + , Just deprec_txt <- lookupDeprec dflags hpt pit name = setSrcSpan (importSpecLoc imp_spec) $ addWarn (sep [ptext SLIT("Deprecated use of") <+> pprNonVarNameSpace (occNameSpace (nameOccName name)) <+> @@ -763,7 +763,7 @@ reportDeprecations tcg_env name_mod = nameModule name imp_mod = importSpecModule imp_spec imp_msg = ptext SLIT("imported from") <+> ppr imp_mod <> extra - extra | imp_mod == name_mod = empty + extra | imp_mod == moduleName name_mod = empty | otherwise = ptext SLIT(", but defined in") <+> ppr name_mod check hpt pit ok_gre = returnM () -- Local, or not used, or not deprectated @@ -774,10 +774,10 @@ reportDeprecations tcg_env -- the defn of a non-deprecated thing, when changing a module's -- interface -lookupDeprec :: HomePackageTable -> PackageIfaceTable +lookupDeprec :: DynFlags -> HomePackageTable -> PackageIfaceTable -> Name -> Maybe DeprecTxt -lookupDeprec hpt pit n - = case lookupIface hpt pit (nameModule n) of +lookupDeprec dflags hpt pit n + = case lookupIfaceByModule dflags hpt pit (nameModule n) of Just iface -> mi_dep_fn iface n `seqMaybe` -- Bleat if the thing, *or mi_dep_fn iface (nameParent n) -- its parent*, is deprec'd Nothing @@ -854,7 +854,7 @@ reportUnusedNames export_decls gbl_env -- into a bunch of avails, so they are properly grouped -- -- BUG WARNING: this does not deal properly with qualified imports! - minimal_imports :: FiniteMap Module AvailEnv + minimal_imports :: FiniteMap ModuleName AvailEnv minimal_imports0 = foldr add_expall emptyFM expall_mods minimal_imports1 = foldr add_name minimal_imports0 defined_and_used minimal_imports = foldr add_inst_mod minimal_imports1 direct_import_mods @@ -909,9 +909,10 @@ reportUnusedNames export_decls gbl_env | otherwise = Avail n add_inst_mod (mod,_,_) acc - | mod `elemFM` acc = acc -- We import something already - | otherwise = addToFM acc mod emptyAvailEnv + | mod_name `elemFM` acc = acc -- We import something already + | otherwise = addToFM acc mod_name emptyAvailEnv where + mod_name = moduleName mod -- Add an empty collection of imports for a module -- from which we have sucked only instance decls @@ -928,15 +929,16 @@ reportUnusedNames export_decls gbl_env -- -- BUG WARNING: does not deal correctly with multiple imports of the same module -- becuase direct_import_mods has only one entry per module - unused_imp_mods = [(mod,loc) | (mod,no_imp,loc) <- direct_import_mods, - not (mod `elemFM` minimal_imports1), + unused_imp_mods = [(mod_name,loc) | (mod,no_imp,loc) <- direct_import_mods, + let mod_name = moduleName mod, + not (mod_name `elemFM` minimal_imports1), mod /= pRELUDE, not no_imp] -- The not no_imp part is not to complain about -- import M (), which is an idiom for importing -- instance declarations - module_unused :: Module -> Bool + module_unused :: ModuleName -> Bool module_unused mod = any (((==) mod) . fst) unused_imp_mods --------------------- @@ -1017,7 +1019,7 @@ selectiveImpItem ImpAll = False selectiveImpItem (ImpSome {}) = True -- ToDo: deal with original imports with 'qualified' and 'as M' clauses -printMinimalImports :: FiniteMap Module AvailEnv -- Minimal imports +printMinimalImports :: FiniteMap ModuleName AvailEnv -- Minimal imports -> RnM () printMinimalImports imps = ifOptM Opt_D_dump_minimal_imports $ do { @@ -1026,13 +1028,13 @@ printMinimalImports imps this_mod <- getModule ; rdr_env <- getGlobalRdrEnv ; ioToTcRn (do { h <- openFile (mkFilename this_mod) WriteMode ; - printForUser h (unQualInScope rdr_env) + printForUser h (mkPrintUnqualified rdr_env) (vcat (map ppr_mod_ie mod_ies)) }) } where - mkFilename this_mod = moduleString this_mod ++ ".imports" + mkFilename this_mod = moduleNameString (moduleName this_mod) ++ ".imports" ppr_mod_ie (mod_name, ies) - | mod_name == pRELUDE + | mod_name == moduleName pRELUDE = empty | null ies -- Nothing except instances comes from here = ptext SLIT("import") <+> ppr mod_name <> ptext SLIT("() -- Instances only") @@ -1053,7 +1055,7 @@ printMinimalImports imps to_ie (AvailTC n ns) = loadSrcInterface doc n_mod False `thenM` \ iface -> case [xs | (m,as) <- mi_exports iface, - m == n_mod, + moduleName m == n_mod, AvailTC x xs <- as, x == nameOccName n] of [xs] | all_used xs -> returnM (IEThingAll n) @@ -1063,7 +1065,7 @@ printMinimalImports imps where all_used avail_occs = all (`elem` map nameOccName ns) avail_occs doc = text "Compute minimal imports from" <+> ppr n - n_mod = nameModule n + n_mod = moduleName (nameModule n) \end{code} |