```   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
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();
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},
56:     {"><", Dya, Other, centre},
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);
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
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;
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; {
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:     }
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
196: #endif
197:     default:
198:         syserr(MESS(3301, "predicate not covered by proposition"));
199:         /*NOTREACHED*/
200:     }
201: }
```

#### Defined functions

defprd defined in line 123; used 3 times
initfpr defined in line 101; used 2 times
is_funprd defined in line 131; used 6 times

#### Defined variables

funtab defined in line 40; used 3 times

#### Defined struct's

funtab defined in line 36; used 4 times

#### Defined macros

Char_ready defined in line 21; used 1 times
In defined in line 18; used 1 times
Not_in defined in line 19; used 1 times
Nume defined in line 16; used 28 times
Other defined in line 15; used 18 times
 Last modified: 1985-08-27 Generated: 2016-12-26 Generated by src2html V0.67 page hit count: 1178