From eeff5e273f22aa28e81ab080e9ffdce85ac394b8 Mon Sep 17 00:00:00 2001 From: Bad Diode Date: Fri, 22 Oct 2021 09:59:31 +0200 Subject: Prepare skeleton for bytecode interpreter --- src/bootstrap/darray.h | 78 ---- src/bootstrap/environment.c | 72 ---- src/bootstrap/environment.h | 27 -- src/bootstrap/errors.c | 29 -- src/bootstrap/errors.h | 38 -- src/bootstrap/gc.c | 199 ---------- src/bootstrap/gc.h | 46 --- src/bootstrap/hashtable.h | 191 --------- src/bootstrap/lexer.c | 257 ------------- src/bootstrap/lexer.h | 57 --- src/bootstrap/main.c | 288 -------------- src/bootstrap/objects.c | 141 ------- src/bootstrap/objects.h | 75 ---- src/bootstrap/parser.c | 139 ------- src/bootstrap/parser.h | 22 -- src/bootstrap/primitives.c | 918 -------------------------------------------- src/bootstrap/primitives.h | 60 --- src/bootstrap/read_line.c | 32 -- src/bootstrap/read_line.h | 10 - src/bootstrap/singletons.c | 17 - src/bootstrap/string_view.c | 40 -- src/bootstrap/string_view.h | 21 - src/bytecode/darray.h | 78 ++++ src/bytecode/debug.h | 32 ++ src/bytecode/errors.c | 29 ++ src/bytecode/errors.h | 38 ++ src/bytecode/lexer.c | 257 +++++++++++++ src/bytecode/lexer.h | 60 +++ src/bytecode/main.c | 197 ++++++++++ src/bytecode/ops.h | 8 + src/bytecode/read_line.c | 32 ++ src/bytecode/read_line.h | 10 + src/bytecode/string_view.c | 40 ++ src/bytecode/string_view.h | 21 + src/bytecode/types.h | 30 ++ src/treewalk/darray.h | 78 ++++ src/treewalk/environment.c | 72 ++++ src/treewalk/environment.h | 27 ++ src/treewalk/errors.c | 29 ++ src/treewalk/errors.h | 38 ++ src/treewalk/gc.c | 199 ++++++++++ src/treewalk/gc.h | 46 +++ src/treewalk/hashtable.h | 191 +++++++++ src/treewalk/lexer.c | 257 +++++++++++++ src/treewalk/lexer.h | 57 +++ src/treewalk/main.c | 288 ++++++++++++++ src/treewalk/objects.c | 141 +++++++ src/treewalk/objects.h | 75 ++++ src/treewalk/parser.c | 139 +++++++ src/treewalk/parser.h | 22 ++ src/treewalk/primitives.c | 918 ++++++++++++++++++++++++++++++++++++++++++++ src/treewalk/primitives.h | 60 +++ src/treewalk/read_line.c | 32 ++ src/treewalk/read_line.h | 10 + src/treewalk/singletons.c | 17 + src/treewalk/string_view.c | 40 ++ src/treewalk/string_view.h | 21 + 57 files changed, 3589 insertions(+), 2757 deletions(-) delete mode 100644 src/bootstrap/darray.h delete mode 100644 src/bootstrap/environment.c delete mode 100644 src/bootstrap/environment.h delete mode 100644 src/bootstrap/errors.c delete mode 100644 src/bootstrap/errors.h delete mode 100644 src/bootstrap/gc.c delete mode 100644 src/bootstrap/gc.h delete mode 100644 src/bootstrap/hashtable.h delete mode 100644 src/bootstrap/lexer.c delete mode 100644 src/bootstrap/lexer.h delete mode 100755 src/bootstrap/main.c delete mode 100644 src/bootstrap/objects.c delete mode 100644 src/bootstrap/objects.h delete mode 100644 src/bootstrap/parser.c delete mode 100644 src/bootstrap/parser.h delete mode 100644 src/bootstrap/primitives.c delete mode 100644 src/bootstrap/primitives.h delete mode 100644 src/bootstrap/read_line.c delete mode 100644 src/bootstrap/read_line.h delete mode 100644 src/bootstrap/singletons.c delete mode 100644 src/bootstrap/string_view.c delete mode 100644 src/bootstrap/string_view.h create mode 100644 src/bytecode/darray.h create mode 100644 src/bytecode/debug.h create mode 100644 src/bytecode/errors.c create mode 100644 src/bytecode/errors.h create mode 100644 src/bytecode/lexer.c create mode 100644 src/bytecode/lexer.h create mode 100644 src/bytecode/main.c create mode 100644 src/bytecode/ops.h create mode 100644 src/bytecode/read_line.c create mode 100644 src/bytecode/read_line.h create mode 100644 src/bytecode/string_view.c create mode 100644 src/bytecode/string_view.h create mode 100644 src/bytecode/types.h create mode 100644 src/treewalk/darray.h create mode 100644 src/treewalk/environment.c create mode 100644 src/treewalk/environment.h create mode 100644 src/treewalk/errors.c create mode 100644 src/treewalk/errors.h create mode 100644 src/treewalk/gc.c create mode 100644 src/treewalk/gc.h create mode 100644 src/treewalk/hashtable.h create mode 100644 src/treewalk/lexer.c create mode 100644 src/treewalk/lexer.h create mode 100755 src/treewalk/main.c create mode 100644 src/treewalk/objects.c create mode 100644 src/treewalk/objects.h create mode 100644 src/treewalk/parser.c create mode 100644 src/treewalk/parser.h create mode 100644 src/treewalk/primitives.c create mode 100644 src/treewalk/primitives.h create mode 100644 src/treewalk/read_line.c create mode 100644 src/treewalk/read_line.h create mode 100644 src/treewalk/singletons.c create mode 100644 src/treewalk/string_view.c create mode 100644 src/treewalk/string_view.h (limited to 'src') diff --git a/src/bootstrap/darray.h b/src/bootstrap/darray.h deleted file mode 100644 index db6234d..0000000 --- a/src/bootstrap/darray.h +++ /dev/null @@ -1,78 +0,0 @@ -#ifndef BDL_DARRAY_H -#define BDL_DARRAY_H - -#include - -typedef struct ArrayHeader { - size_t size; - size_t cap; -} ArrayHeader; - -// Header/Size/capacity accessors. -#define array_head(ARR) ((ArrayHeader *)((char *)(ARR) - sizeof(ArrayHeader))) -#define array_size(ARR) ((ARR) ? array_head(ARR)->size : 0) -#define array_cap(ARR) ((ARR) ? array_head(ARR)->cap : 0) - -// Initialize a dynamic array ARR with N elements. The initialization doesn't -// zero out the data, so thread carefully.. -#define array_init(ARR,N) ((ARR) = _array_reserve(N, sizeof(*(ARR)))) - -// Push a given element T to the dynamic array ARR. -#define array_push(ARR, T) \ - ((ARR) = _array_maybe_grow(ARR, sizeof(T)), \ - (ARR)[array_head(ARR)->size++] = (T)) - -// Return the last element of the array. Can be used to build stacks. -#define array_pop(ARR) (ARR)[--array_head(ARR)->size] - -// Insert N bytes from the SRC array into the ARR dynamic array. -#define array_insert(ARR, SRC, N) \ - ((ARR) = _array_insert(ARR, SRC, N, sizeof(*(ARR)))) - -// Free the memory from the original allocated position. -#define array_free(ARR) ((ARR) ? free(array_head(ARR)), (ARR) = NULL : 0) - -static inline void * -_array_reserve(size_t num_elem, size_t type_size) { - char *p = malloc(num_elem * type_size + sizeof(ArrayHeader)); - p += sizeof(ArrayHeader); - array_head(p)->size = 0; - array_head(p)->cap = num_elem; - return p; -} - -static inline void * -_array_maybe_grow(void *arr, size_t type_size) { - ArrayHeader *head = array_head(arr); - if (head->cap == head->size) { - if (head->cap == 0) { - head->cap++; - } else { - head->cap *= 2; - } - head = realloc(head, head->cap * type_size + sizeof(ArrayHeader)); - } - arr = (char *)head + sizeof(ArrayHeader); - return arr; -} - -static inline -char * _array_insert(char *arr, const char *src, size_t n_bytes, size_t type_size) { - ArrayHeader *head = array_head(arr); - size_t new_size = n_bytes + head->size; - if (new_size >= head->cap * type_size) { - if (head->cap == 0) { - head->cap = 1; - } - while (new_size >= head->cap * type_size) { - head->cap *= 2; - } - head = realloc(head, head->cap * type_size + sizeof(ArrayHeader)); - } - arr = (char *)head + sizeof(ArrayHeader); - memcpy((arr + head->size), src, n_bytes); - head->size = new_size; - return arr; -} - -#endif // BDL_DARRAY_H diff --git a/src/bootstrap/environment.c b/src/bootstrap/environment.c deleted file mode 100644 index dd4a648..0000000 --- a/src/bootstrap/environment.c +++ /dev/null @@ -1,72 +0,0 @@ -#include "environment.h" -#include "gc.h" -#include "errors.h" - -Environment * -env_create(Environment *parent) { - Environment *env = alloc_env(); - env->parent = parent; - env->marked = false; - env->table = ht_init(); - return env; -} - -void -env_add_symbol(Environment *env, Object *symbol, Object *value) { - if (symbol->type != OBJ_TYPE_SYMBOL) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_A_SYMBOL, - .line = 0, - .col = 0, - }); - return; - } - ht_insert(env->table, symbol, value); -} - -Object * -env_lookup(Environment *env, Object *symbol) { - while (env != NULL) { - Object *obj = ht_lookup(env->table, symbol); - if (obj != NULL) { - return obj; - } - env = env->parent; - } - return obj_err; -} - -Object * -env_update(Environment *env, Object *symbol, Object *value) { - while (env != NULL) { - Object *obj = ht_lookup(env->table, symbol); - if (obj != NULL) { - ht_insert(env->table, symbol, value); - return obj_nil; - } - env = env->parent; - } - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_SYMBOL_NOT_FOUND, - }); - return obj_err; -} - -void -env_add_or_update_current(Environment *env, Object *symbol, Object *value) { - ht_insert(env->table, symbol, value); -} - -Environment * -env_extend(Environment *parent, Environment *extra) { - Environment *env = parent; - HashTablePair *pairs = extra->table->pairs; - for (size_t i = 0; i < array_cap(pairs); i++) { - if (pairs[i].key != NULL) { - ht_insert(env->table, pairs[i].key, pairs[i].value); - } - } - return env; -} diff --git a/src/bootstrap/environment.h b/src/bootstrap/environment.h deleted file mode 100644 index 5ee21ad..0000000 --- a/src/bootstrap/environment.h +++ /dev/null @@ -1,27 +0,0 @@ -#ifndef BDL_ENVIRONMENT_H -#define BDL_ENVIRONMENT_H - -#include "objects.h" - -typedef struct Environment { - struct Environment *parent; - HashTable *table; - bool marked; -} Environment; - -Environment * env_create(Environment *parent); -void env_add_symbol(Environment *env, Object *symbol, Object *value); -Object * env_lookup(Environment *env, Object *symbol); -Object * env_update(Environment *env, Object *symbol, Object *value); -ssize_t env_index_current(Environment *env, Object *symbol); -void env_add_or_update_current(Environment *env, Object *symbol, Object *value); -Environment * env_extend(Environment *parent, Environment *extra); - -#define MAKE_ENV_VAR(ENV,STR,VAR) \ - (env_add_symbol((ENV), MAKE_SYM(STR), (VAR))) -#define MAKE_ENV_PROC(ENV,STR,FUN) \ - (env_add_symbol((ENV), MAKE_SYM(STR), make_procedure(FUN))) - -#define ENV_BUF_CAP 8 - -#endif // BDL_ENVIRONMENT_H diff --git a/src/bootstrap/errors.c b/src/bootstrap/errors.c deleted file mode 100644 index d957cfa..0000000 --- a/src/bootstrap/errors.c +++ /dev/null @@ -1,29 +0,0 @@ -#include "errors.h" - -static const char* error_msgs[] = { - [ERR_UNKNOWN] = "error: something unexpected happened", - [ERR_UNMATCHED_STRING] = "error: unmatched string delimiter", - [ERR_UNBALANCED_PAREN] = "error: unbalanced parentheses", - [ERR_NOT_IMPLEMENTED] = "error: not implemented", - [ERR_EOF_REACHED] = "error: EOF reached", - [ERR_UNKNOWN_TOKEN] = "error: unknown token", - [ERR_UNKNOWN_OBJ_TYPE] = "error: can't eval unknown object type", - [ERR_NOT_A_SYMBOL] = "error: object is not a symbol", - [ERR_SYMBOL_NOT_FOUND] = "error: symbol not found", - [ERR_OBJ_NOT_CALLABLE] = "error: object is not callable", - [ERR_NOT_ENOUGH_ARGS] = "error: not enough arguments", - [ERR_TOO_MANY_ARGS] = "error: too many arguments", - [ERR_WRONG_ARG_TYPE] = "error: wrong argument type", - [ERR_DIVISION_BY_ZERO] = "error: division by zero", -}; - -static Error errors[ERR_MAX_NUMBER]; -static size_t errors_n = 0; -static bool supress_errors = false; - -void -error_push(Error error) { - if (errors_n < ERR_MAX_NUMBER) { - errors[errors_n++] = error; - } -} diff --git a/src/bootstrap/errors.h b/src/bootstrap/errors.h deleted file mode 100644 index 7916f4a..0000000 --- a/src/bootstrap/errors.h +++ /dev/null @@ -1,38 +0,0 @@ -#ifndef BDL_ERRORS_H -#define BDL_ERRORS_H - -typedef enum ErrorType { - ERR_TYPE_LEXER, - ERR_TYPE_PARSER, - ERR_TYPE_RUNTIME, -} ErrorType; - -typedef enum ErrorValue { - ERR_UNKNOWN = 0, - ERR_UNMATCHED_STRING, - ERR_UNBALANCED_PAREN, - ERR_NOT_IMPLEMENTED, - ERR_EOF_REACHED, - ERR_UNKNOWN_TOKEN, - ERR_UNKNOWN_OBJ_TYPE, - ERR_NOT_A_SYMBOL, - ERR_SYMBOL_NOT_FOUND, - ERR_OBJ_NOT_CALLABLE, - ERR_NOT_ENOUGH_ARGS, - ERR_TOO_MANY_ARGS, - ERR_WRONG_ARG_TYPE, - ERR_DIVISION_BY_ZERO, -} ErrorValue; - -typedef struct Error { - ErrorType type; - ErrorValue value; - size_t line; - size_t col; -} Error; - -void error_push(Error error); - -#define ERR_MAX_NUMBER 16 - -#endif // BDL_ERRORS_H diff --git a/src/bootstrap/gc.c b/src/bootstrap/gc.c deleted file mode 100644 index 358a07e..0000000 --- a/src/bootstrap/gc.c +++ /dev/null @@ -1,199 +0,0 @@ -#include "gc.h" - -Environment * -alloc_env(void) { - if (array_size(gc.free_envs.offsets) == 0) { - mark_and_sweep(); - if (array_size(gc.free_envs.offsets) == 0) { - fprintf(stderr, "NO MORE ENV MEMORY AVAILABLE WHERE IS YOUR GOD NOW MWAHAHA\n"); - dump_gc(); - exit(EXIT_FAILURE); - // TODO: grow heap tables. - } - } - size_t slot = gc.free_envs.offsets[gc.free_envs.position++]; - array_head(gc.free_envs.offsets)->size--; - return &gc.envs[slot]; -} - -void -push_root(Object *obj) { - array_push(gc.roots, obj); -} - -Object * -pop_root(void) { - return array_pop(gc.roots); -} - -void -push_active_env(Environment *env) { - array_push(gc.active_envs, env); -} - -Environment * -pop_active_env(void) { - return array_pop(gc.active_envs); -} - -void -gc_init(void) { - gc = (GC){0}; - - array_init(gc.objects, GC_OBJS_CAP); - array_init(gc.roots, GC_ROOTS_CAP); - array_init(gc.active_envs, GC_ACTIVE_ENVS_CAP); - array_init(gc.envs, GC_ENVS_CAP); - array_init(gc.free_objects.offsets, GC_OBJS_CAP); - array_init(gc.free_envs.offsets, GC_ENVS_CAP); - - // The free list stores the offset from the initial position for all - // available slots. - for (size_t i = 0; i < GC_OBJS_CAP; i++) { - array_push(gc.free_objects.offsets, i); - } - for (size_t i = 0; i < GC_ENVS_CAP; i++) { - array_push(gc.free_envs.offsets, i); - } -} - -void -mark_environment(Environment *env) { - if (env == NULL || env->marked) { - return; - } - env->marked = true; - HashTablePair *pairs = env->table->pairs; - for (size_t i = 0; i < array_cap(pairs); i++) { - if (pairs[i].key != NULL) { - mark_obj(pairs[i].key); - mark_obj(pairs[i].value); - } - } -} - -void -mark_obj(Object *obj) { - if (obj->marked) { - return; - } - obj->marked = true; - if (obj->type == OBJ_TYPE_PAIR) { - mark_obj(obj->car); - mark_obj(obj->cdr); - } - if (obj->type == OBJ_TYPE_LAMBDA) { - mark_obj(obj->params); - mark_obj(obj->body); - mark_environment(obj->env); - } -} - -void -mark_and_sweep(void) { - // Mark. - for (size_t i = 0; i < array_size(gc.active_envs); i++) { - mark_environment(gc.active_envs[i]); - } - for (size_t i = 0; i < array_size(gc.roots); i++) { - mark_obj(gc.roots[i]); - } - - // Reset the free list. - gc.free_objects.position = 0; - array_head(gc.free_objects.offsets)->size = 0; - gc.free_envs.position = 0; - array_head(gc.free_envs.offsets)->size = 0; - - // Sweep. - for (size_t i = 0; i < array_cap(gc.objects); i++) { - Object *obj = &gc.objects[i]; - if (!obj->marked) { - // Free heap allocated memory for this object if needed. - if (obj->type == OBJ_TYPE_SYMBOL) { - array_free(obj->symbol); - } else if (obj->type == OBJ_TYPE_STRING) { - array_free(obj->string); - } - gc.free_objects.offsets[array_head(gc.free_objects.offsets)->size++] = i; - } - obj->marked = false; - } - for (size_t i = 0; i < array_cap(gc.envs); i++) { - Environment *env = &gc.envs[i]; - if (!env->marked) { - ht_free(env->table); - gc.free_envs.offsets[array_head(gc.free_envs.offsets)->size++] = i; - } - env->marked = false; - } -} - -void -dump_gc(void) { - printf("-------------- ROOTS -------------- \n"); - for (size_t i = 0; i < array_size(gc.roots); i++) { - display(gc.roots[i]); - printf("\n"); - } - printf("--------- OBJECTS (TOP 20) -------- \n"); - for (size_t i = 0; i < 20; i++) { - printf("i: %ld -> ", i); - Object *obj = &gc.objects[i]; - display(obj); - bool is_free = false; - for (size_t j = 0; j < array_cap(gc.objects); j++) { - if (gc.free_objects.offsets[j] == i) { - is_free = true; - break; - } - } - if (is_free) { - printf(" [FREE]"); - } - printf("\n"); - } - printf("-------------- MISC --------------- \n"); - printf("gc.roots.size: %ld\n", array_size(gc.roots)); - printf("gc.roots.cap: %ld\n", array_size(gc.roots)); - printf("gc.active_envs.size: %ld\n", array_size(gc.active_envs)); - printf("gc.active_envs.cap: %ld\n", array_cap(gc.active_envs)); - printf("gc.obj_cap: %ld\n", array_cap(gc.objects)); - printf("gc.free_objects.size: %ld\n", array_size(gc.free_objects.offsets)); - printf("gc.free_objects.cap: %ld\n", array_cap(gc.free_objects.offsets)); - printf("gc.free_objects.position: %ld\n", gc.free_objects.position); - printf("array_size(gc.free_envs.offsets): %ld\n", array_size(gc.free_envs.offsets)); - printf("gc.free_envs.cap: %ld\n", array_cap(gc.free_envs.offsets)); - printf("gc.free_envs.position: %ld\n", gc.free_envs.position); - printf("gc.envs.size: %ld\n", array_size(gc.envs)); - printf("gc.envs.cap: %ld\n", array_cap(gc.envs)); -} - -Object * -alloc_object(ObjectType type) { - if (array_head(gc.free_objects.offsets)->size == 0) { - mark_and_sweep(); - if (array_head(gc.free_objects.offsets)->size == 0) { - fprintf(stderr, "NO MORE OBJ MEMORY AVAILABLE WHERE IS YOUR GOD NOW MWAHAHA\n"); - dump_gc(); - exit(EXIT_FAILURE); - // TODO: grow heap tables. - // NOTE: When growing the tables, we WILL lose the pointer - // references! Should we work with offsets all the way? That is for - // cdr and car? Should we have a utility function? All in all, we - // need to refactor the codebase first to work with pointer offsets - // rather than objects. This issue is very important, if we are in - // the middle of an operation that tries to allocate memory but we - // had saved pointers to some object, the pointer references may be - // invalidated, crashing or worse, silently returning garbage! Let's - // move on for now implementing the GC and we will revisit this part - // later. - } - } - size_t slot = gc.free_objects.offsets[gc.free_objects.position++]; - array_head(gc.free_objects.offsets)->size--; - Object *obj = &gc.objects[slot]; - obj->type = type; - obj->marked = false; - return obj; -} diff --git a/src/bootstrap/gc.h b/src/bootstrap/gc.h deleted file mode 100644 index 9ad1615..0000000 --- a/src/bootstrap/gc.h +++ /dev/null @@ -1,46 +0,0 @@ -#ifndef BDL_GC_H -#define BDL_GC_H - -#include "objects.h" -#include "environment.h" - -typedef struct FreeList { - size_t *offsets; - size_t position; -} FreeList; - -typedef struct GC { - Object **roots; - Environment *envs; - Object *objects; - FreeList free_objects; - FreeList free_envs; - Environment **active_envs; -} GC; - -void gc_init(void); - -// Allocation functions for objects and environments. -Object * alloc_object(ObjectType type); -Environment * alloc_env(void); - -// Root and environment protector functions. -void push_root(Object *obj); -Object * pop_root(void); -void push_active_env(Environment *env); -Environment * pop_active_env(void); - -// Mark and sweep algorithm functions. -void mark_environment(Environment *env); -void mark_obj(Object *obj); -void mark_and_sweep(void); - -// Debugging function to print out the contentes of some GC fields. -void dump_gc(void); - -#define GC_OBJS_CAP 1024 * 1024 -#define GC_ROOTS_CAP 1024 -#define GC_ACTIVE_ENVS_CAP 2 -#define GC_ENVS_CAP 1024 * 4 - -#endif // BDL_GC_H diff --git a/src/bootstrap/hashtable.h b/src/bootstrap/hashtable.h deleted file mode 100644 index 8f210e3..0000000 --- a/src/bootstrap/hashtable.h +++ /dev/null @@ -1,191 +0,0 @@ -#ifndef BDL_HASHTABLE_H -#define BDL_HASHTABLE_H - -#include "darray.h" -#include "objects.h" - -// Minimum table capacity. -#define HT_MIN_CAP 4 -#define HT_MIN_SHIFT 2 - -// Adjust the load factor threshold at which the table will grow on insertion. -#define HT_LOAD_THRESHOLD 0.8 - -typedef struct HashTablePair { - Object *key; - Object *value; -} HashTablePair; - -typedef struct HashTable { - // All available key-value pairs as a dynamic array. - HashTablePair *pairs; - - // This table expects the number of buckets to grow in powers of two. To - // speedup the default hashing, we memoize the number of bits equivalent to - // that power of 2: - // - // cap := 1024 = 2 ^ 10, shift_amount := 10 - // - uint8_t shift_amount; -} HashTable; - -// Hash a byte stream using a circular shift + XOR hash function. -static inline uint64_t -_xor_shift_hash(const char *key, size_t n) { - uint64_t hash = 0x65d9d65f6a19574f; - char *last = (char *)key + n; - while (key != last) { - hash ^= (uint64_t)*key++; - hash = (hash << 8) | (hash >> (64 - 8)); - } - return hash; -} - -// Use Fibonacci hashing to map a hash to a value in range of the table. -static inline uint64_t -_fibonacci_hash(uint64_t hash, size_t shift_amount) { - return (hash * UINT64_C(11400714819323198485)) >> (64 - shift_amount); -} - -uint64_t -ht_hash(const HashTable *table, const Object *key) { - uint64_t hash = 0; - switch (key->type) { - case OBJ_TYPE_FIXNUM: { - hash = key->fixnum; - } break; - case OBJ_TYPE_STRING: { - hash = _xor_shift_hash(key->string, array_size(key->string)); - } break; - case OBJ_TYPE_SYMBOL: { - hash = _xor_shift_hash(key->symbol, array_size(key->symbol)); - } break; - case OBJ_TYPE_BOOL: - case OBJ_TYPE_NIL: - case OBJ_TYPE_PAIR: - case OBJ_TYPE_LAMBDA: - case OBJ_TYPE_PROCEDURE: - case OBJ_TYPE_ERR: { - hash = (uintptr_t)key; - } break; - } - hash = _fibonacci_hash(hash, table->shift_amount); - return hash; -} - -static inline float -ht_load_factor(const HashTable *table) { - return (float)array_size(table->pairs) / (float)array_cap(table->pairs); -} - -HashTable * -ht_init(void) { - HashTable *table = malloc(sizeof(HashTable)); - table->pairs = NULL; - array_init(table->pairs, HT_MIN_CAP); - for (size_t i = 0; i < array_cap(table->pairs); i++) { - table->pairs[i] = (HashTablePair){NULL, NULL}; - } - table->shift_amount = HT_MIN_SHIFT; - return table; -} - -void -_ht_insert(HashTable *table, const Object *key, const Object *value) { - size_t position = ht_hash(table, key); - size_t probe_position = position; - - // Verify the key in that position is free. If not, use linear probing to - // find the next free slot. - HashTablePair *pairs = table->pairs; - while (true) { - if (pairs[probe_position].key == NULL) { - array_head(pairs)->size++; - break; - } - if (obj_eq(pairs[probe_position].key, key)) { - break; - } - if (probe_position == array_cap(pairs) - 1) { - probe_position = 0; - } else { - probe_position++; - } - } - pairs[probe_position].key = (Object *)key; - pairs[probe_position].value = (Object *)value; -} - -void -_ht_maybe_grow(HashTable *table) { - HashTablePair *pairs = table->pairs; - if (ht_load_factor(table) < HT_LOAD_THRESHOLD) { - return; - } - - // Create a new array with 2x capacity. - table->pairs = NULL; - array_init(table->pairs, array_cap(pairs) * 2); - for (size_t i = 0; i < array_cap(table->pairs); i++) { - table->pairs[i] = (HashTablePair){NULL, NULL}; - } - table->shift_amount++; - - // Hash everything in the table for the new array capacity. - for (size_t i = 0; i < array_cap(pairs); i++) { - if (pairs[i].key != NULL) { - _ht_insert(table, pairs[i].key, pairs[i].value); - } - } - - // Free the old array. - array_free(pairs); -} - -void -ht_insert(HashTable *table, const Object *key, const Object *value) { - _ht_maybe_grow(table); - _ht_insert(table, key, value); - return; -} - -Object * -ht_lookup(const HashTable *table, const Object *key) { - size_t position = ht_hash(table, key); - size_t probe_position = position; - - // Verify the key in that position is the same. If not perform linear - // probing to find it. - HashTablePair *pairs = table->pairs; - while (true) { - if (pairs[probe_position].key == NULL) { - return NULL; - } - if (obj_eq(pairs[probe_position].key, key)) { - break; - } - if (probe_position == array_cap(pairs) - 1) { - probe_position = 0; - } else { - probe_position++; - } - if (probe_position == position) { - return NULL; - } - } - return pairs[probe_position].value; -} - -void -ht_free(HashTable *table) { - if (table == NULL) { - return; - } - if (table->pairs == NULL) { - return; - } - array_free(table->pairs); - free(table); -} - -#endif // BDL_HASHTABLE_H diff --git a/src/bootstrap/lexer.c b/src/bootstrap/lexer.c deleted file mode 100644 index 38ca37c..0000000 --- a/src/bootstrap/lexer.c +++ /dev/null @@ -1,257 +0,0 @@ -#include "lexer.h" - -void -print_token(Token tok) { - printf("LINE: %3ld COL: %3ld ", tok.line, tok.column); - switch (tok.type) { - case TOKEN_LPAREN: { - printf("TOKEN_LPAREN"); - } break; - case TOKEN_RPAREN: { - printf("TOKEN_RPAREN"); - } break; - case TOKEN_QUOTE: { - printf("TOKEN_QUOTE"); - } break; - case TOKEN_TRUE: { - printf("TOKEN_TRUE"); - } break; - case TOKEN_FALSE: { - printf("TOKEN_FALSE"); - } break; - case TOKEN_NIL: { - printf("TOKEN_NIL"); - } break; - case TOKEN_FIXNUM: { - printf("TOKEN_FIXNUM -> "); - sv_write(&tok.value, stdout); - } break; - case TOKEN_SYMBOL: { - printf("TOKEN_SYMBOL -> "); - sv_write(&tok.value, stdout); - } break; - case TOKEN_STRING: { - printf("TOKEN_STRING -> "); - sv_write(&tok.value, stdout); - } break; - case TOKEN_EOF: { - printf("TOKEN_EOF"); - } break; - case TOKEN_UNKNOWN: { - printf("TOKEN_UNKNOWN"); - } break; - } - printf("\n"); -} - -char -scan_next(Scanner *scanner) { - char c = sv_next(&scanner->current); - if (c == '\n') { - scanner->line_number++; - scanner->col_number = 1; - } else { - scanner->col_number++; - } - scanner->offset++; - return c; -} - -char -scan_peek(const Scanner *scanner) { - return sv_peek(&scanner->current); -} - -bool -scan_has_next(const Scanner *scanner) { - return scanner->current.n != 0; -} - -void -skip_whitespace(Scanner *scanner) { - while (scan_has_next(scanner)) { - char c = scan_peek(scanner); - switch (c) { - case ' ': - case '\f': - case '\n': - case '\r': - case '\t': - case '\v': { - scan_next(scanner); - } break; - default: { - return; - } break; - } - } -} - -bool -is_delimiter(char c) { - switch (c) { - case EOF: - case '\0': - case ';': - case '"': - case '\'': - case '(': - case ')': - case ' ': - case '\f': - case '\n': - case '\r': - case '\t': - case '\v': { - return true; - } break; - } - return false; -} - -TokenType -find_primitive_type(const StringView value) { - bool is_fixnum = true; - for (size_t i = 0; i < value.n; i++) { - char c = value.start[i]; - if (i == 0 && c == '-' && value.n > 1) { - continue; - } - if (!(c >= '0' && c <= '9')) { - is_fixnum = false; - break; - } - } - if (is_fixnum) { - return TOKEN_FIXNUM; - } - if (sv_equal(&value, &(StringView){"true", 4})) { - return TOKEN_TRUE; - } - if (sv_equal(&value, &(StringView){"false", 5})) { - return TOKEN_FALSE; - } - return TOKEN_SYMBOL; -} - -Token * -tokenize(const StringView *sv) { - Token *tokens = NULL; - array_init(tokens, 1); - Scanner scanner = (Scanner){ - .current = *sv, - .line_number = 1, - .col_number = 1, - }; - - while (scan_has_next(&scanner)) { - skip_whitespace(&scanner); - size_t line = scanner.line_number; - size_t col = scanner.col_number; - size_t offset = scanner.offset; - char c = scan_next(&scanner); - switch (c) { - case ';': { - while ((c = scan_next(&scanner)) != '\n' && c != '\0') {} - } break; - case '"': { - char prev = c; - bool found = false; - size_t n = 0; - while (scan_has_next(&scanner)) { - c = scan_next(&scanner); - if (c == '"' && prev != '\\') { - found = true; - break; - } - prev = c; - n++; - } - if (!found) { - error_push((Error){ - .type = ERR_TYPE_LEXER, - .value = ERR_UNMATCHED_STRING, - .line = line, - .col = col, - }); - return tokens; - } - Token token = (Token){ - .value = (StringView){ - .start = &sv->start[offset + 1], - .n = n, - }, - .type = TOKEN_STRING, - .line = line, - .column = col, - }; - array_push(tokens, token); - } break; - case '\'': { - Token token = (Token){ - .type = TOKEN_QUOTE, - .line = line, - .column = col, - }; - array_push(tokens, token); - } break; - case '(': { - if (scan_peek(&scanner) == ')') { - scan_next(&scanner); - Token token = (Token){ - .type = TOKEN_NIL, - .line = line, - .column = col, - }; - array_push(tokens, token); - } else { - Token token = (Token){ - .type = TOKEN_LPAREN, - .line = line, - .column = col, - }; - array_push(tokens, token); - } - } break; - case ')': { - Token token = (Token){ - .type = TOKEN_RPAREN, - .line = line, - .column = col, - }; - array_push(tokens, token); - } break; - default: { - size_t n = 1; - while (!is_delimiter(scan_peek(&scanner))) { - scan_next(&scanner); - n++; - } - if (c == EOF || c == '\0') { - break; - } - Token token = (Token){ - .value = (StringView){ - .start = &sv->start[offset], - .n = n, - }, - .type = TOKEN_SYMBOL, - .line = line, - .column = col, - }; - token.type = find_primitive_type(token.value); - array_push(tokens, token); - } break; - } - } - - // Push EOF token. - Token token = (Token){ - .type = TOKEN_EOF, - .line = scanner.line_number, - .column = 1, - }; - array_push(tokens, token); - - return tokens; -} diff --git a/src/bootstrap/lexer.h b/src/bootstrap/lexer.h deleted file mode 100644 index 2b2789f..0000000 --- a/src/bootstrap/lexer.h +++ /dev/null @@ -1,57 +0,0 @@ -#ifndef BDL_LEXER_H -#define BDL_LEXER_H - -typedef enum TokenType { - TOKEN_UNKNOWN = 0, - TOKEN_LPAREN, - TOKEN_RPAREN, - TOKEN_QUOTE, - TOKEN_TRUE, - TOKEN_FALSE, - TOKEN_NIL, - TOKEN_FIXNUM, - TOKEN_SYMBOL, - TOKEN_STRING, - TOKEN_EOF, -} TokenType; - -typedef struct Token { - TokenType type; - StringView value; - size_t line; - size_t column; -} Token; - -typedef struct Scanner { - StringView current; - size_t line_number; - size_t col_number; - size_t offset; -} Scanner; - -// Print a token to standard output for debugging purposes. -void print_token(Token tok); - -// Same functionality as the ScanView pairs, but keeping track of line and -// column numbers. -char scan_next(Scanner *scanner); -char scan_peek(const Scanner *scanner); - -// Check if the current scanner still have characters left. -bool scan_has_next(const Scanner *scanner); - -// Advance the scanner until we ran out of whitespace. -void skip_whitespace(Scanner *scanner); - -// Check if a given character is a delimiter. -bool is_delimiter(char c); - -// Extract the token type from the current string. -TokenType find_primitive_type(const StringView value); - -// Generate a list of tokens from the given string. -Token * tokenize(const StringView *sv); - -#define TOK_BUF_CAP 256 - -#endif // BDL_LEXER_H diff --git a/src/bootstrap/main.c b/src/bootstrap/main.c deleted file mode 100755 index a5888fd..0000000 --- a/src/bootstrap/main.c +++ /dev/null @@ -1,288 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include - -#include "darray.h" -#include "hashtable.h" - -#include "singletons.c" - -#include "environment.c" -#include "errors.c" -#include "gc.c" -#include "lexer.c" -#include "objects.c" -#include "parser.c" -#include "primitives.c" -#include "read_line.c" -#include "string_view.c" - -void -init(void) { - // Initialize garbage collector. - gc_init(); - - // Initialize singletons. - obj_nil = alloc_object(OBJ_TYPE_NIL); - obj_true = alloc_object(OBJ_TYPE_BOOL); - obj_false = alloc_object(OBJ_TYPE_BOOL); - obj_err = alloc_object(OBJ_TYPE_ERR); - obj_quote = make_symbol((StringView){"quote", 5}); - proc_if = alloc_object(OBJ_TYPE_ERR); - push_root(obj_nil); - push_root(obj_true); - push_root(obj_false); - push_root(obj_err); - push_root(obj_quote); - push_root(proc_if); - - // Global environment. - global_env = env_create(NULL); - // TODO: make sure we create symbols and strings only once (interning - // strings?) - push_active_env(global_env); - - // Primitive symbols. - MAKE_ENV_VAR(global_env, "else", obj_true); - MAKE_ENV_VAR(global_env, "nil", obj_nil); - MAKE_ENV_VAR(global_env, "if", proc_if); - - // Primitive procedures. - MAKE_ENV_PROC(global_env, "eval", proc_eval); - MAKE_ENV_PROC(global_env, "quote", proc_quote); - MAKE_ENV_PROC(global_env, "car", proc_car); - MAKE_ENV_PROC(global_env, "cdr", proc_cdr); - MAKE_ENV_PROC(global_env, "cons", proc_cons); - MAKE_ENV_PROC(global_env, "list", proc_list); - MAKE_ENV_PROC(global_env, "+", proc_sum); - MAKE_ENV_PROC(global_env, "-", proc_sub); - MAKE_ENV_PROC(global_env, "*", proc_mul); - MAKE_ENV_PROC(global_env, "/", proc_div); - MAKE_ENV_PROC(global_env, "%", proc_mod); - MAKE_ENV_PROC(global_env, "print", proc_print); - MAKE_ENV_PROC(global_env, "display", proc_display); - MAKE_ENV_PROC(global_env, "newline", proc_newline); - MAKE_ENV_PROC(global_env, "boolean?", proc_is_boolean); - MAKE_ENV_PROC(global_env, "nil?", proc_is_nil); - MAKE_ENV_PROC(global_env, "symbol?", proc_is_symbol); - MAKE_ENV_PROC(global_env, "string?", proc_is_string); - MAKE_ENV_PROC(global_env, "fixnum?", proc_is_fixnum); - MAKE_ENV_PROC(global_env, "pair?", proc_is_pair); - MAKE_ENV_PROC(global_env, "procedure?", proc_is_procedure); - MAKE_ENV_PROC(global_env, "error?", proc_is_error); - MAKE_ENV_PROC(global_env, "not", proc_not); - MAKE_ENV_PROC(global_env, "and", proc_and); - MAKE_ENV_PROC(global_env, "or", proc_or); - MAKE_ENV_PROC(global_env, "cond", proc_cond); - MAKE_ENV_PROC(global_env, "<", proc_num_less_than); - MAKE_ENV_PROC(global_env, "<=", proc_num_lesseq_than); - MAKE_ENV_PROC(global_env, ">", proc_num_greater_than); - MAKE_ENV_PROC(global_env, ">=", proc_num_greatereq_than); - MAKE_ENV_PROC(global_env, "=", proc_num_equal); - MAKE_ENV_PROC(global_env, "eq?", proc_equal); - MAKE_ENV_PROC(global_env, "def", proc_define); - MAKE_ENV_PROC(global_env, "set!", proc_set); - MAKE_ENV_PROC(global_env, "lambda", proc_lambda); - MAKE_ENV_PROC(global_env, "fun", proc_fun); - - // Runtime procedures. - MAKE_ENV_PROC(global_env, "supress-errors", proc_supress_errors); -} - -void -process_source(const StringView *source) { - Token *tokens = tokenize(source); - if (errors_n != 0) { - if (tokens != NULL) { - array_free(tokens); - } - return; - } - - Visitor visitor = (Visitor){ - .tokens = tokens, - .current = 0, - }; - while (has_next_token(&visitor) && peek_token(&visitor).type != TOKEN_EOF) { - // Check the root node stack size before parsing - size_t root_stack_size = array_size(gc.roots); - Object *root = parse_tree(&visitor); - array_head(gc.roots)->size = root_stack_size; - if (root == obj_err || errors_n != 0) { - break; - } - push_root(root); - - Object *result = eval(global_env, root); - if (result != obj_nil) { - display(result); - printf("\n"); - } - pop_root(); - } - - if (tokens != NULL) { - array_free(tokens); - } -} - -#define REPL_PROMPT "bdl> " - -void -run_repl(void) { - printf("BDL REPL (Press Ctrl-D or Ctrl-C to exit)\n"); - while (true) { - printf(REPL_PROMPT); - StringView sv = read_line(); - if (sv.start == NULL) { - return; - } - process_source(&sv); - - // Check if there were any errors. - if (errors_n != 0 && !supress_errors) { - for (size_t i = 0; i < errors_n; i++) { - Error err = errors[i]; - for (size_t j = 0; j < err.col + sizeof(REPL_PROMPT) - 2; j++) { - putchar(' '); - } - printf("|\n"); - for (size_t j = 0; j < err.col + sizeof(REPL_PROMPT) - 2; j++) { - putchar(' '); - } - printf("%s\n", error_msgs[err.value]); - } - errors_n = 0; - continue; - } - } -} - -void -run_file(char *file_name) { - FILE *file = fopen(file_name, "r"); - if (!file) { - fprintf(stderr, "error: couldn't open input file: %s\n", file_name); - exit(EXIT_FAILURE); - } - - // Read entire file into memory. - fseek(file, 0, SEEK_END); - size_t file_size = ftell(file); - fseek(file, 0, SEEK_SET); - - char *source = malloc(file_size + 1); - fread(source, 1, file_size, file); - source[file_size] = 0; - - StringView sv = (StringView){ - .start = source, - .n = file_size, - }; - - process_source(&sv); - - // Check if there were any errors. - if (errors_n != 0 && !supress_errors) { - for (size_t i = 0; i < errors_n; i++) { - Error err = errors[i]; - fprintf(stderr, "%s", file_name); - if (err.line != 0) { - fprintf(stderr, ":%ld:%ld", err.line, err.col); - } - fprintf(stderr, ": %s\n", error_msgs[err.value]); - } - errors_n = 0; - } - - free(source); - fclose(file); -} - -#define STDIN_BUF_CAP 16 - -void -run_stdin(void) { - size_t buf_size = 0; - char *source = NULL; - array_init(source, STDIN_BUF_CAP); - - char c; - while ((c = getchar()) != EOF) { - array_push(source, c); - buf_size++; - } - - StringView sv = (StringView){ - .start = source, - .n = buf_size, - }; - - process_source(&sv); - - // Check if there were any errors. - if (errors_n != 0 && !supress_errors) { - for (size_t i = 0; i < errors_n; i++) { - Error err = errors[i]; - fprintf(stderr, "stdin"); - if (err.line != 0) { - fprintf(stderr, ":%ld:%ld", err.line, err.col); - } - fprintf(stderr, ": %s\n", error_msgs[err.value]); - } - errors_n = 0; - } - - array_free(source); -} - -#ifndef BIN_NAME -#define BIN_NAME "bdl" -#endif - -void -print_usage(void) { - printf("Usage: %s [options] \n", BIN_NAME); - printf("\n"); - printf("\t-i\tInteractive mode (REPL).\n"); - printf("\n"); -} - -int -main(int argc, char *argv[]) { - init(); - - int option; - while ((option = getopt(argc, argv, "i")) != -1) { - switch (option) { - case 'i': { - // Interactive mode. - run_repl(); - return EXIT_SUCCESS; - } break; - default: { - print_usage(); - return EXIT_FAILURE; - } break; - } - } - - // Run from stdin. - if (optind == argc) { - run_stdin(); - return EXIT_SUCCESS; - } - - // Run from file. - while (optind < argc) { - char *file_name = argv[optind]; - run_file(file_name); - optind++; - } - - return EXIT_SUCCESS; -} diff --git a/src/bootstrap/objects.c b/src/bootstrap/objects.c deleted file mode 100644 index c71bc40..0000000 --- a/src/bootstrap/objects.c +++ /dev/null @@ -1,141 +0,0 @@ -#include "gc.h" -#include "objects.h" - -// -// Constructors. -// - -Object * -make_fixnum(ssize_t num) { - Object *obj = alloc_object(OBJ_TYPE_FIXNUM); - obj->fixnum = num; - return obj; -} - -Object * -make_procedure(Object *(*proc)(struct Environment *, struct Object *args)) { - Object *obj = alloc_object(OBJ_TYPE_PROCEDURE); - obj->proc = proc; - return obj; -} - -Object * -make_pair(Object *car, Object *cdr) { - Object *obj = alloc_object(OBJ_TYPE_PAIR); - obj->car = car; - obj->cdr = cdr; - return obj; -} - -Object * -make_symbol(StringView sv) { - Object *obj = alloc_object(OBJ_TYPE_SYMBOL); - obj->symbol = NULL; - array_init(obj->symbol, sv.n); - array_insert(obj->symbol, sv.start, sv.n); - return obj; -} - -Object * -make_string(void) { - Object *obj = alloc_object(OBJ_TYPE_STRING); - obj->string = NULL; - array_init(obj->string, 0); - return obj; -} - -void -append_string(Object *obj, const StringView sv) { - if (sv.n == 0) { - return; - } - array_insert(obj->string, sv.start, sv.n); -} - -void -display_pair(Object *root) { - display(root->car); - if (root->cdr->type == OBJ_TYPE_PAIR) { - printf(" "); - display_pair(root->cdr); - } else if (root->cdr == obj_nil) { - return; - } else { - printf(" . "); - display(root->cdr); - } -} - -void -display(Object *root) { - switch (root->type) { - case OBJ_TYPE_FIXNUM: { - printf("%zd", root->fixnum); - } break; - case OBJ_TYPE_BOOL: { - if (root == obj_true) { - printf("true"); - } else { - printf("false"); - } - } break; - case OBJ_TYPE_NIL: { - printf("()"); - } break; - case OBJ_TYPE_STRING: { - printf("\"%.*s\"", (int)array_size(root->string), root->string); - } break; - case OBJ_TYPE_SYMBOL: { - printf(":%.*s", (int)array_size(root->symbol), root->symbol); - } break; - case OBJ_TYPE_PAIR: { - printf("("); - display_pair(root); - printf(")"); - } break; - case OBJ_TYPE_LAMBDA: - case OBJ_TYPE_PROCEDURE: { - printf("#{procedure}"); - } break; - case OBJ_TYPE_ERR: { - printf("#{error}"); - } break; - } - return; -} - -bool -obj_eq(const Object *a, const Object* b) { - if (a->type != b->type) { - return false; - } - switch (a->type) { - case OBJ_TYPE_FIXNUM: { - return a->fixnum == b->fixnum; - } break; - case OBJ_TYPE_STRING: { - if (array_size(a->string) != array_size(b->string)) { - return false; - } - for (size_t i = 0; i < array_size(a->string); i++) { - if (a->string[i] != b->string[i]) { - return false; - } - } - } break; - case OBJ_TYPE_SYMBOL: { - if (array_size(a->symbol) != array_size(b->symbol)) { - return false; - } - for (size_t i = 0; i < array_size(a->symbol); i++) { - if (a->symbol[i] != b->symbol[i]) { - return false; - } - } - } break; - default: { - return a == b; - } break; - } - return true; -} diff --git a/src/bootstrap/objects.h b/src/bootstrap/objects.h deleted file mode 100644 index ed623eb..0000000 --- a/src/bootstrap/objects.h +++ /dev/null @@ -1,75 +0,0 @@ -#ifndef BDL_OBJECTS_H -#define BDL_OBJECTS_H - -#include "string_view.h" - -typedef enum ObjectType { - OBJ_TYPE_FIXNUM, - OBJ_TYPE_BOOL, - OBJ_TYPE_NIL, - OBJ_TYPE_SYMBOL, - OBJ_TYPE_STRING, - OBJ_TYPE_PAIR, - OBJ_TYPE_PROCEDURE, - OBJ_TYPE_LAMBDA, - OBJ_TYPE_ERR, -} ObjectType; - -struct Environment; - -typedef struct Object { - ObjectType type; - bool marked; - union { - // OBJ_TYPE_FIXNUM - ssize_t fixnum; - - // OBJ_TYPE_STRING - struct { - char *string; - }; - - // OBJ_TYPE_PAIR - struct { - struct Object *car; - struct Object *cdr; - }; - - // OBJ_TYPE_SYMBOL - struct { - char *symbol; - }; - - // OBJ_TYPE_PROCEDURE - struct Object *(*proc)(struct Environment *env, struct Object *args); - - // OBJ_TYPE_LAMBDA - struct { - struct Object *params; - struct Object *body; - struct Environment *env; - }; - }; -} Object; - -// Object constructors. -Object * make_fixnum(ssize_t num); -Object * make_procedure(Object *(*proc)(struct Environment *, Object *args)); -Object * make_pair(Object *car, Object *cdr); -Object * make_symbol(StringView sv); -Object * make_string(void); -void append_string(Object *obj, const StringView sv); - -// Object representation. -void display(Object *root); -void display_pair(Object *root); - -// Object comparison. -bool obj_eq(const Object *a, const Object* b); - -// Utility macros. -#define DEBUG_OBJ(MSG,OBJ) printf((MSG)); display(OBJ); printf("\n"); -#define PRINT_OBJ(OBJ) display(OBJ); printf("\n"); -#define MAKE_SYM(STR) make_symbol((StringView){(STR), sizeof(STR) - 1}) - -#endif // BDL_OBJECTS_H diff --git a/src/bootstrap/parser.c b/src/bootstrap/parser.c deleted file mode 100644 index a2f0f71..0000000 --- a/src/bootstrap/parser.c +++ /dev/null @@ -1,139 +0,0 @@ -#include "parser.h" - -Token -peek_token(const Visitor *visitor) { - return visitor->tokens[visitor->current]; -} - -Token -next_token(Visitor *visitor) { - return visitor->tokens[visitor->current++]; -} - -bool -has_next_token(const Visitor *visitor) { - return visitor->current < array_size(visitor->tokens); -} - -Object * -parse_fixnum(Token tok) { - ssize_t num = 0; - int sign = 1; - for (size_t i = 0; i < tok.value.n; i++) { - char c = tok.value.start[i]; - if (c == '-') { - sign = -1; - continue; - } - num = num * 10 + (c - '0'); - } - - Object *obj = make_fixnum(num * sign); - push_root(obj); - return obj; -} - -Object * -parse_list(Visitor *vs) { - Token tok = peek_token(vs); - if (tok.type == TOKEN_EOF) { - return obj_err; - } - Object *root = make_pair(obj_nil, obj_nil); - push_root(root); - Object *next_obj = parse_tree(vs); - if (next_obj == obj_err) { - return obj_err; - } - root->car = next_obj; - Object *list = root; - while (has_next_token(vs)) { - Token tok = peek_token(vs); - if (tok.type == TOKEN_RPAREN) { - next_token(vs); - break; - } - if (tok.type == TOKEN_EOF) { - return obj_err; - } - next_obj = parse_tree(vs); - if (next_obj == obj_err) { - return obj_err; - } - list->cdr = make_pair(next_obj, obj_nil); - list = list->cdr; - } - return root; -} - -Object * -parse_tree(Visitor *vs) { - Token tok = next_token(vs); - switch (tok.type) { - case TOKEN_FIXNUM: { - return parse_fixnum(tok); - } break; - case TOKEN_TRUE: { - return obj_true; - } break; - case TOKEN_FALSE: { - return obj_false; - } break; - case TOKEN_RPAREN: { - error_push((Error){ - .type = ERR_TYPE_PARSER, - .value = ERR_UNBALANCED_PAREN, - .line = tok.line, - .col = tok.column, - }); - return obj_err; - } break; - case TOKEN_QUOTE: { - Object *base = make_pair(obj_quote, obj_nil); - base->cdr = make_pair(obj_nil, obj_nil); - push_root(base); - Object *next_obj = parse_tree(vs); - if (next_obj == obj_err) { - return obj_err; - } - base->cdr->car = next_obj; - return base; - } break; - case TOKEN_LPAREN: { - Object *obj = parse_list(vs); - if (obj == obj_err) { - error_push((Error){ - .type = ERR_TYPE_PARSER, - .value = ERR_UNBALANCED_PAREN, - .line = tok.line, - .col = tok.column, - }); - } - return obj; - } break; - case TOKEN_STRING: { - Object *obj = make_string(); - push_root(obj); - append_string(obj, tok.value); - return obj; - } break; - case TOKEN_SYMBOL: { - Object *obj = make_symbol(tok.value); - push_root(obj); - return obj; - } break; - case TOKEN_NIL: { - return obj_nil; - } break; - default: { - break; - } break; - } - error_push((Error){ - .type = ERR_TYPE_PARSER, - .value = ERR_EOF_REACHED, - .line = tok.line, - .col = tok.column, - }); - return obj_err; -} diff --git a/src/bootstrap/parser.h b/src/bootstrap/parser.h deleted file mode 100644 index 3834c75..0000000 --- a/src/bootstrap/parser.h +++ /dev/null @@ -1,22 +0,0 @@ -#ifndef BDL_PARSER_H -#define BDL_PARSER_H - -typedef struct Visitor { - Token *tokens; - size_t current; -} Visitor; - -// Mimics the functionality in the Scanner functions, but for entire tokens. -Token next_token(Visitor *visitor); -Token peek_token(const Visitor *visitor); -bool has_next_token(const Visitor *visitor); - -// Parse a token into a fixnum object. -Object * parse_fixnum(Token tok); - -// Recursive descent parser. If an object is not a list the parsing is handled -// by the parse_tree function. -Object * parse_list(Visitor *vs); -Object * parse_tree(Visitor *vs); - -#endif // BDL_PARSER_H diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c deleted file mode 100644 index 8b0d407..0000000 --- a/src/bootstrap/primitives.c +++ /dev/null @@ -1,918 +0,0 @@ -#include "primitives.h" - -Object * -eval(Environment *env, Object *root) { - Object* lambda = NULL; - Object* args = NULL; - Object* ret = NULL; - bool recursion_active = false; -eval_start: - switch (root->type) { - case OBJ_TYPE_ERR: - case OBJ_TYPE_PROCEDURE: - case OBJ_TYPE_LAMBDA: - case OBJ_TYPE_FIXNUM: - case OBJ_TYPE_BOOL: - case OBJ_TYPE_NIL: - case OBJ_TYPE_STRING: { - ret = root; - goto eval_success; - } break; - case OBJ_TYPE_SYMBOL: { - Object *val = env_lookup(env, root); - if (val == obj_err) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_SYMBOL_NOT_FOUND, - }); - return obj_err; - } - ret = val; - goto eval_success; - } break; - case OBJ_TYPE_PAIR: { - if (root->car->type == OBJ_TYPE_SYMBOL) { - Object *val = env_lookup(env, root->car); - if (val == obj_err) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_SYMBOL_NOT_FOUND, - }); - return obj_err; - } - - // Primitive `if` procedure with TCO. - if (val == proc_if) { - Object *obj = root->cdr; - if (obj == obj_nil || obj->cdr == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - Object *car = obj->car; - Object *cdr = obj->cdr; - Object *condition = eval(env, car); - if (condition == obj_err) { - return obj_err; - } - if (condition == obj_true) { - root = cdr->car; - } else if (cdr->cdr != obj_nil) { - root = cdr->cdr->car; - } else { - return obj_nil; - } - goto eval_start; - } - - if (val->type == OBJ_TYPE_PROCEDURE) { - ret = val->proc(env, root->cdr); - goto eval_success; - } - if (val->type == OBJ_TYPE_LAMBDA) { - lambda = val; - goto eval_lambda; - } - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_OBJ_NOT_CALLABLE, - }); - return obj_err; - } - lambda = eval(env, root->car); - if (lambda == obj_err) { - return obj_err; - } - if (lambda->type != OBJ_TYPE_LAMBDA) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_OBJ_NOT_CALLABLE, - }); - return obj_err; - } - -eval_lambda: - args = root->cdr; - Object *params = lambda->params; - if (!recursion_active) { - recursion_active = true; - // Protect current stack. - Environment *tmp = env_create(lambda->env); - push_active_env(tmp); - // Extend environment. - env = env_extend(tmp, env); - } - - // Create temporary environment to store bindings. - Environment *tmp = env_create(env); - push_active_env(tmp); - - // Evaluate arguments in temporary environment. - while (params != obj_nil) { - if (args == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - if (args->car == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - Object *symbol = params->car; - Object *value = eval(env, args->car); - if (value == obj_err) { - return obj_err; - } - env_add_or_update_current(tmp, symbol, value); - args = args->cdr; - params = params->cdr; - } - if (args != obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_TOO_MANY_ARGS, - }); - return obj_err; - } - - // Copy temporary environment values to closure environment. - args = root->cdr; - params = lambda->params; - while (params != obj_nil) { - Object *symbol = params->car; - Object *value = env_lookup(tmp, symbol); - env_add_or_update_current(env, symbol, value); - args = args->cdr; - params = params->cdr; - } - - // Release the temporary environment protection. - pop_active_env(); - - // Run the body of the function. - root = lambda->body; - while (root->cdr != obj_nil) { - if (eval(env, root->car) == obj_err) { - return obj_err; - }; - root = root->cdr; - } - root = root->car; - goto eval_start; - } break; - } - - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_UNKNOWN_OBJ_TYPE, - }); - return obj_err; - -eval_success: - if (recursion_active) { - // Remove stack protector. - pop_active_env(); - } - return ret; -} - -Object * -proc_quote(Environment *env, Object *obj) { - (void)env; - return obj->car; -} - -static inline Object * -extract_car_with_type(Environment *env, Object *obj, ObjectType expected_type) { - if (obj == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - Object *car = eval(env, obj->car); - if (car == obj_err) { - return obj_err; - } - if (car->type != expected_type) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_WRONG_ARG_TYPE, - }); - return obj_err; - } - return car; -} - -// -// Arithmetic procedures. -// - -Object * -proc_sum(Environment *env, Object *obj) { - Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); - obj = obj->cdr; - ssize_t tot = car->fixnum; - while (obj != obj_nil) { - car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); - tot += car->fixnum; - obj = obj->cdr; - } - return make_fixnum(tot); -} - -Object * -proc_sub(Environment *env, Object *obj) { - Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); - obj = obj->cdr; - ssize_t tot = car->fixnum; - while (obj != obj_nil) { - car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); - tot -= car->fixnum; - obj = obj->cdr; - } - return make_fixnum(tot); -} - -Object * -proc_mul(Environment *env, Object *obj) { - Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); - obj = obj->cdr; - ssize_t tot = car->fixnum; - while (obj != obj_nil) { - car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); - tot *= car->fixnum; - obj = obj->cdr; - } - return make_fixnum(tot); -} - -Object * -proc_div(Environment *env, Object *obj) { - Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); - obj = obj->cdr; - ssize_t tot = car->fixnum; - while (obj != obj_nil) { - car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); - if (car->fixnum == 0) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_DIVISION_BY_ZERO, - }); - return obj_err; - } - tot /= car->fixnum; - obj = obj->cdr; - } - return make_fixnum(tot); -} - -Object * -proc_mod(Environment *env, Object *obj) { - Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); - obj = obj->cdr; - ssize_t tot = car->fixnum; - while (obj != obj_nil) { - car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); - if (car->fixnum == 0) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_DIVISION_BY_ZERO, - }); - return obj_err; - } - tot %= car->fixnum; - obj = obj->cdr; - } - return make_fixnum(tot); -} - -// -// Display/Evaluation procedues. -// - -Object * -proc_display(Environment *env, Object *obj) { - display(eval(env, obj->car)); - return obj_nil; -} - -Object * -proc_print(Environment *env, Object *obj) { - Object *car = extract_car_with_type(env, obj, OBJ_TYPE_STRING); - StringView scanner = (StringView) { - .start = car->string, - .n = array_size(car->string), - }; - while (scanner.n != 0) { - char c = sv_next(&scanner); - if (c == '\\' && sv_peek(&scanner) == 'n') { - putchar('\n'); - sv_next(&scanner); - continue; - } - if (c == '\\' && sv_peek(&scanner) == '"') { - putchar('"'); - sv_next(&scanner); - continue; - } - putchar(c); - } - return obj_nil; -} - -Object * -proc_newline(Environment *env, Object *obj) { - printf("\n"); - (void)env; - (void)obj; - return obj_nil; -} - -// -// Type info procedures. -// - -Object * -proc_is_boolean(Environment *env, Object *obj) { - if (obj == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - obj = eval(env, obj->car); - if (obj == obj_err) { - return obj_err; - } - return (obj == obj_true || obj == obj_false) ? obj_true : obj_false; -} - -Object * -proc_is_nil(Environment *env, Object *obj) { - if (obj == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - obj = eval(env, obj->car); - if (obj == obj_err) { - return obj_err; - } - return obj == obj_nil ? obj_true : obj_false; -} - -Object * -proc_is_symbol(Environment *env, Object *obj) { - if (obj == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - obj = eval(env, obj->car); - if (obj == obj_err) { - return obj_err; - } - return obj->type == OBJ_TYPE_SYMBOL ? obj_true : obj_false; -} - -Object * -proc_is_string(Environment *env, Object *obj) { - if (obj == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - obj = eval(env, obj->car); - if (obj == obj_err) { - return obj_err; - } - return obj->type == OBJ_TYPE_STRING ? obj_true : obj_false; -} - -Object * -proc_is_fixnum(Environment *env, Object *obj) { - if (obj == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - obj = eval(env, obj->car); - if (obj == obj_err) { - return obj_err; - } - return obj->type == OBJ_TYPE_FIXNUM ? obj_true : obj_false; -} - -Object * -proc_is_pair(Environment *env, Object *obj) { - if (obj == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - obj = eval(env, obj->car); - if (obj == obj_err) { - return obj_err; - } - return obj->type == OBJ_TYPE_PAIR ? obj_true : obj_false; -} - -Object * -proc_is_procedure(Environment *env, Object *obj) { - if (obj == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - obj = eval(env, obj->car); - if (obj == obj_err) { - return obj_err; - } - return obj->type == OBJ_TYPE_PROCEDURE ? obj_true : obj_false; -} - -Object * -proc_is_error(Environment *env, Object *obj) { - if (obj == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - obj = eval(env, obj->car); - if (obj == obj_err) { - return obj_true; - } - return obj_false; -} - -// -// Boolean/conditional procedures. -// - -Object * -proc_not(Environment *env, Object *obj) { - if (obj == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - obj = eval(env, obj->car); - if (obj == obj_err) { - return obj_err; - } - return obj == obj_false ? obj_true : obj_false; -} - -Object * -proc_and(Environment *env, Object *obj) { - while (obj != obj_nil) { - if (proc_not(env, obj) == obj_true) { - return obj_false; - } - obj = obj->cdr; - } - return obj_true; -} - -Object * -proc_or(Environment *env, Object *obj) { - while (obj != obj_nil) { - if (proc_not(env, obj) == obj_false) { - return obj_true; - } - obj = obj->cdr; - } - return obj_false; -} - -Object * -proc_cond(Environment *env, Object *obj) { - if (obj == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - while (obj != obj_nil) { - Object *clause = obj->car; - if (clause->type != OBJ_TYPE_PAIR || clause->cdr == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_WRONG_ARG_TYPE, - }); - return obj_err; - } - Object *test = clause->car; - Object *value = clause->cdr->car; - Object *result = eval(env, test); - if (result == obj_err) { - return obj_err; - } - if (result == obj_true) { - return eval(env, value); - } - obj = obj->cdr; - } - return obj_nil; -} - -Object * -proc_num_less_than(Environment *env, Object *obj) { - Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); - obj = obj->cdr; - ssize_t prev = car->fixnum; - while (obj != obj_nil) { - car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); - if (prev >= car->fixnum) { - return obj_false; - } - prev = car->fixnum; - obj = obj->cdr; - } - return obj_true; -} - -Object * -proc_num_greater_than(Environment *env, Object *obj) { - Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); - obj = obj->cdr; - ssize_t prev = car->fixnum; - while (obj != obj_nil) { - car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); - if (prev <= car->fixnum) { - return obj_false; - } - prev = car->fixnum; - obj = obj->cdr; - } - return obj_true; -} - -Object * -proc_num_lesseq_than(Environment *env, Object *obj) { - Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); - obj = obj->cdr; - ssize_t prev = car->fixnum; - while (obj != obj_nil) { - car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); - if (prev > car->fixnum) { - return obj_false; - } - prev = car->fixnum; - obj = obj->cdr; - } - return obj_true; -} - -Object * -proc_num_greatereq_than(Environment *env, Object *obj) { - Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); - obj = obj->cdr; - ssize_t prev = car->fixnum; - while (obj != obj_nil) { - car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); - if (prev < car->fixnum) { - return obj_false; - } - prev = car->fixnum; - obj = obj->cdr; - } - return obj_true; -} - -Object * -proc_num_equal(Environment *env, Object *obj) { - Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); - obj = obj->cdr; - ssize_t prev = car->fixnum; - while (obj != obj_nil) { - car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); - if (prev != car->fixnum) { - return obj_false; - } - prev = car->fixnum; - obj = obj->cdr; - } - return obj_true; -} - -// -// List operation procedures. -// - -Object * -proc_car(Environment *env, Object *obj) { - if (obj == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - obj = eval(env, obj->car); - if (obj == obj_err) { - return obj_err; - } - if (obj->type != OBJ_TYPE_PAIR) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_WRONG_ARG_TYPE, - }); - return obj_err; - } - return obj->car; -} - -Object * -proc_cdr(Environment *env, Object *obj) { - if (obj == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - obj = eval(env, obj->car); - if (obj == obj_err) { - return obj_err; - } - if (obj->type != OBJ_TYPE_PAIR) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_WRONG_ARG_TYPE, - }); - return obj_err; - } - return obj->cdr; -} - -Object * -proc_cons(Environment *env, Object *obj) { - if (obj == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - Object *head = make_pair(obj_nil, obj_nil); - push_root(head); - head->car = eval(env, obj->car); - if (head->car == obj_err) { - pop_root(); - return obj_err; - } - head->cdr = eval(env, obj->cdr->car); - if (head->cdr == obj_err) { - pop_root(); - return obj_err; - } - pop_root(); - return head; -} - -Object * -proc_list(Environment *env, Object *obj) { - if (obj == obj_nil) { - return obj_nil; - } - - Object *head = make_pair(obj_nil, obj_nil); - push_root(head); - Object *tmp = eval(env, obj->car); - if (tmp == obj_err) { - pop_root(); - return obj_err; - } - head->car = tmp; - Object *curr = head; - obj = obj->cdr; - while (obj != obj_nil) { - tmp = eval(env, obj->car); - if (tmp == obj_err) { - pop_root(); - return obj_err; - } - curr->cdr = make_pair(tmp, obj_nil); - curr = curr->cdr; - obj = obj->cdr; - } - pop_root(); - return head; -} - -// -// Polymorphic procedures. -// - -Object * -proc_equal(Environment *env, Object *obj) { - if (obj == obj_nil || obj->cdr == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - Object *a = eval(env, obj->car); - if (a == obj_err) { - return obj_err; - } - Object *b = eval(env, obj->cdr->car); - if (b == obj_err) { - return obj_err; - } - return obj_eq(a, b) ? obj_true : obj_false; -} - -// -// Variables and declarations. -// - -Object * -proc_define(Environment *env, Object *obj) { - if (obj == obj_nil || obj->cdr == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - - Object *symbol = obj->car; - if (symbol->type != OBJ_TYPE_SYMBOL) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_WRONG_ARG_TYPE, - }); - return obj_err; - } - - Object *value = eval(env, obj->cdr->car); - if (value == obj_err) { - return obj_err; - } - - env_add_or_update_current(env, symbol, value); - return obj_nil; -} - -Object * -proc_set(Environment *env, Object *obj) { - if (obj == obj_nil || obj->cdr == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - - Object *symbol = obj->car; - if (symbol->type != OBJ_TYPE_SYMBOL) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_WRONG_ARG_TYPE, - }); - return obj_err; - } - - Object *value = eval(env, obj->cdr->car); - if (value == obj_err) { - return obj_err; - } - - return env_update(env, symbol, value); -} - -Object * -proc_lambda(Environment *env, Object *obj) { - if (obj == obj_nil || obj->cdr == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - Object *params = obj->car; - if (params != obj_nil && params->type != OBJ_TYPE_PAIR) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_WRONG_ARG_TYPE, - }); - return obj_err; - } - Object *body = obj->cdr; - Object *fun = alloc_object(OBJ_TYPE_LAMBDA); - fun->params = params; - fun->body = body; - fun->env = env; - return fun; -} - -Object * -proc_fun(Environment *env, Object *obj) { - if (obj == obj_nil || obj->cdr == obj_nil || obj->cdr->cdr == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - - Object *name = obj->car; - if (name->type != OBJ_TYPE_SYMBOL) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_WRONG_ARG_TYPE, - }); - return obj_err; - } - - Object *params = obj->cdr->car; - if (params != obj_nil && params->type != OBJ_TYPE_PAIR) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_WRONG_ARG_TYPE, - }); - return obj_err; - } - Object *body = obj->cdr->cdr; - Object *fun = alloc_object(OBJ_TYPE_LAMBDA); - fun->params = params; - fun->body = body; - fun->env = env; - env_add_or_update_current(env, name, fun); - return obj_nil; -} - -// -// Evaluation. -// - -Object * -proc_eval(Environment *env, Object *obj) { - if (obj == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - return eval(env, eval(env, obj->car)); -} - -// -// Runtime configuration options. -// - -Object * -proc_supress_errors(Environment *env, Object *obj) { - Object *car = extract_car_with_type(env, obj, OBJ_TYPE_BOOL); - if (car == obj_err) { - return obj_err; - } - - if (car == obj_true) { - supress_errors = true; - } else if (car == obj_false) { - supress_errors = false; - } - return obj_nil; -} - -// TODO: map -// TODO: apply -// TODO: filter - -// TODO: fixnum left/right shift, mask, invert -// TODO: add primitives for type transforms: string->symbol, symbol->string, etc -// TODO: implement support for semi-quotes -// TODO: LAMBDA -// TODO: let diff --git a/src/bootstrap/primitives.h b/src/bootstrap/primitives.h deleted file mode 100644 index f874b17..0000000 --- a/src/bootstrap/primitives.h +++ /dev/null @@ -1,60 +0,0 @@ -#ifndef BDL_PRIMITIVES_H -#define BDL_PRIMITIVES_H - -// Function evaluation. -Object * eval(Environment *env, Object *root); - -// Evaluation functions. -Object * proc_quote(Environment *env, Object *obj); -Object * proc_eval(Environment *env, Object *obj); - -// Arithmetic. -Object * proc_sum(Environment *env, Object *obj); -Object * proc_sub(Environment *env, Object *obj); -Object * proc_mul(Environment *env, Object *obj); -Object * proc_div(Environment *env, Object *obj); -Object * proc_mod(Environment *env, Object *obj); - -// Printing. -Object * proc_display(Environment *env, Object *obj); -Object * proc_print(Environment *env, Object *obj); -Object * proc_newline(Environment *env, Object *obj); - -// Type checking. -Object * proc_is_boolean(Environment *env, Object *obj); -Object * proc_is_nil(Environment *env, Object *obj); -Object * proc_is_symbol(Environment *env, Object *obj); -Object * proc_is_string(Environment *env, Object *obj); -Object * proc_is_fixnum(Environment *env, Object *obj); -Object * proc_is_pair(Environment *env, Object *obj); -Object * proc_is_procedure(Environment *env, Object *obj); -Object * proc_is_error(Environment *env, Object *obj); - -// Logical operations. -Object * proc_not(Environment *env, Object *obj); -Object * proc_and(Environment *env, Object *obj); -Object * proc_or(Environment *env, Object *obj); -Object * proc_cond(Environment *env, Object *obj); -Object * proc_num_less_than(Environment *env, Object *obj); -Object * proc_num_greater_than(Environment *env, Object *obj); -Object * proc_num_lesseq_than(Environment *env, Object *obj); -Object * proc_num_greatereq_than(Environment *env, Object *obj); -Object * proc_num_equal(Environment *env, Object *obj); -Object * proc_equal(Environment *env, Object *obj); - -// List operations. -Object * proc_car(Environment *env, Object *obj); -Object * proc_cdr(Environment *env, Object *obj); -Object * proc_cons(Environment *env, Object *obj); -Object * proc_list(Environment *env, Object *obj); - -// Environment/variable manipulation. -Object * proc_define(Environment *env, Object *obj); -Object * proc_set(Environment *env, Object *obj); -Object * proc_lambda(Environment *env, Object *obj); -Object * proc_fun(Environment *env, Object *obj); - -// Runtinme configuration. -Object * proc_supress_errors(Environment *env, Object *obj); - -#endif // BDL_PRIMITIVES_H diff --git a/src/bootstrap/read_line.c b/src/bootstrap/read_line.c deleted file mode 100644 index 03146ad..0000000 --- a/src/bootstrap/read_line.c +++ /dev/null @@ -1,32 +0,0 @@ -#include "read_line.h" - -static char readline_buf[RL_BUF_SIZE]; - -StringView -read_line(void) { - // Clear buffer. - for (size_t i = 0; i < RL_BUF_SIZE; i++) { - readline_buf[i] = 0; - } - - // Barebones readline implementation. - size_t n = 0; - char c; - while ((c = getchar()) != '\n') { - if (c == '\b') { - readline_buf[n] = '\0'; - n--; - } else if (c == EOF || c == '\0') { - return (StringView){ .start = NULL, .n = 0 }; - } else if ((c >= ' ' && c <= '~') && n < RL_BUF_SIZE) { - readline_buf[n] = c; - n++; - } - } - - StringView sv = (StringView){ - .start = (char *)&readline_buf, - .n = n, - }; - return sv; -} diff --git a/src/bootstrap/read_line.h b/src/bootstrap/read_line.h deleted file mode 100644 index 160bce0..0000000 --- a/src/bootstrap/read_line.h +++ /dev/null @@ -1,10 +0,0 @@ -#ifndef BDL_READ_LINE_H -#define BDL_READ_LINE_H - -#include "string_view.h" - -StringView read_line(void); - -#define RL_BUF_SIZE 1024 - -#endif // BDL_READ_LINE_H diff --git a/src/bootstrap/singletons.c b/src/bootstrap/singletons.c deleted file mode 100644 index eb9c397..0000000 --- a/src/bootstrap/singletons.c +++ /dev/null @@ -1,17 +0,0 @@ -#include "environment.h" -#include "gc.h" -#include "objects.h" - -// Global garbage collector singleton. -static GC gc; - -// Special singleton Objects. -static Object *obj_nil; -static Object *obj_true; -static Object *obj_false; -static Object *obj_err; -static Object *obj_quote; -static Object *proc_if; - -// Global environment. -static Environment *global_env; diff --git a/src/bootstrap/string_view.c b/src/bootstrap/string_view.c deleted file mode 100644 index 39fabe9..0000000 --- a/src/bootstrap/string_view.c +++ /dev/null @@ -1,40 +0,0 @@ -#include "string_view.h" - -char -sv_next(StringView *sv) { - if (sv->n == 0) { - return '\0'; - } - char c = sv->start[0]; - sv->start++; - sv->n--; - return c; -} - -char -sv_peek(const StringView *sv) { - if (sv->n == 0) { - return '\0'; - } - return sv->start[0]; -} - -bool -sv_equal(const StringView *a, const StringView *b) { - if (a->n != b->n) { - return false; - } - for (size_t i = 0; i < a->n; i++) { - if (a->start[i] != b->start[i]) { - return false; - } - } - return true; -} - -void -sv_write(const StringView *sv, FILE *file) { - for (size_t i = 0; i < sv->n; i++) { - putc(sv->start[i], file); - } -} diff --git a/src/bootstrap/string_view.h b/src/bootstrap/string_view.h deleted file mode 100644 index 42273ab..0000000 --- a/src/bootstrap/string_view.h +++ /dev/null @@ -1,21 +0,0 @@ -#ifndef BDL_STRINGVIEW_H -#define BDL_STRINGVIEW_H - -typedef struct StringView { - char *start; - size_t n; -} StringView; - -// Consume a character in the stream. -char sv_next(StringView *sv); - -// Check what is the current character in the stream. -char sv_peek(const StringView *sv); - -// Compare if the arguments are the same. -bool sv_equal(const StringView *a, const StringView *b); - -// Write a character to the given output stream. -void sv_write(const StringView *sv, FILE *file); - -#endif // BDL_STRINGVIEW_H diff --git a/src/bytecode/darray.h b/src/bytecode/darray.h new file mode 100644 index 0000000..db6234d --- /dev/null +++ b/src/bytecode/darray.h @@ -0,0 +1,78 @@ +#ifndef BDL_DARRAY_H +#define BDL_DARRAY_H + +#include + +typedef struct ArrayHeader { + size_t size; + size_t cap; +} ArrayHeader; + +// Header/Size/capacity accessors. +#define array_head(ARR) ((ArrayHeader *)((char *)(ARR) - sizeof(ArrayHeader))) +#define array_size(ARR) ((ARR) ? array_head(ARR)->size : 0) +#define array_cap(ARR) ((ARR) ? array_head(ARR)->cap : 0) + +// Initialize a dynamic array ARR with N elements. The initialization doesn't +// zero out the data, so thread carefully.. +#define array_init(ARR,N) ((ARR) = _array_reserve(N, sizeof(*(ARR)))) + +// Push a given element T to the dynamic array ARR. +#define array_push(ARR, T) \ + ((ARR) = _array_maybe_grow(ARR, sizeof(T)), \ + (ARR)[array_head(ARR)->size++] = (T)) + +// Return the last element of the array. Can be used to build stacks. +#define array_pop(ARR) (ARR)[--array_head(ARR)->size] + +// Insert N bytes from the SRC array into the ARR dynamic array. +#define array_insert(ARR, SRC, N) \ + ((ARR) = _array_insert(ARR, SRC, N, sizeof(*(ARR)))) + +// Free the memory from the original allocated position. +#define array_free(ARR) ((ARR) ? free(array_head(ARR)), (ARR) = NULL : 0) + +static inline void * +_array_reserve(size_t num_elem, size_t type_size) { + char *p = malloc(num_elem * type_size + sizeof(ArrayHeader)); + p += sizeof(ArrayHeader); + array_head(p)->size = 0; + array_head(p)->cap = num_elem; + return p; +} + +static inline void * +_array_maybe_grow(void *arr, size_t type_size) { + ArrayHeader *head = array_head(arr); + if (head->cap == head->size) { + if (head->cap == 0) { + head->cap++; + } else { + head->cap *= 2; + } + head = realloc(head, head->cap * type_size + sizeof(ArrayHeader)); + } + arr = (char *)head + sizeof(ArrayHeader); + return arr; +} + +static inline +char * _array_insert(char *arr, const char *src, size_t n_bytes, size_t type_size) { + ArrayHeader *head = array_head(arr); + size_t new_size = n_bytes + head->size; + if (new_size >= head->cap * type_size) { + if (head->cap == 0) { + head->cap = 1; + } + while (new_size >= head->cap * type_size) { + head->cap *= 2; + } + head = realloc(head, head->cap * type_size + sizeof(ArrayHeader)); + } + arr = (char *)head + sizeof(ArrayHeader); + memcpy((arr + head->size), src, n_bytes); + head->size = new_size; + return arr; +} + +#endif // BDL_DARRAY_H diff --git a/src/bytecode/debug.h b/src/bytecode/debug.h new file mode 100644 index 0000000..3d08d8f --- /dev/null +++ b/src/bytecode/debug.h @@ -0,0 +1,32 @@ +#ifndef BDL_DEBUG_H +#define BDL_DEBUG_H + +void disassemble_chunk(u8 *chunk, const char *name); +size_t disassemble_instruction(u8 *chunk, size_t offset); + +void +disassemble_chunk(u8 *chunk, const char *name) { + printf("== %s ==\n", name); + size_t offset = 0; + while (offset < array_size(chunk)) { + offset = disassemble_instruction(chunk, offset); + } +} + +size_t +disassemble_instruction(u8 *chunk, size_t offset) { + printf("%04ld ", offset); + u8 instruction = chunk[offset]; + switch (instruction) { + case OP_RETURN: { + printf("OP_RETURN\n"); + return offset + 1; + } break; + default: { + printf("Unknown OP: %d\n", instruction); + return offset + 1; + } break; + } +} + +#endif // BDL_DEBUG_H diff --git a/src/bytecode/errors.c b/src/bytecode/errors.c new file mode 100644 index 0000000..d957cfa --- /dev/null +++ b/src/bytecode/errors.c @@ -0,0 +1,29 @@ +#include "errors.h" + +static const char* error_msgs[] = { + [ERR_UNKNOWN] = "error: something unexpected happened", + [ERR_UNMATCHED_STRING] = "error: unmatched string delimiter", + [ERR_UNBALANCED_PAREN] = "error: unbalanced parentheses", + [ERR_NOT_IMPLEMENTED] = "error: not implemented", + [ERR_EOF_REACHED] = "error: EOF reached", + [ERR_UNKNOWN_TOKEN] = "error: unknown token", + [ERR_UNKNOWN_OBJ_TYPE] = "error: can't eval unknown object type", + [ERR_NOT_A_SYMBOL] = "error: object is not a symbol", + [ERR_SYMBOL_NOT_FOUND] = "error: symbol not found", + [ERR_OBJ_NOT_CALLABLE] = "error: object is not callable", + [ERR_NOT_ENOUGH_ARGS] = "error: not enough arguments", + [ERR_TOO_MANY_ARGS] = "error: too many arguments", + [ERR_WRONG_ARG_TYPE] = "error: wrong argument type", + [ERR_DIVISION_BY_ZERO] = "error: division by zero", +}; + +static Error errors[ERR_MAX_NUMBER]; +static size_t errors_n = 0; +static bool supress_errors = false; + +void +error_push(Error error) { + if (errors_n < ERR_MAX_NUMBER) { + errors[errors_n++] = error; + } +} diff --git a/src/bytecode/errors.h b/src/bytecode/errors.h new file mode 100644 index 0000000..7916f4a --- /dev/null +++ b/src/bytecode/errors.h @@ -0,0 +1,38 @@ +#ifndef BDL_ERRORS_H +#define BDL_ERRORS_H + +typedef enum ErrorType { + ERR_TYPE_LEXER, + ERR_TYPE_PARSER, + ERR_TYPE_RUNTIME, +} ErrorType; + +typedef enum ErrorValue { + ERR_UNKNOWN = 0, + ERR_UNMATCHED_STRING, + ERR_UNBALANCED_PAREN, + ERR_NOT_IMPLEMENTED, + ERR_EOF_REACHED, + ERR_UNKNOWN_TOKEN, + ERR_UNKNOWN_OBJ_TYPE, + ERR_NOT_A_SYMBOL, + ERR_SYMBOL_NOT_FOUND, + ERR_OBJ_NOT_CALLABLE, + ERR_NOT_ENOUGH_ARGS, + ERR_TOO_MANY_ARGS, + ERR_WRONG_ARG_TYPE, + ERR_DIVISION_BY_ZERO, +} ErrorValue; + +typedef struct Error { + ErrorType type; + ErrorValue value; + size_t line; + size_t col; +} Error; + +void error_push(Error error); + +#define ERR_MAX_NUMBER 16 + +#endif // BDL_ERRORS_H diff --git a/src/bytecode/lexer.c b/src/bytecode/lexer.c new file mode 100644 index 0000000..38ca37c --- /dev/null +++ b/src/bytecode/lexer.c @@ -0,0 +1,257 @@ +#include "lexer.h" + +void +print_token(Token tok) { + printf("LINE: %3ld COL: %3ld ", tok.line, tok.column); + switch (tok.type) { + case TOKEN_LPAREN: { + printf("TOKEN_LPAREN"); + } break; + case TOKEN_RPAREN: { + printf("TOKEN_RPAREN"); + } break; + case TOKEN_QUOTE: { + printf("TOKEN_QUOTE"); + } break; + case TOKEN_TRUE: { + printf("TOKEN_TRUE"); + } break; + case TOKEN_FALSE: { + printf("TOKEN_FALSE"); + } break; + case TOKEN_NIL: { + printf("TOKEN_NIL"); + } break; + case TOKEN_FIXNUM: { + printf("TOKEN_FIXNUM -> "); + sv_write(&tok.value, stdout); + } break; + case TOKEN_SYMBOL: { + printf("TOKEN_SYMBOL -> "); + sv_write(&tok.value, stdout); + } break; + case TOKEN_STRING: { + printf("TOKEN_STRING -> "); + sv_write(&tok.value, stdout); + } break; + case TOKEN_EOF: { + printf("TOKEN_EOF"); + } break; + case TOKEN_UNKNOWN: { + printf("TOKEN_UNKNOWN"); + } break; + } + printf("\n"); +} + +char +scan_next(Scanner *scanner) { + char c = sv_next(&scanner->current); + if (c == '\n') { + scanner->line_number++; + scanner->col_number = 1; + } else { + scanner->col_number++; + } + scanner->offset++; + return c; +} + +char +scan_peek(const Scanner *scanner) { + return sv_peek(&scanner->current); +} + +bool +scan_has_next(const Scanner *scanner) { + return scanner->current.n != 0; +} + +void +skip_whitespace(Scanner *scanner) { + while (scan_has_next(scanner)) { + char c = scan_peek(scanner); + switch (c) { + case ' ': + case '\f': + case '\n': + case '\r': + case '\t': + case '\v': { + scan_next(scanner); + } break; + default: { + return; + } break; + } + } +} + +bool +is_delimiter(char c) { + switch (c) { + case EOF: + case '\0': + case ';': + case '"': + case '\'': + case '(': + case ')': + case ' ': + case '\f': + case '\n': + case '\r': + case '\t': + case '\v': { + return true; + } break; + } + return false; +} + +TokenType +find_primitive_type(const StringView value) { + bool is_fixnum = true; + for (size_t i = 0; i < value.n; i++) { + char c = value.start[i]; + if (i == 0 && c == '-' && value.n > 1) { + continue; + } + if (!(c >= '0' && c <= '9')) { + is_fixnum = false; + break; + } + } + if (is_fixnum) { + return TOKEN_FIXNUM; + } + if (sv_equal(&value, &(StringView){"true", 4})) { + return TOKEN_TRUE; + } + if (sv_equal(&value, &(StringView){"false", 5})) { + return TOKEN_FALSE; + } + return TOKEN_SYMBOL; +} + +Token * +tokenize(const StringView *sv) { + Token *tokens = NULL; + array_init(tokens, 1); + Scanner scanner = (Scanner){ + .current = *sv, + .line_number = 1, + .col_number = 1, + }; + + while (scan_has_next(&scanner)) { + skip_whitespace(&scanner); + size_t line = scanner.line_number; + size_t col = scanner.col_number; + size_t offset = scanner.offset; + char c = scan_next(&scanner); + switch (c) { + case ';': { + while ((c = scan_next(&scanner)) != '\n' && c != '\0') {} + } break; + case '"': { + char prev = c; + bool found = false; + size_t n = 0; + while (scan_has_next(&scanner)) { + c = scan_next(&scanner); + if (c == '"' && prev != '\\') { + found = true; + break; + } + prev = c; + n++; + } + if (!found) { + error_push((Error){ + .type = ERR_TYPE_LEXER, + .value = ERR_UNMATCHED_STRING, + .line = line, + .col = col, + }); + return tokens; + } + Token token = (Token){ + .value = (StringView){ + .start = &sv->start[offset + 1], + .n = n, + }, + .type = TOKEN_STRING, + .line = line, + .column = col, + }; + array_push(tokens, token); + } break; + case '\'': { + Token token = (Token){ + .type = TOKEN_QUOTE, + .line = line, + .column = col, + }; + array_push(tokens, token); + } break; + case '(': { + if (scan_peek(&scanner) == ')') { + scan_next(&scanner); + Token token = (Token){ + .type = TOKEN_NIL, + .line = line, + .column = col, + }; + array_push(tokens, token); + } else { + Token token = (Token){ + .type = TOKEN_LPAREN, + .line = line, + .column = col, + }; + array_push(tokens, token); + } + } break; + case ')': { + Token token = (Token){ + .type = TOKEN_RPAREN, + .line = line, + .column = col, + }; + array_push(tokens, token); + } break; + default: { + size_t n = 1; + while (!is_delimiter(scan_peek(&scanner))) { + scan_next(&scanner); + n++; + } + if (c == EOF || c == '\0') { + break; + } + Token token = (Token){ + .value = (StringView){ + .start = &sv->start[offset], + .n = n, + }, + .type = TOKEN_SYMBOL, + .line = line, + .column = col, + }; + token.type = find_primitive_type(token.value); + array_push(tokens, token); + } break; + } + } + + // Push EOF token. + Token token = (Token){ + .type = TOKEN_EOF, + .line = scanner.line_number, + .column = 1, + }; + array_push(tokens, token); + + return tokens; +} diff --git a/src/bytecode/lexer.h b/src/bytecode/lexer.h new file mode 100644 index 0000000..e58dd05 --- /dev/null +++ b/src/bytecode/lexer.h @@ -0,0 +1,60 @@ +#ifndef BDL_LEXER_H +#define BDL_LEXER_H + +#include "string_view.h" + + +typedef enum TokenType { + TOKEN_UNKNOWN = 0, + TOKEN_LPAREN, + TOKEN_RPAREN, + TOKEN_QUOTE, + TOKEN_TRUE, + TOKEN_FALSE, + TOKEN_NIL, + TOKEN_FIXNUM, + TOKEN_SYMBOL, + TOKEN_STRING, + TOKEN_EOF, +} TokenType; + +typedef struct Token { + TokenType type; + StringView value; + size_t line; + size_t column; +} Token; + +typedef struct Scanner { + StringView current; + size_t line_number; + size_t col_number; + size_t offset; +} Scanner; + +// Print a token to standard output for debugging purposes. +void print_token(Token tok); + +// Same functionality as the ScanView pairs, but keeping track of line and +// column numbers. +char scan_next(Scanner *scanner); +char scan_peek(const Scanner *scanner); + +// Check if the current scanner still have characters left. +bool scan_has_next(const Scanner *scanner); + +// Advance the scanner until we ran out of whitespace. +void skip_whitespace(Scanner *scanner); + +// Check if a given character is a delimiter. +bool is_delimiter(char c); + +// Extract the token type from the current string. +TokenType find_primitive_type(const StringView value); + +// Generate a list of tokens from the given string. +Token * tokenize(const StringView *sv); + +#define TOK_BUF_CAP 256 + +#endif // BDL_LEXER_H diff --git a/src/bytecode/main.c b/src/bytecode/main.c new file mode 100644 index 0000000..78fdfd3 --- /dev/null +++ b/src/bytecode/main.c @@ -0,0 +1,197 @@ +#include +#include +#include +#include +#include + +#include "types.h" +#include "darray.h" +#include "ops.h" +#include "debug.h" +#include "errors.c" +#include "lexer.c" +#include "read_line.c" +#include "string_view.c" + +void +init(void) { + // STUB +} + +void +process_source(const StringView *source) { + Token *tokens = tokenize(source); + if (errors_n != 0) { + array_free(tokens); + return; + } + + // Test chunks and debugging utilities. + u8 *chunk = NULL; + array_init(chunk, 0); + array_push(chunk, OP_RETURN); + array_push(chunk, OP_RETURN); + array_push(chunk, OP_RETURN); + array_push(chunk, OP_RETURN); + disassemble_chunk(chunk, "test chunk"); + + array_free(chunk); + array_free(tokens); +} + +#define REPL_PROMPT "bdl> " + +void +run_repl(void) { + printf("BDL REPL (Press Ctrl-D or Ctrl-C to exit)\n"); + while (true) { + printf(REPL_PROMPT); + StringView sv = read_line(); + if (sv.start == NULL) { + return; + } + process_source(&sv); + + // Check if there were any errors. + if (errors_n != 0 && !supress_errors) { + for (size_t i = 0; i < errors_n; i++) { + Error err = errors[i]; + for (size_t j = 0; j < err.col + sizeof(REPL_PROMPT) - 2; j++) { + putchar(' '); + } + printf("|\n"); + for (size_t j = 0; j < err.col + sizeof(REPL_PROMPT) - 2; j++) { + putchar(' '); + } + printf("%s\n", error_msgs[err.value]); + } + errors_n = 0; + continue; + } + } +} + +void +run_file(char *file_name) { + FILE *file = fopen(file_name, "r"); + if (!file) { + fprintf(stderr, "error: couldn't open input file: %s\n", file_name); + exit(EXIT_FAILURE); + } + + // Read entire file into memory. + fseek(file, 0, SEEK_END); + size_t file_size = ftell(file); + fseek(file, 0, SEEK_SET); + + char *source = malloc(file_size + 1); + fread(source, 1, file_size, file); + source[file_size] = 0; + + StringView sv = (StringView){ + .start = source, + .n = file_size, + }; + + process_source(&sv); + + // Check if there were any errors. + if (errors_n != 0 && !supress_errors) { + for (size_t i = 0; i < errors_n; i++) { + Error err = errors[i]; + fprintf(stderr, "%s", file_name); + if (err.line != 0) { + fprintf(stderr, ":%ld:%ld", err.line, err.col); + } + fprintf(stderr, ": %s\n", error_msgs[err.value]); + } + errors_n = 0; + } + + free(source); + fclose(file); +} + +#define STDIN_BUF_CAP 16 + +void +run_stdin(void) { + size_t buf_size = 0; + char *source = NULL; + array_init(source, STDIN_BUF_CAP); + + char c; + while ((c = getchar()) != EOF) { + array_push(source, c); + buf_size++; + } + + StringView sv = (StringView){ + .start = source, + .n = buf_size, + }; + + process_source(&sv); + + // Check if there were any errors. + if (errors_n != 0 && !supress_errors) { + for (size_t i = 0; i < errors_n; i++) { + Error err = errors[i]; + fprintf(stderr, "stdin"); + if (err.line != 0) { + fprintf(stderr, ":%ld:%ld", err.line, err.col); + } + fprintf(stderr, ": %s\n", error_msgs[err.value]); + } + errors_n = 0; + } + + array_free(source); +} + +#ifndef BIN_NAME +#define BIN_NAME "bdl" +#endif + +void +print_usage(void) { + printf("Usage: %s [options] \n", BIN_NAME); + printf("\n"); + printf("\t-i\tInteractive mode (REPL).\n"); + printf("\n"); +} + +int +main(int argc, char *argv[]) { + init(); + + int option; + while ((option = getopt(argc, argv, "i")) != -1) { + switch (option) { + case 'i': { + // Interactive mode. + run_repl(); + return EXIT_SUCCESS; + } break; + default: { + print_usage(); + return EXIT_FAILURE; + } break; + } + } + + // Run from stdin. + if (optind == argc) { + run_stdin(); + return EXIT_SUCCESS; + } + + // Run from file. + while (optind < argc) { + char *file_name = argv[optind]; + run_file(file_name); + optind++; + } + + return EXIT_SUCCESS; +} diff --git a/src/bytecode/ops.h b/src/bytecode/ops.h new file mode 100644 index 0000000..f7001ad --- /dev/null +++ b/src/bytecode/ops.h @@ -0,0 +1,8 @@ +#ifndef BDL_OPS_H +#define BDL_OPS_H + +typedef enum Ops { + OP_RETURN = 1, +} Ops; + +#endif // BDL_OPS_H diff --git a/src/bytecode/read_line.c b/src/bytecode/read_line.c new file mode 100644 index 0000000..03146ad --- /dev/null +++ b/src/bytecode/read_line.c @@ -0,0 +1,32 @@ +#include "read_line.h" + +static char readline_buf[RL_BUF_SIZE]; + +StringView +read_line(void) { + // Clear buffer. + for (size_t i = 0; i < RL_BUF_SIZE; i++) { + readline_buf[i] = 0; + } + + // Barebones readline implementation. + size_t n = 0; + char c; + while ((c = getchar()) != '\n') { + if (c == '\b') { + readline_buf[n] = '\0'; + n--; + } else if (c == EOF || c == '\0') { + return (StringView){ .start = NULL, .n = 0 }; + } else if ((c >= ' ' && c <= '~') && n < RL_BUF_SIZE) { + readline_buf[n] = c; + n++; + } + } + + StringView sv = (StringView){ + .start = (char *)&readline_buf, + .n = n, + }; + return sv; +} diff --git a/src/bytecode/read_line.h b/src/bytecode/read_line.h new file mode 100644 index 0000000..160bce0 --- /dev/null +++ b/src/bytecode/read_line.h @@ -0,0 +1,10 @@ +#ifndef BDL_READ_LINE_H +#define BDL_READ_LINE_H + +#include "string_view.h" + +StringView read_line(void); + +#define RL_BUF_SIZE 1024 + +#endif // BDL_READ_LINE_H diff --git a/src/bytecode/string_view.c b/src/bytecode/string_view.c new file mode 100644 index 0000000..39fabe9 --- /dev/null +++ b/src/bytecode/string_view.c @@ -0,0 +1,40 @@ +#include "string_view.h" + +char +sv_next(StringView *sv) { + if (sv->n == 0) { + return '\0'; + } + char c = sv->start[0]; + sv->start++; + sv->n--; + return c; +} + +char +sv_peek(const StringView *sv) { + if (sv->n == 0) { + return '\0'; + } + return sv->start[0]; +} + +bool +sv_equal(const StringView *a, const StringView *b) { + if (a->n != b->n) { + return false; + } + for (size_t i = 0; i < a->n; i++) { + if (a->start[i] != b->start[i]) { + return false; + } + } + return true; +} + +void +sv_write(const StringView *sv, FILE *file) { + for (size_t i = 0; i < sv->n; i++) { + putc(sv->start[i], file); + } +} diff --git a/src/bytecode/string_view.h b/src/bytecode/string_view.h new file mode 100644 index 0000000..42273ab --- /dev/null +++ b/src/bytecode/string_view.h @@ -0,0 +1,21 @@ +#ifndef BDL_STRINGVIEW_H +#define BDL_STRINGVIEW_H + +typedef struct StringView { + char *start; + size_t n; +} StringView; + +// Consume a character in the stream. +char sv_next(StringView *sv); + +// Check what is the current character in the stream. +char sv_peek(const StringView *sv); + +// Compare if the arguments are the same. +bool sv_equal(const StringView *a, const StringView *b); + +// Write a character to the given output stream. +void sv_write(const StringView *sv, FILE *file); + +#endif // BDL_STRINGVIEW_H diff --git a/src/bytecode/types.h b/src/bytecode/types.h new file mode 100644 index 0000000..dc21756 --- /dev/null +++ b/src/bytecode/types.h @@ -0,0 +1,30 @@ +#ifndef BDL_TYPES_H +#define BDL_TYPES_H + +#include +#include +#include + +typedef uint8_t u8; +typedef uint16_t u16; +typedef uint32_t u32; +typedef uint64_t u64; +typedef int8_t s8; +typedef int16_t s16; +typedef int32_t s32; +typedef int64_t s64; +typedef volatile u8 vu8; +typedef volatile u16 vu16; +typedef volatile u32 vu32; +typedef volatile u64 vu64; +typedef volatile s8 vs8; +typedef volatile s16 vs16; +typedef volatile s32 vs32; +typedef volatile s64 vs64; + +#define KB(N) ((u64)(N) * 1024) +#define MB(N) ((u64)KB(N) * 1024) +#define GB(N) ((u64)MB(N) * 1024) +#define TB(N) ((u64)GB(N) * 1024) + +#endif // BDL_TYPES_H diff --git a/src/treewalk/darray.h b/src/treewalk/darray.h new file mode 100644 index 0000000..db6234d --- /dev/null +++ b/src/treewalk/darray.h @@ -0,0 +1,78 @@ +#ifndef BDL_DARRAY_H +#define BDL_DARRAY_H + +#include + +typedef struct ArrayHeader { + size_t size; + size_t cap; +} ArrayHeader; + +// Header/Size/capacity accessors. +#define array_head(ARR) ((ArrayHeader *)((char *)(ARR) - sizeof(ArrayHeader))) +#define array_size(ARR) ((ARR) ? array_head(ARR)->size : 0) +#define array_cap(ARR) ((ARR) ? array_head(ARR)->cap : 0) + +// Initialize a dynamic array ARR with N elements. The initialization doesn't +// zero out the data, so thread carefully.. +#define array_init(ARR,N) ((ARR) = _array_reserve(N, sizeof(*(ARR)))) + +// Push a given element T to the dynamic array ARR. +#define array_push(ARR, T) \ + ((ARR) = _array_maybe_grow(ARR, sizeof(T)), \ + (ARR)[array_head(ARR)->size++] = (T)) + +// Return the last element of the array. Can be used to build stacks. +#define array_pop(ARR) (ARR)[--array_head(ARR)->size] + +// Insert N bytes from the SRC array into the ARR dynamic array. +#define array_insert(ARR, SRC, N) \ + ((ARR) = _array_insert(ARR, SRC, N, sizeof(*(ARR)))) + +// Free the memory from the original allocated position. +#define array_free(ARR) ((ARR) ? free(array_head(ARR)), (ARR) = NULL : 0) + +static inline void * +_array_reserve(size_t num_elem, size_t type_size) { + char *p = malloc(num_elem * type_size + sizeof(ArrayHeader)); + p += sizeof(ArrayHeader); + array_head(p)->size = 0; + array_head(p)->cap = num_elem; + return p; +} + +static inline void * +_array_maybe_grow(void *arr, size_t type_size) { + ArrayHeader *head = array_head(arr); + if (head->cap == head->size) { + if (head->cap == 0) { + head->cap++; + } else { + head->cap *= 2; + } + head = realloc(head, head->cap * type_size + sizeof(ArrayHeader)); + } + arr = (char *)head + sizeof(ArrayHeader); + return arr; +} + +static inline +char * _array_insert(char *arr, const char *src, size_t n_bytes, size_t type_size) { + ArrayHeader *head = array_head(arr); + size_t new_size = n_bytes + head->size; + if (new_size >= head->cap * type_size) { + if (head->cap == 0) { + head->cap = 1; + } + while (new_size >= head->cap * type_size) { + head->cap *= 2; + } + head = realloc(head, head->cap * type_size + sizeof(ArrayHeader)); + } + arr = (char *)head + sizeof(ArrayHeader); + memcpy((arr + head->size), src, n_bytes); + head->size = new_size; + return arr; +} + +#endif // BDL_DARRAY_H diff --git a/src/treewalk/environment.c b/src/treewalk/environment.c new file mode 100644 index 0000000..dd4a648 --- /dev/null +++ b/src/treewalk/environment.c @@ -0,0 +1,72 @@ +#include "environment.h" +#include "gc.h" +#include "errors.h" + +Environment * +env_create(Environment *parent) { + Environment *env = alloc_env(); + env->parent = parent; + env->marked = false; + env->table = ht_init(); + return env; +} + +void +env_add_symbol(Environment *env, Object *symbol, Object *value) { + if (symbol->type != OBJ_TYPE_SYMBOL) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_A_SYMBOL, + .line = 0, + .col = 0, + }); + return; + } + ht_insert(env->table, symbol, value); +} + +Object * +env_lookup(Environment *env, Object *symbol) { + while (env != NULL) { + Object *obj = ht_lookup(env->table, symbol); + if (obj != NULL) { + return obj; + } + env = env->parent; + } + return obj_err; +} + +Object * +env_update(Environment *env, Object *symbol, Object *value) { + while (env != NULL) { + Object *obj = ht_lookup(env->table, symbol); + if (obj != NULL) { + ht_insert(env->table, symbol, value); + return obj_nil; + } + env = env->parent; + } + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_SYMBOL_NOT_FOUND, + }); + return obj_err; +} + +void +env_add_or_update_current(Environment *env, Object *symbol, Object *value) { + ht_insert(env->table, symbol, value); +} + +Environment * +env_extend(Environment *parent, Environment *extra) { + Environment *env = parent; + HashTablePair *pairs = extra->table->pairs; + for (size_t i = 0; i < array_cap(pairs); i++) { + if (pairs[i].key != NULL) { + ht_insert(env->table, pairs[i].key, pairs[i].value); + } + } + return env; +} diff --git a/src/treewalk/environment.h b/src/treewalk/environment.h new file mode 100644 index 0000000..5ee21ad --- /dev/null +++ b/src/treewalk/environment.h @@ -0,0 +1,27 @@ +#ifndef BDL_ENVIRONMENT_H +#define BDL_ENVIRONMENT_H + +#include "objects.h" + +typedef struct Environment { + struct Environment *parent; + HashTable *table; + bool marked; +} Environment; + +Environment * env_create(Environment *parent); +void env_add_symbol(Environment *env, Object *symbol, Object *value); +Object * env_lookup(Environment *env, Object *symbol); +Object * env_update(Environment *env, Object *symbol, Object *value); +ssize_t env_index_current(Environment *env, Object *symbol); +void env_add_or_update_current(Environment *env, Object *symbol, Object *value); +Environment * env_extend(Environment *parent, Environment *extra); + +#define MAKE_ENV_VAR(ENV,STR,VAR) \ + (env_add_symbol((ENV), MAKE_SYM(STR), (VAR))) +#define MAKE_ENV_PROC(ENV,STR,FUN) \ + (env_add_symbol((ENV), MAKE_SYM(STR), make_procedure(FUN))) + +#define ENV_BUF_CAP 8 + +#endif // BDL_ENVIRONMENT_H diff --git a/src/treewalk/errors.c b/src/treewalk/errors.c new file mode 100644 index 0000000..d957cfa --- /dev/null +++ b/src/treewalk/errors.c @@ -0,0 +1,29 @@ +#include "errors.h" + +static const char* error_msgs[] = { + [ERR_UNKNOWN] = "error: something unexpected happened", + [ERR_UNMATCHED_STRING] = "error: unmatched string delimiter", + [ERR_UNBALANCED_PAREN] = "error: unbalanced parentheses", + [ERR_NOT_IMPLEMENTED] = "error: not implemented", + [ERR_EOF_REACHED] = "error: EOF reached", + [ERR_UNKNOWN_TOKEN] = "error: unknown token", + [ERR_UNKNOWN_OBJ_TYPE] = "error: can't eval unknown object type", + [ERR_NOT_A_SYMBOL] = "error: object is not a symbol", + [ERR_SYMBOL_NOT_FOUND] = "error: symbol not found", + [ERR_OBJ_NOT_CALLABLE] = "error: object is not callable", + [ERR_NOT_ENOUGH_ARGS] = "error: not enough arguments", + [ERR_TOO_MANY_ARGS] = "error: too many arguments", + [ERR_WRONG_ARG_TYPE] = "error: wrong argument type", + [ERR_DIVISION_BY_ZERO] = "error: division by zero", +}; + +static Error errors[ERR_MAX_NUMBER]; +static size_t errors_n = 0; +static bool supress_errors = false; + +void +error_push(Error error) { + if (errors_n < ERR_MAX_NUMBER) { + errors[errors_n++] = error; + } +} diff --git a/src/treewalk/errors.h b/src/treewalk/errors.h new file mode 100644 index 0000000..7916f4a --- /dev/null +++ b/src/treewalk/errors.h @@ -0,0 +1,38 @@ +#ifndef BDL_ERRORS_H +#define BDL_ERRORS_H + +typedef enum ErrorType { + ERR_TYPE_LEXER, + ERR_TYPE_PARSER, + ERR_TYPE_RUNTIME, +} ErrorType; + +typedef enum ErrorValue { + ERR_UNKNOWN = 0, + ERR_UNMATCHED_STRING, + ERR_UNBALANCED_PAREN, + ERR_NOT_IMPLEMENTED, + ERR_EOF_REACHED, + ERR_UNKNOWN_TOKEN, + ERR_UNKNOWN_OBJ_TYPE, + ERR_NOT_A_SYMBOL, + ERR_SYMBOL_NOT_FOUND, + ERR_OBJ_NOT_CALLABLE, + ERR_NOT_ENOUGH_ARGS, + ERR_TOO_MANY_ARGS, + ERR_WRONG_ARG_TYPE, + ERR_DIVISION_BY_ZERO, +} ErrorValue; + +typedef struct Error { + ErrorType type; + ErrorValue value; + size_t line; + size_t col; +} Error; + +void error_push(Error error); + +#define ERR_MAX_NUMBER 16 + +#endif // BDL_ERRORS_H diff --git a/src/treewalk/gc.c b/src/treewalk/gc.c new file mode 100644 index 0000000..358a07e --- /dev/null +++ b/src/treewalk/gc.c @@ -0,0 +1,199 @@ +#include "gc.h" + +Environment * +alloc_env(void) { + if (array_size(gc.free_envs.offsets) == 0) { + mark_and_sweep(); + if (array_size(gc.free_envs.offsets) == 0) { + fprintf(stderr, "NO MORE ENV MEMORY AVAILABLE WHERE IS YOUR GOD NOW MWAHAHA\n"); + dump_gc(); + exit(EXIT_FAILURE); + // TODO: grow heap tables. + } + } + size_t slot = gc.free_envs.offsets[gc.free_envs.position++]; + array_head(gc.free_envs.offsets)->size--; + return &gc.envs[slot]; +} + +void +push_root(Object *obj) { + array_push(gc.roots, obj); +} + +Object * +pop_root(void) { + return array_pop(gc.roots); +} + +void +push_active_env(Environment *env) { + array_push(gc.active_envs, env); +} + +Environment * +pop_active_env(void) { + return array_pop(gc.active_envs); +} + +void +gc_init(void) { + gc = (GC){0}; + + array_init(gc.objects, GC_OBJS_CAP); + array_init(gc.roots, GC_ROOTS_CAP); + array_init(gc.active_envs, GC_ACTIVE_ENVS_CAP); + array_init(gc.envs, GC_ENVS_CAP); + array_init(gc.free_objects.offsets, GC_OBJS_CAP); + array_init(gc.free_envs.offsets, GC_ENVS_CAP); + + // The free list stores the offset from the initial position for all + // available slots. + for (size_t i = 0; i < GC_OBJS_CAP; i++) { + array_push(gc.free_objects.offsets, i); + } + for (size_t i = 0; i < GC_ENVS_CAP; i++) { + array_push(gc.free_envs.offsets, i); + } +} + +void +mark_environment(Environment *env) { + if (env == NULL || env->marked) { + return; + } + env->marked = true; + HashTablePair *pairs = env->table->pairs; + for (size_t i = 0; i < array_cap(pairs); i++) { + if (pairs[i].key != NULL) { + mark_obj(pairs[i].key); + mark_obj(pairs[i].value); + } + } +} + +void +mark_obj(Object *obj) { + if (obj->marked) { + return; + } + obj->marked = true; + if (obj->type == OBJ_TYPE_PAIR) { + mark_obj(obj->car); + mark_obj(obj->cdr); + } + if (obj->type == OBJ_TYPE_LAMBDA) { + mark_obj(obj->params); + mark_obj(obj->body); + mark_environment(obj->env); + } +} + +void +mark_and_sweep(void) { + // Mark. + for (size_t i = 0; i < array_size(gc.active_envs); i++) { + mark_environment(gc.active_envs[i]); + } + for (size_t i = 0; i < array_size(gc.roots); i++) { + mark_obj(gc.roots[i]); + } + + // Reset the free list. + gc.free_objects.position = 0; + array_head(gc.free_objects.offsets)->size = 0; + gc.free_envs.position = 0; + array_head(gc.free_envs.offsets)->size = 0; + + // Sweep. + for (size_t i = 0; i < array_cap(gc.objects); i++) { + Object *obj = &gc.objects[i]; + if (!obj->marked) { + // Free heap allocated memory for this object if needed. + if (obj->type == OBJ_TYPE_SYMBOL) { + array_free(obj->symbol); + } else if (obj->type == OBJ_TYPE_STRING) { + array_free(obj->string); + } + gc.free_objects.offsets[array_head(gc.free_objects.offsets)->size++] = i; + } + obj->marked = false; + } + for (size_t i = 0; i < array_cap(gc.envs); i++) { + Environment *env = &gc.envs[i]; + if (!env->marked) { + ht_free(env->table); + gc.free_envs.offsets[array_head(gc.free_envs.offsets)->size++] = i; + } + env->marked = false; + } +} + +void +dump_gc(void) { + printf("-------------- ROOTS -------------- \n"); + for (size_t i = 0; i < array_size(gc.roots); i++) { + display(gc.roots[i]); + printf("\n"); + } + printf("--------- OBJECTS (TOP 20) -------- \n"); + for (size_t i = 0; i < 20; i++) { + printf("i: %ld -> ", i); + Object *obj = &gc.objects[i]; + display(obj); + bool is_free = false; + for (size_t j = 0; j < array_cap(gc.objects); j++) { + if (gc.free_objects.offsets[j] == i) { + is_free = true; + break; + } + } + if (is_free) { + printf(" [FREE]"); + } + printf("\n"); + } + printf("-------------- MISC --------------- \n"); + printf("gc.roots.size: %ld\n", array_size(gc.roots)); + printf("gc.roots.cap: %ld\n", array_size(gc.roots)); + printf("gc.active_envs.size: %ld\n", array_size(gc.active_envs)); + printf("gc.active_envs.cap: %ld\n", array_cap(gc.active_envs)); + printf("gc.obj_cap: %ld\n", array_cap(gc.objects)); + printf("gc.free_objects.size: %ld\n", array_size(gc.free_objects.offsets)); + printf("gc.free_objects.cap: %ld\n", array_cap(gc.free_objects.offsets)); + printf("gc.free_objects.position: %ld\n", gc.free_objects.position); + printf("array_size(gc.free_envs.offsets): %ld\n", array_size(gc.free_envs.offsets)); + printf("gc.free_envs.cap: %ld\n", array_cap(gc.free_envs.offsets)); + printf("gc.free_envs.position: %ld\n", gc.free_envs.position); + printf("gc.envs.size: %ld\n", array_size(gc.envs)); + printf("gc.envs.cap: %ld\n", array_cap(gc.envs)); +} + +Object * +alloc_object(ObjectType type) { + if (array_head(gc.free_objects.offsets)->size == 0) { + mark_and_sweep(); + if (array_head(gc.free_objects.offsets)->size == 0) { + fprintf(stderr, "NO MORE OBJ MEMORY AVAILABLE WHERE IS YOUR GOD NOW MWAHAHA\n"); + dump_gc(); + exit(EXIT_FAILURE); + // TODO: grow heap tables. + // NOTE: When growing the tables, we WILL lose the pointer + // references! Should we work with offsets all the way? That is for + // cdr and car? Should we have a utility function? All in all, we + // need to refactor the codebase first to work with pointer offsets + // rather than objects. This issue is very important, if we are in + // the middle of an operation that tries to allocate memory but we + // had saved pointers to some object, the pointer references may be + // invalidated, crashing or worse, silently returning garbage! Let's + // move on for now implementing the GC and we will revisit this part + // later. + } + } + size_t slot = gc.free_objects.offsets[gc.free_objects.position++]; + array_head(gc.free_objects.offsets)->size--; + Object *obj = &gc.objects[slot]; + obj->type = type; + obj->marked = false; + return obj; +} diff --git a/src/treewalk/gc.h b/src/treewalk/gc.h new file mode 100644 index 0000000..9ad1615 --- /dev/null +++ b/src/treewalk/gc.h @@ -0,0 +1,46 @@ +#ifndef BDL_GC_H +#define BDL_GC_H + +#include "objects.h" +#include "environment.h" + +typedef struct FreeList { + size_t *offsets; + size_t position; +} FreeList; + +typedef struct GC { + Object **roots; + Environment *envs; + Object *objects; + FreeList free_objects; + FreeList free_envs; + Environment **active_envs; +} GC; + +void gc_init(void); + +// Allocation functions for objects and environments. +Object * alloc_object(ObjectType type); +Environment * alloc_env(void); + +// Root and environment protector functions. +void push_root(Object *obj); +Object * pop_root(void); +void push_active_env(Environment *env); +Environment * pop_active_env(void); + +// Mark and sweep algorithm functions. +void mark_environment(Environment *env); +void mark_obj(Object *obj); +void mark_and_sweep(void); + +// Debugging function to print out the contentes of some GC fields. +void dump_gc(void); + +#define GC_OBJS_CAP 1024 * 1024 +#define GC_ROOTS_CAP 1024 +#define GC_ACTIVE_ENVS_CAP 2 +#define GC_ENVS_CAP 1024 * 4 + +#endif // BDL_GC_H diff --git a/src/treewalk/hashtable.h b/src/treewalk/hashtable.h new file mode 100644 index 0000000..8f210e3 --- /dev/null +++ b/src/treewalk/hashtable.h @@ -0,0 +1,191 @@ +#ifndef BDL_HASHTABLE_H +#define BDL_HASHTABLE_H + +#include "darray.h" +#include "objects.h" + +// Minimum table capacity. +#define HT_MIN_CAP 4 +#define HT_MIN_SHIFT 2 + +// Adjust the load factor threshold at which the table will grow on insertion. +#define HT_LOAD_THRESHOLD 0.8 + +typedef struct HashTablePair { + Object *key; + Object *value; +} HashTablePair; + +typedef struct HashTable { + // All available key-value pairs as a dynamic array. + HashTablePair *pairs; + + // This table expects the number of buckets to grow in powers of two. To + // speedup the default hashing, we memoize the number of bits equivalent to + // that power of 2: + // + // cap := 1024 = 2 ^ 10, shift_amount := 10 + // + uint8_t shift_amount; +} HashTable; + +// Hash a byte stream using a circular shift + XOR hash function. +static inline uint64_t +_xor_shift_hash(const char *key, size_t n) { + uint64_t hash = 0x65d9d65f6a19574f; + char *last = (char *)key + n; + while (key != last) { + hash ^= (uint64_t)*key++; + hash = (hash << 8) | (hash >> (64 - 8)); + } + return hash; +} + +// Use Fibonacci hashing to map a hash to a value in range of the table. +static inline uint64_t +_fibonacci_hash(uint64_t hash, size_t shift_amount) { + return (hash * UINT64_C(11400714819323198485)) >> (64 - shift_amount); +} + +uint64_t +ht_hash(const HashTable *table, const Object *key) { + uint64_t hash = 0; + switch (key->type) { + case OBJ_TYPE_FIXNUM: { + hash = key->fixnum; + } break; + case OBJ_TYPE_STRING: { + hash = _xor_shift_hash(key->string, array_size(key->string)); + } break; + case OBJ_TYPE_SYMBOL: { + hash = _xor_shift_hash(key->symbol, array_size(key->symbol)); + } break; + case OBJ_TYPE_BOOL: + case OBJ_TYPE_NIL: + case OBJ_TYPE_PAIR: + case OBJ_TYPE_LAMBDA: + case OBJ_TYPE_PROCEDURE: + case OBJ_TYPE_ERR: { + hash = (uintptr_t)key; + } break; + } + hash = _fibonacci_hash(hash, table->shift_amount); + return hash; +} + +static inline float +ht_load_factor(const HashTable *table) { + return (float)array_size(table->pairs) / (float)array_cap(table->pairs); +} + +HashTable * +ht_init(void) { + HashTable *table = malloc(sizeof(HashTable)); + table->pairs = NULL; + array_init(table->pairs, HT_MIN_CAP); + for (size_t i = 0; i < array_cap(table->pairs); i++) { + table->pairs[i] = (HashTablePair){NULL, NULL}; + } + table->shift_amount = HT_MIN_SHIFT; + return table; +} + +void +_ht_insert(HashTable *table, const Object *key, const Object *value) { + size_t position = ht_hash(table, key); + size_t probe_position = position; + + // Verify the key in that position is free. If not, use linear probing to + // find the next free slot. + HashTablePair *pairs = table->pairs; + while (true) { + if (pairs[probe_position].key == NULL) { + array_head(pairs)->size++; + break; + } + if (obj_eq(pairs[probe_position].key, key)) { + break; + } + if (probe_position == array_cap(pairs) - 1) { + probe_position = 0; + } else { + probe_position++; + } + } + pairs[probe_position].key = (Object *)key; + pairs[probe_position].value = (Object *)value; +} + +void +_ht_maybe_grow(HashTable *table) { + HashTablePair *pairs = table->pairs; + if (ht_load_factor(table) < HT_LOAD_THRESHOLD) { + return; + } + + // Create a new array with 2x capacity. + table->pairs = NULL; + array_init(table->pairs, array_cap(pairs) * 2); + for (size_t i = 0; i < array_cap(table->pairs); i++) { + table->pairs[i] = (HashTablePair){NULL, NULL}; + } + table->shift_amount++; + + // Hash everything in the table for the new array capacity. + for (size_t i = 0; i < array_cap(pairs); i++) { + if (pairs[i].key != NULL) { + _ht_insert(table, pairs[i].key, pairs[i].value); + } + } + + // Free the old array. + array_free(pairs); +} + +void +ht_insert(HashTable *table, const Object *key, const Object *value) { + _ht_maybe_grow(table); + _ht_insert(table, key, value); + return; +} + +Object * +ht_lookup(const HashTable *table, const Object *key) { + size_t position = ht_hash(table, key); + size_t probe_position = position; + + // Verify the key in that position is the same. If not perform linear + // probing to find it. + HashTablePair *pairs = table->pairs; + while (true) { + if (pairs[probe_position].key == NULL) { + return NULL; + } + if (obj_eq(pairs[probe_position].key, key)) { + break; + } + if (probe_position == array_cap(pairs) - 1) { + probe_position = 0; + } else { + probe_position++; + } + if (probe_position == position) { + return NULL; + } + } + return pairs[probe_position].value; +} + +void +ht_free(HashTable *table) { + if (table == NULL) { + return; + } + if (table->pairs == NULL) { + return; + } + array_free(table->pairs); + free(table); +} + +#endif // BDL_HASHTABLE_H diff --git a/src/treewalk/lexer.c b/src/treewalk/lexer.c new file mode 100644 index 0000000..38ca37c --- /dev/null +++ b/src/treewalk/lexer.c @@ -0,0 +1,257 @@ +#include "lexer.h" + +void +print_token(Token tok) { + printf("LINE: %3ld COL: %3ld ", tok.line, tok.column); + switch (tok.type) { + case TOKEN_LPAREN: { + printf("TOKEN_LPAREN"); + } break; + case TOKEN_RPAREN: { + printf("TOKEN_RPAREN"); + } break; + case TOKEN_QUOTE: { + printf("TOKEN_QUOTE"); + } break; + case TOKEN_TRUE: { + printf("TOKEN_TRUE"); + } break; + case TOKEN_FALSE: { + printf("TOKEN_FALSE"); + } break; + case TOKEN_NIL: { + printf("TOKEN_NIL"); + } break; + case TOKEN_FIXNUM: { + printf("TOKEN_FIXNUM -> "); + sv_write(&tok.value, stdout); + } break; + case TOKEN_SYMBOL: { + printf("TOKEN_SYMBOL -> "); + sv_write(&tok.value, stdout); + } break; + case TOKEN_STRING: { + printf("TOKEN_STRING -> "); + sv_write(&tok.value, stdout); + } break; + case TOKEN_EOF: { + printf("TOKEN_EOF"); + } break; + case TOKEN_UNKNOWN: { + printf("TOKEN_UNKNOWN"); + } break; + } + printf("\n"); +} + +char +scan_next(Scanner *scanner) { + char c = sv_next(&scanner->current); + if (c == '\n') { + scanner->line_number++; + scanner->col_number = 1; + } else { + scanner->col_number++; + } + scanner->offset++; + return c; +} + +char +scan_peek(const Scanner *scanner) { + return sv_peek(&scanner->current); +} + +bool +scan_has_next(const Scanner *scanner) { + return scanner->current.n != 0; +} + +void +skip_whitespace(Scanner *scanner) { + while (scan_has_next(scanner)) { + char c = scan_peek(scanner); + switch (c) { + case ' ': + case '\f': + case '\n': + case '\r': + case '\t': + case '\v': { + scan_next(scanner); + } break; + default: { + return; + } break; + } + } +} + +bool +is_delimiter(char c) { + switch (c) { + case EOF: + case '\0': + case ';': + case '"': + case '\'': + case '(': + case ')': + case ' ': + case '\f': + case '\n': + case '\r': + case '\t': + case '\v': { + return true; + } break; + } + return false; +} + +TokenType +find_primitive_type(const StringView value) { + bool is_fixnum = true; + for (size_t i = 0; i < value.n; i++) { + char c = value.start[i]; + if (i == 0 && c == '-' && value.n > 1) { + continue; + } + if (!(c >= '0' && c <= '9')) { + is_fixnum = false; + break; + } + } + if (is_fixnum) { + return TOKEN_FIXNUM; + } + if (sv_equal(&value, &(StringView){"true", 4})) { + return TOKEN_TRUE; + } + if (sv_equal(&value, &(StringView){"false", 5})) { + return TOKEN_FALSE; + } + return TOKEN_SYMBOL; +} + +Token * +tokenize(const StringView *sv) { + Token *tokens = NULL; + array_init(tokens, 1); + Scanner scanner = (Scanner){ + .current = *sv, + .line_number = 1, + .col_number = 1, + }; + + while (scan_has_next(&scanner)) { + skip_whitespace(&scanner); + size_t line = scanner.line_number; + size_t col = scanner.col_number; + size_t offset = scanner.offset; + char c = scan_next(&scanner); + switch (c) { + case ';': { + while ((c = scan_next(&scanner)) != '\n' && c != '\0') {} + } break; + case '"': { + char prev = c; + bool found = false; + size_t n = 0; + while (scan_has_next(&scanner)) { + c = scan_next(&scanner); + if (c == '"' && prev != '\\') { + found = true; + break; + } + prev = c; + n++; + } + if (!found) { + error_push((Error){ + .type = ERR_TYPE_LEXER, + .value = ERR_UNMATCHED_STRING, + .line = line, + .col = col, + }); + return tokens; + } + Token token = (Token){ + .value = (StringView){ + .start = &sv->start[offset + 1], + .n = n, + }, + .type = TOKEN_STRING, + .line = line, + .column = col, + }; + array_push(tokens, token); + } break; + case '\'': { + Token token = (Token){ + .type = TOKEN_QUOTE, + .line = line, + .column = col, + }; + array_push(tokens, token); + } break; + case '(': { + if (scan_peek(&scanner) == ')') { + scan_next(&scanner); + Token token = (Token){ + .type = TOKEN_NIL, + .line = line, + .column = col, + }; + array_push(tokens, token); + } else { + Token token = (Token){ + .type = TOKEN_LPAREN, + .line = line, + .column = col, + }; + array_push(tokens, token); + } + } break; + case ')': { + Token token = (Token){ + .type = TOKEN_RPAREN, + .line = line, + .column = col, + }; + array_push(tokens, token); + } break; + default: { + size_t n = 1; + while (!is_delimiter(scan_peek(&scanner))) { + scan_next(&scanner); + n++; + } + if (c == EOF || c == '\0') { + break; + } + Token token = (Token){ + .value = (StringView){ + .start = &sv->start[offset], + .n = n, + }, + .type = TOKEN_SYMBOL, + .line = line, + .column = col, + }; + token.type = find_primitive_type(token.value); + array_push(tokens, token); + } break; + } + } + + // Push EOF token. + Token token = (Token){ + .type = TOKEN_EOF, + .line = scanner.line_number, + .column = 1, + }; + array_push(tokens, token); + + return tokens; +} diff --git a/src/treewalk/lexer.h b/src/treewalk/lexer.h new file mode 100644 index 0000000..2b2789f --- /dev/null +++ b/src/treewalk/lexer.h @@ -0,0 +1,57 @@ +#ifndef BDL_LEXER_H +#define BDL_LEXER_H + +typedef enum TokenType { + TOKEN_UNKNOWN = 0, + TOKEN_LPAREN, + TOKEN_RPAREN, + TOKEN_QUOTE, + TOKEN_TRUE, + TOKEN_FALSE, + TOKEN_NIL, + TOKEN_FIXNUM, + TOKEN_SYMBOL, + TOKEN_STRING, + TOKEN_EOF, +} TokenType; + +typedef struct Token { + TokenType type; + StringView value; + size_t line; + size_t column; +} Token; + +typedef struct Scanner { + StringView current; + size_t line_number; + size_t col_number; + size_t offset; +} Scanner; + +// Print a token to standard output for debugging purposes. +void print_token(Token tok); + +// Same functionality as the ScanView pairs, but keeping track of line and +// column numbers. +char scan_next(Scanner *scanner); +char scan_peek(const Scanner *scanner); + +// Check if the current scanner still have characters left. +bool scan_has_next(const Scanner *scanner); + +// Advance the scanner until we ran out of whitespace. +void skip_whitespace(Scanner *scanner); + +// Check if a given character is a delimiter. +bool is_delimiter(char c); + +// Extract the token type from the current string. +TokenType find_primitive_type(const StringView value); + +// Generate a list of tokens from the given string. +Token * tokenize(const StringView *sv); + +#define TOK_BUF_CAP 256 + +#endif // BDL_LEXER_H diff --git a/src/treewalk/main.c b/src/treewalk/main.c new file mode 100755 index 0000000..a5888fd --- /dev/null +++ b/src/treewalk/main.c @@ -0,0 +1,288 @@ +#include +#include +#include +#include +#include +#include +#include + +#include "darray.h" +#include "hashtable.h" + +#include "singletons.c" + +#include "environment.c" +#include "errors.c" +#include "gc.c" +#include "lexer.c" +#include "objects.c" +#include "parser.c" +#include "primitives.c" +#include "read_line.c" +#include "string_view.c" + +void +init(void) { + // Initialize garbage collector. + gc_init(); + + // Initialize singletons. + obj_nil = alloc_object(OBJ_TYPE_NIL); + obj_true = alloc_object(OBJ_TYPE_BOOL); + obj_false = alloc_object(OBJ_TYPE_BOOL); + obj_err = alloc_object(OBJ_TYPE_ERR); + obj_quote = make_symbol((StringView){"quote", 5}); + proc_if = alloc_object(OBJ_TYPE_ERR); + push_root(obj_nil); + push_root(obj_true); + push_root(obj_false); + push_root(obj_err); + push_root(obj_quote); + push_root(proc_if); + + // Global environment. + global_env = env_create(NULL); + // TODO: make sure we create symbols and strings only once (interning + // strings?) + push_active_env(global_env); + + // Primitive symbols. + MAKE_ENV_VAR(global_env, "else", obj_true); + MAKE_ENV_VAR(global_env, "nil", obj_nil); + MAKE_ENV_VAR(global_env, "if", proc_if); + + // Primitive procedures. + MAKE_ENV_PROC(global_env, "eval", proc_eval); + MAKE_ENV_PROC(global_env, "quote", proc_quote); + MAKE_ENV_PROC(global_env, "car", proc_car); + MAKE_ENV_PROC(global_env, "cdr", proc_cdr); + MAKE_ENV_PROC(global_env, "cons", proc_cons); + MAKE_ENV_PROC(global_env, "list", proc_list); + MAKE_ENV_PROC(global_env, "+", proc_sum); + MAKE_ENV_PROC(global_env, "-", proc_sub); + MAKE_ENV_PROC(global_env, "*", proc_mul); + MAKE_ENV_PROC(global_env, "/", proc_div); + MAKE_ENV_PROC(global_env, "%", proc_mod); + MAKE_ENV_PROC(global_env, "print", proc_print); + MAKE_ENV_PROC(global_env, "display", proc_display); + MAKE_ENV_PROC(global_env, "newline", proc_newline); + MAKE_ENV_PROC(global_env, "boolean?", proc_is_boolean); + MAKE_ENV_PROC(global_env, "nil?", proc_is_nil); + MAKE_ENV_PROC(global_env, "symbol?", proc_is_symbol); + MAKE_ENV_PROC(global_env, "string?", proc_is_string); + MAKE_ENV_PROC(global_env, "fixnum?", proc_is_fixnum); + MAKE_ENV_PROC(global_env, "pair?", proc_is_pair); + MAKE_ENV_PROC(global_env, "procedure?", proc_is_procedure); + MAKE_ENV_PROC(global_env, "error?", proc_is_error); + MAKE_ENV_PROC(global_env, "not", proc_not); + MAKE_ENV_PROC(global_env, "and", proc_and); + MAKE_ENV_PROC(global_env, "or", proc_or); + MAKE_ENV_PROC(global_env, "cond", proc_cond); + MAKE_ENV_PROC(global_env, "<", proc_num_less_than); + MAKE_ENV_PROC(global_env, "<=", proc_num_lesseq_than); + MAKE_ENV_PROC(global_env, ">", proc_num_greater_than); + MAKE_ENV_PROC(global_env, ">=", proc_num_greatereq_than); + MAKE_ENV_PROC(global_env, "=", proc_num_equal); + MAKE_ENV_PROC(global_env, "eq?", proc_equal); + MAKE_ENV_PROC(global_env, "def", proc_define); + MAKE_ENV_PROC(global_env, "set!", proc_set); + MAKE_ENV_PROC(global_env, "lambda", proc_lambda); + MAKE_ENV_PROC(global_env, "fun", proc_fun); + + // Runtime procedures. + MAKE_ENV_PROC(global_env, "supress-errors", proc_supress_errors); +} + +void +process_source(const StringView *source) { + Token *tokens = tokenize(source); + if (errors_n != 0) { + if (tokens != NULL) { + array_free(tokens); + } + return; + } + + Visitor visitor = (Visitor){ + .tokens = tokens, + .current = 0, + }; + while (has_next_token(&visitor) && peek_token(&visitor).type != TOKEN_EOF) { + // Check the root node stack size before parsing + size_t root_stack_size = array_size(gc.roots); + Object *root = parse_tree(&visitor); + array_head(gc.roots)->size = root_stack_size; + if (root == obj_err || errors_n != 0) { + break; + } + push_root(root); + + Object *result = eval(global_env, root); + if (result != obj_nil) { + display(result); + printf("\n"); + } + pop_root(); + } + + if (tokens != NULL) { + array_free(tokens); + } +} + +#define REPL_PROMPT "bdl> " + +void +run_repl(void) { + printf("BDL REPL (Press Ctrl-D or Ctrl-C to exit)\n"); + while (true) { + printf(REPL_PROMPT); + StringView sv = read_line(); + if (sv.start == NULL) { + return; + } + process_source(&sv); + + // Check if there were any errors. + if (errors_n != 0 && !supress_errors) { + for (size_t i = 0; i < errors_n; i++) { + Error err = errors[i]; + for (size_t j = 0; j < err.col + sizeof(REPL_PROMPT) - 2; j++) { + putchar(' '); + } + printf("|\n"); + for (size_t j = 0; j < err.col + sizeof(REPL_PROMPT) - 2; j++) { + putchar(' '); + } + printf("%s\n", error_msgs[err.value]); + } + errors_n = 0; + continue; + } + } +} + +void +run_file(char *file_name) { + FILE *file = fopen(file_name, "r"); + if (!file) { + fprintf(stderr, "error: couldn't open input file: %s\n", file_name); + exit(EXIT_FAILURE); + } + + // Read entire file into memory. + fseek(file, 0, SEEK_END); + size_t file_size = ftell(file); + fseek(file, 0, SEEK_SET); + + char *source = malloc(file_size + 1); + fread(source, 1, file_size, file); + source[file_size] = 0; + + StringView sv = (StringView){ + .start = source, + .n = file_size, + }; + + process_source(&sv); + + // Check if there were any errors. + if (errors_n != 0 && !supress_errors) { + for (size_t i = 0; i < errors_n; i++) { + Error err = errors[i]; + fprintf(stderr, "%s", file_name); + if (err.line != 0) { + fprintf(stderr, ":%ld:%ld", err.line, err.col); + } + fprintf(stderr, ": %s\n", error_msgs[err.value]); + } + errors_n = 0; + } + + free(source); + fclose(file); +} + +#define STDIN_BUF_CAP 16 + +void +run_stdin(void) { + size_t buf_size = 0; + char *source = NULL; + array_init(source, STDIN_BUF_CAP); + + char c; + while ((c = getchar()) != EOF) { + array_push(source, c); + buf_size++; + } + + StringView sv = (StringView){ + .start = source, + .n = buf_size, + }; + + process_source(&sv); + + // Check if there were any errors. + if (errors_n != 0 && !supress_errors) { + for (size_t i = 0; i < errors_n; i++) { + Error err = errors[i]; + fprintf(stderr, "stdin"); + if (err.line != 0) { + fprintf(stderr, ":%ld:%ld", err.line, err.col); + } + fprintf(stderr, ": %s\n", error_msgs[err.value]); + } + errors_n = 0; + } + + array_free(source); +} + +#ifndef BIN_NAME +#define BIN_NAME "bdl" +#endif + +void +print_usage(void) { + printf("Usage: %s [options] \n", BIN_NAME); + printf("\n"); + printf("\t-i\tInteractive mode (REPL).\n"); + printf("\n"); +} + +int +main(int argc, char *argv[]) { + init(); + + int option; + while ((option = getopt(argc, argv, "i")) != -1) { + switch (option) { + case 'i': { + // Interactive mode. + run_repl(); + return EXIT_SUCCESS; + } break; + default: { + print_usage(); + return EXIT_FAILURE; + } break; + } + } + + // Run from stdin. + if (optind == argc) { + run_stdin(); + return EXIT_SUCCESS; + } + + // Run from file. + while (optind < argc) { + char *file_name = argv[optind]; + run_file(file_name); + optind++; + } + + return EXIT_SUCCESS; +} diff --git a/src/treewalk/objects.c b/src/treewalk/objects.c new file mode 100644 index 0000000..c71bc40 --- /dev/null +++ b/src/treewalk/objects.c @@ -0,0 +1,141 @@ +#include "gc.h" +#include "objects.h" + +// +// Constructors. +// + +Object * +make_fixnum(ssize_t num) { + Object *obj = alloc_object(OBJ_TYPE_FIXNUM); + obj->fixnum = num; + return obj; +} + +Object * +make_procedure(Object *(*proc)(struct Environment *, struct Object *args)) { + Object *obj = alloc_object(OBJ_TYPE_PROCEDURE); + obj->proc = proc; + return obj; +} + +Object * +make_pair(Object *car, Object *cdr) { + Object *obj = alloc_object(OBJ_TYPE_PAIR); + obj->car = car; + obj->cdr = cdr; + return obj; +} + +Object * +make_symbol(StringView sv) { + Object *obj = alloc_object(OBJ_TYPE_SYMBOL); + obj->symbol = NULL; + array_init(obj->symbol, sv.n); + array_insert(obj->symbol, sv.start, sv.n); + return obj; +} + +Object * +make_string(void) { + Object *obj = alloc_object(OBJ_TYPE_STRING); + obj->string = NULL; + array_init(obj->string, 0); + return obj; +} + +void +append_string(Object *obj, const StringView sv) { + if (sv.n == 0) { + return; + } + array_insert(obj->string, sv.start, sv.n); +} + +void +display_pair(Object *root) { + display(root->car); + if (root->cdr->type == OBJ_TYPE_PAIR) { + printf(" "); + display_pair(root->cdr); + } else if (root->cdr == obj_nil) { + return; + } else { + printf(" . "); + display(root->cdr); + } +} + +void +display(Object *root) { + switch (root->type) { + case OBJ_TYPE_FIXNUM: { + printf("%zd", root->fixnum); + } break; + case OBJ_TYPE_BOOL: { + if (root == obj_true) { + printf("true"); + } else { + printf("false"); + } + } break; + case OBJ_TYPE_NIL: { + printf("()"); + } break; + case OBJ_TYPE_STRING: { + printf("\"%.*s\"", (int)array_size(root->string), root->string); + } break; + case OBJ_TYPE_SYMBOL: { + printf(":%.*s", (int)array_size(root->symbol), root->symbol); + } break; + case OBJ_TYPE_PAIR: { + printf("("); + display_pair(root); + printf(")"); + } break; + case OBJ_TYPE_LAMBDA: + case OBJ_TYPE_PROCEDURE: { + printf("#{procedure}"); + } break; + case OBJ_TYPE_ERR: { + printf("#{error}"); + } break; + } + return; +} + +bool +obj_eq(const Object *a, const Object* b) { + if (a->type != b->type) { + return false; + } + switch (a->type) { + case OBJ_TYPE_FIXNUM: { + return a->fixnum == b->fixnum; + } break; + case OBJ_TYPE_STRING: { + if (array_size(a->string) != array_size(b->string)) { + return false; + } + for (size_t i = 0; i < array_size(a->string); i++) { + if (a->string[i] != b->string[i]) { + return false; + } + } + } break; + case OBJ_TYPE_SYMBOL: { + if (array_size(a->symbol) != array_size(b->symbol)) { + return false; + } + for (size_t i = 0; i < array_size(a->symbol); i++) { + if (a->symbol[i] != b->symbol[i]) { + return false; + } + } + } break; + default: { + return a == b; + } break; + } + return true; +} diff --git a/src/treewalk/objects.h b/src/treewalk/objects.h new file mode 100644 index 0000000..ed623eb --- /dev/null +++ b/src/treewalk/objects.h @@ -0,0 +1,75 @@ +#ifndef BDL_OBJECTS_H +#define BDL_OBJECTS_H + +#include "string_view.h" + +typedef enum ObjectType { + OBJ_TYPE_FIXNUM, + OBJ_TYPE_BOOL, + OBJ_TYPE_NIL, + OBJ_TYPE_SYMBOL, + OBJ_TYPE_STRING, + OBJ_TYPE_PAIR, + OBJ_TYPE_PROCEDURE, + OBJ_TYPE_LAMBDA, + OBJ_TYPE_ERR, +} ObjectType; + +struct Environment; + +typedef struct Object { + ObjectType type; + bool marked; + union { + // OBJ_TYPE_FIXNUM + ssize_t fixnum; + + // OBJ_TYPE_STRING + struct { + char *string; + }; + + // OBJ_TYPE_PAIR + struct { + struct Object *car; + struct Object *cdr; + }; + + // OBJ_TYPE_SYMBOL + struct { + char *symbol; + }; + + // OBJ_TYPE_PROCEDURE + struct Object *(*proc)(struct Environment *env, struct Object *args); + + // OBJ_TYPE_LAMBDA + struct { + struct Object *params; + struct Object *body; + struct Environment *env; + }; + }; +} Object; + +// Object constructors. +Object * make_fixnum(ssize_t num); +Object * make_procedure(Object *(*proc)(struct Environment *, Object *args)); +Object * make_pair(Object *car, Object *cdr); +Object * make_symbol(StringView sv); +Object * make_string(void); +void append_string(Object *obj, const StringView sv); + +// Object representation. +void display(Object *root); +void display_pair(Object *root); + +// Object comparison. +bool obj_eq(const Object *a, const Object* b); + +// Utility macros. +#define DEBUG_OBJ(MSG,OBJ) printf((MSG)); display(OBJ); printf("\n"); +#define PRINT_OBJ(OBJ) display(OBJ); printf("\n"); +#define MAKE_SYM(STR) make_symbol((StringView){(STR), sizeof(STR) - 1}) + +#endif // BDL_OBJECTS_H diff --git a/src/treewalk/parser.c b/src/treewalk/parser.c new file mode 100644 index 0000000..a2f0f71 --- /dev/null +++ b/src/treewalk/parser.c @@ -0,0 +1,139 @@ +#include "parser.h" + +Token +peek_token(const Visitor *visitor) { + return visitor->tokens[visitor->current]; +} + +Token +next_token(Visitor *visitor) { + return visitor->tokens[visitor->current++]; +} + +bool +has_next_token(const Visitor *visitor) { + return visitor->current < array_size(visitor->tokens); +} + +Object * +parse_fixnum(Token tok) { + ssize_t num = 0; + int sign = 1; + for (size_t i = 0; i < tok.value.n; i++) { + char c = tok.value.start[i]; + if (c == '-') { + sign = -1; + continue; + } + num = num * 10 + (c - '0'); + } + + Object *obj = make_fixnum(num * sign); + push_root(obj); + return obj; +} + +Object * +parse_list(Visitor *vs) { + Token tok = peek_token(vs); + if (tok.type == TOKEN_EOF) { + return obj_err; + } + Object *root = make_pair(obj_nil, obj_nil); + push_root(root); + Object *next_obj = parse_tree(vs); + if (next_obj == obj_err) { + return obj_err; + } + root->car = next_obj; + Object *list = root; + while (has_next_token(vs)) { + Token tok = peek_token(vs); + if (tok.type == TOKEN_RPAREN) { + next_token(vs); + break; + } + if (tok.type == TOKEN_EOF) { + return obj_err; + } + next_obj = parse_tree(vs); + if (next_obj == obj_err) { + return obj_err; + } + list->cdr = make_pair(next_obj, obj_nil); + list = list->cdr; + } + return root; +} + +Object * +parse_tree(Visitor *vs) { + Token tok = next_token(vs); + switch (tok.type) { + case TOKEN_FIXNUM: { + return parse_fixnum(tok); + } break; + case TOKEN_TRUE: { + return obj_true; + } break; + case TOKEN_FALSE: { + return obj_false; + } break; + case TOKEN_RPAREN: { + error_push((Error){ + .type = ERR_TYPE_PARSER, + .value = ERR_UNBALANCED_PAREN, + .line = tok.line, + .col = tok.column, + }); + return obj_err; + } break; + case TOKEN_QUOTE: { + Object *base = make_pair(obj_quote, obj_nil); + base->cdr = make_pair(obj_nil, obj_nil); + push_root(base); + Object *next_obj = parse_tree(vs); + if (next_obj == obj_err) { + return obj_err; + } + base->cdr->car = next_obj; + return base; + } break; + case TOKEN_LPAREN: { + Object *obj = parse_list(vs); + if (obj == obj_err) { + error_push((Error){ + .type = ERR_TYPE_PARSER, + .value = ERR_UNBALANCED_PAREN, + .line = tok.line, + .col = tok.column, + }); + } + return obj; + } break; + case TOKEN_STRING: { + Object *obj = make_string(); + push_root(obj); + append_string(obj, tok.value); + return obj; + } break; + case TOKEN_SYMBOL: { + Object *obj = make_symbol(tok.value); + push_root(obj); + return obj; + } break; + case TOKEN_NIL: { + return obj_nil; + } break; + default: { + break; + } break; + } + error_push((Error){ + .type = ERR_TYPE_PARSER, + .value = ERR_EOF_REACHED, + .line = tok.line, + .col = tok.column, + }); + return obj_err; +} diff --git a/src/treewalk/parser.h b/src/treewalk/parser.h new file mode 100644 index 0000000..3834c75 --- /dev/null +++ b/src/treewalk/parser.h @@ -0,0 +1,22 @@ +#ifndef BDL_PARSER_H +#define BDL_PARSER_H + +typedef struct Visitor { + Token *tokens; + size_t current; +} Visitor; + +// Mimics the functionality in the Scanner functions, but for entire tokens. +Token next_token(Visitor *visitor); +Token peek_token(const Visitor *visitor); +bool has_next_token(const Visitor *visitor); + +// Parse a token into a fixnum object. +Object * parse_fixnum(Token tok); + +// Recursive descent parser. If an object is not a list the parsing is handled +// by the parse_tree function. +Object * parse_list(Visitor *vs); +Object * parse_tree(Visitor *vs); + +#endif // BDL_PARSER_H diff --git a/src/treewalk/primitives.c b/src/treewalk/primitives.c new file mode 100644 index 0000000..8b0d407 --- /dev/null +++ b/src/treewalk/primitives.c @@ -0,0 +1,918 @@ +#include "primitives.h" + +Object * +eval(Environment *env, Object *root) { + Object* lambda = NULL; + Object* args = NULL; + Object* ret = NULL; + bool recursion_active = false; +eval_start: + switch (root->type) { + case OBJ_TYPE_ERR: + case OBJ_TYPE_PROCEDURE: + case OBJ_TYPE_LAMBDA: + case OBJ_TYPE_FIXNUM: + case OBJ_TYPE_BOOL: + case OBJ_TYPE_NIL: + case OBJ_TYPE_STRING: { + ret = root; + goto eval_success; + } break; + case OBJ_TYPE_SYMBOL: { + Object *val = env_lookup(env, root); + if (val == obj_err) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_SYMBOL_NOT_FOUND, + }); + return obj_err; + } + ret = val; + goto eval_success; + } break; + case OBJ_TYPE_PAIR: { + if (root->car->type == OBJ_TYPE_SYMBOL) { + Object *val = env_lookup(env, root->car); + if (val == obj_err) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_SYMBOL_NOT_FOUND, + }); + return obj_err; + } + + // Primitive `if` procedure with TCO. + if (val == proc_if) { + Object *obj = root->cdr; + if (obj == obj_nil || obj->cdr == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + Object *car = obj->car; + Object *cdr = obj->cdr; + Object *condition = eval(env, car); + if (condition == obj_err) { + return obj_err; + } + if (condition == obj_true) { + root = cdr->car; + } else if (cdr->cdr != obj_nil) { + root = cdr->cdr->car; + } else { + return obj_nil; + } + goto eval_start; + } + + if (val->type == OBJ_TYPE_PROCEDURE) { + ret = val->proc(env, root->cdr); + goto eval_success; + } + if (val->type == OBJ_TYPE_LAMBDA) { + lambda = val; + goto eval_lambda; + } + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_OBJ_NOT_CALLABLE, + }); + return obj_err; + } + lambda = eval(env, root->car); + if (lambda == obj_err) { + return obj_err; + } + if (lambda->type != OBJ_TYPE_LAMBDA) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_OBJ_NOT_CALLABLE, + }); + return obj_err; + } + +eval_lambda: + args = root->cdr; + Object *params = lambda->params; + if (!recursion_active) { + recursion_active = true; + // Protect current stack. + Environment *tmp = env_create(lambda->env); + push_active_env(tmp); + // Extend environment. + env = env_extend(tmp, env); + } + + // Create temporary environment to store bindings. + Environment *tmp = env_create(env); + push_active_env(tmp); + + // Evaluate arguments in temporary environment. + while (params != obj_nil) { + if (args == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + if (args->car == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + Object *symbol = params->car; + Object *value = eval(env, args->car); + if (value == obj_err) { + return obj_err; + } + env_add_or_update_current(tmp, symbol, value); + args = args->cdr; + params = params->cdr; + } + if (args != obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_TOO_MANY_ARGS, + }); + return obj_err; + } + + // Copy temporary environment values to closure environment. + args = root->cdr; + params = lambda->params; + while (params != obj_nil) { + Object *symbol = params->car; + Object *value = env_lookup(tmp, symbol); + env_add_or_update_current(env, symbol, value); + args = args->cdr; + params = params->cdr; + } + + // Release the temporary environment protection. + pop_active_env(); + + // Run the body of the function. + root = lambda->body; + while (root->cdr != obj_nil) { + if (eval(env, root->car) == obj_err) { + return obj_err; + }; + root = root->cdr; + } + root = root->car; + goto eval_start; + } break; + } + + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_UNKNOWN_OBJ_TYPE, + }); + return obj_err; + +eval_success: + if (recursion_active) { + // Remove stack protector. + pop_active_env(); + } + return ret; +} + +Object * +proc_quote(Environment *env, Object *obj) { + (void)env; + return obj->car; +} + +static inline Object * +extract_car_with_type(Environment *env, Object *obj, ObjectType expected_type) { + if (obj == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + Object *car = eval(env, obj->car); + if (car == obj_err) { + return obj_err; + } + if (car->type != expected_type) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_WRONG_ARG_TYPE, + }); + return obj_err; + } + return car; +} + +// +// Arithmetic procedures. +// + +Object * +proc_sum(Environment *env, Object *obj) { + Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); + obj = obj->cdr; + ssize_t tot = car->fixnum; + while (obj != obj_nil) { + car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); + tot += car->fixnum; + obj = obj->cdr; + } + return make_fixnum(tot); +} + +Object * +proc_sub(Environment *env, Object *obj) { + Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); + obj = obj->cdr; + ssize_t tot = car->fixnum; + while (obj != obj_nil) { + car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); + tot -= car->fixnum; + obj = obj->cdr; + } + return make_fixnum(tot); +} + +Object * +proc_mul(Environment *env, Object *obj) { + Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); + obj = obj->cdr; + ssize_t tot = car->fixnum; + while (obj != obj_nil) { + car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); + tot *= car->fixnum; + obj = obj->cdr; + } + return make_fixnum(tot); +} + +Object * +proc_div(Environment *env, Object *obj) { + Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); + obj = obj->cdr; + ssize_t tot = car->fixnum; + while (obj != obj_nil) { + car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); + if (car->fixnum == 0) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_DIVISION_BY_ZERO, + }); + return obj_err; + } + tot /= car->fixnum; + obj = obj->cdr; + } + return make_fixnum(tot); +} + +Object * +proc_mod(Environment *env, Object *obj) { + Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); + obj = obj->cdr; + ssize_t tot = car->fixnum; + while (obj != obj_nil) { + car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); + if (car->fixnum == 0) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_DIVISION_BY_ZERO, + }); + return obj_err; + } + tot %= car->fixnum; + obj = obj->cdr; + } + return make_fixnum(tot); +} + +// +// Display/Evaluation procedues. +// + +Object * +proc_display(Environment *env, Object *obj) { + display(eval(env, obj->car)); + return obj_nil; +} + +Object * +proc_print(Environment *env, Object *obj) { + Object *car = extract_car_with_type(env, obj, OBJ_TYPE_STRING); + StringView scanner = (StringView) { + .start = car->string, + .n = array_size(car->string), + }; + while (scanner.n != 0) { + char c = sv_next(&scanner); + if (c == '\\' && sv_peek(&scanner) == 'n') { + putchar('\n'); + sv_next(&scanner); + continue; + } + if (c == '\\' && sv_peek(&scanner) == '"') { + putchar('"'); + sv_next(&scanner); + continue; + } + putchar(c); + } + return obj_nil; +} + +Object * +proc_newline(Environment *env, Object *obj) { + printf("\n"); + (void)env; + (void)obj; + return obj_nil; +} + +// +// Type info procedures. +// + +Object * +proc_is_boolean(Environment *env, Object *obj) { + if (obj == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + obj = eval(env, obj->car); + if (obj == obj_err) { + return obj_err; + } + return (obj == obj_true || obj == obj_false) ? obj_true : obj_false; +} + +Object * +proc_is_nil(Environment *env, Object *obj) { + if (obj == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + obj = eval(env, obj->car); + if (obj == obj_err) { + return obj_err; + } + return obj == obj_nil ? obj_true : obj_false; +} + +Object * +proc_is_symbol(Environment *env, Object *obj) { + if (obj == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + obj = eval(env, obj->car); + if (obj == obj_err) { + return obj_err; + } + return obj->type == OBJ_TYPE_SYMBOL ? obj_true : obj_false; +} + +Object * +proc_is_string(Environment *env, Object *obj) { + if (obj == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + obj = eval(env, obj->car); + if (obj == obj_err) { + return obj_err; + } + return obj->type == OBJ_TYPE_STRING ? obj_true : obj_false; +} + +Object * +proc_is_fixnum(Environment *env, Object *obj) { + if (obj == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + obj = eval(env, obj->car); + if (obj == obj_err) { + return obj_err; + } + return obj->type == OBJ_TYPE_FIXNUM ? obj_true : obj_false; +} + +Object * +proc_is_pair(Environment *env, Object *obj) { + if (obj == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + obj = eval(env, obj->car); + if (obj == obj_err) { + return obj_err; + } + return obj->type == OBJ_TYPE_PAIR ? obj_true : obj_false; +} + +Object * +proc_is_procedure(Environment *env, Object *obj) { + if (obj == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + obj = eval(env, obj->car); + if (obj == obj_err) { + return obj_err; + } + return obj->type == OBJ_TYPE_PROCEDURE ? obj_true : obj_false; +} + +Object * +proc_is_error(Environment *env, Object *obj) { + if (obj == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + obj = eval(env, obj->car); + if (obj == obj_err) { + return obj_true; + } + return obj_false; +} + +// +// Boolean/conditional procedures. +// + +Object * +proc_not(Environment *env, Object *obj) { + if (obj == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + obj = eval(env, obj->car); + if (obj == obj_err) { + return obj_err; + } + return obj == obj_false ? obj_true : obj_false; +} + +Object * +proc_and(Environment *env, Object *obj) { + while (obj != obj_nil) { + if (proc_not(env, obj) == obj_true) { + return obj_false; + } + obj = obj->cdr; + } + return obj_true; +} + +Object * +proc_or(Environment *env, Object *obj) { + while (obj != obj_nil) { + if (proc_not(env, obj) == obj_false) { + return obj_true; + } + obj = obj->cdr; + } + return obj_false; +} + +Object * +proc_cond(Environment *env, Object *obj) { + if (obj == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + while (obj != obj_nil) { + Object *clause = obj->car; + if (clause->type != OBJ_TYPE_PAIR || clause->cdr == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_WRONG_ARG_TYPE, + }); + return obj_err; + } + Object *test = clause->car; + Object *value = clause->cdr->car; + Object *result = eval(env, test); + if (result == obj_err) { + return obj_err; + } + if (result == obj_true) { + return eval(env, value); + } + obj = obj->cdr; + } + return obj_nil; +} + +Object * +proc_num_less_than(Environment *env, Object *obj) { + Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); + obj = obj->cdr; + ssize_t prev = car->fixnum; + while (obj != obj_nil) { + car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); + if (prev >= car->fixnum) { + return obj_false; + } + prev = car->fixnum; + obj = obj->cdr; + } + return obj_true; +} + +Object * +proc_num_greater_than(Environment *env, Object *obj) { + Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); + obj = obj->cdr; + ssize_t prev = car->fixnum; + while (obj != obj_nil) { + car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); + if (prev <= car->fixnum) { + return obj_false; + } + prev = car->fixnum; + obj = obj->cdr; + } + return obj_true; +} + +Object * +proc_num_lesseq_than(Environment *env, Object *obj) { + Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); + obj = obj->cdr; + ssize_t prev = car->fixnum; + while (obj != obj_nil) { + car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); + if (prev > car->fixnum) { + return obj_false; + } + prev = car->fixnum; + obj = obj->cdr; + } + return obj_true; +} + +Object * +proc_num_greatereq_than(Environment *env, Object *obj) { + Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); + obj = obj->cdr; + ssize_t prev = car->fixnum; + while (obj != obj_nil) { + car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); + if (prev < car->fixnum) { + return obj_false; + } + prev = car->fixnum; + obj = obj->cdr; + } + return obj_true; +} + +Object * +proc_num_equal(Environment *env, Object *obj) { + Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); + obj = obj->cdr; + ssize_t prev = car->fixnum; + while (obj != obj_nil) { + car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM); + if (prev != car->fixnum) { + return obj_false; + } + prev = car->fixnum; + obj = obj->cdr; + } + return obj_true; +} + +// +// List operation procedures. +// + +Object * +proc_car(Environment *env, Object *obj) { + if (obj == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + obj = eval(env, obj->car); + if (obj == obj_err) { + return obj_err; + } + if (obj->type != OBJ_TYPE_PAIR) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_WRONG_ARG_TYPE, + }); + return obj_err; + } + return obj->car; +} + +Object * +proc_cdr(Environment *env, Object *obj) { + if (obj == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + obj = eval(env, obj->car); + if (obj == obj_err) { + return obj_err; + } + if (obj->type != OBJ_TYPE_PAIR) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_WRONG_ARG_TYPE, + }); + return obj_err; + } + return obj->cdr; +} + +Object * +proc_cons(Environment *env, Object *obj) { + if (obj == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + Object *head = make_pair(obj_nil, obj_nil); + push_root(head); + head->car = eval(env, obj->car); + if (head->car == obj_err) { + pop_root(); + return obj_err; + } + head->cdr = eval(env, obj->cdr->car); + if (head->cdr == obj_err) { + pop_root(); + return obj_err; + } + pop_root(); + return head; +} + +Object * +proc_list(Environment *env, Object *obj) { + if (obj == obj_nil) { + return obj_nil; + } + + Object *head = make_pair(obj_nil, obj_nil); + push_root(head); + Object *tmp = eval(env, obj->car); + if (tmp == obj_err) { + pop_root(); + return obj_err; + } + head->car = tmp; + Object *curr = head; + obj = obj->cdr; + while (obj != obj_nil) { + tmp = eval(env, obj->car); + if (tmp == obj_err) { + pop_root(); + return obj_err; + } + curr->cdr = make_pair(tmp, obj_nil); + curr = curr->cdr; + obj = obj->cdr; + } + pop_root(); + return head; +} + +// +// Polymorphic procedures. +// + +Object * +proc_equal(Environment *env, Object *obj) { + if (obj == obj_nil || obj->cdr == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + Object *a = eval(env, obj->car); + if (a == obj_err) { + return obj_err; + } + Object *b = eval(env, obj->cdr->car); + if (b == obj_err) { + return obj_err; + } + return obj_eq(a, b) ? obj_true : obj_false; +} + +// +// Variables and declarations. +// + +Object * +proc_define(Environment *env, Object *obj) { + if (obj == obj_nil || obj->cdr == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + + Object *symbol = obj->car; + if (symbol->type != OBJ_TYPE_SYMBOL) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_WRONG_ARG_TYPE, + }); + return obj_err; + } + + Object *value = eval(env, obj->cdr->car); + if (value == obj_err) { + return obj_err; + } + + env_add_or_update_current(env, symbol, value); + return obj_nil; +} + +Object * +proc_set(Environment *env, Object *obj) { + if (obj == obj_nil || obj->cdr == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + + Object *symbol = obj->car; + if (symbol->type != OBJ_TYPE_SYMBOL) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_WRONG_ARG_TYPE, + }); + return obj_err; + } + + Object *value = eval(env, obj->cdr->car); + if (value == obj_err) { + return obj_err; + } + + return env_update(env, symbol, value); +} + +Object * +proc_lambda(Environment *env, Object *obj) { + if (obj == obj_nil || obj->cdr == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + Object *params = obj->car; + if (params != obj_nil && params->type != OBJ_TYPE_PAIR) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_WRONG_ARG_TYPE, + }); + return obj_err; + } + Object *body = obj->cdr; + Object *fun = alloc_object(OBJ_TYPE_LAMBDA); + fun->params = params; + fun->body = body; + fun->env = env; + return fun; +} + +Object * +proc_fun(Environment *env, Object *obj) { + if (obj == obj_nil || obj->cdr == obj_nil || obj->cdr->cdr == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + + Object *name = obj->car; + if (name->type != OBJ_TYPE_SYMBOL) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_WRONG_ARG_TYPE, + }); + return obj_err; + } + + Object *params = obj->cdr->car; + if (params != obj_nil && params->type != OBJ_TYPE_PAIR) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_WRONG_ARG_TYPE, + }); + return obj_err; + } + Object *body = obj->cdr->cdr; + Object *fun = alloc_object(OBJ_TYPE_LAMBDA); + fun->params = params; + fun->body = body; + fun->env = env; + env_add_or_update_current(env, name, fun); + return obj_nil; +} + +// +// Evaluation. +// + +Object * +proc_eval(Environment *env, Object *obj) { + if (obj == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + return eval(env, eval(env, obj->car)); +} + +// +// Runtime configuration options. +// + +Object * +proc_supress_errors(Environment *env, Object *obj) { + Object *car = extract_car_with_type(env, obj, OBJ_TYPE_BOOL); + if (car == obj_err) { + return obj_err; + } + + if (car == obj_true) { + supress_errors = true; + } else if (car == obj_false) { + supress_errors = false; + } + return obj_nil; +} + +// TODO: map +// TODO: apply +// TODO: filter + +// TODO: fixnum left/right shift, mask, invert +// TODO: add primitives for type transforms: string->symbol, symbol->string, etc +// TODO: implement support for semi-quotes +// TODO: LAMBDA +// TODO: let diff --git a/src/treewalk/primitives.h b/src/treewalk/primitives.h new file mode 100644 index 0000000..f874b17 --- /dev/null +++ b/src/treewalk/primitives.h @@ -0,0 +1,60 @@ +#ifndef BDL_PRIMITIVES_H +#define BDL_PRIMITIVES_H + +// Function evaluation. +Object * eval(Environment *env, Object *root); + +// Evaluation functions. +Object * proc_quote(Environment *env, Object *obj); +Object * proc_eval(Environment *env, Object *obj); + +// Arithmetic. +Object * proc_sum(Environment *env, Object *obj); +Object * proc_sub(Environment *env, Object *obj); +Object * proc_mul(Environment *env, Object *obj); +Object * proc_div(Environment *env, Object *obj); +Object * proc_mod(Environment *env, Object *obj); + +// Printing. +Object * proc_display(Environment *env, Object *obj); +Object * proc_print(Environment *env, Object *obj); +Object * proc_newline(Environment *env, Object *obj); + +// Type checking. +Object * proc_is_boolean(Environment *env, Object *obj); +Object * proc_is_nil(Environment *env, Object *obj); +Object * proc_is_symbol(Environment *env, Object *obj); +Object * proc_is_string(Environment *env, Object *obj); +Object * proc_is_fixnum(Environment *env, Object *obj); +Object * proc_is_pair(Environment *env, Object *obj); +Object * proc_is_procedure(Environment *env, Object *obj); +Object * proc_is_error(Environment *env, Object *obj); + +// Logical operations. +Object * proc_not(Environment *env, Object *obj); +Object * proc_and(Environment *env, Object *obj); +Object * proc_or(Environment *env, Object *obj); +Object * proc_cond(Environment *env, Object *obj); +Object * proc_num_less_than(Environment *env, Object *obj); +Object * proc_num_greater_than(Environment *env, Object *obj); +Object * proc_num_lesseq_than(Environment *env, Object *obj); +Object * proc_num_greatereq_than(Environment *env, Object *obj); +Object * proc_num_equal(Environment *env, Object *obj); +Object * proc_equal(Environment *env, Object *obj); + +// List operations. +Object * proc_car(Environment *env, Object *obj); +Object * proc_cdr(Environment *env, Object *obj); +Object * proc_cons(Environment *env, Object *obj); +Object * proc_list(Environment *env, Object *obj); + +// Environment/variable manipulation. +Object * proc_define(Environment *env, Object *obj); +Object * proc_set(Environment *env, Object *obj); +Object * proc_lambda(Environment *env, Object *obj); +Object * proc_fun(Environment *env, Object *obj); + +// Runtinme configuration. +Object * proc_supress_errors(Environment *env, Object *obj); + +#endif // BDL_PRIMITIVES_H diff --git a/src/treewalk/read_line.c b/src/treewalk/read_line.c new file mode 100644 index 0000000..03146ad --- /dev/null +++ b/src/treewalk/read_line.c @@ -0,0 +1,32 @@ +#include "read_line.h" + +static char readline_buf[RL_BUF_SIZE]; + +StringView +read_line(void) { + // Clear buffer. + for (size_t i = 0; i < RL_BUF_SIZE; i++) { + readline_buf[i] = 0; + } + + // Barebones readline implementation. + size_t n = 0; + char c; + while ((c = getchar()) != '\n') { + if (c == '\b') { + readline_buf[n] = '\0'; + n--; + } else if (c == EOF || c == '\0') { + return (StringView){ .start = NULL, .n = 0 }; + } else if ((c >= ' ' && c <= '~') && n < RL_BUF_SIZE) { + readline_buf[n] = c; + n++; + } + } + + StringView sv = (StringView){ + .start = (char *)&readline_buf, + .n = n, + }; + return sv; +} diff --git a/src/treewalk/read_line.h b/src/treewalk/read_line.h new file mode 100644 index 0000000..160bce0 --- /dev/null +++ b/src/treewalk/read_line.h @@ -0,0 +1,10 @@ +#ifndef BDL_READ_LINE_H +#define BDL_READ_LINE_H + +#include "string_view.h" + +StringView read_line(void); + +#define RL_BUF_SIZE 1024 + +#endif // BDL_READ_LINE_H diff --git a/src/treewalk/singletons.c b/src/treewalk/singletons.c new file mode 100644 index 0000000..eb9c397 --- /dev/null +++ b/src/treewalk/singletons.c @@ -0,0 +1,17 @@ +#include "environment.h" +#include "gc.h" +#include "objects.h" + +// Global garbage collector singleton. +static GC gc; + +// Special singleton Objects. +static Object *obj_nil; +static Object *obj_true; +static Object *obj_false; +static Object *obj_err; +static Object *obj_quote; +static Object *proc_if; + +// Global environment. +static Environment *global_env; diff --git a/src/treewalk/string_view.c b/src/treewalk/string_view.c new file mode 100644 index 0000000..39fabe9 --- /dev/null +++ b/src/treewalk/string_view.c @@ -0,0 +1,40 @@ +#include "string_view.h" + +char +sv_next(StringView *sv) { + if (sv->n == 0) { + return '\0'; + } + char c = sv->start[0]; + sv->start++; + sv->n--; + return c; +} + +char +sv_peek(const StringView *sv) { + if (sv->n == 0) { + return '\0'; + } + return sv->start[0]; +} + +bool +sv_equal(const StringView *a, const StringView *b) { + if (a->n != b->n) { + return false; + } + for (size_t i = 0; i < a->n; i++) { + if (a->start[i] != b->start[i]) { + return false; + } + } + return true; +} + +void +sv_write(const StringView *sv, FILE *file) { + for (size_t i = 0; i < sv->n; i++) { + putc(sv->start[i], file); + } +} diff --git a/src/treewalk/string_view.h b/src/treewalk/string_view.h new file mode 100644 index 0000000..42273ab --- /dev/null +++ b/src/treewalk/string_view.h @@ -0,0 +1,21 @@ +#ifndef BDL_STRINGVIEW_H +#define BDL_STRINGVIEW_H + +typedef struct StringView { + char *start; + size_t n; +} StringView; + +// Consume a character in the stream. +char sv_next(StringView *sv); + +// Check what is the current character in the stream. +char sv_peek(const StringView *sv); + +// Compare if the arguments are the same. +bool sv_equal(const StringView *a, const StringView *b); + +// Write a character to the given output stream. +void sv_write(const StringView *sv, FILE *file); + +#endif // BDL_STRINGVIEW_H -- cgit v1.2.1