examples/compose.grr

@@ -1,5 +0,0 @@
-5 [1 +] [2 *] compose
-call .
-
-10 5 [+] curry
-call .

src/compile.c

@@ -19,40 +19,40 @@ struct {
   const char *name;
   U8 opcode[8];
 } primitives[] = {
-  {"nil",     {OP_NIL, 0}},
+  {"nil",    {OP_NIL, 0}},
-  {"dup",     {OP_DUP, 0}},
+  {"dup",    {OP_DUP, 0}},
-  {"drop",    {OP_DROP, 0}},
+  {"drop",   {OP_DROP, 0}},
-  {"swap",    {OP_SWAP, 0}},
+  {"swap",   {OP_SWAP, 0}},
-  {"over",    {OP_OVER, 0}},
+  {"over",   {OP_OVER, 0}},
-  {"nip",     {OP_NIP, 0}},
+  {"nip",    {OP_NIP, 0}},
-  {"bury",    {OP_BURY, 0}},
+  {"bury",   {OP_BURY, 0}},
-  {"dig",     {OP_DIG, 0}},
+  {"dig",    {OP_DIG, 0}},
-  {">r",      {OP_TOR, 0}},
+  {">r",     {OP_TOR, 0}},
-  {"r>",      {OP_FROMR, 0}},
+  {"r>",     {OP_FROMR, 0}},
-  {"if",      {OP_CHOOSE, OP_CALL, 0}},
+  {"dip",    {OP_SWAP, OP_TOR, OP_CALL, OP_FROMR, 0}},
-  {"call",    {OP_CALL, 0}},
+  {"keep",   {OP_OVER, OP_TOR, OP_CALL, OP_FROMR, 0}},
-  {"compose", {OP_COMPOSE, 0}},
+  {"if",     {OP_CHOOSE, OP_CALL, 0}},
-  {"curry",   {OP_CURRY, 0}},
+  {"call",   {OP_CALL, 0}},
-  {"?",       {OP_CHOOSE, 0}},
+  {"?",      {OP_CHOOSE, 0}},
-  {"+",       {OP_ADD, 0}},
+  {"+",      {OP_ADD, 0}},
-  {"-",       {OP_SUB, 0}},
+  {"-",      {OP_SUB, 0}},
-  {"*",       {OP_MUL, 0}},
+  {"*",      {OP_MUL, 0}},
-  {"/",       {OP_DIV, 0}},
+  {"/",      {OP_DIV, 0}},
-  {"%",       {OP_MOD, 0}},
+  {"%",      {OP_MOD, 0}},
-  {"logand",  {OP_LOGAND, 0}},
+  {"logand", {OP_LOGAND, 0}},
-  {"logor",   {OP_LOGOR, 0}},
+  {"logor",  {OP_LOGOR, 0}},
-  {"logxor",  {OP_LOGXOR, 0}},
+  {"logxor", {OP_LOGXOR, 0}},
-  {"lognot",  {OP_LOGNOT, 0}},
+  {"lognot", {OP_LOGNOT, 0}},
-  {"=",       {OP_EQ, 0}},
+  {"=",      {OP_EQ, 0}},
-  {"<>",      {OP_NEQ, 0}},
+  {"<>",     {OP_NEQ, 0}},
-  {"<",       {OP_LT, 0}},
+  {"<",      {OP_LT, 0}},
-  {">",       {OP_GT, 0}},
+  {">",      {OP_GT, 0}},
-  {"<=",      {OP_LTE, 0}},
+  {"<=",     {OP_LTE, 0}},
-  {">=",      {OP_GTE, 0}},
+  {">=",     {OP_GTE, 0}},
-  {"and",     {OP_AND, 0}},
+  {"and",    {OP_AND, 0}},
-  {"or",      {OP_OR, 0}},
+  {"or",     {OP_OR, 0}},
-  {"^",       {OP_CONCAT, 0}},
+  {"^",      {OP_CONCAT, 0}},
-  {NULL,      {0}},
+  {NULL,     {0}},
 };
 // clang-format on
 

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);

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:

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

src/print.c

@@ -20,12 +20,6 @@ V print(O o) {
     case OBJ_QUOT:
       printf("<quotation>");
       break;
-    case OBJ_COMPOSE:
-      printf("<composed>");
-      break;
-    case OBJ_CURRY:
-      printf("<curried>");
-      break;
     case OBJ_STR: {
       // TODO: make this binary safe
       Str *s = string_unwrap(o);

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("<trampoline>");
-  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);
+      if (type(quot) == TYPE_QUOT) {
-    do_call:
-      switch (type(quot)) {
-      case 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;
+      } else {
-      }
-      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:
         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:
+      if (type(quot) == TYPE_QUOT) {
-      switch (type(quot)) {
-      case TYPE_QUOT: {
         Bc **ptr = (Bc **)(UNBOX(quot) + 1);
         Bc *chunk = *ptr;
         vm->chunk = chunk;
         vm->ip = chunk->items;
-        break;
+      } else {
-      }
+        vm_error(vm, VM_ERR_TYPE, "attempt to call non-quotation object\n");
-      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");
       }
       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 {

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;

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 }