```   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;
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);
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; {
102:     value r= mk_text(repr), p= mk_prd(adic, def, (txptr) fux /*nasty*/, (txptr)Dummy, (value)Dummy, (bool)Dummy);
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);
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);
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
dyator defined in line 169; used 2 times
initfprs defined in line 83; used 1 times
is_dyafun defined in line 127; used 2 times
is_funprd defined in line 107; used 6 times
is_zerfun defined in line 119; used 2 times

#### Defined variables

funtab defined in line 29; used 3 times
torbuf defined in line 143; used 4 times

#### Defined struct's

funtab defined in line 23; used 4 times

#### 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
Other defined in line 13; used 18 times
Rot defined in line 145; used 2 times
Tor defined in line 144; used 20 times
 Last modified: 1985-08-27 Generated: 2016-12-26 Generated by src2html V0.67 page hit count: 3754