X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnHiFiles.lhs;h=e5fbb17898e4b1d636bccec3b1e71ad2ed004af5;hb=cbc2146f970905a626c4ef364f08b75965c8bf8e;hp=25706e3f2a28f508e3fdc0619a4a4dd6f4c0c80e;hpb=d45f529caa46cec03ca3c1c65232230add7eed61;p=ghc-hetmet.git diff --git a/ghc/compiler/rename/RnHiFiles.lhs b/ghc/compiler/rename/RnHiFiles.lhs index 25706e3..e5fbb17 100644 --- a/ghc/compiler/rename/RnHiFiles.lhs +++ b/ghc/compiler/rename/RnHiFiles.lhs @@ -14,14 +14,14 @@ module RnHiFiles ( #include "HsVersions.h" import DriverState ( v_GhcMode, isCompManagerMode ) -import DriverUtil ( splitFilename ) +import DriverUtil ( replaceFilenameSuffix ) import CmdLineOpts ( opt_IgnoreIfacePragmas ) import Parser ( parseIface ) import HscTypes ( ModIface(..), emptyModIface, - ExternalPackageState(..), - VersionInfo(..), ImportedModuleInfo, - lookupIfaceByModName, RdrExportItem, WhatsImported(..), - ImportVersion, WhetherHasOrphans, IsBootInterface, + ExternalPackageState(..), noDependencies, + VersionInfo(..), Usage(..), + lookupIfaceByModName, RdrExportItem, + IsBootInterface, DeclsMap, GatedDecl, IfaceInsts, IfaceRules, mkIfaceDecls, AvailInfo, GenAvailInfo(..), ParsedIface(..), IfaceDeprecs, Avails, availNames, availName, Deprecations(..) @@ -46,21 +46,23 @@ import NameEnv import NameSet import Id ( idName ) import MkId ( seqId ) -import Packages ( preludePackage ) +import Packages ( basePackage ) import Module ( Module, ModuleName, ModLocation(ml_hi_file), - moduleName, isHomeModule, mkVanillaModule, - extendModuleEnv + moduleName, isHomeModule, mkPackageModule, + extendModuleEnv, lookupModuleEnvByName ) import RdrName ( RdrName, mkRdrUnqual, rdrNameOcc, nameRdrName ) -import OccName ( OccName, mkWorkerOcc, mkClassTyConOcc, mkClassDataConOcc, - mkSuperDictSelOcc, mkGenOcc1, mkGenOcc2 ) +import OccName ( OccName, mkClassTyConOcc, mkClassDataConOcc, + mkSuperDictSelOcc, mkGenOcc1, mkGenOcc2, + mkDataConWrapperOcc, mkDataConWorkerOcc ) import TyCon ( DataConDetails(..) ) import SrcLoc ( noSrcLoc, mkSrcLoc ) import Maybes ( maybeToBool ) import StringBuffer ( hGetStringBuffer ) import FastString ( mkFastString ) import ErrUtils ( Message ) -import Finder ( findModule, findPackageModule ) +import Finder ( findModule, findPackageModule, + hiBootExt, hiBootVerExt ) import Lex import FiniteMap import ListSetOps ( minusList ) @@ -68,7 +70,6 @@ import Outputable import Bag import BinIface ( readBinIface ) import Panic -import Config import EXCEPTION as Exception import DATA_IOREF ( readIORef ) @@ -115,12 +116,11 @@ loadInterface :: SDoc -> ModuleName -> WhereFrom -> TcRn m ModIface -- But it's OK to fail; perhaps the module has changed, and that interface -- is no longer used. - -- tryLoadInterface guarantees to return with eps_mod_info m --> (..., True) - -- (If the load fails, we plug in a vanilla placeholder) loadInterface doc_str mod_name from - = getHpt `thenM` \ hpt -> - getModule `thenM` \ this_mod -> - getEps `thenM` \ eps@(EPS { eps_PIT = pit }) -> + = getHpt `thenM` \ hpt -> + getModule `thenM` \ this_mod -> + getImports `thenM` \ import_avails -> + getEps `thenM` \ eps@(EPS { eps_PIT = pit }) -> -- CHECK WHETHER WE HAVE IT ALREADY case lookupIfaceByModName hpt pit mod_name of { @@ -136,8 +136,8 @@ loadInterface doc_str mod_name from other -> let - mod_map = eps_imp_mods eps - mod_info = lookupFM mod_map mod_name + mod_map = imp_dep_mods import_avails + mod_info = lookupModuleEnvByName mod_map mod_name hi_boot_file = case (from, mod_info) of @@ -152,8 +152,8 @@ loadInterface doc_str mod_name from redundant_source_import = case (from, mod_info) of - (ImportByUser True, Just (_,False)) -> True - other -> False + (ImportByUser True, Just (_, False)) -> True + other -> False in -- Issue a warning for a redundant {- SOURCE -} import @@ -180,7 +180,7 @@ loadInterface doc_str mod_name from | otherwise -> let -- Not found, so add an empty export env to -- the EPS map so that we don't look again - fake_mod = mkVanillaModule mod_name + fake_mod = mkPackageModule mod_name fake_iface = emptyModIface fake_mod new_eps = eps { eps_PIT = extendModuleEnv pit fake_mod fake_iface } in @@ -225,29 +225,9 @@ loadInterface doc_str mod_name from vers_rules = rule_vers, vers_decls = decls_vers } - -- For an explicit user import, add to mod_map info about - -- the things the imported module depends on, extracted - -- from its usage info; and delete the module itself, which is now in the PIT - usages = pi_usages iface - mod_map1 = case from of - ImportByUser _ -> addModDeps mod is_loaded usages mod_map - other -> mod_map - mod_map2 = delFromFM mod_map1 mod_name - - -- mod_deps is a pruned version of usages that records only what - -- module imported, but nothing about versions. - -- This info is used when demand-linking the dependencies - mod_deps = [ (mod,orph,boot,NothingAtAll) | (mod,orph,boot,_) <- usages] - - this_mod_name = moduleName this_mod - is_loaded m = m == this_mod_name - || maybeToBool (lookupIfaceByModName hpt pit m) - -- We treat the currently-being-compiled module as 'loaded' because - -- even though it isn't yet in the HIT or PIT; otherwise it gets - -- put into iImpModInfo, and then spat out into its own interface - -- file as a dependency - -- Now add info about this module to the PIT + -- Even home modules loaded by this route (which only + -- happens in OneShot mode) are put in the PIT has_orphans = pi_orphan iface new_pit = extendModuleEnv pit mod mod_iface mod_iface = ModIface { mi_module = mod, mi_package = pi_pkg iface, @@ -255,8 +235,8 @@ loadInterface doc_str mod_name from mi_orphan = has_orphans, mi_boot = hi_boot_file, mi_exports = avails, mi_fixities = fix_env, mi_deprecs = deprec_env, - mi_usages = mod_deps, -- Used for demand-loading, - -- not for version info + mi_deps = pi_deps iface, + mi_usages = panic "No mi_usages in PIT", mi_decls = panic "No mi_decls in PIT", mi_globals = Nothing } @@ -264,47 +244,13 @@ loadInterface doc_str mod_name from new_eps = eps { eps_PIT = new_pit, eps_decls = new_decls, eps_insts = new_insts, - eps_rules = new_rules, - eps_imp_mods = mod_map2 } + eps_rules = new_rules } in setEps new_eps `thenM_` returnM mod_iface }} ----------------------------------------------------- --- Adding module dependencies from the --- import decls in the interface file ------------------------------------------------------ - -addModDeps :: Module - -> (ModuleName -> Bool) -- True for modules that are already loaded - -> [ImportVersion a] - -> ImportedModuleInfo -> ImportedModuleInfo --- (addModDeps M ivs deps) --- We are importing module M, and M.hi contains 'import' decls given by ivs -addModDeps mod is_loaded new_deps mod_deps - = foldr add mod_deps filtered_new_deps - where - -- Don't record dependencies when importing a module from another package - -- Except for its descendents which contain orphans, - -- and in that case, forget about the boot indicator - filtered_new_deps :: [(ModuleName, (WhetherHasOrphans, IsBootInterface))] - filtered_new_deps - | isHomeModule mod = [ (imp_mod, (has_orphans, is_boot)) - | (imp_mod, has_orphans, is_boot, _) <- new_deps, - not (is_loaded imp_mod) - ] - | otherwise = [ (imp_mod, (True, False)) - | (imp_mod, has_orphans, _, _) <- new_deps, - not (is_loaded imp_mod) && has_orphans - ] - add (imp_mod, dep) deps = addToFM_C combine deps imp_mod dep - - combine old@(old_has_orphans, old_is_boot) new@(new_has_orphans, new_is_boot) - | old_is_boot = new -- Record the best is_boot info - | otherwise = old - ------------------------------------------------------ -- Loading the export list ----------------------------------------------------- @@ -320,11 +266,11 @@ loadExport (mod, entities) returnM (mod, avails) where load_entity mod (Avail occ) - = newGlobalName mod occ `thenM` \ name -> + = newGlobalName2 mod occ `thenM` \ name -> returnM (Avail name) load_entity mod (AvailTC occ occs) - = newGlobalName mod occ `thenM` \ name -> - mappM (newGlobalName mod) occs `thenM` \ names -> + = newGlobalName2 mod occ `thenM` \ name -> + mappM (newGlobalName2 mod) occs `thenM` \ names -> returnM (AvailTC name names) @@ -354,7 +300,7 @@ loadDecl mod (version_map, decls_map) (version, decl) new_version_map = extendNameEnv version_map main_name version in - traceRn (text "Loading" <+> ppr full_avail) `thenM_` +-- traceRn (text "Loading" <+> ppr full_avail) `thenM_` returnM (new_version_map, new_decls_map) @@ -381,13 +327,14 @@ getSysBinders :: Module -> TyClDecl RdrName -> TcRn m [Name] -- on RdrNames, returning OccNames getSysBinders mod (ClassDecl {tcdName = cname, tcdCtxt = cxt, tcdLoc = loc}) - = sequenceM [new_sys_bndr mod n loc | n <- sys_occs] + = mapM (new_sys_bndr mod loc) sys_occs where -- C.f. TcClassDcl.tcClassDecl1 - sys_occs = tc_occ : data_occ : dw_occ : sc_sel_occs + sys_occs = tc_occ : data_occ : dwrap_occ : dwork_occ : sc_sel_occs cls_occ = rdrNameOcc cname data_occ = mkClassDataConOcc cls_occ - dw_occ = mkWorkerOcc data_occ + dwrap_occ = mkDataConWrapperOcc data_occ + dwork_occ = mkDataConWorkerOcc data_occ tc_occ = mkClassTyConOcc cls_occ sc_sel_occs = [mkSuperDictSelOcc n cls_occ | n <- [1..length cxt]] @@ -395,19 +342,21 @@ getSysBinders mod (TyData {tcdName = tc_name, tcdCons = DataCons cons, tcdGeneric = Just want_generic, tcdLoc = loc}) -- The 'Just' is because this is an interface-file decl -- so it will say whether to derive generic stuff for it or not - = sequenceM ([new_sys_bndr mod n loc | n <- gen_occs] ++ - map con_sys_occ cons) + = mapM (new_sys_bndr mod loc) (gen_occs ++ concatMap mk_con_occs cons) where + new = new_sys_bndr -- c.f. TcTyDecls.tcTyDecl tc_occ = rdrNameOcc tc_name gen_occs | want_generic = [mkGenOcc1 tc_occ, mkGenOcc2 tc_occ] | otherwise = [] - con_sys_occ (ConDecl name _ _ _ loc) - = new_sys_bndr mod (mkWorkerOcc (rdrNameOcc name)) loc + mk_con_occs (ConDecl name _ _ _ _) + = [mkDataConWrapperOcc con_occ, mkDataConWorkerOcc con_occ] + where + con_occ = rdrNameOcc name -- The "source name" getSysBinders mod decl = returnM [] -new_sys_bndr mod occ loc = newTopBinder mod (mkRdrUnqual occ) loc +new_sys_bndr mod loc occ = newTopBinder mod (mkRdrUnqual occ) loc ----------------------------------------------------- @@ -472,7 +421,7 @@ loadInstDecl mod insts decl@(InstDecl inst_ty _ _ _ _) -- (Note that we do let the inst decl in if it mentions -- no tycons at all. Hence the null free_ty_names.) in - traceRn ((text "Load instance for" <+> ppr inst_ty') $$ ppr free_tcs) `thenM_` +-- traceRn ((text "Load instance for" <+> ppr inst_ty') $$ ppr free_tcs) `thenM_` returnM ((gate_fn, (mod, decl)) `consBag` insts) @@ -511,7 +460,7 @@ loadDeprecs (Just (Right prs)) = foldlM loadDeprec emptyNameEnv prs `thenM` \ en returnM (DeprecSome env) loadDeprec deprec_env (n, txt) = lookupGlobalOccRn n `thenM` \ name -> - traceRn (text "Loaded deprecation(s) for" <+> ppr name <> colon <+> ppr txt) `thenM_` +-- traceRn (text "Loaded deprecation(s) for" <+> ppr name <> colon <+> ppr txt) `thenM_` returnM (extendNameEnv deprec_env name (name,txt)) \end{code} @@ -548,7 +497,7 @@ loadOldIface iface decls = mkIfaceDecls new_decls new_rules new_insts mod_iface = ModIface { mi_module = mod, mi_package = pi_pkg iface, - mi_version = version, + mi_version = version, mi_deps = pi_deps iface, mi_exports = avails, mi_usages = usages, mi_boot = False, mi_orphan = pi_orphan iface, mi_fixities = fix_env, mi_deprecs = deprec_env, @@ -584,17 +533,13 @@ loadHomeInsts :: [RdrNameInstDecl] loadHomeInsts insts = mappM rnInstDecl insts ------------------ -loadHomeUsage :: ImportVersion OccName - -> TcRn m (ImportVersion Name) -loadHomeUsage (mod_name, orphans, is_boot, whats_imported) - = rn_imps whats_imported `thenM` \ whats_imported' -> - returnM (mod_name, orphans, is_boot, whats_imported') +loadHomeUsage :: Usage OccName -> TcRn m (Usage Name) +loadHomeUsage usage + = mappM rn_imp (usg_entities usage) `thenM` \ entities' -> + returnM (usage { usg_entities = entities' }) where - rn_imps NothingAtAll = returnM NothingAtAll - rn_imps (Everything v) = returnM (Everything v) - rn_imps (Specifically mv ev items rv) = mappM rn_imp items `thenM` \ items' -> - returnM (Specifically mv ev items' rv) - rn_imp (occ,vers) = newGlobalName mod_name occ `thenM` \ name -> + mod_name = usg_name usage + rn_imp (occ,vers) = newGlobalName2 mod_name occ `thenM` \ name -> returnM (name,vers) \end{code} @@ -627,11 +572,12 @@ findAndReadIface doc_str mod_name hi_boot_file ioToTcRn (findHiFile mod_name hi_boot_file) `thenM` \ maybe_found -> case maybe_found of - Nothing -> + Left files -> traceRn (ptext SLIT("...not found")) `thenM_` - returnM (Left (noIfaceErr mod_name hi_boot_file)) + getDOpts `thenM` \ dflags -> + returnM (Left (noIfaceErr dflags mod_name hi_boot_file files)) - Just (wanted_mod, file_path) -> + Right (wanted_mod, file_path) -> traceRn (ptext SLIT("readIFace") <+> text file_path) `thenM_` readIface wanted_mod file_path hi_boot_file `thenM` \ read_result -> @@ -650,7 +596,8 @@ findAndReadIface doc_str mod_name hi_boot_file ppr mod_name <> semi], nest 4 (ptext SLIT("reason:") <+> doc_str)] -findHiFile :: ModuleName -> IsBootInterface -> IO (Maybe (Module, FilePath)) +findHiFile :: ModuleName -> IsBootInterface + -> IO (Either [FilePath] (Module, FilePath)) findHiFile mod_name hi_boot_file = do { -- In interactive or --make mode, we are *not allowed* to demand-load @@ -666,22 +613,22 @@ findHiFile mod_name hi_boot_file else findPackageModule mod_name ; case maybe_found of { - Nothing -> return Nothing ; + Left files -> return (Left files) ; - Just (mod,loc) -> do { + Right (mod,loc) -> do { -- Return the path to M.hi, M.hi-boot, or M.hi-boot-n as appropriate let { hi_path = ml_hi_file loc ; - (hi_base, _hi_suf) = splitFilename hi_path ; - hi_boot_path = hi_base ++ ".hi-boot" ; - hi_boot_ver_path = hi_base ++ ".hi-boot-" ++ cHscIfaceFileVersion } ; + hi_boot_path = replaceFilenameSuffix hi_path hiBootExt ; + hi_boot_ver_path = replaceFilenameSuffix hi_path hiBootVerExt + }; if not hi_boot_file then - return (Just (mod, hi_path)) + return (Right (mod, hi_path)) else do { hi_ver_exists <- doesFileExist hi_boot_ver_path ; - if hi_ver_exists then return (Just (mod, hi_boot_ver_path)) - else return (Just (mod, hi_boot_path)) + if hi_ver_exists then return (Right (mod, hi_boot_ver_path)) + else return (Right (mod, hi_boot_path)) }}}} \end{code} @@ -734,7 +681,8 @@ read_iface mod file_path is_hi_boot_file ghcPrimIface :: ParsedIface ghcPrimIface = ParsedIface { pi_mod = gHC_PRIM_Name, - pi_pkg = preludePackage, + pi_pkg = basePackage, + pi_deps = noDependencies, pi_vers = 1, pi_orphan = False, pi_usages = [], @@ -757,12 +705,6 @@ ghcPrimIface = ParsedIface { %********************************************************* \begin{code} -noIfaceErr mod_name boot_file - = ptext SLIT("Could not find interface file for") <+> quotes (ppr mod_name) - -- We used to print the search path, but we can't do that - -- now, because it's hidden inside the finder. - -- Maybe the finder should expose more functions. - badIfaceFile file err = vcat [ptext SLIT("Bad interface file:") <+> text file, nest 4 err]