Return to b3fpr.c CVS log

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

Annotation of 43BSD/contrib/B/src/bint/b3fpr.c, revision 1.1

1.1     ! root        1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
        !             2: 
        !             3: /*
        !             4:   $Header: b3fpr.c,v 1.4 85/08/22 16:58:15 timo Exp $
        !             5: */
        !             6: 
        !             7: /* B formula/predicate invocation */
        !             8: #include "b.h"
        !             9: #include "b0fea.h"
        !            10: #include "b1obj.h"
        !            11: #include "b3err.h"
        !            12: #include "b3sem.h"
        !            13: #include "b3sou.h"
        !            14: 
        !            15: #define Other 0
        !            16: #define Nume 1
        !            17: 
        !            18: #define In 1
        !            19: #define Not_in 2
        !            20: #ifdef EXT_COMMAND
        !            21: #define Char_ready 3
        !            22: #endif
        !            23: 
        !            24: /*
        !            25:  * Table defining all predefined functions (but not propositions).
        !            26:  */
        !            27: 
        !            28: #ifdef EXT_COMMAND
        !            29: 
        !            30: extern value e_getchar();
        !            31: extern value e_screensize();
        !            32: extern outcome e_ch_ready();
        !            33: 
        !            34: #endif EXT_COMMAND
        !            35: 
        !            36: struct funtab {
        !            37:        string f_name; literal f_adic, f_kind;
        !            38:        value   (*f_fun)();
        !            39:        bool f_extended;
        !            40: } funtab[] = {
        !            41:        {"~",  Mon, Nume, approximate},
        !            42:        {"+",  Mon, Nume, copy},
        !            43:        {"+",  Dya, Nume, sum},
        !            44:        {"-",  Mon, Nume, negated},
        !            45:        {"-",  Dya, Nume, diff},
        !            46:        {"*/", Mon, Nume, numerator},
        !            47:        {"/*", Mon, Nume, denominator},
        !            48: 
        !            49:        {"*",  Dya, Nume, prod},
        !            50:        {"/",  Dya, Nume, quot},
        !            51:        {"**", Dya, Nume, power},
        !            52: 
        !            53:        {"^",  Dya, Other, concat},
        !            54:        {"^^", Dya, Other, repeat},
        !            55:        {"<<", Dya, Other, adjleft},
        !            56:        {"><", Dya, Other, centre},
        !            57:        {">>", Dya, Other, adjright},
        !            58: 
        !            59:        {"#",  Mon, Other, size},
        !            60:        {"#",  Dya, Other, size2},
        !            61: 
        !            62:        {"pi", Zer, Other, pi},
        !            63:        {"e",  Zer, Other, e},
        !            64: 
        !            65:        {"abs",    Mon, Nume, absval},
        !            66:        {"sign",   Mon, Nume, signum},
        !            67:        {"floor",  Mon, Nume, floorf},
        !            68:        {"ceiling",Mon, Nume, ceilf},
        !            69:        {"round",  Mon, Nume, round1},
        !            70:        {"round",  Dya, Nume, round2},
        !            71:        {"mod",    Dya, Nume, mod},
        !            72:        {"root",   Mon, Nume, root1},
        !            73:        {"root",   Dya, Nume, root2},
        !            74: 
        !            75:        {"sin", Mon, Nume, sin1},
        !            76:        {"cos", Mon, Nume, cos1},
        !            77:        {"tan", Mon, Nume, tan1},
        !            78:        {"atan",Mon, Nume, atn1},
        !            79:        {"atan",Dya, Nume, atn2},
        !            80:        {"exp", Mon, Nume, exp1},
        !            81:        {"log", Mon, Nume, log1},
        !            82:        {"log", Dya, Nume, log2},
        !            83: 
        !            84:        {"keys", Mon, Other, keys},
        !            85:        {"th'of",Dya, Other, th_of},
        !            86:        {"min",  Mon, Other, min1},
        !            87:        {"min",  Dya, Other, min2},
        !            88:        {"max",  Mon, Other, max1},
        !            89:        {"max",  Dya, Other, max2},
        !            90: 
        !            91: #ifdef EXT_COMMAND
        !            92:        /* Extended group: */
        !            93: 
        !            94:        {"get'char", Zer, Other, e_getchar, Yes},
        !            95:        {"screen'size", Zer, Other, e_screensize, Yes},
        !            96: #endif
        !            97: 
        !            98:        {"", Dya, Other, NULL} /*sentinel*/
        !            99: };
        !           100: 
        !           101: Visible Procedure initfpr() {
        !           102:        struct funtab *fp; value r, f, pname;
        !           103:        extern bool extcmds; /* Flag set by -E option */
        !           104:        for (fp= funtab; *(fp->f_name) != '\0'; ++fp) {
        !           105: #ifdef EXT_COMMAND
        !           106:                if (fp->f_extended && !extcmds) continue;
        !           107: #endif
        !           108:                /* Define function */
        !           109:                r= mk_text(fp->f_name);
        !           110:                f= mk_fun(fp->f_adic, (intlet) (fp-funtab), NilTree, Yes);
        !           111:                pname= permkey(r, fp->f_adic);
        !           112:                def_unit(pname, f);
        !           113:                release(f); release(r); release(pname);
        !           114:        }
        !           115: 
        !           116:        defprd("in", Dya, In);
        !           117:        defprd("not'in", Dya, Not_in);
        !           118: #ifdef EXT_COMMAND
        !           119:        if (extcmds) defprd("char'ready", Zer, Char_ready);
        !           120: #endif
        !           121: }
        !           122: 
        !           123: Hidden Procedure defprd(repr, adic, pre) string repr; literal adic; intlet pre; {
        !           124:        value r= mk_text(repr), p= mk_prd(adic, pre, NilTree, Yes), pname;
        !           125:        pname= permkey(r, adic);
        !           126:        def_unit(pname, p);
        !           127:        release(p); release(r); release(pname);
        !           128: }
        !           129: 
        !           130: /* returns if a given test/yield exists *without faults* */
        !           131: Hidden bool is_funprd(t, f, adicity, func) value t, *f; literal adicity; bool func; {
        !           132:        value *aa;
        !           133:        if (!is_unit(t, adicity, &aa)) return No;
        !           134:        if (still_ok) {
        !           135:                if (func) {
        !           136:                        if (!Is_function(*aa)) return No;
        !           137:                } else {
        !           138:                        if (!Is_predicate(*aa)) return No;
        !           139:                }
        !           140:                *f= *aa; return Yes;
        !           141:        } else return No;
        !           142: }
        !           143: 
        !           144: Visible bool is_zerfun(t, f) value t, *f; {
        !           145:        return is_funprd(t, f, Zer, Yes);
        !           146: }
        !           147: 
        !           148: Visible bool is_monfun(t, f) value t, *f; {
        !           149:        return is_funprd(t, f, Mon, Yes);
        !           150: }
        !           151: 
        !           152: Visible bool is_dyafun(t, f) value t, *f; {
        !           153:        return is_funprd(t, f, Dya, Yes);
        !           154: }
        !           155: 
        !           156: Visible bool is_zerprd(t, p) value t, *p; {
        !           157:        return is_funprd(t, p, Zer, No);
        !           158: }
        !           159: 
        !           160: Visible bool is_monprd(t, p) value t, *p; {
        !           161:        return is_funprd(t, p, Mon, No);
        !           162: }
        !           163: 
        !           164: Visible bool is_dyaprd(t, p) value t, *p; {
        !           165:        return is_funprd(t, p, Dya, No);
        !           166: }
        !           167: 
        !           168: Visible value pre_fun(nd1, pre, nd2) value nd1, nd2; intlet pre; {
        !           169:        struct funtab *fp= &funtab[pre]; literal adic= fp->f_adic;
        !           170:        if (fp->f_kind == Nume && adic != Zer) { /* check types */
        !           171:                if (adic == Dya && !Is_number(nd1)) {
        !           172:                        error3(MESSMAKE(fp->f_name), Vnil,
        !           173:                                MESS(4500, " has a non-numeric left operand"));
        !           174:                        return Vnil;
        !           175:                } else if (!Is_number(nd2)) {
        !           176:                        error3(MESSMAKE(fp->f_name), Vnil,
        !           177:                                MESS(4501, " has a non-numeric right operand"));
        !           178:                        return Vnil;
        !           179:                }
        !           180:        }
        !           181:        switch (adic) {
        !           182:                case Zer: return((*fp->f_fun)());
        !           183:                case Mon: return((*fp->f_fun)(nd2));
        !           184:                case Dya: return((*fp->f_fun)(nd1, nd2));
        !           185:                default: syserr(MESS(3300, "pre-defined fpr wrong"));
        !           186:                         /*NOTREACHED*/
        !           187:        }
        !           188: }
        !           189: 
        !           190: Visible outcome pre_prop(nd1, pre, nd2) value nd1, nd2; intlet pre; {
        !           191:        switch (pre) {
        !           192:        case In: return in(nd1, nd2);
        !           193:        case Not_in: return !in(nd1, nd2);
        !           194: #ifdef EXT_COMMAND
        !           195:        case Char_ready: return e_ch_ready();
        !           196: #endif
        !           197:        default:
        !           198:                syserr(MESS(3301, "predicate not covered by proposition"));
        !           199:                /*NOTREACHED*/
        !           200:        }
        !           201: }

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