Make tcg_dus behave more sanely; fixes a mkUsageInfo panic

The tcg_dus field used to contain *uses* of type and class decls,
but not *defs*.  That was inconsistent, and it really went wrong
for Template Haskell bracket.  What happened was that
 foo = [d| data A = A
       	   f :: A -> A
       	   f x = x |]
would find a "use" of A when processing the top level of the module,
which in turn led to a mkUsageInfo panic in MkIface.  The cause was
the fact that the tcg_dus for the nested quote didn't have defs for
A.

3 files changed, 38 insertions, 34 deletions

diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
index bf4257da40..874971148c 100644
--- a/compiler/rename/RnBinds.lhs
+++ b/compiler/rename/RnBinds.lhs
@@ -352,9 +352,9 @@ rnValBindsAndThen binds@(ValBindsIn _ sigs) thing_inside
 
 	; let
             -- The variables "used" in the val binds are: 
-            --   (1) the uses of the binds (duUses)
+            --   (1) the uses of the binds (allUses)
             --   (2) the FVs of the thing-inside
-            all_uses = duUses dus `plusFV` result_fvs
+            all_uses = allUses dus `plusFV` result_fvs
 		-- Note [Unused binding hack]
 		-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
 		-- Note that *in contrast* to the above reporting of
diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 490faec5d6..620b1fe9df 100644
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -618,8 +618,9 @@ rnBracket (DecBrL decls)
        	 	   	      setStage thRnBrack $
 			      rnSrcDecls group      
 
-       -- Discard the tcg_env; it contains only extra info about fixity
-	; return (DecBrG group', allUses (tcg_dus tcg_env)) }
+	      -- Discard the tcg_env; it contains only extra info about fixity
+        ; traceRn (text "rnBracket dec" <+> (ppr (tcg_dus tcg_env) $$ ppr (duUses (tcg_dus tcg_env))))
+	; return (DecBrG group', duUses (tcg_dus tcg_env)) }
 
 rnBracket (DecBrG _) = panic "rnBracket: unexpected DecBrG"
 \end{code}
@@ -994,8 +995,8 @@ rn_rec_stmt all_bndrs (L loc (LetStmt (HsValBinds binds'))) _ = do
   (binds', du_binds) <- 
       -- fixities and unused are handled above in rn_rec_stmts_and_then
       rnValBindsRHS (mkNameSet all_bndrs) binds'
-  return [(duDefs du_binds, duUses du_binds, 
-	    emptyNameSet, L loc (LetStmt (HsValBinds binds')))]
+  return [(duDefs du_binds, allUses du_binds, 
+	   emptyNameSet, L loc (LetStmt (HsValBinds binds')))]
 
 -- no RecStmt case becuase they get flattened above when doing the LHSes
 rn_rec_stmt _ stmt@(L _ (RecStmt {})) _
diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index 5d23110e5f..a152a18a07 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -86,17 +86,17 @@ Checks the @(..)@ etc constraints in the export list.
 -- does NOT assume that anything is in scope already
 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
 -- Rename a HsGroup; used for normal source files *and* hs-boot files
-rnSrcDecls group@(HsGroup {hs_valds  = val_decls,
-                                   hs_tyclds = tycl_decls,
-                                   hs_instds = inst_decls,
-                                   hs_derivds = deriv_decls,
-                                   hs_fixds  = fix_decls,
-                                   hs_warnds  = warn_decls,
-                                   hs_annds  = ann_decls,
-                                   hs_fords  = foreign_decls,
-                                   hs_defds  = default_decls,
-                                   hs_ruleds = rule_decls,
-                                   hs_docs   = docs })
+rnSrcDecls group@(HsGroup { hs_valds   = val_decls,
+                            hs_tyclds  = tycl_decls,
+                            hs_instds  = inst_decls,
+                            hs_derivds = deriv_decls,
+                            hs_fixds   = fix_decls,
+                            hs_warnds  = warn_decls,
+                            hs_annds   = ann_decls,
+                            hs_fords   = foreign_decls,
+                            hs_defds   = default_decls,
+                            hs_ruleds  = rule_decls,
+                            hs_docs    = docs })
  = do {
    -- (A) Process the fixity declarations, creating a mapping from
    --     FastStrings to FixItems.
@@ -178,30 +178,33 @@ rnSrcDecls group@(HsGroup {hs_valds  = val_decls,
    rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
 
    -- (I) Compute the results and return
-   let {rn_group = HsGroup { hs_valds  = rn_val_decls,
-			     hs_tyclds = rn_tycl_decls,
-			     hs_instds = rn_inst_decls,
+   let {rn_group = HsGroup { hs_valds  	= rn_val_decls,
+			     hs_tyclds 	= rn_tycl_decls,
+			     hs_instds 	= rn_inst_decls,
                              hs_derivds = rn_deriv_decls,
-			     hs_fixds  = rn_fix_decls,
-			     hs_warnds = [], -- warns are returned in the tcg_env
+			     hs_fixds   = rn_fix_decls,
+			     hs_warnds  = [], -- warns are returned in the tcg_env
 	                                     -- (see below) not in the HsGroup
 			     hs_fords  = rn_foreign_decls,
-			     hs_annds   = rn_ann_decls,
+			     hs_annds  = rn_ann_decls,
 			     hs_defds  = rn_default_decls,
 			     hs_ruleds = rn_rule_decls,
                              hs_docs   = rn_docs } ;
 
-	other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4, 
-			     src_fvs5, src_fvs6, src_fvs7] ;
-	src_dus = bind_dus `plusDU` usesOnly other_fvs;
-		-- Note: src_dus will contain *uses* for locally-defined types
-		-- and classes, but no *defs* for them.  (Because rnTyClDecl 
-		-- returns only the uses.)  This is a little 
-		-- surprising but it doesn't actually matter at all.
-
-       final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
-                       in -- we return the deprecs in the env, not in the HsGroup above
-                         tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };
+        tycl_bndrs = hsTyClDeclsBinders rn_tycl_decls rn_inst_decls ;
+        ford_bndrs = hsForeignDeclsBinders rn_foreign_decls ;
+	other_def  = (Just (mkNameSet tycl_bndrs `unionNameSets` mkNameSet ford_bndrs), emptyNameSet) ;
+        other_fvs  = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4, 
+			      src_fvs5, src_fvs6, src_fvs7] ;
+		-- It is tiresome to gather the binders from type and class decls
+
+	src_dus = [other_def] `plusDU` bind_dus `plusDU` usesOnly other_fvs ;
+		-- Instance decls may have occurrences of things bound in bind_dus
+		-- so we must put other_fvs last
+
+        final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
+                        in -- we return the deprecs in the env, not in the HsGroup above
+                        tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };
        } ;
 
    traceRn (text "finish rnSrc" <+> ppr rn_group) ;