![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to b2uni.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 / bint|
Return to b2uni.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bint |
1.1 root 1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
2:
3: /*
4: $Header: b2uni.c,v 1.4 85/08/22 16:57:24 timo Exp $
5: */
6:
7: #include "b.h"
8: #include "b0fea.h"
9: #include "b1obj.h"
10: #include "b2par.h"
11: #include "b2key.h"
12: #include "b2syn.h"
13: #include "b2nod.h"
14: #include "b3env.h"
15: #include "b3err.h"
16: #include "b3sou.h" /* for permkey() */
17:
18: /* ******************************************************************** */
19: /* unit */
20: /* ******************************************************************** */
21:
22: Visible bool unit_keyword() {
23: bool b; txptr tx0= tx;
24: b= how_to_keyword() || yield_keyword() || test_keyword();
25: tx= tx0;
26: return b;
27: }
28:
29: Hidden value formlist, sharelist;
30: Hidden envtab reftab;
31: Visible literal idf_cntxt;
32:
33: Forward bool is_howto_unit(), is_yield_unit(), is_test_unit();
34: Forward parsetree unicmd_suite(), ref_suite();
35:
36: Visible parsetree unit(heading) bool heading; {
37: parsetree v= NilTree;
38: if (!heading) {
39: lino= 1;
40: cntxt= In_unit;
41: release(uname); uname= Vnil;
42: }
43: if (!is_howto_unit(&v, heading) &&
44: !is_yield_unit(&v, heading) &&
45: !is_test_unit(&v, heading)
46: )
47: parerr(MESS(2800, "no unit keyword where expected"));
48: #ifdef TYPE_CHECK
49: if (!heading) type_check(v);
50: #endif
51: return v;
52: }
53:
54: /* ******************************************************************** */
55: /* howto_unit */
56: /* ******************************************************************** */
57:
58: Forward value hu_formals();
59:
60: Hidden bool is_howto_unit(v, heading) parsetree *v; bool heading; {
61: if (how_to_keyword()) {
62: value kw, w, f;
63: txptr ftx, ttx;
64: if (cur_ilev != 0) parerr(MESS(2801, "unit starts with indentation"));
65: formlist= mk_elt();
66: skipsp(&tx);
67: kw= keyword();
68: release(uname); uname= permkey(kw, How);
69: if (in(kw, kwlist)) pprerr2(kw, MESS(2802, " is a reserved keyword"));
70: req(":", ceol, &ftx, &ttx);
71: idf_cntxt= In_formal;
72: f= hu_formals(ftx, kw); tx= ttx;
73: if (!is_comment(&w)) w= Vnil;
74: *v= node8(HOW_TO, copy(kw), f, w, NilTree, NilTree, Vnil, Vnil);
75: if (!heading) {
76: sharelist= mk_elt();
77: *Branch(*v, HOW_SUITE)= unicmd_suite();
78: reftab= mk_elt();
79: *Branch(*v, HOW_REFINEMENT)= ref_suite();
80: *Branch(*v, HOW_R_NAMES)= reftab;
81: release(sharelist);
82: }
83: release(formlist);
84: return Yes;
85: }
86: return No;
87: }
88:
89: Hidden value hu_formals(q, kw) txptr q; value kw; {
90: value t, v, w;
91: skipsp(&tx);
92: if (Text(q) && is_tag(&t)) treat_idf(t);
93: else t= Vnil;
94: skipsp(&tx);
95: v= Text(q) ? hu_formals(q, keyword()) : Vnil;
96: w= node4(FORMAL, kw, t, v);
97: return w;
98: }
99:
100: /* ******************************************************************** */
101: /* yield_unit */
102: /* ******************************************************************** */
103:
104: Forward parsetree ytu_formals();
105:
106: Hidden bool is_yield_unit(v, heading) parsetree *v; bool heading; {
107: if (yield_keyword()) {
108: parsetree f; value name, w, adicity;
109: txptr ftx, ttx;
110: if (cur_ilev != 0) parerr(MESS(2803, "unit starts with indentation"));
111: formlist= mk_elt();
112: skipsp(&tx);
113: req(":", ceol, &ftx, &ttx);
114: f= ytu_formals(ftx, 'y', &name, &adicity); tx= ttx;
115: if (!is_comment(&w)) w= Vnil;
116: *v= node9(YIELD, copy(name), adicity, f, w, NilTree,
117: NilTree, Vnil, Vnil);
118: if (!heading) {
119: sharelist= mk_elt();
120: *Branch(*v, FPR_SUITE)= unicmd_suite();
121: reftab= mk_elt();
122: *Branch(*v, FPR_REFINEMENT)= ref_suite();
123: *Branch(*v, FPR_R_NAMES)= reftab;
124: release(sharelist);
125: }
126: release(formlist);
127: return Yes;
128: }
129: return No;
130: }
131:
132: /* ******************************************************************** */
133: /* test_unit */
134: /* ******************************************************************** */
135:
136: Hidden bool is_test_unit(v, heading) parsetree *v; bool heading; {
137: if (test_keyword()) {
138: parsetree f; value name, w, adicity;
139: txptr ftx, ttx;
140: if (cur_ilev != 0) parerr(MESS(2804, "unit starts with indentation"));
141: formlist= mk_elt();
142: skipsp(&tx);
143: req(":", ceol, &ftx, &ttx);
144: f= ytu_formals(ftx, 't', &name, &adicity); tx= ttx;
145: if (!is_comment(&w)) w= Vnil;
146: *v= node9(TEST, copy(name), adicity, f, w, NilTree,
147: NilTree, Vnil, Vnil);
148: if (!heading) {
149: sharelist= mk_elt();
150: *Branch(*v, FPR_SUITE)= unicmd_suite();
151: reftab= mk_elt();
152: *Branch(*v, FPR_REFINEMENT)= ref_suite();
153: *Branch(*v, FPR_R_NAMES)= reftab;
154: release(sharelist);
155: }
156: release(formlist);
157: return Yes;
158: }
159: return No;
160: }
161:
162: /* ******************************************************************** */
163:
164: #define FML_IN_FML MESS(2805, " is already a formal parameter or operand")
165: #define SH_IN_FML MESS(2806, " is already a formal parameter")
166: #define SH_IN_SH MESS(2807, " is already a shared identifier")
167: #define REF_IN_FML MESS(2808, " is already a formal parameter")
168: #define REF_IN_SH MESS(2809, " is already a shared identifier")
169: #define REF_IN_REF MESS(2810, " is already a refinement name")
170:
171: Hidden Procedure treat_idf(t) value t; {
172: switch (idf_cntxt) {
173: case In_formal: if (in(t, formlist)) pprerr2(t, FML_IN_FML);
174: insert(t, &formlist);
175: break;
176: case In_share: if (in(t, formlist)) pprerr2(t, SH_IN_FML);
177: if (in(t, sharelist)) pprerr2(t, SH_IN_SH);
178: insert(t, &sharelist);
179: break;
180: case In_ref: if (in(t, formlist)) pprerr2(t, REF_IN_FML);
181: if (in(t, sharelist)) pprerr2(t, REF_IN_SH);
182: break;
183: case In_ranger: break;
184: default: break;
185: }
186: }
187:
188: Forward parsetree fml_operand();
189:
190: Hidden parsetree ytu_formals(q, yt, name, adic)
191: txptr q; char yt; value *name, *adic; {
192:
193: parsetree v1, v2, v3;
194: *name= Vnil;
195: idf_cntxt= In_formal;
196: v1= fml_operand(q);
197: skipsp(&tx);
198: if (!Text(q)) { /* zeroadic */
199: *adic= zero;
200: if (nodetype(v1) == TAG) {
201: *name= *Branch(v1, TAG_NAME);
202: release(uname); uname= permkey(*name, Zer);
203: } else
204: pprerr(MESS(2811, "user defined functions must be tags"));
205: return v1;
206: }
207:
208: v2= fml_operand(q);
209: skipsp(&tx);
210: if (!Text(q)) { /* monadic */
211: *adic= one;
212: if (nodetype(v1) == TAG) {
213: *name= *Branch(v1, TAG_NAME);
214: release(uname); uname= permkey(*name, Mon);
215: } else
216: pprerr(MESS(2812, "no monadic function name"));
217: if (nodetype(v2) == TAG) treat_idf(*Branch(v2, TAG_NAME));
218: return node4(yt == 'y' ? MONF : MONPRD, *name, v2, Vnil);
219: }
220:
221: v3= fml_operand(q);
222: /* dyadic */
223: *adic= mk_integer(2);
224: if (nodetype(v2) == TAG) {
225: *name= *Branch(v2, TAG_NAME);
226: release(uname); uname= permkey(*name, Dya);
227: } else
228: pprerr(MESS(2813, "no dyadic function name"));
229: upto(q, "dyadic formal formula");
230: if (nodetype(v1) == TAG) treat_idf(*Branch(v1, TAG_NAME));
231: if (nodetype(v3) == TAG) treat_idf(*Branch(v3, TAG_NAME));
232: return node5(yt == 'y' ? DYAF : DYAPRD, v1, *name, v3, Vnil);
233: }
234:
235: Hidden parsetree fml_operand(q) txptr q; {
236: value t;
237: skipsp(&tx);
238: if (nothing(q, "formal operand")) return NilTree;
239: else if (is_tag(&t)) return node2(TAG, t);
240: else if (open_sign()) return compound(q, idf);
241: else {
242: parerr(MESS(2814, "no formal operand where expected"));
243: tx= q;
244: return NilTree;
245: }
246: }
247:
248: /* ******************************************************************** */
249: /* unit_command_suite */
250: /* ******************************************************************** */
251:
252: Forward parsetree ucmd_seq();
253:
254: Forward bool share();
255:
256: Hidden parsetree unicmd_suite() {
257: if (ateol())
258: return ucmd_seq(0, Yes);
259: else {
260: parsetree v; value c; intlet l= lino;
261: suite_command(&v, &c);
262: return node5(SUITE, mk_integer(l), v, c, NilTree);
263: }
264: }
265:
266: Hidden parsetree ucmd_seq(cil, first) intlet cil; bool first; {
267: value c; intlet level, l;
268: level= ilev(); l= lino;
269: if (is_comment(&c))
270: return node5(SUITE, mk_integer(l), NilTree, c,
271: ucmd_seq(cil, first));
272: if ((level == cil && !first) || (level > cil && first)) {
273: parsetree v;
274: findceol();
275: if (share(ceol, &v, &c))
276: return node5(SUITE, mk_integer(l), v, c,
277: ucmd_seq(level, No));
278: veli();
279: return cmd_suite(cil, first);
280: }
281: veli();
282: return NilTree;
283: }
284:
285: Hidden bool share(q, v, c) txptr q; parsetree *v; value *c; {
286: if (share_keyword()) {
287: idf_cntxt= In_share;
288: *v= node2(SHARE, idf(q));
289: *c= tail_line();
290: return Yes;
291: }
292: return No;
293: }
294:
295:
296: /* ******************************************************************** */
297: /* refinement_suite */
298: /* ******************************************************************** */
299:
300: Hidden parsetree ref_suite() {
301: value name; bool t;
302: if (ilev() > 0) {
303: parerr(MESS(2815, "indentation where not allowed"));
304: return NilTree;
305: }
306: if ((t= is_tag(&name)) || is_keyword(&name)) {
307: parsetree v, s; value w, *aa, r;
308: skipsp(&tx);
309: if (Char(tx) != ':') {
310: release(name);
311: tx= fcol();
312: veli(); return NilTree;
313: }
314: /* lino= 1; cntxt= In_ref; */
315: tx++;
316: if (t) {
317: idf_cntxt= In_ref;
318: treat_idf(name);
319: }
320: if (in_env(reftab, name, &aa)) pprerr2(name, REF_IN_REF);
321: findceol();
322: if (!is_comment(&w)) w= Vnil;
323: s= cmd_suite(0, Yes);
324: v= node6(REFINEMENT, name, w, s, Vnil, Vnil);
325: e_replace(r= mk_ref(v), &reftab, name);
326: release(r);
327: *Branch(v, REF_NEXT)= ref_suite();
328: return v;
329: }
330: veli();
331: return NilTree;
332: }
333:
334: /* ******************************************************************** */
335: /* collateral, compound */
336: /* ******************************************************************** */
337:
338: Hidden parsetree n_collateral(q, n, base)
339: txptr q; intlet n; parsetree (*base)(); {
340:
341: parsetree v, w; txptr ftx, ttx;
342: if (find(",", q, &ftx, &ttx)) {
343: w= (*base)(ftx); tx= ttx;
344: v= n_collateral(q, n+1, base);
345: } else {
346: w= (*base)(q);
347: if (n == 1) return w;
348: v= mk_compound(n);
349: }
350: *Field(v, n-1)= w;
351: return n > 1 ? v : node2(COLLATERAL, v);
352: }
353:
354: Visible parsetree collateral(q, base) txptr q; parsetree (*base)(); {
355: return n_collateral(q, 1, base);
356: }
357:
358: Visible parsetree compound(q, base) txptr q; parsetree (*base)(); {
359: parsetree v; txptr ftx, ttx;
360: req(")", q, &ftx, &ttx);
361: v= (*base)(ftx); tx= ttx;
362: return node2(COMPOUND, v);
363: }
364:
365: /* ******************************************************************** */
366: /* idf, singidf */
367: /* ******************************************************************** */
368:
369: Hidden parsetree singidf(q) txptr q; {
370: parsetree v;
371: skipsp(&tx);
372: if (nothing(q, "identifier"))
373: v= NilTree;
374: else if (open_sign())
375: v= compound(q, idf);
376: else if (is_tag(&v)) {
377: treat_idf(v);
378: v= node2(TAG, v);
379: } else {
380: parerr(MESS(2816, "no identifier where expected"));
381: v= NilTree;
382: }
383: upto(q, "identifier");
384: return v;
385: }
386:
387: Visible parsetree idf(q) txptr q; {
388: return collateral(q, singidf);
389: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.