From: simonpj <unknown>
Date: Fri, 24 Aug 2001 07:58:29 +0000 (+0000)
Subject: [project @ 2001-08-24 07:58:29 by simonpj]
X-Git-Tag: Approximately_9120_patches~1086
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=17985eb4007ae2415a97335b26fabc82fc38521f;hp=c57d9ab39c887454a365a3e552a7fa6006a773dd;p=ghc-hetmet.git

[project @ 2001-08-24 07:58:29 by simonpj]
Improve error message for nullary class
---

diff --git a/ghc/compiler/typecheck/TcClassDcl.lhs b/ghc/compiler/typecheck/TcClassDcl.lhs
index ff99a46..97e5d5b 100644
--- a/ghc/compiler/typecheck/TcClassDcl.lhs
+++ b/ghc/compiler/typecheck/TcClassDcl.lhs
@@ -261,8 +261,8 @@ checkValidClass cls
     doptsTc Opt_GlasgowExts				`thenTc` \ gla_exts ->
 
     	-- Check that the class is unary, unless GlaExs
-    checkTc (gla_exts || unary)
-	    (classArityErr cls)				`thenTc_`
+    checkTc (arity > 0)		(nullaryClassErr cls)	`thenTc_`
+    checkTc (gla_exts || unary) (classArityErr cls)	`thenTc_`
 
    	-- Check the super-classes
     checkValidTheta (ClassSCCtxt (className cls)) theta	`thenTc_`
@@ -277,7 +277,8 @@ checkValidClass cls
 
   where
     (tyvars, theta, sel_ids, op_stuff) = classBigSig cls
-    unary 	= length tyvars == 1
+    arity	= length tyvars
+    unary 	= arity == 1
     no_generics = null [() | (_, GenDefMeth) <- op_stuff]
 
     check_op (sel_id, dm) 
@@ -614,8 +615,12 @@ find_prags sel_name meth_name (prag:prags) = find_prags sel_name meth_name prags
 Contexts and errors
 ~~~~~~~~~~~~~~~~~~~
 \begin{code}
+nullaryClassErr cls
+  = ptext SLIT("No parameters for class")  <+> quotes (ppr cls)
+
 classArityErr cls
-  = ptext SLIT("Too many parameters for class") <+> quotes (ppr cls)
+  = vcat [ptext SLIT("Too many parameters for class") <+> quotes (ppr cls),
+	  parens (ptext SLIT("Use -fglasgow-exts to allow multi-parameter classes"))]
 
 defltMethCtxt clas
   = ptext SLIT("When checking the default methods for class") <+> quotes (ppr clas)