X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnSource.lhs;h=9b04da051c4c6173ea4c9ff9a71c02a5be6d826a;hb=615d88d1912a81ca3bef44010285424f6c454449;hp=5d23110e5fc9bdfa624d4cb761fd83c32a61468e;hpb=302e2e29f2e1074bfba561e077a484dc4e1d15f6;p=ghc-hetmet.git

diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index 5d23110..9b04da0 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) ;
@@ -463,7 +466,7 @@ rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
 	-- The typechecker (not the renamer) checks that all 
 	-- the declarations are for the right class
     let
-	at_names = map (head . tyClDeclNames . unLoc) ats
+	at_names = map (head . hsTyClDeclBinders) ats
     in
     checkDupRdrNames at_names		`thenM_`
 	-- See notes with checkDupRdrNames for methods, above
@@ -1056,8 +1059,7 @@ extendRecordFieldEnv tycl_decls inst_decls
     all_data_cons = [con | L _ (TyData { tcdCons = cons }) <- all_tycl_decls
     		         , L _ con <- cons ]
     all_tycl_decls = at_tycl_decls ++ tycl_decls
-    at_tycl_decls = [at | L _ (InstDecl _ _ _ ats) <- inst_decls, at <- ats]
-    		      -- Do not forget associated types!
+    at_tycl_decls = instDeclATs inst_decls  -- Do not forget associated types!
 
     get_con (ConDecl { con_name = con, con_details = RecCon flds })
 	    (RecFields env fld_set)