From 4ca2f63c016e7af3d84ec1559ce7549e9bf9b8ae Mon Sep 17 00:00:00 2001 From: Liam O'Connor Date: Sun, 23 Nov 2025 22:56:30 +1100 Subject: [PATCH] basic evaluator, builtins support TODO: - patterns - parser for binops - function groups - tests!? --- .gitignore | 2 + Makefile | 2 +- bitset.c | 218 +++++++++++++++ bitset.h | 54 ++++ builtins.c | 82 ++++++ builtins.h | 20 ++ env.c | 77 ++++++ env.h | 19 ++ eval.c | 387 ++++++++++++++++++++++++++ eval.h | 7 + lexer.c | 114 +++++++- lexer.h | 21 ++ main.c | 24 +- scope.c | 7 + scope.h | 1 + syntax.c | 778 +++++++++++++++++++++++++++++++++++++++++------------ syntax.h | 55 +++- test.hito | 3 + value.c | 171 ++++++++++++ value.h | 66 +++++ 20 files changed, 1916 insertions(+), 192 deletions(-) create mode 100644 bitset.c create mode 100644 bitset.h create mode 100644 builtins.c create mode 100644 builtins.h create mode 100644 env.c create mode 100644 env.h create mode 100644 eval.c create mode 100644 eval.h create mode 100644 test.hito create mode 100644 value.c create mode 100644 value.h diff --git a/.gitignore b/.gitignore index 039aad2..08ab4a8 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,6 @@ *.o +.nova *.d compile_commands.json hito +/.DS_Store diff --git a/Makefile b/Makefile index 2f89bec..ed6d6ea 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,7 @@ CC = clang CFLAGS = -isysroot $(shell xcrun --show-sdk-path) -std=c11 -Wall -Wno-parentheses LDFLAGS = -isysroot $(shell xcrun --show-sdk-path) -SRC = main.c source.c util.c lexer.c syntax.c error.c intern.c scope.c +SRC = main.c source.c util.c lexer.c syntax.c error.c intern.c scope.c bitset.c env.c value.c eval.c builtins.c OBJ = $(SRC:.c=.o) DEPS = $(OBJ:.o=.d) diff --git a/bitset.c b/bitset.c new file mode 100644 index 0000000..10dd62f --- /dev/null +++ b/bitset.c @@ -0,0 +1,218 @@ +#include "bitset.h" +#include +#include +#include +#include "util.h" +struct bitset { + size_t nwords; /* allocated */ + uint64_t *words; /* array of 64-bit chunks */ +}; + +#define BITWORD(i) ((i) >> 6) /* divide by 64 */ +#define BITMASK(i) (1ULL << ((i) & 63)) + +bitset_t *bitset_alloc(void) { + bitset_t *bs = calloc(1, sizeof(bitset_t)); + if (bs == NULL) { + die("Out of memory: cannot allocate bitset"); + } + return bs; +} + +void bitset_free(bitset_t *bs) { + if (!bs) return; + free(bs->words); + free(bs); +} + +void bitset_reserve(bitset_t *bs, size_t maxbit) { + size_t need_words = BITWORD(maxbit) + 1; + if (need_words <= bs->nwords) + return; + + size_t new_words = bs->nwords ? bs->nwords : 1; + while (new_words < need_words) + new_words *= 2; + + uint64_t *new = calloc(new_words, sizeof(uint64_t)); + if (new == NULL) { + die("Out of memory: cannot enlarge bitset"); + } + if (bs->words) { + memcpy(new, bs->words, bs->nwords * sizeof(uint64_t)); + free(bs->words); + } + bs->words = new; + bs->nwords = new_words; +} + +void bitset_set(bitset_t *bs, size_t bit) { + bitset_reserve(bs, bit); + bs->words[BITWORD(bit)] |= BITMASK(bit); +} + +void bitset_clear(bitset_t *bs, size_t bit) { + size_t w = BITWORD(bit); + if (w >= bs->nwords) + return; + bs->words[w] &= ~BITMASK(bit); +} + +bool bitset_get(const bitset_t *bs, size_t bit) { + size_t w = BITWORD(bit); + if (w >= bs->nwords) + return false; + return (bs->words[w] & BITMASK(bit)) != 0; +} + +void bitset_reset(bitset_t *bs) { + memset(bs->words, 0, bs->nwords * sizeof(uint64_t)); +} + +size_t bitset_count(const bitset_t *bs) { + size_t count = 0; + for (size_t i = 0; i < bs->nwords; i++) + count += __builtin_popcountll(bs->words[i]); + return count; +} + + +size_t bitset_max(const bitset_t *bs) { + for (size_t w = bs->nwords; w > 0; w--) { + uint64_t x = bs->words[w - 1]; + if (x != 0) { + return ((w - 1) << 6) + + (63 - __builtin_clzll(x)); + } + } + return 0; +} + +void bitset_shift_up(bitset_t *bs, size_t n) { + if (n == 0) return; + + size_t word_shift = n / 64; + size_t bit_shift = n % 64; + + size_t old_max = bitset_max(bs); + bitset_reserve(bs, old_max + n - 1); // ensure enough space + + size_t old_nwords = bs->nwords; + + // shift words from end to start to avoid overwriting + for (ssize_t i = old_nwords - 1; i >= 0; i--) { + uint64_t w = bs->words[i]; + uint64_t upper = (bit_shift != 0 && i > 0) ? bs->words[i - 1] >> (64 - bit_shift) : 0; + bs->words[i + word_shift] = (w << bit_shift) | upper; + } + + // zero out lower words + for (size_t i = 0; i < word_shift; i++) + bs->words[i] = 0; +} + +void bitset_shift_down(bitset_t *bs, size_t n) { + if (n == 0) return; + + size_t word_shift = n / 64; + size_t bit_shift = n % 64; + + if (word_shift >= bs->nwords) { + // all bits are discarded + bitset_reset(bs); + return; + } + + // shift words from start to end + for (size_t i = 0; i + word_shift < bs->nwords; i++) { + uint64_t w = bs->words[i + word_shift]; + uint64_t lower = (bit_shift != 0 && i + word_shift + 1 < bs->nwords) + ? bs->words[i + word_shift + 1] << (64 - bit_shift) + : 0; + bs->words[i] = (w >> bit_shift) | lower; + } + + // zero out top words + for (size_t i = bs->nwords - word_shift; i < bs->nwords; i++) + bs->words[i] = 0; +} + +void bitset_union_with_offset(bitset_t *bs1, const bitset_t *bs2, size_t skip) { + size_t total_bits = bs2->nwords * 64; + if (skip >= total_bits) return; // nothing to merge + + // ensure bs1 can hold all bits + bitset_reserve(bs1, total_bits - skip - 1); + + size_t start_word = skip / 64; + size_t start_bit = skip % 64; + + uint64_t carry = 0; + for (size_t i = start_word; i < bs2->nwords; i++) { + uint64_t w = bs2->words[i]; + if (i == start_word && start_bit != 0) { + // mask out the first 'start_bit' bits in the first word + w &= ~((1ULL << start_bit) - 1); + } + + uint64_t new_w = (w >> start_bit) | carry; + carry = (start_bit != 0) ? (w << (64 - start_bit)) : 0; + + size_t dest_word = i - start_word; + bs1->words[dest_word] |= new_w; + } + + if (carry) { + size_t dest_word = bs2->nwords - start_word; + if (dest_word >= bs1->nwords) { + bitset_reserve(bs1, dest_word * 64 + 63); + } + bs1->words[dest_word] |= carry; + } +} + +void bitset_union(bitset_t *bs1, const bitset_t *bs2) { + if (bs2->nwords > bs1->nwords) + bitset_reserve(bs1, (bs2->nwords * 64) - 1); + + for (size_t i = 0; i < bs2->nwords; i++) + bs1->words[i] |= bs2->words[i]; +} + +void bitset_dump(const bitset_t *bs) { + size_t start = 0; + size_t bit; + printf("{"); + bool isStart = 1; + while ((bit = bitset_next(bs, &start)) != (size_t)-1) { + if (!isStart) + printf(", "); + printf("%zu", bit); + isStart = 0; + } + printf("}"); +} + +size_t bitset_next(const bitset_t *bs, size_t *start) { + size_t i = *start; + while (1) { + size_t w = BITWORD(i); + if (w >= bs->nwords) { + *start = (size_t)-1; + return (size_t)-1; + } + uint64_t word = bs->words[w]; + + uint64_t mask = ~0ULL << (i & 63); + uint64_t rem = word & mask; + + if (rem) { + int bit = __builtin_ctzll(rem); + size_t result = (w << 6) + bit; + *start = result + 1; + return result; + } + + i = (w + 1) << 6; + } +} diff --git a/bitset.h b/bitset.h new file mode 100644 index 0000000..2050aeb --- /dev/null +++ b/bitset.h @@ -0,0 +1,54 @@ +#ifndef BITSET_H +#define BITSET_H + +#include +#include +#include + +typedef struct bitset bitset_t; + +bitset_t *bitset_alloc(void); + +void bitset_free(bitset_t *bs); + +/* Ensure it can represent numbers up to at least 'maxbit'. */ +void bitset_reserve(bitset_t *bs, size_t maxbit); + +/* Set the nth bit. */ +void bitset_set(bitset_t *bs, size_t bit); + +/* Clear the nth bit. */ +void bitset_clear(bitset_t *bs, size_t bit); + +/* Test a bit (returns false if out of range). */ +bool bitset_get(const bitset_t *bs, size_t bit); + +/* Count bits set to 1. */ +size_t bitset_count(const bitset_t *bs); + +// TODO check if this is needed +/* bs1 |= bs2 with first 'skip' bits ignored */ +void bitset_union_with_offset(bitset_t *bs1, const bitset_t *bs2, size_t skip); + +/* Shift all bits up by `n` positions (insert n zeros at LSB) */ +void bitset_shift_up(bitset_t *bs, size_t n); + +/* Shift all bits down by `n` positions (discard LSB) */ +void bitset_shift_down(bitset_t *bs, size_t n); + +/* Return highest set bit+1, or 0 if empty. */ +size_t bitset_max(const bitset_t *bs); + +/* Clear all bits. */ +void bitset_reset(bitset_t *bs); + +/* bs1 |= bs2 */ +void bitset_union(bitset_t *bs1, const bitset_t *bs2); + +/* Iterate through set bits: returns next bit >= *start, + or (size_t)-1 if none. Caller sets *start = 0 to begin. */ +size_t bitset_next(const bitset_t *bs, size_t *start); + +/* dump the contents of a bitset to the console */ +void bitset_dump(const bitset_t *it); +#endif diff --git a/builtins.c b/builtins.c new file mode 100644 index 0000000..94e28b7 --- /dev/null +++ b/builtins.c @@ -0,0 +1,82 @@ +#include +#include +#include "builtins.h" +#include "util.h" + +#define BUILTINS_BUCKETS 128 // Enough for ~100 builtins at <0.8 load factor + +typedef struct { + intern_t key; // NULL = empty slot + builtin_func_t *func; +} builtin_slot_t; + +struct builtins { + size_t size; // number of stored entries + builtin_slot_t *slots; +}; + +/* Simple pointer hash for interned strings */ +static inline size_t hash_ptr(intern_t p) { + return ((size_t)p) >> 3; +} + +builtins_t *builtins_alloc(void) { + builtins_t *b = malloc(sizeof(*b)); + if (b == NULL) + die("Out of memory: cannot allocate builtins table"); + + b->size = 0; + b->slots = calloc(BUILTINS_BUCKETS, sizeof(builtin_slot_t)); + if (!b->slots) { + free(b); + return NULL; + } + + return b; +} + +builtins_t *builtins_add(builtins_t *b, intern_t name, builtin_func_t *func) { + if (b == NULL) return NULL; + + size_t idx = hash_ptr(name) % BUILTINS_BUCKETS; + + while (1) { + if (b->slots[idx].key == NULL) { + // empty slot → insert + b->slots[idx].key = name; + b->slots[idx].func = func; + b->size++; + return b; + } else if (b->slots[idx].key == name) { + // existing key → replace + b->slots[idx].func = func; + return b; + } + + // linear probe + idx = (idx + 1) % BUILTINS_BUCKETS; + } +} + +builtin_func_t *builtins_lookup(builtins_t *b, intern_t name) { + if (b == NULL) return NULL; + + size_t idx = hash_ptr(name) % BUILTINS_BUCKETS; + + while (1) { + if (b->slots[idx].key == NULL) { + // empty → not found + return NULL; + } else if (b->slots[idx].key == name) { + return b->slots[idx].func; + } + + idx = (idx + 1) % BUILTINS_BUCKETS; + } +} + +void builtins_free(builtins_t *b) { + if (b == NULL) return; + free(b->slots); + free(b); +} diff --git a/builtins.h b/builtins.h new file mode 100644 index 0000000..c298b12 --- /dev/null +++ b/builtins.h @@ -0,0 +1,20 @@ +#ifndef BUILTINS_H +#define BUILTINS_H + +#include "intern.h" +typedef struct value value_t; +typedef struct gc gc_t; +typedef value_t *builtin_func_t(gc_t *, value_t **args, size_t num_args); + +typedef struct builtins builtins_t; + +builtins_t *builtins_alloc(void); + +builtins_t *builtins_add(builtins_t *, intern_t name, builtin_func_t *func); + +builtin_func_t *builtins_lookup(builtins_t *, intern_t); + +void builtins_free(builtins_t *); + + +#endif \ No newline at end of file diff --git a/env.c b/env.c new file mode 100644 index 0000000..8df7d2e --- /dev/null +++ b/env.c @@ -0,0 +1,77 @@ +#include "env.h" + +#include "bitset.h" +#include "util.h" +#include "value.h" +#include +#include +#include +#include + +struct env { + value_t **vals; // array of captured values + size_t offset; // first index in De Bruijn space + size_t length; // number of slots (offset .. last set bit) +}; + +void env_free(env_t *caps) { + free(caps->vals); + free(caps); +} + +void env_mark_values(env_t *caps) { + if (caps == NULL) return; + for (size_t i = 0; i < caps->length; i++) { + if (caps->vals[i] != NULL) value_mark_gc(caps->vals[i]); + } +} + +value_t *env_lookup(env_t *env, de_bruijn_t index) { + if (env != NULL && index < env->length) + return env->vals[index]; + else + return NULL; +} + +/* ---------------- Capturing variables ---------------- */ + +env_t *env_capture(env_t *env, value_t **locals, size_t as_frame, size_t as_top, bitset_t *used) { + //printf("BITS:"); + //bitset_dump(used); + size_t start = 0; + size_t first = bitset_next(used, &start); + if (first == (size_t)-1) return NULL; // empty capture + + size_t last = bitset_max(used); + size_t length = last - first + 1; + //printf("first: %zu, last: %zu, length: %zu\n", first,last,length); + env_t *caps = malloc(sizeof(env_t)); + if (caps == NULL) + die("Out of memory: can't allocate captures"); + caps->offset = first; + caps->length = length; + caps->vals = calloc(length, sizeof(value_t*)); // NULL slots by default + if (caps->vals == NULL) + die("Out of memory: can't allocate captures array"); + + start = first; + size_t bit; + while ((bit = bitset_next(used, &start)) != (size_t)-1 && bit <= last) { + value_t *val = (bit >= as_frame) ? + env_lookup(env, bit - as_frame) : + locals[as_top - 1 - bit]; + caps->vals[bit - first] = val; + } + + return caps; +} + + +void env_debug_dump(env_t *env) { + for (int i = 0; i < env->length; i++) { + if (env->vals[i]) { + value_debug_dump(env->vals[i]); + printf("%zu:", i + env->offset); + } + } +} \ No newline at end of file diff --git a/env.h b/env.h new file mode 100644 index 0000000..f4acc43 --- /dev/null +++ b/env.h @@ -0,0 +1,19 @@ +#ifndef env_h +#define env_h + +#include "bitset.h" +#include "scope.h" + +typedef struct captures captures_t; +typedef struct env env_t; +typedef struct value value_t; + +env_t *env_capture(env_t *env, value_t **locals, size_t as_frame, size_t as_top, bitset_t *used); +void env_free(env_t *env); + +value_t *env_lookup(env_t *env, de_bruijn_t index); +void env_mark_values(env_t *env); + +void env_debug_dump(env_t *env); + +#endif \ No newline at end of file diff --git a/eval.c b/eval.c new file mode 100644 index 0000000..577a05d --- /dev/null +++ b/eval.c @@ -0,0 +1,387 @@ +#include "eval.h" +#include "builtins.h" +#include "env.h" +#include "syntax.h" +#include "util.h" +#include "value.h" +#include +#include +#include + + + +typedef union amb_ptr { + expr_t *unevaled; + value_t *evaled; +} amb_ptr; + +// this struct must have a compatible +// memory layout to struct expr. +typedef struct { + enum { + FRAME_CALL_ARGS, + FRAME_CALL_CALLEE, + FRAME_ALT, + FRAME_SEQ, + FRAME_LET, + FRAME_ENV + } tag; + source_t *source; + pos_t pos; + union { + struct { + expr_t **arguments; + size_t nargs; + } call_callee; + struct { + expr_t **arguments; + size_t nargs; + size_t arg_base; + } call_args; + struct { + expr_t *orelse; + } alt; + struct { + expr_t *after; + } seq; + struct { + pattern_t pattern; + expr_t *in; + } let_binding; + struct { + size_t locals_top; + size_t locals_frame; + env_t *captures; + } env; + } as; +} frame_t; +typedef enum { + MODE_EVAL, MODE_RETURN +} eval_mode_t; + +void _frame_debug_dump(frame_t *it) { + switch (it->tag) { + case FRAME_ALT: + printf("ALT("); + syntax_dump_expr(it->as.alt.orelse); + printf(")"); + break; + case FRAME_SEQ: + printf("SEQ("); + syntax_dump_expr(it->as.seq.after); + printf(")"); + break; + case FRAME_ENV: + printf("ENV .."); + break; + case FRAME_LET: + printf("LET"); + break; + case FRAME_CALL_ARGS: + printf("CA"); + break; + case FRAME_CALL_CALLEE: + printf("CC"); + break; + } +} +static inline size_t stack_bump(frame_t **stack, size_t stack_size, size_t stack_capacity) { + if (stack_size == stack_capacity) { + stack_capacity *= 2; + *stack = realloc(*stack, stack_capacity); + if (*stack == NULL) + die("Out of memory: cannot enlarge stack"); + } + return stack_capacity; +} + +static inline size_t arg_stack_bump(value_t ***stack, size_t stack_size, size_t stack_capacity) { + if (stack_size == stack_capacity) { + stack_capacity *= 2; + *stack = realloc(*stack, stack_capacity); + if (*stack == NULL) + die("Out of memory: cannot enlarge arg stack"); + } + return stack_capacity; +} + +value_t *eval(expr_t *expr, gc_t *gc) { + + frame_t *stack = malloc(sizeof(frame_t) * 32); + if (stack == NULL) + die("Out of memory: cannot allocate control stack"); + value_t** locals = malloc(sizeof(value_t *) * 64); + if (locals == NULL) + die("Out of memory: cannot allocate locals stack"); + value_t** arguments = malloc(sizeof(value_t *) * 64); + if (arguments == NULL) + die("Out of memory: cannot allocate arguments stack"); + + size_t stack_size = 0; + size_t stack_capacity = 32; + size_t locals_capacity = 64; + size_t locals_frame = 0; + size_t locals_size = 0; + + size_t arguments_capacity = 64; + size_t arguments_size = 0; + + eval_mode_t mode = MODE_EVAL; + amb_ptr focus; + focus.unevaled = expr; + env_t *env = NULL; + while (!(mode == MODE_RETURN && stack_size == 0)) { + /* debugging code: + for (int i = 0; i < stack_size; i++) { + _frame_debug_dump(stack + i); + if (i < stack_size - 1) + printf(", "); + } + printf(" | "); + for (int i = 0; i < locals_size; i++) { + if (i == locals_size - locals_frame - 1) { + printf("["); + } + value_debug_dump(locals[i]); + if (i == locals_size - locals_frame - 1) { + printf("]"); + } + if (i < locals_size - 1) + printf(", "); + } + printf("{"); + if (env) {env_debug_dump(env);}; + printf("}"); + printf(" | "); + for (int i = 0; i < arguments_size; i++) { + value_debug_dump(arguments[i]); + if (i < stack_size - 1) + printf(", "); + } + if (mode == MODE_EVAL) { + printf(" > "); + syntax_dump_expr(focus.unevaled); + printf("\n"); + } else { + printf(" < "); + value_debug_dump(focus.evaled); + printf("\n"); + } + */ + switch (mode) { + case MODE_EVAL: switch (focus.unevaled->tag) { + case EXPR_VAR: { + value_t *val = (focus.unevaled->as.var >= locals_frame) ? + env_lookup(env, focus.unevaled->as.var - locals_frame) : + locals[locals_size - 1 - focus.unevaled->as.var]; + mode = MODE_RETURN; + focus.evaled = val; + break; + } + case EXPR_BUILTIN: { + builtin_func_t *func = focus.unevaled->as.builtin; + value_t * val = value_alloc(gc); + val->tag = VALUE_BUILTIN; + val->as.builtin = func; + focus.evaled = val; + mode = MODE_RETURN; + break; + } + case EXPR_INT_LIT: { + value_t * val = value_alloc(gc); + val->tag = VALUE_INT; + val->as.integer = focus.unevaled->as.int_lit; + focus.evaled = val; + mode = MODE_RETURN; + break; + } + case EXPR_FLOAT_LIT: { + value_t * val = value_alloc(gc); + val->tag = VALUE_FLOAT; + val->as.floating = focus.unevaled->as.float_lit; + focus.evaled = val; + mode = MODE_RETURN; + break; + } + case EXPR_STRING_LIT: { + value_t * val = value_alloc(gc); + val->tag = VALUE_STRING; + val->as.string.string = focus.unevaled->as.string_lit; + val->as.string.shared = true; + focus.evaled = val; + mode = MODE_RETURN; + break; + } + case EXPR_CONSTRUCTOR: { + value_t *val = value_alloc(gc); + val->tag = VALUE_CONSTRUCTOR; + val->as.constructor.args = NULL; + val->as.constructor.num_args = 0; + val->as.constructor.name = focus.unevaled->as.constructor; + focus.evaled = val; + mode = MODE_RETURN; + break; + } + case EXPR_LAMBDA_COMPILED: { + value_t *val = value_alloc(gc); + val->tag = VALUE_CLOSURE; + val->as.closure.body = focus.unevaled->as.lambda.body; + val->as.closure.arity = focus.unevaled->as.lambda.args; + val->as.closure.captured = env_capture(env, locals, locals_frame,locals_size, focus.unevaled->as.lambda.mask); + focus.evaled = val; + mode = MODE_RETURN; + break; + } + case EXPR_ALT: + stack_capacity = stack_bump(&stack, stack_size, stack_capacity); + stack[stack_size].as.alt.orelse = focus.unevaled->as.alt.orelse; + stack[stack_size].tag = FRAME_ALT; + stack_size++; + focus.unevaled = focus.unevaled->as.alt.try; + break; + case EXPR_SEQ: + stack_capacity = stack_bump(&stack, stack_size, stack_capacity); + stack[stack_size].as.seq.after = focus.unevaled->as.seq.then; + stack[stack_size].tag = FRAME_SEQ; + focus.unevaled = focus.unevaled->as.seq.first; + stack_size++; + break; + case EXPR_CALL: + stack_capacity = stack_bump(&stack, stack_size, stack_capacity); + stack[stack_size].as.call_callee.arguments = focus.unevaled->as.call.arguments; + stack[stack_size].as.call_callee.nargs = focus.unevaled->as.call.nargs; + stack[stack_size].tag = FRAME_CALL_CALLEE; + stack_size++; + focus.unevaled = focus.unevaled->as.call.callee; + break; + case EXPR_LET_BINDING: + stack_capacity = stack_bump(&stack, stack_size, stack_capacity); + stack[stack_size].as.let_binding.in = focus.unevaled->as.let_binding.in; + stack[stack_size].as.let_binding.pattern = focus.unevaled->as.let_binding.pattern; + stack[stack_size].tag = FRAME_LET; + stack_size++; + focus.unevaled = focus.unevaled->as.let_binding.expr; + break; + case EXPR_PAT_IDENT: + case EXPR_LAMBDA: + die("Impossible: uncompiled expression found while evaluating"); + } + break; + case MODE_RETURN: switch (stack[--stack_size].tag) { + case FRAME_ENV: + env = stack[stack_size].as.env.captures; + locals_frame = stack[stack_size].as.env.locals_frame; + locals_size = stack[stack_size].as.env.locals_top; + break; + case FRAME_ALT: + if (focus.evaled == NULL) { + focus.unevaled = stack[stack_size].as.alt.orelse; + mode = MODE_EVAL; + } + break; + case FRAME_SEQ: + if (focus.evaled != NULL) { + focus.unevaled = stack[stack_size].as.seq.after; + mode = MODE_EVAL; + } + break; + case FRAME_LET: { + locals_capacity = arg_stack_bump(&locals, locals_size, locals_capacity); + locals[locals_size] = focus.evaled; + locals_size++; + locals_frame++; + focus.unevaled = stack[stack_size].as.let_binding.in; + mode = MODE_EVAL; + if (stack_size > 0 && stack[stack_size-1].tag != FRAME_ENV || stack_size == 0) { + stack[stack_size].tag = FRAME_ENV; + stack[stack_size].as.env.captures = env; + stack[stack_size].as.env.locals_top = locals_size - 1; + stack[stack_size].as.env.locals_frame = locals_frame; + stack_size++; + } + break; + } + case FRAME_CALL_CALLEE: { + expr_t ** args = stack[stack_size].as.call_callee.arguments; + size_t nargs = stack[stack_size].as.call_callee.nargs; + stack[stack_size].tag = FRAME_CALL_ARGS; + stack[stack_size].as.call_args.arg_base = arguments_size; + stack[stack_size].as.call_args.arguments = args; + stack[stack_size].as.call_args.nargs = nargs; + // fall through + } + case FRAME_CALL_ARGS: { + arguments_capacity = arg_stack_bump(&arguments, arguments_size, arguments_capacity); + arguments[arguments_size] = focus.evaled; + arguments_size++; + if (stack[stack_size].as.call_args.nargs > 0) { + focus.unevaled = stack[stack_size].as.call_args.arguments[0]; + stack[stack_size].as.call_args.nargs--; + stack[stack_size].as.call_args.arguments++; + mode = MODE_EVAL; + stack_size++; + } else { + value_t *callee = arguments[stack[stack_size].as.call_args.arg_base]; + size_t num_args = arguments_size - stack[stack_size].as.call_args.arg_base - 1; + value_t **args_start = arguments + stack[stack_size].as.call_args.arg_base + 1; + arguments_size = stack[stack_size].as.call_args.arg_base; + if (callee == NULL) { + focus.evaled = NULL; + } else switch (callee->tag) { + case VALUE_BUILTIN: + focus.evaled = callee->as.builtin(gc,args_start, num_args); + break; + case VALUE_CLOSURE: + if (callee->as.closure.arity == num_args) { + if (stack_size > 0 && stack[stack_size-1].tag != FRAME_ENV || stack_size == 0) { + stack[stack_size].as.env.captures = env; + stack[stack_size].as.env.locals_frame = locals_frame; + stack[stack_size].as.env.locals_top = locals_size; + stack[stack_size].tag = FRAME_ENV; + stack_size++; + } + env = callee->as.closure.captured; + locals_frame = num_args; + locals_capacity = arg_stack_bump(&locals, locals_size + num_args, locals_capacity); + memcpy(locals + locals_size, args_start, sizeof(value_t*) * num_args); + locals_size += num_args; + focus.unevaled = callee->as.closure.body; + mode = MODE_EVAL; + } else { + focus.evaled = NULL; + } + break; + case VALUE_CONSTRUCTOR: + if (callee->as.constructor.args == NULL) { + value_t *val = value_alloc(gc); + val->tag = VALUE_CONSTRUCTOR; + val->as.constructor.args = malloc(sizeof(value_t*) * num_args); + if (val->as.constructor.args == NULL) { + die("Out of memory, can't allocate args buffer"); + } + memcpy(val->as.constructor.args,args_start, sizeof(value_t*) * num_args); + val->as.constructor.num_args = num_args; + val->as.constructor.name = callee->as.constructor.name; + focus.evaled = val; + break; + } + //fall through + case VALUE_INT: + case VALUE_FLOAT: + case VALUE_STRING: + case VALUE_CONS: + focus.evaled = NULL; + } + } + break; + } + } + break; + } + } + free(arguments); + free(locals); + free(stack); + return focus.evaled; +} + diff --git a/eval.h b/eval.h new file mode 100644 index 0000000..81ddbed --- /dev/null +++ b/eval.h @@ -0,0 +1,7 @@ +#ifndef eval_h +#define eval_h +#include "value.h" + +value_t *eval(expr_t *expr, gc_t *gc); + +#endif \ No newline at end of file diff --git a/lexer.c b/lexer.c index e15654f..df14df4 100644 --- a/lexer.c +++ b/lexer.c @@ -59,6 +59,8 @@ token_t lexer_lex(lexer_t* lexer) { switch (*current) { case '(': tok.type = TOKEN_LPAREN; return tok; case ')': tok.type = TOKEN_RPAREN; return tok; + case '{': tok.type = TOKEN_LBRACE; return tok; + case '}': tok.type = TOKEN_RBRACE; return tok; case ':': if (*(current+1) == '=') { tok.type = TOKEN_ASSIGN; tok.len = 2; @@ -68,11 +70,60 @@ token_t lexer_lex(lexer_t* lexer) { tok.type = TOKEN_COLON; return tok; } + case '>': if (*(current+1) == '=') { + tok.type = TOKEN_GREATEREQ; + tok.len = 2; + lexer->cur_pos = source_next_pos(lexer->source, lexer->cur_pos); + return tok; + } else { + tok.type = TOKEN_GREATER; + return tok; + } + case '<': if (*(current+1) == '=') { + tok.type = TOKEN_LESSEQ; + tok.len = 2; + lexer->cur_pos = source_next_pos(lexer->source, lexer->cur_pos); + return tok; + } else { + tok.type = TOKEN_LESS; + return tok; + } + case '/': if (*(current+1) == '=') { + tok.type = TOKEN_NOTEQ; + tok.len = 2; + lexer->cur_pos = source_next_pos(lexer->source, lexer->cur_pos); + return tok; + } else { + tok.type = TOKEN_DIV; + return tok; + } + if (*(current+1) == '=') { + tok.type = TOKEN_NOTEQ; + tok.len = 2; + lexer->cur_pos = source_next_pos(lexer->source, lexer->cur_pos); + return tok; + } else { + tok.type = TOKEN_DIV; + return tok; + } + case '|': tok.type = TOKEN_PIPE; return tok; case ',': tok.type = TOKEN_COMMA; return tok; case ';': tok.type = TOKEN_SEMI; return tok; - case '.': if (isalnum(*(current+1))) { + case '-': if (isdigit(*(current+1))) { current++; - while (isalnum(*current)) { + tok.len++; + lexer->cur_pos = source_next_pos(lexer->source, lexer->cur_pos); + break; + } else { + tok.type = TOKEN_MINUS; return tok; + } + case '+': tok.type = TOKEN_PLUS; return tok; + case '=': tok.type = TOKEN_EQ; return tok; + case '^': tok.type = TOKEN_EXP; return tok; + case '*': tok.type = TOKEN_MULT; return tok; + case '.': if (isalnum(*(current+1)) || *(current+1) == '_') { + current++; + while (isalnum(*current) || *current == '_') { tok.len++; current++; lexer->cur_pos = source_next_pos(lexer->source, lexer->cur_pos); @@ -104,19 +155,46 @@ token_t lexer_lex(lexer_t* lexer) { } if (isdigit(*current)) { current++; - while (isdigit(*current)) { + bool dot_seen = false; + bool e_seen = false; + tok.type = TOKEN_INT_LIT; + while (isdigit(*current) + || !dot_seen && *current == '.' + || !e_seen && *current == 'E' + || !e_seen && *current == 'e') { + if (*current == '.') { + dot_seen = true; + tok.type = TOKEN_FLOAT_LIT; + } + if (*current == 'e' || *current == 'E') { + e_seen = true; + tok.type = TOKEN_FLOAT_LIT; + } current++; tok.len++; lexer->cur_pos = source_next_pos(lexer->source, lexer->cur_pos); } - tok.type = TOKEN_INT_LIT; + return tok; - } else if (isalpha(*current)) { + } else if (isalpha(*current) || *current == '_') { current++; - while (isalnum(*current)) { + while (isalnum(*current) || *current == '_') { current++; tok.len++; lexer->cur_pos = source_next_pos(lexer->source, lexer->cur_pos); } - tok.type = TOKEN_IDENT; + if (tok.len == 2 && starts_with_any(tok.start,"if")) + tok.type = TOKEN_IF; + else if (tok.len == 3 && starts_with_any(tok.start,"and")) + tok.type = TOKEN_AND; + else if (tok.len == 3 && starts_with_any(tok.start,"not")) + tok.type = TOKEN_NOT; + else if (tok.len == 3 && starts_with_any(tok.start,"mod")) + tok.type = TOKEN_MOD; + else if (tok.len == 3 && starts_with_any(tok.start,"div")) + tok.type = TOKEN_IDIV; + else if (tok.len == 2 && starts_with_any(tok.start,"or")) + tok.type = TOKEN_OR; + else + tok.type = TOKEN_IDENT; return tok; } @@ -131,6 +209,7 @@ token_t lexer_lex(lexer_t* lexer) { token_t lexer_peek(lexer_t* lexer) { pos_t pos = lexer->cur_pos; token_t tok = lexer_lex(lexer); + printf("%s\n",lexer_token_type_to_string(tok)); lexer->cur_pos = pos; return tok; } @@ -143,11 +222,32 @@ const char* lexer_token_type_to_string(token_t to_print) { switch (to_print.type) { enum_case_str(TOKEN_LPAREN); enum_case_str(TOKEN_RPAREN); + enum_case_str(TOKEN_LBRACE); + enum_case_str(TOKEN_RBRACE); enum_case_str(TOKEN_STRING_LIT); enum_case_str(TOKEN_INT_LIT); + enum_case_str(TOKEN_FLOAT_LIT); enum_case_str(TOKEN_IDENT); enum_case_str(TOKEN_ASSIGN); enum_case_str(TOKEN_SEMI); + enum_case_str(TOKEN_PIPE); + enum_case_str(TOKEN_IF); + enum_case_str(TOKEN_AND); + enum_case_str(TOKEN_OR); + enum_case_str(TOKEN_NOT); + enum_case_str(TOKEN_MULT); + enum_case_str(TOKEN_PLUS); + enum_case_str(TOKEN_EXP); + enum_case_str(TOKEN_MINUS); + enum_case_str(TOKEN_DIV); + enum_case_str(TOKEN_IDIV); + enum_case_str(TOKEN_EQ); + enum_case_str(TOKEN_NOTEQ); + enum_case_str(TOKEN_MOD); + enum_case_str(TOKEN_LESSEQ); + enum_case_str(TOKEN_GREATEREQ); + enum_case_str(TOKEN_LESS); + enum_case_str(TOKEN_GREATER); enum_case_str(TOKEN_COMMA); enum_case_str(TOKEN_COLON); enum_case_str(TOKEN_CONSTRUCTOR); diff --git a/lexer.h b/lexer.h index 6904055..21b49ea 100644 --- a/lexer.h +++ b/lexer.h @@ -8,11 +8,32 @@ typedef enum { TOKEN_RPAREN, TOKEN_STRING_LIT, TOKEN_INT_LIT, + TOKEN_FLOAT_LIT, + TOKEN_LBRACE, + TOKEN_RBRACE, TOKEN_IDENT, TOKEN_CONSTRUCTOR, TOKEN_ASSIGN, + TOKEN_IF, + TOKEN_AND, + TOKEN_OR, + TOKEN_NOT, + TOKEN_EQ, + TOKEN_NOTEQ, + TOKEN_LESS, + TOKEN_GREATER, + TOKEN_LESSEQ, + TOKEN_GREATEREQ, + TOKEN_PLUS, + TOKEN_MINUS, + TOKEN_MULT, + TOKEN_MOD, + TOKEN_DIV, + TOKEN_IDIV, + TOKEN_EXP, TOKEN_SEMI, TOKEN_COMMA, + TOKEN_PIPE, TOKEN_COLON, TOKEN_UNRECOGNISED, TOKEN_EOF diff --git a/main.c b/main.c index 2e11be1..b9d4550 100644 --- a/main.c +++ b/main.c @@ -1,4 +1,7 @@ +#include "bitset.h" +#include "builtins.h" #include "error.h" +#include "eval.h" #include "intern.h" #include "lexer.h" #include "scope.h" @@ -6,18 +9,31 @@ #include "stdio.h" #include "syntax.h" #include "error.h" +#include "value.h" + +value_t *test(gc_t *gc, value_t **args, size_t num_args) { + if (num_args != 2 || args[0]->tag != VALUE_INT || args[1]->tag != VALUE_INT) + return NULL; + long result = args[0]->as.integer + args[1]->as.integer; + value_t *ret = value_alloc(gc); + ret->tag = VALUE_INT; + ret->as.integer = result; + return ret; +} int main(int argc, char**argv) { source_t *source = source_alloc_from_file("test.hito"); lexer_t *lexer = lexer_alloc(source); token_t tok; intern_table_t *table = intern_table_alloc(); - expr_t *expr = syntax_parse_expr(lexer, table); + builtins_t *builtins = builtins_alloc(); + builtins_add(builtins, intern(table,"prim_test"),test); + expr_t *expr = syntax_parse_expr(lexer, builtins, table); printf("%p\n", expr); if (expr == NULL) return 1; syntax_dump_expr(expr); printf("\n"); - scope_t *scope = scope_alloc(); - syntax_scope_check_expr(expr, scope); - syntax_dump_expr(expr); + gc_t *gc = gc_alloc(); + value_t *v = eval(expr, gc); + value_debug_dump(v); printf("\n"); } \ No newline at end of file diff --git a/scope.c b/scope.c index f534a78..de8b86d 100644 --- a/scope.c +++ b/scope.c @@ -1,5 +1,6 @@ #include "scope.h" #include +#include #include "util.h" struct scope { intern_t *data; @@ -47,4 +48,10 @@ de_bruijn_t scope_lookup(scope_t *scope, intern_t identifier) { /* caller should decide what happens for "not found" */ return (de_bruijn_t)-1; +} + +void scope_debug_dump(scope_t *scope) { + for (size_t i = 0; i < scope->size; i++) + printf("%s, ", scope->data[i]); + printf("|-"); } \ No newline at end of file diff --git a/scope.h b/scope.h index abf503e..c0f9647 100644 --- a/scope.h +++ b/scope.h @@ -12,4 +12,5 @@ void scope_push(scope_t *scope, intern_t identifier); void scope_pop(scope_t *scope, size_t amount); void scope_free(scope_t *scope); de_bruijn_t scope_lookup(scope_t *scope, intern_t identifier); +void scope_debug_dump(scope_t *scope); #endif \ No newline at end of file diff --git a/syntax.c b/syntax.c index 041d1c8..dae59d2 100644 --- a/syntax.c +++ b/syntax.c @@ -1,9 +1,12 @@ #include "syntax.h" +#include "bitset.h" +#include "builtins.h" #include "error.h" #include "lexer.h" #include "scope.h" #include "util.h" #include "intern.h" +#include "value.h" #include #include #include @@ -19,6 +22,7 @@ static bool _expect(lexer_t *lexer, token_type expected, error_tag on_failure) { return true; } } + static expr_t *_alloc_expr(void) { expr_t *ptr = malloc(sizeof(struct expr)); if (ptr == NULL) { @@ -27,62 +31,145 @@ static expr_t *_alloc_expr(void) { return ptr; } -char *syntax_parse_string_literal(const char *input) { - if (!input || *input != '"') { - die("Provided string is not a string literal"); - } - const char *p = input + 1; // skip opening quote - size_t capacity = 16; - size_t length = 0; - char *result = malloc(capacity); - if (result == NULL) { - die("Cannot allocate space for string literal"); - } +static char *_parse_string_literal(const char *input) { + if (!input || *input != '"') { + die("Provided string is not a string literal"); + } + const char *p = input + 1; // skip opening quote + size_t capacity = 16; + size_t length = 0; + char *result = malloc(capacity); + if (result == NULL) { + die("Out of memory: Cannot allocate space for string literal"); + } - while (*p != '\0' && *p != '"') { - char c = *p++; - if (c == '\\') { - if (!*p) break; // unterminated escape - char esc = *p++; - switch (esc) { - case 'n': c = '\n'; break; - case 't': c = '\t'; break; - case 'r': c = '\r'; break; - case '\\': c = '\\'; break; - case '"': c = '"'; break; - case '\'': c = '\''; break; - default: c = esc; break; - } - } - if (length + 1 >= capacity) { - capacity *= 2; - char *tmp = realloc(result, capacity); - if (tmp == NULL) { - die("Cannot enlarge space for string literal"); - } - result = tmp; - } - result[length++] = c; + while (*p != '\0' && *p != '"') { + char c = *p++; + if (c == '\\') { + if (!*p) break; // unterminated escape + char esc = *p++; + switch (esc) { + case 'n': c = '\n'; break; + case 't': c = '\t'; break; + case 'r': c = '\r'; break; + case '\\': c = '\\'; break; + case '"': c = '"'; break; + case '\'': c = '\''; break; + default: c = esc; break; + } } - if (*p != '"') { - die("The impossible happened"); + if (length + 1 >= capacity) { + capacity *= 2; + char *tmp = realloc(result, capacity); + if (tmp == NULL) { + die("Out of memory: Cannot enlarge space for string literal"); + } + result = tmp; } + result[length++] = c; + } + if (*p != '"') { + die("The impossible happened"); + } - result[length] = '\0'; // null-terminate - return result; + result[length] = '\0'; // null-terminate + return result; } -expr_t *syntax_parse_atom(lexer_t *lexer, intern_table_t *table) { - token_t tok = lexer_peek(lexer); +static expr_t *_parse_expr(lexer_t *lexer, intern_table_t *table); +static expr_t *_parse_atom(lexer_t *lexer, intern_table_t *table) { + token_t tok = lexer_peek(lexer); switch (tok.type) { case TOKEN_LPAREN: { - lexer_lex(lexer); - expr_t *inner = syntax_parse_expr(lexer, table); - if (inner == NULL) - return NULL; - if (!_expect(lexer,TOKEN_RPAREN,ERROR_EXPECTED_RPAREN)) + lexer_lex(lexer); + + expr_t *first_expr = _parse_expr(lexer, table); + token_t next_tok = lexer_peek(lexer); + + if (first_expr == NULL) { + if (next_tok.type == TOKEN_RPAREN) { + error_report(error(ERROR_EXPECTED_EXPRESSION, lexer_source(lexer), next_tok.pos, 1)); + + lexer_lex(lexer); // Consume ')' + return NULL; + } + return NULL; + } + + if (next_tok.type != TOKEN_COMMA) { + // Single element parenthesized expression + if (!_expect(lexer, TOKEN_RPAREN, ERROR_EXPECTED_RPAREN)) { + syntax_expr_free(first_expr); + return NULL; + } + return first_expr; + } + + // Multi-element tuple + lexer_lex(lexer); // consume the first ',' + + size_t cap = 4; + size_t nargs = 1; + expr_t **args = malloc(cap * sizeof(expr_t*)); + if (args == NULL) + die("Out of memory: can't allocate args array for tuple"); + + args[0] = first_expr; + + while (1) { + token_t next_arg_tok = lexer_peek(lexer); + expr_t *arg = _parse_expr(lexer, table); + + if (arg == NULL) { + error_report(error(ERROR_EXPECTED_EXPRESSION, lexer_source(lexer), next_arg_tok.pos, 1)); + + for (size_t i = 0; i < nargs; i++) { + syntax_expr_free(args[i]); + } + free(args); + return NULL; + } + + if (nargs == cap) { + cap *= 2; + expr_t **temp_args = realloc(args, cap * sizeof(expr_t*)); + if (temp_args == NULL) + die("Out of memory: can't enlarge args array for tuple"); + args = temp_args; + } + + args[nargs++] = arg; + + token_t post_arg_tok = lexer_peek(lexer); + if (post_arg_tok.type != TOKEN_COMMA) { + break; + } + lexer_lex(lexer); // consume ',' + } + + if (!_expect(lexer, TOKEN_RPAREN, ERROR_EXPECTED_RPAREN)) { + for (size_t i = 0; i < nargs; i++) { + syntax_expr_free(args[i]); + } + free(args); return NULL; - return inner; + } + + if (nargs < cap) { + expr_t **temp_args = realloc(args, nargs * sizeof(expr_t*)); + if (temp_args == NULL) { + die("Out of memory: can't resize args array for tuple"); + } + args = temp_args; + } + + expr_t *tuple = _alloc_expr(); + tuple->pos = tok.pos; + tuple->source = lexer_source(lexer); + tuple->tag = EXPR_TUPLE; + tuple->as.tuple.elements = args; + tuple->as.tuple.nelements = nargs; + return tuple; } case TOKEN_IDENT: { lexer_lex(lexer); @@ -92,7 +179,17 @@ expr_t *syntax_parse_atom(lexer_t *lexer, intern_table_t *table) { it->source = lexer_source(lexer); it->tag = EXPR_PAT_IDENT; it->as.ident = name; - return it; + return it; + } + case TOKEN_FLOAT_LIT: { + lexer_lex(lexer); + double value = strtod(tok.start, NULL); + expr_t *lit = _alloc_expr(); + lit->pos = tok.pos; + lit->source = lexer_source(lexer); + lit->tag = EXPR_FLOAT_LIT; + lit->as.float_lit = value; + return lit; } case TOKEN_INT_LIT: { lexer_lex(lexer); @@ -112,11 +209,11 @@ expr_t *syntax_parse_atom(lexer_t *lexer, intern_table_t *table) { it->source = lexer_source(lexer); it->tag = EXPR_CONSTRUCTOR; it->as.ident = name; - return it; + return it; } case TOKEN_STRING_LIT: { lexer_lex(lexer); - char* contents = syntax_parse_string_literal(tok.start); + char* contents = _parse_string_literal(tok.start); expr_t *lit = _alloc_expr(); lit->pos = tok.pos; lit->source = lexer_source(lexer); @@ -127,124 +224,294 @@ expr_t *syntax_parse_atom(lexer_t *lexer, intern_table_t *table) { default: return NULL; } } -expr_t *syntax_parse_call_expr(lexer_t *lexer, intern_table_t *table) { - expr_t *lhs; - expr_t *rhs; - expr_t *in; - lhs = syntax_parse_atom(lexer, table); - if (lhs == NULL) - return NULL; - while (1) { - rhs = syntax_parse_atom(lexer, table); - if (rhs == NULL) { - return lhs; - } else { - in = _alloc_expr(); - in->pos = lhs->pos; - in->source = lexer_source(lexer); - in->tag = EXPR_CALL; - in->as.call.callee = lhs; - in->as.call.argument = rhs; - lhs = in; + +static expr_t *_parse_call_expr(lexer_t *lexer, intern_table_t *table) { + expr_t *lhs = _parse_atom(lexer, table); + if (lhs == NULL) return NULL; + + // Loop to handle chained calls like f(a)(b) + // If we see '(', we treat 'lhs' as the callee, parse arguments, + // update 'lhs' to the new call node, and repeat. + while (lexer_peek(lexer).type == TOKEN_LPAREN) { + lexer_lex(lexer); // consume '(' + + size_t cap = 4; + size_t nargs = 0; + expr_t **args = malloc(cap * sizeof(expr_t*)); + if (args == NULL) die("Out of memory: can't allocate args array"); + + // Zero-argument functions do not exist, so we unconditionally expect arguments. + while (1) { + pos_t arg_start_pos = lexer_cur_pos(lexer); + // Use _parse_expr here to allow complex args like f(a + b) + expr_t *arg = _parse_expr(lexer, table); + + if (arg == NULL) { + // Error: Expected an expression argument + error_report(error(ERROR_EXPECTED_EXPRESSION, lexer_source(lexer), arg_start_pos, 1)); + + // Cleanup + for (size_t i = 0; i < nargs; i++) { + syntax_expr_free(args[i]); + } + free(args); + syntax_expr_free(lhs); + return NULL; + } + + if (nargs == cap) { + cap *= 2; + args = realloc(args, cap * sizeof(expr_t*)); + if (args == NULL) + die("Out of memory: can't enlarge args array"); + } + + args[nargs++] = arg; + + // If we see a comma, consume it and continue to next arg + if (lexer_peek(lexer).type == TOKEN_COMMA) { + lexer_lex(lexer); + continue; + } + + // If no comma, we expect the closing parenthesis + break; + } + + if (!_expect(lexer, TOKEN_RPAREN, ERROR_EXPECTED_RPAREN)) { + // Cleanup + for (size_t i = 0; i < nargs; i++) { + syntax_expr_free(args[i]); + } + free(args); + syntax_expr_free(lhs); + return NULL; } + // _expect consumes ')' on success + + // shrink array to exact size + args = realloc(args, nargs * sizeof(expr_t*)); + if (args == NULL) + die("Out of memory: can't resize args array"); + + // build n-ary call node + expr_t *call = _alloc_expr(); + call->pos = lhs->pos; + call->source = lexer_source(lexer); + call->tag = EXPR_CALL; + call->as.call.callee = lhs; + call->as.call.arguments = args; + call->as.call.nargs = nargs; + + // The result of this call becomes the LHS for the next potential call in the chain + lhs = call; } + + return lhs; } -expr_t *syntax_parse_body_expr(lexer_t *lexer, intern_table_t *table) { - expr_t *lhs; - expr_t *rhs; - expr_t *in; - lhs = syntax_parse_call_expr(lexer, table); - if (lhs == NULL) goto err0; +static expr_t *_parse_sequence_expr(lexer_t *lexer, intern_table_t *table) { token_t tok = lexer_peek(lexer); - if (tok.type == TOKEN_COLON || tok.type == TOKEN_ASSIGN) { + if (tok.type == TOKEN_IF) { lexer_lex(lexer); + expr_t *lhs = _parse_call_expr(lexer, table); + if (lhs == NULL) { + error_report(error(ERROR_EXPECTED_EXPRESSION, lexer_source(lexer), tok.pos, 1)); + } pos_t pos = lexer_cur_pos(lexer); - rhs = syntax_parse_body_expr(lexer, table); + expr_t *rhs = _parse_sequence_expr(lexer, table); if (rhs == NULL) { - error_report(error(ERROR_EXPECTED_EXPRESSION,lexer_source(lexer),pos,1)); - goto err1; + syntax_expr_free(lhs); + error_report(error(ERROR_EXPECTED_EXPRESSION, lexer_source(lexer), pos, 1)); } - if (tok.type == TOKEN_COLON) { - in = _alloc_expr(); - in->pos = tok.pos; - in->source = lexer_source(lexer); - in->tag = EXPR_LAMBDA; - in->as.lambda.pattern = lhs; - in->as.lambda.body = rhs; - return in; - } else { - if (!_expect(lexer,TOKEN_SEMI,ERROR_EXPECTED_SEMI)) goto err2; - pos = lexer_cur_pos(lexer); - in = syntax_parse_body_expr(lexer, table); - if (in == NULL) { - error_report(error(ERROR_EXPECTED_EXPRESSION,lexer_source(lexer),pos,1)); - goto err2; - } - expr_t *ret = _alloc_expr(); - ret->pos = tok.pos; - ret->source = lexer_source(lexer); - ret->tag = EXPR_LET_BINDING; - ret->as.let_binding.pattern = lhs; - ret->as.let_binding.expr = rhs; - ret->as.let_binding.in = in; - return ret; + + expr_t *sequence = _alloc_expr(); + sequence->tag = EXPR_SEQ; + sequence->pos = lhs->pos; + sequence->source = lhs->source; + sequence->as.seq.first = lhs; + sequence->as.seq.then = rhs; + return sequence; + } + expr_t *lhs = _parse_call_expr(lexer, table); + if (lhs == NULL) return NULL; + + token_type next_token = lexer_peek(lexer).type; + + if (next_token == TOKEN_ASSIGN) { + expr_t *pattern = lhs; + lhs = NULL; // Ownership transferred to 'pattern' variable + lexer_lex(lexer); // consume := + pos_t value_pos = lexer_cur_pos(lexer); + + expr_t *value_expr = _parse_expr(lexer, table); + if (value_expr == NULL) { + error_report(error(ERROR_EXPECTED_EXPRESSION, lexer_source(lexer), value_pos, 1)); + syntax_expr_free(pattern); + return NULL; } - } else return lhs; - - err2: syntax_expr_free(rhs); - err1: syntax_expr_free(lhs); - err0: return NULL; + + if (!_expect(lexer, TOKEN_SEMI, ERROR_EXPECTED_SEMI)) { + syntax_expr_free(value_expr); + syntax_expr_free(pattern); + return NULL; + } + + pos_t body_pos = lexer_cur_pos(lexer); + expr_t *body_expr = _parse_sequence_expr(lexer, table); + if (body_expr == NULL) { + error_report(error(ERROR_EXPECTED_EXPRESSION, lexer_source(lexer), body_pos, 1)); + syntax_expr_free(value_expr); + // Cleanup: Free the pattern node + syntax_expr_free(pattern); + return NULL; + } + + expr_t *let_binding = _alloc_expr(); + let_binding->tag = EXPR_LET_BINDING; + let_binding->pos = pattern->pos; + let_binding->source = pattern->source; + let_binding->as.let_binding.pattern.expr = pattern; + let_binding->as.let_binding.pattern.bound_vars = (size_t)-1; + let_binding->as.let_binding.expr = value_expr; + let_binding->as.let_binding.in = body_expr; + + return let_binding; + } + + + return lhs; } -expr_t *syntax_parse_expr(lexer_t *lexer, intern_table_t *table) { - expr_t *lhs; - expr_t *rhs; - expr_t *in; - lhs = syntax_parse_body_expr(lexer, table); - if (lhs == NULL) goto err0; - token_t tok = lexer_peek(lexer); - if (tok.type == TOKEN_COMMA) { - lexer_lex(lexer); - pos_t pos = lexer_cur_pos(lexer); - rhs = syntax_parse_expr(lexer,table); + +static expr_t *_parse_alt_expr(lexer_t *lexer, intern_table_t *table) { + expr_t *lhs = _parse_sequence_expr(lexer, table); + if (lhs == NULL) return NULL; + + if (lexer_peek(lexer).type == TOKEN_PIPE) { + lexer_lex(lexer); + + pos_t rhs_pos = lexer_cur_pos(lexer); + expr_t *rhs = _parse_alt_expr(lexer, table); if (rhs == NULL) { - error_report(error(ERROR_EXPECTED_EXPRESSION,lexer_source(lexer),pos,1)); - goto err1; + error_report(error(ERROR_EXPECTED_EXPRESSION, lexer_source(lexer), rhs_pos, 1)); + syntax_expr_free(lhs); + return NULL; + } + + expr_t *disjunction = _alloc_expr(); + disjunction->tag = EXPR_ALT; + disjunction->pos = lhs->pos; + disjunction->source = lhs->source; + disjunction->as.alt.try = lhs; + disjunction->as.alt.orelse = rhs; + + return disjunction; + } + + return lhs; +} + +static expr_t *_parse_expr(lexer_t *lexer, intern_table_t *table) { + expr_t *lhs = NULL; + expr_t **params = NULL; + size_t nparams = 0; + + lhs = _parse_alt_expr(lexer, table); + if (lhs == NULL) return NULL; + + token_type next_token = lexer_peek(lexer).type; + + if (next_token == TOKEN_COLON) { + lexer_lex(lexer); + if (lexer_peek(lexer).type == TOKEN_PIPE) { + + lexer_lex(lexer); } - in = _alloc_expr(); - in->pos = tok.pos; - in->source = lexer_source(lexer); - in->tag = EXPR_ALT; - in->as.alt.try = lhs; - in->as.alt.orelse = rhs; - return in; - } else return lhs; + pos_t body_pos = lexer_cur_pos(lexer); - err1: syntax_expr_free(lhs); - err0: return NULL; + if (lhs->tag == EXPR_TUPLE) { + nparams = lhs->as.tuple.nelements; + params = lhs->as.tuple.elements; + + lhs->as.tuple.elements = NULL; + lhs->as.tuple.nelements = 0; + + syntax_expr_free(lhs); + lhs = NULL; + + } else { + nparams = 1; + params = malloc(sizeof(expr_t*)); + if (params == NULL) die("Out of memory: cannot allocate params"); + params[0] = lhs; + lhs = NULL; + } + + expr_t *body = _parse_expr(lexer, table); + if (body == NULL) { + error_report(error(ERROR_EXPECTED_EXPRESSION, lexer_source(lexer), body_pos, 1)); + if (params != NULL) { + for(size_t i=0; itag = EXPR_LAMBDA; + lambda->pos = params[0]->pos; + lambda->source = params[0]->source; + lambda->as.lambda_raw.patterns = params; + lambda->as.lambda_raw.npatterns = nparams; + lambda->as.lambda_raw.body = body; + return lambda; + } + + return lhs; } -size_t syntax_scope_check_pattern(expr_t *it, scope_t *scope) { + + + +static size_t _scope_check_pattern(expr_t *it, scope_t *scope) { switch (it->tag) { case EXPR_ALT: case EXPR_LAMBDA: + case EXPR_LAMBDA_COMPILED: + case EXPR_GROUP: + case EXPR_SEQ: + case EXPR_BUILTIN: case EXPR_LET_BINDING: - case EXPR_VAR: error_report(error(ERROR_INVALID_PATTERN, it->source,it->pos,1)); return (size_t)-1; + case EXPR_VAR: + die("Impossible happened: Found a var node when scope-checking."); + case EXPR_TUPLE: { + size_t i1 = 0; + for (int i = 0; i < it->as.tuple.nelements; i++) { + size_t i2 = _scope_check_pattern(it->as.tuple.elements[i],scope); + if (i2 == (size_t)-1) return i2; + i1 += i2; + } + return i1; + } case EXPR_CALL: { if (it->as.call.callee->tag != EXPR_CALL && it->as.call.callee->tag != EXPR_CONSTRUCTOR) { error_report(error(ERROR_INVALID_PATTERN, it->source,it->pos,1)); return (size_t)-1; } - size_t i1 = syntax_scope_check_pattern(it->as.call.callee, scope); + size_t i1 = _scope_check_pattern(it->as.call.callee, scope); if (i1 == (size_t)-1) return i1; - size_t i2 = syntax_scope_check_pattern(it->as.call.argument,scope); - if (i2 == (size_t)-1) return i2; - return (i1 + i2); + for (int i = 0; i < it->as.call.nargs; i++) { + size_t i2 = _scope_check_pattern(it->as.call.arguments[i],scope); + if (i2 == (size_t)-1) return i2; + i1 += i2; + } + return i1; } case EXPR_STRING_LIT: case EXPR_INT_LIT: + case EXPR_FLOAT_LIT: case EXPR_CONSTRUCTOR: return 0; case EXPR_PAT_IDENT: { @@ -253,69 +520,211 @@ size_t syntax_scope_check_pattern(expr_t *it, scope_t *scope) { } } } -bool syntax_scope_check_expr(expr_t *it, scope_t *scope) { +static inline size_t max(size_t a, size_t b) { + return (a > b) ? a : b; +} +static size_t _max_let_depth(expr_t *it) { + switch (it->tag) { + case EXPR_ALT: + case EXPR_SEQ: + return max(_max_let_depth(it->as.alt.try),_max_let_depth(it->as.alt.orelse)); + case EXPR_CALL: { + size_t ret = _max_let_depth(it->as.call.callee); + for (int i = 0; i < it->as.call.nargs;i++) { + ret = max(ret,_max_let_depth(it->as.call.arguments[i])); + } + return ret; + } + case EXPR_LET_BINDING: { + size_t expr = _max_let_depth(it->as.let_binding.expr); + return max(expr,_max_let_depth(it->as.let_binding.in) + it->as.let_binding.pattern.bound_vars); + } + case EXPR_TUPLE: + case EXPR_GROUP: { + size_t ret = 0; + for (int i = 0; i < it->as.tuple.nelements;i++) { + ret = max(ret,_max_let_depth(it->as.tuple.elements[i])); + } + return ret; + } + case EXPR_LAMBDA: + case EXPR_LAMBDA_COMPILED: + case EXPR_BUILTIN: + case EXPR_INT_LIT: + case EXPR_FLOAT_LIT: + case EXPR_PAT_IDENT: + case EXPR_STRING_LIT: + case EXPR_VAR: + case EXPR_CONSTRUCTOR: + return 0; + } +} + +size_t syntax_expr_required_locals(expr_t *it) { + return _max_let_depth(it); +} + +static char* INTERNAL_NAMES[] + = {"0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", + "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23"}; + +static bool _scope_check_expr(expr_t *it, scope_t *scope, builtins_t *builtins, bitset_t *used) { + + //printf("SCOPE CHECK:"); + //scope_debug_dump(scope); + //syntax_dump_expr(it); + //printf("\n"); switch (it->tag) { case EXPR_ALT: - return syntax_scope_check_expr(it->as.alt.try, scope) - && syntax_scope_check_expr(it->as.alt.orelse, scope); + case EXPR_SEQ: + return _scope_check_expr(it->as.alt.try, scope, builtins, used) + && _scope_check_expr(it->as.alt.orelse, scope, builtins, used); case EXPR_LAMBDA: { - size_t amount = syntax_scope_check_pattern(it->as.lambda.pattern,scope); - if (amount == (size_t)-1) - return false; + size_t idx = 0; + expr_t *body = it->as.lambda_raw.body; + size_t num_args = it->as.lambda_raw.npatterns; + for (int i = 0; i < it->as.lambda_raw.npatterns; i++) { + if (it->as.lambda_raw.patterns[i]->tag == EXPR_PAT_IDENT) { + scope_push(scope, it->as.lambda_raw.patterns[i]->as.ident); + } else { + expr_t *ident_expr = _alloc_expr(); + ident_expr->tag = EXPR_PAT_IDENT; + ident_expr->pos = it->as.lambda_raw.patterns[i]->pos; + ident_expr->source = it->as.lambda_raw.patterns[i]->source; + ident_expr->as.ident = INTERNAL_NAMES[idx++]; + scope_push(scope, ident_expr->as.ident); + expr_t *let_binding = _alloc_expr(); + let_binding->tag = EXPR_LET_BINDING; + let_binding->pos = it->as.lambda_raw.patterns[i]->pos; + let_binding->source = it->as.lambda_raw.patterns[i]->source; + let_binding->as.let_binding.pattern.expr = it->as.lambda_raw.patterns[i]; + let_binding->as.let_binding.pattern.bound_vars = (size_t)-1; + let_binding->as.let_binding.expr = ident_expr; + let_binding->as.let_binding.in = body; + body = let_binding; + } + } + it->tag = EXPR_LAMBDA_COMPILED; + it->as.lambda.body = body; + it->as.lambda.args = num_args; - bool ret = syntax_scope_check_expr(it->as.lambda.body,scope); - scope_pop(scope,amount); + bitset_t *lambda_mask = bitset_alloc(); + bool ret = _scope_check_expr(it->as.lambda.body,scope, builtins, lambda_mask); + bitset_shift_down(lambda_mask,num_args); + it->as.lambda.mask = lambda_mask; + bitset_union(used, lambda_mask); + it->as.lambda.num_lets = _max_let_depth(it->as.lambda.body); + scope_pop(scope,num_args); return ret; } case EXPR_LET_BINDING: { - if (!syntax_scope_check_expr(it->as.let_binding.expr,scope)) + if (!_scope_check_expr(it->as.let_binding.expr,scope,builtins, used)) return false; - size_t amount = syntax_scope_check_pattern(it->as.let_binding.pattern,scope); + size_t amount = _scope_check_pattern(it->as.let_binding.pattern.expr,scope); if (amount == (size_t)-1) return false; - bool ret = syntax_scope_check_expr(it->as.let_binding.in,scope); + it->as.let_binding.pattern.bound_vars = amount; + bitset_shift_up(used, amount); + bool ret = _scope_check_expr(it->as.let_binding.in,scope,builtins, used); + bitset_shift_down(used, amount); scope_pop(scope,amount); return ret; } case EXPR_CALL: - return syntax_scope_check_expr(it->as.call.callee, scope) - && syntax_scope_check_expr(it->as.call.argument, scope); + if (_scope_check_expr(it->as.call.callee, scope,builtins, used)) { + for (int i = 0; i < it->as.call.nargs; i++) { + if (!_scope_check_expr(it->as.call.arguments[i], scope,builtins, used)) + return false; + } + return true; + } else return false; case EXPR_STRING_LIT: case EXPR_INT_LIT: + case EXPR_FLOAT_LIT: case EXPR_CONSTRUCTOR: - case EXPR_VAR: return true; + case EXPR_TUPLE: + // TODO + case EXPR_GROUP: + // TODO + return true; + case EXPR_LAMBDA_COMPILED: + case EXPR_VAR: + case EXPR_BUILTIN: + die("Impossible happened: Found a compiled node when scope-checking."); case EXPR_PAT_IDENT: { de_bruijn_t idx = scope_lookup(scope, it->as.ident); if (idx == (de_bruijn_t)-1) { - error_report(error(ERROR_UNKNOWN_VARIABLE, it->source, it->pos, strlen(it->as.ident))); - return false; + builtin_func_t *ptr = builtins_lookup(builtins, it->as.ident); + if (ptr != NULL) { + it->tag = EXPR_BUILTIN; + it->as.builtin = ptr; + return true; + } else { + //printf("FOO: %s\n", it->as.ident); + error_report(error(ERROR_UNKNOWN_VARIABLE, it->source, it->pos, strlen(it->as.ident))); + return false; + } } it->tag = EXPR_VAR; it->as.var = idx; + bitset_set(used,idx); return true; } } } - +expr_t *syntax_parse_expr(lexer_t *lexer, builtins_t *builtins, intern_table_t *table) { + expr_t *it = _parse_expr(lexer, table); + if (it == NULL) return NULL; + bitset_t *used = bitset_alloc(); + scope_t *scope = scope_alloc(); + _scope_check_expr(it, scope, builtins, used); + return it; +} void syntax_expr_free(expr_t *it) { switch (it->tag) { case EXPR_ALT: + case EXPR_SEQ: syntax_expr_free(it->as.alt.try); syntax_expr_free(it->as.alt.orelse); break; case EXPR_LAMBDA: - syntax_expr_free(it->as.lambda.pattern); + for (int i = 0; i < it->as.lambda_raw.npatterns;i++) { + syntax_expr_free(it->as.lambda_raw.patterns[i]); + } + free(it->as.lambda_raw.patterns); + syntax_expr_free(it->as.lambda_raw.body); + break; + case EXPR_LAMBDA_COMPILED: syntax_expr_free(it->as.lambda.body); + if (it->as.lambda.mask != NULL) bitset_free(it->as.lambda.mask); break; + case EXPR_LET_BINDING: syntax_expr_free(it->as.let_binding.expr); syntax_expr_free(it->as.let_binding.in); + syntax_expr_free(it->as.let_binding.pattern.expr); + break; + + case EXPR_TUPLE: + for (int i = 0; i < it->as.tuple.nelements;i++) { + syntax_expr_free(it->as.tuple.elements[i]); + } + free(it->as.tuple.elements); + break; + case EXPR_GROUP: + for (int i = 0; i < it->as.group.nclauses;i++) { + syntax_expr_free(it->as.group.clauses[i]); + } + free(it->as.group.clauses); break; case EXPR_CALL: syntax_expr_free(it->as.call.callee); - syntax_expr_free(it->as.call.argument); + for (int i = 0; i < it->as.call.nargs;i++) { + syntax_expr_free(it->as.call.arguments[i]); + } + free(it->as.call.arguments); break; case EXPR_STRING_LIT: free(it->as.string_lit); @@ -324,10 +733,16 @@ void syntax_expr_free(expr_t *it) { } free(it); } + + void syntax_dump_expr(expr_t *it) { switch (it->tag) { case EXPR_ALT: printf("alt("); + goto bits; + case EXPR_SEQ: + printf("seq("); + bits: syntax_dump_expr(it->as.alt.try); printf(","); syntax_dump_expr(it->as.alt.orelse); @@ -335,41 +750,72 @@ void syntax_dump_expr(expr_t *it) { break; case EXPR_LAMBDA: printf("lambda("); - syntax_dump_expr(it->as.lambda.pattern); - printf(","); - syntax_dump_expr(it->as.lambda.body); + for (int i = 0; i < it->as.lambda_raw.npatterns;i++) { + syntax_dump_expr(it->as.lambda_raw.patterns[i]); + printf(": "); + } + syntax_dump_expr(it->as.lambda_raw.body); printf(")"); break; case EXPR_LET_BINDING: printf("let("); - syntax_dump_expr(it->as.let_binding.pattern); + syntax_dump_expr(it->as.let_binding.pattern.expr); printf(":="); syntax_dump_expr(it->as.let_binding.expr); - printf(","); + printf(";"); syntax_dump_expr(it->as.let_binding.in); printf(")"); break; case EXPR_CALL: - printf("call("); syntax_dump_expr(it->as.call.callee); - printf(", "); - syntax_dump_expr(it->as.call.argument); + printf("("); + for (int i = 0; i < it->as.call.nargs;i++) { + syntax_dump_expr(it->as.call.arguments[i]); + printf(","); + } + printf(")"); + break; + case EXPR_TUPLE: + printf("("); + for (int i = 0; i < it->as.tuple.nelements;i++) { + syntax_dump_expr(it->as.tuple.elements[i]); + printf(","); + } printf(")"); break; + case EXPR_BUILTIN: + printf(""); + break; + case EXPR_LAMBDA_COMPILED: + printf("lambda_c(%zu,",it->as.lambda.args); + syntax_dump_expr(it->as.lambda.body); + printf(")"); + break; + case EXPR_GROUP: + printf("{"); + for (int i = 0; i < it->as.group.nclauses;i++) { + syntax_dump_expr(it->as.group.clauses[i]); + printf(","); + } + printf("}"); + break; case EXPR_STRING_LIT: printf("\"%s\"",it->as.string_lit); break; case EXPR_INT_LIT: printf("%ld", it->as.int_lit); break; + case EXPR_FLOAT_LIT: + printf("%f", it->as.float_lit); + break; case EXPR_PAT_IDENT: - printf("$%s", it->as.ident); + printf("%s", it->as.ident); break; case EXPR_VAR: printf("\\%zu", it->as.var); break; case EXPR_CONSTRUCTOR: - printf(":%s", it->as.constructor); + printf("<%s>", it->as.constructor); break; default: break; } diff --git a/syntax.h b/syntax.h index 899490d..667a5d1 100644 --- a/syntax.h +++ b/syntax.h @@ -3,9 +3,15 @@ #include "lexer.h" #include "intern.h" #include "scope.h" +#include "bitset.h" +#include "builtins.h" #include typedef struct expr expr_t; +typedef struct { + expr_t *expr; + size_t bound_vars; +} pattern_t; struct expr { enum { @@ -14,51 +20,72 @@ struct expr { EXPR_PAT_IDENT, EXPR_CONSTRUCTOR, EXPR_INT_LIT, + EXPR_FLOAT_LIT, EXPR_LET_BINDING, EXPR_STRING_LIT, + EXPR_TUPLE, EXPR_LAMBDA, - EXPR_WEAKENING, + EXPR_LAMBDA_COMPILED, + EXPR_GROUP, EXPR_ALT, + EXPR_SEQ, + EXPR_BUILTIN, } tag; source_t *source; pos_t pos; union { struct { - expr_t *callee; - expr_t *argument; + expr_t *callee; + expr_t **arguments; + size_t nargs; } call; struct { expr_t *try; expr_t *orelse; } alt; struct { - expr_t *pattern; + expr_t *first; + expr_t *then; + } seq; + struct { + pattern_t pattern; expr_t *expr; expr_t *in; } let_binding; de_bruijn_t var; + builtin_func_t *builtin; intern_t ident; intern_t constructor; long int_lit; + double float_lit; char *string_lit; struct { - expr_t *pattern; + size_t args; expr_t *body; + bitset_t *mask; + size_t num_lets; } lambda; struct { - de_bruijn_t *keep; - size_t keep_len; - expr_t *pattern; - expr_t *body; - } weakening; + expr_t** clauses; + size_t nclauses; + } group; + struct { + expr_t** elements; + size_t nelements; + } tuple; + struct { + expr_t** patterns; + size_t npatterns; + expr_t *body; + } lambda_raw; } as; }; -expr_t *syntax_parse_expr(lexer_t *lexer, intern_table_t *table); -void syntax_expr_free(expr_t *it); -size_t syntax_scope_check_pattern(expr_t *it, scope_t *scope); -bool syntax_scope_check_expr(expr_t *it, scope_t *scope); +expr_t *syntax_parse_expr(lexer_t *lexer, builtins_t *builtins, intern_table_t *table); +/* returns the amount of local binding slots required to evaluate this expression */ +size_t syntax_expr_required_locals(expr_t *it); +void syntax_expr_free(expr_t *it); void syntax_dump_expr(expr_t *it); #endif \ No newline at end of file diff --git a/test.hito b/test.hito new file mode 100644 index 0000000..83c3e84 --- /dev/null +++ b/test.hito @@ -0,0 +1,3 @@ +y := x: .bar(x); +x := (a,b,c,d,e): .foo(y(y(y(a))),.bar(b),y(c)); +prim_test(34,20) \ No newline at end of file diff --git a/value.c b/value.c new file mode 100644 index 0000000..497acb8 --- /dev/null +++ b/value.c @@ -0,0 +1,171 @@ +#include "value.h" +#include "env.h" +#include "syntax.h" +#include "util.h" +#include +#include + + +/* ---------------- GC management ---------------- */ +struct gc { + value_t *gc_list; // linked list of values +}; + + +/* Mark bit stored in the high bit of `tag` */ +#define GC_MARK_BIT ((int)1 << (sizeof(int)*8 - 1)) + +#define VALUE_TAG(v) ((v)->tag & ~GC_MARK_BIT) +#define VALUE_MARKED(v) (((v)->tag & GC_MARK_BIT) != 0) +#define VALUE_SET_MARK(v) ((v)->tag |= GC_MARK_BIT) +#define VALUE_CLEAR_MARK(v) ((v)->tag &= ~GC_MARK_BIT) + +#define MARK_STACK_SIZE 256 + +gc_t *gc_alloc(void) { + gc_t *gc = calloc(1,sizeof(gc_t)); + if (gc == NULL) + die("Out of memory: cannot allocate gc"); + return gc; +} + +void gc_free(gc_t *gc) { + if (gc->gc_list != NULL) + die("Cannot free a gc arena that still has values in it!"); + free(gc); +} + +/* Allocate a new value, zero-initialized, linked into GC list */ +value_t *value_alloc(gc_t *gc) { + value_t *v = calloc(1, sizeof(value_t)); + if (v == NULL) + die("Out of memory: cannot allocate value"); + v->gc_next = gc->gc_list; + gc->gc_list = v; + return v; +} + +/* Recursive/stack-based marking function */ +static void mark_value(value_t *root) { + if (!root) return; + + value_t *stack[MARK_STACK_SIZE]; + size_t top = 0; + + stack[top++] = root; + + while (top > 0) { + value_t *v = stack[--top]; + if (!v || VALUE_MARKED(v)) continue; + + VALUE_SET_MARK(v); + + switch (VALUE_TAG(v)) { + case VALUE_CONSTRUCTOR: + for (size_t i = 0; i < v->as.constructor.num_args; i++) { + value_t *child = v->as.constructor.args[i]; + if (!child) continue; + + if (top < MARK_STACK_SIZE) stack[top++] = child; + else mark_value(child); // fallback recursion + } + break; + + case VALUE_CONS: + if (v->as.cons.left) { + if (top < MARK_STACK_SIZE) stack[top++] = v->as.cons.left; + else mark_value(v->as.cons.left); + } + if (v->as.cons.right) { + if (top < MARK_STACK_SIZE) stack[top++] = v->as.cons.right; + else mark_value(v->as.cons.right); + } + break; + + case VALUE_CLOSURE: + if (v->as.closure.captured) + env_mark_values(v->as.closure.captured); + break; + + default: + break; + } + } +} + +/* Public function to mark a single value */ +void value_mark_gc(value_t *v) { + mark_value(v); +} + +/* Sweep unmarked values */ +static void sweep(gc_t *gc) { + value_t **ptr = &gc->gc_list; + while (*ptr) { + value_t *v = *ptr; + if (VALUE_MARKED(v)) { + VALUE_CLEAR_MARK(v); + ptr = &v->gc_next; + } else { + *ptr = v->gc_next; + switch (v->tag) { + case VALUE_STRING: if (!v->as.string.shared) { + free(v->as.string.string); + } break; + case VALUE_CONSTRUCTOR: if (v->as.constructor.args) { + free(v->as.constructor.args); + } break; + case VALUE_CLOSURE: if (v->as.closure.captured) { + env_free(v->as.closure.captured); + } break; + default: + break; + } + free(v); + } + } +} + +/* Trigger a GC cycle; caller must have marked roots */ +void value_gc(gc_t *gc) { + sweep(gc); +} +void value_debug_dump(value_t *it) { + if (it == NULL) + printf("nil"); + else switch (it->tag) { + case VALUE_INT: + printf("%ld",it->as.integer); + break; + case VALUE_FLOAT: + printf("%f",it->as.floating); + break; + case VALUE_STRING: + printf("\"%s\"",it->as.string.string); + break; + case VALUE_CLOSURE: + printf("as.closure.captured) env_debug_dump(it->as.closure.captured); + printf("} %zu:", it->as.closure.arity); + syntax_dump_expr(it->as.closure.body); + printf(">"); + break; + case VALUE_CONSTRUCTOR: + printf("%s",it->as.constructor.name); + printf("("); + for (int i = 0; i < it->as.constructor.num_args; i++) { + value_debug_dump(it->as.constructor.args[i]); + if (i < it->as.constructor.num_args - 1) + printf(", "); + } + printf(")"); + break; + case VALUE_CONS: + printf("cons"); + break; + default: + printf("!!%d!!", it->tag); + } + + +} \ No newline at end of file diff --git a/value.h b/value.h new file mode 100644 index 0000000..1c05d9b --- /dev/null +++ b/value.h @@ -0,0 +1,66 @@ +#ifndef value_h +#define value_h + +#include "intern.h" +#include "env.h" +#include "syntax.h" +#include "builtins.h" +#include +typedef struct env env_t; +typedef struct value value_t; +typedef struct gc gc_t; + +struct value { + enum { + VALUE_INT = 0, + VALUE_FLOAT, + VALUE_STRING, + VALUE_CONSTRUCTOR, + VALUE_CONS, + VALUE_CLOSURE, + VALUE_BUILTIN + } tag; + union { + long integer; + double floating; + builtin_func_t *builtin; + struct { + char *string; + bool shared; + } string; + struct { + intern_t name; + value_t **args; + size_t num_args; + } constructor; + struct { + value_t *left; + value_t *right; + } cons; + struct { + env_t *captured; + expr_t *body; + size_t arity; + } closure; + } as; + value_t *gc_next; +}; + +/* allocate a gc arena */ +gc_t *gc_alloc(void); + +/* free a gc arena -- ensure all values are collected first */ +void gc_free(gc_t *); + +/* Allocation */ +value_t *value_alloc(gc_t *gc); + +/* Mark as live for gc */ +void value_mark_gc(value_t *); + +/* GC collection */ +void gc(gc_t *gc); + +void value_debug_dump(value_t *it); + +#endif \ No newline at end of file -- 2.51.2