![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to b2exp.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bsmall|
Return to b2exp.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bsmall |
1.1 root 1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
2: /* $Header: b2exp.c,v 1.1 84/06/28 00:49:08 timo Exp $ */
3:
4: /* B expression evaluation */
5: #include "b.h"
6: #include "b0con.h"
7: #include "b1obj.h"
8: #include "b1mem.h" /* for ptr */
9: #include "b2env.h"
10: #include "b2syn.h"
11: #include "b2sem.h"
12: #include "b2sou.h"
13:
14: /*************************************************************/
15: /* */
16: /* The operand and operator stacks are modelled as compounds */
17: /* whose first field is the top and whose second field is */
18: /* the remainder of the stack (i.e., linked lists). */
19: /* A cleaner and more efficient implementation of */
20: /* these heavily used stacks would be in order. */
21: /* */
22: /*************************************************************/
23:
24: /* nd = operand, tor = operator (function) */
25:
26: value ndstack, torstack;
27: #define Bot Vnil
28: fun Bra, Ket;
29:
30: Visible Procedure inittors() {
31: ndstack= torstack= Vnil;
32: Bra= mk_fun(-1, -1, Mon, (literal)Dummy, (txptr)Dummy, (txptr)Dummy, (value)Dummy, (bool)Dummy);
33: Ket= mk_fun( 0, 0, Dya, (literal)Dummy, (txptr)Dummy, (txptr)Dummy, (value)Dummy, (bool)Dummy);
34: }
35:
36: Hidden Procedure pop_stack(stack) value *stack; {
37: value oldstack= *stack;
38: *stack= *field(*stack, 1);
39: put_in_field(Vnil, &oldstack, 0); put_in_field(Vnil, &oldstack, 1);
40: release(oldstack);
41: }
42:
43: Hidden value popnd() {
44: value r;
45: if (ndstack == Vnil) syserr("operand stack underflow");
46: r= *field(ndstack, 0);
47: pop_stack(&ndstack);
48: return r;
49: }
50:
51: Hidden Procedure pushnd(nd) value nd; {
52: value s= ndstack;
53: ndstack= mk_compound(2);
54: put_in_field(nd, &ndstack, 0); put_in_field(s, &ndstack, 1);
55: }
56:
57: Hidden Procedure pushmontor(tor) value tor; {
58: value s= torstack;
59: torstack= mk_compound(2);
60: put_in_field(tor, &torstack, 0); put_in_field(s, &torstack, 1);
61: }
62:
63: Hidden Procedure pushdyator(tor2) value tor2; {
64: value tor1; funprd *t1, *t2= Funprd(tor2);
65: intlet L1, H1, L2= t2->L, H2= t2->H;
66: prio: if (torstack == Vnil) syserr("operator stack underflow");
67: tor1= *field(torstack, 0); t1= Funprd(tor1),
68: L1= t1->L; H1= t1->H;
69: if (L2 > H1)
70: if (tor2 == Ket) {
71: if (tor1 != Bra)
72: syserr("local operator stack underflow");
73: pop_stack(&torstack);
74: }
75: else pushmontor(tor2);
76: else if (L1 >= H2) {
77: value nd1= Vnil, nd2= popnd();
78: if (t1->adic == Dya) nd1= popnd();
79: pushnd(formula(nd1, tor1, nd2));
80: if (xeq) {
81: release(nd2);
82: release(nd1);
83: }
84: pop_stack(&torstack);
85: goto prio;
86: } else pprerr("priorities? use ( and ) to resolve", "");
87: }
88:
89: Forward value basexpr();
90: Forward value text_dis();
91: Forward value tl_dis();
92:
93: Hidden value statabsel(t, k) value t, k; {
94: /* temporary, while no static type check */
95: return mk_elt();
96: }
97:
98: Visible value expr(q) txptr q; {
99: value c, v; txptr i, j; intlet len, k;
100: if ((len= 1+count(",", q)) == 1) return basexpr(q);
101: c= mk_compound(len);
102: k_Overfields {
103: if (Lastfield(k)) i= q;
104: else req(",", q, &i, &j);
105: v= basexpr(i);
106: put_in_field(v, &c, k);
107: if (!Lastfield(k)) tx= j;
108: }
109: return c;
110: }
111:
112: Hidden value basexpr(q) txptr q; {
113: value v= obasexpr(q);
114: Skipsp(tx);
115: if (tx < q && Char(tx) == ',')
116: parerr("no commas allowed in this context", "");
117: upto(q, "expression");
118: return v;
119: }
120:
121: Forward bool primary(), clocondis();
122:
123: #define Pbot {pushnd(Bot); pushmontor(Bra);}
124: #define Ipush if (!pushing) {Pbot; pushing= Yes;}
125: #define Fpush if (pushing) { \
126: pushnd(v); pushdyator(Ket); v= popnd(); \
127: if (popnd() != Bot) syserr( \
128: xeq ? "formula evaluation awry" : \
129: "formula parsing awry"); \
130: }
131:
132: Visible value obasexpr(q) txptr q; {
133: value v, t; bool pushing= No;
134: nxtnd: Skipsp(tx);
135: nothing(q, "expression");
136: t= tag();
137: if (primary(q, t, &v, Yes)) /* then t is released */;
138: else if (t != Vnil) {
139: value f;
140: if (is_monfun(t, &f)) {
141: release(t);
142: Ipush;
143: pushmontor(f);
144: goto nxtnd;
145: } else {
146: release(t);
147: error("target has not yet received a value");
148: }
149: } else if (Montormark(Char(tx))) {
150: Ipush;
151: pushmontor(montor());
152: goto nxtnd;
153: } else parerr("no expression where expected", "");
154: /* We are past an operand and look for an operator */
155: Skipsp(tx);
156: if (tx < q) {
157: txptr tx0= tx; bool lt, eq, gt;
158: if (Letter(Char(tx))) {
159: fun f;
160: t= tag();
161: if (is_dyafun(t, &f)) {
162: release(t);
163: Ipush;
164: pushnd(v);
165: pushdyator(f);
166: goto nxtnd;
167: }
168: release(t);
169: } else if (relop(<, &eq, >));
170: else if (Dyatormark(Char(tx))) {
171: Ipush;
172: pushnd(v);
173: pushdyator(dyator());
174: goto nxtnd;
175: }
176: tx= tx0;
177: }
178: Fpush;
179: return v;
180: }
181:
182: Hidden bool clocondis(q, p) txptr q; value *p; {
183: txptr i, j;
184: Skipsp(tx);
185: nothing(q, "expression");
186: if (Char(tx) == '(') {
187: tx++; req(")", q, &i, &j);
188: *p= expr(i); tx= j;
189: return Yes;
190: }
191: if (Dig(Char(tx)) || Char(tx) == '.' || Char(tx) == 'E' &&
192: (Dig(Char(tx+1)) || Char(tx+1)=='+' || Char(tx+1)=='-')) {
193: *p= constant(q);
194: return Yes;
195: }
196: if (Char(tx) == '\'' || Char(tx) == '"') {
197: *p= text_dis(q);
198: return Yes;
199: }
200: if (Char(tx) == '{') {
201: *p= tl_dis(q);
202: return Yes;
203: }
204: return No;
205: }
206:
207: Hidden bool primary(q, t, p, tri) txptr q; value t, *p; bool tri; {
208: /* If a tag has been seen, it is held in t.
209: Releasing t is a task of primary, but only if the call succeeds. */
210: fun f; value tt, relt= Vnil; value *aa= &t;
211: if (t != Vnil) /* tag */ {
212: if (xeq) {
213: tt= t;
214: aa= lookup(t);
215: if (aa == Pnil) {
216: if (is_zerfun(t, &f)) {
217: t= formula(Vnil, f, Vnil);
218: aa= &t;
219: } else return No;
220: } else if (Is_refinement(*aa)) {
221: ref_et(*aa, Ret); t= resval; resval= Vnil;
222: aa= &t;
223: } else if (Is_formal(*aa)) {
224: t= eva_formal(*aa);
225: aa= &t;
226: } else if (Is_shared(*aa)) {
227: if (!in_env(prmnv->tab, t, &aa)) return No;
228: if (Is_filed(*aa))
229: if (!is_tloaded(t, &aa)) return No;
230: t= Vnil;
231: } else if (Is_filed(*aa)) {
232: if (!is_tloaded(t, &aa)) return No;
233: t= Vnil;
234: } else t= Vnil;
235: release(tt);
236: }
237: } else if (clocondis(q, &t)) aa= &t;
238: else return No;
239: Skipsp(tx);
240: while (tx < q && Char(tx) == '[') {
241: txptr i, j; value s;
242: tx++; req("]", q, &i, &j);
243: s= expr(i); tx= j;
244: /* don't copy table for selection */
245: if (xeq) {
246: aa= adrassoc(*aa, s);
247: release(s);
248: relt= t;
249: if (aa == Pnil) error("key not in table");
250: } else {
251: t= statabsel(tt= t, s);
252: release(tt); release(s);
253: }
254: Skipsp(tx);
255: }
256: if (tri && tx < q && (Char(tx) == '@' || Char(tx) == '|')) {
257: intlet B, C;
258: if (xeq && !Is_text(*aa))
259: parerr("in t@p or t|p, t is not a text", "");
260: trimbc(q, xeq ? length(*aa) : 0, &B, &C);
261: if (xeq) {
262: relt= t;
263: t= trim(*aa, B, C);
264: aa= &t;
265: }
266: }
267: *p= t == Vnil || relt != Vnil ? copy(*aa) : t;
268: release(relt);
269: return Yes;
270: }
271:
272: Forward intlet trimi();
273:
274: Visible Procedure trimbc(q, len, B, C) txptr q; intlet len, *B, *C; {
275: char bc; intlet N;
276: *B= *C= 0;
277: while (tx < q && (Char(tx) == '@' || Char(tx) == '|')) {
278: bc= Char(tx++);
279: N= trimi(q);
280: if (bc == '@') *B+= N-1;
281: else *C+= (len-*B-*C)-N;
282: if (*B < 0 || *C < 0 || *B+*C > len)
283: error("in t@p or t|p, p is out of bounds");
284: Skipsp(tx);
285: }
286: }
287:
288: Hidden intlet trimi(q) txptr q; {
289: value v, t; bool pushing= No;
290: nxtnd: Skipsp(tx);
291: nothing(q, "expression");
292: t= tag();
293: if (primary(q, t, &v, No)); /* then t is released */
294: else if (t != Vnil) {
295: value f;
296: if (is_monfun(t, &f)) {
297: release(t);
298: Ipush;
299: pushmontor(f);
300: goto nxtnd;
301: } else {
302: release(t);
303: error("target has not yet received a value");
304: }
305: } else if (Montormark(Char(tx))) {
306: Ipush;
307: pushmontor(montor());
308: goto nxtnd;
309: } else parerr("no expression where expected", "");
310: Fpush;
311: {int ii; intlet i= 0;
312: if (xeq) {
313: ii= intval(v);
314: if (ii < 0) error("in t@p or t|p, p is negative");
315: if (ii > Maxintlet)
316: error("in t@p or t|p, p is excessive");
317: i= ii;
318: }
319: release(v);
320: return i;
321: }
322: }
323:
324: Visible value constant(q) txptr q; {
325: bool dig= No; txptr first= tx;
326: while (tx < q && Dig(Char(tx))) {
327: ++tx;
328: dig= Yes;
329: }
330: if (tx < q && Char(tx) == '.') {
331: tx++;
332: while (tx < q && Dig(Char(tx))) {
333: dig= Yes;
334: ++tx;
335: }
336: if (!dig) pprerr("point without digits", "");
337: }
338: if (tx < q && Char(tx) == 'E') {
339: tx++;
340: if (!(Dig(Char(tx))) && Keymark(Char(tx))) {
341: tx--;
342: goto done;
343: }
344: if (tx < q && (Char(tx) == '+' || Char(tx) == '-')) ++tx;
345: dig= No;
346: while (tx < q && Dig(Char(tx))) {
347: dig= Yes;
348: ++tx;
349: }
350: if (!dig) parerr("E not followed by exponent", "");
351: }
352: done: return numconst(first, tx);
353: }
354:
355: char txdbuf[TXDBUFSIZE];
356: txptr txdbufend= &txdbuf[TXDBUFSIZE];
357:
358: Visible Procedure concat_to(v, s) value* v; string s; { /*TEMPORARY*/
359: value v1, v2;
360: if (*v == Vnil) *v= mk_text(s);
361: else {
362: *v= concat(v1= *v, v2= mk_text(s));
363: release(v1); release(v2);
364: }
365: }
366:
367: Hidden value text_dis(q) txptr q; {
368: char aq[2]; txptr tp= txdbuf; value t= Vnil, t1, t2;
369: aq[1]= '\0'; *aq= Char(tx++);
370: fbuf: while (tx < q && Char(tx) != *aq) {
371: if (Char(tx) == '`') {
372: if (Char(tx+1) == '`') tx++;
373: else {
374: *tp= '\0';
375: concat_to(&t, txdbuf);
376: t= concat(t1= t, t2= conversion(q));
377: release(t1); release(t2);
378: tp= txdbuf; goto fbuf;
379: }
380: }
381: *tp++= Char(tx++);
382: if (tp+1 >= txdbufend) {
383: *(txdbufend-1)= '\0';
384: concat_to(&t, txdbuf);
385: tp= txdbuf;
386: }
387: }
388: if (tx >= q) parerr("cannot find matching ", aq);
389: if (++tx < q && Char(tx) == *aq) {
390: *tp++= Char(tx++);
391: goto fbuf;
392: }
393: *tp= '\0';
394: concat_to(&t, txdbuf);
395: return t;
396: }
397:
398: Visible value conversion(q) txptr q; {
399: txptr f, t; value v, c;
400: thought('`');
401: req("`", q, &f, &t);
402: v= expr(f); c= Ifxeq(convert(v, Yes, Yes));
403: if (xeq) release(v);
404: tx= t; return c;
405: }
406:
407: Hidden value tl_dis(q) txptr q; {
408: txptr f, t, ff, tt;
409: intlet len, k;
410: thought('{');
411: Skipsp(tx);
412: if (Char(tx) == '}') {
413: tx++;
414: return Ifxeq(mk_elt());
415: }
416: req("}", q, &f, &t);
417: if (find("..", f, &ff, &tt)) {
418: value enu, lo, hi;
419: lo= basexpr(ff);
420: if (!xeq || Is_number(lo)) {
421: tx= tt; while (Char(tx) == '.') tx++;
422: hi= basexpr(f);
423: if (xeq) {
424: value entries;
425: if (!integral(lo))
426: error("in {p..q}, p is a number but not an integer");
427: if (!Is_number(hi))
428: error("in {p..q}, p is a number but q is not");
429: if (!integral(hi))
430: error("in {p..q}, q is a number but not an integer");
431: entries= diff(lo, hi);
432: if (compare(entries, one)>0)
433: error("in {p..q}, integer q < x < p");
434: enu= mk_numrange(lo, hi);
435: release(entries);
436: } else enu= mk_elt();
437: release(hi); release(lo);
438: } else if (Is_text(lo)) {
439: char a, z;
440: if (!character(lo))
441: error("in {p..q}, p is a text but not a character");
442: tx= tt; hi= basexpr(f);
443: if (!Is_text(hi))
444: error("in {p..q}, p is a text but q is not");
445: if (!character(hi))
446: error("in {p..q}, q is a text but not a character");
447: a= charval(lo); z= charval(hi);
448: if (z < a-1) error("in {p..q}, character q < x < p");
449: enu= mk_charrange(lo, hi);
450: release(lo); release(hi);
451: } else error("in {p..q}, p is neither a number nor a text");
452: tx= t; return enu;
453: }
454: len= 1+count(";", f);
455: Skipsp(tx);
456: if (Char(tx) == '[') {
457: value ta, ke, a;
458: ta= mk_elt();
459: k_Over_len {
460: Skipsp(tx);
461: need("[");
462: req("]", f, &ff, &tt);
463: ke= expr(ff); tx= tt;
464: need(":");
465: if (Last(k)) {ff= f; tt= t;}
466: else req(";", f, &ff, &tt);
467: a= basexpr(ff); tx= tt;
468: replace(a, &ta, ke);
469: release(ke); release(a);
470: }
471: return ta;
472: }
473: {value l, v;
474: l= mk_elt();
475: k_Over_len {
476: if (Last(k)) {ff= f; tt= t;}
477: else req(";", f, &ff, &tt);
478: v= basexpr(ff); tx= tt;
479: insert(v, &l);
480: release(v);
481: }
482: return l;
483: }
484: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.