rework compose implementation to not use retain stack

src/compile.c

@@ -29,8 +29,6 @@ struct {
   {"dig",     {OP_DIG, 0}},
   {">r",      {OP_TOR, 0}},
   {"r>",      {OP_FROMR, 0}},
-  {"dip",     {OP_SWAP, OP_TOR, OP_CALL, OP_FROMR, 0}},
-  {"keep",    {OP_OVER, OP_TOR, OP_CALL, OP_FROMR, 0}},
   {"if",      {OP_CHOOSE, OP_CALL, 0}},
   {"call",    {OP_CALL, 0}},
   {"compose", {OP_COMPOSE, 0}},

src/vm.c

@@ -45,13 +45,17 @@ V vm_init(Vm *vm) {
   for (Z i = 0; i < STACK_SIZE; i++) {
     vm->stack[i] = NIL;
     vm->tstack[i] = NIL;
+    vm->rstack[i].obj = NIL;
     gc_addroot(&vm->gc, &vm->stack[i]);
     gc_addroot(&vm->gc, &vm->tstack[i]);
+    gc_addroot(&vm->gc, &vm->rstack[i].obj);
   }
 
+  vm->next_call = NIL;
+  gc_addroot(&vm->gc, &vm->next_call);
+
   vm->trampoline = chunk_new("<trampoline>");
-  chunk_emit_byte(vm->trampoline, OP_FROMR);
-  chunk_emit_byte(vm->trampoline, OP_TAIL_CALL);
+  chunk_emit_byte(vm->trampoline, OP_CALL_NEXT);
 
   vm->stdin = userdata_make(vm, (void *)stdin, &userdata_file);
   vm->stdout = userdata_make(vm, (void *)stdout, &userdata_file);
@@ -128,6 +132,7 @@ V vm_rpush(Vm *vm, Bc *chunk, U8 *ip) {
     vm_error(vm, VM_ERR_STACK_OVERFLOW, "return stack overflow");
   vm->rsp->chunk = chunk;
   vm->rsp->ip = ip;
+  vm->rsp->obj = NIL;
   vm->rsp++;
 }
 Fr vm_rpop(Vm *vm) {
@@ -268,7 +273,7 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
       case TYPE_COMPOSE: {
         Qo *comp = (Qo *)(UNBOX(quot) + 1);
         vm_rpush(vm, vm->trampoline, vm->trampoline->items);
-        vm_tpush(vm, comp->second);
+        vm->rsp[-1].obj = comp->second;
         quot = comp->first;
         goto do_call;
       }
@@ -293,6 +298,10 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
       vm->ip = word->chunk->items;
       break;
     }
+    case OP_CALL_NEXT:
+      vm_push(vm, vm->next_call);
+      vm->next_call = NIL;
+      // fallthrough
     case OP_TAIL_CALL: {
       O quot = vm_pop(vm);
     do_tail_call:
@@ -307,7 +316,7 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
       case TYPE_COMPOSE: {
         Qo *comp = (Qo *)(UNBOX(quot) + 1);
         vm_rpush(vm, vm->trampoline, vm->trampoline->items);
-        vm_tpush(vm, comp->second);
+        vm->rsp[-1].obj = comp->second;
         quot = comp->first;
         goto do_tail_call;
       }
@@ -368,6 +377,7 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
     case OP_RETURN:
       if (vm->rsp != vm->rstack) {
         Fr frame = vm_rpop(vm);
+        vm->next_call = frame.obj;
         vm->chunk = frame.chunk;
         vm->ip = frame.ip;
       } else {

src/vm.h

@@ -51,6 +51,7 @@ enum {
   OP_AND,
   OP_OR,
   OP_CONCAT,
+  OP_CALL_NEXT,
 };
 
 #define STACK_SIZE 256
@@ -58,6 +59,7 @@ enum {
 typedef struct Fr {
   Bc *chunk;
   U8 *ip;
+  O obj;
 } Fr;
 
 typedef struct Vm {
@@ -71,6 +73,7 @@ typedef struct Vm {
   Ar arena;
   jmp_buf error;
   Bc *trampoline;
+  O next_call;
 
   // These objects need to stay as roots!
   O stdin, stdout, stderr;

std.grr

@@ -8,6 +8,8 @@ def eprintln { stderr fprint "\n" stderr fprint }
 def when { [] if }
 def unless { swap when }
 
+def dip { swap [] curry compose call }
+def keep { over [call] dip }
 def bi { [keep] dip call }
 def tri { [[keep] dip keep] dip call }