diff --git a/src/compile.c b/src/compile.c index 350efe1..b0fa3ec 100644 --- a/src/compile.c +++ b/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}}, diff --git a/src/vm.c b/src/vm.c index ade231b..0211d59 100644 --- a/src/vm.c +++ b/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(""); - 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 { diff --git a/src/vm.h b/src/vm.h index 3eac49e..168fc09 100644 --- a/src/vm.h +++ b/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; diff --git a/std.grr b/std.grr index 5faa2e7..779b125 100644 --- a/std.grr +++ b/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 }