summaryrefslogtreecommitdiff
path: root/ghc/compiler/parser/syntax.c
diff options
context:
space:
mode:
Diffstat (limited to 'ghc/compiler/parser/syntax.c')
-rw-r--r--ghc/compiler/parser/syntax.c304
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 */
+
View Lorry Controller Status