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

remove old interpreter from source tree

Browse source
This commit is contained in:
Lobo 2026-02-09 10:48:16 -03:00
parent d279bf1d31
commit e18681b309
91 changed files with 45 additions and 11539 deletions
Download patch file Download diff file Expand all files Collapse all files

80
meson.build
View file

@ -1,79 +1,45 @@
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=2',
],
)
libutf = subproject('libutf')
libutf_dep = libutf.get_variable('libutf_dep')
growl_sources = [
'src/arena.c',
'src/chunk.c',
'src/compile.c',
'src/debug.c',
'src/dictionary.c',
'src/file.c',
'src/lexer.c',
'src/object.c',
'src/gc.c',
'src/parser.c',
'src/primitive.c',
'src/print.c',
'src/stream.c',
'src/string.c',
'src/userdata.c',
'src/vm.c',
'src/vendor/linenoise.c',
'src/vendor/yar.c',
]
growl = executable(
'growl',
'src/core/alien.c',
'src/core/arena.c',
'src/core/callable.c',
'src/core/compiler.c',
'src/core/dictionary.c',
'src/core/disasm.c',
'src/core/file.c',
'src/core/gc.c',
'src/core/hash.c',
'src/core/lexer.c',
'src/core/list.c',
'src/core/native.c',
'src/core/print.c',
'src/core/sleb128.c',
'src/core/string.c',
'src/core/table.c',
'src/core/tuple.c',
'src/core/value.c',
'src/core/vm.c',
'src/main.c',
growl_sources,
dependencies: [libutf_dep],
install: true,
)
growlnext_sources = [
'next/core/alien.c',
'next/core/arena.c',
'next/core/callable.c',
'next/core/compiler.c',
'next/core/dictionary.c',
'next/core/disasm.c',
'next/core/file.c',
'next/core/gc.c',
'next/core/hash.c',
'next/core/lexer.c',
'next/core/list.c',
'next/core/native.c',
'next/core/print.c',
'next/core/sleb128.c',
'next/core/string.c',
'next/core/table.c',
'next/core/tuple.c',
'next/core/value.c',
'next/core/vm.c',
'next/main.c',
]
cc = meson.get_compiler('c')
m_dep = cc.find_library('m', required: false)
growlnext = executable(
'growlnext',
growlnext_sources,
growl = executable(
'growl',
growl_sources,
dependencies: [m_dep],
include_directories: ['next/include'],
include_directories: ['src/include'],
install: true,
)

28
next/main.c
View file

@ -1,28 +0,0 @@
#include <growl.h>
#include <math.h>
int main(void) {
GrowlVM *vm = growl_vm_init();
growl_register_file_library(vm);
GrowlLexer lexer = {0};
lexer.file = stdin;
Growl obj = growl_compile(vm, &lexer);
if (obj != GROWL_NIL) {
GrowlQuotation *quot = growl_unwrap_quotation(obj);
if (!growl_vm_execute(vm, quot)) {
if (vm->sp != vm->wst) {
fprintf(stderr, "Stack:");
for (Growl *p = vm->wst; p < vm->sp; p++) {
putc(' ', stderr);
growl_print_to(stderr, *p);
}
putchar('\n');
}
}
}
growl_gc_collect(vm);
growl_vm_free(vm);
return 0;
}

31
src/arena.c
View file

@ -1,31 +0,0 @@
#include "arena.h"
#include <assert.h>
#include <stdlib.h>
#include <string.h>
V *_arena_alloc(Ar *ar, I count, I size, I align) {
I pad = -(U)ar->start & (align - 1);
assert(count < (ar->end - ar->start - pad) / size);
V *r = ar->start + pad;
ar->start += pad + count * size;
return memset(r, 0, count * size);
}
V arena_init(Ar *ar, Z size) {
ar->data = malloc(size);
ar->start = ar->data;
ar->end = ar->start + size;
}
V arena_free(Ar *ar) {
free(ar->data);
ar->data = ar->start = ar->end = NULL;
}
char *arena_strdup(Ar *ar, const char *str) {
Z len = strlen(str) + 1;
char *copy = arena_alloc(ar, len, char);
memcpy(copy, str, len);
return copy;
}

18
src/arena.h
View file

@ -1,18 +0,0 @@
#ifndef ARENA_H
#define ARENA_H
#include "common.h"
typedef struct Ar {
U8 *data;
U8 *start, *end;
} Ar;
#define arena_alloc(a, n, t) (t *)_arena_alloc(a, n, sizeof(t), _Alignof(t))
V *_arena_alloc(Ar *, ptrdiff_t, ptrdiff_t, ptrdiff_t);
V arena_init(Ar *, Z);
V arena_free(Ar *);
char *arena_strdup(Ar *, const char *);
#endif

91
src/chunk.c
View file

@ -1,91 +0,0 @@
#include <stdlib.h>
#include "chunk.h"
#include "vendor/yar.h"
#if CHUNK_DEBUG
#include <stdio.h>
#endif
Bc *chunk_new(const char *name) {
Bc *chunk = calloc(1, sizeof(Bc));
chunk->name = name;
chunk->ref = 1;
#if CHUNK_DEBUG
fprintf(stderr, "DEBUG: created chunk %s at %p\n", chunk->name, (V *)chunk);
#endif
return chunk;
}
V chunk_acquire(Bc *chunk) {
#if CHUNK_DEBUG
fprintf(stderr, "DEBUG: acquiring chunk %s at %p\n", chunk->name, (V *)chunk);
#endif
chunk->ref++;
}
V chunk_release(Bc *chunk) {
#if CHUNK_DEBUG
fprintf(stderr, "DEBUG: releasing chunk %s at %p\n", chunk->name, (V *)chunk);
#endif
if (--chunk->ref == 0) {
#if CHUNK_DEBUG
fprintf(stderr, "DEBUG: freeing chunk %s at %p\n", chunk->name, (V *)chunk);
#endif
yar_free(&chunk->constants);
yar_free(&chunk->lines);
yar_free(&chunk->symbols);
yar_free(chunk);
free(chunk);
}
}
V chunk_emit_byte(Bc *chunk, U8 byte) { *yar_append(chunk) = byte; }
V chunk_emit_sleb128(Bc *chunk, I num) {
I more = 1;
while (more) {
U8 byte = num & 0x7f;
num >>= 7;
if ((num == 0 && !(byte & 0x40)) || (num == -1 && (byte & 0x40))) {
more = 0;
} else {
byte |= 0x80;
}
chunk_emit_byte(chunk, byte);
}
}
I chunk_add_constant(Bc *chunk, O value) {
I mark = chunk->constants.count;
*yar_append(&chunk->constants) = value;
return mark;
}
V chunk_emit_byte_with_line(Bc *chunk, U8 byte, I line, I col) {
*yar_append(chunk) = byte;
if (chunk->lines.count == 0 ||
chunk->lines.items[chunk->lines.count - 1].row != line ||
chunk->lines.items[chunk->lines.count - 1].col != col) {
Bl *entry = yar_append(&chunk->lines);
entry->offset = chunk->count - 1;
entry->row = line;
entry->col = col;
}
}
I chunk_get_line(Bc *chunk, Z offset, I *out_col) {
if (chunk->lines.count == 0)
return -1;
Z left = 0, right = chunk->lines.count - 1;
while (left < right) {
Z mid = left + (right - left + 1) / 2;
if (chunk->lines.items[mid].offset <= offset)
left = mid;
else
right = mid - 1;
}
if (out_col)
*out_col = chunk->lines.items[left].col;
return chunk->lines.items[left].row;
}

50
src/chunk.h
View file

@ -1,50 +0,0 @@
#ifndef CHUNK_H
#define CHUNK_H
#define CHUNK_DEBUG 0
#include "common.h"
#include "object.h"
typedef struct Bl {
Z offset;
I row;
I col;
} Bl;
typedef struct Bs {
const char *name;
struct Dt *resolved;
} Bs;
typedef struct Bc {
I ref;
const char *name;
U8 *items;
Z count, capacity;
struct {
O *items;
Z count, capacity;
} constants;
struct {
Bl *items;
Z count, capacity;
} lines;
struct {
Bs *items;
Z count, capacity;
} symbols;
} Bc;
Bc *chunk_new(const char *);
V chunk_acquire(Bc *);
V chunk_release(Bc *);
V chunk_emit_byte(Bc *, U8);
V chunk_emit_sleb128(Bc *, I);
I chunk_add_constant(Bc *, O);
V chunk_emit_byte_with_line(Bc *, U8, I, I);
I chunk_get_line(Bc *, Z, I*);
#endif

16
src/common.h
View file

@ -1,16 +0,0 @@
#ifndef COMMON_H
#define COMMON_H
#include <stdint.h>
#include <stddef.h>
typedef void V;
typedef intptr_t I;
typedef uintptr_t U;
typedef double F;
typedef size_t Z;
typedef uint8_t U8;
typedef uint32_t U32;
typedef uint64_t U64;
#endif

332
src/compile.c
View file

@ -1,332 +0,0 @@
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "chunk.h"
#include "compile.h"
#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"
// clang-format off
struct {
const char *name;
U8 opcode[8];
} primitives[] = {
{"nil", {OP_NIL, 0}},
{"dup", {OP_DUP, 0}},
{"drop", {OP_DROP, 0}},
{"swap", {OP_SWAP, 0}},
{"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}},
{"dig", {OP_DIG, 0}},
{">r", {OP_TOR, 0}},
{"r>", {OP_FROMR, 0}},
{"2>r", {OP_2TOR, 0}},
{"2r>", {OP_2FROMR, 0}},
{"if", {OP_CHOOSE, OP_CALL, 0}},
{"call", {OP_CALL, 0}},
{"compose", {OP_COMPOSE, 0}},
{"curry", {OP_CURRY, 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}},
{"^", {OP_CONCAT, 0}},
{NULL, {0}},
};
// clang-format on
V compiler_init(Cm *cm, Vm *vm, const char *name) {
cm->vm = vm;
cm->arena = &vm->arena;
cm->dictionary = &vm->dictionary;
cm->chunk = chunk_new(name);
}
V compiler_deinit(Cm *cm) { cm->dictionary = NULL; }
static I peek_sleb128(U8 *ptr, I *out_value) {
I result = 0;
I shift = 0;
U8 byte;
I bytes = 0;
do {
byte = ptr[bytes];
bytes++;
result |= (I)(byte & 0x7F) << shift;
shift += 7;
} while (byte & 0x80);
if ((shift < 64) && (byte & 0x40)) {
result |= -(1LL << shift);
}
if (out_value)
*out_value = result;
return bytes;
}
static V optim_tailcall(Bc *chunk) {
Z i = 0;
while (i < chunk->count) {
U8 opcode = chunk->items[i];
if (opcode == OP_DOWORD) {
I ofs = peek_sleb128(&chunk->items[i + 1], NULL);
Z next = i + 1 + ofs;
if (next < chunk->count && chunk->items[next] == OP_RETURN) {
chunk->items[i] = OP_TAIL_DOWORD;
}
i++;
} else if (opcode == OP_CALL) {
Z ofs = i + 1;
if (ofs < chunk->count && chunk->items[ofs] == OP_RETURN) {
chunk->items[i] = OP_TAIL_CALL;
}
i++;
} else if (opcode == OP_CONST) {
I ofs = peek_sleb128(&chunk->items[i + 1], NULL);
i += 1 + ofs;
} else {
i++;
}
}
}
static I compile_expr(Cm *cm, Ast *node);
static I compile_constant(Cm *cm, O value, I line, I col) {
I idx = chunk_add_constant(cm->chunk, value);
chunk_emit_byte_with_line(cm->chunk, OP_CONST, line, col);
chunk_emit_sleb128(cm->chunk, idx);
return 1;
}
static I add_sym(Bc *chunk, const char *name, Dt *word) {
for (Z i = 0; i < chunk->symbols.count; i++) {
if (strcmp(chunk->symbols.items[i].name, name) == 0)
return i;
}
Z idx = chunk->symbols.count;
Bs *sym = yar_append(&chunk->symbols);
sym->name = name;
sym->resolved = word;
return idx;
}
static I compile_call(Cm *cm, const char *name, I line, I col) {
for (Z i = 0; primitives[i].name != NULL; i++) {
if (strcmp(name, primitives[i].name) == 0) {
for (Z j = 0; primitives[i].opcode[j] != 0; j++)
chunk_emit_byte_with_line(cm->chunk, primitives[i].opcode[j], line,
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",
line + 1, col + 1, name);
return 0;
}
I idx = add_sym(cm->chunk, name, word);
chunk_emit_byte_with_line(cm->chunk, OP_DOWORD, line, col);
chunk_emit_sleb128(cm->chunk, idx);
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]))
return 0;
}
return compile_call(cm, node->name, node->line, node->col);
}
static I compile_definition(Cm *cm, Ast *node) {
const char *name = arena_strdup(cm->arena, node->name);
Dt *entry = upsert(cm->dictionary, name, cm->arena);
Cm inner = {0};
inner.arena = cm->arena;
inner.chunk = chunk_new(name);
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])) {
chunk_release(inner.chunk);
return 0;
}
}
chunk_emit_byte_with_line(inner.chunk, OP_RETURN, node->line, node->col);
optim_tailcall(inner.chunk);
entry->chunk = inner.chunk;
#if COMPILER_DEBUG
disassemble(inner.chunk, name, cm->dictionary);
#endif
return 1;
}
static O compile_quotation_obj(Cm *cm, Ast *node) {
Cm inner = {0};
inner.arena = cm->arena;
inner.chunk = chunk_new("<quotation>");
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])) {
chunk_release(inner.chunk);
return NIL;
}
}
chunk_emit_byte_with_line(inner.chunk, OP_RETURN, node->line, node->col);
optim_tailcall(inner.chunk);
Hd *hd = gc_alloc(cm->vm, sizeof(Hd) + sizeof(Bc *));
hd->type = OBJ_QUOT;
Bc **chunk_ptr = (Bc **)(hd + 1);
*chunk_ptr = inner.chunk;
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_pragma(Cm *cm, Ast *node) {
if (strcmp(node->name, "#load") == 0) {
if (node->children.count == 0) {
fprintf(stderr, "compiler error: #load requires argument\n");
return 0;
}
Ast *arg = node->children.items[0];
if (arg->type != AST_STR) {
fprintf(stderr, "compiler error: #load requires string\n");
return 0;
}
char *fname = arg->name;
FILE *f = fopen(fname, "rb");
if (!f) {
fprintf(stderr, "compiler error: cannot open file '%s'\n", fname);
return 0;
}
Stream s = {filestream_vtable, f};
Lx *lx = lexer_make(&s);
Ast *root = parser_parse(lx);
I success = 1;
for (size_t i = 0; i < root->children.count; i++) {
if (!compile_expr(cm, root->children.items[i])) {
success = 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;
}
}
} else {
if (!compile_expr(cm, ast)) {
chunk_release(cm->chunk);
return NULL;
}
}
chunk_emit_byte(cm->chunk, OP_RETURN);
optim_tailcall(cm->chunk);
return cm->chunk;
}

