1 /***************************************************************************
2 JSPICE3 adaptation of Spice3f2 - Copyright (c) Stephen R. Whiteley 1992
3 Copyright 1990 Regents of the University of California. All rights reserved.
4 Authors: 1985 Wayne A. Christopher
5 1992 Stephen R. Whiteley
6 ****************************************************************************/
7
8 /*
9 * User-defined functions. The user defines the function with
10 * define func(arg1, arg2, arg3) <expression involving args...>
11 * Then when he types "func(1, 2, 3)", the commas are interpreted as
12 * binary operations of the lowest priority by the parser, and ft_substdef()
13 * below is given a chance to fill things in and return what the parse tree
14 * would have been had the entire thing been typed.
15 * Note that we have to take some care to distinguish between functions
16 * with the same name and different arities.
17 */
18
19 #include "spice.h"
20 #include "ftedefs.h"
21
22 #ifdef __STDC__
23 static void savetree(struct pnode*);
24 static void prdefs(char*);
25 static void prtree(struct udfunc*);
26 static void prtree1(struct pnode*);
27 static struct pnode *trcopy(struct pnode*,char*,struct pnode*);
28 static struct pnode *ntharg(int,struct pnode*);
29 #else
30 static void savetree();
31 static void prdefs();
32 static void prtree();
33 static void prtree1();
34 static struct pnode *trcopy();
35 static struct pnode *ntharg();
36 #endif
37
38 static struct udfunc *udfuncs = NULL;
39
40
41 /* Set up a function definition. */
42
43 void
com_define(wlist)44 com_define(wlist)
45
46 wordlist *wlist;
47 {
48 int arity = 0, i;
49 char buf[BSIZE_SP], tbuf[BSIZE_SP], *s, *t, *b;
50 wordlist *wl, *cwl;
51 struct pnode *pn;
52 struct udfunc *udf;
53
54 /* If there's nothing then print all the definitions. */
55 if (wlist == NULL) {
56 prdefs((char *) NULL);
57 return;
58 }
59
60 /* Accumulate the function head in the buffer, w/out spaces. A
61 * useful thing here would be to check to make sure that there
62 * are no formal parameters here called "list". But you have
63 * to try really hard to break this here.
64 */
65 buf[0] = '\0';
66 for (wl = wlist; wl && (strchr(wl->wl_word,')') == NULL);
67 wl = wl->wl_next)
68 (void) strcat(buf, wl->wl_word);
69
70 cwl = wl = wl_copy(wl);
71 if (wl) {
72 for (t = buf; *t; t++);
73 for (s = wl->wl_word; *s && (*s != ')'); s++, t++)
74 *t = *s;
75 *t++ = ')';
76 *t = '\0';
77 if (*++s) {
78 tfree(wl->wl_word);
79 wl->wl_word = copy(s);
80 }
81 else
82 wl = wl->wl_next;
83 }
84
85 /* If that's all, then print the definition. */
86 if (wl == NULL) {
87 prdefs(buf);
88 wl_free(cwl);
89 return;
90 }
91
92 /* Now check to see if this is a valid name for a function (i.e,
93 * there isn't a predefined function of the same name).
94 */
95 (void) strcpy(tbuf, buf);
96 for (b = tbuf; *b; b++)
97 if (isspace(*b) || (*b == '(')) {
98 *b = '\0';
99 break;
100 }
101 for (i = 0; ft_funcs[i].fu_name; i++)
102 if (eq(ft_funcs[i].fu_name, tbuf)) {
103 fprintf(cp_err, "Error: %s is a predefined function.\n",tbuf);
104 wl_free(cwl);
105 return;
106 }
107
108 /* Parse the rest of it. We can't know if there are the right
109 * number of undefined variables in the expression.
110 */
111 if (!(pn = ft_getpnames(wl, false))) {
112 wl_free(cwl);
113 return;
114 }
115
116 /* This is a pain -- when things are garbage-collected, any
117 * vectors that may have been mentioned here will be thrown
118 * away. So go down the tree and save any vectors that aren't
119 * formal parameters.
120 */
121 savetree(pn);
122
123 /* Format the name properly and add to the list. */
124 b = copy(buf);
125 for (s = b; *s; s++) {
126 if (*s == '(') {
127 *s = '\0';
128 if (s[1] != ')')
129 arity++; /* It will have been 0. */
130 }
131 else if (*s == ')') {
132 *s = '\0';
133 }
134 else if (*s == ',') {
135 *s = '\0';
136 arity++;
137 }
138 }
139 for (udf = udfuncs; udf; udf = udf->ud_next)
140 if (prefix(b, udf->ud_name) && (arity == udf->ud_arity))
141 break;
142 if (udf == NULL) {
143 udf = alloc(struct udfunc);
144 if (udfuncs == NULL)
145 udfuncs = udf;
146 else {
147 udf->ud_next = udfuncs;
148 udfuncs = udf;
149 }
150 }
151 else {
152 inp_pnfree(udf->ud_text);
153 tfree(udf->ud_name);
154 }
155 udf->ud_text = pn;
156 udf->ud_name = b;
157 udf->ud_arity = arity;
158 cp_addkword(CT_UDFUNCS, b);
159 wl_free(cwl);
160 return;
161 }
162
163
164 /* Kludge. */
165
166 static void
savetree(pn)167 savetree(pn)
168
169 struct pnode *pn;
170 {
171 struct dvec *d;
172
173 if (pn->pn_value) {
174 /* We specifically don't add this to the plot list
175 * so it won't get gc'ed.
176 */
177 d = pn->pn_value;
178 if ((d->v_length != 0) || eq(d->v_name, "list")) {
179 pn->pn_value = alloc(struct dvec);
180 pn->pn_value->v_name = copy(d->v_name);
181 pn->pn_value->v_length = d->v_length;
182 pn->pn_value->v_type = d->v_type;
183 pn->pn_value->v_flags = d->v_flags;
184 pn->pn_value->v_plot = d->v_plot;
185 if (isreal(d)) {
186 pn->pn_value->v_realdata =
187 (double *) tmalloc(sizeof(double) * d->v_length);
188 DCOPY(d->v_realdata, pn->pn_value->v_realdata, d->v_length);
189 }
190 else {
191 pn->pn_value->v_compdata =
192 (complex *) tmalloc(sizeof(complex) * d->v_length);
193 CCOPY(d->v_compdata, pn->pn_value->v_compdata, d->v_length);
194 }
195 }
196 }
197 else if (pn->pn_op) {
198 savetree(pn->pn_left);
199 if (pn->pn_op->op_arity == 2)
200 savetree(pn->pn_right);
201 }
202 else if (pn->pn_func) {
203 savetree(pn->pn_left);
204 }
205 return;
206 }
207
208
209 /* A bunch of junk to print out nodes. */
210
211 static void
prdefs(name)212 prdefs(name)
213
214 char *name;
215 {
216 struct udfunc *udf;
217 char *s;
218
219 if (name) {
220 s = strchr(name, '(' /* ) */);
221 if (s)
222 *s = '\0';
223 }
224 out_send("\n");
225 if (name && *name) { /* You never know what people will do */
226 for (udf = udfuncs; udf; udf = udf->ud_next)
227 if (eq(name, udf->ud_name))
228 prtree(udf);
229 }
230 else
231 for (udf = udfuncs; udf; udf = udf->ud_next)
232 prtree(udf);
233 out_send("\n");
234 if (s) *s = '(';
235 return;
236 }
237
238
239 /* Print out one definition. */
240
241 static void
prtree(ud)242 prtree(ud)
243
244 struct udfunc *ud;
245 {
246 char *s, buf[BSIZE_SP];
247
248 /* Print the head. */
249 buf[0] = '\0';
250 (void) strcat(buf, ud->ud_name);
251 for (s = ud->ud_name; *s; s++);
252 (void) strcat(buf, " (");
253 s++;
254 while (*s) {
255 (void) strcat(buf, s);
256 while (*s)
257 s++;
258 if (s[1])
259 (void) strcat(buf, ", ");
260 s++;
261 }
262 (void) strcat(buf, ") = ");
263 out_send(buf);
264 prtree1(ud->ud_text);
265 out_send("\n");
266 return;
267 }
268
269
270 static void
prtree1(pn)271 prtree1(pn)
272
273 struct pnode *pn;
274 {
275 if (pn->pn_value) {
276 out_send(pn->pn_value->v_name);
277 }
278 else if (pn->pn_func) {
279 out_printf("%s (", pn->pn_func->fu_name);
280 prtree1(pn->pn_left);
281 out_send(")");
282 }
283 else if (pn->pn_op && (pn->pn_op->op_arity == 2)) {
284 out_send("(");
285 prtree1(pn->pn_left);
286 out_printf(")%s(", pn->pn_op->op_name);
287 prtree1(pn->pn_right);
288 out_send(")");
289 }
290 else if (pn->pn_op && (pn->pn_op->op_arity == 1)) {
291 out_printf("%s(", pn->pn_op->op_name);
292 prtree1(pn->pn_left);
293 out_send(")");
294 }
295 else
296 out_send("<something strange>");
297 return;
298 }
299
300
301 struct pnode *
ft_substdef(name,args)302 ft_substdef(name, args)
303
304 char *name;
305 struct pnode *args;
306 {
307 struct udfunc *udf;
308 struct pnode *tp;
309 char *s;
310 int arity = 0, rarity;
311 bool found = false;
312
313 if (args)
314 arity = 1;
315 for (tp = args; tp && tp->pn_op && (tp->pn_op->op_num == COMMA); tp =
316 tp->pn_right)
317 arity++;
318 for (udf = udfuncs; udf; udf = udf->ud_next)
319 if (eq(name, udf->ud_name)) {
320 if (arity == udf->ud_arity)
321 break;
322 else {
323 found = true;
324 rarity = udf->ud_arity;
325 }
326 }
327 if (udf == NULL) {
328 if (found)
329 fprintf(cp_err,
330 "Warning: the user-defined function %s has %d args\n",
331 name, rarity);
332 return (NULL);
333 }
334 for (s = udf->ud_name; *s; s++)
335 ;
336 s++;
337
338 /* Now we have to traverse the tree and copy it over,
339 * substituting args.
340 */
341 return (trcopy(udf->ud_text, s, args));
342 }
343
344
345 /* Copy the tree and replace formal args with the right stuff. The way
346 * we know that something might be a formal arg is when it is a dvec
347 * with length 0 and a name that isn't "list". I hope nobody calls their
348 * formal parameters "list".
349 */
350
351 static struct pnode *
trcopy(tree,args,nn)352 trcopy(tree, args, nn)
353
354 struct pnode *tree;
355 char *args;
356 struct pnode *nn;
357 {
358 struct pnode *pn;
359 struct dvec *d;
360 struct func *func;
361 struct op *op;
362 char *s, *t;
363 int i;
364
365 if (tree->pn_value) {
366 d = tree->pn_value;
367 if ((d->v_length == 0) && strcmp(d->v_name, "list")) {
368 /* Yep, it's a formal parameter. Substitute for it.
369 * IMPORTANT: we never free parse trees, so we
370 * needn't worry that they aren't trees here.
371 */
372 s = args;
373 i = 1;
374 while (*s) {
375 if (eq(s, d->v_name))
376 return (ntharg(i, nn));
377 if (ciprefix("v(",d->v_name)) {
378 if (ciprefix(s,d->v_name+2)) {
379 t = d->v_name + strlen(s) + 2;
380 while (*t && isspace(*t)) t++;
381 if (*t == ')') {
382 pn = alloc(struct pnode);
383 func = alloc(struct func);
384 pn->pn_func = func;
385 func->fu_func = NULL;
386 func->fu_name = copy("v");
387 pn->pn_left = ntharg(i, nn);
388 return (pn);
389 }
390 }
391 }
392 i++;
393 while (*s++); /* Get past the last '\0'. */
394 }
395 }
396 return (NULL);
397 }
398 else if (tree->pn_func) {
399 pn = alloc(struct pnode);
400 func = alloc(struct func);
401 pn->pn_func = func;
402 func->fu_name = copy(tree->pn_func->fu_name);
403 func->fu_func = tree->pn_func->fu_func;
404 pn->pn_left = trcopy(tree->pn_left, args, nn);
405 }
406 else if (tree->pn_op) {
407 pn = alloc(struct pnode);
408 op = alloc(struct op);
409 pn->pn_op = op;
410 op->op_num = tree->pn_op->op_num;
411 op->op_arity = tree->pn_op->op_arity;
412 op->op_func = tree->pn_op->op_func;
413 op->op_name = copy(tree->pn_op->op_name);
414 pn->pn_left = trcopy(tree->pn_left, args, nn);
415 if (op->op_arity == 2)
416 pn->pn_right = trcopy(tree->pn_right, args, nn);
417 }
418 else {
419 fprintf(cp_err, "trcopy: Internal Error: bad parse node\n");
420 return (NULL);
421 }
422 return (pn);
423 }
424
425
426 /* Find the n'th arg in the arglist, returning NULL if there isn't one.
427 * Since comma has such a low priority and associates to the right,
428 * we can just follow the right branch of the tree num times.
429 * Note that we start at 1 when numbering the args.
430 */
431
432 static struct pnode *
ntharg(num,args)433 ntharg(num, args)
434
435 struct pnode *args;
436 {
437 struct pnode *ptry;
438
439 ptry = args;
440 if (num > 1) {
441 while (--num > 0) {
442 if (ptry && ptry->pn_op &&
443 (ptry->pn_op->op_num != COMMA))
444 if (num == 1)
445 break;
446 else
447 return (NULL);
448 ptry = ptry->pn_right;
449 }
450 }
451 if (ptry && ptry->pn_op && (ptry->pn_op->op_num == COMMA))
452 ptry = ptry->pn_left;
453 return (ptry);
454 }
455
456
457 void
com_undefine(wlist)458 com_undefine(wlist)
459
460 wordlist *wlist;
461 {
462 struct udfunc *udf, *ludf = NULL, *udn;
463
464 if (!wlist)
465 return;
466 if (*wlist->wl_word == '*' || eq(wlist->wl_word,"all")) {
467 for (udf = udfuncs; udf; udf = udn) {
468 udn = udf->ud_next;
469 inp_pnfree(udf->ud_text);
470 tfree(udf->ud_name);
471 tfree(udf);
472 }
473 udfuncs = NULL;
474 return;
475 }
476 while (wlist) {
477 for (udf = udfuncs; udf; udf = udf->ud_next) {
478 if (eq(wlist->wl_word, udf->ud_name)) {
479 if (ludf)
480 ludf->ud_next = udf->ud_next;
481 else
482 udfuncs = udf->ud_next;
483 cp_remkword(CT_UDFUNCS, wlist->wl_word);
484 inp_pnfree(udf->ud_text);
485 tfree(udf->ud_name);
486 tfree(udf);
487 }
488 else
489 ludf = udf;
490 }
491 wlist = wlist->wl_next;
492 }
493 return;
494 }
495