Return to b2fpr.c CVS log

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

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

1.1     ! root        1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
        !             2: /* $Header: b2fpr.c,v 1.1 84/06/28 00:49:12 timo Exp $ */
        !             3: 
        !             4: /* B formula/predicate invocation */
        !             5: #include "b.h"
        !             6: #include "b1obj.h"
        !             7: #include "b2fil.h"
        !             8: #include "b2env.h"
        !             9: #include "b2sem.h"
        !            10: #include "b2syn.h"
        !            11: #include "b2sou.h"
        !            12: 
        !            13: #define Other 0
        !            14: #define Nume 1
        !            15: 
        !            16: #define In ('[')
        !            17: #define Not_in (']')
        !            18: 
        !            19: /*
        !            20:  * Table defining all predefined functions (not propositions).
        !            21:  */
        !            22: 
        !            23: struct funtab {
        !            24:        char    *f_name;
        !            25:        char    f_lopri, f_hipri;
        !            26:        char    f_adic;
        !            27:        char    f_flag;
        !            28:        value   (*f_fun)();
        !            29: } funtab[] = {
        !            30:        {"~",  8, 8, Mon, Nume, approximate},
        !            31:        {"+",  8, 8, Mon, Nume, copy},
        !            32:        {"+",  2, 2, Dya, Nume, sum},
        !            33:        {"-",  5, 5, Mon, Nume, negated},
        !            34:        {"-",  2, 2, Dya, Nume, diff},
        !            35:        {"*/", 1, 8, Mon, Nume, numerator},
        !            36:        {"/*", 1, 8, Mon, Nume, denominator},
        !            37: 
        !            38:        {"*",  4, 4, Dya, Nume, prod},
        !            39:        {"/",  3, 4, Dya, Nume, quot},
        !            40:        {"**", 6, 7, Dya, Nume, power},
        !            41: 
        !            42:        {"^",  2, 2, Dya, Other, concat},
        !            43:        {"^^", 1, 8, Dya, Other, repeat},
        !            44:        {"<<", 1, 8, Dya, Other, adjleft},
        !            45:        {"><", 1, 8, Dya, Other, centre},
        !            46:        {">>", 1, 8, Dya, Other, adjright},
        !            47: 
        !            48:        {"#",  7, 7, Mon, Other, size},
        !            49:        {"#",  7, 8, Dya, Other, size2},
        !            50: 
        !            51:        {"pi", 8, 8, Zer, Other, pi},
        !            52:        {"e",  8, 8, Zer, Other, e},
        !            53: 
        !            54:        {"abs",    1, 8, Mon, Nume, absval},
        !            55:        {"sign",   1, 8, Mon, Nume, signum},
        !            56:        {"floor",  1, 8, Mon, Nume, floorf},
        !            57:        {"ceiling",1, 8, Mon, Nume, ceilf},
        !            58:        {"round",  1, 8, Mon, Nume, round1},
        !            59:        {"round",  1, 8, Dya, Nume, round2},
        !            60:        {"mod",    1, 8, Dya, Nume, mod},
        !            61:        {"root",   1, 8, Mon, Nume, root1},
        !            62:        {"root",   1, 8, Dya, Nume, root2},
        !            63: 
        !            64:        {"sin", 1, 8, Mon, Nume, sin1},
        !            65:        {"cos", 1, 8, Mon, Nume, cos1},
        !            66:        {"tan", 1, 8, Mon, Nume, tan1},
        !            67:        {"atan",1, 8, Mon, Nume, atn1},
        !            68:        {"atan",1, 8, Dya, Other, atn2},
        !            69:        {"exp", 1, 8, Mon, Nume, exp1},
        !            70:        {"log", 1, 8, Mon, Nume, log1},
        !            71:        {"log", 1, 8, Dya, Other, log2},
        !            72: 
        !            73:        {"keys", 1, 8, Mon, Other, keys},
        !            74:        {"th'of",1, 8, Dya, Other, th_of},
        !            75:        {"min",  1, 8, Mon, Other, min1},
        !            76:        {"min",  1, 8, Dya, Other, min2},
        !            77:        {"max",  1, 8, Mon, Other, max1},
        !            78:        {"max",  1, 8, Dya, Other, max2},
        !            79: 
        !            80:        {"", 0, 0, Dya, Other, NULL} /*sentinel*/
        !            81: };
        !            82: 
        !            83: Visible Procedure initfprs() {
        !            84:        struct funtab *fp; value r, f;
        !            85:        for (fp = funtab; fp->f_lopri != 0; ++fp) {
        !            86:                /* Define function */
        !            87:                r= mk_text(fp->f_name);
        !            88:                f= mk_fun(fp->f_lopri, fp->f_hipri, fp->f_adic,
        !            89:                        Pre, (txptr)(fp-funtab), /*NON-PORTABLE: remove the cast*/
        !            90:                        (txptr)Dummy, (value)Dummy, (bool)Dummy);
        !            91:                def_unit(f, r, fp->f_adic == Zer ? FZR
        !            92:                              :fp->f_adic == Mon ? FMN : FDY);
        !            93:                release(f); release(r);
        !            94:        }
        !            95: 
        !            96:        defprd("in", Dya, Pre, In);
        !            97:        defprd("not'in", Dya, Pre, Not_in);
        !            98: }
        !            99: 
        !           100: Hidden Procedure defprd(repr, adic, def, fux) string repr; literal adic, def, fux; {
        !           101:        literal ad= adic == Zer ? FZR : adic == Mon ? FMN : FDY;
        !           102:        value r= mk_text(repr), p= mk_prd(adic, def, (txptr) fux /*nasty*/, (txptr)Dummy, (value)Dummy, (bool)Dummy);
        !           103:        def_unit(p, r, ad);
        !           104:        release(p); release(r);
        !           105: }
        !           106: 
        !           107: Hidden bool is_funprd(t, f, adicity, func) value t, *f; literal adicity; bool func; {
        !           108:        value *aa, *sl= lookup(t);
        !           109:        if (sl != Pnil) return No;
        !           110:        if (!is_unit(t, adicity, &aa)) return No;
        !           111:        if (func) {
        !           112:                if (!Is_function(*aa)) return No;
        !           113:        } else {
        !           114:                if (!Is_predicate(*aa)) return No;
        !           115:        }
        !           116:        *f= *aa; return Yes;
        !           117: }
        !           118: 
        !           119: Visible bool is_zerfun(t, f) value t, *f; {
        !           120:        return is_funprd(t, f, FZR, Yes);
        !           121: }
        !           122: 
        !           123: Visible bool is_monfun(t, f) value t, *f; {
        !           124:        return is_funprd(t, f, FMN, Yes);
        !           125: }
        !           126: 
        !           127: Visible bool is_dyafun(t, f) value t, *f; {
        !           128:        return is_funprd(t, f, FDY, Yes);
        !           129: }
        !           130: 
        !           131: Visible bool is_zerprd(t, p) value t, *p; {
        !           132:        return is_funprd(t, p, FZR, No);
        !           133: }
        !           134: 
        !           135: Visible bool is_monprd(t, p) value t, *p; {
        !           136:        return is_funprd(t, p, FMN, No);
        !           137: }
        !           138: 
        !           139: Visible bool is_dyaprd(t, p) value t, *p; {
        !           140:        return is_funprd(t, p, FDY, No);
        !           141: }
        !           142: 
        !           143: char torbuf[3];
        !           144: #define Tor *tb++= Char(tx++)
        !           145: #define Rot *tb= '\0'
        !           146: 
        !           147: Visible value montor() {
        !           148:        txptr tb= torbuf; value r, f;
        !           149:        switch (Char(tx)) {
        !           150:        case '~': Tor; break;
        !           151:        case '+': Tor; break;
        !           152:        case '-': Tor; break;
        !           153:        case '*': Tor;
        !           154:                if (Char(tx) != '/') pprerr("function * is not monadic", "");
        !           155:                Tor; break;
        !           156:        case '/': Tor;
        !           157:                if (Char(tx) != '*') pprerr("function / is not monadic", "");
        !           158:                Tor; break;
        !           159:        case '#': Tor; break;
        !           160:        default:  syserr("unhandled Montormark");
        !           161:        }
        !           162:        Rot;
        !           163:        r= mk_text(torbuf);
        !           164:        f= unit_info(r, FMN);
        !           165:        release(r);
        !           166:        return f;
        !           167: }
        !           168: 
        !           169: Visible value dyator() {
        !           170:        txptr tb= torbuf; value r, f;
        !           171:        switch (Char(tx)) {
        !           172:        case '+': Tor; break;
        !           173:        case '-': Tor; break;
        !           174:        case '*': Tor;
        !           175:                {txptr tx0= tx;
        !           176:                loop:   if (Char(tx++) != '*') {tx= tx0; break;}
        !           177:                        if (Char(tx++) != '/') {tx= tx0; Tor; break;}
        !           178:                        goto loop;
        !           179:                }
        !           180:        case '/': Tor; break;
        !           181:        case '^': Tor; if (Char(tx) == '^') Tor; break;
        !           182:        case '<': Tor;
        !           183:                if (Char(tx) != '<') pprerr("order-relator instead of function", "");
        !           184:                Tor; break;
        !           185:        case '>': Tor;
        !           186:                if (Char(tx) != '<' && Char(tx) != '>')
        !           187:                        pprerr("order-relator instead of function", "");
        !           188:                Tor; break;
        !           189:        case '#': Tor; break;
        !           190:        default:  syserr("unhandled Dyatormark");
        !           191:        }
        !           192:        Rot;
        !           193:        r= mk_text(torbuf);
        !           194:        f= unit_info(r, FDY);
        !           195:        release(r);
        !           196:        return f;
        !           197: }
        !           198: 
        !           199: Visible value formula(nd1, tor, nd2) value nd1, tor, nd2; {
        !           200:        funprd *t;
        !           201:        struct funtab *fp;
        !           202:        if (!Is_function(tor)) syserr("formula called with non-function");
        !           203:        if (!xeq) return (value) Dummy;
        !           204:        t= Funprd(tor);
        !           205:        if (!(t->adic==Zer ? nd2==Vnil : (t->adic==Mon) == (nd1==Vnil)))
        !           206:                syserr("invoked formula has other adicity than invoker");
        !           207:        if (t->def == Use) {
        !           208:                value r;
        !           209:                udfpr(nd1, t, nd2, Ret);
        !           210:                r= resval; resval= Vnil;
        !           211:                return r;
        !           212:        }
        !           213:        fp= &funtab[(int)(t->fux)];
        !           214:        if (fp->f_flag == Nume && t->adic != Zer) { /* check types */
        !           215:                if (t->adic == Dya && !Is_number(nd1)) {
        !           216:                        error("left operand not a number");
        !           217:                        return Vnil;
        !           218:                } else if (!Is_number(nd2)) {
        !           219:                        error("right operand not a number");
        !           220:                        return Vnil;
        !           221:                }
        !           222:        }
        !           223:        if (t->adic == Zer) return((*fp->f_fun)());
        !           224:        else if (fp->f_adic == Mon) return((*fp->f_fun)(nd2));
        !           225:        else return((*fp->f_fun)(nd1, nd2));
        !           226: }
        !           227: 
        !           228: Visible outcome proposition(nd1, pred, nd2) value nd1, pred, nd2; {
        !           229:        funprd *p;
        !           230:        if (!Is_predicate(pred)) syserr("proposition called with non-predicate");
        !           231:        if (!xeq) return (outcome) Dummy;
        !           232:        p= Funprd(pred);
        !           233:        if (!(p->adic==Zer ? nd2==Vnil : (p->adic==Mon) == (nd1==Vnil)))
        !           234:                syserr("invoked proposition has other adicity than invoker");
        !           235:        if (p->def == Use) {
        !           236:                outcome o;
        !           237:                udfpr(nd1, p, nd2, Rep);
        !           238:                o= resout; resout= Und;
        !           239:                return o;
        !           240:        }
        !           241:        switch (p->fux) {
        !           242:        case In:
        !           243:                return in(nd1, nd2);
        !           244:        case Not_in:
        !           245:                return !in(nd1, nd2);
        !           246:        default:
        !           247:                syserr("predicate not covered by proposition");
        !           248:                return (outcome) Dummy;
        !           249:        }
        !           250: }

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