![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to b3fpr.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bint|
Return to b3fpr.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bint |
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.