diff --git a/README b/README index 4b97e29..f81001f 100644 --- a/README +++ b/README @@ -11,5 +11,5 @@ <__________\______)\__) TODO: -- [ ] "#load" pragma +- [o] "#load" pragma - [ ] hand-rolled parser diff --git a/examples/fibonacci.grr b/examples/fibonacci.grr new file mode 100644 index 0000000..dfa5e09 --- /dev/null +++ b/examples/fibonacci.grr @@ -0,0 +1,7 @@ +#load("std.grr") + +def fib { + 0 1 dig [dup [+] dip swap] times drop +} + +50 fib . diff --git a/examples/fizzbuzz.grr b/examples/fizzbuzz.grr new file mode 100644 index 0000000..4b0b8be --- /dev/null +++ b/examples/fizzbuzz.grr @@ -0,0 +1,19 @@ +#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 fizzbuzz1 { + if: fizzbuzz? + [ [fizz] keep buzz "\n" type ] + [ . ]; +} + +def fizzbuzz { + 0 swap times: + [ 1 + dup [fizzbuzz1] keep ]; + drop +} + +30 fizzbuzz diff --git a/shell.nix b/shell.nix index 6857959..f5020a7 100644 --- a/shell.nix +++ b/shell.nix @@ -12,6 +12,7 @@ pkgs.mkShell { ninja rlwrap hyperfine + valgrind muon samurai ]; diff --git a/src/chunk.h b/src/chunk.h index a93ab50..f6d2538 100644 --- a/src/chunk.h +++ b/src/chunk.h @@ -1,7 +1,7 @@ #ifndef CHUNK_H #define CHUNK_H -#define CHUNK_DEBUG 0 +#define CHUNK_DEBUG DEBUG #include "common.h" #include "object.h" diff --git a/src/common.h b/src/common.h index a8c64ba..308d96c 100644 --- a/src/common.h +++ b/src/common.h @@ -1,4 +1,4 @@ -#ifndef COMMON_H + #ifndef COMMON_H #define COMMON_H #include @@ -13,4 +13,6 @@ typedef uint8_t U8; typedef uint32_t U32; typedef uint64_t U64; +#define DEBUG 0 + #endif diff --git a/src/compile.c b/src/compile.c index 8325f1a..345d138 100644 --- a/src/compile.c +++ b/src/compile.c @@ -7,8 +7,8 @@ #include "debug.h" #include "gc.h" #include "object.h" -#include "vm.h" #include "string.h" +#include "vm.h" #include "vendor/mpc.h" @@ -17,37 +17,43 @@ 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}}, - {"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}}, - {"=", {OP_EQ, 0}}, - {"<>", {OP_NEQ, 0}}, - {"<", {OP_LT, 0}}, - {">", {OP_GT, 0}}, - {"<=", {OP_LTE, 0}}, - {">=", {OP_GTE, 0}}, - {"type", {OP_TYPE, 0}}, - {"^", {OP_CONCAT, 0}}, - {".", {OP_PPRINT, 0}}, - {".s", {OP_PRINTSTACK, 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}}, + {"type", {OP_TYPE, 0}}, + {"^", {OP_CONCAT, 0}}, + {".", {OP_PPRINT, 0}}, + {".s", {OP_PRINTSTACK, 0}}, + {NULL, {0}}, }; // clang-format on @@ -198,6 +204,7 @@ static I compile_definition(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next) { static O compile_quotation_obj(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next) { Cm inner = {0}; inner.arena = cm->arena; + inner.chunk = chunk_new(""); inner.vm = cm->vm; inner.dictionary = cm->dictionary; @@ -214,7 +221,8 @@ static O compile_quotation_obj(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next) { } curr = mpc_ast_traverse_next(next); } - chunk_emit_byte(inner.chunk, OP_RETURN); + chunk_emit_byte_with_line(inner.chunk, OP_RETURN, curr->state.row, + curr->state.col); optim_tailcall(inner.chunk); Hd *hd = gc_alloc(cm->vm, sizeof(Hd) + sizeof(Bc *)); @@ -230,6 +238,94 @@ static I compile_quotation(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next, return compile_constant(cm, compile_quotation_obj(cm, curr, next), line, col); } +static I compile_pragma(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next) { + (void)mpc_ast_traverse_next(next); + curr = mpc_ast_traverse_next(next); + const char *name = curr->contents; + I line = curr->state.row; + I col = curr->state.col; + curr = mpc_ast_traverse_next(next); + I has_args = 0; + + if (curr != NULL && strcmp(curr->tag, "char") == 0 && + strcmp(curr->contents, "(") == 0) { + has_args = 1; + curr = mpc_ast_traverse_next(next); // Skip '(' + } + + if (strcmp(name, "load") == 0) { + if (!has_args) { + fprintf(stderr, + "compiler error at %ld:%ld: #load requires a filename argument\n", + line + 1, col + 1); + return 0; + } + if (!strstr(curr->tag, "expr|string")) { + fprintf(stderr, + "compiler error at %ld:%ld: #load requires a string argument\n", + line + 1, col + 1); + return 0; + } + + char *fname_raw = curr->contents; + Z len = strlen(fname_raw); + char *fname = malloc(len + 1); + memcpy(fname, fname_raw + 1, len - 2); + fname[len - 2] = '\0'; + fname = mpcf_unescape(fname); + + mpc_result_t res; + extern mpc_parser_t *Program; + + if (!mpc_parse_contents(fname, Program, &res)) { + fprintf(stderr, "compiler error at %ld:%ld: failed to parse file '%s':\n", + line + 1, col + 1, fname); + mpc_err_print_to(res.error, stderr); + mpc_err_delete(res.error); + free(fname); + return 0; + } + + mpc_ast_trav_t *inner_next = + mpc_ast_traverse_start(res.output, mpc_ast_trav_order_pre); + mpc_ast_t *inner_curr = mpc_ast_traverse_next(&inner_next); + + I success = compile_ast(cm, inner_curr, &inner_next); + + mpc_ast_delete(res.output); + + if (!success) { + fprintf(stderr, + "compiler error at %ld:%ld: failed to compile file '%s'\n", + line + 1, col + 1, fname); + free(fname); + return 0; + } + + free(fname); + + curr = mpc_ast_traverse_next(next); + while (curr != NULL) { + if (strcmp(curr->tag, "char") == 0 && strcmp(curr->contents, ")") == 0) + break; + curr = mpc_ast_traverse_next(next); + } + } else { + fprintf(stderr, "compiler warning at %ld:%ld: unknown pragma \"%s\"\n", + line + 1, col + 1, name); + } + + if (has_args) { + if (curr == NULL || strcmp(curr->contents, ")") != 0) { + fprintf(stderr, "error at %ld:%ld: expected ')' after pragma arguments\n", + line + 1, col + 1); + return 0; + } + } + + return 1; +} + static I compile_expr(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next) { I line = curr->state.row; I col = curr->state.col; @@ -252,6 +348,8 @@ static I compile_expr(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next) { return compile_definition(cm, curr, next); } else if (strstr(curr->tag, "expr|command") != NULL) { return compile_command(cm, curr, next); + } else if (strstr(curr->tag, "expr|pragma") != NULL) { + return compile_pragma(cm, curr, next); } else if (strstr(curr->tag, "expr|comment") != NULL) { return 1; } else { @@ -259,8 +357,6 @@ static I compile_expr(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next) { col + 1, curr->tag); return 0; } - - return 1; } static I compile_ast(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next) { diff --git a/src/compile.h b/src/compile.h index b851552..8f47e34 100644 --- a/src/compile.h +++ b/src/compile.h @@ -7,7 +7,7 @@ #include "vendor/mpc.h" -#define COMPILER_DEBUG 0 +#define COMPILER_DEBUG DEBUG /** Compiler context */ typedef struct Cm { diff --git a/src/debug.c b/src/debug.c index 2b40514..8304bb4 100644 --- a/src/debug.c +++ b/src/debug.c @@ -36,9 +36,8 @@ V disassemble(Bc *chunk, const char *name, Dt **dictionary) { } static Z dis_instr(Bc *chunk, Z offset, Dt **dictionary, I indent) { - for (I i = 0; i < indent * 2; i++) - putchar(' '); - fflush(stdout); + for (I i = 0; i < indent; i++) + printf(" "); printf("%04zu ", offset); I col = -1; @@ -136,12 +135,18 @@ static Z dis_instr(Bc *chunk, Z offset, Dt **dictionary, I indent) { SIMPLE(MUL); SIMPLE(DIV); SIMPLE(MOD); + SIMPLE(LOGAND); + SIMPLE(LOGOR); + SIMPLE(LOGXOR); + SIMPLE(LOGNOT); SIMPLE(EQ); SIMPLE(NEQ); SIMPLE(LT); SIMPLE(GT); SIMPLE(LTE); SIMPLE(GTE); + SIMPLE(AND); + SIMPLE(OR); SIMPLE(TYPE); SIMPLE(CONCAT); SIMPLE(PPRINT); diff --git a/src/gc.c b/src/gc.c index 12bfd23..9f5bcef 100644 --- a/src/gc.c +++ b/src/gc.c @@ -101,6 +101,8 @@ 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: { Bc **chunk_ptr = (Bc **)(hdr + 1); Bc *chunk = *chunk_ptr; diff --git a/src/gc.h b/src/gc.h index 447f706..3bfc46d 100644 --- a/src/gc.h +++ b/src/gc.h @@ -4,8 +4,12 @@ #include "common.h" #include "object.h" -#define GC_DEBUG 0 +#define GC_DEBUG 1 +#if GC_DEBUG +#define HEAP_BYTES (8 * 1024) +#else #define HEAP_BYTES (4 * 1024 * 1024) +#endif typedef struct Gs { U8 *start, *end; diff --git a/src/print.c b/src/print.c index 8c63981..99a3636 100644 --- a/src/print.c +++ b/src/print.c @@ -1,9 +1,12 @@ #include #include +#include +#include #include "object.h" -#include "string.h" #include "print.h" +#include "string.h" +#include "vendor/mpc.h" V print(O o) { if (o == NIL) { @@ -18,7 +21,12 @@ V print(O o) { break; case OBJ_STR: { Str *s = string_unwrap(o); - printf("\"%.*s\"", (int)s->len, s->data); + char *escaped = malloc(s->len + 1); + memcpy(escaped, s->data, s->len); + escaped[s->len] = 0; + escaped = mpcf_escape(escaped); + printf("\"%s\"", escaped); + free(escaped); break; } default: diff --git a/src/string.c b/src/string.c index 0acd653..e89d8c0 100644 --- a/src/string.c +++ b/src/string.c @@ -1,6 +1,7 @@ #include #include "string.h" +#include "src/gc.h" O string_make(Vm *vm, const char *str, I len) { if (len < 0) @@ -24,13 +25,27 @@ Str *string_unwrap(O o) { return (Str *)(hdr + 1); } -O string_concat(Vm *vm, Str *a, Str *b) { - O new_obj = string_make(vm, "", a->len + b->len); - Str *new = (Str *)(UNBOX(new_obj) + 1); +O string_concat(Vm *vm, O a_obj, O b_obj) { + I mark = gc_mark(&vm->gc); + gc_addroot(&vm->gc, &a_obj); + gc_addroot(&vm->gc, &b_obj); - memcpy(new->data, a->data, a->len); - memcpy(new->data + a->len, b->data, b->len); - new->data[a->len + b->len] = 0; + Str *as = string_unwrap(a_obj); + Str *bs = string_unwrap(b_obj); + I a_len = as->len; + I b_len = bs->len; - return new_obj; + O new = string_make(vm, "", a_len + b_len); + + as = string_unwrap(a_obj); + bs = string_unwrap(b_obj); + Str *news = (Str *)(UNBOX(new) + 1); + + memcpy(news->data, as->data, a_len); + memcpy(news->data + a_len, bs->data, b_len); + news->data[a_len + b_len] = 0; + + gc_reset(&vm->gc, mark); + + return new; } diff --git a/src/string.h b/src/string.h index 54e54cd..54a71e7 100644 --- a/src/string.h +++ b/src/string.h @@ -10,4 +10,4 @@ typedef struct Str { O string_make(Vm *, const char *, I); Str *string_unwrap(O); -O string_concat(Vm *, Str *, Str *); +O string_concat(Vm *, O, O); diff --git a/src/vm.c b/src/vm.c index fd2e56e..cece6d5 100644 --- a/src/vm.c +++ b/src/vm.c @@ -49,10 +49,29 @@ V vm_init(Vm *vm) { } V vm_deinit(Vm *vm) { - gc_collect(vm); - gc_deinit(&vm->gc); + // Free all definitions + Dt *dstack[256]; + Dt **dsp = dstack; + *dsp++ = vm->dictionary; + + while (dsp > dstack) { + Dt *node = *--dsp; + if (!node) + continue; + if (node->chunk != NULL) + chunk_release(node->chunk); + for (I i = 0; i < 4; i++) { + if (node->child[i] != NULL) + *dsp++ = node->child[i]; + } + } + arena_free(&vm->arena); vm->dictionary = NULL; + + // Run final GC pass + gc_collect(vm); + gc_deinit(&vm->gc); } static V vm_error(Vm *vm, I error, const char *message) { @@ -116,7 +135,7 @@ I vm_run(Vm *vm, Bc *chunk, I offset) { O b = vm_pop(vm); \ O a = vm_pop(vm); \ if (!IMM(a) || !IMM(b)) \ - vm_error(vm, VM_ERR_TYPE, "arithmetic on non-numeric objects"); \ + vm_error(vm, VM_ERR_TYPE, "numop on non-numeric objects"); \ vm_push(vm, NUM(ORD(a) op ORD(b))); \ break; \ } @@ -282,6 +301,19 @@ I vm_run(Vm *vm, Bc *chunk, I offset) { BINOP(/); case OP_MOD: BINOP(%); + case OP_LOGAND: + BINOP(&); + case OP_LOGOR: + BINOP(|); + case OP_LOGXOR: + BINOP(^); + case OP_LOGNOT: { + O o = vm_pop(vm); + if (!IMM(o)) + vm_error(vm, VM_ERR_TYPE, "numop on non-number"); + vm_push(vm, NUM(~ORD(o))); + break; + } case OP_EQ: CMPOP(==); case OP_NEQ: @@ -294,12 +326,32 @@ I vm_run(Vm *vm, Bc *chunk, I offset) { CMPOP(<=); case OP_GTE: CMPOP(>=); + case OP_AND: { + O b = vm_pop(vm); + O a = vm_pop(vm); + if (a == NIL) { + vm_push(vm, NIL); + } else { + vm_push(vm, b); + } + break; + } + case OP_OR: { + O b = vm_pop(vm); + O a = vm_pop(vm); + if (a == NIL) { + vm_push(vm, b); + } else { + vm_push(vm, a); + } + break; + } case OP_CONCAT: { - Str *b = string_unwrap(vm_pop(vm)); - if (b == NULL) + O b = vm_pop(vm); + if (type(b) != TYPE_STR) vm_error(vm, VM_ERR_TYPE, "expected string"); - Str *a = string_unwrap(vm_pop(vm)); - if (a == NULL) + O a = vm_pop(vm); + if (type(a) != TYPE_STR) vm_error(vm, VM_ERR_TYPE, "expected string"); vm_push(vm, string_concat(vm, a, b)); break; diff --git a/src/vm.h b/src/vm.h index 42ebca6..660df72 100644 --- a/src/vm.h +++ b/src/vm.h @@ -14,7 +14,7 @@ enum { OP_NOP = 0, OP_CONST, // Push constant to stack - OP_NIL, // Push constant to stack + OP_NIL, // Push constant to stack OP_DROP, OP_DUP, OP_SWAP, @@ -22,12 +22,12 @@ enum { OP_OVER, OP_BURY, OP_DIG, - OP_TOR, // Push from stack to retain stack - OP_FROMR, // Push from retain stack to stack + OP_TOR, // Push from stack to retain stack + OP_FROMR, // Push from retain stack to stack OP_DOWORD, // Call word from dictionary by name hash OP_CALL, OP_TAIL_DOWORD, // Tail call to dictionary word (reuses current frame) - OP_TAIL_CALL, // Tail call to quotation (reuses current frame) + OP_TAIL_CALL, // Tail call to quotation (reuses current frame) OP_RETURN, OP_CHOOSE, OP_ADD, @@ -37,10 +37,16 @@ enum { OP_MOD, OP_EQ, OP_NEQ, + OP_LOGAND, + OP_LOGOR, + OP_LOGXOR, + OP_LOGNOT, OP_LT, OP_GT, OP_LTE, OP_GTE, + OP_AND, + OP_OR, OP_TYPE, OP_CONCAT, OP_PPRINT, diff --git a/std.grr b/std.grr new file mode 100644 index 0000000..192068f --- /dev/null +++ b/std.grr @@ -0,0 +1,11 @@ +def when { [] if } +def unless { swap when } + +def bi { [keep] dip call } +def tri { [[keep] dip keep] dip call } + +def times { + if: over 0 = + [drop drop] + [swap over >r >r call r> 1 - r> times]; +} diff --git a/test.grr b/test.grr deleted file mode 100644 index 4a75336..0000000 --- a/test.grr +++ /dev/null @@ -1,12 +0,0 @@ -def times { - if: over 0 = - [drop drop] - [swap over >r >r call r> 1 - r> times]; -} - -def fib { - 0 1 dig [dup [+] dip swap] times drop -} - -"50 fib => " type -50 fib .