Return to b2tes.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bsmall

Annotation of 43BSD/contrib/B/src/bsmall/b2tes.c, revision 1.1

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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.