4.3BSD - /usr/src/new/B/src/bsmall/b2tes.c

   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(&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);
 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: }

Defined functions

Defined macros