|
|
1.1 root 1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
2:
3: /*
4: $Header: b2exp.c,v 1.4 85/08/22 16:54:36 timo Exp $
5: */
6:
7: #include "b.h"
8: #include "b1obj.h"
9: #include "b2par.h"
10: #include "b2syn.h"
11: #include "b2nod.h"
12: #include "b2exp.h"
13: #include "b3err.h"
14:
15: /* ******************************************************************** */
16: /* expression */
17: /* ******************************************************************** */
18:
19: Visible parsetree expr(q) txptr q; {
20: return collateral(q, singexpr);
21: }
22:
23: Forward parsetree rsingexpr();
24:
25: Visible parsetree singexpr(q) txptr q; {
26: if (nothing(q, "expression")) return NilTree;
27: else {
28: expadm adm;
29: initexp(&adm);
30: return rsingexpr(q, &adm);
31: }
32: }
33:
34: Hidden Procedure initexp(adm) expadm *adm; {
35: Parsed(adm)= Yes;
36: N_fld(adm)= 0;
37: Prop(adm)= dya_proposition;
38: dya_proposition= No;
39: }
40:
41: Hidden bool expr_opr() {
42: return reptext_sign() || center_sign() || leftadj_sign() ||
43: rightadj_sign();
44: }
45:
46: Forward parsetree term(), factor(), primary(), base(), unp_expr();
47: Forward bool element();
48:
49: Hidden parsetree rsingexpr(q, adm) txptr q; expadm *adm; {
50: parsetree v; value w; txptr tx0= tx;
51: v= term(q, adm);
52: skipsp(&tx);
53: if (Parsed(adm) && Text(q) && expr_opr()) {
54: if (nodetype(v) == DYAF) pprerr(Prio);
55: dya_formula(q, adm, &v, mk_text(textsign), L_expr, base);
56: }
57: skipsp(&tx);
58: if (Parsed(adm) && Prop(adm)) {
59: if (Text(q) && (nodetype(v) == DYAF || Level(adm) < L_expr))
60: /* predicate must follow */
61: return v;
62: else if (Text(q) && tag_operator(q, &w))
63: dya_formula(q, adm, &v, w, L_expr, unp_expr);
64: else
65: parerr(MESS(2100, "no test where expected"));
66: }
67: if (Parsed(adm) && Text(q) && tag_operator(q, &w)) {
68: if (nodetype(v) == DYAF) pprerr(Prio);
69: dya_formula(q, adm, &v, w, L_expr, base);
70: }
71: if (!Parsed(adm)) /* v is an UNPARSED node */
72: *Branch(v, UNP_TEXT)= cr_text(tx0, tx);
73: upto_expr(q);
74: return v;
75: }
76:
77: Hidden Procedure dya_formula(q, adm, v, name, lev, fct)
78: txptr q; expadm *adm; parsetree *v, (*fct)(); value name; intlet lev; {
79:
80: parsetree w;
81: if (Level(adm) < lev) pprerr(Prio);
82: N_fld(adm)+= 2;
83: w= (*fct)(q, adm);
84: if (Parsed(adm)) {
85: N_fld(adm)-= 2;
86: if (Trim(adm))
87: *v= node3(b_behead(name) ? BEHEAD : CURTAIL, *v, w);
88: else
89: *v= node5(DYAF, *v, name, w, Vnil);
90: } else {
91: *Field(Unp_comp(adm), --N_fld(adm))= name;
92: *Field(Unp_comp(adm), --N_fld(adm))= *v;
93: *v= w;
94: }
95: }
96:
97: /* ******************************************************************** */
98: /* term */
99: /* ******************************************************************** */
100:
101: Hidden bool term_opr() {
102: return plus_sign() || minus_sign() || join_sign();
103: }
104:
105: Hidden parsetree term(q, adm) txptr q; expadm *adm; {
106: parsetree v= factor(q, adm);
107: skipsp(&tx);
108: while (Parsed(adm) && Text(q) && term_opr()) {
109: dya_formula(q, adm, &v, mk_text(textsign), L_term, factor);
110: skipsp(&tx);
111: }
112: return v;
113: }
114:
115: /* ******************************************************************** */
116: /* factor */
117: /* ******************************************************************** */
118:
119: Hidden parsetree factor(q, adm) txptr q; expadm *adm; {
120: parsetree v= primary(q, adm);
121: skipsp(&tx);
122: while (Parsed(adm) && Text(q) && times_sign()) {
123: dya_formula(q, adm, &v, mk_text(textsign), L_factor, primary);
124: skipsp(&tx);
125: }
126: if (Parsed(adm) && Text(q) && over_sign())
127: dya_formula(q, adm, &v, mk_text(textsign), L_factor, primary);
128: return v;
129: }
130:
131: /* ******************************************************************** */
132: /* primary */
133: /* ******************************************************************** */
134:
135: Hidden parsetree primary(q, adm) txptr q; expadm *adm; {
136: parsetree v;
137: v= base(q, adm);
138: skipsp(&tx);
139: if (Parsed(adm) && Text(q) && number_sign())
140: dya_formula(q, adm, &v, mk_text(textsign), L_number, base);
141: skipsp(&tx);
142: if (Parsed(adm) && Text(q) && power_sign())
143: dya_formula(q, adm, &v, mk_text(textsign), L_power, base);
144: return v;
145: }
146:
147: /* ******************************************************************** */
148: /* base */
149: /* ******************************************************************** */
150:
151: Forward parsetree rbase();
152:
153: Hidden parsetree base(q, adm) txptr q; expadm *adm; {
154: State(adm)= S_else;
155: Level(adm)= L_expr;
156: Trim(adm)= No;
157: return rbase(q, adm);
158: }
159:
160: Hidden bool critical(adm, v) expadm *adm; value v; {
161: if (State(adm) == S_t) {
162: if (b_plus(v) || b_minus(v))
163: return Level(adm) >= L_term;
164: if (b_number(v))
165: return Level(adm) >= L_number;
166: }
167: return No;
168: }
169:
170: Hidden parsetree mon_formula(q, adm, w, fct)
171: txptr q; expadm *adm; value w; parsetree (*fct)(); {
172:
173: parsetree v;
174: N_fld(adm)++;
175: v= (*fct)(q, adm);
176: if (Parsed(adm)) {
177: N_fld(adm)--;
178: return v == NilTree ? node2(TAG, w) : node4(MONF, w, v, Vnil);
179: } else {
180: *Field(Unp_comp(adm), --N_fld(adm))= w;
181: return v;
182: }
183: }
184:
185: Hidden Procedure adjust_level(adm, lev) expadm *adm; intlet lev; {
186: if (lev < Level(adm)) Level(adm)= lev;
187: }
188:
189: Hidden parsetree rbase(q, adm) txptr q; expadm *adm; {
190: parsetree v; value name;
191: skipsp(&tx);
192: if (Text(q) && tag_operator(q, &name)) {
193: if (State(adm) == S_tt)
194: return mon_formula(q, adm, name, unp_expr);
195: if (State(adm) == S_t) {
196: if (Level(adm) == L_expr || Prop(adm)) State(adm)= S_tt;
197: else if (!Trim(adm)) adjust_level(adm, L_bottom);
198: } else State(adm)= S_t;
199: v= mon_formula(q, adm, name, rbase);
200: if (!Trim(adm) && Parsed(adm) && nodetype(v) == MONF)
201: adjust_level(adm, L_bottom);
202: return v;
203: } else if (Text(q) && (dyamon_sign() || mon_sign())) {
204: name= mk_text(textsign);
205: if (State(adm) == S_tt || critical(adm, name))
206: return mon_formula(q, adm, name, unp_expr);
207: if (!Trim(adm)) {
208: if (State(adm) == S_t) adjust_level(adm, L_bottom);
209: else if (b_minus(name)) adjust_level(adm, L_factor);
210: else if (b_number(name)) adjust_level(adm, L_number);
211: else if (b_numtor(name) || b_denomtor(name))
212: adjust_level(adm, L_bottom);
213: }
214: State(adm)= S_else;
215: if (!Trim(adm) && b_minus(name)) {
216: intlet lev= Level(adm);
217: v= mon_formula(q, adm, name, primary);
218: adjust_level(adm, lev);
219: return v;
220: } else
221: return mon_formula(q, adm, name, rbase);
222: } else if (Text(q) && element(q, &v)) {
223: if (State(adm) == S_tt)
224: return mon_formula(q, adm, v, unp_expr);
225: exp_trimmed_text(q, adm, &v);
226: return v;
227: } else {
228: if (State(adm) == S_else)
229: parerr(MESS(2101, "no expression where expected"));
230: return NilTree;
231: }
232: }
233:
234: /* ******************************************************************** */
235: /* element */
236: /* ******************************************************************** */
237:
238: Forward bool closed_expr(), constant(), text_dis(), tlr_dis(), seltrim_tag();
239:
240: Hidden bool element(q, v) txptr q; parsetree *v; {
241: if (seltrim_tag(q, v) || closed_expr(q, v) || constant(q, v) ||
242: text_dis(q, v) || tlr_dis(q, v)
243: ) {
244: selection(q, v);
245: return Yes;
246: }
247: return No;
248: }
249:
250: /* ******************************************************************** */
251: /* (seltrim_tag) */
252: /* ******************************************************************** */
253:
254: Hidden bool seltrim_tag(q, v) txptr q; parsetree *v; {
255: value name; txptr tx0= tx;
256: if (Text(q) && is_tag(&name)) {
257: txptr tx1= tx;
258: skipsp(&tx);
259: if (Text(q) && (sub_sign() || trim_sign())) {
260: tx= tx1;
261: *v= node2(TAG, name);
262: return Yes;
263: } else {
264: release(name);
265: tx= tx0;
266: }
267: }
268: return No;
269: }
270:
271: /* ******************************************************************** */
272: /* (expression) */
273: /* ******************************************************************** */
274:
275: Hidden bool closed_expr(q, v) txptr q; parsetree *v; {
276: return open_sign() ? (*v= compound(q, expr), Yes) : No;
277: }
278:
279: /* ******************************************************************** */
280: /* constant */
281: /* */
282: /* note: stand_alone E<number> not allowed */
283: /* ******************************************************************** */
284:
285: Forward bool digits();
286:
287: Hidden bool constant(q, v) txptr q; parsetree *v; {
288: if (Dig(Char(tx)) || Char(tx) == '.') {
289: txptr tx0= tx;
290: bool d= digits(q);
291: if (Text(q) && point_sign() && !digits(q) && !d)
292: pprerr(MESS(2102, "point without digits"));
293: if (Text(q) && Char(tx) == 'E' &&
294: (Dig(Char(tx+1)) || !keymark(Char(tx+1)))
295: ) {
296: tx++;
297: if (Text(q) && (plus_sign() || minus_sign()));
298: if (!digits(q)) pprerr(MESS(2103, "E not followed by exponent"));
299: }
300: *v= node3(NUMBER, numconst(tx0, tx), cr_text(tx0, tx));
301: return Yes;
302: }
303: return No;
304: }
305:
306: Hidden bool digits(q) txptr q; {
307: txptr tx0= tx;
308: while (Text(q) && Dig(Char(tx))) tx++;
309: return tx > tx0;
310: }
311:
312: /* ******************************************************************** */
313: /* textual_display */
314: /* ******************************************************************** */
315:
316: Forward parsetree text_body();
317:
318: Hidden bool text_dis(q, v) txptr q; parsetree *v; {
319: if (apostrophe_sign() || quote_sign()) {
320: parsetree w; value aq= mk_text(textsign);
321: w= text_body(q, textsign);
322: if (w == NilTree) w= node3(TEXT_LIT, mk_text(""), NilTree);
323: *v= node3(TEXT_DIS, aq, w);
324: return Yes;
325: }
326: return No;
327: }
328:
329: Forward bool is_conversion();
330:
331: Hidden parsetree text_body(q, aq) txptr q; string aq; {
332: value head; parsetree tail;
333: txptr tx0= tx;
334: while (Text(q)) {
335: if (Char(tx) == *aq || Char(tx) == '`') {
336: head= tx0 < tx ? cr_text(tx0, tx) : Vnil;
337: if (Char(tx) == Char(tx+1)) {
338: value spec= cr_text(tx, tx+1);
339: tx+= 2;
340: tail= text_body(q, aq);
341: tail= node3(TEXT_LIT, spec, tail);
342: } else {
343: parsetree e;
344: if (is_conversion(q, &e)) {
345: tail= text_body(q, aq);
346: tail= node3(TEXT_CONV, e, tail);
347: } else {
348: tx++;
349: tail= NilTree;
350: }
351: }
352: if (head == Vnil) return tail;
353: else return node3(TEXT_LIT, head, tail);
354: } else
355: tx++;
356: }
357: parerr2(MESS(2104, "cannot find matching "), MESSMAKE(aq));
358: return NilTree;
359: }
360:
361: Hidden bool is_conversion(q, v) txptr q; parsetree *v; {
362: if (conv_sign()) {
363: txptr ftx, ttx;
364: req("`", q, &ftx, &ttx);
365: *v= expr(ftx); tx= ttx;
366: return Yes;
367: }
368: return No;
369: }
370:
371: /* ******************************************************************** */
372: /* table_display; list_display; range_display; */
373: /* ******************************************************************** */
374:
375: Hidden bool elt_dis(v) parsetree *v; {
376: if (curlyclose_sign()) {
377: *v= node1(ELT_DIS);
378: return Yes;
379: }
380: return No;
381: }
382:
383: Hidden bool range_dis(q, v) txptr q; parsetree *v; {
384: txptr ftx, ttx;
385: if (find("..", q, &ftx, &ttx)) {
386: parsetree w;
387: if (Char(ttx) == '.') { ftx++; ttx++; }
388: w= singexpr(ftx); tx= ttx;
389: *v= node3(RANGE_DIS, w, singexpr(q));
390: return Yes;
391: }
392: return No;
393: }
394:
395: Forward value tab_comp();
396:
397: Hidden bool tab_dis(q, v) txptr q; parsetree *v; {
398: if (Char(tx) == '[') {
399: *v= node2(TAB_DIS, tab_comp(q, 1));
400: return Yes;
401: }
402: return No;
403: }
404:
405: Hidden value tab_comp(q, n) txptr q; intlet n; {
406: value v; parsetree key, assoc; txptr ftx, ttx;
407: if (find(";", q, &ftx, &ttx)) {
408: tab_elem(ftx, &key, &assoc); tx= ttx;
409: v= tab_comp(q, n+2);
410: } else {
411: tab_elem(q, &key, &assoc);
412: v= mk_compound(n+1);
413: }
414: *Field(v, n-1)= key;
415: *Field(v, n)= assoc;
416: return v;
417: }
418:
419: Hidden Procedure tab_elem(q, key, assoc) txptr q; parsetree *key, *assoc; {
420: txptr ftx, ttx;
421: need("[");
422: req("]", q, &ftx, &ttx);
423: *key= expr(ftx); tx= ttx;
424: need(":");
425: *assoc= singexpr(q);
426: }
427:
428: Forward value list_comp();
429:
430: Hidden Procedure list_dis(q, v) txptr q; parsetree *v; {
431: *v= node2(LIST_DIS, list_comp(q, 1));
432: }
433:
434: Hidden value list_comp(q, n) txptr q; intlet n; {
435: value v; parsetree w; txptr ftx, ttx;
436: if (find(";", q, &ftx, &ttx)) {
437: w= singexpr(ftx); tx= ttx;
438: v= list_comp(q, n+1);
439: } else {
440: w= singexpr(q);
441: v= mk_compound(n);
442: }
443: *Field(v, n-1)= w;
444: return v;
445: }
446:
447: Hidden bool tlr_dis(q, v) txptr q; parsetree *v; {
448: if (curlyopen_sign()) {
449: skipsp(&tx);
450: if (!elt_dis(v)) {
451: txptr ftx, ttx;
452: req("}", q, &ftx, &ttx);
453: if (!range_dis(ftx, v)) {
454: skipsp(&tx);
455: if (!tab_dis(ftx, v)) list_dis(ftx, v);
456: }
457: tx= ttx;
458: }
459: return Yes;
460: }
461: return No;
462: }
463:
464: /* ******************************************************************** */
465: /* selection */
466: /* ******************************************************************** */
467:
468: Visible Procedure selection(q, v) txptr q; parsetree *v; {
469: txptr ftx, ttx;
470: skipsp(&tx);
471: while (Text(q) && sub_sign()) {
472: req("]", q, &ftx, &ttx);
473: *v= node3(SELECTION, *v, expr(ftx)); tx= ttx;
474: skipsp(&tx);
475: }
476: }
477:
478: /* ******************************************************************** */
479: /* trimmed_text */
480: /* ******************************************************************** */
481:
482: Hidden bool is_trimmed_text(q) txptr q; {
483: txptr tx0= tx; bool b;
484: skipsp(&tx);
485: b= Text(q) && trim_sign();
486: tx= tx0;
487: return b;
488: }
489:
490: Hidden Procedure trimmed_text(q, adm, v) txptr q; expadm *adm; parsetree *v; {
491: Trim(adm)= Yes;
492: while (Parsed(adm) && Text(q) && trim_sign()) {
493: State(adm)= S_else;
494: dya_formula(q, adm, v, mk_text(textsign), L_bottom, rbase);
495: skipsp(&tx);
496: }
497: Trim(adm)= No;
498: }
499:
500: Visible Procedure tar_trimmed_text(q, v) txptr q; parsetree *v; {
501: if (is_trimmed_text(q)) {
502: expadm adm;
503: initexp(&adm);
504: Level(&adm)= L_bottom;
505: trimmed_text(q, &adm, v);
506: }
507: }
508:
509: Hidden Procedure exp_trimmed_text(q, adm, v)
510: txptr q; expadm *adm; parsetree *v; {
511:
512: if (!Trim(adm) && is_trimmed_text(q)) {
513: intlet s= State(adm); /* save */
514: if (State(adm) == S_t) adjust_level(adm, L_bottom);
515: trimmed_text(q, adm, v);
516: State(adm)= s; /* restore */
517: }
518: }
519:
520: /* ******************************************************************** */
521: /* unp_expr, unp_test */
522: /* ******************************************************************** */
523:
524: Forward bool item();
525:
526: Hidden parsetree unp_expr(q, adm) txptr q; expadm *adm; {
527: value v;
528: skipsp(&tx);
529: if (Text(q) && item(q, &v)) {
530: return mon_formula(q, adm, v, unp_expr);
531: } else {
532: Parsed(adm)= No;
533: Unp_comp(adm)= mk_compound(N_fld(adm));
534: return node3(UNPARSED, Unp_comp(adm), Vnil);
535: }
536: }
537:
538: Visible parsetree unp_test(q) txptr q; {
539: parsetree v; expadm adm; txptr tx0= tx;
540: initexp(&adm);
541: v= unp_expr(q, &adm);
542: *Branch(v, UNP_TEXT)= cr_text(tx0, tx);
543: return v;
544: }
545:
546: Visible bool tag_operator(q, v) txptr q; value *v; {
547: txptr tx0= tx;
548: if (Text(q) && is_tag(v)) {
549: skipsp(&tx);
550: if (!(Text(q) && (sub_sign() || trim_sign()))) return Yes;
551: else {
552: release(*v);
553: tx= tx0;
554: }
555: }
556: return No;
557: }
558:
559: Hidden bool dm_operator(q, v) txptr q; value *v; {
560: return dyamon_sign() ? (*v= mk_text(textsign), Yes) : tag_operator(q, v);
561: }
562:
563: Hidden bool d_operator(q, v) txptr q; value *v; {
564: return dya_sign() ? (*v= mk_text(textsign), Yes) : dm_operator(q, v);
565: }
566:
567: Hidden bool m_operator(q, v) txptr q; value *v; {
568: return mon_sign() ? (*v= mk_text(textsign), Yes) : dm_operator(q, v);
569: }
570:
571: Hidden bool trim_operator(q, v) txptr q; value *v; {
572: return trim_sign() ? (*v= mk_text(textsign), Yes) : No;
573: }
574:
575: Hidden bool item(q, v) txptr q; value *v; {
576: return tag_operator(q, v) || trim_operator(q, v) ||
577: d_operator(q, v) || m_operator(q, v) ||
578: element(q, v);
579: }
580:
581: /* ******************************************************************** */
582: /* upto_expr */
583: /* ******************************************************************** */
584:
585: Hidden Procedure upto_expr(q) txptr q; {
586: skipsp(&tx);
587: if (Text(q)) {
588: value dum;
589: if (d_operator(q, &dum)) {
590: release(dum);
591: pprerr(Prio);
592: } else parerr(MESS(2105, "something unexpected following expression"));
593: tx= q;
594: }
595: }
596:
597: /* ******************************************************************** */
598:
599: Hidden bool is_opr(v, s) value v; string s; {
600: value t= Vnil;
601: bool is= Is_text(v) && compare(v, t= mk_text(s)) == 0;
602: release(t);
603: return is;
604: }
605:
606: Visible bool b_about(v) value v; { return is_opr(v, "~"); }
607: Visible bool b_numtor(v) value v; { return is_opr(v, "*/"); }
608: Visible bool b_denomtor(v) value v; { return is_opr(v, "/*"); }
609: Visible bool b_plus(v) value v; { return is_opr(v, "+"); }
610: Visible bool b_minus(v) value v; { return is_opr(v, "-"); }
611: Visible bool b_number(v) value v; { return is_opr(v, "#"); }
612: Visible bool b_behead(v) value v; { return is_opr(v, "@"); }
613: Visible bool b_curtail(v) value v; { return is_opr(v, "|"); }
614: #ifdef NOT_USED
615: Visible bool b_times(v) value v; { return is_opr(v, "*"); }
616: Visible bool b_over(v) value v; { return is_opr(v, "/"); }
617: Visible bool b_power(v) value v; { return is_opr(v, "**"); }
618: Visible bool b_join(v) value v; { return is_opr(v, "^"); }
619: Visible bool b_reptext(v) value v; { return is_opr(v, "^^"); }
620: Visible bool b_center(v) value v; { return is_opr(v, "><"); }
621: Visible bool b_leftadj(v) value v; { return is_opr(v, "<<"); }
622: Visible bool b_rightadj(v) value v; { return is_opr(v, ">>"); }
623: #endif
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.