126 lines
1.8 KiB
C++
126 lines
1.8 KiB
C++
/* Transform an expression using table look-up
|
|
|
|
The expression and free variable are on the stack.
|
|
|
|
The argument s is a null terminated list of transform rules.
|
|
|
|
For example, see itab.cpp
|
|
|
|
Internally, the following symbols are used:
|
|
|
|
F input expression
|
|
|
|
X free variable, i.e. F of X
|
|
|
|
A template expression
|
|
|
|
B result expression
|
|
|
|
C list of conditional expressions
|
|
*/
|
|
|
|
#include "stdafx.h"
|
|
#include "defs.h"
|
|
|
|
// p1 and p2 are tmps
|
|
|
|
#define F p3
|
|
#define X p4
|
|
#define A p5
|
|
#define B p6
|
|
#define C p7
|
|
|
|
void
|
|
transform(char **s)
|
|
{
|
|
int h;
|
|
|
|
save();
|
|
|
|
X = pop();
|
|
F = pop();
|
|
|
|
// save symbol context in case eval(B) below calls transform
|
|
|
|
push(get_binding(symbol(METAA)));
|
|
push(get_binding(symbol(METAB)));
|
|
push(get_binding(symbol(METAX)));
|
|
|
|
set_binding(symbol(METAX), X);
|
|
|
|
// put constants in F(X) on the stack
|
|
|
|
h = tos;
|
|
push_integer(1);
|
|
push(F);
|
|
push(X);
|
|
polyform(); // collect coefficients of x, x^2, etc.
|
|
push(X);
|
|
decomp();
|
|
|
|
while (*s) {
|
|
|
|
scan_meta(*s);
|
|
p1 = pop();
|
|
|
|
A = cadr(p1);
|
|
B = caddr(p1);
|
|
C = cdddr(p1);
|
|
|
|
if (f_equals_a(h))
|
|
break;
|
|
|
|
s++;
|
|
}
|
|
|
|
tos = h;
|
|
|
|
if (*s) {
|
|
push(B);
|
|
eval();
|
|
p1 = pop();
|
|
} else
|
|
p1 = symbol(NIL);
|
|
|
|
set_binding(symbol(METAX), pop());
|
|
set_binding(symbol(METAB), pop());
|
|
set_binding(symbol(METAA), pop());
|
|
|
|
push(p1);
|
|
|
|
restore();
|
|
}
|
|
|
|
// search for a METAA and METAB such that F = A
|
|
|
|
int
|
|
f_equals_a(int h)
|
|
{
|
|
int i, j;
|
|
for (i = h; i < tos; i++) {
|
|
set_binding(symbol(METAA), stack[i]);
|
|
for (j = h; j < tos; j++) {
|
|
set_binding(symbol(METAB), stack[j]);
|
|
p1 = C; // are conditions ok?
|
|
while (iscons(p1)) {
|
|
push(car(p1));
|
|
eval();
|
|
p2 = pop();
|
|
if (iszero(p2))
|
|
break;
|
|
p1 = cdr(p1);
|
|
}
|
|
if (iscons(p1)) // no, try next j
|
|
continue;
|
|
push(F); // F = A?
|
|
push(A);
|
|
eval();
|
|
subtract();
|
|
p1 = pop();
|
|
if (iszero(p1))
|
|
return 1; // yes
|
|
}
|
|
}
|
|
return 0; // no
|
|
}
|