diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index f91ccdf43d6d7693c96a72fc45979f81a50d4e95..ba1b011e82f5d36155380804230a2da469a33335 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -1365,17 +1365,10 @@ checkValidClass cls
 
         -- Check the associated type defaults are well-formed and instantiated
         -- See Note [Checking consistent instantiation]
-        ; mapM_ check_at_defs at_stuff
-
-  	-- Check that if the class has generic methods, then the
-	-- class has only one parameter.  We can't do generic
-	-- multi-parameter type classes!
-	; checkTc (unary || no_generics) (genericMultiParamErr cls)
-	}
+        ; mapM_ check_at_defs at_stuff	}
   where
     (tyvars, fundeps, theta, _, at_stuff, op_stuff) = classExtraBigSig cls
-    unary 	= isSingleton (snd (splitKiTyVars tyvars))  -- IA0_NOTE: only count type arguments
-    no_generics = null [() | (_, (GenDefMeth _)) <- op_stuff]
+    unary = isSingleton (snd (splitKiTyVars tyvars))  -- IA0_NOTE: only count type arguments
 
     check_op constrained_class_methods (sel_id, dm) 
       = addErrCtxt (classOpCtxt sel_id tau) $ do
@@ -1700,11 +1693,6 @@ noClassTyVarErr clas op
 	 ptext (sLit "mentions none of the type variables of the class") <+> 
 		ppr clas <+> hsep (map ppr (classTyVars clas))]
 
-genericMultiParamErr :: Class -> SDoc
-genericMultiParamErr clas
-  = ptext (sLit "The multi-parameter class") <+> quotes (ppr clas) <+> 
-    ptext (sLit "cannot have generic methods")
-
 recSynErr :: [LTyClDecl Name] -> TcRn ()
 recSynErr syn_decls
   = setSrcSpan (getLoc (head sorted_decls)) $