lobo/growl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

*

Browse source
This commit is contained in:
Lobo 2026-01-22 11:56:01 -03:00
parent 54d12060ec
commit 80d8f87883
18 changed files with 292 additions and 76 deletions
Download patch file Download diff file Expand all files Collapse all files

2
README
View file

@ -11,5 +11,5 @@
<__________\______)\__)
TODO:
- [ ] "#load" pragma
- [o] "#load" pragma
- [ ] hand-rolled parser

7
examples/fibonacci.grr Normal file
View file

@ -0,0 +1,7 @@
#load("std.grr")
def fib {
0 1 dig [dup [+] dip swap] times drop
}
50 fib .

19
examples/fizzbuzz.grr Normal file
View file

@ -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

1
shell.nix
View file

@ -12,6 +12,7 @@ pkgs.mkShell {
ninja
rlwrap
hyperfine
valgrind
muon
samurai
];

2
src/chunk.h
View file

@ -1,7 +1,7 @@
#ifndef CHUNK_H
#define CHUNK_H
#define CHUNK_DEBUG 0
#define CHUNK_DEBUG DEBUG
#include "common.h"
#include "object.h"

4
src/common.h
View file

@ -1,4 +1,4 @@
#ifndef COMMON_H
#ifndef COMMON_H
#define COMMON_H
#include <stdint.h>
@ -13,4 +13,6 @@ typedef uint8_t U8;
typedef uint32_t U32;
typedef uint64_t U64;
#define DEBUG 0
#endif

166
src/compile.c
View file

@ -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("<quotation>");
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) {

2
src/compile.h
View file

@ -7,7 +7,7 @@
#include "vendor/mpc.h"
#define COMPILER_DEBUG 0
#define COMPILER_DEBUG DEBUG
/** Compiler context */
typedef struct Cm {

11
src/debug.c
View file

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

2
src/gc.c
View file

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

6
src/gc.h
View file

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

12
src/print.c
View file

@ -1,9 +1,12 @@
#include <inttypes.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#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:

29
src/string.c
View file

@ -1,6 +1,7 @@
#include <string.h>
#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;
}

2
src/string.h
View file

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

66
src/vm.c
View file

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

14
src/vm.h
View file

@ -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,

11
std.grr Normal file
View file

@ -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];
}

12
test.grr
View file

@ -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 .