move non essential opcodes to primitives and add userdata

examples/fizzbuzz.grr

@@ -1,12 +1,12 @@
 #load("std.grr")
 
 def fizzbuzz? { [3 % 0 =] [5 % 0 =] bi or }
-def fizz { when: 3 % 0 = ["Fizz" type]; }
-def buzz { when: 5 % 0 = ["Buzz" type]; }
+def fizz { when: 3 % 0 = ["Fizz" print]; }
+def buzz { when: 5 % 0 = ["Buzz" print]; }
 
 def fizzbuzz1 {
   if: fizzbuzz?
-    [ [fizz] keep buzz "\n" type ]
+    [ [fizz] keep buzz nl ]
     [ . ];
 }
 

meson.build

@@ -12,11 +12,14 @@ sources = [
   'src/compile.c',
   'src/debug.c',
   'src/dictionary.c',
+  'src/file.c',
   'src/object.c',
   'src/gc.c',
   'src/parser.c',
+  'src/primitive.c',
   'src/print.c',
   'src/string.c',
+  'src/userdata.c',
   'src/vm.c',
   'src/vendor/linenoise.c',
   'src/vendor/mpc.c',

src/common.h

@@ -1,4 +1,4 @@
-  #ifndef COMMON_H
+#ifndef COMMON_H
 #define COMMON_H
 
 #include <stdint.h>

src/compile.c

@@ -7,6 +7,7 @@
 #include "debug.h"
 #include "gc.h"
 #include "object.h"
+#include "src/primitive.h"
 #include "string.h"
 #include "vm.h"
 
@@ -50,10 +51,7 @@ struct {
   {">=",     {OP_GTE, 0}},
   {"and",    {OP_AND, 0}},
   {"or",     {OP_OR, 0}},
-  {"type",   {OP_TYPE, 0}},
   {"^",      {OP_CONCAT, 0}},
-  {".",      {OP_PPRINT, 0}},
-  {".s",     {OP_PRINTSTACK, 0}},
   {NULL,     {0}},
 };
 // clang-format on
@@ -146,6 +144,14 @@ static I compile_call(Cm *cm, const char *name, I line, I col) {
       return 1;
     }
   }
+
+  I prim_idx = prim_find(name);
+  if (prim_idx != -1) {
+    chunk_emit_byte_with_line(cm->chunk, OP_PRIM, line, col);
+    chunk_emit_sleb128(cm->chunk, prim_idx);
+    return 1;
+  }
+
   Dt *word = upsert(cm->dictionary, name, NULL);
   if (!word) {
     fprintf(stderr, "compiler error at %ld:%ld: undefined word '%s'\n",

src/debug.c

@@ -4,6 +4,7 @@
 #include "debug.h"
 #include "dictionary.h"
 #include "print.h"
+#include "src/primitive.h"
 #include "vm.h"
 
 static I decode_sleb128(U8 *ptr, Z *bytes_read) {
@@ -94,7 +95,7 @@ static Z dis_instr(Bc *chunk, Z offset, Dt **dictionary, I indent) {
       Z bytes_read;
       I idx = decode_sleb128(&chunk->items[offset], &bytes_read);
       Dt *word = chunk->symbols.items[idx].resolved;
-      printf("DOWORD %s\n", word->name);
+      printf("DOWORD \"%s\"\n", word->name);
       return offset + bytes_read;
     }
     SIMPLE(CALL);
@@ -102,10 +103,17 @@ static Z dis_instr(Bc *chunk, Z offset, Dt **dictionary, I indent) {
       Z bytes_read;
       I idx = decode_sleb128(&chunk->items[offset], &bytes_read);
       Dt *word = chunk->symbols.items[idx].resolved;
-      printf("TAIL_DOWORD %s\n", word->name);
+      printf("TAIL_DOWORD \"%s\"\n", word->name);
       return offset + bytes_read;
     }
     SIMPLE(TAIL_CALL);
+    CASE(PRIM) {
+      Z bytes_read;
+      I idx = decode_sleb128(&chunk->items[offset], &bytes_read);
+      Pr prim = primitives_table[idx];
+      printf("PRIM \"%s\"\n", prim.name);
+      return offset + bytes_read;
+    }
     SIMPLE(RETURN);
     SIMPLE(CHOOSE);
     SIMPLE(ADD);
@@ -125,10 +133,7 @@ static Z dis_instr(Bc *chunk, Z offset, Dt **dictionary, I indent) {
     SIMPLE(GTE);
     SIMPLE(AND);
     SIMPLE(OR);
-    SIMPLE(TYPE);
     SIMPLE(CONCAT);
-    SIMPLE(PPRINT);
-    SIMPLE(PRINTSTACK);
   default:
     printf("??? (%d)\n", opcode);
     return offset;

src/file.c

@@ -0,0 +1,56 @@
+#include <stdio.h>
+
+#include "string.h"
+#include "userdata.h"
+#include "vm.h"
+
+static V finalizer(V *data);
+
+// clang-format off
+Ut userdata_file = {
+  .name = "file",
+  .finalizer = finalizer
+};
+// clang-format on
+
+I prim_file_stdout(Vm *vm) {
+  static O stdout_object = NIL;
+  if (stdout_object == NIL)
+    stdout_object = userdata_make(vm, (void *)stdout, &userdata_file);
+  vm_push(vm, stdout_object);
+  return 0;
+}
+
+I prim_file_stderr(Vm *vm) {
+  static O stderr_object = NIL;
+  if (stderr_object == NIL)
+    stderr_object = userdata_make(vm, (void *)stderr, &userdata_file);
+  vm_push(vm, stderr_object);
+  return 0;
+}
+
+I prim_file_fprint(Vm *vm) {
+  O file_obj = vm_pop(vm);
+  O string_obj = vm_pop(vm);
+
+  Ud *file_ud = userdata_unwrap(file_obj, &userdata_file);
+  if (file_ud == NULL) {
+    fprintf(stderr, "expected file object");
+    return VM_ERR_TYPE;
+  };
+
+  Str *str = string_unwrap(string_obj);
+  if (str == NULL) {
+    fprintf(stderr, "expected string");
+    return VM_ERR_TYPE;
+  }
+
+  fwrite(str->data, sizeof(char), str->len, (FILE *)file_ud->data);
+  return 0;
+}
+
+static V finalizer(V *data) {
+  FILE *f = (FILE *)data;
+  if (f && f != stdin && f != stdout && f != stderr)
+    fclose(f);
+}

src/file.h

@@ -0,0 +1,7 @@
+#include "userdata.h"
+
+extern Ut userdata_file;
+
+I prim_file_stdout(Vm *);
+I prim_file_stderr(Vm *);
+I prim_file_fprint(Vm *);

src/gc.c

@@ -6,6 +6,7 @@
 #include "chunk.h"
 #include "gc.h"
 #include "object.h"
+#include "userdata.h"
 #include "vendor/yar.h"
 #include "vm.h"
 
@@ -110,6 +111,8 @@ V gc_collect(Vm *vm) {
         chunk->constants.items[i] = forward(gc, chunk->constants.items[i]);
       break;
     }
+    case OBJ_USERDATA:
+      break;
     case OBJ_FWD:
       fprintf(stderr, "fatal GC error: forwarding pointer in to-space\n");
       abort();
@@ -129,6 +132,12 @@ V gc_collect(Vm *vm) {
         chunk_release(*chunk_ptr);
         break;
       }
+      case OBJ_USERDATA: {
+        Ud *ud = (Ud *)(hdr + 1);
+        if (ud->kind->finalizer != NULL)
+          ud->kind->finalizer(ud->data);
+        break;
+      }
       default:
         break;
       }

src/object.h

@@ -14,6 +14,7 @@ enum {
   OBJ_FWD = 2,
   OBJ_QUOT,
   OBJ_STR,
+  OBJ_USERDATA,
 };
 
 enum {
@@ -22,6 +23,7 @@ enum {
   TYPE_FWD = OBJ_FWD,
   TYPE_QUOT = OBJ_QUOT,
   TYPE_STR = OBJ_STR,
+  TYPE_USERDATA = OBJ_USERDATA,
 };
 
 typedef uintptr_t O;

src/primitive.c

@@ -0,0 +1,44 @@
+#include <stdio.h>
+#include <string.h>
+
+#include "primitive.h"
+#include "print.h"
+#include "string.h"
+#include "vm.h"
+
+#include "file.h"
+
+// Pretty-printing primitives
+static I prim_pprint(Vm *vm) {
+  println(vm_pop(vm));
+  return 0;
+}
+
+static I prim_printstack(Vm *vm) {
+  printf("Stk:");
+  for (O *p = vm->stack; p < vm->sp; p++) {
+    putchar(' ');
+    print(*p);
+  }
+  putchar('\n');
+  return 0;
+}
+
+// clang-format off
+Pr primitives_table[] = {
+  {".", prim_pprint},
+  {".s", prim_printstack},
+  {"stdout", prim_file_stdout},
+  {"stderr", prim_file_stderr},
+  {"fprint", prim_file_fprint},
+  {NULL, NULL},
+};
+// clang-format on
+
+I prim_find(const char *name) {
+  for (Z i = 0; primitives_table[i].name != NULL; i++) {
+    if (strcmp(primitives_table[i].name, name) == 0)
+      return i;
+  }
+  return -1;
+}

src/primitive.h

@@ -0,0 +1,15 @@
+#ifndef PRIMITIVE_H
+#define PRIMITIVE_H
+
+#include "common.h"
+#include "vm.h"
+
+typedef struct Pr {
+  const char *name;
+  I (*fn)(Vm *);
+} Pr;
+
+extern Pr primitives_table[];
+I prim_find(const char *name);
+
+#endif

src/print.c

@@ -6,6 +6,7 @@
 #include "object.h"
 #include "print.h"
 #include "string.h"
+#include "userdata.h"
 #include "vendor/mpc.h"
 
 V print(O o) {
@@ -29,8 +30,13 @@ V print(O o) {
       free(escaped);
       break;
     }
+    case OBJ_USERDATA: {
+      Ud *ud = (Ud *)(hdr + 1);
+      printf("<#userdata %s@%p>", ud->kind->name, ud->data);
+      break;
+    }
     default:
-      printf("<obj type=%ld ptr=%p>", type(o), (void *)o);
+      printf("<#obj type=%ld ptr=%p>", type(o), (void *)o);
     }
   }
 }

src/userdata.c

@@ -0,0 +1,24 @@
+#include "userdata.h"
+#include "gc.h"
+
+O userdata_make(Vm *vm, V *data, Ut *kind) {
+  Z size = sizeof(Hd) + sizeof(Ud);
+  Hd *hdr = gc_alloc(vm, size);
+  hdr->type = OBJ_USERDATA;
+  Ud *ud = (Ud *)(hdr + 1);
+  ud->kind = kind;
+  ud->data = data;
+  return BOX(hdr);
+}
+
+Ud *userdata_unwrap(O o, Ut *kind) {
+  if (o == NIL || IMM(o))
+    return NULL;
+  Hd *hdr = UNBOX(o);
+  if (hdr->type != OBJ_USERDATA)
+    return NULL;
+  Ud *ud = (Ud *)(hdr + 1);
+  if (ud->kind != kind)
+    return NULL;
+  return ud;
+}

src/userdata.h

@@ -0,0 +1,21 @@
+#ifndef USERDATA_H
+#define USERDATA_H
+
+#include "common.h"
+#include "object.h"
+#include "vm.h"
+
+typedef struct Ut {
+  const char *name;
+  V (*finalizer)(V *);
+} Ut;
+
+typedef struct Ud {
+  Ut *kind;
+  V *data;
+} Ud;
+
+O userdata_make(Vm *, V *, Ut *);
+Ud *userdata_unwrap(O, Ut *);
+
+#endif

src/vm.c

@@ -8,6 +8,7 @@
 #include "gc.h"
 #include "object.h"
 #include "print.h"
+#include "src/primitive.h"
 #include "string.h"
 #include "vm.h"
 
@@ -271,6 +272,14 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
       }
       break;
     }
+    case OP_PRIM: {
+      I idx = decode_sleb128(&vm->ip);
+      Pr prim = primitives_table[idx];
+      I err = prim.fn(vm);
+      if (err != 0)
+        vm_error(vm, err, "primitive call failed");
+      break;
+    }
     case OP_RETURN:
       if (vm->rsp != vm->rstack) {
         Fr frame = vm_rpop(vm);
@@ -356,27 +365,6 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
       vm_push(vm, string_concat(vm, a, b));
       break;
     }
-    case OP_TYPE: {
-      Str *s = string_unwrap(vm_pop(vm));
-      if (s == NULL)
-        vm_error(vm, VM_ERR_TYPE, "expected string");
-      printf("%.*s", (int)s->len, s->data);
-      break;
-    }
-    case OP_PPRINT: {
-      O obj = vm_pop(vm);
-      println(obj);
-      break;
-    }
-    case OP_PRINTSTACK: {
-      printf("Stk:");
-      for (O *p = vm->stack; p < vm->sp; p++) {
-        putchar(' ');
-        print(*p);
-      }
-      putchar('\n');
-      break;
-    }
     default:
       vm_error(vm, VM_ERR_RUNTIME, "unknown opcode");
     }

src/vm.h

@@ -28,6 +28,7 @@ enum {
   OP_CALL,
   OP_TAIL_DOWORD, // Tail call to dictionary word (reuses current frame)
   OP_TAIL_CALL,   // Tail call to quotation (reuses current frame)
+  OP_PRIM,
   OP_RETURN,
   OP_CHOOSE,
   OP_ADD,
@@ -47,10 +48,7 @@ enum {
   OP_GTE,
   OP_AND,
   OP_OR,
-  OP_TYPE,
   OP_CONCAT,
-  OP_PPRINT,
-  OP_PRINTSTACK,
 };
 
 #define STACK_SIZE 256
@@ -82,4 +80,10 @@ enum {
 V vm_init(Vm *);
 V vm_deinit(Vm *);
 I vm_run(Vm *, Bc *, I);
+
+V vm_push(Vm *, O);
+O vm_pop(Vm *);
+V vm_tpush(Vm *, O);
+O vm_tpop(Vm *);
+
 #endif

std.grr

@@ -1,3 +1,10 @@
+def print { stdout fprint }
+def println { stdout fprint "\n" stdout fprint }
+def nl { "\n" stdout fprint }
+
+def eprint { stderr fprint }
+def eprintln { stderr fprint "\n" stderr fprint }
+
 def when { [] if }
 def unless { swap when }