21
src/compile.h
View file

@ -1,21 +0,0 @@
#include "common.h"
#include "arena.h"
#include "chunk.h"
#include "gc.h"
#include "vm.h"
#include "parser.h"
#define COMPILER_DEBUG 0
/** Compiler context */
typedef struct Cm {
Vm *vm; // Parent context
Ar *arena;
Bc *chunk;
Dt **dictionary;
} Cm;
V compiler_init(Cm *, Vm *, const char *);
V compiler_deinit(Cm *);
Bc *compile_program(Cm *, Ast *);

0
next/core/alien.c → src/core/alien.c
View file

0
next/core/arena.c → src/core/arena.c
View file

0
next/core/callable.c → src/core/callable.c
View file

0
next/core/compiler.c → src/core/compiler.c
View file

0
next/core/dictionary.c → src/core/dictionary.c
View file

0
next/core/disasm.c → src/core/disasm.c
View file

0
next/core/dynarray.h → src/core/dynarray.h
View file

0
next/core/file.c → src/core/file.c
View file

0
next/core/gc.c → src/core/gc.c
View file

0
next/core/hash.c → src/core/hash.c
View file

0
next/core/lexer.c → src/core/lexer.c
View file

0
next/core/list.c → src/core/list.c
View file

0
next/core/native.c → src/core/native.c
View file

0
next/core/opcodes.h → src/core/opcodes.h
View file

0
next/core/print.c → src/core/print.c
View file

0
next/core/sleb128.c → src/core/sleb128.c
View file

0
next/core/sleb128.h → src/core/sleb128.h
View file

0
next/core/string.c → src/core/string.c
View file

0
next/core/table.c → src/core/table.c
View file

0
next/core/tuple.c → src/core/tuple.c
View file

0
next/core/value.c → src/core/value.c
View file

0
next/core/vm.c → src/core/vm.c
View file

146
src/debug.c
View file

@ -1,146 +0,0 @@
#include <stdio.h>
#include "chunk.h"
#include "debug.h"
#include "dictionary.h"
#include "primitive.h"
#include "print.h"
#include "vm.h"
static I decode_sleb128(U8 *ptr, Z *bytes_read) {
I result = 0;
I shift = 0;
U8 byte;
Z count = 0;
do {
byte = ptr[count++];
result |= (I)(byte & 0x7F) << shift;
shift += 7;
} while (byte & 0x80);
if ((shift < 64) && (byte & 0x40))
result |= -(1LL << shift);
*bytes_read = count;
return result;
}
static Z dis_instr(Bc *chunk, Z offset, Dt **dictionary, I indent);
static V dis(Bc *chunk, Dt **dictionary, I indent) {
Z offset = 0;
while (offset < chunk->count)
offset = dis_instr(chunk, offset, dictionary, indent);
}
V disassemble(Bc *chunk, const char *name, Dt **dictionary) {
printf("=== %s ===\n", name);
dis(chunk, dictionary, 0);
}
static Z dis_instr(Bc *chunk, Z offset, Dt **dictionary, I indent) {
for (I i = 0; i < indent; i++)
printf(" ");
printf("%04zu ", offset);
I col = -1;
I line = chunk_get_line(chunk, offset, &col);
if (line >= 0) {
printf("%4ld:%-3ld ", line + 1, col + 1);
} else {
printf(" ");
}
U8 opcode = chunk->items[offset++];
#define CASE(name) case OP_##name:
#define SIMPLE(name) \
case OP_##name: \
printf(#name "\n"); \
return offset;
switch (opcode) {
SIMPLE(NOP);
SIMPLE(NIL);
CASE(CONST) {
Z bytes_read;
I idx = decode_sleb128(&chunk->items[offset], &bytes_read);
printf("CONST %ld", idx);
if (idx >= 0 && idx < (I)chunk->constants.count) {
O obj = chunk->constants.items[idx];
printf(" (");
print(obj);
printf(")");
if (!IMM(obj) && obj != NIL && type(obj) == OBJ_QUOT) {
putchar('\n');
Hd *hdr = UNBOX(obj);
Bc **chunk_ptr = (Bc **)(hdr + 1);
Bc *quot_chunk = *chunk_ptr;
dis(quot_chunk, dictionary, indent + 1);
return offset + bytes_read;
}
}
printf("\n");
return offset + bytes_read;
}
SIMPLE(DROP);
SIMPLE(DUP);
SIMPLE(SWAP);
SIMPLE(NIP);
SIMPLE(OVER);
SIMPLE(BURY);
SIMPLE(DIG);
SIMPLE(TOR);
SIMPLE(FROMR);
CASE(DOWORD) {
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);
return offset + bytes_read;
}
SIMPLE(CALL);
CASE(TAIL_DOWORD) {
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);
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(COMPOSE);
SIMPLE(CURRY);
SIMPLE(RETURN);
SIMPLE(CHOOSE);
SIMPLE(ADD);
SIMPLE(SUB);
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(CONCAT);
default:
printf("??? (%d)\n", opcode);
return offset;
}
#undef SIMPLE
#undef CASE
}

5
src/debug.h
View file

@ -1,5 +0,0 @@
#include "chunk.h"
#include "common.h"
#include "dictionary.h"
V disassemble(Bc *, const char*, Dt **);

39
src/dictionary.c
View file

@ -1,39 +0,0 @@
#include <string.h>
#include "arena.h"
#include "common.h"
#include "dictionary.h"
U64 hash64(const char *str) {
I len = strlen(str);
U64 h = 0x100;
for (I i = 0; i < len; i++) {
h ^= str[i] & 255;
h *= 1111111111111111111;
}
return h;
}
Dt *upsert(Dt **env, const char *key, Ar *a) {
U64 hash = hash64(key);
for (U64 h = hash; *env; h <<= 2) {
if (hash == (*env)->hash)
return *env;
env = &(*env)->child[h >> 62];
}
if (!a)
return 0;
*env = arena_alloc(a, 1, Dt);
(*env)->name = key;
(*env)->hash = hash;
return *env;
}
Dt *lookup_hash(Dt **env, U64 hash) {
for (U64 h = hash; *env; h <<= 2) {
if ((*env)->hash == hash)
return *env;
env = &(*env)->child[h >> 62];
}
return NULL;
}

19
src/dictionary.h
View file

@ -1,19 +0,0 @@
#ifndef DICTIONARY_H
#define DICTIONARY_H
#include "arena.h"
#include "chunk.h"
typedef struct Dt Dt;
struct Dt {
Dt *child[4];
const char *name;
U64 hash;
Bc *chunk;
};
U64 hash64(const char *);
Dt *upsert(Dt **, const char *, Ar *);
Dt *lookup_hash(Dt **, U64);
#endif

83
src/file.c
View file

@ -1,83 +0,0 @@
#include <stdio.h>
#include <stdlib.h>
#include "src/gc.h"
#include "src/object.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_stdin(Vm *vm) {
vm_push(vm, vm->stdin);
return 0;
}
I prim_file_stdout(Vm *vm) {
vm_push(vm, vm->stdout);
return 0;
}
I prim_file_stderr(Vm *vm) {
vm_push(vm, vm->stderr);
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\n");
return VM_ERR_TYPE;
};
Str *str = string_unwrap(string_obj);
if (str == NULL) {
fprintf(stderr, "expected string\n");
return VM_ERR_TYPE;
}
fwrite(str->data, sizeof(char), str->len, (FILE *)file_ud->data);
return 0;
}
I prim_file_fgetline(Vm *vm) {
O file_obj = vm_pop(vm);
I mark = gc_mark(&vm->gc);
gc_addroot(&vm->gc, &file_obj);
Ud *file_ud = userdata_unwrap(file_obj, &userdata_file);
if (file_ud == NULL) {
fprintf(stderr, "expected file object\n");
return VM_ERR_TYPE;
}
char *lineptr = NULL;
size_t size;
I len = getline(&lineptr, &size, (FILE *)file_ud->data);
if (len == -1) {
vm_push(vm, NIL);
} else {
vm_push(vm, string_make(vm, lineptr, len));
}
free(lineptr);
gc_reset(&vm->gc, mark);
return 0;
}
static V finalizer(V *data) {
FILE *f = (FILE *)data;
if (f && f != stdin && f != stdout && f != stderr)
fclose(f);
}

9
src/file.h
View file

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

215
src/gc.c
View file

@ -1,215 +0,0 @@
#include <assert.h>
#include <inttypes.h>
#include <stdio.h>
#include <stdlib.h>
#include "chunk.h"
#include "gc.h"
#include "object.h"
#include "userdata.h"
#include "vendor/yar.h"
#include "vm.h"
#define ALIGN(n) (((n) + 7) & ~7)
static inline int infrom(Gc *gc, V *ptr) {
const U8 *x = (const U8 *)ptr;
return (x >= gc->from.start && x < gc->from.end);
}
V gc_addroot(Gc *gc, O *ptr) { *yar_append(&gc->roots) = ptr; }
I gc_mark(Gc *gc) { return gc->roots.count; }
V gc_reset(Gc *gc, I mark) { gc->roots.count = mark; }
static O copy(Gc *gc, Hd *hdr) {
assert(infrom(gc, hdr));
assert(hdr->type != OBJ_FWD);
Z sz = ALIGN(hdr->size);
Hd *new = (Hd *)gc->to.free;
gc->to.free += sz;
memcpy(new, hdr, sz);
hdr->type = OBJ_FWD;
O *obj = (O *)(hdr + 1);
*obj = BOX(new);
return *obj;
}
static O forward(Gc *gc, O obj) {
if (obj == 0)
return 0;
if (IMM(obj))
return obj;
if (!infrom(gc, (V *)obj))
return obj;
Hd *hdr = UNBOX(obj);
if (hdr->type == OBJ_FWD) {
O *o = (O *)(hdr + 1);
return *o;
} else {
return copy(gc, hdr);
}
}
#if GC_DEBUG
static V printstats(Gc *gc, const char *label) {
Z used = (Z)(gc->from.free - gc->from.start);
fprintf(stderr, "[%s] used=%zu/%zu bytes (%.1f%%)\n", label, used,
(Z)HEAP_BYTES, (F)used / (F)HEAP_BYTES * 100.0);
}
#endif
V gc_collect(Vm *vm, I final) {
Gc *gc = &vm->gc;
uint8_t *scan = gc->to.free;
#if GC_DEBUG
printstats(gc, "before GC");
#endif
if (!final) {
// Final GC ignores roots.
for (Z i = 0; i < gc->roots.count; i++) {
O *o = gc->roots.items[i];
*o = forward(gc, *o);
}
Dt *dstack[256];
Dt **dsp = dstack;
*dsp++ = vm->dictionary;
// Forward constants referenced by dictionary entries
while (dsp > dstack) {
Dt *node = *--dsp;
if (!node)
continue;
if (node->chunk != NULL) {
for (Z i = 0; i < node->chunk->constants.count; i++) {
node->chunk->constants.items[i] =
forward(gc, node->chunk->constants.items[i]);
}
}
for (I i = 0; i < 4; i++) {
if (node->child[i] != NULL)
*dsp++ = node->child[i];
}
}
}
while (scan < gc->to.free) {
if (scan >= gc->to.end) {
fprintf(stderr, "fatal GC error: out of memory\n");
abort();
}
Hd *hdr = (Hd *)scan;
switch (hdr->type) {
case OBJ_STR:
break;
case OBJ_QUOT: {
Bc **chunk_ptr = (Bc **)(hdr + 1);
Bc *chunk = *chunk_ptr;
for (Z i = 0; i < chunk->constants.count; i++)
chunk->constants.items[i] = forward(gc, chunk->constants.items[i]);
break;
}
case OBJ_COMPOSE: {
Qo *comp = (Qo *)(hdr + 1);
comp->first = forward(gc, comp->first);
comp->second = forward(gc, comp->second);
break;
};
case OBJ_CURRY: {
Qc *curry = (Qc *)(hdr + 1);
curry->value = forward(gc, curry->value);
curry->callable = forward(gc, curry->callable);
break;
};
case OBJ_USERDATA:
break;
case OBJ_FWD:
fprintf(stderr, "fatal GC error: forwarding pointer in to-space\n");
abort();
default:
fprintf(stderr, "GC warning: junk object type %" PRId32 "\n", hdr->type);
}
scan += ALIGN(hdr->size);
}
scan = gc->from.start;
while (scan < gc->from.free) {
Hd *hdr = (Hd *)scan;
if (hdr->type != OBJ_FWD) {
switch (hdr->type) {
case OBJ_QUOT: {
Bc **chunk_ptr = (Bc **)(hdr + 1);
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;
}
}
scan += ALIGN(hdr->size);
}
Gs tmp = gc->from;
gc->from = gc->to;
gc->to = tmp;
gc->to.free = gc->to.start;
#if GC_DEBUG
printstats(gc, "after GC");
#endif
}
Hd *gc_alloc(Vm *vm, Z sz) {
Gc *gc = &vm->gc;
sz = ALIGN(sz);
if (gc->from.free + sz > gc->from.end) {
gc_collect(vm, 0);
if (gc->from.free + sz > gc->from.end) {
fprintf(stderr, "out of memory (requested %" PRIdPTR "bytes\n", sz);
abort();
}
}
Hd *hdr = (Hd *)gc->from.free;
gc->from.free += sz;
hdr->size = sz;
return hdr;
}
V gc_init(Gc *gc) {
gc->from.start = malloc(HEAP_BYTES);
if (!gc->from.start)
goto fatal;
gc->from.end = gc->from.start + HEAP_BYTES;
gc->from.free = gc->from.start;
gc->to.start = malloc(HEAP_BYTES);
if (!gc->to.start)
goto fatal;
gc->to.end = gc->to.start + HEAP_BYTES;
gc->to.free = gc->to.start;
gc->roots.capacity = 0;
gc->roots.count = 0;
gc->roots.items = NULL;
return;
fatal:
fprintf(stderr, "failed to allocate heap space\n");
abort();
}
V gc_deinit(Gc *gc) {
free(gc->from.start);
free(gc->to.start);
yar_free(&gc->roots);
}

38
src/gc.h
View file

@ -1,38 +0,0 @@
#ifndef GC_H
#define GC_H
#include "common.h"
#include "object.h"
#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;
U8 *free;
} Gs;
typedef struct Gc {
Gs from, to;
struct {
O **items;
Z count, capacity;
} roots;
} Gc;
V gc_addroot(Gc *, O *);
I gc_mark(Gc *);
V gc_reset(Gc *, I);
V gc_init(Gc *);
V gc_deinit(Gc *);
typedef struct Vm Vm;
V gc_collect(Vm *, I);
Hd *gc_alloc(Vm *, Z);
#endif

