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

Compare commits

base: lobo:2ac2f85512594aa4f14c747fabbcf85ffccfc3cd
Branches Tags
lobo:trunk
..
compare: lobo:35bad08a0dbb98be50df0cdc2d4ab86d8cc6488b
Branches Tags
lobo:trunk

No commits in common. "2ac2f85512594aa4f14c747fabbcf85ffccfc3cd" and "35bad08a0dbb98be50df0cdc2d4ab86d8cc6488b" have entirely different histories.
2ac2f85512 ... 35bad08a0d

30 changed files with 343 additions and 1210 deletions
Download patch file Download diff file Expand all files Collapse all files

2
.editorconfig
View file

@ -10,4 +10,4 @@ indent_size = 2
[meson.build]
indent_style = space
indent_size = 4
indent_size = 2

36
meson.build
View file

@ -1,21 +1,15 @@
project(
'growl',
'c',
'cpp',
meson_version : '>= 1.3.0',
version : '0.1',
default_options: [
'buildtype=debugoptimized',
'c_std=gnu11',
'cpp_std=c++20',
'warning_level=3',
],
default_options : ['buildtype=debugoptimized', 'c_std=gnu11', 'warning_level=3'],
)
libutf = subproject('libutf')
libutf_dep = libutf.get_variable('libutf_dep')
growl_sources = [
sources = [
'src/arena.c',
'src/chunk.c',
'src/compile.c',
@ -33,33 +27,13 @@ growl_sources = [
'src/userdata.c',
'src/vm.c',
'src/vendor/linenoise.c',
'src/vendor/mpc.c',
'src/vendor/yar.c',
]
growl = executable(
exe = executable(
'growl',
'src/main.c',
growl_sources,
'src/main.c', sources,
dependencies : [libutf_dep],
install : true,
)
growlnext_sources = [
'next/core/arena.c',
'next/core/callable.c',
'next/core/compiler.c',
'next/core/gc.c',
'next/core/list.c',
'next/core/sleb128.c',
'next/core/string.c',
'next/core/tuple.c',
'next/core/vm.c',
'next/main.c',
]
growlnext = executable(
'growlnext',
growlnext_sources,
include_directories: ['next/include'],
install: true,
)

26
next/core/arena.c
View file

@ -1,26 +0,0 @@
#include <growl.h>
#include <stdlib.h>
#include <string.h>
void growl_arena_init(GrowlGCArena *arena, size_t size) {
arena->start = arena->free = malloc(size);
if (arena->start == NULL)
abort();
arena->end = arena->start + size;
}
void growl_arena_free(GrowlGCArena *arena) {
free(arena->start);
arena->start = arena->end = arena->free = NULL;
}
void *growl_arena_alloc(GrowlGCArena *arena, size_t size, size_t align,
size_t count) {
ptrdiff_t padding = -(uintptr_t)arena->start & (align - 1);
ptrdiff_t available = arena->end - arena->start - padding;
if (available < 0 || count > available / size)
abort();
void *p = arena->start + padding;
arena->start += padding + count * size;
return memset(p, 0, count * size);
}

97
next/core/callable.c
View file

@ -1,97 +0,0 @@
#include <growl.h>
#include <string.h>
int growl_callable(Growl obj) {
if (obj == GROWL_NIL || GROWL_IMM(obj))
return 0;
GrowlObjectHeader *hdr = GROWL_UNBOX(obj);
switch (hdr->type) {
case GROWL_QUOTATION:
case GROWL_COMPOSE:
case GROWL_CURRY:
return 1;
default:
return 0;
}
}
Growl growl_make_quotation(GrowlVM *vm, const uint8_t *code, size_t code_size,
const Growl *constants, size_t constants_size) {
size_t constants_obj_size = sizeof(GrowlObjectHeader) + sizeof(GrowlTuple) +
constants_size * sizeof(Growl);
GrowlObjectHeader *constants_hdr =
growl_gc_alloc_tenured(vm, constants_obj_size);
constants_hdr->type = GROWL_TUPLE;
GrowlTuple *constants_tuple = (GrowlTuple *)(constants_hdr + 1);
constants_tuple->count = constants_size;
for (size_t i = 0; i < constants_size; ++i) {
constants_tuple->data[i] = constants[i];
}
size_t quotation_obj_size =
sizeof(GrowlObjectHeader) + sizeof(GrowlQuotation) + code_size;
GrowlObjectHeader *quotation_hdr =
growl_gc_alloc_tenured(vm, quotation_obj_size);
quotation_hdr->type = GROWL_QUOTATION;
GrowlQuotation *quotation = (GrowlQuotation *)(quotation_hdr + 1);
quotation->constants = GROWL_BOX(constants_hdr);
quotation->count = code_size;
memcpy(quotation->data, code, code_size);
return GROWL_BOX(quotation_hdr);
}
GrowlQuotation *growl_unwrap_quotation(Growl obj) {
if (obj == GROWL_NIL || GROWL_IMM(obj))
return NULL;
GrowlObjectHeader *hdr = GROWL_UNBOX(obj);
if (hdr->type != GROWL_QUOTATION)
return NULL;
return (GrowlQuotation *)(hdr + 1);
}
Growl growl_compose(GrowlVM *vm, Growl first, Growl second) {
if (!growl_callable(first))
return GROWL_NIL;
if (!growl_callable(second))
return GROWL_NIL;
size_t size = sizeof(GrowlObjectHeader) + sizeof(GrowlCompose);
GrowlObjectHeader *hdr = growl_gc_alloc(vm, size);
hdr->type = GROWL_COMPOSE;
GrowlCompose *comp = (GrowlCompose *)(hdr + 1);
comp->first = first;
comp->second = second;
return GROWL_BOX(hdr);
}
GrowlCompose *growl_unwrap_compose(Growl obj) {
if (obj == GROWL_NIL || GROWL_IMM(obj))
return NULL;
GrowlObjectHeader *hdr = GROWL_UNBOX(obj);
if (hdr->type != GROWL_COMPOSE)
return NULL;
return (GrowlCompose *)(hdr + 1);
}
Growl growl_curry(GrowlVM *vm, Growl value, Growl callable) {
if (!growl_callable(callable))
return GROWL_NIL;
size_t size = sizeof(GrowlObjectHeader) + sizeof(GrowlCurry);
GrowlObjectHeader *hdr = growl_gc_alloc(vm, size);
hdr->type = GROWL_CURRY;
GrowlCurry *comp = (GrowlCurry *)(hdr + 1);
comp->value = value;
comp->callable = callable;
return GROWL_BOX(hdr);
}
GrowlCurry *growl_unwrap_curry(Growl obj) {
if (obj == GROWL_NIL || GROWL_IMM(obj))
return NULL;
GrowlObjectHeader *hdr = GROWL_UNBOX(obj);
if (hdr->type != GROWL_CURRY)
return NULL;
return (GrowlCurry *)(hdr + 1);
}

2
next/core/compiler.c
View file

@ -1,2 +0,0 @@
#include <growl.h>

169
next/core/gc.c
View file

@ -1,169 +0,0 @@
//
// Created by lobo on 2/5/26.
//
#include <assert.h>
#include <growl.h>
#include <inttypes.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#define ALIGN(n) (((n) + 7) & ~7)
static int in_from(GrowlVM *vm, void *ptr) {
const uint8_t *x = ptr;
return (x >= vm->from.start && x < vm->from.end);
}
static Growl copy(GrowlVM *vm, GrowlObjectHeader *hdr) {
assert(in_from(vm, hdr));
assert(hdr->type != UINT32_MAX);
size_t size = ALIGN(hdr->size);
GrowlObjectHeader *new = (GrowlObjectHeader *)vm->to.free;
vm->to.free += size;
memcpy(new, hdr, size);
hdr->type = UINT32_MAX;
Growl *obj = (Growl *)(hdr + 1);
*obj = (Growl)(new);
return *obj;
}
static Growl forward(GrowlVM *vm, Growl obj) {
if (obj == 0)
return 0;
if (!in_from(vm, (void *)obj))
return obj;
GrowlObjectHeader *hdr = (GrowlObjectHeader *)obj;
if (hdr->type == UINT32_MAX) {
Growl *fwd = (Growl *)(hdr + 1);
return *fwd;
}
return copy(vm, hdr);
}
GrowlObjectHeader *growl_gc_alloc(GrowlVM *vm, size_t size) {
size = ALIGN(size);
if (vm->from.free + size > vm->from.end) {
growl_gc_collect(vm);
if (vm->from.free + size > vm->from.end) {
fprintf(stderr, "gc: oom (requested %" PRIdPTR " bytes)\n", size);
abort();
}
}
GrowlObjectHeader *hdr = (GrowlObjectHeader *)vm->from.free;
vm->from.free += size;
hdr->size = size;
return hdr;
}
GrowlObjectHeader *growl_gc_alloc_tenured(GrowlVM *vm, size_t size) {
size = ALIGN(size);
GrowlObjectHeader *hdr = growl_arena_alloc(&vm->arena, size, 8, 1);
hdr->size = size;
return hdr;
}
static void scan(GrowlVM *vm, GrowlObjectHeader *hdr) {
switch (hdr->type) {
case GROWL_STRING:
break;
case GROWL_LIST: {
GrowlList *list = (GrowlList *)(hdr + 1);
list->head = forward(vm, list->head);
list->tail = forward(vm, list->tail);
break;
}
case GROWL_TUPLE: {
GrowlTuple *tuple = (GrowlTuple *)(hdr + 1);
for (size_t i = 0; i < tuple->count; ++i) {
tuple->data[i] = forward(vm, tuple->data[i]);
}
break;
}
case GROWL_QUOTATION: {
GrowlQuotation *quot = (GrowlQuotation *)(hdr + 1);
quot->constants = forward(vm, quot->constants);
break;
}
case GROWL_COMPOSE: {
GrowlCompose *comp = (GrowlCompose *)(hdr + 1);
comp->first = forward(vm, comp->first);
comp->second = forward(vm, comp->second);
break;
}
case GROWL_CURRY: {
GrowlCurry *comp = (GrowlCurry *)(hdr + 1);
comp->value = forward(vm, comp->value);
comp->callable = forward(vm, comp->callable);
break;
}
case UINT32_MAX:
fprintf(stderr, "gc: fwd pointer during scan\n");
abort();
default:
fprintf(stderr, "gc: junk object type %" PRIu32 "\n", hdr->type);
abort();
}
}
static void gc_print_stats(GrowlVM *vm, const char *label) {
size_t used = vm->from.free - vm->from.start;
size_t total = vm->from.end - vm->from.start;
fprintf(stderr, "[%s] used=%zu/%zu bytes (%.1f%%)\n", label, used, total,
(double)used / (double)total * 100.0);
}
void growl_gc_collect(GrowlVM *vm) {
uint8_t *gc_scan = vm->to.free;
gc_print_stats(vm, "before GC");
for (size_t i = 0; i < GROWL_STACK_SIZE; ++i) {
vm->wst[i] = forward(vm, vm->wst[i]);
}
for (size_t i = 0; i < vm->root_count; ++i) {
*vm->roots[i] = forward(vm, *vm->roots[i]);
}
uint8_t *arena_scan = vm->arena.start;
while (arena_scan < vm->arena.free) {
GrowlObjectHeader *hdr = (GrowlObjectHeader *)arena_scan;
scan(vm, hdr);
arena_scan += ALIGN(hdr->size);
}
while (gc_scan < vm->to.free) {
GrowlObjectHeader *hdr = (GrowlObjectHeader *)gc_scan;
scan(vm, hdr);
gc_scan += ALIGN(hdr->size);
}
GrowlGCArena tmp = vm->from;
vm->from = vm->to;
vm->to = tmp;
vm->to.free = vm->to.start;
vm->scratch.free = vm->scratch.start;
gc_print_stats(vm, "after GC");
}
void growl_gc_root(GrowlVM *vm, Growl *ptr) {
if (vm->root_count >= vm->root_capacity) {
size_t cap = vm->root_capacity == 0 ? 16 : vm->root_capacity * 2;
Growl **data = realloc(vm->roots, cap * sizeof(Growl *));
if (!data) {
fprintf(stderr, "expanding roots array: oom\n");
abort();
}
vm->root_capacity = cap;
vm->roots = data;
}
vm->roots[vm->root_count++] = ptr;
}
size_t growl_gc_mark(GrowlVM *vm) { return vm->root_count; }
void growl_gc_reset(GrowlVM *vm, size_t mark) { vm->root_count = mark; }

2
next/core/list.c
View file

@ -1,2 +0,0 @@
#include <growl.h>

12
next/core/opcodes.h
View file

@ -1,12 +0,0 @@
#ifndef GROWL_OPCODES_H
#define GROWL_OPCODES_H
enum {
GOP_NOP = 0,
GOP_PUSH_NIL,
GOP_PUSH_CONSTANT,
GOP_CALL,
GOP_RETURN,
};
#endif // GROWL_OPCODES_H

45
next/core/sleb128.c
View file

@ -1,45 +0,0 @@
//
// Created by lobo on 2/5/26.
//
#include "sleb128.h"
intptr_t growl_sleb128_decode(uint8_t **ptr) {
intptr_t result = 0;
intptr_t shift = 0;
uint8_t byte;
do {
byte = **ptr;
(*ptr)++;
result |= (intptr_t)(byte & 0x7F) << shift;
shift += 7;
} while (byte & 0x80);
if ((shift < 64) && (byte & 0x40)) {
result |= -(1LL << shift);
}
return result;
}
size_t growl_sleb128_peek(const uint8_t *ptr, intptr_t *out) {
intptr_t result = 0, shift = 0;
size_t bytes = 0;
uint8_t byte;
do {
byte = ptr[bytes];
bytes++;
result |= (intptr_t)(byte & 0x7f) << shift;
shift += 7;
} while (byte & 0x80);
if (shift < 64 && byte & 0x40) {
result |= -(1LL << shift);
}
if (out)
*out = result;
return bytes;
}

10
next/core/sleb128.h
View file

@ -1,10 +0,0 @@
#ifndef GROWL_SLEB128_H
#define GROWL_SLEB128_H
#include <stdint.h>
#include <stddef.h>
intptr_t growl_sleb128_decode(uint8_t **ptr);
size_t growl_sleb128_peek(const uint8_t *ptr, intptr_t *out);
#endif // GROWL_SLEB128_H

33
next/core/string.c
View file

@ -1,33 +0,0 @@
#include <growl.h>
#include <string.h>
Growl growl_make_string(GrowlVM *vm, size_t len) {
size_t size = sizeof(GrowlObjectHeader) + sizeof(GrowlString) + len;
GrowlObjectHeader *hdr = growl_gc_alloc(vm, size);
hdr->type = GROWL_STRING;
GrowlString *str = (GrowlString *)(hdr + 1);
str->len = len;
memset(str->data, 0, len);
return GROWL_BOX(hdr);
}
Growl growl_wrap_string(GrowlVM *vm, const char *cstr) {
size_t len = strlen(cstr);
size_t size = sizeof(GrowlObjectHeader) + sizeof(GrowlString) + len + 1;
GrowlObjectHeader *hdr = growl_gc_alloc(vm, size);
hdr->type = GROWL_STRING;
GrowlString *str = (GrowlString *)(hdr + 1);
str->len = len;
memcpy(str->data, cstr, len);
str->data[len] = 0;
return GROWL_BOX(hdr);
}
GrowlString *growl_unwrap_string(Growl obj) {
if (obj == 0 || GROWL_IMM(obj))
return NULL;
GrowlObjectHeader *hdr = GROWL_UNBOX(obj);
if (hdr->type != GROWL_STRING)
return NULL;
return (GrowlString *)(hdr + 1);
}

10
next/core/tuple.c
View file

@ -1,10 +0,0 @@
#include <growl.h>
GrowlTuple *growl_unwrap_tuple(Growl obj) {
if (obj == 0 || GROWL_IMM(obj))
return NULL;
GrowlObjectHeader *hdr = GROWL_UNBOX(obj);
if (hdr->type != GROWL_TUPLE)
return NULL;
return (GrowlTuple *)(hdr + 1);
}

164
next/core/vm.c
View file

@ -1,164 +0,0 @@
#include <growl.h>
#include <stdarg.h>
#include <stdlib.h>
#include <stdnoreturn.h>
#include "opcodes.h"
#include "sleb128.h"
#include <inttypes.h>
#include <stdio.h>
GrowlVM *growl_vm_init(void) {
GrowlVM *mem = malloc(sizeof(GrowlVM));
if (mem == NULL) {
abort();
}
growl_arena_init(&mem->from, GROWL_HEAP_SIZE);
growl_arena_init(&mem->to, GROWL_HEAP_SIZE);
growl_arena_init(&mem->arena, GROWL_ARENA_SIZE);
growl_arena_init(&mem->scratch, GROWL_SCRATCH_SIZE);
mem->sp = mem->wst;
mem->rsp = mem->rst;
mem->csp = mem->cst;
for (size_t i = 0; i < GROWL_STACK_SIZE; ++i) {
mem->wst[i] = 0;
mem->rst[i] = 0;
}
mem->roots = NULL;
mem->root_count = 0;
mem->root_capacity = 0;
return mem;
}
void growl_vm_free(GrowlVM *vm) {
growl_arena_free(&vm->from);
growl_arena_free(&vm->to);
growl_arena_free(&vm->arena);
growl_arena_free(&vm->scratch);
if (vm->roots != NULL)
free(vm->roots);
free(vm);
}
__attribute__((format(printf, 2, 3))) static noreturn void
vm_error(GrowlVM *vm, const char *fmt, ...) {
va_list args;
va_start(args, fmt);
fprintf(stderr, "vm: ");
vfprintf(stderr, fmt, args);
fprintf(stderr, "\n");
va_end(args);
longjmp(vm->error, -1);
}
void growl_push(GrowlVM *vm, Growl obj) {
if (vm->sp >= vm->wst + GROWL_STACK_SIZE)
vm_error(vm, "work stack overflow");
*vm->sp++ = obj;
}
Growl growl_pop(GrowlVM *vm) {
if (vm->sp <= vm->wst)
vm_error(vm, "work stack underflow");
Growl obj = *--vm->sp;
*vm->sp = GROWL_NIL;
return obj;
}
void growl_rpush(GrowlVM *vm, Growl obj) {
if (vm->rsp >= vm->rst + GROWL_STACK_SIZE)
vm_error(vm, "work stack overflow");
*vm->rsp++ = obj;
}
Growl growl_rpop(GrowlVM *vm) {
if (vm->rsp <= vm->rst)
vm_error(vm, "work stack underflow");
Growl obj = *--vm->rsp;
*vm->rsp = GROWL_NIL;
return obj;
}
static void push_call(GrowlVM *vm, GrowlQuotation *q, uint8_t *ip) {
if (vm->csp >= vm->cst + GROWL_CALL_STACK_SIZE)
vm_error(vm, "call stack overflow");
vm->csp->quot = q;
vm->csp->ip = ip;
vm->csp++;
}
static GrowlFrame pop_call(GrowlVM *vm) {
if (vm->csp <= vm->cst)
vm_error(vm, "call stack underflow");
return *--vm->csp;
}
int vm_doquot(GrowlVM *vm, GrowlQuotation *quot) {
size_t gc_mark = growl_gc_mark(vm);
int result = setjmp(vm->error);
if (result != 0) {
growl_gc_reset(vm, gc_mark);
return result;
}
GrowlTuple *constants = growl_unwrap_tuple(quot->constants);
if (constants != NULL) {
for (size_t i = 0; i < constants->count; ++i) {
growl_gc_root(vm, &constants->data[i]);
}
}
vm->ip = quot->data;
vm->quotation = quot;
for (;;) {
uint8_t opcode;
switch (opcode = *vm->ip++) {
case GOP_NOP:
break;
case GOP_PUSH_NIL:
growl_push(vm, GROWL_NIL);
break;
case GOP_PUSH_CONSTANT: {
intptr_t idx = growl_sleb128_decode(&vm->ip);
if (constants != NULL) {
growl_push(vm, constants->data[idx]);
} else {
vm_error(vm, "constant index %" PRIdPTR " out of bounds", idx);
}
break;
case GOP_CALL: { // TODO: compose and curry
Growl obj = growl_pop(vm);
push_call(vm, vm->quotation, vm->ip);
GrowlQuotation *obj_quot = growl_unwrap_quotation(obj);
if (obj_quot == NULL)
vm_error(vm, "attempt to call non-callable");
vm->quotation = obj_quot;
vm->ip = obj_quot->data;
break;
}
case GOP_RETURN:
if (vm->csp != vm->cst) {
GrowlFrame frame = pop_call(vm);
vm->quotation = frame.quot;
vm->ip = frame.ip;
} else {
goto done;
}
break;
}
default:
vm_error(vm, "unknown opcode %d", opcode);
}
}
done:
growl_gc_reset(vm, gc_mark);
return 0;
}

135
next/include/growl.h
View file

@ -1,135 +0,0 @@
#ifndef GROWL_H
#define GROWL_H
#include <setjmp.h>
#include <stddef.h>
#include <stdint.h>
typedef uintptr_t Growl;
#define GROWL_NIL ((Growl)(0))
#define GROWL_BOX(x) ((Growl)(x))
#define GROWL_UNBOX(x) ((GrowlObjectHeader *)(x))
#define GROWL_IMM(x) ((Growl)(x) & (Growl)1)
#define GROWL_NUM(x) (((Growl)((intptr_t)(x) << 1)) | (Growl)1)
#define GROWL_ORD(x) ((intptr_t)(x) >> 1)
typedef struct GrowlObjectHeader GrowlObjectHeader;
typedef struct GrowlString GrowlString;
typedef struct GrowlList GrowlList;
typedef struct GrowlTuple GrowlTuple;
typedef struct GrowlQuotation GrowlQuotation;
typedef struct GrowlCompose GrowlCompose;
typedef struct GrowlCurry GrowlCurry;
typedef struct GrowlGCArena GrowlGCArena;
typedef struct GrowlFrame GrowlFrame;
typedef struct GrowlVM GrowlVM;
enum {
GROWL_STRING,
GROWL_LIST,
GROWL_TUPLE,
GROWL_QUOTATION,
GROWL_COMPOSE,
GROWL_CURRY,
};
struct GrowlObjectHeader {
size_t size;
uint32_t type;
};
struct GrowlString {
size_t len;
char data[];
};
Growl growl_make_string(GrowlVM *vm, size_t len);
Growl growl_wrap_string(GrowlVM *vm, const char *cstr);
GrowlString *growl_unwrap_string(Growl obj);
struct GrowlList {
Growl head, tail;
};
struct GrowlTuple {
size_t count;
Growl data[];
};
GrowlTuple *growl_unwrap_tuple(Growl obj);
struct GrowlQuotation {
size_t count;
Growl constants;
uint8_t data[];
};
struct GrowlCompose {
Growl first, second;
};
struct GrowlCurry {
Growl value, callable;
};
int growl_callable(Growl obj);
Growl growl_make_quotation(GrowlVM *vm, const uint8_t *code, size_t code_size,
const Growl *constants, size_t constants_size);
GrowlQuotation *growl_unwrap_quotation(Growl obj);
Growl growl_compose(GrowlVM *vm, Growl first, Growl second);
GrowlCompose *growl_unwrap_compose(Growl obj);
Growl growl_curry(GrowlVM *vm, Growl value, Growl callable);
GrowlCurry *growl_unwrap_curry(Growl obj);
struct GrowlGCArena {
uint8_t *start, *end;
uint8_t *free;
};
void growl_arena_init(GrowlGCArena *arena, size_t size);
void growl_arena_free(GrowlGCArena *arena);
void *growl_arena_alloc(GrowlGCArena *arena, size_t size, size_t align,
size_t count);
#define growl_arena_new(a, t, n) \
(t *)growl_arena_alloc(a, sizeof(t), _Alignof(t), n)
#define GROWL_STACK_SIZE 128
#define GROWL_CALL_STACK_SIZE 64
#define GROWL_HEAP_SIZE (4 * 1024 * 1024)
#define GROWL_ARENA_SIZE (2 * 1024 * 1024)
#define GROWL_SCRATCH_SIZE (1024 * 1024)
struct GrowlFrame {
GrowlQuotation *quot;
uint8_t *ip;
};
struct GrowlVM {
GrowlGCArena from, to;
GrowlGCArena arena;
GrowlGCArena scratch;
GrowlQuotation *quotation;
uint8_t *ip;
Growl wst[GROWL_STACK_SIZE], *sp;
Growl rst[GROWL_STACK_SIZE], *rsp;
GrowlFrame cst[GROWL_CALL_STACK_SIZE], *csp;
Growl **roots;
size_t root_count, root_capacity;
jmp_buf error;
};
GrowlVM *growl_vm_init(void);
void growl_vm_free(GrowlVM *vm);
GrowlObjectHeader *growl_gc_alloc(GrowlVM *vm, size_t size);
GrowlObjectHeader *growl_gc_alloc_tenured(GrowlVM *vm, size_t size);
void growl_gc_collect(GrowlVM *vm);
void growl_gc_root(GrowlVM *vm, Growl *ptr);
size_t growl_gc_mark(GrowlVM *vm);
void growl_gc_reset(GrowlVM *vm, size_t mark);
int vm_doquot(GrowlVM *vm, GrowlQuotation *quot);
#endif // GROWL_H

18
next/main.c
View file

@ -1,18 +0,0 @@
#include "core/opcodes.h"
#include <growl.h>
static uint8_t code[] = {
GOP_PUSH_NIL,
GOP_RETURN,
};
int main(void) {
GrowlVM *vm = growl_vm_init();
Growl quot_obj = growl_make_quotation(vm, code, sizeof(code), NULL, 0);
GrowlQuotation *quot = (GrowlQuotation *)(GROWL_UNBOX(quot_obj) + 1);
vm_doquot(vm, quot);
growl_gc_collect(vm);
growl_vm_free(vm);
}

283
src/compile.c
View file

@ -7,12 +7,13 @@
#include "debug.h"
#include "gc.h"
#include "object.h"
#include "parser.h"
#include "src/primitive.h"
#include "string.h"
#include "vendor/yar.h"
#include "vm.h"
#include "vendor/mpc.h"
#include "vendor/yar.h"
// clang-format off
struct {
const char *name;
@ -25,7 +26,6 @@ struct {
{"2dup", {OP_2DUP, 0}},
{"2drop", {OP_2DROP, 0}},
{"2swap", {OP_2SWAP, 0}},
{"2over", {OP_2TOR, OP_2DUP, OP_2FROMR, OP_2SWAP, 0}},
{"over", {OP_OVER, 0}},
{"nip", {OP_NIP, 0}},
{"bury", {OP_BURY, 0}},
@ -118,7 +118,8 @@ static V optim_tailcall(Bc *chunk) {
}
}
static I compile_expr(Cm *cm, Ast *node);
static I compile_expr(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next);
static I compile_ast(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next);
static I compile_constant(Cm *cm, O value, I line, I col) {
I idx = chunk_add_constant(cm->chunk, value);
@ -168,16 +169,31 @@ static I compile_call(Cm *cm, const char *name, I line, I col) {
return 1;
}
static I compile_command(Cm *cm, Ast *node) {
for (size_t i = 0; i < node->children.count; i++) {
if (!compile_expr(cm, node->children.items[i]))
static I compile_command(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next) {
curr = mpc_ast_traverse_next(next);
const char *name = curr->contents;
I name_line = curr->state.row;
I name_col = curr->state.col;
(void)mpc_ast_traverse_next(next);
curr = mpc_ast_traverse_next(next);
while (curr != NULL) {
if (strcmp(curr->tag, "char") == 0 && strcmp(curr->contents, ";") == 0)
break;
I res = compile_expr(cm, curr, next);
if (!res)
return 0;
curr = mpc_ast_traverse_next(next);
}
return compile_call(cm, node->name, node->line, node->col);
compile_call(cm, name, name_line, name_col);
return 1;
}
static I compile_definition(Cm *cm, Ast *node) {
const char *name = arena_strdup(cm->arena, node->name);
static I compile_definition(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next) {
(void)mpc_ast_traverse_next(next); // skip 'def'
curr = mpc_ast_traverse_next(next);
const char *name = arena_strdup(cm->arena, curr->contents);
(void)mpc_ast_traverse_next(next); // skip '{'
Dt *entry = upsert(cm->dictionary, name, cm->arena);
Cm inner = {0};
@ -186,14 +202,19 @@ static I compile_definition(Cm *cm, Ast *node) {
inner.vm = cm->vm;
inner.dictionary = cm->dictionary;
for (size_t i = 0; i < node->children.count; i++) {
if (!compile_expr(&inner, node->children.items[i])) {
curr = mpc_ast_traverse_next(next);
while (curr != NULL) {
if (strcmp(curr->tag, "char") == 0 && strcmp(curr->contents, "}") == 0)
break;
if (!compile_expr(&inner, curr, next)) {
chunk_release(inner.chunk);
return 0;
}
curr = mpc_ast_traverse_next(next);
}
chunk_emit_byte_with_line(inner.chunk, OP_RETURN, node->line, node->col);
chunk_emit_byte_with_line(inner.chunk, OP_RETURN, curr->state.row,
curr->state.col);
optim_tailcall(inner.chunk);
entry->chunk = inner.chunk;
@ -205,7 +226,7 @@ static I compile_definition(Cm *cm, Ast *node) {
return 1;
}
static O compile_quotation_obj(Cm *cm, Ast *node) {
static O compile_quotation_obj(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next) {
Cm inner = {0};
inner.arena = cm->arena;
@ -213,13 +234,20 @@ static O compile_quotation_obj(Cm *cm, Ast *node) {
inner.vm = cm->vm;
inner.dictionary = cm->dictionary;
for (size_t i = 0; i < node->children.count; i++) {
if (!compile_expr(&inner, node->children.items[i])) {
(void)mpc_ast_traverse_next(next);
curr = mpc_ast_traverse_next(next);
while (curr != NULL) {
if (strcmp(curr->tag, "char") == 0 && strcmp(curr->contents, "]") == 0)
break;
I res = compile_expr(&inner, curr, next);
if (!res) {
chunk_release(inner.chunk);
return NIL;
return res;
}
curr = mpc_ast_traverse_next(next);
}
chunk_emit_byte_with_line(inner.chunk, OP_RETURN, node->line, node->col);
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,103 +258,158 @@ static O compile_quotation_obj(Cm *cm, Ast *node) {
return BOX(hd);
}
static I compile_quotation(Cm *cm, Ast *node) {
O obj = compile_quotation_obj(cm, node);
if (obj == NIL)
return 0;
return compile_constant(cm, obj, node->line, node->col);
static I compile_quotation(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next,
I line, I col) {
return compile_constant(cm, compile_quotation_obj(cm, curr, next), line, col);
}
static I compile_pragma(Cm *cm, Ast *node) {
if (strcmp(node->name, "#load") == 0) {
if (node->children.count == 0) {
fprintf(stderr, "compiler error: #load requires argument\n");
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;
}
Ast *arg = node->children.items[0];
if (arg->type != AST_STR) {
fprintf(stderr, "compiler error: #load requires string\n");
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 = arg->name;
FILE *f = fopen(fname, "rb");
if (!f) {
fprintf(stderr, "compiler error: cannot open file '%s'\n", fname);
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;
}
Stream s = {filestream_vtable, f};
Lx *lx = lexer_make(&s);
Ast *root = parser_parse(lx);
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 = 1;
for (size_t i = 0; i < root->children.count; i++) {
if (!compile_expr(cm, root->children.items[i])) {
success = 0;
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;
}
}
ast_free(root);
lexer_free(lx);
fclose(f);
return success;
}
fprintf(stderr, "compiler warning: unknown pragma \"%s\"\n", node->name);
return 1;
}
static I compile_expr(Cm *cm, Ast *node) {
if (!node)
return 0;
switch (node->type) {
case AST_INT: {
O num = NUM(node->int_val);
return compile_constant(cm, num, node->line, node->col);
}
case AST_STR: {
O obj = string_make(cm->vm, node->name, -1);
return compile_constant(cm, obj, node->line, node->col);
}
case AST_WORD:
return compile_call(cm, node->name, node->line, node->col);
case AST_QUOTE:
return compile_quotation(cm, node);
case AST_DEF:
return compile_definition(cm, node);
case AST_CMD:
return compile_command(cm, node);
case AST_PRAGMA:
return compile_pragma(cm, node);
case AST_PROGRAM:
for (size_t i = 0; i < node->children.count; i++) {
if (!compile_expr(cm, node->children.items[i]))
return 0;
}
return 1;
default:
fprintf(stderr, "compiler error: nyi ast type %d\n", (int)node->type);
return 0;
}
}
Bc *compile_program(Cm *cm, Ast *ast) {
if (ast->type == AST_PROGRAM) {
for (size_t i = 0; i < ast->children.count; i++) {
if (!compile_expr(cm, ast->children.items[i])) {
chunk_release(cm->chunk);
return NULL;
}
curr = mpc_ast_traverse_next(next);
}
} else {
if (!compile_expr(cm, ast)) {
chunk_release(cm->chunk);
return NULL;
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;
}
}
chunk_emit_byte(cm->chunk, OP_RETURN);
optim_tailcall(cm->chunk);
return cm->chunk;
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;
if (strstr(curr->tag, "expr|number") != NULL) {
I num = strtol(curr->contents, NULL, 0);
return compile_constant(cm, NUM(num), line, col);
} else if (strstr(curr->tag, "expr|string") != NULL) {
curr->contents[strlen(curr->contents) - 1] = '\0';
char *unescaped = malloc(strlen(curr->contents + 1) + 1);
strcpy(unescaped, curr->contents + 1);
unescaped = mpcf_unescape(unescaped);
O obj = string_make(cm->vm, unescaped, -1);
free(unescaped);
return compile_constant(cm, obj, line, col);
} else if (strstr(curr->tag, "expr|word") != NULL) {
return compile_call(cm, curr->contents, line, col);
} else if (strstr(curr->tag, "expr|quotation") != NULL) {
return compile_quotation(cm, curr, next, line, col);
} else if (strstr(curr->tag, "expr|def") != NULL) {
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 {
fprintf(stderr, "compiler error at %ld:%ld: \"%s\" nyi\n", line + 1,
col + 1, curr->tag);
return 0;
}
}
static I compile_ast(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next) {
(void)mpc_ast_traverse_next(next);
curr = mpc_ast_traverse_next(next);
while (curr != NULL) {
if (strcmp(curr->tag, "regex") == 0 && strcmp(curr->contents, "") == 0)
break;
I res = compile_expr(cm, curr, next);
if (!res)
return res;
curr = mpc_ast_traverse_next(next);
}
return 1;
}
Bc *compile_program(Cm *cm, mpc_ast_t *ast) {
mpc_ast_trav_t *next = mpc_ast_traverse_start(ast, mpc_ast_trav_order_pre);
mpc_ast_t *curr = mpc_ast_traverse_next(&next); // Begin traversal
if (!compile_ast(cm, curr, &next)) {
chunk_release(cm->chunk);
return NULL;
}
Bc *chunk = cm->chunk;
chunk_emit_byte(chunk, OP_RETURN);
optim_tailcall(chunk);
return chunk;
}

7
src/compile.h
View file

@ -4,9 +4,10 @@
#include "chunk.h"
#include "gc.h"
#include "vm.h"
#include "parser.h"
#define COMPILER_DEBUG 0
#include "vendor/mpc.h"
#define COMPILER_DEBUG DEBUG
/** Compiler context */
typedef struct Cm {
@ -18,4 +19,4 @@ typedef struct Cm {
V compiler_init(Cm *, Vm *, const char *);
V compiler_deinit(Cm *);
Bc *compile_program(Cm *, Ast *);
Bc *compile_program(Cm *, mpc_ast_t *);

4
src/debug.c
View file

@ -3,8 +3,8 @@
#include "chunk.h"
#include "debug.h"
#include "dictionary.h"
#include "primitive.h"
#include "print.h"
#include "src/primitive.h"
#include "vm.h"
static I decode_sleb128(U8 *ptr, Z *bytes_read) {
@ -70,7 +70,7 @@ static Z dis_instr(Bc *chunk, Z offset, Dt **dictionary, I indent) {
print(obj);
printf(")");
if (!IMM(obj) && obj != NIL && type(obj) == OBJ_QUOT) {
if (!IMM(obj) && obj != NIL && type(obj) == TYPE_QUOT) {
putchar('\n');
Hd *hdr = UNBOX(obj);
Bc **chunk_ptr = (Bc **)(hdr + 1);

2
src/gc.h
View file

@ -4,7 +4,7 @@
#include "common.h"
#include "object.h"
#define GC_DEBUG 1
#define GC_DEBUG 0
#if GC_DEBUG
#define HEAP_BYTES (8 * 1024)
#else

72
src/lexer.c
View file

@ -1,42 +1,12 @@
#include <ctype.h>
#include <err.h>
#include <stdio.h>
#include <stdlib.h>
#include <utf.h>
#include "lexer.h"
#include "vendor/yar.h"
Lx *lexer_make(Stream *s) {
Lx *lx = calloc(1, sizeof(Lx));
lx->stream = s;
return lx;
}
V lexer_free(Lx *lx) {
yar_free(lx);
free(lx);
}
static int lx_getc(Lx *lx) {
int c = ST_GETC(lx->stream);
if (c == '\n') {
lx->curr_line++;
lx->curr_col = 0;
} else if (c != -1) {
lx->curr_col++;
}
return c;
}
static void lx_ungetc(Lx *lx, int c) {
ST_UNGETC(c, lx->stream);
if (c == '\n') {
lx->curr_line--;
} else if (c != -1) {
lx->curr_col--;
}
}
static inline int is_delimiter(int i) {
return i == '(' || i == ')' || i == '[' || i == ']' || i == '{' || i == '}' ||
i == ';' || i == '\\' || i == '"';
@ -54,7 +24,7 @@ static int getc_ws(Lx *lx) {
if (ST_EOF(lx->stream))
return -1;
for (;;) {
int ch = lx_getc(lx);
int ch = ST_GETC(lx->stream);
if (isspace(ch))
continue;
return ch;
@ -62,21 +32,21 @@ static int getc_ws(Lx *lx) {
}
static int scanword(Lx *lx) {
int next = lx_getc(lx);
int next = ST_GETC(lx->stream);
for (;;) {
if (next == -1) {
if (lx->count == 0)
if (lx->cursor == 0)
lx->kind = TOK_EOF;
appendbyte(lx, 0);
return lx->kind;
} else if (is_delimiter(next) || isspace(next)) {
lx_ungetc(lx, next);
ST_UNGETC(next, lx->stream);
appendbyte(lx, 0);
return lx->kind;
} else {
appendbyte(lx, next);
next = lx_getc(lx);
next = ST_GETC(lx->stream);
continue;
}
}
@ -88,7 +58,7 @@ static void scanescape(Lx *lx) {
Rune tmp;
for (;;) {
next = lx_getc(lx);
next = ST_GETC(lx->stream);
if (next == -1) {
errx(1, "unterminated hex sequence '%s'", escbuf);
@ -107,28 +77,22 @@ static void scanescape(Lx *lx) {
}
tmp = strtol(escbuf, &escptr, 16);
if (*escptr == '\0') {
if (tmp < 256) {
appendbyte(lx, (U8)(tmp & 255));
} else {
if (*escptr == '\0')
appendrune(lx, tmp);
}
} else {
else
errx(1, "invalid hex sequence '%s'", escbuf);
}
}
static int scanstring(Lx *lx) {
int next;
for (;;) {
next = lx_getc(lx);
next = ST_GETC(lx->stream);
switch (next) {
case -1:
goto eof;
case '\\':
next = lx_getc(lx);
next = ST_GETC(lx->stream);
if (next == -1)
goto eof;
switch (next) {
@ -164,7 +128,8 @@ static int scanstring(Lx *lx) {
scanescape(lx);
break;
default:
return (lx->kind = TOK_INVALID);
fprintf(stderr, "unknown escape sequence '\\%c'\n", next);
abort();
}
break;
case '"':
@ -176,13 +141,13 @@ static int scanstring(Lx *lx) {
}
eof:
return (lx->kind = TOK_INVALID);
errx(1, "unterminated string literal");
return 0;
}
I lexer_next(Lx *lx) {
int next;
lx->cursor = 0;
lx->count = 0;
if (ST_EOF(lx->stream)) {
lx->kind = TOK_EOF;
@ -191,12 +156,9 @@ I lexer_next(Lx *lx) {
next = getc_ws(lx);
lx->start_line = lx->curr_line;
lx->start_col = (lx->curr_col > 0) ? lx->curr_col - 1 : 0;
switch (next) {
case '\\':
for (; next != '\n'; next = lx_getc(lx))
for (; next != '\n'; next = ST_GETC(lx->stream))
;
return lexer_next(lx);
case '(':
@ -210,7 +172,7 @@ I lexer_next(Lx *lx) {
case '"':
return scanstring(lx);
default:
lx_ungetc(lx, next);
ST_UNGETC(next, lx->stream);
lx->kind = TOK_WORD;
return scanword(lx);
};

3
src/lexer.h
View file

@ -22,15 +22,12 @@ enum {
typedef struct Lx {
I kind;
I cursor;
I curr_line, curr_col;
I start_line, start_col;
Stream *stream;
char *items;
Z count, capacity;
} Lx;
Lx *lexer_make(Stream *);
V lexer_free(Lx *lx);
I lexer_next(Lx *);
#endif

40
src/main.c
View file

@ -1,6 +1,5 @@
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "chunk.h"
#include "compile.h"
@ -9,6 +8,7 @@
#include "vm.h"
#include "vendor/linenoise.h"
#include "vendor/mpc.h"
#define REPL_BUFFER_SIZE 4096
@ -18,18 +18,16 @@ I repl(void) {
char *line;
while ((line = linenoise("growl> ")) != NULL) {
Buf b = { line, (int)strlen(line), 0, -1 };
Stream s = { bufstream_vtable, &b };
Lx *lx = lexer_make(&s);
Ast *root = parser_parse(lx);
mpc_result_t res;
if (!mpc_parse("<repl>", line, Program, &res)) {
mpc_err_print_to(res.error, stderr);
mpc_err_delete(res.error);
continue;
}
Cm cm = {0};
compiler_init(&cm, &vm, "<repl>");
Bc *chunk = compile_program(&cm, root);
ast_free(root);
lexer_free(lx);
Bc *chunk = compile_program(&cm, res.output);
mpc_ast_delete(res.output);
if (chunk != NULL) {
vm_run(&vm, chunk, 0);
chunk_release(chunk);
@ -46,23 +44,18 @@ I loadfile(const char *fname) {
Vm vm = {0};
vm_init(&vm);
FILE *f = fopen(fname, "rb");
if (!f) {
fprintf(stderr, "error: cannot open file '%s'\n", fname);
mpc_result_t res;
if (!mpc_parse_contents(fname, Program, &res)) {
mpc_err_print_to(res.error, stderr);
mpc_err_delete(res.error);
return 1;
}
Stream s = { filestream_vtable, f };
Lx *lx = lexer_make(&s);
Ast *root = parser_parse(lx);
Cm cm = {0};
compiler_init(&cm, &vm, fname);
Bc *chunk = compile_program(&cm, root);
ast_free(root);
lexer_free(lx);
fclose(f);
Bc *chunk = compile_program(&cm, res.output);
mpc_ast_delete(res.output);
if (chunk != NULL) {
#if COMPILER_DEBUG
@ -79,6 +72,9 @@ I loadfile(const char *fname) {
}
int main(int argc, const char *argv[]) {
parser_init();
atexit(parser_deinit);
switch (argc) {
case 1:
return repl();

4
src/object.c
View file

@ -2,9 +2,9 @@
I type(O o) {
if (o == NIL)
return OBJ_NIL;
return TYPE_NIL;
if (IMM(o))
return OBJ_NUM;
return TYPE_NUM;
Hd *h = UNBOX(o);
return h->type;
}

16
src/object.h
View file

@ -11,17 +11,25 @@
#define ORD(x) ((intptr_t)(x) >> 1)
enum {
OBJ_NIL = 0,
OBJ_NUM = 1,
OBJ_FWD = 2,
OBJ_QUOT,
OBJ_COMPOSE,
OBJ_CURRY,
OBJ_STR,
OBJ_ARRAY,
OBJ_USERDATA,
};
enum {
TYPE_NIL = 0,
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,
};
typedef uintptr_t O;
/** Object header */
@ -42,7 +50,7 @@ typedef struct Qc {
I type(O);
static inline I callable(O o) {
I t = type(o);
return t == OBJ_QUOT || t == OBJ_COMPOSE || t == OBJ_CURRY;
return t == TYPE_QUOT || t == TYPE_COMPOSE || t == TYPE_CURRY;
}
#endif

189
src/parser.c
View file

@ -1,156 +1,51 @@
#include "parser.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "vendor/mpc.h"
static Ast *ast_new(I type, I line, I col) {
Ast *node = calloc(1, sizeof(Ast));
node->type = type;
node->line = line;
node->col = col;
return node;
}
mpc_parser_t *Pragma, *Comment, *Expr, *Number, *String, *Word, *Definition,
*Command, *List, *Table, *Quotation, *Program;
void ast_free(Ast *ast) {
if (!ast)
return;
if (ast->name)
free(ast->name);
for (size_t i = 0; i < ast->children.count; i++) {
ast_free(ast->children.items[i]);
}
yar_free(&ast->children);
free(ast);
}
V parser_init(V) {
Pragma = mpc_new("pragma");
Comment = mpc_new("comment");
Expr = mpc_new("expr");
Number = mpc_new("number");
String = mpc_new("string");
Word = mpc_new("word");
Definition = mpc_new("def");
Command = mpc_new("command");
List = mpc_new("list");
Table = mpc_new("table");
Quotation = mpc_new("quotation");
Program = mpc_new("program");
static Ast *parse_expr_at(Lx *lx);
mpc_err_t *err = mpca_lang(
MPCA_LANG_DEFAULT,
" pragma : '#' <word> ('(' <expr>* ')')? ; "
" comment : /\\\\[^\\n]*/ ; "
" expr : ( <pragma> | <def> | <command> | <quotation> "
" | <number> | <list> | <table> | <string> "
" | <word> | <comment> ) ; "
" number : ( /0x[0-9A-Fa-f]+/ | /-?[0-9]+/ ) ; "
" string : /\"(\\\\.|[^\"])*\"/ ; "
" word : /[a-zA-Z0-9_!?.,@#$%^&*_+\\-=><|\\/]+/ ; "
" def : \"def\" <word> '{' <expr>* '}' ; "
" command : <word> ':' <expr>+ ';' ; "
" list : '(' <expr>* ')' ; "
" table : '{' <expr>* '}' ; "
" quotation : '[' <expr>* ']' ; "
" program : /^/ <expr>* /$/ ; ",
Pragma, Comment, Expr, Number, String, Word, Definition, Command, List,
Table, Quotation, Program, NULL);
static void parse_block(Lx *lx, Ast *parent, int close_token) {
while (1) {
if (lx->kind == TOK_EOF) {
if (close_token != TOK_EOF)
fprintf(stderr, "syntax error: unexpected EOF, expected '%c'\n",
close_token);
break;
}
if (lx->kind == close_token) {
lexer_next(lx);
break;
}
Ast *expr = parse_expr_at(lx);
*yar_append(&parent->children) = expr;
// crash if i do a woopsie
if (err != NULL) {
mpc_err_print(err);
mpc_err_delete(err);
abort();
}
}
static Ast *parse_expr_at(Lx *lx) {
int kind = lx->kind;
I line = lx->start_line;
I col = lx->start_col;
if (kind == TOK_WORD) {
char *text = lx->items;
if (strcmp(text, "def") == 0) {
Ast *node = ast_new(AST_DEF, line, col);
lexer_next(lx);
if (lx->kind != TOK_WORD) {
fprintf(stderr, "syntax error: expected word after 'def' at %ld:%ld\n",
(long)line + 1, (long)col + 1);
return node;
}
node->name = strdup(lx->items);
lexer_next(lx);
if (lx->kind != '{') {
fprintf(stderr,
"syntax error: expected '{' after def name at %ld:%ld\n",
(long)lx->start_line + 1, (long)lx->start_col + 1);
return node;
}
lexer_next(lx);
parse_block(lx, node, '}');
return node;
}
size_t len = strlen(text);
if (len > 0 && text[len - 1] == ':') {
Ast *node = ast_new(AST_CMD, line, col);
node->name = strndup(text, len - 1);
lexer_next(lx);
parse_block(lx, node, ';');
return node;
}
if (text[0] == '#') {
Ast *node = ast_new(AST_PRAGMA, line, col);
node->name = strdup(text);
lexer_next(lx);
if (lx->kind == '(') {
lexer_next(lx);
parse_block(lx, node, ')');
}
return node;
}
char *end;
long val = strtol(text, &end, 0);
if (*end == '\0') {
Ast *node = ast_new(AST_INT, line, col);
node->int_val = val;
lexer_next(lx);
return node;
}
Ast *node = ast_new(AST_WORD, line, col);
node->name = strdup(text);
lexer_next(lx);
return node;
}
if (kind == TOK_STRING) {
Ast *node = ast_new(AST_STR, line, col);
node->name = strdup(lx->items);
lexer_next(lx);
return node;
}
if (kind == '[') {
Ast *node = ast_new(AST_QUOTE, line, col);
lexer_next(lx);
parse_block(lx, node, ']');
return node;
}
if (kind == '{') {
Ast *node = ast_new(AST_TABLE, line, col);
lexer_next(lx);
parse_block(lx, node, '}');
return node;
}
if (kind == '(') {
Ast *node = ast_new(AST_LIST, line, col);
lexer_next(lx);
parse_block(lx, node, ')');
return node;
}
if (kind == TOK_INVALID) {
fprintf(stderr, "syntax error: invalid token at %ld:%ld\n", (long)line + 1,
(long)col + 1);
} else {
fprintf(stderr, "syntax error: unexpected token '%c' (%d) at %ld:%ld\n",
kind, kind, (long)line + 1, (long)col + 1);
}
lexer_next(lx);
return NULL;
}
Ast *parser_parse(Lx *lx) {
Ast *root = ast_new(AST_PROGRAM, 0, 0);
lexer_next(lx);
parse_block(lx, root, TOK_EOF);
return root;
V parser_deinit(V) {
mpc_cleanup(12, Pragma, Comment, Expr, Number, String, Word, Definition,
Command, List, Table, Quotation, Program);
}

31
src/parser.h
View file

@ -2,34 +2,11 @@
#define PARSER_H
#include "common.h"
#include "lexer.h"
#include "vendor/yar.h"
#include "vendor/mpc.h"
enum {
AST_PROGRAM,
AST_INT,
AST_STR,
AST_WORD,
AST_LIST,
AST_TABLE,
AST_QUOTE,
AST_DEF,
AST_CMD,
AST_PRAGMA,
};
V parser_init(V);
V parser_deinit(V);
typedef struct Ast {
I type;
char *name;
I int_val;
struct {
struct Ast **items;
Z count, capacity;
} children;
I line, col;
} Ast;
Ast *parser_parse(Lx *lx);
void ast_free(Ast *ast);
extern mpc_parser_t *Program;
#endif

1
src/primitive.h
View file

@ -1,6 +1,7 @@
#ifndef PRIMITIVE_H
#define PRIMITIVE_H
#include "common.h"
#include "vm.h"
typedef struct Pr {

57
src/print.c
View file

@ -1,56 +1,13 @@
#include <inttypes.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "object.h"
#include "print.h"
#include "string.h"
#include "userdata.h"
static V print_string(Str *s) {
putchar('"');
for (Z i = 0; i < s->len; i++) {
unsigned char c = s->data[i];
switch (c) {
case '\t':
printf("\\t");
break;
case '\n':
printf("\\n");
break;
case '\r':
printf("\\r");
break;
case '\b':
printf("\\b");
break;
case '\v':
printf("\\v");
break;
case '\f':
printf("\\f");
break;
case '\0':
printf("\\0");
break;
case '\x1b':
printf("\\e");
break;
case '\\':
printf("\\\\");
break;
case '\"':
printf("\\\"");
break;
default:
if (c < 32 || c > 126) {
printf("\\x%02x;", c);
} else {
putchar(c);
}
}
}
putchar('"');
}
#include "vendor/mpc.h"
V print(O o) {
if (o == NIL) {
@ -70,8 +27,14 @@ V print(O o) {
printf("<curried>");
break;
case OBJ_STR: {
// TODO: make this binary safe
Str *s = string_unwrap(o);
print_string(s);
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;
}
case OBJ_USERDATA: {

22
src/vm.c
View file

@ -206,9 +206,9 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
O obj2 = vm_pop(vm);
O obj1 = vm_pop(vm);
vm_push(vm, obj1);
vm_push(vm, obj2);
vm_push(vm, obj1);
vm_push(vm, obj2);
vm_push(vm, obj2);
break;
}
case OP_SWAP: {
@ -223,10 +223,10 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
O c = vm_pop(vm);
O b = vm_pop(vm);
O a = vm_pop(vm);
vm_push(vm, c);
vm_push(vm, d);
vm_push(vm, a);
vm_push(vm, c);
vm_push(vm, b);
vm_push(vm, a);
break;
}
case OP_NIP: {
@ -302,21 +302,21 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
vm_rpush(vm, vm->chunk, vm->ip);
do_call:
switch (type(quot)) {
case OBJ_QUOT: {
case TYPE_QUOT: {
Bc **ptr = (Bc **)(UNBOX(quot) + 1);
Bc *chunk = *ptr;
vm->chunk = chunk;
vm->ip = chunk->items;
break;
}
case OBJ_COMPOSE: {
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 OBJ_CURRY: {
case TYPE_CURRY: {
Qc *curry = (Qc *)(UNBOX(quot) + 1);
vm_push(vm, curry->value);
quot = curry->callable;
@ -345,21 +345,21 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
O quot = vm_pop(vm);
do_tail_call:
switch (type(quot)) {
case OBJ_QUOT: {
case TYPE_QUOT: {
Bc **ptr = (Bc **)(UNBOX(quot) + 1);
Bc *chunk = *ptr;
vm->chunk = chunk;
vm->ip = chunk->items;
break;
}
case OBJ_COMPOSE: {
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 OBJ_CURRY: {
case TYPE_CURRY: {
Qc *curry = (Qc *)(UNBOX(quot) + 1);
vm_push(vm, curry->value);
quot = curry->callable;
@ -491,10 +491,10 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
}
case OP_CONCAT: {
O b = vm_pop(vm);
if (type(b) != OBJ_STR)
if (type(b) != TYPE_STR)
vm_error(vm, VM_ERR_TYPE, "expected string");
O a = vm_pop(vm);
if (type(a) != OBJ_STR)
if (type(a) != TYPE_STR)
vm_error(vm, VM_ERR_TYPE, "expected string");
vm_push(vm, string_concat(vm, a, b));
break;

1
std.grr
View file

@ -14,7 +14,6 @@ def 3dip { swap [2dip] dip }
def keep { over [call] dip }
def 2keep { [2dup] dip 2dip }
def 3keep { [dup 2over dig] dip 3dip }
def bi { [keep] dip call }
def tri { [[keep] dip keep] dip call }