X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fparser%2Fsyntax.c;h=4f8d661318c1f5cb0a675bf9bb401ce41a0f486d;hb=ba013704bfb94aa133fb28f342e0d432698a5d6d;hp=a48b1198cb2d528f7e1d4c52e8a9af9dfa3cb3b0;hpb=1fb1ab5d53a09607e7f6d2450806760688396387;p=ghc-hetmet.git

diff --git a/ghc/compiler/parser/syntax.c b/ghc/compiler/parser/syntax.c
index a48b119..4f8d661 100644
--- a/ghc/compiler/parser/syntax.c
+++ b/ghc/compiler/parser/syntax.c
@@ -127,6 +127,7 @@ expORpat(int wanted, tree e)
 
 	  case clitlit:
 	    error_if_patt_wanted(wanted, "``literal-literal'' in pattern");
+	    break;
 
 	  default: /* the others only occur in pragmas */
 	    hsperror("not a valid literal pattern or expression");
@@ -317,6 +318,7 @@ lhs_is_patt(tree e)
       case llist:
       case tuple:
       case negate:
+      case record:
 	expORpat(LEGIT_PATT, e);
 	return TRUE;
 
@@ -326,13 +328,17 @@ lhs_is_patt(tree e)
       case ap:
 	{
 	  tree f = function(e);
-	  tree a = garg(e);       /* do not "unparen", otherwise the error
-				       fromInteger ((x,y) {-no comma-} z)
-				     will be missed.
-			          */
 
-	  /* definitions must have pattern arguments */
+/*  These lines appear to duplicate what's in function(e).
+    Nuked SLPJ May 97
+ 	
+	  tree a = garg(e);       -- do not "unparen", otherwise the error
+				  --     fromInteger ((x,y) {-no comma-} z)
+				  --   will be missed.
+
+	  -- definitions must have pattern arguments
 	  expORpat(LEGIT_PATT, a);
+*/
 
 	  if(ttree(f) == ident)
 	    return(isconstr(qid_to_string(gident(f))));
@@ -341,7 +347,7 @@ lhs_is_patt(tree e)
 	    return(lhs_is_patt(f));
 
 	  else
-	    hsperror("Not a legal pattern binding in LHS");
+	    hsperror("Syntax error: not a legal pattern binding in LHS");
 	}
 
       case infixap:
@@ -362,7 +368,7 @@ lhs_is_patt(tree e)
 
       /* Anything else must be an illegal LHS */
       default:
-	hsperror("Not a valid LHS");
+	hsperror("Syntax error: not a valid LHS");
       }
 
   abort(); /* should never get here */
@@ -371,7 +377,8 @@ lhs_is_patt(tree e)
 
 
 /*
-  Return the function at the root of a series of applications.
+  Return the function at the root of a series of applications,
+  checking on the way that the arguments are patterns.
 */
 
 tree
@@ -533,9 +540,50 @@ checknobangs(app)
 	hsperror("syntax error: unexpected ! in type");
 
       checknobangs(gtapp((struct Stapp *)app));
-    }	  
+    }
+}
+
+
+/* Check that a type is of the form
+	C a1 a2 .. an
+   where n>=1, and the ai are all type variables
+   This is used to check that a class decl is well formed.
+*/
+void
+check_class_decl_head_help( app, n )
+  ttype app;
+  int n;	/* Number of args so far */
+{
+  switch (tttype(app)) {
+    case tapp:
+	/* Check the arg is a type variable */
+	switch (tttype (gtarg((struct Stapp *) app))) {
+		case namedtvar: break;
+		default: hsperror("Class declaration head must use only type variables");
+	}
+
+	/* Check the fun part */
+	check_class_decl_head_help( gtapp((struct Stapp *) app), n+1 );
+	break;
+
+    case tname:
+	/* Class name; check there is at least one argument */
+      if (n==0) {
+	    hsperror("Class must have at least one argument");
+      }
+      break;
+
+    default:
+	hsperror("Illegal syntax in class declaration head");
+  }
 }
 
+void
+check_class_decl_head( app )
+  ttype app;
+{ check_class_decl_head_help( app, 0 ); }
+
+	
 
 /*
   Splits a tycon application into its constructor and a list of types.