-
-/* Expressions involving infix operators or unary minus are parsed as elements
- * of the following type:
- *
- * data OpExp = Only Exp | Neg OpExp | Infix OpExp Op Exp
- *
- * (The algorithms here do not assume that negation can be applied only once,
- * i.e., that - - x is a syntax error, as required by the Haskell report.
- * Instead, that restriction is captured by the grammar itself, given above.)
- *
- * There are rules of precedence and grouping, expressed by two functions:
- *
- * prec :: Op -> Int; assoc :: Op -> Assoc (Assoc = {L, N, R})
- *
- * OpExp values are rearranged accordingly when a complete expression has
- * been read using a simple shift-reduce parser whose result may be taken
- * to be a value of the following type:
- *
- * data Exp = Atom Int | Negate Exp | Apply Op Exp Exp | Error String
- *
- * The machine on which this parser is based can be defined as follows:
- *
- * tidy :: OpExp -> [(Op,Exp)] -> Exp
- * tidy (Only a) [] = a
- * tidy (Only a) ((o,b):ss) = tidy (Only (Apply o a b)) ss
- * tidy (Infix a o b) [] = tidy a [(o,b)]
- * tidy (Infix a o b) ((p,c):ss)
- * | shift o p = tidy a ((o,b):(p,c):ss)
- * | red o p = tidy (Infix a o (Apply p b c)) ss
- * | ambig o p = Error "ambiguous use of operators"
- * tidy (Neg e) [] = tidy (tidyNeg e) []
- * tidy (Neg e) ((o,b):ss)
- * | nshift o = tidy (Neg (underNeg o b e)) ss
- * | nred o = tidy (tidyNeg e) ((o,b):ss)
- * | nambig o = Error "illegal use of negation"
- *
- * At each stage, the parser can either shift, reduce, accept, or error.
- * The transitions when dealing with juxtaposed operators o and p are
- * determined by the following rules:
- *
- * shift o p = (prec o > prec p)
- * || (prec o == prec p && assoc o == L && assoc p == L)
- *
- * red o p = (prec o < prec p)
- * || (prec o == prec p && assoc o == R && assoc p == R)
- *
- * ambig o p = (prec o == prec p)
- * && (assoc o == N || assoc p == N || assoc o /= assoc p)
- *
- * The transitions when dealing with juxtaposed unary minus and infix operators
- * are as follows. The precedence of unary minus (infixl 6) is hardwired in
- * to these definitions, as it is to the definitions of the Haskell grammar
- * in the official report.
- *
- * nshift o = (prec o > 6)
- * nred o = (prec o < 6) || (prec o == 6 && assoc o == L)
- * nambig o = prec o == 6 && (assoc o == R || assoc o == N)
- *
- * An OpExp of the form (Neg e) means negate the last thing in the OpExp e;
- * we can force this negation using:
- *
- * tidyNeg :: OpExp -> OpExp
- * tidyNeg (Only e) = Only (Negate e)
- * tidyNeg (Infix a o b) = Infix a o (Negate b)
- * tidyNeg (Neg e) = tidyNeg (tidyNeg e)
- *
- * On the other hand, if we want to sneak application of an infix operator
- * under a negation, then we use:
- *
- * underNeg :: Op -> Exp -> OpExp -> OpExp
- * underNeg o b (Only e) = Only (Apply o e b)
- * underNeg o b (Neg e) = Neg (underNeg o b e)
- * underNeg o b (Infix e p f) = Infix e p (Apply o f b)
- *
- * As a concession to efficiency, we lower the number of calls to syntaxOf
- * by keeping track of the values of sye, sys throughout the process. The
- * value APPLIC is used to indicate that the syntax value is unknown.
- */
-
-#define UMINUS_PREC 6 /* Change these settings at your */
-#define UMINUS_ASSOC LEFT_ASS /* own risk; they may not work! */
-
-static Cell local tidyInfix(e) /* convert OpExp to Expr */
-Cell e; { /* :: OpExp */
- Cell s = NIL; /* :: [(Op,Exp)] */
- Syntax sye = APPLIC; /* Syntax of op in e (init unknown)*/
- Syntax sys = APPLIC; /* Syntax of op in s (init unknown)*/
-
- for (;;)
- switch (whatIs(e)) {
- case ONLY : e = snd(e);
- while (nonNull(s)) {
- Cell next = arg(fun(s));
- arg(fun(s)) = e;
- e = s;
- s = next;
- }
- return e;
-
- case NEG : if (nonNull(s)) {
-
- if (sys==APPLIC) { /* calculate sys */
- sys = identSyntax(fun(fun(s)));
- if (sys==APPLIC) sys=DEF_OPSYNTAX;
- }
-
- if (precOf(sys)==UMINUS_PREC && /* nambig */
- assocOf(sys)!=UMINUS_ASSOC) {
- ERRMSG(row)
- "Ambiguous use of unary minus with \"%s\"",
- textToStr(textOf(fun(fun(s))))
- EEND;
- }
-
- if (precOf(sys)>UMINUS_PREC) { /* nshift */
- Cell e1 = snd(e);
- Cell t = s;
- s = arg(fun(s));
- while (whatIs(e1)==NEG)
- e1 = snd(e1);
- arg(fun(t)) = arg(e1);
- arg(e1) = t;
- sys = APPLIC;
- continue;
- }
-
- }
-
- /* Intentional fall-thru for nreduce and isNull(s) */
- { Cell prev = e; /* e := tidyNeg e */
- Cell temp = arg(prev);
- Int nneg = 1;
- for (; whatIs(temp)==NEG; nneg++) {
- fun(prev) = varNegate;
- prev = temp;
- temp = arg(prev);
- }
- /* These special cases are required for
- * pattern matching.
- */
- if (isInt(arg(temp))) { /* special cases */
- if (nneg&1) /* for literals */
- arg(temp) = intNegate(arg(temp));
- }
- else if (isBignum(arg(temp))) {
- if (nneg&1)
- arg(temp) = bignumNegate(arg(temp));
- }
- else if (isFloat(arg(temp))) {
- if (nneg&1)
- arg(temp) = floatNegate(arg(temp));
- }
- else {
- fun(prev) = varNegate;
- arg(prev) = arg(temp);
- arg(temp) = e;
- }
- e = temp;
- }
- continue;
-
- default : if (isNull(s)) {/* Move operation onto empty stack */
- Cell next = arg(fun(e));
- s = e;
- arg(fun(s)) = NIL;
- e = next;
- sys = sye;
- sye = APPLIC;
- }
- else { /* deal with pair of operators */
-
- if (sye==APPLIC) { /* calculate sys and sye */
- sye = identSyntax(fun(fun(e)));
- if (sye==APPLIC) sye=DEF_OPSYNTAX;
- }
- if (sys==APPLIC) {
- sys = identSyntax(fun(fun(s)));
- if (sys==APPLIC) sys=DEF_OPSYNTAX;
- }
-
- if (precOf(sye)==precOf(sys) && /* ambig */
- (assocOf(sye)!=assocOf(sys) ||
- assocOf(sye)==NON_ASS)) {
- ERRMSG(row)
- "Ambiguous use of operator \"%s\" with \"%s\"",
- textToStr(textOf(fun(fun(e)))),
- textToStr(textOf(fun(fun(s))))
- EEND;
- }
-
- if (precOf(sye)>precOf(sys) || /* shift */
- (precOf(sye)==precOf(sys) &&
- assocOf(sye)==LEFT_ASS &&
- assocOf(sys)==LEFT_ASS)) {
- Cell next = arg(fun(e));
- arg(fun(e)) = s;
- s = e;
- e = next;
- sys = sye;
- sye = APPLIC;
- }
- else { /* reduce */
- Cell next = arg(fun(s));
- arg(fun(s)) = arg(e);
- arg(e) = s;
- s = next;
- sys = APPLIC;
- /* sye unchanged */
- }
- }
- continue;
- }