transform.cpp

   1 /* Transform an expression using table look-up
   2
   3 The expression and free variable are on the stack.
   4
   5 The argument s is a null terminated list of transform rules.
   6
   7 For example, see itab.cpp
   8
   9 Internally, the following symbols are used:
  10
  11         F       input expression
  12
  13         X       free variable, i.e. F of X
  14
  15         A       template expression
  16
  17         B       result expression
  18
  19         C       list of conditional expressions
  20 */
  21
  22 #include "stdafx.h"
  23 #include "defs.h"
  24
  25 // p1 and p2 are tmps
  26
  27 #define F p3
  28 #define X p4
  29 #define A p5
  30 #define B p6
  31 #define C p7
  32
  33 void
  34 transform(char **s)
  35 {
  36         int h;
  37
  38         save();
  39
  40         X = pop();
  41         F = pop();
  42
  43         // save symbol context in case eval(B) below calls transform
  44
  45         push(get_binding(symbol(METAA)));
  46         push(get_binding(symbol(METAB)));
  47         push(get_binding(symbol(METAX)));
  48
  49         set_binding(symbol(METAX), X);
  50
  51         // put constants in F(X) on the stack
  52
  53         h = tos;
  54         push_integer(1);
  55         push(F);
  56         push(X);
  57         polyform(); // collect coefficients of x, x^2, etc.
  58         push(X);
  59         decomp();
  60
  61         while (*s) {
  62
  63                 scan_meta(*s);
  64                 p1 = pop();
  65
  66                 A = cadr(p1);
  67                 B = caddr(p1);
  68                 C = cdddr(p1);
  69
  70                 if (f_equals_a(h))
  71                         break;
  72
  73                 s++;
  74         }
  75
  76         tos = h;
  77
  78         if (*s) {
  79                 push(B);
  80                 eval();
  81                 p1 = pop();
  82         } else
  83                 p1 = symbol(NIL);
  84
  85         set_binding(symbol(METAX), pop());
  86         set_binding(symbol(METAB), pop());
  87         set_binding(symbol(METAA), pop());
  88
  89         push(p1);
  90
  91         restore();
  92 }
  93
  94 // search for a METAA and METAB such that F = A
  95
  96 int
  97 f_equals_a(int h)
  98 {
  99         int i, j;
 100         for (i = h; i < tos; i++) {
 101                 set_binding(symbol(METAA), stack[i]);
 102                 for (j = h; j < tos; j++) {
 103                         set_binding(symbol(METAB), stack[j]);
 104                         p1 = C;                         // are conditions ok?
 105                         while (iscons(p1)) {
 106                                 push(car(p1));
 107                                 eval();
 108                                 p2 = pop();
 109                                 if (iszero(p2))
 110                                         break;
 111                                 p1 = cdr(p1);
 112                         }
 113                         if (iscons(p1))                 // no, try next j
 114                                 continue;
 115                         push(F);                        // F = A?
 116                         push(A);
 117                         eval();
 118                         subtract();
 119                         p1 = pop();
 120                         if (iszero(p1))
 121                                 return 1;               // yes
 122                 }
 123         }
 124         return 0;                                       // no
 125 }