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 - 22 files changed, 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 (limited to 'src/bootstrap') 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 -- cgit v1.2.1