0
next/include/growl.h → src/include/growl.h
View file

217
src/lexer.c
View file

@ -1,217 +0,0 @@
#include <ctype.h>
#include <err.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 == '"';
}
static inline void appendrune(Lx *lx, Rune rn) {
char data[5];
I len = runetochar(data, &rn);
yar_append_many(lx, data, len);
}
static inline void appendbyte(Lx *lx, char byte) { *yar_append(lx) = byte; }
static int getc_ws(Lx *lx) {
if (ST_EOF(lx->stream))
return -1;
for (;;) {
int ch = lx_getc(lx);
if (isspace(ch))
continue;
return ch;
}
}
static int scanword(Lx *lx) {
int next = lx_getc(lx);
for (;;) {
if (next == -1) {
if (lx->count == 0)
lx->kind = TOK_EOF;
appendbyte(lx, 0);
return lx->kind;
} else if (is_delimiter(next) || isspace(next)) {
lx_ungetc(lx, next);
appendbyte(lx, 0);
return lx->kind;
} else {
appendbyte(lx, next);
next = lx_getc(lx);
continue;
}
}
}
static void scanescape(Lx *lx) {
char escbuf[7], *escptr = escbuf;
int next;
Rune tmp;
for (;;) {
next = lx_getc(lx);
if (next == -1) {
errx(1, "unterminated hex sequence '%s'", escbuf);
} else if (next == ';') {
*escptr = 0;
break;
} else if (!isxdigit(next)) {
errx(1, "invalid hex digit '%c'", next);
}
if (escptr - escbuf >= 6) {
errx(1, "hex sequence too long (6 chars max.)");
} else {
*(escptr++) = next;
}
}
tmp = strtol(escbuf, &escptr, 16);
if (*escptr == '\0') {
if (tmp < 256) {
appendbyte(lx, (U8)(tmp & 255));
} else {
appendrune(lx, tmp);
}
} else {
errx(1, "invalid hex sequence '%s'", escbuf);
}
}
static int scanstring(Lx *lx) {
int next;
for (;;) {
next = lx_getc(lx);
switch (next) {
case -1:
goto eof;
case '\\':
next = lx_getc(lx);
if (next == -1)
goto eof;
switch (next) {
case 't':
appendbyte(lx, '\t');
break;
case 'n':
appendbyte(lx, '\n');
break;
case 'r':
appendbyte(lx, '\r');
break;
case 'b':
appendbyte(lx, '\b');
break;
case 'v':
appendbyte(lx, '\v');
break;
case 'f':
appendbyte(lx, '\f');
break;
case '0':
appendbyte(lx, '\0');
break;
case 'e':
appendbyte(lx, '\x1b');
break;
case '\\':
case '"':
appendbyte(lx, next);
break;
case 'x':
scanescape(lx);
break;
default:
return (lx->kind = TOK_INVALID);
}
break;
case '"':
appendbyte(lx, 0);
return (lx->kind = TOK_STRING);
default:
appendbyte(lx, next);
}
}
eof:
return (lx->kind = TOK_INVALID);
}
I lexer_next(Lx *lx) {
int next;
lx->cursor = 0;
lx->count = 0;
if (ST_EOF(lx->stream)) {
lx->kind = TOK_EOF;
return 0;
}
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))
;
return lexer_next(lx);
case '(':
case ')':
case '[':
case ']':
case '{':
case '}':
case ';':
return (lx->kind = next);
case '"':
return scanstring(lx);
default:
lx_ungetc(lx, next);
lx->kind = TOK_WORD;
return scanword(lx);
};
}

36
src/lexer.h
View file

@ -1,36 +0,0 @@
#ifndef LEXER_H
#define LEXER_H
#include "common.h"
#include "stream.h"
enum {
TOK_INVALID = -1,
TOK_EOF = 0,
TOK_WORD = 'a',
TOK_STRING = '"',
TOK_SEMICOLON = ';',
TOK_LPAREN = '(',
TOK_RPAREN = ')',
TOK_LBRACKET = '[',
TOK_RBRACKET = ']',
TOK_LBRACE = '{',
TOK_RBRACE = '}',
TOK_COMMENT = '\\',
};
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

107
src/main.c
View file

@ -1,91 +1,28 @@
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <growl.h>
#include <math.h>
#include "chunk.h"
#include "compile.h"
#include "debug.h"
#include "parser.h"
#include "vm.h"
int main(void) {
GrowlVM *vm = growl_vm_init();
growl_register_file_library(vm);
GrowlLexer lexer = {0};
lexer.file = stdin;
#include "vendor/linenoise.h"
#define REPL_BUFFER_SIZE 4096
I repl(void) {
Vm vm = {0};
vm_init(&vm);
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);
Cm cm = {0};
compiler_init(&cm, &vm, "<repl>");
Bc *chunk = compile_program(&cm, root);
ast_free(root);
lexer_free(lx);
if (chunk != NULL) {
vm_run(&vm, chunk, 0);
chunk_release(chunk);
linenoiseHistoryAdd(line);
Growl obj = growl_compile(vm, &lexer);
if (obj != GROWL_NIL) {
GrowlQuotation *quot = growl_unwrap_quotation(obj);
if (!growl_vm_execute(vm, quot)) {
if (vm->sp != vm->wst) {
fprintf(stderr, "Stack:");
for (Growl *p = vm->wst; p < vm->sp; p++) {
putc(' ', stderr);
growl_print_to(stderr, *p);
}
compiler_deinit(&cm);
linenoiseFree(line);
putchar('\n');
}
vm_deinit(&vm);
}
}
growl_gc_collect(vm);
growl_vm_free(vm);
return 0;
}
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);
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);
if (chunk != NULL) {
#if COMPILER_DEBUG
disassemble(chunk, fname, &vm.dictionary);
#endif
I res = vm_run(&vm, chunk, 0);
chunk_release(chunk);
vm_deinit(&vm);
return !res;
} else {
vm_deinit(&vm);
return 1;
}
}
int main(int argc, const char *argv[]) {
switch (argc) {
case 1:
return repl();
case 2:
return loadfile(argv[1]);
default:
fprintf(stderr, "usage: growl [file]\n");
return 64;
}
}

10
src/object.c
View file

@ -1,10 +0,0 @@
#include "object.h"
I type(O o) {
if (o == NIL)
return OBJ_NIL;
if (IMM(o))
return OBJ_NUM;
Hd *h = UNBOX(o);
return h->type;
}

48
src/object.h
View file

@ -1,48 +0,0 @@
#ifndef OBJECT_H
#define OBJECT_H
#include "common.h"
#define NIL ((O)0)
#define BOX(x) ((O)(x))
#define UNBOX(x) ((Hd *)(x))
#define IMM(x) ((O)(x) & (O)1)
#define NUM(x) (((O)((intptr_t)(x) << 1)) | (O)1)
#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,
};
typedef uintptr_t O;
/** Object header */
typedef struct Hd {
U32 size, type;
} Hd;
/** Composition */
typedef struct Qo {
O first, second;
} Qo;
/** Curry */
typedef struct Qc {
O value, callable;
} Qc; //
I type(O);
static inline I callable(O o) {
I t = type(o);
return t == OBJ_QUOT || t == OBJ_COMPOSE || t == OBJ_CURRY;
}
#endif

156
src/parser.c
View file

@ -1,156 +0,0 @@
#include "parser.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.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;
}
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);
}
static Ast *parse_expr_at(Lx *lx);
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;
}
}
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;
}

35
src/parser.h
View file

@ -1,35 +0,0 @@
#ifndef PARSER_H
#define PARSER_H
#include "common.h"
#include "lexer.h"
#include "vendor/yar.h"
enum {
AST_PROGRAM,
AST_INT,
AST_STR,
AST_WORD,
AST_LIST,
AST_TABLE,
AST_QUOTE,
AST_DEF,
AST_CMD,
AST_PRAGMA,
};
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);
#endif

46
src/primitive.c
View file

@ -1,46 +0,0 @@
#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},
{"stdin", prim_file_stdin},
{"stdout", prim_file_stdout},
{"stderr", prim_file_stderr},
{"fprint", prim_file_fprint},
{"fgetline", prim_file_fgetline},
{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;
}

14
src/primitive.h
View file

@ -1,14 +0,0 @@
#ifndef PRIMITIVE_H
#define PRIMITIVE_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

91
src/print.c
View file

@ -1,91 +0,0 @@
#include <inttypes.h>
#include <stdio.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('"');
}
V print(O o) {
if (o == NIL) {
printf("nil");
} else if (IMM(o)) {
printf("%" PRIdPTR, ORD(o));
} else {
Hd *hdr = UNBOX(o);
switch (hdr->type) {
case OBJ_QUOT:
printf("<quotation>");
break;
case OBJ_COMPOSE:
printf("<composed>");
break;
case OBJ_CURRY:
printf("<curried>");
break;
case OBJ_STR: {
Str *s = string_unwrap(o);
print_string(s);
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);
}
}
}
V println(O o) {
print(o);
putchar('\n');
}

10
src/print.h
View file

@ -1,10 +0,0 @@
#ifndef PRINT_H
#define PRINT_H
#include "common.h"
#include "object.h"
V print(O);
V println(O);
#endif

39
src/stream.c
View file

@ -1,39 +0,0 @@
#include "stream.h"
#include <stdio.h>
static int filestream_getc(void *f) { return fgetc((FILE *)f); }
static int filestream_ungetc(int c, void *f) { return ungetc(c, (FILE *)f); }
static int filestream_eof(void *f) { return feof((FILE *)f); }
static int bufstream_getc(void *f) {
Buf *b = f;
if (b->unread != -1) {
int c = b->unread;
b->unread = -1;
return c;
} else if (b->pos >= b->len) {
return -1;
}
return b->data[b->pos++];
}
static int bufstream_ungetc(int c, void *f) { return ((Buf *)f)->unread = c; }
static int bufstream_eof(void *f) {
Buf *b = f;
if (b->unread != -1)
return 0;
return b->pos >= b->len;
}
// clang-format off
static const StreamVtable _filestream_vtable = {
filestream_getc, filestream_ungetc, filestream_eof
};
const StreamVtable *filestream_vtable = &_filestream_vtable;
static const StreamVtable _bufstream_vtable = {
bufstream_getc, bufstream_ungetc, bufstream_eof
};
const StreamVtable *bufstream_vtable = &_bufstream_vtable;
// clang-format on

30
src/stream.h
View file

@ -1,30 +0,0 @@
#ifndef STREAM_H
#define STREAM_H
typedef struct StreamVtable {
int (*__sgetc)(void *);
int (*__sungetc)(int, void *);
int (*__seof)(void *);
} StreamVtable;
typedef struct Stream {
const StreamVtable *vtable;
void *data;
} Stream;
typedef struct Buf {
const char *data;
int len, pos;
int unread;
} Buf;
#define ST_GETC(R) ((R)->vtable->__sgetc((R)->data))
#define ST_UNGETC(C, R) ((R)->vtable->__sungetc(C, (R)->data))
#define ST_EOF(R) ((R)->vtable->__seof((R)->data))
#define BUF(s) ((Buf){s, sizeof(s)-1, 0, -1})
extern const StreamVtable *filestream_vtable;
extern const StreamVtable *bufstream_vtable;
#endif

51
src/string.c
View file

@ -1,51 +0,0 @@
#include <string.h>
#include "string.h"
#include "src/gc.h"
O string_make(Vm *vm, const char *str, I len) {
if (len < 0)
len = strlen(str);
Z size = sizeof(Hd) + sizeof(Str) + len + 1;
Hd *hdr = gc_alloc(vm, size);
hdr->type = OBJ_STR;
Str *s = (Str *)(hdr + 1);
s->len = len;
memcpy(s->data, str, len);
s->data[len] = 0;
return BOX(hdr);
}
Str *string_unwrap(O o) {
if (o == NIL || IMM(o))
return NULL;
Hd *hdr = UNBOX(o);
if (hdr->type != OBJ_STR)
return NULL;
return (Str *)(hdr + 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);
Str *as = string_unwrap(a_obj);
Str *bs = string_unwrap(b_obj);
I a_len = as->len;
I b_len = bs->len;
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;
}

