[project @ 1996-04-07 15:41:24 by partain]

Sansom 1.3 changes through 960407

1 files changed, 143 insertions, 161 deletions

diff --git a/ghc/compiler/parser/syntax.c b/ghc/compiler/parser/syntax.c
index ad5d3d68b1..fec0ae8278 100644
--- a/ghc/compiler/parser/syntax.c
+++ b/ghc/compiler/parser/syntax.c
@@ -35,8 +35,6 @@ qid	fns[MAX_CONTEXTS] = { NULL };
 BOOLEAN samefn[MAX_CONTEXTS] = { FALSE };
 tree	prevpatt[MAX_CONTEXTS] = { NULL };
 
-BOOLEAN inpat = FALSE;
-
 static BOOLEAN	 checkorder2 PROTO((binding, BOOLEAN));
 static BOOLEAN	 checksig PROTO((BOOLEAN, binding));
 
@@ -85,13 +83,6 @@ checksamefn(fn)
 }
 
 
-void
-checkinpat()
-{
-  if(!inpat)
-    hsperror("pattern syntax used in expression");
-}
-
 /* ------------------------------------------------------------------------
 */
 
@@ -327,9 +318,6 @@ lhs_is_patt(tree e)
 
       case ident:
 	return(TRUE);
-	/* This change might break ap infixop below.  BEWARE.
-	   return (isconstr(qid_to_string(gident(e))));
-        */
 
       case ap:
 	{
@@ -433,107 +421,6 @@ binding rule;
     fprintf(stderr,"bind error in decl (%d)\n",tbinding(bind));
 }
 
-/* 
-
-  Precedence Parser for Haskell.  By default operators are left-associative, 
-  so it is only necessary to rearrange the parse tree where the new operator
-  has a greater precedence than the existing one, or where two operators have
-  the same precedence and are both right-associative. Error conditions are
-  handled.
-
-  Note:  Prefix negation has the same precedence as infix minus.
-         The algorithm must thus take account of explicit negates.
-*/
-
-void
-precparse(tree t)
-{
-  if(ttree(t) == infixap)
-    {
-      tree left = ginfarg1(t);
-
-      if(ttree(left) == negate)
-	{
-	  struct infix *ttabpos = infixlookup(ginffun(t));
-	  struct infix *ntabpos = infixlookup(mknoqual(install_literal("-")));
-	  
-	  if(pprecedence(ntabpos) < pprecedence(ttabpos))
-	    {
-	      /* (-x)*y  ==> -(x*y) */
-	      qid  lop  = ginffun(t);
-	      tree arg1 = gnexp(left);
-	      tree arg2 = ginfarg2(t);
-
-	      t->tag = negate;
-	      gnexp(t) = left;
-	      gnxxx1(t) = NULL;
-	      gnxxx2(t) = NULL;
-
-	      left->tag = infixap;
-	      ginffun(left)  = lop;
-	      ginfarg1(left) = arg1;
-	      ginfarg2(left) = arg2;
-
-	      precparse(left);
-	    }
-	}
-
-      else if(ttree(left) == infixap)
-	{
-	  struct infix *ttabpos    = infixlookup(ginffun(t));
-	  struct infix *lefttabpos = infixlookup(ginffun(left));
-
-	  if(pprecedence(lefttabpos) < pprecedence(ttabpos))
-	    rearrangeprec(left,t);
-
-	  else if(pprecedence(lefttabpos) == pprecedence(ttabpos))
-	    {
-	      if(pfixity(lefttabpos) == INFIXR && pfixity(ttabpos) == INFIXR)
-		rearrangeprec(left,t);
-
-	      else if(pfixity(lefttabpos) == INFIXL && pfixity(ttabpos) == INFIXL)
-		/* SKIP */;
-
-	      else
-		{
-		  char errbuf[ERR_BUF_SIZE];
-		  sprintf(errbuf,"Cannot mix %s and %s in the same infix expression", 
-			  qid_to_string(ginffun(left)), qid_to_string(ginffun(t)));
-		  hsperror(errbuf);
-	      }
-	    }
-	}
-    }
-}
-
-
-/*
-  Rearrange a tree to effectively insert an operator in the correct place.
-
-  x+y*z ==parsed== (x+y)*z  ==>  x+(y*z)
-
-  The recursive call to precparse ensures this filters down as necessary.
-*/
-
-static void
-rearrangeprec(tree left, tree t)
-{
-  qid top  = ginffun(left);
-  qid lop  = ginffun(t);
-  tree arg1 = ginfarg1(left);
-  tree arg2 = ginfarg2(left);
-  tree arg3 = ginfarg2(t);
-
-  ginffun(t)  = top;
-  ginfarg1(t) = arg1;
-  ginfarg2(t) = left;
-
-  ginffun(left)  = lop;
-  ginfarg1(left) = arg2;
-  ginfarg2(left) = arg3;
-
-  precparse(left);
-}
 
 pbinding
 createpat(guards,where)
