From fb30abb2778cc0f3b07581b32d9cba0104937fa5 Mon Sep 17 00:00:00 2001 From: simonpj Date: Fri, 2 Apr 2004 13:19:28 +0000 Subject: [PATCH] [project @ 2004-04-02 13:19:28 by simonpj] Get rid of DiscardedInfo, and fix a Ghci bug at the same time. The new story is this: - We always read the whole interface file, as it exists on disk, not dropping pragmas or anything. - We compare that from-the-disk copy with the new version before writing the new interface file. - We drop the pragmas a) Before loading the interface payload into the declaration pools b) In the no-need-to-recompile case, before typechecking the interface decls. Omitting this was the previous bug. --- ghc/compiler/iface/BinIface.hs | 1 - ghc/compiler/iface/IfaceSyn.lhs | 30 ++++++++++------------------ ghc/compiler/iface/LoadIface.lhs | 41 +++++++++++++++++++------------------- ghc/compiler/iface/TcIface.lhs | 35 ++++++++++++++++++++------------ 4 files changed, 53 insertions(+), 54 deletions(-) diff --git a/ghc/compiler/iface/BinIface.hs b/ghc/compiler/iface/BinIface.hs index f5294d9..1040c2e 100644 --- a/ghc/compiler/iface/BinIface.hs +++ b/ghc/compiler/iface/BinIface.hs @@ -795,7 +795,6 @@ instance Binary IfaceIdInfo where put_ bh (HasInfo i) = do putByte bh 1 lazyPut bh i - put_ bh DiscardedInfo = panic "BinIface:DiscardedInfo" get bh = do h <- getByte bh diff --git a/ghc/compiler/iface/IfaceSyn.lhs b/ghc/compiler/iface/IfaceSyn.lhs index 917b8b9..10889e6 100644 --- a/ghc/compiler/iface/IfaceSyn.lhs +++ b/ghc/compiler/iface/IfaceSyn.lhs @@ -169,24 +169,16 @@ data IfaceRule data IfaceIdInfo = NoInfo -- When writing interface file without -O | HasInfo [IfaceInfoItem] -- Has info, and here it is - | DiscardedInfo -- HasInfo in the .hi file, but discarded - -- when it was read in --- Here's why we need this NoInfo/DiscardedInfo stuff + +-- Here's a tricky case: -- * Compile with -O module A, and B which imports A.f -- * Change function f in A, and recompile without -O --- * If we read in A.hi and discard IdInfo, the --- new (empty) IdInfo for f looks like the --- old (discarded) IdInfo for f --- => no new version # for f --- * But that might mean that we fail to recompile B, when --- actually we should --- --- * We also want to ensure that if A.hi was *already* compiled --- without -O we *don't* then recompile B --- --- When we discard IdInfo on *reading* we make it into DiscardedInfo --- On *writing* we make it NoInfo --- DiscardedInfo is never written into a file +-- * When we read in old A.hi we read in its IdInfo (as a thunk) +-- (In earlier GHCs we used to drop IdInfo immediately on reading, +-- but we do not do that now. Instead it's discarded when the +-- ModIface is read into the various decl pools.) +-- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *) +-- and so gives a new version. data IfaceInfoItem = HsArity Arity @@ -397,9 +389,8 @@ instance Outputable IfaceConAlt where ------------------ instance Outputable IfaceIdInfo where - ppr NoInfo = empty - ppr DiscardedInfo = ptext SLIT("") - ppr (HasInfo is) = ptext SLIT("{-") <+> fsep (map ppr_hs_info is) <+> ptext SLIT("-}") + ppr NoInfo = empty + ppr (HasInfo is) = ptext SLIT("{-") <+> fsep (map ppr_hs_info is) <+> ptext SLIT("-}") ppr_hs_info (HsUnfold prag unf) = sep [ptext SLIT("Unfolding: ") <> ppr prag, parens (pprIfaceExpr noParens unf)] @@ -806,7 +797,6 @@ eq_cls_sig env (IfaceClassOp n1 dm1 ty1) (IfaceClassOp n2 dm2 ty2) \begin{code} ----------------- eqIfIdInfo NoInfo NoInfo = Equal -eqIfIdInfo DiscardedInfo DiscardedInfo = Equal -- Should not happen? eqIfIdInfo (HasInfo is1) (HasInfo is2) = eqListBy eq_item is1 is2 eqIfIdInfo i1 i2 = NotEqual diff --git a/ghc/compiler/iface/LoadIface.lhs b/ghc/compiler/iface/LoadIface.lhs index bf5f694..0e4b441 100644 --- a/ghc/compiler/iface/LoadIface.lhs +++ b/ghc/compiler/iface/LoadIface.lhs @@ -8,7 +8,7 @@ module LoadIface ( loadHomeInterface, loadInterface, loadSrcInterface, loadOrphanModules, readIface, -- Used when reading the module's old interface - predInstGates, ifaceInstGates, ifaceStats, + predInstGates, ifaceInstGates, ifaceStats, discardDeclPrags, initExternalPackageState ) where @@ -227,9 +227,10 @@ loadInterface doc_str mod_name from -- If we do loadExport first the wrong info gets into the cache (unless we -- explicitly tag each export which seems a bit of a bore) - { new_eps_decls <- loadDecls mod (eps_decls eps) (mi_decls iface) - ; new_eps_insts <- loadInsts mod (eps_insts eps) (mi_insts iface) - ; new_eps_rules <- loadRules mod (eps_rules eps) (mi_rules iface) + { ignore_prags <- doptM Opt_IgnoreInterfacePragmas + ; new_eps_decls <- loadDecls ignore_prags mod (eps_decls eps) (mi_decls iface) + ; new_eps_rules <- loadRules ignore_prags mod (eps_rules eps) (mi_rules iface) + ; new_eps_insts <- loadInsts mod (eps_insts eps) (mi_insts iface) ; let { final_iface = iface { mi_decls = panic "No mi_decls in PIT", mi_insts = panic "No mi_insts in PIT", @@ -252,17 +253,17 @@ loadInterface doc_str mod_name from -- the declaration itself, will find the fully-glorious Name ----------------------------------------------------- -loadDecls :: Module -> DeclPool +loadDecls :: Bool -- Don't load pragmas into the decl pool + -> Module -> DeclPool -> [(Version, IfaceDecl)] -> IfM lcl DeclPool -loadDecls mod (Pool decls_map n_in n_out) decls - = do { ignore_prags <- doptM Opt_IgnoreInterfacePragmas - ; decls_map' <- foldlM (loadDecl ignore_prags mod) decls_map decls +loadDecls ignore_prags mod (Pool decls_map n_in n_out) decls + = do { decls_map' <- foldlM (loadDecl ignore_prags mod) decls_map decls ; returnM (Pool decls_map' (n_in + length decls) n_out) } loadDecl ignore_prags mod decls_map (_version, decl) = do { main_name <- mk_new_bndr Nothing (ifName decl) - ; let decl' | ignore_prags = zapIdInfo decl + ; let decl' | ignore_prags = discardDeclPrags decl | otherwise = decl -- Populate the name cache with final versions of all the subordinate names @@ -280,9 +281,10 @@ loadDecl ignore_prags mod decls_map (_version, decl) mk_new_bndr mb_parent occ = newGlobalBinder mod occ mb_parent loc loc = importedSrcLoc (moduleUserString mod) -zapIdInfo decl@(IfaceId {ifIdInfo = HasInfo _}) = decl { ifIdInfo = DiscardedInfo } -zapIdInfo decl = decl - -- Don't alter "NoInfo", just "HasInfo" +discardDeclPrags :: IfaceDecl -> IfaceDecl +discardDeclPrags decl@(IfaceId {ifIdInfo = HasInfo _}) = decl { ifIdInfo = NoInfo } +discardDeclPrags decl = decl + ----------------- ifaceDeclSubBndrs :: IfaceDecl -> [OccName] @@ -359,14 +361,13 @@ loadInstDecl mod pool decl@(IfaceInst {ifInstHead = inst_ty}) -- Loading Rules ----------------------------------------------------- -loadRules :: Module -> RulePool -> [IfaceRule] -> IfL RulePool -loadRules mod pool@(Pool rule_pool n_in n_out) rules - = do { ignore_prags <- doptM Opt_IgnoreInterfacePragmas - ; if ignore_prags then - returnM pool - else do - { new_pool <- foldlM (loadRule (moduleName mod)) rule_pool rules - ; returnM (Pool new_pool (n_in + length rules) n_out) } } +loadRules :: Bool -- Don't load pragmas into the decl pool + -> Module -> RulePool -> [IfaceRule] -> IfL RulePool +loadRules ignore_prags mod pool@(Pool rule_pool n_in n_out) rules + | ignore_prags = returnM pool + | otherwise + = do { new_pool <- foldlM (loadRule (moduleName mod)) rule_pool rules + ; returnM (Pool new_pool (n_in + length rules) n_out) } loadRule :: ModuleName -> RulePoolContents -> IfaceRule -> IfL RulePoolContents -- "Gate" the rule simply by a crude notion of the free vars of diff --git a/ghc/compiler/iface/TcIface.lhs b/ghc/compiler/iface/TcIface.lhs index 1f9b0ed..680f11b 100644 --- a/ghc/compiler/iface/TcIface.lhs +++ b/ghc/compiler/iface/TcIface.lhs @@ -12,7 +12,7 @@ module TcIface ( #include "HsVersions.h" import IfaceSyn -import LoadIface ( loadHomeInterface, predInstGates ) +import LoadIface ( loadHomeInterface, predInstGates, discardDeclPrags ) import IfaceEnv ( lookupIfaceTop, newGlobalBinder, lookupOrig, extendIfaceIdEnv, extendIfaceTyVarEnv, newIPName, tcIfaceTyVar, tcIfaceTyCon, tcIfaceClass, tcIfaceExtId, @@ -246,11 +246,23 @@ and even if they were, the type decls might be mutually recursive. typecheckIface :: HscEnv -> ModIface -- Get the decls from here -> IO ModDetails -typecheckIface hsc_env iface@(ModIface { mi_module = mod, mi_decls = ver_decls, - mi_rules = rules, mi_insts = dfuns }) +typecheckIface hsc_env iface = initIfaceTc hsc_env iface $ \ tc_env_var -> do - { -- Typecheck the decls - names <- mappM (lookupOrig (moduleName mod) . ifName) decls + { -- Get the right set of decls and rules. If we are compiling without -O + -- we discard pragmas before typechecking, so that we don't "see" + -- information that we shouldn't. From a versioning point of view + -- It's not actually *wrong* to do so, but in fact GHCi is unable + -- to handle unboxed tuples, so it must not see unfoldings. + ignore_prags <- doptM Opt_IgnoreInterfacePragmas + ; let { decls | ignore_prags = map (discardDeclPrags . snd) (mi_decls iface) + | otherwise = map snd (mi_decls iface) + ; rules | ignore_prags = [] + | otherwise = mi_rules iface + ; dfuns = mi_insts iface + ; mod_name = moduleName (mi_module iface) + } + -- Typecheck the decls + ; names <- mappM (lookupOrig mod_name . ifName) decls ; ty_things <- fixM (\ rec_ty_things -> do { writeMutVar tc_env_var (mkNameEnv (names `zipLazy` rec_ty_things)) -- This only makes available the "main" things, @@ -266,14 +278,12 @@ typecheckIface hsc_env iface@(ModIface { mi_module = mod, mi_decls = ver_decls, ; writeMutVar tc_env_var type_env -- Now do those rules and instances - ; dfuns <- mapM tcIfaceInst (mi_insts iface) - ; rules <- mapM tcIfaceRule (mi_rules iface) + ; dfuns <- mapM tcIfaceInst dfuns + ; rules <- mapM tcIfaceRule rules -- Finished ; return (ModDetails { md_types = type_env, md_insts = dfuns, md_rules = rules }) } - where - decls = map snd ver_decls \end{code} @@ -842,10 +852,9 @@ do_one mod (IfaceRec pairs) thing_inside %************************************************************************ \begin{code} -tcIdInfo name ty NoInfo = return vanillaIdInfo -tcIdInfo name ty DiscardedInfo = return vanillaIdInfo -tcIdInfo name ty (HasInfo iface_info) - = foldlM tcPrag init_info iface_info +tcIdInfo :: Name -> Type -> IfaceIdInfo -> IfL IdInfo +tcIdInfo name ty NoInfo = return vanillaIdInfo +tcIdInfo name ty (HasInfo info) = foldlM tcPrag init_info info where -- Set the CgInfo to something sensible but uninformative before -- we start; default assumption is that it has CAFs -- 1.7.10.4