13
src/string.h
View file

@ -1,13 +0,0 @@
#include "common.h"
#include "object.h"
#include "vm.h"
/** String */
typedef struct Str {
Z len;
char data[];
} Str;
O string_make(Vm *, const char *, I);
Str *string_unwrap(O);
O string_concat(Vm *, O, O);

24
src/userdata.c
View file

@ -1,24 +0,0 @@
#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;
}

21
src/userdata.h
View file

@ -1,21 +0,0 @@
#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

1763
src/vendor/linenoise.c vendored
View file

File diff suppressed because it is too large Load diff

114
src/vendor/linenoise.h vendored
View file

@ -1,114 +0,0 @@
/* linenoise.h -- VERSION 1.0
*
* Guerrilla line editing library against the idea that a line editing lib
* needs to be 20,000 lines of C code.
*
* See linenoise.c for more information.
*
* ------------------------------------------------------------------------
*
* Copyright (c) 2010-2023, Salvatore Sanfilippo <antirez at gmail dot com>
* Copyright (c) 2010-2013, Pieter Noordhuis <pcnoordhuis at gmail dot com>
*
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are
* met:
*
* * Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* * Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
* HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
#ifndef __LINENOISE_H
#define __LINENOISE_H
#ifdef __cplusplus
extern "C" {
#endif
#include <stddef.h> /* For size_t. */
extern char *linenoiseEditMore;
/* The linenoiseState structure represents the state during line editing.
* We pass this state to functions implementing specific editing
* functionalities. */
struct linenoiseState {
int in_completion; /* The user pressed TAB and we are now in completion
* mode, so input is handled by completeLine(). */
size_t completion_idx; /* Index of next completion to propose. */
int ifd; /* Terminal stdin file descriptor. */
int ofd; /* Terminal stdout file descriptor. */
char *buf; /* Edited line buffer. */
size_t buflen; /* Edited line buffer size. */
const char *prompt; /* Prompt to display. */
size_t plen; /* Prompt length. */
size_t pos; /* Current cursor position. */
size_t oldpos; /* Previous refresh cursor position. */
size_t len; /* Current edited line length. */
size_t cols; /* Number of columns in terminal. */
size_t oldrows; /* Rows used by last refrehsed line (multiline mode) */
int oldrpos; /* Cursor row from last refresh (for multiline clearing). */
int history_index; /* The history index we are currently editing. */
};
typedef struct linenoiseCompletions {
size_t len;
char **cvec;
} linenoiseCompletions;
/* Non blocking API. */
int linenoiseEditStart(struct linenoiseState *l, int stdin_fd, int stdout_fd, char *buf, size_t buflen, const char *prompt);
char *linenoiseEditFeed(struct linenoiseState *l);
void linenoiseEditStop(struct linenoiseState *l);
void linenoiseHide(struct linenoiseState *l);
void linenoiseShow(struct linenoiseState *l);
/* Blocking API. */
char *linenoise(const char *prompt);
void linenoiseFree(void *ptr);
/* Completion API. */
typedef void(linenoiseCompletionCallback)(const char *, linenoiseCompletions *);
typedef char*(linenoiseHintsCallback)(const char *, int *color, int *bold);
typedef void(linenoiseFreeHintsCallback)(void *);
void linenoiseSetCompletionCallback(linenoiseCompletionCallback *);
void linenoiseSetHintsCallback(linenoiseHintsCallback *);
void linenoiseSetFreeHintsCallback(linenoiseFreeHintsCallback *);
void linenoiseAddCompletion(linenoiseCompletions *, const char *);
/* History API. */
int linenoiseHistoryAdd(const char *line);
int linenoiseHistorySetMaxLen(int len);
int linenoiseHistorySave(const char *filename);
int linenoiseHistoryLoad(const char *filename);
/* Other utilities. */
void linenoiseClearScreen(void);
void linenoiseSetMultiLine(int ml);
void linenoisePrintKeyCodes(void);
void linenoiseMaskModeEnable(void);
void linenoiseMaskModeDisable(void);
#ifdef __cplusplus
}
#endif
#endif /* __LINENOISE_H */

4128
src/vendor/mpc.c vendored
View file

File diff suppressed because it is too large Load diff

391
src/vendor/mpc.h vendored
View file

@ -1,391 +0,0 @@
/*
** mpc - Micro Parser Combinator library for C
**
** https://github.com/orangeduck/mpc
**
** Daniel Holden - contact@daniel-holden.com
** Licensed under BSD3
*/
#ifndef mpc_h
#define mpc_h
#ifdef __cplusplus
extern "C" {
#endif
#include <stdlib.h>
#include <stdio.h>
#include <stdarg.h>
#include <string.h>
#include <math.h>
#include <errno.h>
#include <ctype.h>
/*
** State Type
*/
typedef struct {
long pos;
long row;
long col;
int term;
} mpc_state_t;
/*
** Error Type
*/
typedef struct {
mpc_state_t state;
int expected_num;
char *filename;
char *failure;
char **expected;
char received;
} mpc_err_t;
void mpc_err_delete(mpc_err_t *e);
char *mpc_err_string(mpc_err_t *e);
void mpc_err_print(mpc_err_t *e);
void mpc_err_print_to(mpc_err_t *e, FILE *f);
/*
** Parsing
*/
typedef void mpc_val_t;
typedef union {
mpc_err_t *error;
mpc_val_t *output;
} mpc_result_t;
struct mpc_parser_t;
typedef struct mpc_parser_t mpc_parser_t;
int mpc_parse(const char *filename, const char *string, mpc_parser_t *p, mpc_result_t *r);
int mpc_nparse(const char *filename, const char *string, size_t length, mpc_parser_t *p, mpc_result_t *r);
int mpc_parse_file(const char *filename, FILE *file, mpc_parser_t *p, mpc_result_t *r);
int mpc_parse_pipe(const char *filename, FILE *pipe, mpc_parser_t *p, mpc_result_t *r);
int mpc_parse_contents(const char *filename, mpc_parser_t *p, mpc_result_t *r);
/*
** Function Types
*/
typedef void(*mpc_dtor_t)(mpc_val_t*);
typedef mpc_val_t*(*mpc_ctor_t)(void);
typedef mpc_val_t*(*mpc_apply_t)(mpc_val_t*);
typedef mpc_val_t*(*mpc_apply_to_t)(mpc_val_t*,void*);
typedef mpc_val_t*(*mpc_fold_t)(int,mpc_val_t**);
typedef int(*mpc_check_t)(mpc_val_t**);
typedef int(*mpc_check_with_t)(mpc_val_t**,void*);
/*
** Building a Parser
*/
mpc_parser_t *mpc_new(const char *name);
mpc_parser_t *mpc_copy(mpc_parser_t *a);
mpc_parser_t *mpc_define(mpc_parser_t *p, mpc_parser_t *a);
mpc_parser_t *mpc_undefine(mpc_parser_t *p);
void mpc_delete(mpc_parser_t *p);
void mpc_cleanup(int n, ...);
/*
** Basic Parsers
*/
mpc_parser_t *mpc_any(void);
mpc_parser_t *mpc_char(char c);
mpc_parser_t *mpc_range(char s, char e);
mpc_parser_t *mpc_oneof(const char *s);
mpc_parser_t *mpc_noneof(const char *s);
mpc_parser_t *mpc_satisfy(int(*f)(char));
mpc_parser_t *mpc_string(const char *s);
/*
** Other Parsers
*/
mpc_parser_t *mpc_pass(void);
mpc_parser_t *mpc_fail(const char *m);
mpc_parser_t *mpc_failf(const char *fmt, ...);
mpc_parser_t *mpc_lift(mpc_ctor_t f);
mpc_parser_t *mpc_lift_val(mpc_val_t *x);
mpc_parser_t *mpc_anchor(int(*f)(char,char));
mpc_parser_t *mpc_state(void);
/*
** Combinator Parsers
*/
mpc_parser_t *mpc_expect(mpc_parser_t *a, const char *e);
mpc_parser_t *mpc_expectf(mpc_parser_t *a, const char *fmt, ...);
mpc_parser_t *mpc_apply(mpc_parser_t *a, mpc_apply_t f);
mpc_parser_t *mpc_apply_to(mpc_parser_t *a, mpc_apply_to_t f, void *x);
mpc_parser_t *mpc_check(mpc_parser_t *a, mpc_dtor_t da, mpc_check_t f, const char *e);
mpc_parser_t *mpc_check_with(mpc_parser_t *a, mpc_dtor_t da, mpc_check_with_t f, void *x, const char *e);
mpc_parser_t *mpc_checkf(mpc_parser_t *a, mpc_dtor_t da, mpc_check_t f, const char *fmt, ...);
mpc_parser_t *mpc_check_withf(mpc_parser_t *a, mpc_dtor_t da, mpc_check_with_t f, void *x, const char *fmt, ...);
mpc_parser_t *mpc_not(mpc_parser_t *a, mpc_dtor_t da);
mpc_parser_t *mpc_not_lift(mpc_parser_t *a, mpc_dtor_t da, mpc_ctor_t lf);
mpc_parser_t *mpc_maybe(mpc_parser_t *a);
mpc_parser_t *mpc_maybe_lift(mpc_parser_t *a, mpc_ctor_t lf);
mpc_parser_t *mpc_many(mpc_fold_t f, mpc_parser_t *a);
mpc_parser_t *mpc_many1(mpc_fold_t f, mpc_parser_t *a);
mpc_parser_t *mpc_count(int n, mpc_fold_t f, mpc_parser_t *a, mpc_dtor_t da);
mpc_parser_t *mpc_or(int n, ...);
mpc_parser_t *mpc_and(int n, mpc_fold_t f, ...);
mpc_parser_t *mpc_predictive(mpc_parser_t *a);
/*
** Common Parsers
*/
mpc_parser_t *mpc_eoi(void);
mpc_parser_t *mpc_soi(void);
mpc_parser_t *mpc_boundary(void);
mpc_parser_t *mpc_boundary_newline(void);
mpc_parser_t *mpc_whitespace(void);
mpc_parser_t *mpc_whitespaces(void);
mpc_parser_t *mpc_blank(void);
mpc_parser_t *mpc_newline(void);
mpc_parser_t *mpc_tab(void);
mpc_parser_t *mpc_escape(void);
mpc_parser_t *mpc_digit(void);
mpc_parser_t *mpc_hexdigit(void);
mpc_parser_t *mpc_octdigit(void);
mpc_parser_t *mpc_digits(void);
mpc_parser_t *mpc_hexdigits(void);
mpc_parser_t *mpc_octdigits(void);
mpc_parser_t *mpc_lower(void);
mpc_parser_t *mpc_upper(void);
mpc_parser_t *mpc_alpha(void);
mpc_parser_t *mpc_underscore(void);
mpc_parser_t *mpc_alphanum(void);
mpc_parser_t *mpc_int(void);
mpc_parser_t *mpc_hex(void);
mpc_parser_t *mpc_oct(void);
mpc_parser_t *mpc_number(void);
mpc_parser_t *mpc_real(void);
mpc_parser_t *mpc_float(void);
mpc_parser_t *mpc_char_lit(void);
mpc_parser_t *mpc_string_lit(void);
mpc_parser_t *mpc_regex_lit(void);
mpc_parser_t *mpc_ident(void);
/*
** Useful Parsers
*/
mpc_parser_t *mpc_startwith(mpc_parser_t *a);
mpc_parser_t *mpc_endwith(mpc_parser_t *a, mpc_dtor_t da);
mpc_parser_t *mpc_whole(mpc_parser_t *a, mpc_dtor_t da);
mpc_parser_t *mpc_stripl(mpc_parser_t *a);
mpc_parser_t *mpc_stripr(mpc_parser_t *a);
mpc_parser_t *mpc_strip(mpc_parser_t *a);
mpc_parser_t *mpc_tok(mpc_parser_t *a);
mpc_parser_t *mpc_sym(const char *s);
mpc_parser_t *mpc_total(mpc_parser_t *a, mpc_dtor_t da);
mpc_parser_t *mpc_between(mpc_parser_t *a, mpc_dtor_t ad, const char *o, const char *c);
mpc_parser_t *mpc_parens(mpc_parser_t *a, mpc_dtor_t ad);
mpc_parser_t *mpc_braces(mpc_parser_t *a, mpc_dtor_t ad);
mpc_parser_t *mpc_brackets(mpc_parser_t *a, mpc_dtor_t ad);
mpc_parser_t *mpc_squares(mpc_parser_t *a, mpc_dtor_t ad);
mpc_parser_t *mpc_tok_between(mpc_parser_t *a, mpc_dtor_t ad, const char *o, const char *c);
mpc_parser_t *mpc_tok_parens(mpc_parser_t *a, mpc_dtor_t ad);
mpc_parser_t *mpc_tok_braces(mpc_parser_t *a, mpc_dtor_t ad);
mpc_parser_t *mpc_tok_brackets(mpc_parser_t *a, mpc_dtor_t ad);
mpc_parser_t *mpc_tok_squares(mpc_parser_t *a, mpc_dtor_t ad);
mpc_parser_t *mpc_sepby1(mpc_fold_t f, mpc_parser_t *sep, mpc_parser_t *a);
/*
** Common Function Parameters
*/
void mpcf_dtor_null(mpc_val_t *x);
mpc_val_t *mpcf_ctor_null(void);
mpc_val_t *mpcf_ctor_str(void);
mpc_val_t *mpcf_free(mpc_val_t *x);
mpc_val_t *mpcf_int(mpc_val_t *x);
mpc_val_t *mpcf_hex(mpc_val_t *x);
mpc_val_t *mpcf_oct(mpc_val_t *x);
mpc_val_t *mpcf_float(mpc_val_t *x);
mpc_val_t *mpcf_strtriml(mpc_val_t *x);
mpc_val_t *mpcf_strtrimr(mpc_val_t *x);
mpc_val_t *mpcf_strtrim(mpc_val_t *x);
mpc_val_t *mpcf_escape(mpc_val_t *x);
mpc_val_t *mpcf_escape_regex(mpc_val_t *x);
mpc_val_t *mpcf_escape_string_raw(mpc_val_t *x);
mpc_val_t *mpcf_escape_char_raw(mpc_val_t *x);
mpc_val_t *mpcf_unescape(mpc_val_t *x);
mpc_val_t *mpcf_unescape_regex(mpc_val_t *x);
mpc_val_t *mpcf_unescape_string_raw(mpc_val_t *x);
mpc_val_t *mpcf_unescape_char_raw(mpc_val_t *x);
mpc_val_t *mpcf_null(int n, mpc_val_t** xs);
mpc_val_t *mpcf_fst(int n, mpc_val_t** xs);
mpc_val_t *mpcf_snd(int n, mpc_val_t** xs);
mpc_val_t *mpcf_trd(int n, mpc_val_t** xs);
mpc_val_t *mpcf_fst_free(int n, mpc_val_t** xs);
mpc_val_t *mpcf_snd_free(int n, mpc_val_t** xs);
mpc_val_t *mpcf_trd_free(int n, mpc_val_t** xs);
mpc_val_t *mpcf_all_free(int n, mpc_val_t** xs);
mpc_val_t *mpcf_freefold(int n, mpc_val_t** xs);
mpc_val_t *mpcf_strfold(int n, mpc_val_t** xs);
/*
** Regular Expression Parsers
*/
enum {
MPC_RE_DEFAULT = 0,
MPC_RE_M = 1,
MPC_RE_S = 2,
MPC_RE_MULTILINE = 1,
MPC_RE_DOTALL = 2
};
mpc_parser_t *mpc_re(const char *re);
mpc_parser_t *mpc_re_mode(const char *re, int mode);
/*
** AST
*/
typedef struct mpc_ast_t {
char *tag;
char *contents;
mpc_state_t state;
int children_num;
struct mpc_ast_t** children;
} mpc_ast_t;
mpc_ast_t *mpc_ast_new(const char *tag, const char *contents);
mpc_ast_t *mpc_ast_build(int n, const char *tag, ...);
mpc_ast_t *mpc_ast_add_root(mpc_ast_t *a);
mpc_ast_t *mpc_ast_add_child(mpc_ast_t *r, mpc_ast_t *a);
mpc_ast_t *mpc_ast_add_tag(mpc_ast_t *a, const char *t);
mpc_ast_t *mpc_ast_add_root_tag(mpc_ast_t *a, const char *t);
mpc_ast_t *mpc_ast_tag(mpc_ast_t *a, const char *t);
mpc_ast_t *mpc_ast_state(mpc_ast_t *a, mpc_state_t s);
void mpc_ast_delete(mpc_ast_t *a);
void mpc_ast_print(mpc_ast_t *a);
void mpc_ast_print_to(mpc_ast_t *a, FILE *fp);
int mpc_ast_get_index(mpc_ast_t *ast, const char *tag);
int mpc_ast_get_index_lb(mpc_ast_t *ast, const char *tag, int lb);
mpc_ast_t *mpc_ast_get_child(mpc_ast_t *ast, const char *tag);
mpc_ast_t *mpc_ast_get_child_lb(mpc_ast_t *ast, const char *tag, int lb);
typedef enum {
mpc_ast_trav_order_pre,
mpc_ast_trav_order_post
} mpc_ast_trav_order_t;
typedef struct mpc_ast_trav_t {
mpc_ast_t *curr_node;
struct mpc_ast_trav_t *parent;
int curr_child;
mpc_ast_trav_order_t order;
} mpc_ast_trav_t;
mpc_ast_trav_t *mpc_ast_traverse_start(mpc_ast_t *ast,
mpc_ast_trav_order_t order);
mpc_ast_t *mpc_ast_traverse_next(mpc_ast_trav_t **trav);
void mpc_ast_traverse_free(mpc_ast_trav_t **trav);
/*
** Warning: This function currently doesn't test for equality of the `state` member!
*/
int mpc_ast_eq(mpc_ast_t *a, mpc_ast_t *b);
mpc_val_t *mpcf_fold_ast(int n, mpc_val_t **as);
mpc_val_t *mpcf_str_ast(mpc_val_t *c);
mpc_val_t *mpcf_state_ast(int n, mpc_val_t **xs);
mpc_parser_t *mpca_tag(mpc_parser_t *a, const char *t);
mpc_parser_t *mpca_add_tag(mpc_parser_t *a, const char *t);
mpc_parser_t *mpca_root(mpc_parser_t *a);
mpc_parser_t *mpca_state(mpc_parser_t *a);
mpc_parser_t *mpca_total(mpc_parser_t *a);
mpc_parser_t *mpca_not(mpc_parser_t *a);
mpc_parser_t *mpca_maybe(mpc_parser_t *a);
mpc_parser_t *mpca_many(mpc_parser_t *a);
mpc_parser_t *mpca_many1(mpc_parser_t *a);
mpc_parser_t *mpca_count(int n, mpc_parser_t *a);
mpc_parser_t *mpca_or(int n, ...);
mpc_parser_t *mpca_and(int n, ...);
enum {
MPCA_LANG_DEFAULT = 0,
MPCA_LANG_PREDICTIVE = 1,
MPCA_LANG_WHITESPACE_SENSITIVE = 2
};
mpc_parser_t *mpca_grammar(int flags, const char *grammar, ...);
mpc_err_t *mpca_lang(int flags, const char *language, ...);
mpc_err_t *mpca_lang_file(int flags, FILE *f, ...);
mpc_err_t *mpca_lang_pipe(int flags, FILE *f, ...);
mpc_err_t *mpca_lang_contents(int flags, const char *filename, ...);
/*
** Misc
*/
void mpc_print(mpc_parser_t *p);
void mpc_optimise(mpc_parser_t *p);
void mpc_stats(mpc_parser_t *p);
int mpc_test_pass(mpc_parser_t *p, const char *s, const void *d,
int(*tester)(const void*, const void*),
mpc_dtor_t destructor,
void(*printer)(const void*));
int mpc_test_fail(mpc_parser_t *p, const char *s, const void *d,
int(*tester)(const void*, const void*),
mpc_dtor_t destructor,
void(*printer)(const void*));
#ifdef __cplusplus
}
#endif
#endif

