X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnNames.lhs;h=4dfcc13eeaab0984775fe1ca16f34a8d0b116fa2;hb=f4c9d2b23bd63b48566e0ca3b13c8bdfc4cd0c0b;hp=baa7c7406ae7bcba42abb0e9dba826a71b6d092e;hpb=b6fbea9780c7acaa623acf2289db1514745ab6b8;p=ghc-hetmet.git diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index baa7c74..4dfcc13 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/ghc/compiler/rename/RnNames.lhs @@ -23,16 +23,16 @@ import LoadIface ( loadSrcInterface ) import TcRnMonad import FiniteMap -import PrelNames ( pRELUDE_Name, isBuiltInSyntaxName, isUnboundName, +import PrelNames ( pRELUDE_Name, isUnboundName, main_RDR_Unqual ) import Module ( Module, ModuleName, moduleName, mkPackageModule, moduleNameUserString, isHomeModule, unitModuleEnvByName, unitModuleEnv, lookupModuleEnvByName, moduleEnvElts ) -import Name ( Name, nameSrcLoc, nameOccName, nameModuleName, - nameParent, nameParent_maybe, isExternalName, nameModule ) +import Name ( Name, nameSrcLoc, nameOccName, nameModuleName, isWiredInName, + nameParent, nameParent_maybe, isExternalName, nameModule, + isBuiltInSyntax ) import NameSet -import NameEnv import OccName ( srcDataName, isTcOcc, occNameFlavour, OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv, extendOccEnv ) import HscTypes ( GenAvailInfo(..), AvailInfo, Avails, GhciMode(..), @@ -48,12 +48,12 @@ import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace, Provenance(..), ImportSpec(..), isLocalGRE, pprNameProvenance ) import Outputable -import Maybes ( isJust, isNothing, catMaybes, mapCatMaybes, seqMaybe ) +import Maybes ( isNothing, catMaybes, mapCatMaybes, seqMaybe ) import SrcLoc ( noSrcLoc, Located(..), mkGeneralSrcSpan, - unLoc, noLoc, srcLocSpan, SrcSpan ) + unLoc, noLoc, srcLocSpan, combineSrcSpans, SrcSpan ) import BasicTypes ( DeprecTxt ) import ListSetOps ( removeDups ) -import Util ( sortLt, notNull, isSingleton ) +import Util ( sortLe, notNull, isSingleton ) import List ( partition ) import IO ( openFile, IOMode(..) ) \end{code} @@ -71,32 +71,32 @@ rnImports :: [LImportDecl RdrName] -> RnM (GlobalRdrEnv, ImportAvails) rnImports imports - = -- PROCESS IMPORT DECLS + = do { -- PROCESS IMPORT DECLS -- Do the non {- SOURCE -} ones first, so that we get a helpful -- warning for {- SOURCE -} ones that are unnecessary - getModule `thenM` \ this_mod -> - doptM Opt_NoImplicitPrelude `thenM` \ opt_no_prelude -> - let - all_imports = mk_prel_imports this_mod opt_no_prelude ++ imports - (source, ordinary) = partition is_source_import all_imports - is_source_import (L _ (ImportDecl _ is_boot _ _ _)) = is_boot - - get_imports = importsFromImportDecl this_mod - in - mappM get_imports ordinary `thenM` \ stuff1 -> - mappM get_imports source `thenM` \ stuff2 -> + this_mod <- getModule + ; opt_no_prelude <- doptM Opt_NoImplicitPrelude + ; let + all_imports = mk_prel_imports this_mod opt_no_prelude ++ imports + (source, ordinary) = partition is_source_import all_imports + is_source_import (L _ (ImportDecl _ is_boot _ _ _)) = is_boot + + get_imports = importsFromImportDecl this_mod + + ; stuff1 <- mappM get_imports ordinary + ; stuff2 <- mappM get_imports source -- COMBINE RESULTS - let + ; let (imp_gbl_envs, imp_avails) = unzip (stuff1 ++ stuff2) gbl_env :: GlobalRdrEnv gbl_env = foldr plusGlobalRdrEnv emptyGlobalRdrEnv imp_gbl_envs all_avails :: ImportAvails all_avails = foldr plusImportAvails emptyImportAvails imp_avails - in + -- ALL DONE - returnM (gbl_env, all_avails) + ; return (gbl_env, all_avails) } where -- NB: opt_NoImplicitPrelude is slightly different to import Prelude (); -- because the former doesn't even look at Prelude.hi for instance @@ -132,7 +132,7 @@ importsFromImportDecl :: Module importsFromImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot qual_only as_mod imp_details)) = - addSrcSpan loc $ + setSrcSpan loc $ -- If there's an error in loadInterface, (e.g. interface -- file not found) we get lots of spurious errors from 'filterImports' @@ -200,11 +200,14 @@ importsFromImportDecl this_mod (dependent_mods, dependent_pkgs) | isHomeModule imp_mod = -- Imported module is from the home package - -- Take its dependent modules and - -- (a) remove this_mod (might be there as a hi-boot) - -- (b) add imp_mod itself + -- Take its dependent modules and add imp_mod itself -- Take its dependent packages unchanged - ((imp_mod_name, want_boot) : filter not_self (dep_mods deps), dep_pkgs deps) + -- NB: (dep_mods deps) might include a hi-boot file for the module being + -- compiled, CM. Do *not* filter this out (as we used to), because when + -- we've finished dealing with the direct imports we want to know if any + -- of them depended on CM.hi-boot, in which case we should do the hi-boot + -- consistency check. See LoadIface.loadHiBootInterface + ((imp_mod_name, want_boot) : dep_mods deps, dep_pkgs deps) | otherwise = -- Imported module is from another package @@ -213,8 +216,6 @@ importsFromImportDecl this_mod ASSERT( not (mi_package iface `elem` dep_pkgs deps) ) ([], mi_package iface : dep_pkgs deps) - not_self (m, _) = m /= this_mod_name - import_all = case imp_details of Just (is_hiding, ls) -- Imports are spec'd explicitly | not is_hiding -> Just (not (null ls)) @@ -336,10 +337,10 @@ importsFromLocalDecls group avails' | implicit_prelude = filter not_built_in_syntax avails | otherwise = avails - not_built_in_syntax a = not (all isBuiltInSyntaxName (availNames a)) + not_built_in_syntax a = not (all isBuiltInSyntax (availNames a)) -- Only filter it if all the names of the avail are built-in -- In particular, lists have (:) which is not built in syntax - -- so we don't filter it out. [Sept 03: wrong: see isBuiltInSyntaxName] + -- so we don't filter it out. [Sept 03: wrong: see isBuiltInSyntax] avail_env = mkAvailEnv avails' imports = emptyImportAvails { @@ -728,8 +729,7 @@ check_occs ie occs names reportDeprecations :: TcGblEnv -> RnM () reportDeprecations tcg_env = ifOptM Opt_WarnDeprecations $ - do { hpt <- getHpt - ; eps <- getEps + do { (eps,hpt) <- getEpsAndHpt ; mapM_ (check hpt (eps_PIT eps)) all_gres } where used_names = findUses (tcg_dus tcg_env) emptyNameSet @@ -738,9 +738,9 @@ 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 - = addSrcSpan (is_loc imp_spec) $ + = setSrcSpan (is_loc imp_spec) $ addWarn (sep [ptext SLIT("Deprecated use of") <+> - text (occNameFlavour (nameOccName name)) <+> + occNameFlavour (nameOccName name) <+> quotes (ppr name), (parens imp_msg), (ppr deprec_txt) ]) @@ -765,7 +765,13 @@ lookupDeprec hpt pit n = case lookupIface 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 -> pprPanic "lookupDeprec" (ppr n) + Nothing + | isWiredInName n -> Nothing + -- We have not necessarily loaded the .hi file for a + -- wired-in name (yet), although we *could*. + -- And we never deprecate them + + | otherwise -> pprPanic "lookupDeprec" (ppr n) -- By now all the interfaces should have been loaded gre_is_used :: NameSet -> GlobalRdrElt -> Bool @@ -999,14 +1005,15 @@ exportClashErr global_env name1 name2 ie1 ie2 [] -> pprPanic "exportClashErr" (ppr name) addDupDeclErr :: [Name] -> TcRn () -addDupDeclErr (n:ns) - = addErrAt (srcLocSpan (nameSrcLoc n)) $ - vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr n), - nest 2 (ptext SLIT("other declarations at:")), - nest 4 (vcat (map ppr sorted_locs))] +addDupDeclErr names + = addErrAt big_loc $ + vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr name1), + ptext SLIT("Declared at:") <+> vcat (map ppr sorted_locs)] where - sorted_locs = sortLt occ'ed_before (map nameSrcLoc ns) - occ'ed_before a b = LT == compare a b + locs = map nameSrcLoc names + big_loc = foldr1 combineSrcSpans (map srcLocSpan locs) + name1 = head names + sorted_locs = sortLe (<=) (sortLe (<=) locs) dupExportWarn occ_name ie1 ie2 = hsep [quotes (ppr occ_name),