Commit 61f93d46 authored by Simon Marlow's avatar Simon Marlow

Fix a recomp bug: make classes/datatypes depend directly on DFuns (#4469)

And remove the old mechanism of recording dfun uses separately,
because it didn't work.

This wiki page describes recompilation avoidance and fingerprinting.
I'll update it to describe the new method and what went wrong with the
old method:

http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
parent f3b7f240
......@@ -137,7 +137,7 @@ deSugar hsc_env
; endPass dflags CoreDesugar ds_binds ds_rules_for_imps
; used_names <- mkUsedNames tcg_env
; let used_names = mkUsedNames tcg_env
; deps <- mkDependencies tcg_env
; let mod_guts = ModGuts {
......
......@@ -153,7 +153,7 @@ mkIfaceTc hsc_env maybe_old_fingerprint mod_details
tcg_hpc = other_hpc_info
}
= do
used_names <- mkUsedNames tc_result
let used_names = mkUsedNames tc_result
deps <- mkDependencies tc_result
let hpc_info = emptyHpcInfo other_hpc_info
mkIface_ hsc_env maybe_old_fingerprint
......@@ -161,13 +161,8 @@ mkIfaceTc hsc_env maybe_old_fingerprint mod_details
fix_env warns hpc_info (imp_mods imports) mod_details
mkUsedNames :: TcGblEnv -> IO NameSet
mkUsedNames
TcGblEnv{ tcg_inst_uses = dfun_uses_var,
tcg_dus = dus
}
= do { dfun_uses <- readIORef dfun_uses_var -- What dfuns are used
; return (allUses dus `unionNameSets` dfun_uses) }
mkUsedNames :: TcGblEnv -> NameSet
mkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus
mkDependencies :: TcGblEnv -> IO Dependencies
mkDependencies
......@@ -515,7 +510,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
orphan_hash <- computeFingerprint dflags (mk_put_name local_env)
(map IfaceInstABI orph_insts, orph_rules, fam_insts)
(map ifDFun orph_insts, orph_rules, fam_insts)
-- the export list hash doesn't depend on the fingerprints of
-- the Names it mentions, only the Names themselves, hence putNameLiterally.
......@@ -630,8 +625,8 @@ The ABI of a declaration consists of:
Items (c)-(f) are not stored in the IfaceDecl, but instead appear
elsewhere in the interface file. But they are *fingerprinted* with
the Id itself. This is done by grouping (c)-(f) in IfaceDeclExtras,
and fingerprinting that as part of the Id.
the declaration itself. This is done by grouping (c)-(f) in IfaceDeclExtras,
and fingerprinting that as part of the declaration.
\begin{code}
type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
......@@ -657,10 +652,10 @@ freeNamesDeclABI (_mod, decl, extras) =
freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
freeNamesDeclExtras (IfaceIdExtras _ rules)
= unionManyNameSets (map freeNamesIfRule rules)
freeNamesDeclExtras (IfaceDataExtras _ _insts subs)
= unionManyNameSets (map freeNamesSub subs)
freeNamesDeclExtras (IfaceClassExtras _ _insts subs)
= unionManyNameSets (map freeNamesSub subs)
freeNamesDeclExtras (IfaceDataExtras _ insts subs)
= unionManyNameSets (mkNameSet insts : map freeNamesSub subs)
freeNamesDeclExtras (IfaceClassExtras _ insts subs)
= unionManyNameSets (mkNameSet insts : map freeNamesSub subs)
freeNamesDeclExtras (IfaceSynExtras _)
= emptyNameSet
freeNamesDeclExtras IfaceOtherDeclExtras
......@@ -713,11 +708,11 @@ declExtras fix_fn rule_env inst_env decl
(lookupOccEnvL rule_env n)
IfaceData{ifCons=cons} ->
IfaceDataExtras (fix_fn n)
(map IfaceInstABI $ lookupOccEnvL inst_env n)
(map ifDFun $ lookupOccEnvL inst_env n)
(map (id_extras . ifConOcc) (visibleIfConDecls cons))
IfaceClass{ifSigs=sigs} ->
IfaceClassExtras (fix_fn n)
(map IfaceInstABI $ lookupOccEnvL inst_env n)
(map ifDFun $ lookupOccEnvL inst_env n)
[id_extras op | IfaceClassOp op _ _ <- sigs]
IfaceSyn{} -> IfaceSynExtras (fix_fn n)
_other -> IfaceOtherDeclExtras
......@@ -726,19 +721,10 @@ declExtras fix_fn rule_env inst_env decl
id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
--
-- When hashing an instance, we hash only its structure, not the
-- fingerprints of the things it mentions. See the section on instances
-- in the commentary,
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
-- When hashing an instance, we hash only the DFunId, because that
-- depends on all the information about the instance.
--
newtype IfaceInstABI = IfaceInstABI IfaceInst
instance Binary IfaceInstABI where
get = panic "no get for IfaceInstABI"
put_ bh (IfaceInstABI inst) = do
let ud = getUserData bh
bh' = setUserData bh (ud{ ud_put_name = putNameLiterally })
put_ bh' inst
type IfaceInstABI = IfExtName
lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
lookupOccEnvL env k = lookupOccEnv env k `orElse` []
......
......@@ -71,8 +71,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this
= do { errs_var <- newIORef (emptyBag, emptyBag) ;
meta_var <- newIORef initTyVarUnique ;
tvs_var <- newIORef emptyVarSet ;
dfuns_var <- newIORef emptyNameSet ;
keep_var <- newIORef emptyNameSet ;
keep_var <- newIORef emptyNameSet ;
used_rdr_var <- newIORef Set.empty ;
th_var <- newIORef False ;
lie_var <- newIORef emptyBag ;
......@@ -97,8 +96,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this
tcg_type_env_var = type_env_var,
tcg_inst_env = emptyInstEnv,
tcg_fam_inst_env = emptyFamInstEnv,
tcg_inst_uses = dfuns_var,
tcg_th_used = th_var,
tcg_th_used = th_var,
tcg_exports = [],
tcg_imports = emptyImportAvails,
tcg_used_rdrnames = used_rdr_var,
......
......@@ -217,22 +217,13 @@ data TcGblEnv
--
-- * Top-level variables appearing free in a TH bracket
tcg_inst_uses :: TcRef NameSet,
-- ^ Home-package Dfuns actually used.
--
-- Used to generate version dependencies This records usages, rather
-- like tcg_dus, but it has to be a mutable variable so it can be
-- augmented when we look up an instance. These uses of dfuns are
-- rather like the free variables of the program, but are implicit
-- instead of explicit.
tcg_th_used :: TcRef Bool,
tcg_th_used :: TcRef Bool,
-- ^ @True@ <=> Template Haskell syntax used.
--
-- We need this so that we can generate a dependency on the Template
-- Haskell package, becuase the desugarer is going to emit loads of
-- references to TH symbols. It's rather like tcg_inst_uses; the
-- reference is implicit rather than explicit, so we have to zap a
-- We need this so that we can generate a dependency on the
-- Template Haskell package, becuase the desugarer is going
-- to emit loads of references to TH symbols. The reference
-- is implicit rather than explicit, so we have to zap a
-- mutable variable.
tcg_dfun_n :: TcRef OccSet,
......
......@@ -87,14 +87,11 @@ import InstEnv
import FamInst
import FamInstEnv
import NameSet ( addOneToNameSet )
import qualified TcRnMonad as TcM
import qualified TcMType as TcM
import qualified TcEnv as TcM
( checkWellStaged, topIdLvl, tcLookupFamInst, tcGetDefaultTys )
import TcType
import Module
import DynFlags
import Coercion
......@@ -952,8 +949,7 @@ matchClass clas tys
text "witness" <+> ppr dfun_id
<+> ppr (idType dfun_id) ])
-- Record that this dfun is needed
; record_dfun_usage dfun_id
; return $ MatchInstSingle (dfun_id, inst_tys)
; return $ MatchInstSingle (dfun_id, inst_tys)
} ;
(matches, unifs) -- More than one matches
-> do { traceTcS "matchClass multiple matches, deferring choice"
......@@ -964,26 +960,8 @@ matchClass clas tys
}
}
}
where record_dfun_usage :: Id -> TcS ()
record_dfun_usage dfun_id
= do { hsc_env <- getTopEnv
; let dfun_name = idName dfun_id
dfun_mod = ASSERT( isExternalName dfun_name )
nameModule dfun_name
; if isInternalName dfun_name || -- Internal name => defined in this module
modulePackageId dfun_mod /= thisPackage (hsc_dflags hsc_env)
then return () -- internal, or in another package
else do updInstUses dfun_id
}
updInstUses :: Id -> TcS ()
updInstUses dfun_id
= do { tcg_env <- getGblEnv
; wrapTcS $ TcM.updMutVar (tcg_inst_uses tcg_env)
(`addOneToNameSet` idName dfun_id)
}
matchFam :: TyCon
matchFam :: TyCon
-> [Type]
-> TcS (MatchInstResult (TyCon, [Type]))
matchFam tycon args
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment