diff --git a/examples/fizzbuzz.grr b/examples/fizzbuzz.grr index 4b0b8be..0fc260a 100644 --- a/examples/fizzbuzz.grr +++ b/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 ] [ . ]; } diff --git a/meson.build b/meson.build index 8b80012..52a8d7a 100644 --- a/meson.build +++ b/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', diff --git a/src/common.h b/src/common.h index 676f0d4..a8c64ba 100644 --- a/src/common.h +++ b/src/common.h @@ -1,4 +1,4 @@ - #ifndef COMMON_H +#ifndef COMMON_H #define COMMON_H #include diff --git a/src/compile.c b/src/compile.c index 5f9a63a..e71430d 100644 --- a/src/compile.c +++ b/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", diff --git a/src/debug.c b/src/debug.c index 539af5b..e414e56 100644 --- a/src/debug.c +++ b/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; diff --git a/src/file.c b/src/file.c new file mode 100644 index 0000000..eed569f --- /dev/null +++ b/src/file.c @@ -0,0 +1,56 @@ +#include + +#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); +} diff --git a/src/file.h b/src/file.h new file mode 100644 index 0000000..fa73f79 --- /dev/null +++ b/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 *); diff --git a/src/gc.c b/src/gc.c index 9f5bcef..0add844 100644 --- a/src/gc.c +++ b/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; } diff --git a/src/object.h b/src/object.h index 3802a14..34ce4b0 100644 --- a/src/object.h +++ b/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; diff --git a/src/primitive.c b/src/primitive.c new file mode 100644 index 0000000..7f68c1f --- /dev/null +++ b/src/primitive.c @@ -0,0 +1,44 @@ +#include +#include + +#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; +} diff --git a/src/primitive.h b/src/primitive.h new file mode 100644 index 0000000..ab58696 --- /dev/null +++ b/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 diff --git a/src/print.c b/src/print.c index 99a3636..53bdcb8 100644 --- a/src/print.c +++ b/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("", type(o), (void *)o); + printf("<#obj type=%ld ptr=%p>", type(o), (void *)o); } } } diff --git a/src/userdata.c b/src/userdata.c new file mode 100644 index 0000000..1c8ba0a --- /dev/null +++ b/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; +} diff --git a/src/userdata.h b/src/userdata.h new file mode 100644 index 0000000..3baa2fd --- /dev/null +++ b/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 diff --git a/src/vm.c b/src/vm.c index 8fc7a77..0c6f02e 100644 --- a/src/vm.c +++ b/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"); } diff --git a/src/vm.h b/src/vm.h index 660df72..0905463 100644 --- a/src/vm.h +++ b/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 diff --git a/std.grr b/std.grr index 192068f..5faa2e7 100644 --- a/std.grr +++ b/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 }