2.11BSD#431 - /usr/src/new/PORT/B/src/bint/b3fpr.c

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

Defined functions

Defined variables

Defined struct's

Defined macros