![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to b2tes.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 b2tes.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: b2tes.c,v 1.2 84/07/05 15:01:46 timo Exp $ */
3:
4: /* B test testing */
5: #include "b.h"
6: #include "b1obj.h"
7: #include "b2key.h"
8: #include "b2env.h"
9: #include "b2syn.h"
10: #include "b2sem.h"
11:
12: #define Tnil ((string) 0)
13:
14: Forward outcome ttest(), stest(), comparison(), quant();
15:
16: Visible outcome test(q) txptr q; {
17: return ttest(q, Tnil);
18: }
19:
20: Hidden outcome ttest(q, ti) txptr q; string ti; {
21: txptr fa, ta, fo, to;
22: bool a= find(AND, q, &fa, &ta), o= find(OR, q, &fo, &to);
23: Skipsp(tx);
24: if (ti != Tnil && (a || o))
25: pprerr("use ( and ) to make AND and/or OR unambiguous after ", ti);
26: if (a && o) parerr("AND and OR intermixed, use ( and )", "");
27: if (atkw(NOT)) return !ttest(q, "NOT");
28: else if (atkw(SOME)) return quant(q, No, No, "SOME");
29: else if (atkw(EACH)) return quant(q, Yes, Yes, "EACH");
30: else if (atkw(NO)) return quant(q, Yes, No, "NO");
31: else if (a) {
32: testa: if (!stest(fa)) return No;
33: tx= ta; if (find(AND, q, &fa, &ta)) goto testa;
34: return ttest(q, Tnil);
35: } else if (o) {
36: testo: if (stest(fo)) return Yes;
37: tx= to; if (find(AND, q, &fo, &to)) goto testo;
38: return ttest(q, Tnil);
39: }
40: return stest(q);
41: }
42:
43: Hidden outcome stest(q) txptr q; {
44: bool o, lt, eq, gt; txptr tx0; value v;
45: Skipsp(tx); tx0= tx;
46: nothing(q, "test");
47: if (Char(tx) == '(') {
48: txptr tx1= ++tx, f, t;
49: req(")", q, &f, &t);
50: tx= t; Skipsp(tx);
51: if (tx < q) {tx= tx0; goto exex;}
52: tx= tx1; o= test(f); tx= t;
53: return o;
54: }
55: if (Letter(Char(tx))) {
56: value t= tag(); prd p;
57: Skipsp(tx);
58: if (tx == q) /* test consists of tag */ {
59: value *aa= lookup(t);
60: if (aa != Pnil && Is_refinement(*aa)) {
61: release(t);
62: ref_et(*aa, Rep);
63: o= resout; resout= Und;
64: return o;
65: } else if (is_zerprd(t, &p)) {
66: release(t);
67: upto(q, "zeroadic test");
68: return proposition(Vnil, p, Vnil);
69: } else
70: pprerr(
71: "tag is neither refined-test nor zeroadic-predicate", "");
72: }
73: if (is_monprd(t, &p)) {
74: release(t);
75: t= obasexpr(q);
76: upto(q, "monadic test");
77: o= proposition(Vnil, p, t); release(t);
78: return o;
79: }
80: release(t); tx= tx0;
81: }
82: exex: v= obasexpr(q); Skipsp(tx);
83: if (relop(<, &eq, >)) {
84: value w;
85: nextv: w= obasexpr(q);
86: if (!comparison(v, w, lt, eq, gt)) {
87: release(v); release(w);
88: return No;
89: }
90: release(v); v= w;
91: Skipsp(tx);
92: if (relop(<, &eq, >)) goto nextv;
93: release(v);
94: upto(q, "comparison");
95: return Yes;
96: }
97: if (Letter(Char(tx))) {
98: value t= tag(); prd p;
99: if (!is_dyaprd(t, &p))
100: pprerr("tag following expression is not a predicate", "");
101: release(t); t= obasexpr(q);
102: upto(q, "dyadic test");
103: o= proposition(v, p, t);
104: release(v); release(t);
105: return o;
106: }
107: parerr("something unexpected following expression in test", "");
108: return (bool) Dummy;
109: }
110:
111: Visible bool relop(lt, eq, gt) bool *lt, *eq, *gt; {
112: txptr tx0= tx;
113: *lt= *eq= *gt= No;
114: Skipsp(tx);
115: switch (Char(tx++)) {
116: case '<':
117: if (Char(tx) == '<') break;
118: *lt= Yes;
119: if (Char(tx) == '=') {
120: tx++; *eq= Yes;
121: } else if (Char(tx) == '>') {
122: tx++; *gt= Yes;
123: }
124: break;
125: case '=':
126: *eq= Yes; break;
127: case '>':
128: if (Char(tx) == '<' || Char(tx) == '>') break;
129: *gt= Yes;
130: if (Char(tx) == '=') {
131: tx++; *eq= Yes;
132: }
133: break;
134: default:
135: break;
136: }
137: if (*lt || *eq || *gt) return Yes;
138: tx= tx0; return No;
139: }
140:
141: Visible outcome comparison(v, w, lt, eq, gt) value v, w; bool lt, eq, gt; {
142: relation c= compare(v, w);
143: return c < 0 ? lt : c == 0 ? eq : gt;
144: }
145:
146: Hidden outcome quant(q, all, each, qt) txptr q; bool all, each; string qt; {
147: /* it is assumed that xeq == Yes */
148: env e0= curnv; bool in= No, par= No, go_on= Yes; loc l; value v, w;
149: txptr ftx, ttx, utx, vtx;
150: reqkw(HAS, &utx, &vtx);
151: if (vtx > q) parerr("HAS follows colon", "");
152: /* as in: SOME i IN x: SHOW i HAS a */
153: if (find(IN_quant, vtx, &ftx, &ttx)) in= Yes;
154: if (find(PARSING, vtx, &ftx, &ttx)) par= Yes;
155: if (!in && !par) parerr("neither IN nor PARSING found", "");
156: if (in && par) parerr("you're kidding; both IN and PARSING", "");
157: l= targ(ftx);
158: if (!(Is_simploc(l) && !par || Is_compound(l)))
159: pprerr("inappropriate identifier after ", qt);
160: bind(l);
161: tx= ttx; v= expr(utx);
162: if (par) {
163: if (!Is_text(v))
164: error("in i1, ... , in PARSING t, t is not a text");
165: part(Length(l), l, 0, v, 0, utx, vtx, &go_on, each, q, qt);
166: } else {
167: value k, k1, len;
168: if (!Is_tlt(v))
169: error("in SOME/EACH/NO i IN t, t is not a text, list or table");
170: len= size(v);
171: k= copy(one);
172: while (go_on && compare(k, len) <= 0) {
173: tx= utx;
174: w= th_of(k, v);
175: put(w, l); release(w);
176: tx= vtx;
177: go_on= each == (ttest(q, qt) == Succ);
178: k= sum(k1= k, one); release(k1);
179: }
180: release(k); release(len);
181: }
182: release(v); release(l); restore_env(e0);
183: return go_on == all ? Succ : Fail;
184: }
185:
186: Hidden part(n, l, f, v, B, utx, vtx, go_on, each, q, qt)
187: intlet n; loc l, v; intlet f, B;
188: txptr utx, vtx; bool *go_on, each; txptr q; string qt; {
189: intlet r= length(v)-B, k; value w;
190: for (k= n == 1 ? r : 0; *go_on && k <= r; k++) {
191: tx= utx;
192: w= trim(v, B, r-k);
193: put(w, *field(l, f)); release(w);
194: if (n == 1) {
195: tx= vtx;
196: *go_on= each == (ttest(q, qt) == Succ);
197: } else part(n-1, l, f+1, v, B+k, utx, vtx, go_on, each, q, qt);
198: }
199: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.