|
|
1.1 root 1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
2:
3: /*
4: $Header: b2tes.c,v 1.4 85/08/22 16:57:17 timo Exp $
5: */
6:
7: #include "b.h"
8: #include "b1obj.h"
9: #include "b2par.h"
10: #include "b2key.h"
11: #include "b2syn.h"
12: #include "b2nod.h"
13: #include "b3err.h"
14:
15: Forward bool conjunction(), disjunction();
16: Forward parsetree right_test();
17:
18: Visible parsetree test(q) txptr q; {
19: parsetree v;
20: skipsp(&tx);
21: if (!(conjunction(q, &v) || disjunction(q, &v))) v= right_test(q);
22: return v;
23: }
24:
25: Forward bool negation(), quantification();
26: Forward parsetree tight_test();
27:
28: Hidden parsetree right_test(q) txptr q; {
29: parsetree v;
30: skipsp(&tx);
31: if (!(negation(q, &v) || quantification(q, &v))) v= tight_test(q);
32: return v;
33: }
34:
35: Hidden bool conjunction(q, v) txptr q; parsetree *v; {
36: txptr ftx, ttx;
37: if (find(K_AND, q, &ftx, &ttx)) {
38: parsetree t;
39: t= tight_test(ftx); tx= ttx;
40: if (!conjunction(q, v)) *v= right_test(q);
41: *v= node3(AND, t, *v);
42: return Yes;
43: }
44: return No;
45: }
46:
47: Hidden bool disjunction(q, v) txptr q; parsetree *v; {
48: txptr ftx, ttx;
49: if (find(K_OR, q, &ftx, &ttx)) {
50: parsetree t;
51: t= tight_test(ftx); tx= ttx;
52: if (!disjunction(q, v)) *v= right_test(q);
53: *v= node3(OR, t, *v);
54: return Yes;
55: }
56: return No;
57: }
58:
59: Hidden bool negation(q, v) txptr q; parsetree *v; {
60: if (not_keyword()) {
61: *v= node2(NOT, right_test(q));
62: return Yes;
63: }
64: return No;
65: }
66:
67: Hidden bool quantification(q, v) txptr q; parsetree *v; {
68: bool some, each;
69: if ((some= some_keyword()) || (each= each_keyword()) || no_keyword()) {
70: parsetree t, e; typenode type;
71: txptr utx, vtx, ftx, ttx;
72: req(K_HAS, ceol, &utx, &vtx);
73: if (utx > q) {
74: parerr(MESS(2700, "HAS follows colon"));
75: /* as in: SOME i IN x: SHOW i HAS a */
76: utx= tx; vtx= q;
77: }
78: if (find(K_IN_quant, utx, &ftx, &ttx)) {
79: idf_cntxt= In_ranger;
80: t= idf(ftx); tx= ttx;
81: type= some ? SOME_IN : each ? EACH_IN : NO_IN;
82: } else if (find(K_PARSING, utx, &ftx, &ttx)) {
83: idf_cntxt= In_ranger;
84: t= idf(ftx);
85: if (nodetype(t) != COLLATERAL)
86: pprerr(MESS(2701, "no collateral_identifier where expected"));
87: tx= ttx;
88: type= some ? SOME_PARSING : each ? EACH_PARSING
89: : NO_PARSING;
90: } else {
91: parerr(MESS(2702, "neither IN nor PARSING found"));
92: utx= tx; vtx= q; t= NilTree; type= Nonode;
93: }
94: e= expr(utx); tx= vtx;
95: *v= node4(type, t, e, right_test(q));
96: return Yes;
97: }
98: return No;
99: }
100:
101: Forward bool cl_test(), order_test();
102: Forward parsetree ref_or_prop();
103:
104: Hidden parsetree tight_test(q) txptr q; {
105: parsetree v;
106: skipsp(&tx);
107: if (nothing(q, "test")) v= NilTree;
108: else if (!(cl_test(q, &v) || order_test(q, &v))) {
109: if (is_expr(Char(tx))) v= ref_or_prop(q);
110: else {
111: parerr(MESS(2703, "no test where expected"));
112: v= NilTree;
113: }
114: }
115: upto_test(q);
116: return v;
117: }
118:
119: Hidden bool cl_test(q, v) txptr q; parsetree *v; {
120: txptr tx0= tx;
121: if (open_sign()) { /* (expr) or (test) */
122: txptr ftx, ttx, tx1;
123: tx1= tx;
124: req(")", q, &ftx, &ttx); tx= ttx;
125: skipsp(&tx);
126: if (!Text(q)) {
127: tx= tx1;
128: *v= compound(ttx, test);
129: return Yes;
130: }
131: }
132: tx= tx0;
133: return No;
134: }
135:
136: Forward typenode relop();
137:
138: Hidden bool order_test(q, v) txptr q; parsetree *v; {
139: txptr ftx;
140: if (findrel(q, &ftx)) {
141: typenode r;
142: *v= singexpr(ftx);
143: do {
144: r= relop();
145: if (!findrel(q, &ftx)) ftx= q;
146: *v= node3(r, *v, singexpr(ftx));
147: } while (ftx < q);
148: return Yes;
149: }
150: return No;
151: }
152:
153: Hidden typenode relop() {
154: skipsp(&tx);
155: return
156: at_most_sign() ? AT_MOST :
157: unequal_sign() ? UNEQUAL :
158: at_least_sign() ? AT_LEAST :
159: equals_sign() ? EQUAL :
160: less_than_sign() ? LESS_THAN :
161: greater_than_sign() ? GREATER_THAN :
162: /* psyserr */ Nonode;
163: }
164:
165: /* refined_test or proposition */
166:
167: Forward parsetree dyadic_proposition();
168:
169: Hidden parsetree ref_or_prop(q) txptr q; {
170: value t1;
171: txptr tx0= tx;
172: if (tag_operator(q, &t1)) {
173: value t2;
174: skipsp(&tx);
175: if (!Text(q)) return node2(TAG, t1);
176: if (tag_operator(q, &t2)) {
177: skipsp(&tx);
178: if (!Text(q))
179: return node4(MONPRD, t1, node2(TAG, t2), Vnil);
180: release(t1); release(t2);
181: return (tx= tx0, unp_test(q));
182: }
183: release(t1);
184: if (!dya_sign()) return (tx= tx0, unp_test(q));
185: }
186: return (tx= tx0, dyadic_proposition(q));
187: }
188:
189: Visible bool dya_proposition= No;
190:
191: Hidden parsetree dyadic_proposition(q) txptr q; {
192: parsetree v; value name;
193: dya_proposition= Yes;
194: v= singexpr(q);
195: if (!Text(q)) /* unparsed */
196: return v;
197: if (!tag_operator(q, &name)) {
198: parerr(MESS(2704, "no dyadic predicate where expected"));
199: name= Vnil;
200: }
201: return node5(DYAPRD, v, name, singexpr(q), Vnil);
202: }
203:
204: Hidden Procedure upto_test(q) txptr q; {
205: skipsp(&tx);
206: if (Text(q)) {
207: txptr ftx, ttx;
208: if (find(K_AND, q, &ftx, &ttx) || find(K_OR, q, &ftx, &ttx)) {
209: tx= ftx;
210: parerr(MESS(2705, "cannot determine priorities; use ( and ) to resolve"));
211: } else parerr(MESS(2706, "something unexpected following test"));
212: tx= q;
213: }
214: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.