2
src/vendor/yar.c vendored
View file

@ -1,2 +0,0 @@
#define YAR_IMPLEMENTATION
#include "yar.h"

229
src/vendor/yar.h vendored
View file

@ -1,229 +0,0 @@
/* yar - dynamic arrays in C - public domain Nicholas Rixson 2025
*
* https://github.com/segcore/yar
*
* Licence: see end of file
Sample usage:
#define YAR_IMPLEMENTATION
#include "yar.h"
int main() {
// struct { double *items; size_t count; size_t capacity; } numbers = {0};
yar(double) numbers = {0};
*yar_append(&numbers) = 3.14159;
*yar_append(&numbers) = 2.71828;
*yar_append(&numbers) = 1.61803;
for(size_t i = 0; i < numbers.count; i++) {
printf("%f\n", numbers.items[i]);
}
yar_free(&numbers);
}
*/
#ifndef YAR_H
#define YAR_H
#include <stddef.h> // size_t
#include <string.h> // strlen
/*
* yar(type) - Declare a new basic dynamic array
*
* yar_append(array) - Add a new item at the end of the array, and return a pointer to it
*
* yar_reserve(array, extra) - Reserve space for `extra` count of items
*
* yar_append_many(array, data, num) - Append a copy of existing data
*
* yar_append_cstr(array, data) - Append a C string (nul-terminated char array)
*
* yar_insert(array, index, num) - Insert items somewhere within the array. Moves items to higher indexes as required. Returns &array[index]
*
* yar_remove(array, index, num) - Remove items from somewhere within the array. Moves items to lower indexes as required.
*
* yar_reset(array) - Reset the count of elements to 0, to re-use the memory. Does not free the memory.
*
* yar_init(array) - Set items, count, and capacity to 0. Can usually be avoided with <declaration> = {0};
*
* yar_free(array) - Free items memory, and set the items, count, and capacity to 0.
*/
#define yar(type) struct { type *items; size_t count; size_t capacity; }
#define yar_append(array) ((_yar_append((void**)&(array)->items, &(array)->count, &(array)->capacity, sizeof((array)->items[0])) ? \
&(array)->items[(array)->count - 1] : NULL))
#define yar_reserve(array, extra) ((_yar_reserve((void**)&(array)->items, &(array)->count, &(array)->capacity, sizeof((array)->items[0]), (extra)) ? \
&(array)->items[(array)->count] : NULL))
#define yar_append_many(array, data, num) ((_yar_append_many((void**)&(array)->items, &(array)->count, &(array)->capacity, sizeof((array)->items[0]), 1 ? (data) : ((array)->items), (num)) ))
#define yar_append_cstr(array, data) yar_append_many(array, data, strlen(data))
#define yar_insert(array, index, num) ((_yar_insert((void**)&(array)->items, &(array)->count, &(array)->capacity, sizeof((array)->items[0]), index, num) ))
#define yar_remove(array, index, num) ((_yar_remove((void**)&(array)->items, &(array)->count, sizeof((array)->items[0]), index, num) ))
#define yar_reset(array) (((array)->count = 0))
#define yar_init(array) ((array)->items = NULL, (array)->count = 0, (array)->capacity = 0)
#define yar_free(array) ((_yar_free((array)->items)), (array)->items = NULL, (array)->count = 0, (array)->capacity = 0)
#ifndef YARAPI
#define YARAPI // nothing; overridable if needed.
#endif
#ifdef __cplusplus
extern "C" {
#endif
// Implementation functions
YARAPI void* _yar_append(void** items_pointer, size_t* count, size_t* capacity, size_t item_size);
YARAPI void* _yar_append_many(void** items_pointer, size_t* count, size_t* capacity, size_t item_size, void* data, size_t extra);
YARAPI void* _yar_reserve(void** items_pointer, size_t* count, size_t* capacity, size_t item_size, size_t extra);
YARAPI void* _yar_insert(void** items_pointer, size_t* count, size_t* capacity, size_t item_size, size_t index, size_t extra);
YARAPI void* _yar_remove(void** items_pointer, size_t* count, size_t item_size, size_t index, size_t remove);
YARAPI void* _yar_realloc(void* p, size_t new_size);
YARAPI void _yar_free(void* p);
#ifdef __cplusplus
}
#endif
#endif // YAR_H
#if defined(YAR_IMPLEMENTATION)
#ifndef YAR_MIN_CAP
#define YAR_MIN_CAP 16
#endif
#ifndef YAR_REALLOC
#define YAR_REALLOC realloc
#endif
#ifndef YAR_FREE
#define YAR_FREE free
#endif
#include <string.h> // mem* functions
YARAPI void* _yar_append(void** items_pointer, size_t* count, size_t* capacity, size_t item_size)
{
void* result = _yar_reserve(items_pointer, count, capacity, item_size, 1);
if (result != NULL) *count += 1;
return result;
}
YARAPI void* _yar_append_many(void** items_pointer, size_t* count, size_t* capacity, size_t item_size, void* data, size_t extra)
{
void* result = _yar_reserve(items_pointer, count, capacity, item_size, extra);
if (result != NULL) {
memcpy(result, data, item_size * extra);
*count += extra;
}
return result;
}
YARAPI void* _yar_reserve(void** items_pointer, size_t* count, size_t* capacity, size_t item_size, size_t extra)
{
char* items = *items_pointer;
size_t newcount = *count + extra;
if (newcount > *capacity) {
size_t newcap = (*capacity < YAR_MIN_CAP) ? YAR_MIN_CAP : *capacity * 8 / 5;
if (newcap < newcount) newcap = newcount;
void* next = _yar_realloc(items, newcap * item_size);
if (next == NULL) return NULL;
items = next;
*items_pointer = next;
*capacity = newcap;
}
void* result = items + (*count * item_size);
if (extra && result) memset(result, 0, item_size * extra);
return result;
}
YARAPI void* _yar_insert(void** items_pointer, size_t* count, size_t* capacity, size_t item_size, size_t index, size_t extra)
{
void* next = _yar_reserve(items_pointer, count, capacity, item_size, extra);
if(next == NULL) return NULL;
char* items = *items_pointer;
if (index < *count)
{
memmove(&items[item_size * (index + extra)], &items[item_size * index], (*count - index) * item_size);
memset(&items[item_size * index], 0, extra * item_size);
}
*count += extra;
return items + index * item_size;
}
YARAPI void* _yar_remove(void** items_pointer, size_t* count, size_t item_size, size_t index, size_t remove)
{
if(remove >= *count) {
*count = 0;
return *items_pointer;
}
if (index >= *count) {
return *items_pointer;
}
char* items = *items_pointer;
memmove(&items[item_size * index], &items[item_size * (index + remove)], item_size * (*count - (index + remove)));
*count -= remove;
return items + item_size * index;
}
YARAPI void* _yar_realloc(void* p, size_t new_size)
{
// Declaration, so we can call it if the definition is overridden
extern void* YAR_REALLOC(void *ptr, size_t size);
return YAR_REALLOC(p, new_size);
}
YARAPI void _yar_free(void* p)
{
extern void YAR_FREE(void *ptr);
YAR_FREE(p);
}
#endif // YAR_IMPLEMENTATION
/*
------------------------------------------------------------------------------
This software is available under 2 licenses -- choose whichever you prefer.
------------------------------------------------------------------------------
ALTERNATIVE A - MIT License
Copyright (c) 2025 Nicholas Rixson
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
------------------------------------------------------------------------------
ALTERNATIVE B - Public Domain (www.unlicense.org)
This is free and unencumbered software released into the public domain.
Anyone is free to copy, modify, publish, use, compile, sell, or distribute this
software, either in source code form or as a compiled binary, for any purpose,
commercial or non-commercial, and by any means.
In jurisdictions that recognize copyright laws, the author or authors of this
software dedicate any and all copyright interest in the software to the public
domain. We make this dedication for the benefit of the public at large and to
the detriment of our heirs and successors. We intend this dedication to be an
overt act of relinquishment in perpetuity of all present and future rights to
this software under copyright law.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
------------------------------------------------------------------------------
*/

