Don't lift ATs out of classes and instances before tc

Wed Aug  9 15:31:08 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
  * Don't lift ATs out of classes and instances before tc

2 files changed, 14 insertions, 26 deletions

diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index 5083044a6f..e29c2fefe2 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -111,10 +111,8 @@ rnSrcDecls (HsGroup { hs_valds  = val_decls,
 	   <- mapFvRn (wrapLocFstM rnDefaultDecl) default_decls ;
 	
 	let {
-           rn_at_decls = concat 
-			   [ats | L _ (InstDecl _ _ _ ats) <- rn_inst_decls] ;
 	   rn_group = HsGroup { hs_valds  = rn_val_decls,
-			    	hs_tyclds = rn_tycl_decls ++ rn_at_decls,
+			    	hs_tyclds = rn_tycl_decls,
 			    	hs_instds = rn_inst_decls,
 			    	hs_fixds  = rn_fix_decls,
 			    	hs_depds  = [],
@@ -284,10 +282,9 @@ rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
     let
 	at_doc   = text "In the associated types in an instance declaration"
 	at_names = map (head . tyClDeclNames . unLoc) ats
-	(_, rdrCtxt, _, _) = splitHsInstDeclTy (unLoc inst_ty)
     in
     checkDupNames at_doc at_names		`thenM_`
-    rnATDefs rdrCtxt ats			`thenM` \ (ats', at_fvs) ->
+    rnATInsts ats				`thenM` \ (ats', at_fvs) ->
 
 	-- Rename the bindings
 	-- The typechecker (not the renamer) checks that all 
@@ -333,30 +330,26 @@ rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
 	     --     to remove the context).
 \end{code}
 
-Renaming of the associated type definitions in instances.  
+Renaming of the associated types in instances.  
 
-* In the case of associated data and newtype definitions we add the instance
-  context.
 * We raise an error if we encounter a kind signature in an instance.
 
 \begin{code}
-rnATDefs :: HsContext RdrName -> [LTyClDecl RdrName] 
-	  -> RnM ([LTyClDecl Name], FreeVars)
-rnATDefs ctxt atDecls = 
-  mapFvRn (wrapLocFstM rnAtDef) atDecls
+rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
+rnATInsts atDecls = 
+  mapFvRn (wrapLocFstM rnATInst) atDecls
   where
-    rnAtDef tydecl@TyFunction {}                 = 
+    rnATInst tydecl@TyFunction {} = 
       do
         addErr noKindSig
 	rnTyClDecl tydecl
-    rnAtDef tydecl@TySynonym  {}                 = rnTyClDecl tydecl
-    rnAtDef tydecl@TyData {tcdCtxt = L l tyCtxt} = 
+    rnATInst tydecl@TySynonym  {} = rnTyClDecl tydecl
+    rnATInst tydecl@TyData     {} = 
       do
         checkM (not . isKindSigDecl $ tydecl) $ addErr noKindSig
-        rnTyClDecl (tydecl {tcdCtxt = L l (ctxt ++ tyCtxt)})
-          -- The source loc is somewhat half hearted... -=chak
-    rnAtDef _ =
-      panic "RnSource.rnATDefs: not a type declaration"
+        rnTyClDecl tydecl
+    rnATInst _                    =
+      panic "RnSource.rnATInsts: not a type declaration"
 
 noKindSig = text "Instances cannot have kind signatures"
 \end{code}
diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index 1e61c399c7..a41ccbe5e3 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -127,13 +127,8 @@ tcTyAndClassDecls boot_details decls
 	; traceTc (text "tcTyAndCl" <+> ppr mod)
 	; (syn_tycons, alg_tyclss) <- fixM (\ ~(rec_syn_tycons, rec_alg_tyclss) ->
 	  do	{ let {	-- Calculate variances and rec-flag
-		      ; (syn_decls, alg_decls_pre) = partition (isSynDecl . unLoc) decls
-                      ; alg_decls = alg_decls_pre ++ 
-				    concat [tcdATs decl        -- add AT decls
-					   | declLoc <- alg_decls_pre
-					   , let decl = unLoc declLoc
-					   , isClassDecl decl] }
-
+		      ; (syn_decls, alg_decls) = partition (isSynDecl . unLoc)
+						   decls }
 			-- Extend the global env with the knot-tied results
 			-- for data types and classes
 			--