@@ -550,6 +437,7 @@ createpat(guards,where)
   return(mkpgrhs(PREVPATT,guards,where,func,endlineno));
 }
 
+
 char *
 ineg(i)
   char *i;
@@ -561,21 +449,6 @@ ineg(i)
   return(p);
 }
 
-#if 0
-/* UNUSED: at the moment */
-void
-checkmodname(import,interface)
-  id import, interface;
-{
-  if(strcmp(import,interface) != 0)
-    {
-      char errbuf[ERR_BUF_SIZE];
-      sprintf(errbuf,"interface name (%s) does not agree with import name (%s)",interface,import);
-      hsperror(errbuf);
-    }
-}
-#endif /* 0 */
-
 /*
   Check the ordering of declarations in a cbody.
   All signatures must appear before any declarations.
@@ -611,7 +484,6 @@ checkorder2(decls,sigs)
   return(checksig(sigs,decls));
 }
 
-
 static BOOLEAN
 checksig(sig,decl)
   BOOLEAN sig;
@@ -644,38 +516,6 @@ checkdostmts(stmts)
 
 
 /*
-  Check the precedence of a pattern or expression to ensure that
-  sections and function definitions have the correct parse.
-*/
-
-void
-checkprec(exp,qfn,right)
-  tree exp;
-  qid qfn;
-  BOOLEAN right;
-{
-  if(ttree(exp) == infixap)
-    {
-      struct infix *ftabpos = infixlookup(qfn);
-      struct infix *etabpos = infixlookup(ginffun(exp));
-
-      if (pprecedence(etabpos) > pprecedence(ftabpos) ||
-	 (pprecedence(etabpos) == pprecedence(ftabpos) &&
-	  ((pfixity(etabpos) == INFIXR && pfixity(ftabpos) == INFIXR && right) ||
-	  ((pfixity(etabpos) == INFIXL && pfixity(ftabpos) == INFIXL && !right)))))
-	/* SKIP */;
-      else
-	{
-	  char errbuf[ERR_BUF_SIZE];
-	  sprintf(errbuf,"Cannot mix %s and %s on a LHS or in a section", 
-		  qid_to_string(qfn), qid_to_string(ginffun(exp)));
-	  hsperror(errbuf);
-	}
-    }
-}
-
-
-/*
   Checks there are no bangs in a tycon application.
 */
 
@@ -718,3 +558,145 @@ splittyconapp(app, tyc, tys)
       hsperror("panic: splittyconap: bad tycon application (no tycon)");
     }
 }