509
src/vm.c
View file

@ -1,509 +0,0 @@
#include <setjmp.h>
#include <stdio.h>
#include "arena.h"
#include "chunk.h"
#include "compile.h"
#include "dictionary.h"
#include "file.h"
#include "gc.h"
#include "object.h"
#include "primitive.h"
#include "string.h"
#include "userdata.h"
#include "vm.h"
static I decode_sleb128(U8 **ptr) {
I result = 0;
I shift = 0;
U8 byte;
do {
byte = **ptr;
(*ptr)++;
result |= (I)(byte & 0x7F) << shift;
shift += 7;
} while (byte & 0x80);
if ((shift < 64) && (byte & 0x40)) {
result |= -(1LL << shift);
}
return result;
}
V vm_init(Vm *vm) {
vm->sp = vm->stack;
vm->rsp = vm->rstack;
vm->tsp = vm->tstack;
vm->chunk = NULL;
vm->dictionary = NULL;
gc_init(&vm->gc);
arena_init(&vm->arena, 1024 * 1024);
for (Z i = 0; i < STACK_SIZE; i++) {
vm->stack[i] = NIL;
vm->tstack[i] = NIL;
vm->rstack[i].obj = NIL;
gc_addroot(&vm->gc, &vm->stack[i]);
gc_addroot(&vm->gc, &vm->tstack[i]);
gc_addroot(&vm->gc, &vm->rstack[i].obj);
}
vm->next_call = NIL;
gc_addroot(&vm->gc, &vm->next_call);
vm->trampoline = chunk_new("<trampoline>");
chunk_emit_byte(vm->trampoline, OP_CALL_NEXT);
vm->stdin = userdata_make(vm, (void *)stdin, &userdata_file);
vm->stdout = userdata_make(vm, (void *)stdout, &userdata_file);
vm->stderr = userdata_make(vm, (void *)stderr, &userdata_file);
gc_addroot(&vm->gc, &vm->stdin);
gc_addroot(&vm->gc, &vm->stdout);
gc_addroot(&vm->gc, &vm->stderr);
}
V vm_deinit(Vm *vm) {
chunk_release(vm->trampoline);
// 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, 1);
gc_deinit(&vm->gc);
}
static V vm_error(Vm *vm, I error, const char *message) {
I col = -1;
I line = chunk_get_line(vm->chunk, vm->ip - vm->chunk->items, &col);
fprintf(stderr, "error at %ld:%ld: %s\n", line + 1, col + 1, message);
longjmp(vm->error, error);
}
V vm_push(Vm *vm, O o) {
if (vm->sp >= vm->stack + STACK_SIZE)
vm_error(vm, VM_ERR_STACK_OVERFLOW, "data stack overflow");
*vm->sp++ = o;
}
O vm_pop(Vm *vm) {
if (vm->sp <= vm->stack)
vm_error(vm, VM_ERR_STACK_UNDERFLOW, "data stack underflow");
O o = *--vm->sp;
*vm->sp = NIL;
return o;
}
V vm_tpush(Vm *vm, O o) {
if (vm->tsp >= vm->tstack + STACK_SIZE)
vm_error(vm, VM_ERR_STACK_OVERFLOW, "retain stack overflow");
*vm->tsp++ = o;
}
O vm_tpop(Vm *vm) {
if (vm->tsp <= vm->tstack)
vm_error(vm, VM_ERR_STACK_UNDERFLOW, "retain stack underflow");
O o = *--vm->tsp;
*vm->tsp = NIL;
return o;
}
V vm_rpush(Vm *vm, Bc *chunk, U8 *ip) {
if (vm->rsp >= vm->rstack + STACK_SIZE)
vm_error(vm, VM_ERR_STACK_OVERFLOW, "return stack overflow");
vm->rsp->chunk = chunk;
vm->rsp->ip = ip;
vm->rsp->obj = NIL;
vm->rsp++;
}
Fr vm_rpop(Vm *vm) {
if (vm->rsp <= vm->rstack)
vm_error(vm, VM_ERR_STACK_UNDERFLOW, "return stack underflow");
return *--vm->rsp;
}
I vm_run(Vm *vm, Bc *chunk, I offset) {
I mark = gc_mark(&vm->gc);
if (setjmp(vm->error) != 0) {
gc_reset(&vm->gc, mark);
return 0;
}
for (Z i = 0; i < chunk->constants.count; i++)
gc_addroot(&vm->gc, &chunk->constants.items[i]);
#define BINOP(op) \
{ \
O b = vm_pop(vm); \
O a = vm_pop(vm); \
if (!IMM(a) || !IMM(b)) \
vm_error(vm, VM_ERR_TYPE, "numop on non-numeric objects"); \
vm_push(vm, NUM(ORD(a) op ORD(b))); \
break; \
}
#define CMPOP(op) \
{ \
O b = vm_pop(vm); \
O a = vm_pop(vm); \
if (!IMM(a) || !IMM(b)) \
vm_error(vm, VM_ERR_TYPE, "comparison on non-numeric objects"); \
vm_push(vm, (ORD(a) op ORD(b)) ? NUM(1) : NIL); \
break; \
}
vm->ip = chunk->items + offset;
vm->chunk = chunk;
for (;;) {
U8 opcode;
switch (opcode = *vm->ip++) {
case OP_NOP:
continue;
case OP_NIL:
vm_push(vm, NIL);
break;
case OP_CONST: {
I idx = decode_sleb128(&vm->ip);
vm_push(vm, vm->chunk->constants.items[idx]);
break;
}
case OP_DROP: {
(void)vm_pop(vm);
break;
}
case OP_2DROP: {
(void)vm_pop(vm);
(void)vm_pop(vm);
break;
}
case OP_DUP: {
O obj = vm_pop(vm);
vm_push(vm, obj);
vm_push(vm, obj);
break;
}
case OP_2DUP: {
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);
break;
}
case OP_SWAP: {
O b = vm_pop(vm);
O a = vm_pop(vm);
vm_push(vm, b);
vm_push(vm, a);
break;
}
case OP_2SWAP: {
O d = vm_pop(vm);
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, b);
break;
}
case OP_NIP: {
/* a b -> b */
O b = vm_pop(vm);
(void)vm_pop(vm);
vm_push(vm, b);
break;
}
case OP_OVER: {
/* a b -> a b a */
O b = vm_pop(vm);
O a = vm_pop(vm);
vm_push(vm, a);
vm_push(vm, b);
vm_push(vm, a);
break;
}
case OP_BURY: {
/* a b c - c a b */
O c = vm_pop(vm);
O b = vm_pop(vm);
O a = vm_pop(vm);
vm_push(vm, c);
vm_push(vm, a);
vm_push(vm, b);
break;
}
case OP_DIG: {
/* a b c - b c a */
O c = vm_pop(vm);
O b = vm_pop(vm);
O a = vm_pop(vm);
vm_push(vm, b);
vm_push(vm, c);
vm_push(vm, a);
break;
}
case OP_TOR: {
vm_tpush(vm, vm_pop(vm));
break;
}
case OP_2TOR: {
O obj2 = vm_pop(vm);
O obj1 = vm_pop(vm);
vm_tpush(vm, obj1);
vm_tpush(vm, obj2);
break;
}
case OP_FROMR: {
vm_push(vm, vm_tpop(vm));
break;
}
case OP_2FROMR: {
O obj2 = vm_tpop(vm);
O obj1 = vm_tpop(vm);
vm_push(vm, obj1);
vm_push(vm, obj2);
break;
}
case OP_DOWORD: {
I idx = decode_sleb128(&vm->ip);
Dt *word = vm->chunk->symbols.items[idx].resolved;
if (!word)
vm_error(vm, VM_ERR_RUNTIME, "word not found");
vm_rpush(vm, vm->chunk, vm->ip);
vm->chunk = word->chunk;
vm->ip = word->chunk->items;
break;
}
case OP_CALL: {
O quot = vm_pop(vm);
vm_rpush(vm, vm->chunk, vm->ip);
do_call:
switch (type(quot)) {
case OBJ_QUOT: {
Bc **ptr = (Bc **)(UNBOX(quot) + 1);
Bc *chunk = *ptr;
vm->chunk = chunk;
vm->ip = chunk->items;
break;
}
case OBJ_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: {
Qc *curry = (Qc *)(UNBOX(quot) + 1);
vm_push(vm, curry->value);
quot = curry->callable;
goto do_call;
break;
}
default:
vm_error(vm, VM_ERR_TYPE, "attempt to call non-quotation object");
}
break;
}
case OP_TAIL_DOWORD: {
I idx = decode_sleb128(&vm->ip);
Dt *word = vm->chunk->symbols.items[idx].resolved;
if (!word)
vm_error(vm, VM_ERR_RUNTIME, "word not found");
vm->chunk = word->chunk;
vm->ip = word->chunk->items;
break;
}
case OP_CALL_NEXT:
vm_push(vm, vm->next_call);
vm->next_call = NIL;
// fallthrough
case OP_TAIL_CALL: {
O quot = vm_pop(vm);
do_tail_call:
switch (type(quot)) {
case OBJ_QUOT: {
Bc **ptr = (Bc **)(UNBOX(quot) + 1);
Bc *chunk = *ptr;
vm->chunk = chunk;
vm->ip = chunk->items;
break;
}
case OBJ_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: {
Qc *curry = (Qc *)(UNBOX(quot) + 1);
vm_push(vm, curry->value);
quot = curry->callable;
goto do_tail_call;
break;
}
default:
vm_error(vm, VM_ERR_TYPE, "attempt to call non-quotation object");
}
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_COMPOSE: {
I mark = gc_mark(&vm->gc);
O c1 = vm_pop(vm);
O c2 = vm_pop(vm);
gc_addroot(&vm->gc, &c2);
gc_addroot(&vm->gc, &c1);
if (!callable(c2) || !callable(c1))
vm_error(vm, VM_ERR_TYPE, "non-callable arguments to compose");
Hd *hd = gc_alloc(vm, sizeof(Hd) + sizeof(Qo));
hd->type = OBJ_COMPOSE;
Qo *comp = (Qo *)(hd + 1);
comp->first = c2;
comp->second = c1;
vm_push(vm, BOX(hd));
gc_reset(&vm->gc, mark);
break;
}
case OP_CURRY: {
I mark = gc_mark(&vm->gc);
O cble = vm_pop(vm);
O value = vm_pop(vm);
gc_addroot(&vm->gc, &cble);
gc_addroot(&vm->gc, &value);
if (!callable(cble))
vm_error(vm, VM_ERR_TYPE, "non-callable argument to curry");
Hd *hd = gc_alloc(vm, sizeof(Hd) + sizeof(Qc));
hd->type = OBJ_CURRY;
Qc *curry = (Qc *)(hd + 1);
curry->value = value;
curry->callable = cble;
vm_push(vm, BOX(hd));
gc_reset(&vm->gc, mark);
break;
}
case OP_RETURN:
if (vm->rsp != vm->rstack) {
Fr frame = vm_rpop(vm);
vm->next_call = frame.obj;
vm->chunk = frame.chunk;
vm->ip = frame.ip;
} else {
goto done;
}
break;
case OP_CHOOSE: {
O fals = vm_pop(vm);
O tru = vm_pop(vm);
O cond = vm_pop(vm);
if (cond == NIL) {
vm_push(vm, fals);
} else {
vm_push(vm, tru);
}
break;
}
case OP_ADD:
BINOP(+);
case OP_SUB:
BINOP(-);
case OP_MUL:
BINOP(*);
case OP_DIV:
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:
CMPOP(!=);
case OP_LT:
CMPOP(<);
case OP_GT:
CMPOP(>);
case OP_LTE:
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: {
O b = vm_pop(vm);
if (type(b) != OBJ_STR)
vm_error(vm, VM_ERR_TYPE, "expected string");
O a = vm_pop(vm);
if (type(a) != OBJ_STR)
vm_error(vm, VM_ERR_TYPE, "expected string");
vm_push(vm, string_concat(vm, a, b));
break;
}
default:
vm_error(vm, VM_ERR_RUNTIME, "unknown opcode");
}
}
done:
gc_reset(&vm->gc, mark);
return 1;
}

103
src/vm.h
View file

