From: sewardj Date: Thu, 23 Mar 2000 12:22:05 +0000 (+0000) Subject: [project @ 2000-03-23 12:22:04 by sewardj] X-Git-Tag: Approximately_9120_patches~4919 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=1e5271f1d0fbe2f4391152bfedf9d4cbbae6b2bd;p=ghc-hetmet.git [project @ 2000-03-23 12:22:04 by sewardj] In interface files, don't forget to mention the names of modules imported via hi-boot files. This is needed so that Hugs can use the import decls in interface files to safely overestimate the dependency sets which it will encounter when linking object code. --- diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs index b6dba20..db04653 100644 --- a/ghc/compiler/main/MkIface.lhs +++ b/ghc/compiler/main/MkIface.lhs @@ -155,14 +155,16 @@ ifaceImports :: Handle -> VersionInfo Name -> IO () ifaceImports if_hdl import_usages = hPutCol if_hdl upp_uses (sortLt lt_imp_vers import_usages) where - upp_uses (m, mv, has_orphans, whats_imported) + upp_uses (m, mv, has_orphans, is_boot, whats_imported) = hsep [ptext SLIT("import"), pprModuleName m, - int mv, pp_orphan, + int mv, pp_orphan, pp_boot, upp_import_versions whats_imported ] <> semi where pp_orphan | has_orphans = ptext SLIT("!") | otherwise = empty + pp_boot | is_boot = ptext SLIT("@") + | otherwise = empty -- Importing the whole module is indicated by an empty list upp_import_versions Everything = empty @@ -678,7 +680,7 @@ lt_lexical :: NamedThing a => a -> a -> Bool lt_lexical a1 a2 = getName a1 `lt_name` getName a2 lt_imp_vers :: ImportVersion a -> ImportVersion a -> Bool -lt_imp_vers (m1,_,_,_) (m2,_,_,_) = m1 < m2 +lt_imp_vers (m1,_,_,_,_) (m2,_,_,_,_) = m1 < m2 sort_versions vs = sortLt lt_vers vs diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y index 82e2286..a151fe4 100644 --- a/ghc/compiler/rename/ParseIface.y +++ b/ghc/compiler/rename/ParseIface.y @@ -18,7 +18,8 @@ import IdInfo ( ArityInfo, exactArity, CprInfo(..), InlinePragInfo(..) import Lex import RnMonad ( ImportVersion, LocalVersion, ParsedIface(..), WhatsImported(..), - RdrNamePragma, ExportItem, RdrAvailInfo, GenAvailInfo(..), WhetherHasOrphans + RdrNamePragma, ExportItem, RdrAvailInfo, GenAvailInfo(..), + WhetherHasOrphans, IsBootInterface ) import Bag ( emptyBag, unitBag, snocBag ) import FiniteMap ( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap ) @@ -201,16 +202,21 @@ import_part : { [] } | import_part import_decl { $2 : $1 } import_decl :: { ImportVersion OccName } -import_decl : 'import' mod_fs INTEGER orphans whats_imported ';' - { (mkSysModuleFS $2, fromInteger $3, $4, $5) } +import_decl : 'import' mod_fs INTEGER orphans is_boot whats_imported ';' + { (mkSysModuleFS $2, fromInteger $3, $4, $5, $6) } -- import Foo 3 :: a 1 b 3 c 7 ; means import a,b,c from Foo -- import Foo 3 ; means import all of Foo - -- import Foo 3 ! :: ...stuff... ; the ! means that Foo contains orphans + -- import Foo 3 ! @ :: ...stuff... ; the ! means that Foo contains orphans + -- and @ that Foo is a boot interface orphans :: { WhetherHasOrphans } orphans : { False } | '!' { True } +is_boot :: { IsBootInterface } +is_boot : { False } + | '@' { True } + whats_imported :: { WhatsImported OccName } whats_imported : { Everything } | '::' name_version_pairs { Specifically $2 } diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs index 28c58f7..211b801 100644 --- a/ghc/compiler/rename/Rename.lhs +++ b/ghc/compiler/rename/Rename.lhs @@ -589,7 +589,7 @@ getRnStats :: [RenamedHsDecl] -> RnMG SDoc getRnStats imported_decls = getIfacesRn `thenRn` \ ifaces -> let - n_mods = length [() | (_, _, Just _) <- eltsFM (iImpModInfo ifaces)] + n_mods = length [() | (_, _, _, Just _) <- eltsFM (iImpModInfo ifaces)] decls_read = [decl | (_, avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces), -- Data, newtype, and class decls are in the decls_fm diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs index 569ef96..2715924 100644 --- a/ghc/compiler/rename/RnIfaces.lhs +++ b/ghc/compiler/rename/RnIfaces.lhs @@ -102,33 +102,35 @@ loadInterface doc_str mod_name from let mod_map = iImpModInfo ifaces mod_info = lookupFM mod_map mod_name - in_map = maybeToBool mod_info + below_me = case mod_info of + Nothing -> False + Just (_, _, is_boot, _) -> not is_boot in -- Issue a warning for a redundant {- SOURCE -} import -- It's redundant if the moduld is in the iImpModInfo at all, -- because we arrange to read all the ordinary imports before -- any of the {- SOURCE -} imports - warnCheckRn (not (in_map && case from of {ImportByUserSource -> True; other -> False})) + warnCheckRn (not (below_me && case from of {ImportByUserSource -> True; other -> False})) (warnRedundantSourceImport mod_name) `thenRn_` -- CHECK WHETHER WE HAVE IT ALREADY case mod_info of { - Just (_, _, Just (load_mod, _, _)) + Just (_, _, _, Just (load_mod, _)) -> -- We're read it already so don't re-read it returnRn (load_mod, ifaces) ; mod_map_result -> -- READ THE MODULE IN - findAndReadIface doc_str mod_name from in_map + findAndReadIface doc_str mod_name from below_me `thenRn` \ (hi_boot_read, read_result) -> case read_result of { Nothing -> -- Not found, so add an empty export env to the Ifaces map -- so that we don't look again let mod = mkVanillaModule mod_name - new_mod_map = addToFM mod_map mod_name (0, False, Just (mod, False, [])) + new_mod_map = addToFM mod_map mod_name (0, False, False, Just (mod, [])) new_ifaces = ifaces { iImpModInfo = new_mod_map } in setIfacesRn new_ifaces `thenRn_` @@ -168,7 +170,7 @@ loadInterface doc_str mod_name from -- Now add info about this module mod_map2 = addToFM mod_map1 mod_name mod_details - mod_details = (pi_mod iface, pi_orphan iface, Just (mod, hi_boot_read, concat avails_s)) + mod_details = (pi_mod iface, pi_orphan iface, hi_boot_read, Just (mod, concat avails_s)) new_ifaces = ifaces { iImpModInfo = mod_map2, iDecls = new_decls, @@ -187,16 +189,19 @@ addModDeps mod mod_deps new_deps = foldr add mod_deps new_deps where is_lib = isLibModule mod -- Don't record dependencies when importing a library module - add (imp_mod, version, has_orphans, _) deps + add (imp_mod, version, has_orphans, is_boot, _) deps | is_lib && not has_orphans = deps - | otherwise = addToFM_C combine deps imp_mod (version, has_orphans, Nothing) + | otherwise = addToFM_C combine deps imp_mod (version, has_orphans, is_boot, Nothing) -- Record dependencies for modules that are -- either are dependent via a non-library module -- or contain orphan rules or instance decls - -- Don't ditch a module that's already loaded!! - combine old@(_, _, Just _) new = old - combine old@(_, _, Nothing) new = new + -- Don't ditch a module that's already loaded + -- If it isn't loaded, and together the is_boot-ness + combine old@(_, _, _, Just _) new = old + combine old@(_, _, old_is_boot, Nothing) + new@(version, has_orphans, new_is_boot, _) + = (version, has_orphans, old_is_boot && new_is_boot, Nothing) loadExport :: ModuleName -> ExportItem -> RnM d [AvailInfo] loadExport this_mod (mod, entities) @@ -391,7 +396,7 @@ checkUpToDate mod_name checkModUsage [] = returnRn True -- Yes! Everything is up to date! -checkModUsage ((mod_name, old_mod_vers, _, Specifically []) : rest) +checkModUsage ((mod_name, old_mod_vers, _, _, Specifically []) : rest) -- If CurrentModule.hi contains -- import Foo :: ; -- then that simply records that Foo lies below CurrentModule in the @@ -400,11 +405,11 @@ checkModUsage ((mod_name, old_mod_vers, _, Specifically []) : rest) = traceRn (ptext SLIT("Nothing used from:") <+> ppr mod_name) `thenRn_` checkModUsage rest -- This one's ok, so check the rest -checkModUsage ((mod_name, old_mod_vers, _, whats_imported) : rest) +checkModUsage ((mod_name, old_mod_vers, _, _, whats_imported) : rest) = loadInterface doc_str mod_name ImportBySystem `thenRn` \ (mod, ifaces) -> let maybe_mod_vers = case lookupFM (iImpModInfo ifaces) mod_name of - Just (version, _, Just (_, _, _)) -> Just version + Just (version, _, _, Just (_, _)) -> Just version other -> Nothing in case maybe_mod_vers of { @@ -557,7 +562,7 @@ getInterfaceExports mod_name from -- anyway, but this does no harm.) returnRn (mod, []) - Just (_, _, Just (mod, _, avails)) -> returnRn (mod, avails) + Just (_, _, _, Just (mod, avails)) -> returnRn (mod, avails) where doc_str = sep [pprModuleName mod_name, ptext SLIT("is directly imported")] \end{code} @@ -577,7 +582,7 @@ getImportedInstDecls gates getIfacesRn `thenRn` \ ifaces -> let orphan_mods = - [mod | (mod, (_, True, Nothing)) <- fmToList (iImpModInfo ifaces)] + [mod | (mod, (_, True, _, Nothing)) <- fmToList (iImpModInfo ifaces)] in loadOrphanModules orphan_mods `thenRn_` @@ -754,9 +759,10 @@ getImportVersions this_mod (ExportEnv export_avails _ export_all_mods) -- whether something is a boot file along with the usage info for it, but -- I can't be bothered just now. - mk_version_info mod_name (version, has_orphans, contents) so_far + mk_version_info mod_name (version, has_orphans, is_boot, contents) so_far = let - go_for_it exports = (mod_name, version, has_orphans, exports) : so_far + go_for_it exports = (mod_name, version, has_orphans, is_boot, exports) + : so_far in case contents of Nothing -> -- We didn't even open the interface @@ -767,9 +773,8 @@ getImportVersions this_mod (ExportEnv export_avails _ export_all_mods) -- file but we must still propagate the dependeny info. go_for_it (Specifically []) - Just (mod, boot_import, _) -- We did open the interface - | boot_import -- Don't record any usage info for this module - || (is_lib_module && not has_orphans) + Just (mod, _) -- We did open the interface + | is_lib_module && not has_orphans -> so_far | is_lib_module -- Record the module but not detailed diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs index b07ec92..1d0f35f 100644 --- a/ghc/compiler/rename/RnMonad.lhs +++ b/ghc/compiler/rename/RnMonad.lhs @@ -259,7 +259,8 @@ type RdrAvailInfo = GenAvailInfo OccName type ExportItem = (ModuleName, [RdrAvailInfo]) type VersionInfo name = [ImportVersion name] -type ImportVersion name = (ModuleName, Version, WhetherHasOrphans, WhatsImported name) +type ImportVersion name = (ModuleName, Version, + WhetherHasOrphans, IsBootInterface, WhatsImported name) type WhetherHasOrphans = Bool -- An "orphan" is @@ -268,6 +269,8 @@ type WhetherHasOrphans = Bool -- * a transformation rule in a module other than the one defining -- the function in the head of the rule. +type IsBootInterface = Bool + data WhatsImported name = Everything | Specifically [LocalVersion name] -- List guaranteed non-empty @@ -342,7 +345,7 @@ data Ifaces = Ifaces { type GatedDecl = (NameSet, (Module, RdrNameHsDecl)) type ImportedModuleInfo - = FiniteMap ModuleName (Version, Bool, Maybe (Module, Bool, Avails)) + = FiniteMap ModuleName (Version, WhetherHasOrphans, IsBootInterface, Maybe (Module, Avails)) -- Suppose the domain element is module 'A' -- -- The first Bool is True if A contains