# 2.11BSD#431 - /usr/src/new/PORT/B/src/bsmall/b2tes.c

##### Functions

    comparison        X
    part              X
    quant             X
    relop             X
    stest             X
    test              X
    ttest             X

##### Macros

    Tnil              X

       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

comparison defined in line 141; used 3 times

- in line 14, 86
- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 64

part defined in line 186; used 2 times

- in line 165, 197

quant defined in line 146; used 4 times

- in line 14, 28-30(3)

relop defined in line 111; used 4 times

- in line 83, 92
- in /usr/src/new/PORT/B/src/bsmall/b2exp.c line 169
- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 63

stest defined in line 43; used 4 times

- in line 14, 32-40(3)

test defined in line 16; used 7 times

- in line 52
- in /usr/src/new/PORT/B/src/bsmall/b2cmd.c line 92, 239, 257, 341, 495
- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 62

ttest defined in line 20; used 7 times

- in line 14-17(2), 27, 34-38(2), 177, 196

#### Defined macros

Tnil defined in line 12; used 4 times

- in line 17, 24, 34-38(2)

Last modified: 1985-08-27 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 1125 |