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

##### Functions

    defprd            X
    dyator            X
    formula           X
    initfprs          X
    is_dyafun         X
    is_dyaprd         X
    is_funprd         X
    is_monfun         X
    is_monprd         X
    is_zerfun         X
    is_zerprd         X
    montor            X
    proposition       X

##### Variables

    funtab            X
    torbuf            X

##### Macros

    In                X
    Not_in            X
    Nume              X
    Other             X
    Rot               X
    Tor               X

##### struct's

    funtab            X

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

#### Defined functions

defprd defined in line 100; used 2 times

- in line 96-97(2)

dyator defined in line 169; used 2 times

- in /usr/src/new/PORT/B/src/bsmall/b2exp.c line 173
- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 43

formula defined in line 199; used 3 times

- in /usr/src/new/PORT/B/src/bsmall/b2exp.c line 79, 217
- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 44

initfprs defined in line 83; used 1 times

- in /usr/src/new/PORT/B/src/bsmall/b2mai.c line 105

is_dyafun defined in line 127; used 2 times

- in /usr/src/new/PORT/B/src/bsmall/b2exp.c line 161
- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 38

is_dyaprd defined in line 139; used 2 times

- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 41
- in /usr/src/new/PORT/B/src/bsmall/b2tes.c line 99

is_funprd defined in line 107; used 6 times

- in line 120-140(6)

is_monfun defined in line 123; used 3 times

- in /usr/src/new/PORT/B/src/bsmall/b2exp.c line 140, 296
- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 37

is_monprd defined in line 135; used 2 times

- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 40
- in /usr/src/new/PORT/B/src/bsmall/b2tes.c line 73

is_zerfun defined in line 119; used 2 times

- in /usr/src/new/PORT/B/src/bsmall/b2exp.c line 216
- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 36

is_zerprd defined in line 131; used 2 times

- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 39
- in /usr/src/new/PORT/B/src/bsmall/b2tes.c line 65

montor defined in line 147; used 3 times

- in /usr/src/new/PORT/B/src/bsmall/b2exp.c line 151, 307
- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 42

proposition defined in line 228; used 4 times

- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 45
- in /usr/src/new/PORT/B/src/bsmall/b2tes.c line 68, 77, 103

#### Defined variables

funtab defined in line 29; used 3 times

- in line 85-89(2), 213

torbuf defined in line 143; used 4 times

- in line 148, 163, 170, 193

#### Defined struct's

funtab defined in line 23; used 4 times

- in line 84(2), 201(2)

#### Defined macros

In defined in line 16; used 1 times

- in line 96

Not_in defined in line 17; used 1 times

- in line 97

Nume defined in line 14; used 26 times

- in line 30-40(10), 54-70(15), 214

Other defined in line 13; used 18 times

- in line 42-52(9), 68-80(9)

Rot defined in line 145; used 2 times

- in line 162, 192

Tor defined in line 144; used 20 times

- in line 150-159(8), 172-189(12)

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