230 lines
3.1 KiB
C++
230 lines
3.1 KiB
C++
#include "stdafx.h"
|
|
#include "defs.h"
|
|
|
|
/* Example: f(x) = x^2
|
|
|
|
p1 -----*-------*---------------*
|
|
| | |
|
|
setq *-------* *-------*-------*
|
|
| | | | |
|
|
f x power x 2
|
|
*/
|
|
|
|
#define NAME p2
|
|
#define ARGS p3
|
|
#define BODY p4
|
|
#define TMP p5
|
|
|
|
void
|
|
define_user_function(void)
|
|
{
|
|
int i, n;
|
|
|
|
NAME = caadr(p1);
|
|
ARGS = cdadr(p1);
|
|
BODY = caddr(p1);
|
|
|
|
if (!issymbol(NAME))
|
|
stop("in function definition, user symbol expected for function name");
|
|
|
|
set_binding_and_arglist(NAME, BODY, ARGS);
|
|
|
|
// do eval, maybe
|
|
|
|
if (car(BODY) == symbol(EVAL)) {
|
|
|
|
// remove eval
|
|
|
|
set_binding_and_arglist(NAME, cadr(BODY), ARGS);
|
|
|
|
// evaluate the function definition using quoted symbols
|
|
|
|
push(NAME);
|
|
TMP = ARGS;
|
|
n = length(TMP);
|
|
for (i = 0; i < n; i++) {
|
|
push_symbol(QUOTE);
|
|
push(car(TMP));
|
|
list(2);
|
|
TMP = cdr(TMP);
|
|
}
|
|
list(n + 1);
|
|
eval();
|
|
|
|
// new binding
|
|
|
|
set_binding_and_arglist(NAME, pop(), ARGS);
|
|
}
|
|
|
|
push(symbol(NIL)); // return value
|
|
}
|
|
|
|
/* Example: f(x,y)
|
|
|
|
p1 -> (f x y)
|
|
|
|
car(p1) -> f
|
|
*/
|
|
|
|
#define FNAME p2
|
|
#define ACTUAL_ARGS p3
|
|
#define FORMAL_ARGS p4
|
|
|
|
void
|
|
eval_user_function(void)
|
|
{
|
|
int h = tos;
|
|
|
|
FNAME = car(p1);
|
|
ACTUAL_ARGS = cdr(p1);
|
|
|
|
// special case for "d"
|
|
|
|
if (FNAME == symbol(SYMBOL_D)
|
|
&& get_arglist(symbol(SYMBOL_D)) == symbol(NIL)) {
|
|
eval_derivative();
|
|
return;
|
|
}
|
|
|
|
// undefined function?
|
|
|
|
if (get_binding(FNAME) == FNAME) {
|
|
push(FNAME);
|
|
while (iscons(ACTUAL_ARGS)) {
|
|
push(car(ACTUAL_ARGS));
|
|
eval();
|
|
ACTUAL_ARGS = cdr(ACTUAL_ARGS);
|
|
}
|
|
list(tos - h);
|
|
return;
|
|
}
|
|
|
|
// argument substitution
|
|
|
|
push(get_binding(FNAME));
|
|
|
|
// replace formal args with placeholders to avoid glare
|
|
// f.e. formal args are A,B and actual args are B,A
|
|
// A gets replaced with B, then all B are replaced with A
|
|
|
|
FORMAL_ARGS = get_arglist(FNAME);
|
|
ACTUAL_ARGS = cdr(p1);
|
|
while (iscons(FORMAL_ARGS) && iscons(ACTUAL_ARGS)) {
|
|
push(car(FORMAL_ARGS));
|
|
push(symbol(SECRETX));
|
|
push(car(FORMAL_ARGS));
|
|
list(2);
|
|
subst();
|
|
FORMAL_ARGS = cdr(FORMAL_ARGS);
|
|
ACTUAL_ARGS = cdr(ACTUAL_ARGS);
|
|
}
|
|
|
|
// replace placeholders with actual args
|
|
|
|
FORMAL_ARGS = get_arglist(FNAME);
|
|
ACTUAL_ARGS = cdr(p1);
|
|
while (iscons(FORMAL_ARGS) && iscons(ACTUAL_ARGS)) {
|
|
push(symbol(SECRETX));
|
|
push(car(FORMAL_ARGS));
|
|
list(2);
|
|
push(car(ACTUAL_ARGS));
|
|
subst();
|
|
FORMAL_ARGS = cdr(FORMAL_ARGS);
|
|
ACTUAL_ARGS = cdr(ACTUAL_ARGS);
|
|
}
|
|
|
|
eval();
|
|
}
|
|
|
|
#if SELFTEST
|
|
|
|
static char *s[] = {
|
|
|
|
// args of generic functions should be evaluated
|
|
|
|
"f(1+2,3*4)",
|
|
"f(3,12)",
|
|
|
|
// simple func def
|
|
|
|
"f(x)=x^2",
|
|
"",
|
|
|
|
"f",
|
|
"x^2",
|
|
|
|
// bindings should be restored
|
|
|
|
"x=123",
|
|
"",
|
|
|
|
"y=345",
|
|
"",
|
|
|
|
"f(x,y)=x^2+y^3",
|
|
"",
|
|
|
|
"f(2,3)",
|
|
"31",
|
|
|
|
"x",
|
|
"123",
|
|
|
|
"y",
|
|
"345",
|
|
|
|
// as above but this time with function bindings
|
|
|
|
"x(a)=sin(a)",
|
|
"",
|
|
|
|
"y(b)=cos(b)",
|
|
"",
|
|
|
|
"f(x,y)=x^2+y^3",
|
|
"",
|
|
|
|
"f(2,3)",
|
|
"31",
|
|
|
|
"x",
|
|
"sin(a)",
|
|
|
|
"y",
|
|
"cos(b)",
|
|
|
|
// eval func body
|
|
|
|
"x=quote(x)",
|
|
"",
|
|
|
|
"p(x)=7+4x",
|
|
"",
|
|
|
|
"w(x)=eval(integral(p(x)))",
|
|
"",
|
|
|
|
"w-2*x^2-7*x",
|
|
"0",
|
|
|
|
"w(5)-w(2)",
|
|
"63",
|
|
|
|
"x=7",
|
|
"",
|
|
|
|
"p(x,y)=eval(x+y)",
|
|
"",
|
|
|
|
"p",
|
|
"x+y",
|
|
};
|
|
|
|
void
|
|
test_user_func(void)
|
|
{
|
|
test(__FILE__, s, sizeof s / sizeof (char *));
|
|
}
|
|
|
|
#endif
|