lambdas wip

TechnoJo4 · Jun 11, 2024 · da44afd · da44afd
1 parent d9b0dd9
commit da44afd
Show file tree

Hide file tree

Showing 4 changed files with 27 additions and 10 deletions.
diff --git a/src/bc.c b/src/bc.c
@@ -1,6 +1,5 @@
 #include "common.h"
 #include "bc.h"
-#include <assert.h>
 
 #define BK(k) ((B)KK(k))
 #define E err(compile)
@@ -27,29 +26,34 @@ S void expr(K t, struct cs* s) {
 #define O(op) *((s->b)++) = (op)
     if (!TV(t)) E;
 
-    if (L(t) == 1) {
-        O(OP_xKST);
-        O(addconst(t, s));
-    }
+    if (L(t) == 1) { O(OP_xKST); O(addconst(t, s)); return; }
 
     K* a = (K*)t; K n0 = a[0];
     switch (T(n0)) {
     case TPsym:
         switch (n0) {
         case PSl: E;//list
-        case PSf: E;//fun
+        case PSf://fun
+            if ((K)s->b != s->cur[2]) { O(OP_xKST); O(addconst(KT(Tfun) | (K)compile(t, s->cur), s)); break; }
         case PSp://progn
             for (i4 i = 1; i < L(t); ++i) expr(a[i], s);
             break;
         default: E;
         }
         break;
+    case 0://temporary
+        if (L(a) != 2) err(nyi);
+        expr(a[1], s);
+        O(OP_STAx);
+        expr(a[0], s);
+        O(OP_ySTA);
+        O(OP_CALL);
+        break;
     case Tverb:
         if (L(a) == 3) {
             if (L(a[1]) == 1) {
                 expr(a[2], s);
-                O(OP_CDBX+BK(n0));
-                O(addconst(a[1], s));
+                O(OP_CDBX+BK(n0)); O(addconst(a[1], s));
             } else {
                 expr(a[2], s);
                 O(OP_STAx);
@@ -65,6 +69,7 @@ S void expr(K t, struct cs* s) {
         expr(a[1], s);
         O(OP_CMBV+BK(n0));
         break;
+    default: err(nyi);
     }
 #undef O
 }

diff --git a/src/bc.h b/src/bc.h
@@ -22,6 +22,7 @@ enum {           //xx       OPER: description of operation
     OP_ySTA,     //0F       ySTA: y:pop
     OP_STAx,     //10       STAx: push x
     OP_STAy,     //11       STAy: push y
+    OP_CALL,     //12       CALL: x:x@y /temporary?
     OP_CDBV=0x20,//2x|3x    CDBV: call verb
     OP_CMBV=0x40,//4x|5x    CMBV: call monad
     OP_xKBV=0x60,//6x|7x    xKBV: x:verb

diff --git a/src/common.h b/src/common.h
@@ -34,6 +34,8 @@ typedef int8_t i1;
 #define Ti8 ((K)5)//boxed
 #define Tf8 ((K)6)
 
+#define Tfun ((K)8)
+
 #define Tdict ((K)20)
 #define Tverb ((K)16)
 #define Tmonad ((K)17)

diff --git a/src/vm.c b/src/vm.c
@@ -28,7 +28,8 @@ void vm(K x, K y, K* c, K* s, B* b) {
     B o = *(b++);
     switch (o) {
     C(OP_TRAP) default: puts("'trap"); return;
-    C(OP_RETN) { K str = stringify(x); printf("'retn x=%s\n", (const char*)PK(str)); return; }
+    C(OP_RETN) if (!c[-2]) { K str = stringify(x); printf("'retn x=%s\n", (const char*)PK(str)); return; }//temporary
+               else { retail vm(x, y, (K*)c[-3], (K*)c[-2], (B*)c[-4]); }
     C(OP_xNIL) vmcont(0, y);
     C(OP_yNIL) vmcont(x, 0);
     C(OP_xKST) vmcont(((K**)c[-1])[1][*(b++)], y);
@@ -45,14 +46,22 @@ void vm(K x, K y, K* c, K* s, B* b) {
     C(OP_ySTA) y = *(s--); vmcont(x, y);
     C(OP_STAx) *(++s) = x; vmcont(x, y);
     C(OP_STAy) *(++s) = y; vmcont(x, y);
+    C(OP_CALL) {
+        K* d = PK(x);
+        *(++s) = (K)b;
+        *(++s) = (K)c;
+        ++s; *s = (K)s;
+        *(++s) = (K)d;
+        retail vm(y, y, s + 1, s, ((B**)d)[2]);
+    }
     C32(OP_CDBV) retail dyads[o-OP_CDBV](x, y, c, s, b);
     C32(OP_CMBV) retail monads[o-OP_CMBV](x, y, c, s, b);
     C32(OP_xKBV) vmtail(x, y);//nyi
     C32(OP_CDBX) y = x; x = ((K**)c[-1])[1][*(b++)]; retail dyads[o-OP_CDBX](x, y, c, s, b);
     }
 }
 
-static K stack[2048] = {0};
+S K stack[2048] = {0};
 void vmentry(K* chunk) {
     stack[0] = 0;
     stack[1] = (K)chunk;