From 2db3c4308e8d1ba14b502b9ccb9bee3fd3bd145e Mon Sep 17 00:00:00 2001 From: simonmar Date: Thu, 18 Jul 2002 09:16:13 +0000 Subject: [PATCH] [project @ 2002-07-18 09:16:12 by simonmar] Back off from including the interface file version in the module init label - we might not recompile modules which depend on the current one, even if its version changes. Thanks to Sigbjorn for pointing this out. We still include the way, however, so we'll still catch cases of linking modules compiled in different ways. --- ghc/compiler/absCSyn/CLabel.lhs | 20 ++++++++++++-------- ghc/compiler/codeGen/CodeGen.lhs | 18 ++++++++---------- ghc/compiler/compMan/CompManager.lhs | 2 +- ghc/compiler/main/HscMain.lhs | 14 ++++---------- ghc/compiler/main/HscTypes.lhs | 11 +++++------ 5 files changed, 30 insertions(+), 35 deletions(-) diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs index 92ead17..442dc01 100644 --- a/ghc/compiler/absCSyn/CLabel.lhs +++ b/ghc/compiler/absCSyn/CLabel.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CLabel.lhs,v 1.53 2002/07/16 14:56:09 simonmar Exp $ +% $Id: CLabel.lhs,v 1.54 2002/07/18 09:16:12 simonmar Exp $ % \section[CLabel]{@CLabel@: Information to make C Labels} @@ -127,8 +127,12 @@ data CLabel | ModuleInitLabel Module -- the module name - Version -- its version (same as the interface file ver) String -- its "way" + -- at some point we might want some kind of version number in + -- the module init label, to guard against compiling modules in + -- the wrong order. We can't use the interface file version however, + -- because we don't always recompile modules which depend on a module + -- whose version has changed. | PlainModuleInitLabel Module -- without the vesrion & way info @@ -313,7 +317,7 @@ needsCDecl (IdLabel _ _) = True needsCDecl (CaseLabel _ CaseReturnPt) = True needsCDecl (DataConLabel _ _) = True needsCDecl (TyConLabel _) = True -needsCDecl (ModuleInitLabel _ _ _) = True +needsCDecl (ModuleInitLabel _ _) = True needsCDecl (PlainModuleInitLabel _) = True needsCDecl (CaseLabel _ _) = False @@ -341,7 +345,7 @@ externallyVisibleCLabel (DataConLabel _ _) = True externallyVisibleCLabel (TyConLabel tc) = True externallyVisibleCLabel (CaseLabel _ _) = False externallyVisibleCLabel (AsmTempLabel _) = False -externallyVisibleCLabel (ModuleInitLabel _ _ _)= True +externallyVisibleCLabel (ModuleInitLabel _ _)= True externallyVisibleCLabel (PlainModuleInitLabel _)= True externallyVisibleCLabel (RtsLabel RtsModuleRegd) = False --hack externallyVisibleCLabel (RtsLabel _) = True @@ -364,7 +368,7 @@ labelType (CaseLabel _ CaseReturnInfo) = InfoTblType labelType (CaseLabel _ CaseReturnPt) = CodeType labelType (CaseLabel _ CaseVecTbl) = VecTblType labelType (TyConLabel _) = ClosureTblType -labelType (ModuleInitLabel _ _ _) = CodeType +labelType (ModuleInitLabel _ _) = CodeType labelType (PlainModuleInitLabel _) = CodeType labelType (IdLabel _ info) = @@ -399,7 +403,7 @@ labelDynamic lbl = DataConLabel n k -> isDllName n TyConLabel tc -> isDllName (getName tc) ForeignLabel _ d -> d - ModuleInitLabel m _ _ -> (not opt_Static) && (not (isHomeModule m)) + ModuleInitLabel m _ -> (not opt_Static) && (not (isHomeModule m)) PlainModuleInitLabel m -> (not opt_Static) && (not (isHomeModule m)) _ -> False \end{code} @@ -533,9 +537,9 @@ pprCLbl (DataConLabel con flavor) = ppr con <> ppConFlavor flavor pprCLbl (CC_Label cc) = ppr cc pprCLbl (CCS_Label ccs) = ppr ccs -pprCLbl (ModuleInitLabel mod ver way) +pprCLbl (ModuleInitLabel mod way) = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod)) - <> char '_' <> int ver <> char '_' <> text way + <> char '_' <> text way pprCLbl (PlainModuleInitLabel mod) = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod)) diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs index e7c53c1..a8ce811 100644 --- a/ghc/compiler/codeGen/CodeGen.lhs +++ b/ghc/compiler/codeGen/CodeGen.lhs @@ -63,15 +63,14 @@ import IOExts ( readIORef ) \begin{code} codeGen :: DynFlags -> Module -- Module name - -> Version -- Module version - -> [(Module,Version)] -- Import names & versions + -> [Module] -- Import names -> CollectedCCs -- (Local/global) cost-centres needing declaring/registering. -> [Id] -- foreign-exported binders -> [TyCon] -- Local tycons, including ones from classes -> [(StgBinding,[Id])] -- Bindings to convert, with SRTs -> IO AbstractC -- Output -codeGen dflags mod_name mod_ver imported_modules cost_centre_info fe_binders +codeGen dflags mod_name imported_modules cost_centre_info fe_binders tycons stg_binds = do showPass dflags "CodeGen" @@ -84,7 +83,7 @@ codeGen dflags mod_name mod_ver imported_modules cost_centre_info fe_binders datatype_stuff = genStaticConBits cinfo data_tycons code_stuff = initC cinfo (mapCs cgTopBinding stg_binds) - init_stuff = mkModuleInit fe_binders mod_name mod_ver way + init_stuff = mkModuleInit fe_binders mod_name way imported_modules cost_centre_info abstractC = mkAbstractCs [ maybeSplitCode, @@ -111,12 +110,11 @@ codeGen dflags mod_name mod_ver imported_modules cost_centre_info fe_binders mkModuleInit :: [Id] -- foreign exported functions -> Module -- module name - -> Version -- module version -> String -- the "way" - -> [(Module,Version)] -- import names & versions + -> [Module] -- import names -> CollectedCCs -- cost centre info -> AbstractC -mkModuleInit fe_binders mod ver way imps cost_centre_info +mkModuleInit fe_binders mod way imps cost_centre_info = let register_fes = map (\f -> CMacroStmt REGISTER_FOREIGN_EXPORT [f]) fe_labels @@ -127,10 +125,10 @@ mkModuleInit fe_binders mod ver way imps cost_centre_info (cc_decls, cc_regs) = mkCostCentreStuff cost_centre_info -- we don't want/need to init GHC.Prim, so filter it out - mk_import_register (imp,ver) + mk_import_register imp | imp == gHC_PRIM = AbsCNop | otherwise = CMacroStmt REGISTER_IMPORT [ - CLbl (mkModuleInitLabel imp ver way) AddrRep + CLbl (mkModuleInitLabel imp way) AddrRep ] register_imports = map mk_import_register imps @@ -138,7 +136,7 @@ mkModuleInit fe_binders mod ver way imps cost_centre_info mkAbstractCs [ cc_decls, CModuleInitBlock (mkPlainModuleInitLabel mod) - (mkModuleInitLabel mod ver way) + (mkModuleInitLabel mod way) (mkAbstractCs (register_fes ++ cc_regs : register_imports)) diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs index dc5a2db..449801c 100644 --- a/ghc/compiler/compMan/CompManager.lhs +++ b/ghc/compiler/compMan/CompManager.lhs @@ -73,7 +73,7 @@ import HscMain ( initPersistentCompilerState, hscThing, #else import HscMain ( initPersistentCompilerState ) #endif -import HscTypes +import HscTypes hiding ( moduleNameToModule ) import Name ( Name, NamedThing(..), nameRdrName, nameModule, isHomePackageName, isExternalName ) import NameEnv diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index 3ae4866..747a14a 100644 --- a/ghc/compiler/main/HscMain.lhs +++ b/ghc/compiler/main/HscMain.lhs @@ -46,6 +46,7 @@ import StringBuffer ( hGetStringBuffer, freeStringBuffer ) import Parser import Lex ( ParseResult(..), ExtFlags(..), mkPState ) import SrcLoc ( mkSrcLoc ) +import Finder ( findModule ) import Rename ( checkOldIface, renameModule, renameExtCore, closeIfaceDecls, RnResult(..) ) import Rules ( emptyRuleBase ) @@ -83,7 +84,6 @@ import OccName ( OccName ) import Name ( Name, nameModule, nameOccName, getName ) import NameEnv ( emptyNameEnv, mkNameEnv ) import Module ( Module ) -import BasicTypes ( Version ) import FastString import Maybes ( expectJust ) import Util ( seqList ) @@ -98,6 +98,7 @@ import IO import MkExternalCore ( emitExternalCore ) import ParserCore import ParserCoreUtils + \end{code} @@ -226,14 +227,12 @@ hscRecomp ghci_mode dflags have_object pcs_tc, ds_details, foreign_stuff) -> do { let { - imported_module_names :: [ModuleName]; imported_module_names = filter (/= gHC_PRIM_Name) $ map ideclName (hsModuleImports rdr_module); - imported_modules :: [(Module,Version)]; imported_modules = - map (getModuleAndVersion hit (pcs_PIT pcs_tc)) + map (moduleNameToModule hit (pcs_PIT pcs_tc)) imported_module_names; } @@ -387,18 +386,13 @@ hscRecomp ghci_mode dflags have_object final_iface <- _scc_ "MkFinalIface" mkFinalIface ghci_mode dflags location maybe_checked_iface new_iface tidy_details - - -- get this module's version - version <- return $! vers_module (mi_version final_iface) - if toNothing then do return (False, False, Nothing, final_iface) else do ------------------ Code generation ------------------ abstractC <- _scc_ "CodeGen" - codeGen dflags this_mod version - imported_modules + codeGen dflags this_mod imported_modules cost_centre_info fe_binders local_tycons stg_binds diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 4dcfaa9..045c17f 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -13,7 +13,7 @@ module HscTypes ( HomeSymbolTable, emptySymbolTable, PackageTypeEnv, HomeIfaceTable, PackageIfaceTable, emptyIfaceTable, - lookupIface, lookupIfaceByModName, getModuleAndVersion, + lookupIface, lookupIfaceByModName, moduleNameToModule, emptyModIface, InteractiveContext(..), @@ -302,11 +302,10 @@ lookupIfaceByModName hit pit mod -- Use instead of Finder.findModule if possible: this way doesn't -- require filesystem operations, and it is guaranteed not to fail -- when the IfaceTables are properly populated (i.e. after the renamer). -getModuleAndVersion :: HomeIfaceTable -> PackageIfaceTable -> ModuleName - -> (Module,Version) -getModuleAndVersion hit pit mod - = ((,) $! mi_module iface) $! vers_module (mi_version iface) - where iface = fromJust (lookupIfaceByModName hit pit mod) +moduleNameToModule :: HomeIfaceTable -> PackageIfaceTable -> ModuleName + -> Module +moduleNameToModule hit pit mod + = mi_module (fromJust (lookupIfaceByModName hit pit mod)) \end{code} -- 1.7.10.4