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