@ -1,103 +0,0 @@
#ifndef VM_H
#define VM_H
#include <setjmp.h>
#include "common.h"
#include "arena.h"
#include "chunk.h"
#include "dictionary.h"
#include "gc.h"
#include "object.h"
enum {
OP_NOP = 0,
OP_CONST,
OP_NIL,
OP_DROP,
OP_2DROP,
OP_DUP,
OP_2DUP,
OP_SWAP,
OP_2SWAP,
OP_NIP,
OP_OVER,
OP_BURY,
OP_DIG,
OP_TOR,
OP_2TOR,
OP_FROMR,
OP_2FROMR,
OP_DOWORD,
OP_CALL,
OP_TAIL_DOWORD,
OP_TAIL_CALL,
OP_PRIM,
OP_COMPOSE,
OP_CURRY,
OP_RETURN,
OP_CHOOSE,
OP_ADD,
OP_SUB,
OP_MUL,
OP_DIV,
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_CONCAT,
OP_CALL_NEXT,
};
#define STACK_SIZE 256
typedef struct Fr {
Bc *chunk;
U8 *ip;
O obj;
} Fr;
typedef struct Vm {
Gc gc;
O stack[STACK_SIZE], *sp;
O tstack[STACK_SIZE], *tsp;
Fr rstack[STACK_SIZE], *rsp;
U8 *ip;
Bc *chunk;
Dt *dictionary;
Ar arena;
jmp_buf error;
Bc *trampoline;
O next_call;
// These objects need to stay as roots!
O stdin, stdout, stderr;
} Vm;
enum {
VM_ERR_STACK_OVERFLOW = 1,
VM_ERR_STACK_UNDERFLOW,
VM_ERR_TYPE,
VM_ERR_RUNTIME
};
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

0
subprojects/.wraplock
View file

22
subprojects/libutf/NOTICE
View file

@ -1,22 +0,0 @@
This is a Unix port of the Plan 9 UTF-8 library, by Rob Pike and Ken Thompson.
Please send comments about the packaging to Russ Cox <rsc@swtch.com>.
Copyright © 2021 Plan 9 Foundation
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.

41
subprojects/libutf/meson.build
View file

@ -1,41 +0,0 @@
project('libutf', 'c')
add_project_arguments(
'-Wno-missing-braces',
'-Wno-parentheses',
'-Wno-sign-compare',
language: 'c'
)
inc = include_directories('.')
libutf = static_library(
'utf',
[
'rune.c',
'runestrcat.c',
'runestrchr.c',
'runestrcmp.c',
'runestrcpy.c',
'runestrdup.c',
'runestrecpy.c',
'runestrlen.c',
'runestrncat.c',
'runestrncmp.c',
'runestrncpy.c',
'runestrrchr.c',
'runestrstr.c',
'runetype.c',
'utfecpy.c',
'utflen.c',
'utfnlen.c',
'utfrrune.c',
'utfrune.c',
'utfutf.c',
],
)
libutf_dep = declare_dependency(
include_directories: inc,
link_with: libutf
)

28
subprojects/libutf/plan9.h
View file

@ -1,28 +0,0 @@
/*
* compiler directive on Plan 9
*/
#ifndef USED
#define USED(x) if(x);else
#endif
/*
* easiest way to make sure these are defined
*/
#define uchar _utfuchar
#define ushort _utfushort
#define uint _utfuint
#define ulong _utfulong
typedef unsigned char uchar;
typedef unsigned short ushort;
typedef unsigned int uint;
typedef unsigned long ulong;
/*
* nil cannot be ((void*)0) on ANSI C,
* because it is used for function pointers
*/
#undef nil
#define nil 0
#undef nelem
#define nelem(x) (sizeof (x)/sizeof (x)[0])

217
subprojects/libutf/rune.c
View file

@ -1,217 +0,0 @@
/*
* The authors of this software are Rob Pike and Ken Thompson.
* Copyright (c) 2002 by Lucent Technologies.
* Permission to use, copy, modify, and distribute this software for any
* purpose without fee is hereby granted, provided that this entire notice
* is included in all copies of any software which is or includes a copy
* or modification of this software and in all copies of the supporting
* documentation for such software.
* THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT TECHNOLOGIES MAKE
* ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
* OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
*/
#include <stdarg.h>
#include <string.h>
#include "plan9.h"
#include "utf.h"
enum
{
Bit1 = 7,
Bitx = 6,
Bit2 = 5,
Bit3 = 4,
Bit4 = 3,
Bit5 = 2,
T1 = ((1<<(Bit1+1))-1) ^ 0xFF, /* 0000 0000 */
Tx = ((1<<(Bitx+1))-1) ^ 0xFF, /* 1000 0000 */
T2 = ((1<<(Bit2+1))-1) ^ 0xFF, /* 1100 0000 */
T3 = ((1<<(Bit3+1))-1) ^ 0xFF, /* 1110 0000 */
T4 = ((1<<(Bit4+1))-1) ^ 0xFF, /* 1111 0000 */
T5 = ((1<<(Bit5+1))-1) ^ 0xFF, /* 1111 1000 */
Rune1 = (1<<(Bit1+0*Bitx))-1, /* 0000 0000 0000 0000 0111 1111 */
Rune2 = (1<<(Bit2+1*Bitx))-1, /* 0000 0000 0000 0111 1111 1111 */
Rune3 = (1<<(Bit3+2*Bitx))-1, /* 0000 0000 1111 1111 1111 1111 */
Rune4 = (1<<(Bit4+3*Bitx))-1, /* 0011 1111 1111 1111 1111 1111 */
Maskx = (1<<Bitx)-1, /* 0011 1111 */
Testx = Maskx ^ 0xFF, /* 1100 0000 */
Bad = Runeerror
};
int
chartorune(Rune *rune, char *str)
{
int c, c1, c2, c3;
long l;
/*
* one character sequence
* 00000-0007F => T1
*/
c = *(uchar*)str;
if(c < Tx) {
*rune = c;
return 1;
}
/*
* two character sequence
* 0080-07FF => T2 Tx
*/
c1 = *(uchar*)(str+1) ^ Tx;
if(c1 & Testx)
goto bad;
if(c < T3) {
if(c < T2)
goto bad;
l = ((c << Bitx) | c1) & Rune2;
if(l <= Rune1)
goto bad;
*rune = l;
return 2;
}
/*
* three character sequence
* 0800-FFFF => T3 Tx Tx
*/
c2 = *(uchar*)(str+2) ^ Tx;
if(c2 & Testx)
goto bad;
if(c < T4) {
l = ((((c << Bitx) | c1) << Bitx) | c2) & Rune3;
if(l <= Rune2)
goto bad;
*rune = l;
return 3;
}
/*
* four character sequence
* 10000-10FFFF => T4 Tx Tx Tx
*/
if(UTFmax >= 4) {
c3 = *(uchar*)(str+3) ^ Tx;
if(c3 & Testx)
goto bad;
if(c < T5) {
l = ((((((c << Bitx) | c1) << Bitx) | c2) << Bitx) | c3) & Rune4;
if(l <= Rune3)
goto bad;
if(l > Runemax)
goto bad;
*rune = l;
return 4;
}
}
/*
* bad decoding
*/
bad:
*rune = Bad;
return 1;
}
int
runetochar(char *str, Rune *rune)
{
long c;
/*
* one character sequence
* 00000-0007F => 00-7F
*/
c = *rune;
if(c <= Rune1) {
str[0] = c;
return 1;
}
/*
* two character sequence
* 00080-007FF => T2 Tx
*/
if(c <= Rune2) {
str[0] = T2 | (c >> 1*Bitx);
str[1] = Tx | (c & Maskx);
return 2;
}
/*
* three character sequence
* 00800-0FFFF => T3 Tx Tx
*/
if(c > Runemax)
c = Runeerror;
if(c <= Rune3) {
str[0] = T3 | (c >> 2*Bitx);
str[1] = Tx | ((c >> 1*Bitx) & Maskx);
str[2] = Tx | (c & Maskx);
return 3;
}
/*
* four character sequence
* 010000-1FFFFF => T4 Tx Tx Tx
*/
str[0] = T4 | (c >> 3*Bitx);
str[1] = Tx | ((c >> 2*Bitx) & Maskx);
str[2] = Tx | ((c >> 1*Bitx) & Maskx);
str[3] = Tx | (c & Maskx);
return 4;
}
int
runelen(long c)
{
Rune rune;
char str[10];
rune = c;
return runetochar(str, &rune);
}
int
runenlen(Rune *r, int nrune)
{
int nb, c;
nb = 0;
while(nrune--) {
c = *r++;
if(c <= Rune1)
nb++;
else
if(c <= Rune2)
nb += 2;
else
if(c <= Rune3 || c > Runemax)
nb += 3;
else
nb += 4;
}
return nb;
}
int
fullrune(char *str, int n)
{
int c;
if(n <= 0)
return 0;
c = *(uchar*)str;
if(c < Tx)
return 1;
if(c < T3)
return n >= 2;
if(UTFmax == 3 || c < T4)
return n >= 3;
return n >= 4;
}

25
subprojects/libutf/runestrcat.c
View file

@ -1,25 +0,0 @@
/*
* The authors of this software are Rob Pike and Ken Thompson.
* Copyright (c) 2002 by Lucent Technologies.
* Permission to use, copy, modify, and distribute this software for any
* purpose without fee is hereby granted, provided that this entire notice
* is included in all copies of any software which is or includes a copy
* or modification of this software and in all copies of the supporting
* documentation for such software.
* THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT TECHNOLOGIES MAKE
* ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
* OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
*/
#include <stdarg.h>
#include <string.h>
#include "plan9.h"
#include "utf.h"
Rune*
runestrcat(Rune *s1, Rune *s2)
{
runestrcpy(runestrchr(s1, 0), s2);
return s1;
}

35
subprojects/libutf/runestrchr.c
View file

@ -1,35 +0,0 @@
/*
* The authors of this software are Rob Pike and Ken Thompson.
* Copyright (c) 2002 by Lucent Technologies.
* Permission to use, copy, modify, and distribute this software for any
* purpose without fee is hereby granted, provided that this entire notice
* is included in all copies of any software which is or includes a copy
* or modification of this software and in all copies of the supporting
* documentation for such software.
* THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT TECHNOLOGIES MAKE
* ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
* OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
*/
#include <stdarg.h>
#include <string.h>
#include "plan9.h"
#include "utf.h"
Rune*
runestrchr(Rune *s, Rune c)
{
Rune c0 = c;
Rune c1;
if(c == 0) {
while(*s++)
;
return s-1;
}
while(c1 = *s++)
if(c1 == c0)
return s-1;
return 0;
}

35
subprojects/libutf/runestrcmp.c
View file

@ -1,35 +0,0 @@
/*
* The authors of this software are Rob Pike and Ken Thompson.
* Copyright (c) 2002 by Lucent Technologies.
* Permission to use, copy, modify, and distribute this software for any
* purpose without fee is hereby granted, provided that this entire notice
* is included in all copies of any software which is or includes a copy
* or modification of this software and in all copies of the supporting
* documentation for such software.
* THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT TECHNOLOGIES MAKE
* ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
* OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
*/
#include <stdarg.h>
#include <string.h>
#include "plan9.h"
#include "utf.h"
int
runestrcmp(Rune *s1, Rune *s2)
{
Rune c1, c2;
for(;;) {
c1 = *s1++;
c2 = *s2++;
if(c1 != c2) {
if(c1 > c2)
return 1;
return -1;
}
if(c1 == 0)
return 0;
}
}

28
subprojects/libutf/runestrcpy.c
View file

@ -1,28 +0,0 @@
/*
* The authors of this software are Rob Pike and Ken Thompson.
* Copyright (c) 2002 by Lucent Technologies.
* Permission to use, copy, modify, and distribute this software for any
* purpose without fee is hereby granted, provided that this entire notice
* is included in all copies of any software which is or includes a copy
* or modification of this software and in all copies of the supporting
* documentation for such software.
* THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT TECHNOLOGIES MAKE
* ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
* OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
*/
#include <stdarg.h>
#include <string.h>
#include "plan9.h"
#include "utf.h"
Rune*
runestrcpy(Rune *s1, Rune *s2)
{
Rune *os1;
os1 = s1;
while(*s1++ = *s2++)
;
return os1;
}

30
subprojects/libutf/runestrdup.c
View file

@ -1,30 +0,0 @@
/*
* The authors of this software are Rob Pike and Ken Thompson.
* Copyright (c) 2002 by Lucent Technologies.
* Permission to use, copy, modify, and distribute this software for any
* purpose without fee is hereby granted, provided that this entire notice
* is included in all copies of any software which is or includes a copy
* or modification of this software and in all copies of the supporting
* documentation for such software.
* THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT TECHNOLOGIES MAKE
* ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
* OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
*/
#include <stdarg.h>
#include <string.h>
#include <stdlib.h>
#include "plan9.h"
#include "utf.h"
Rune*
runestrdup(Rune *s)
{
Rune *ns;
ns = malloc(sizeof(Rune)*(runestrlen(s) + 1));
if(ns == 0)
return 0;
return runestrcpy(ns, s);
}

32
subprojects/libutf/runestrecpy.c
View file

@ -1,32 +0,0 @@
/*
* The authors of this software are Rob Pike and Ken Thompson.
* Copyright (c) 2002 by Lucent Technologies.
* Permission to use, copy, modify, and distribute this software for any
* purpose without fee is hereby granted, provided that this entire notice
* is included in all copies of any software which is or includes a copy
* or modification of this software and in all copies of the supporting
* documentation for such software.
* THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT TECHNOLOGIES MAKE
* ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
* OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
*/
#include <stdarg.h>
#include <string.h>
#include "plan9.h"
#include "utf.h"
Rune*
runestrecpy(Rune *s1, Rune *es1, Rune *s2)
{
if(s1 >= es1)
return s1;
while(*s1++ = *s2++){
if(s1 == es1){
*--s1 = '\0';
break;
}
}
return s1;
}

24
subprojects/libutf/runestrlen.c
View file

@ -1,24 +0,0 @@
/*
* The authors of this software are Rob Pike and Ken Thompson.
* Copyright (c) 2002 by Lucent Technologies.
* Permission to use, copy, modify, and distribute this software for any
* purpose without fee is hereby granted, provided that this entire notice
* is included in all copies of any software which is or includes a copy
* or modification of this software and in all copies of the supporting
* documentation for such software.
* THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT TECHNOLOGIES MAKE
* ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
* OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
*/
#include <stdarg.h>
#include <string.h>
#include "plan9.h"
#include "utf.h"
long
runestrlen(Rune *s)
{
return runestrchr(s, 0) - s;
}

