X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcClassDcl.lhs;h=13b6300d4a945b5817012cee9951b283e92cf9e9;hb=bd8a952b1ec55c1c8fe6db968f8f0cc08596a550;hp=2f7f6bc3f41ae92776570c8a90cb99a97608fb7e;hpb=786932468faac49aafe20b65eabc8bdf465fbc9d;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcClassDcl.lhs b/compiler/typecheck/TcClassDcl.lhs
index 2f7f6bc..13b6300 100644
--- a/compiler/typecheck/TcClassDcl.lhs
+++ b/compiler/typecheck/TcClassDcl.lhs
@@ -149,12 +149,12 @@ tcClassSig _ s = pprPanic "tcClassSig" (ppr s)
 
 \begin{code}
 tcClassDecl2 :: LTyClDecl Name		-- The class declaration
-	     -> TcM ([Id], LHsBinds Id)
+	     -> TcM (LHsBinds Id)
 
 tcClassDecl2 (L loc (ClassDecl {tcdLName = class_name, tcdSigs = sigs, 
 				tcdMeths = default_binds}))
-  = recoverM (return ([], emptyLHsBinds))	$
-    setSrcSpan loc		   		$
+  = recoverM (return emptyLHsBinds)	$
+    setSrcSpan loc		   	$
     do  { clas <- tcLookupLocatedClass class_name
 
 	-- We make a separate binding for each default method.
@@ -179,17 +179,16 @@ tcClassDecl2 (L loc (ClassDecl {tcdLName = class_name, tcdSigs = sigs,
 				this_dict default_binds
 	      			sig_fn prag_fn
 
-	; dm_stuff <- tcExtendTyVarEnv clas_tyvars $
+	; dm_binds <- tcExtendTyVarEnv clas_tyvars $
                       mapM tc_dm op_items
-        ; let (dm_ids, defm_binds) = unzip (catMaybes dm_stuff)
 
-	; return (dm_ids, listToBag defm_binds) }
+	; return (listToBag (catMaybes dm_binds)) }
 
 tcClassDecl2 d = pprPanic "tcClassDecl2" (ppr d)
     
 tcDefMeth :: Class -> [TyVar] -> Inst -> LHsBinds Name
           -> TcSigFun -> TcPragFun -> ClassOpItem
-          -> TcM (Maybe (Id, LHsBind Id))
+          -> TcM (Maybe (LHsBind Id))
 -- Generate code for polymorphic default methods only (hence DefMeth)
 -- (Generic default methods have turned into instance decls by now.)
 -- This is incompatible with Hugs, which expects a polymorphic 
@@ -213,9 +212,8 @@ tcDefMeth clas tyvars this_dict binds_in sig_fn prag_fn (sel_id, dm_info)
 			  `orElse` pprPanic "tcDefMeth" (ppr sel_id)
 		-- dm_info = DefMeth dm_name only if there is a binding in binds_in
 
-	      dm_sig_fn  _ = sig_fn sel_name
-	      dm_ty = idType sel_id
-	      dm_id = mkDefaultMethodId dm_name dm_ty
+	      dm_sig_fn  _  = sig_fn sel_name
+	      dm_id         = mkDefaultMethodId sel_id dm_name
 	      local_dm_type = instantiateMethod clas sel_id (mkTyVarTys tyvars)
 	      local_dm_id   = mkLocalId local_dm_name local_dm_type
 
@@ -237,7 +235,7 @@ tcDefMeth clas tyvars this_dict binds_in sig_fn prag_fn (sel_id, dm_info)
 tcInstanceMethodBody :: InstLoc -> [TcTyVar] -> [Inst]
 		     -> ([Inst], LHsBinds Id) -> Id -> Id
           	     -> TcSigFun -> TcSpecPrags -> LHsBind Name 
-          	     -> TcM (Id, LHsBind Id)
+          	     -> TcM (LHsBind Id)
 tcInstanceMethodBody inst_loc tyvars dfun_dicts
 		     (this_dict, this_bind) meth_id local_meth_id
 		     meth_sig_fn spec_prags bind@(L loc _)
@@ -264,7 +262,7 @@ tcInstanceMethodBody inst_loc tyvars dfun_dicts
 
 	      dfun_lam_vars = map instToVar dfun_dicts	-- Includes equalities
 
-        ; return (meth_id, L loc full_bind) } 
+        ; return (L loc full_bind) } 
   where
     no_prag_fn  _ = []		-- No pragmas for local_meth_id; 
     		    		-- they are all for meth_id