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.
put_ bh (HasInfo i) = do
putByte bh 1
lazyPut bh i
- put_ bh DiscardedInfo = panic "BinIface:DiscardedInfo"
get bh = do
h <- getByte bh
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
------------------
instance Outputable IfaceIdInfo where
- ppr NoInfo = empty
- ppr DiscardedInfo = ptext SLIT("<discarded>")
- 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)]
\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
loadHomeInterface, loadInterface,
loadSrcInterface, loadOrphanModules,
readIface, -- Used when reading the module's old interface
- predInstGates, ifaceInstGates, ifaceStats,
+ predInstGates, ifaceInstGates, ifaceStats, discardDeclPrags,
initExternalPackageState
) where
-- 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",
-- 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
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]
-- 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
#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,
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,
; 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}
%************************************************************************
\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
projects / ghc-hetmet.git / commitdiff