32
subprojects/libutf/runestrncat.c
View file

@ -1,32 +0,0 @@
/*
* The authors of this software are Rob Pike and Ken Thompson.
* Copyright (c) 2002 by Lucent Technologies.
* Permission to use, copy, modify, and distribute this software for any
* purpose without fee is hereby granted, provided that this entire notice
* is included in all copies of any software which is or includes a copy
* or modification of this software and in all copies of the supporting
* documentation for such software.
* THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT TECHNOLOGIES MAKE
* ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
* OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
*/
#include <stdarg.h>
#include <string.h>
#include "plan9.h"
#include "utf.h"
Rune*
runestrncat(Rune *s1, Rune *s2, long n)
{
Rune *os1;
os1 = s1;
s1 = runestrchr(s1, 0);
while(*s1++ = *s2++)
if(--n < 0) {
s1[-1] = 0;
break;
}
return os1;
}

37
subprojects/libutf/runestrncmp.c
View file

@ -1,37 +0,0 @@
/*
* The authors of this software are Rob Pike and Ken Thompson.
* Copyright (c) 2002 by Lucent Technologies.
* Permission to use, copy, modify, and distribute this software for any
* purpose without fee is hereby granted, provided that this entire notice
* is included in all copies of any software which is or includes a copy
* or modification of this software and in all copies of the supporting
* documentation for such software.
* THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT TECHNOLOGIES MAKE
* ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
* OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
*/
#include <stdarg.h>
#include <string.h>
#include "plan9.h"
#include "utf.h"
int
runestrncmp(Rune *s1, Rune *s2, long n)
{
Rune c1, c2;
while(n > 0) {
c1 = *s1++;
c2 = *s2++;
n--;
if(c1 != c2) {
if(c1 > c2)
return 1;
return -1;
}
if(c1 == 0)
break;
}
return 0;
}

33
subprojects/libutf/runestrncpy.c
View file

@ -1,33 +0,0 @@
/*
* The authors of this software are Rob Pike and Ken Thompson.
* Copyright (c) 2002 by Lucent Technologies.
* Permission to use, copy, modify, and distribute this software for any
* purpose without fee is hereby granted, provided that this entire notice
* is included in all copies of any software which is or includes a copy
* or modification of this software and in all copies of the supporting
* documentation for such software.
* THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT TECHNOLOGIES MAKE
* ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
* OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
*/
#include <stdarg.h>
#include <string.h>
#include "plan9.h"
#include "utf.h"
Rune*
runestrncpy(Rune *s1, Rune *s2, long n)
{
int i;
Rune *os1;
os1 = s1;
for(i = 0; i < n; i++)
if((*s1++ = *s2++) == 0) {
while(++i < n)
*s1++ = 0;
return os1;
}
return os1;
}

30
subprojects/libutf/runestrrchr.c
View file

@ -1,30 +0,0 @@
/*
* The authors of this software are Rob Pike and Ken Thompson.
* Copyright (c) 2002 by Lucent Technologies.
* Permission to use, copy, modify, and distribute this software for any
* purpose without fee is hereby granted, provided that this entire notice
* is included in all copies of any software which is or includes a copy
* or modification of this software and in all copies of the supporting
* documentation for such software.
* THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT TECHNOLOGIES MAKE
* ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
* OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
*/
#include <stdarg.h>
#include <string.h>
#include "plan9.h"
#include "utf.h"
Rune*
runestrrchr(Rune *s, Rune c)
{
Rune *r;
if(c == 0)
return runestrchr(s, 0);
r = 0;
while(s = runestrchr(s, c))
r = s++;
return r;
}

44
subprojects/libutf/runestrstr.c
View file

@ -1,44 +0,0 @@
/*
* The authors of this software are Rob Pike and Ken Thompson.
* Copyright (c) 2002 by Lucent Technologies.
* Permission to use, copy, modify, and distribute this software for any
* purpose without fee is hereby granted, provided that this entire notice
* is included in all copies of any software which is or includes a copy
* or modification of this software and in all copies of the supporting
* documentation for such software.
* THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT TECHNOLOGIES MAKE
* ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
* OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
*/
#include <stdarg.h>
#include <string.h>
#include "plan9.h"
#include "utf.h"
/*
* Return pointer to first occurrence of s2 in s1,
* 0 if none
*/
Rune*
runestrstr(Rune *s1, Rune *s2)
{
Rune *p, *pa, *pb;
int c0, c;
c0 = *s2;
if(c0 == 0)
return s1;
s2++;
for(p=runestrchr(s1, c0); p; p=runestrchr(p+1, c0)) {
pa = p;
for(pb=s2;; pb++) {
c = *pb;
if(c == 0)
return p;
if(c != *++pa)
break;
}
}
return 0;
}

1151
subprojects/libutf/runetype.c
View file

File diff suppressed because it is too large Load diff

54
subprojects/libutf/utf.h
View file

@ -1,54 +0,0 @@
#ifndef _UTF_H_
#define _UTF_H_ 1
#if defined(__cplusplus)
extern "C" {
#endif
typedef unsigned int Rune; /* 32 bits */
enum
{
UTFmax = 4, /* maximum bytes per rune */
Runesync = 0x80, /* cannot represent part of a UTF sequence (<) */
Runeself = 0x80, /* rune and UTF sequences are the same (<) */
Runeerror = 0xFFFD, /* decoding error in UTF */
Runemax = 0x10FFFF /* maximum rune value */
};
/* Edit .+1,/^$/ | cfn $PLAN9/src/lib9/utf/?*.c | grep -v static |grep -v __ */
int chartorune(Rune *rune, char *str);
int fullrune(char *str, int n);
int isalpharune(Rune c);
int islowerrune(Rune c);
int isspacerune(Rune c);
int istitlerune(Rune c);
int isupperrune(Rune c);
int runelen(long c);
int runenlen(Rune *r, int nrune);
Rune* runestrcat(Rune *s1, Rune *s2);
Rune* runestrchr(Rune *s, Rune c);
int runestrcmp(Rune *s1, Rune *s2);
Rune* runestrcpy(Rune *s1, Rune *s2);
Rune* runestrdup(Rune *s) ;
Rune* runestrecpy(Rune *s1, Rune *es1, Rune *s2);
long runestrlen(Rune *s);
Rune* runestrncat(Rune *s1, Rune *s2, long n);
int runestrncmp(Rune *s1, Rune *s2, long n);
Rune* runestrncpy(Rune *s1, Rune *s2, long n);
Rune* runestrrchr(Rune *s, Rune c);
Rune* runestrstr(Rune *s1, Rune *s2);
int runetochar(char *str, Rune *rune);
Rune tolowerrune(Rune c);
Rune totitlerune(Rune c);
Rune toupperrune(Rune c);
char* utfecpy(char *to, char *e, char *from);
int utflen(char *s);
int utfnlen(char *s, long m);
char* utfrrune(char *s, long c);
char* utfrune(char *s, long c);
char* utfutf(char *s1, char *s2);
#if defined(__cplusplus)
}
#endif
#endif

32
subprojects/libutf/utfdef.h
View file

@ -1,32 +0,0 @@
/*
* compiler directive on Plan 9
*/
#ifndef USED
#define USED(x) if(x);else
#endif
/*
* easiest way to make sure these are defined
*/
#define uchar _fmtuchar
#define ushort _fmtushort
#define uint _fmtuint
#define ulong _fmtulong
#define vlong _fmtvlong
#define uvlong _fmtuvlong
typedef unsigned char uchar;
typedef unsigned short ushort;
typedef unsigned int uint;
typedef unsigned long ulong;
typedef unsigned long long uvlong;
typedef long long vlong;
/*
* nil cannot be ((void*)0) on ANSI C,
* because it is used for function pointers
*/
#undef nil
#define nil 0
#undef nelem
#define nelem ((void*)0)

38
subprojects/libutf/utfecpy.c
View file

@ -1,38 +0,0 @@
/*
* The authors of this software are Rob Pike and Ken Thompson.
* Copyright (c) 2002 by Lucent Technologies.
* Permission to use, copy, modify, and distribute this software for any
* purpose without fee is hereby granted, provided that this entire notice
* is included in all copies of any software which is or includes a copy
* or modification of this software and in all copies of the supporting
* documentation for such software.
* THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT TECHNOLOGIES MAKE
* ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
* OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
*/
#define _BSD_SOURCE 1 /* memccpy */
#define _DEFAULT_SOURCE 1
#include <stdarg.h>
#include <string.h>
#include "plan9.h"
#include "utf.h"
char*
utfecpy(char *to, char *e, char *from)
{
char *end;
if(to >= e)
return to;
end = memccpy(to, from, '\0', e - to);
if(end == nil){
end = e-1;
while(end>to && (*--end&0xC0)==0x80)
;
*end = '\0';
}else{
end--;
}
return end;
}

37
subprojects/libutf/utflen.c
View file

@ -1,37 +0,0 @@
/*
* The authors of this software are Rob Pike and Ken Thompson.
* Copyright (c) 2002 by Lucent Technologies.
* Permission to use, copy, modify, and distribute this software for any
* purpose without fee is hereby granted, provided that this entire notice
* is included in all copies of any software which is or includes a copy
* or modification of this software and in all copies of the supporting
* documentation for such software.
* THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT TECHNOLOGIES MAKE
* ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
* OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
*/
#include <stdarg.h>
#include <string.h>
#include "plan9.h"
#include "utf.h"
int
utflen(char *s)
{
int c;
long n;
Rune rune;
n = 0;
for(;;) {
c = *(uchar*)s;
if(c < Runeself) {
if(c == 0)
return n;
s++;
} else
s += chartorune(&rune, s);
n++;
}
}

41
subprojects/libutf/utfnlen.c
View file

@ -1,41 +0,0 @@
/*
* The authors of this software are Rob Pike and Ken Thompson.
* Copyright (c) 2002 by Lucent Technologies.
* Permission to use, copy, modify, and distribute this software for any
* purpose without fee is hereby granted, provided that this entire notice
* is included in all copies of any software which is or includes a copy
* or modification of this software and in all copies of the supporting
* documentation for such software.
* THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT TECHNOLOGIES MAKE
* ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
* OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
*/
#include <stdarg.h>
#include <string.h>
#include "plan9.h"
#include "utf.h"
int
utfnlen(char *s, long m)
{
int c;
long n;
Rune rune;
char *es;
es = s + m;
for(n = 0; s < es; n++) {
c = *(uchar*)s;
if(c < Runeself){
if(c == '\0')
break;
s++;
continue;
}
if(!fullrune(s, es-s))
break;
s += chartorune(&rune, s);
}
return n;
}

45
subprojects/libutf/utfrrune.c
View file

@ -1,45 +0,0 @@
/*
* The authors of this software are Rob Pike and Ken Thompson.
* Copyright (c) 2002 by Lucent Technologies.
* Permission to use, copy, modify, and distribute this software for any
* purpose without fee is hereby granted, provided that this entire notice
* is included in all copies of any software which is or includes a copy
* or modification of this software and in all copies of the supporting
* documentation for such software.
* THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT TECHNOLOGIES MAKE
* ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
* OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
*/
#include <stdarg.h>
#include <string.h>
#include "plan9.h"
#include "utf.h"
char*
utfrrune(char *s, long c)
{
long c1;
Rune r;
char *s1;
if(c < Runesync) /* not part of utf sequence */
return strrchr(s, c);
s1 = 0;
for(;;) {
c1 = *(uchar*)s;
if(c1 < Runeself) { /* one byte rune */
if(c1 == 0)
return s1;
if(c1 == c)
s1 = s;
s++;
continue;
}
c1 = chartorune(&r, s);
if(r == c)
s1 = s;
s += c1;
}
}

44
subprojects/libutf/utfrune.c
View file

@ -1,44 +0,0 @@
/*
* The authors of this software are Rob Pike and Ken Thompson.
* Copyright (c) 2002 by Lucent Technologies.
* Permission to use, copy, modify, and distribute this software for any
* purpose without fee is hereby granted, provided that this entire notice
* is included in all copies of any software which is or includes a copy
* or modification of this software and in all copies of the supporting
* documentation for such software.
* THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT TECHNOLOGIES MAKE
* ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
* OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
*/
#include <stdarg.h>
#include <string.h>
#include "plan9.h"
#include "utf.h"
char*
utfrune(char *s, long c)
{
long c1;
Rune r;
int n;
if(c < Runesync) /* not part of utf sequence */
return strchr(s, c);
for(;;) {
c1 = *(uchar*)s;
if(c1 < Runeself) { /* one byte rune */
if(c1 == 0)
return 0;
if(c1 == c)
return s;
s++;
continue;
}
n = chartorune(&r, s);
if(r == c)
return s;
s += n;
}
}

41
subprojects/libutf/utfutf.c
View file

@ -1,41 +0,0 @@
/*
* The authors of this software are Rob Pike and Ken Thompson.
* Copyright (c) 2002 by Lucent Technologies.
* Permission to use, copy, modify, and distribute this software for any
* purpose without fee is hereby granted, provided that this entire notice
* is included in all copies of any software which is or includes a copy
* or modification of this software and in all copies of the supporting
* documentation for such software.
* THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT TECHNOLOGIES MAKE
* ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
* OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
*/
#include <stdarg.h>
#include <string.h>
#include "plan9.h"
#include "utf.h"
/*
* Return pointer to first occurrence of s2 in s1,
* 0 if none
*/
char*
utfutf(char *s1, char *s2)
{
char *p;
long f, n1, n2;
Rune r;
n1 = chartorune(&r, s2);
f = r;
if(f <= Runesync) /* represents self */
return strstr(s1, s2);
n2 = strlen(s2);
for(p=s1; p=utfrune(p, f); p+=n1)
if(strncmp(p, s2, n2) == 0)
return p;
return 0;
}