+
+
+#if 0 
+
+Precedence Parsing Is Now Done In The Compiler !!!
+
+/* 
+
+  Precedence Parser for Haskell.  By default operators are left-associative, 
+  so it is only necessary to rearrange the parse tree where the new operator
+  has a greater precedence than the existing one, or where two operators have
+  the same precedence and are both right-associative. Error conditions are
+  handled.
+
+  Note:  Prefix negation has the same precedence as infix minus.
+         The algorithm must thus take account of explicit negates.
+*/
+
+void
+precparse(tree t)
+{
+  if(ttree(t) == infixap)
+    {
+      tree left = ginfarg1(t);
+
+      if(ttree(left) == negate)
+	{
+	  struct infix *ttabpos = infixlookup(ginffun(t));
+	  struct infix *ntabpos = infixlookup(mknoqual(install_literal("-")));
+	  
+	  if(pprecedence(ntabpos) < pprecedence(ttabpos))
+	    {
+	      /* (-x)*y  ==> -(x*y) */
+	      qid  lop  = ginffun(t);
+	      tree arg1 = gnexp(left);
+	      tree arg2 = ginfarg2(t);
+
+	      t->tag = negate;
+	      gnexp(t) = left;
+	      gnxxx1(t) = NULL;
+	      gnxxx2(t) = NULL;
+
+	      left->tag = infixap;
+	      ginffun(left)  = lop;
+	      ginfarg1(left) = arg1;
+	      ginfarg2(left) = arg2;
+
+	      precparse(left);
+	    }
+	}
+
+      else if(ttree(left) == infixap)
+	{
+	  struct infix *ttabpos    = infixlookup(ginffun(t));
+	  struct infix *lefttabpos = infixlookup(ginffun(left));
+
+	  if(pprecedence(lefttabpos) < pprecedence(ttabpos))
+	    rearrangeprec(left,t);
+
+	  else if(pprecedence(lefttabpos) == pprecedence(ttabpos))
+	    {
+	      if(pfixity(lefttabpos) == INFIXR && pfixity(ttabpos) == INFIXR)
+		rearrangeprec(left,t);
+
+	      else if(pfixity(lefttabpos) == INFIXL && pfixity(ttabpos) == INFIXL)
+		/* SKIP */;
+
+	      else
+		{
+		  char errbuf[ERR_BUF_SIZE];
+		  sprintf(errbuf,"Cannot mix %s and %s in the same infix expression", 
+			  qid_to_string(ginffun(left)), qid_to_string(ginffun(t)));
+		  hsperror(errbuf);
+	      }
+	    }
+	}
+    }
+}
+
+
+/*
+  Rearrange a tree to effectively insert an operator in the correct place.
+
+  x+y*z ==parsed== (x+y)*z  ==>  x+(y*z)
+
+  The recursive call to precparse ensures this filters down as necessary.
+*/
+
+static void
+rearrangeprec(tree left, tree t)
+{
+  qid top  = ginffun(left);
+  qid lop  = ginffun(t);
+  tree arg1 = ginfarg1(left);
+  tree arg2 = ginfarg2(left);
+  tree arg3 = ginfarg2(t);
+
+  ginffun(t)  = top;
+  ginfarg1(t) = arg1;
+  ginfarg2(t) = left;
+
+  ginffun(left)  = lop;
+  ginfarg1(left) = arg2;
+  ginfarg2(left) = arg3;
+
+  precparse(left);
+}
+
+
+/*
+  Check the precedence of a pattern or expression to ensure that
+  sections and function definitions have the correct parse.
+*/
+
+void
+checkprec(exp,qfn,right)
+  tree exp;
+  qid qfn;
+  BOOLEAN right;
+{
+  if(ttree(exp) == infixap)
+    {
+      struct infix *ftabpos = infixlookup(qfn);
+      struct infix *etabpos = infixlookup(ginffun(exp));
+
+      if (pprecedence(etabpos) > pprecedence(ftabpos) ||
+	 (pprecedence(etabpos) == pprecedence(ftabpos) &&
+	  ((pfixity(etabpos) == INFIXR && pfixity(ftabpos) == INFIXR && right) ||
+	  ((pfixity(etabpos) == INFIXL && pfixity(ftabpos) == INFIXL && !right)))))
+	/* SKIP */;
+      else
+	{
+	  char errbuf[ERR_BUF_SIZE];
+	  sprintf(errbuf,"Cannot mix %s and %s on a LHS or in a section", 
+		  qid_to_string(qfn), qid_to_string(ginffun(exp)));
+	  hsperror(errbuf);
+	}
+    }
+}
+
+#endif /* 0 */
+