diff --git a/examples/compose.grr b/examples/compose.grr deleted file mode 100644 index 2565021..0000000 --- a/examples/compose.grr +++ /dev/null @@ -1,5 +0,0 @@ -5 [1 +] [2 *] compose -call . - -10 5 [+] curry -call . diff --git a/src/compile.c b/src/compile.c index b0fa3ec..e71430d 100644 --- a/src/compile.c +++ b/src/compile.c @@ -19,40 +19,40 @@ struct { const char *name; U8 opcode[8]; } primitives[] = { - {"nil", {OP_NIL, 0}}, - {"dup", {OP_DUP, 0}}, - {"drop", {OP_DROP, 0}}, - {"swap", {OP_SWAP, 0}}, - {"over", {OP_OVER, 0}}, - {"nip", {OP_NIP, 0}}, - {"bury", {OP_BURY, 0}}, - {"dig", {OP_DIG, 0}}, - {">r", {OP_TOR, 0}}, - {"r>", {OP_FROMR, 0}}, - {"if", {OP_CHOOSE, OP_CALL, 0}}, - {"call", {OP_CALL, 0}}, - {"compose", {OP_COMPOSE, 0}}, - {"curry", {OP_CURRY, 0}}, - {"?", {OP_CHOOSE, 0}}, - {"+", {OP_ADD, 0}}, - {"-", {OP_SUB, 0}}, - {"*", {OP_MUL, 0}}, - {"/", {OP_DIV, 0}}, - {"%", {OP_MOD, 0}}, - {"logand", {OP_LOGAND, 0}}, - {"logor", {OP_LOGOR, 0}}, - {"logxor", {OP_LOGXOR, 0}}, - {"lognot", {OP_LOGNOT, 0}}, - {"=", {OP_EQ, 0}}, - {"<>", {OP_NEQ, 0}}, - {"<", {OP_LT, 0}}, - {">", {OP_GT, 0}}, - {"<=", {OP_LTE, 0}}, - {">=", {OP_GTE, 0}}, - {"and", {OP_AND, 0}}, - {"or", {OP_OR, 0}}, - {"^", {OP_CONCAT, 0}}, - {NULL, {0}}, + {"nil", {OP_NIL, 0}}, + {"dup", {OP_DUP, 0}}, + {"drop", {OP_DROP, 0}}, + {"swap", {OP_SWAP, 0}}, + {"over", {OP_OVER, 0}}, + {"nip", {OP_NIP, 0}}, + {"bury", {OP_BURY, 0}}, + {"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}}, + {"?", {OP_CHOOSE, 0}}, + {"+", {OP_ADD, 0}}, + {"-", {OP_SUB, 0}}, + {"*", {OP_MUL, 0}}, + {"/", {OP_DIV, 0}}, + {"%", {OP_MOD, 0}}, + {"logand", {OP_LOGAND, 0}}, + {"logor", {OP_LOGOR, 0}}, + {"logxor", {OP_LOGXOR, 0}}, + {"lognot", {OP_LOGNOT, 0}}, + {"=", {OP_EQ, 0}}, + {"<>", {OP_NEQ, 0}}, + {"<", {OP_LT, 0}}, + {">", {OP_GT, 0}}, + {"<=", {OP_LTE, 0}}, + {">=", {OP_GTE, 0}}, + {"and", {OP_AND, 0}}, + {"or", {OP_OR, 0}}, + {"^", {OP_CONCAT, 0}}, + {NULL, {0}}, }; // clang-format on diff --git a/src/debug.c b/src/debug.c index eda0ee6..e414e56 100644 --- a/src/debug.c +++ b/src/debug.c @@ -114,8 +114,6 @@ static Z dis_instr(Bc *chunk, Z offset, Dt **dictionary, I indent) { printf("PRIM \"%s\"\n", prim.name); return offset + bytes_read; } - SIMPLE(COMPOSE); - SIMPLE(CURRY); SIMPLE(RETURN); SIMPLE(CHOOSE); SIMPLE(ADD); diff --git a/src/gc.c b/src/gc.c index c67ea3c..0add844 100644 --- a/src/gc.c +++ b/src/gc.c @@ -101,6 +101,7 @@ V gc_collect(Vm *vm) { } Hd *hdr = (Hd *)scan; switch (hdr->type) { + // TODO: the rest of the owl case OBJ_STR: break; case OBJ_QUOT: { @@ -110,18 +111,6 @@ V gc_collect(Vm *vm) { chunk->constants.items[i] = forward(gc, chunk->constants.items[i]); break; } - case OBJ_COMPOSE: { - Qo *comp = (Qo *)(hdr + 1); - comp->first = forward(gc, comp->first); - comp->second = forward(gc, comp->second); - break; - }; - case OBJ_CURRY: { - Qc *curry = (Qc *)(hdr + 1); - curry->value = forward(gc, curry->value); - curry->callable = forward(gc, curry->callable); - break; - }; case OBJ_USERDATA: break; case OBJ_FWD: diff --git a/src/object.h b/src/object.h index f987b5f..34ce4b0 100644 --- a/src/object.h +++ b/src/object.h @@ -13,8 +13,6 @@ enum { OBJ_FWD = 2, OBJ_QUOT, - OBJ_COMPOSE, - OBJ_CURRY, OBJ_STR, OBJ_USERDATA, }; @@ -24,8 +22,6 @@ enum { TYPE_NUM = 1, TYPE_FWD = OBJ_FWD, TYPE_QUOT = OBJ_QUOT, - TYPE_COMPOSE = OBJ_COMPOSE, - TYPE_CURRY = OBJ_CURRY, TYPE_STR = OBJ_STR, TYPE_USERDATA = OBJ_USERDATA, }; @@ -37,20 +33,6 @@ typedef struct Hd { U32 size, type; } Hd; -/** Composition */ -typedef struct Qo { - O first, second; -} Qo; - -/** Curry */ -typedef struct Qc { - O value, callable; -} Qc; // - I type(O); -static inline I callable(O o) { - I t = type(o); - return t == TYPE_QUOT || t == TYPE_COMPOSE || t == TYPE_CURRY; -} #endif diff --git a/src/print.c b/src/print.c index 8549e5d..1407963 100644 --- a/src/print.c +++ b/src/print.c @@ -20,12 +20,6 @@ V print(O o) { case OBJ_QUOT: printf(""); break; - case OBJ_COMPOSE: - printf(""); - break; - case OBJ_CURRY: - printf(""); - break; case OBJ_STR: { // TODO: make this binary safe Str *s = string_unwrap(o); diff --git a/src/vm.c b/src/vm.c index 0211d59..ae56946 100644 --- a/src/vm.c +++ b/src/vm.c @@ -5,12 +5,12 @@ #include "chunk.h" #include "compile.h" #include "dictionary.h" -#include "file.h" #include "gc.h" #include "object.h" #include "primitive.h" -#include "string.h" #include "userdata.h" +#include "file.h" +#include "string.h" #include "vm.h" static I decode_sleb128(U8 **ptr) { @@ -45,18 +45,10 @@ 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_CALL_NEXT); - vm->stdin = userdata_make(vm, (void *)stdin, &userdata_file); vm->stdout = userdata_make(vm, (void *)stdout, &userdata_file); vm->stderr = userdata_make(vm, (void *)stderr, &userdata_file); @@ -67,8 +59,6 @@ V vm_init(Vm *vm) { } V vm_deinit(Vm *vm) { - chunk_release(vm->trampoline); - // Free all definitions Dt *dstack[256]; Dt **dsp = dstack; @@ -132,7 +122,6 @@ 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) { @@ -260,31 +249,13 @@ I vm_run(Vm *vm, Bc *chunk, I offset) { } case OP_CALL: { O quot = vm_pop(vm); - vm_rpush(vm, vm->chunk, vm->ip); - do_call: - switch (type(quot)) { - case TYPE_QUOT: { + if (type(quot) == TYPE_QUOT) { Bc **ptr = (Bc **)(UNBOX(quot) + 1); Bc *chunk = *ptr; + vm_rpush(vm, vm->chunk, vm->ip); vm->chunk = chunk; vm->ip = chunk->items; - break; - } - case TYPE_COMPOSE: { - Qo *comp = (Qo *)(UNBOX(quot) + 1); - vm_rpush(vm, vm->trampoline, vm->trampoline->items); - vm->rsp[-1].obj = comp->second; - quot = comp->first; - goto do_call; - } - case TYPE_CURRY: { - Qc *curry = (Qc *)(UNBOX(quot) + 1); - vm_push(vm, curry->value); - quot = curry->callable; - goto do_call; - break; - } - default: + } else { vm_error(vm, VM_ERR_TYPE, "attempt to call non-quotation object"); } break; @@ -298,37 +269,15 @@ 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: - switch (type(quot)) { - case TYPE_QUOT: { + if (type(quot) == TYPE_QUOT) { Bc **ptr = (Bc **)(UNBOX(quot) + 1); Bc *chunk = *ptr; vm->chunk = chunk; vm->ip = chunk->items; - break; - } - case TYPE_COMPOSE: { - Qo *comp = (Qo *)(UNBOX(quot) + 1); - vm_rpush(vm, vm->trampoline, vm->trampoline->items); - vm->rsp[-1].obj = comp->second; - quot = comp->first; - goto do_tail_call; - } - case TYPE_CURRY: { - Qc *curry = (Qc *)(UNBOX(quot) + 1); - vm_push(vm, curry->value); - quot = curry->callable; - goto do_tail_call; - break; - } - default: - vm_error(vm, VM_ERR_TYPE, "attempt to call non-quotation object"); + } else { + vm_error(vm, VM_ERR_TYPE, "attempt to call non-quotation object\n"); } break; } @@ -340,44 +289,9 @@ I vm_run(Vm *vm, Bc *chunk, I offset) { vm_error(vm, err, "primitive call failed"); break; } - case OP_COMPOSE: { - I mark = gc_mark(&vm->gc); - O c1 = vm_pop(vm); - O c2 = vm_pop(vm); - gc_addroot(&vm->gc, &c2); - gc_addroot(&vm->gc, &c1); - if (!callable(c2) || !callable(c1)) - vm_error(vm, VM_ERR_TYPE, "non-callable arguments to compose"); - Hd *hd = gc_alloc(vm, sizeof(Hd) + sizeof(Qo)); - hd->type = OBJ_COMPOSE; - Qo *comp = (Qo *)(hd + 1); - comp->first = c2; - comp->second = c1; - vm_push(vm, BOX(hd)); - gc_reset(&vm->gc, mark); - break; - } - case OP_CURRY: { - I mark = gc_mark(&vm->gc); - O cble = vm_pop(vm); - O value = vm_pop(vm); - gc_addroot(&vm->gc, &cble); - gc_addroot(&vm->gc, &value); - if (!callable(cble)) - vm_error(vm, VM_ERR_TYPE, "non-callable argument to curry"); - Hd *hd = gc_alloc(vm, sizeof(Hd) + sizeof(Qc)); - hd->type = OBJ_CURRY; - Qc *curry = (Qc *)(hd + 1); - curry->value = value; - curry->callable = cble; - vm_push(vm, BOX(hd)); - gc_reset(&vm->gc, mark); - break; - } 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 168fc09..8fb4b55 100644 --- a/src/vm.h +++ b/src/vm.h @@ -29,8 +29,6 @@ enum { OP_TAIL_DOWORD, // Tail call to dictionary word (reuses current frame) OP_TAIL_CALL, // Tail call to quotation (reuses current frame) OP_PRIM, - OP_COMPOSE, - OP_CURRY, OP_RETURN, OP_CHOOSE, OP_ADD, @@ -51,7 +49,6 @@ enum { OP_AND, OP_OR, OP_CONCAT, - OP_CALL_NEXT, }; #define STACK_SIZE 256 @@ -59,7 +56,6 @@ enum { typedef struct Fr { Bc *chunk; U8 *ip; - O obj; } Fr; typedef struct Vm { @@ -72,8 +68,6 @@ typedef struct Vm { Dt *dictionary; 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 779b125..5faa2e7 100644 --- a/std.grr +++ b/std.grr @@ -8,8 +8,6 @@ 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 }