z combinator

diff --git a/src/builtins/combinators.c b/src/builtins/combinators.c
index bd97a452544b194853ac6aee87c85bda82f7b5c4..af8f34e4c22815f03770e074174bc62200c72c8d 100644 (file)
--- a/src/builtins/combinators.c
+++ b/src/builtins/combinators.c
@@ -122,6 +122,23 @@ Sexpr* c_psi(Sexpr* b, Sexpr* rest, Sexpr* env) {
        return ret;
 }
 
+Sexpr* c_z(Sexpr* b, Sexpr* rest, Sexpr* env) {
+       // Zgv = g(Zg)v
+       if(COMB_Z_ARGS != u64_get_num_args(b)) {
+               return cons(b, rest);
+       }
+       Sexpr* args = b->value.b.args;
+       Sexpr* g = clone(car(cdr(args)));
+       Sexpr* v = clone(car(args));
+       sexpr_free(b);
+       Sexpr* g2 = clone(g);
+       Sexpr* z = from_opcode((COMB_PREFIX << 8) | COMB_Z);
+       Sexpr* zg = cons(z, cons(g2, from_nil()));
+       //return cons(g, rest);
+       return cons(g,cons(zg, cons(v, rest)));
+}
+
+
 
 
 Sexpr* x_comb_dispatch(Sexpr* b, Sexpr* rest, Sexpr* env) {
@@ -144,6 +161,8 @@ Sexpr* x_comb_dispatch(Sexpr* b, Sexpr* rest, Sexpr* env) {
                return c_phi(b, rest, env);
        case COMB_PSI:
                return c_psi(b, rest, env);
+       case COMB_Z:
+               return c_z(b, rest, env);
        default:
                return from_nil();
        }
@@ -159,6 +178,7 @@ Sexpr* load_comb_env(Sexpr* env) {
        load_builtin("W", (COMB_PREFIX << 8) | COMB_W, env);
        load_builtin("Phi", (COMB_PREFIX << 8) | COMB_PHI, env);
        load_builtin("Psi", (COMB_PREFIX << 8) | COMB_PSI, env);
+       load_builtin("Z", (COMB_PREFIX << 8) | COMB_Z, env);
        
        return env;
 }

diff --git a/src/builtins/combinators.h b/src/builtins/combinators.h
index 07b4464443f76298da90788cda52f625e7288be2..b64d7ec8ea24ca09523ddba97e648753eeef5f78 100644 (file)
--- a/src/builtins/combinators.h
+++ b/src/builtins/combinators.h
@@ -21,6 +21,8 @@
 #define COMB_PHI_ARGS 4
 #define COMB_PSI 0x07
 #define COMB_PSI_ARGS 4
+#define COMB_Z 0x08
+#define COMB_Z_ARGS 2
 
 Sexpr* x_comb_dispatch(Sexpr* s, Sexpr* rest, Sexpr* env);
 Sexpr* load_comb_env(Sexpr* env);