```   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);
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);
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(&lt, &eq, &gt)) {
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(&lt, &eq, &gt)) 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);
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: }
```

#### Defined functions

comparison defined in line 141; used 3 times
part defined in line 186; used 2 times
quant defined in line 146; used 4 times
relop defined in line 111; used 4 times
stest defined in line 43; used 4 times
test defined in line 16; used 7 times
ttest defined in line 20; used 7 times

#### Defined macros

Tnil defined in line 12; used 4 times
 Last modified: 1985-08-27 Generated: 2016-12-26 Generated by src2html V0.67 page hit count: 2492