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

compiler/deSugar/Desugar.lhs

@@ -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 {	

compiler/iface/MkIface.lhs

@@ -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` []

compiler/typecheck/TcRnMonad.lhs

@@ -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,

compiler/typecheck/TcRnTypes.lhs

@@ -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,

compiler/typecheck/TcSMonad.lhs

@@ -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