commit cd252f59086a8e01ba0acbef5a4471abfad68c2c Author: ~keith Date: Wed Sep 22 09:54:29 2021 -0400 oopsie i forgot to commit :zany: diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..2ee39f0 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +*.o +/keithlisp +.ccls-cache +.directory diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..7a604a6 --- /dev/null +++ b/Makefile @@ -0,0 +1,20 @@ + +CFLAGS=-I. -Wall -g +LFLAGS=-lm + +OBJ_DIR=obj + +SRCS = main.c dbg_malloc.c lisp_string.c parse.c native_funs.c +OBJS = $(SRCS:%.c=$(OBJ_DIR)/%.o) + +keithlisp: $(OBJS) + gcc $(LFLAGS) -o $@ $^ $(CFLAGS) + +$(OBJ_DIR)/%.o: %.c + gcc -c -o $@ $^ $(CFLAGS) +$(OBJ_DIR): + mkdir $(OBJ_DIR) + +.PHONY = clean +clean: + rm $(OBJ_DIR)/* diff --git a/crc_table.h b/crc_table.h new file mode 100644 index 0000000..32cc07f --- /dev/null +++ b/crc_table.h @@ -0,0 +1,66 @@ +static const unsigned int crc32_table[] = { +0x00000000, 0x04c11db7, 0x09823b6e, 0x0d4326d9, +0x130476dc, 0x17c56b6b, 0x1a864db2, 0x1e475005, +0x2608edb8, 0x22c9f00f, 0x2f8ad6d6, 0x2b4bcb61, +0x350c9b64, 0x31cd86d3, 0x3c8ea00a, 0x384fbdbd, +0x4c11db70, 0x48d0c6c7, 0x4593e01e, 0x4152fda9, +0x5f15adac, 0x5bd4b01b, 0x569796c2, 0x52568b75, +0x6a1936c8, 0x6ed82b7f, 0x639b0da6, 0x675a1011, +0x791d4014, 0x7ddc5da3, 0x709f7b7a, 0x745e66cd, +0x9823b6e0, 0x9ce2ab57, 0x91a18d8e, 0x95609039, +0x8b27c03c, 0x8fe6dd8b, 0x82a5fb52, 0x8664e6e5, +0xbe2b5b58, 0xbaea46ef, 0xb7a96036, 0xb3687d81, +0xad2f2d84, 0xa9ee3033, 0xa4ad16ea, 0xa06c0b5d, +0xd4326d90, 0xd0f37027, 0xddb056fe, 0xd9714b49, +0xc7361b4c, 0xc3f706fb, 0xceb42022, 0xca753d95, +0xf23a8028, 0xf6fb9d9f, 0xfbb8bb46, 0xff79a6f1, +0xe13ef6f4, 0xe5ffeb43, 0xe8bccd9a, 0xec7dd02d, +0x34867077, 0x30476dc0, 0x3d044b19, 0x39c556ae, +0x278206ab, 0x23431b1c, 0x2e003dc5, 0x2ac12072, +0x128e9dcf, 0x164f8078, 0x1b0ca6a1, 0x1fcdbb16, +0x018aeb13, 0x054bf6a4, 0x0808d07d, 0x0cc9cdca, +0x7897ab07, 0x7c56b6b0, 0x71159069, 0x75d48dde, +0x6b93dddb, 0x6f52c06c, 0x6211e6b5, 0x66d0fb02, +0x5e9f46bf, 0x5a5e5b08, 0x571d7dd1, 0x53dc6066, +0x4d9b3063, 0x495a2dd4, 0x44190b0d, 0x40d816ba, +0xaca5c697, 0xa864db20, 0xa527fdf9, 0xa1e6e04e, +0xbfa1b04b, 0xbb60adfc, 0xb6238b25, 0xb2e29692, +0x8aad2b2f, 0x8e6c3698, 0x832f1041, 0x87ee0df6, +0x99a95df3, 0x9d684044, 0x902b669d, 0x94ea7b2a, +0xe0b41de7, 0xe4750050, 0xe9362689, 0xedf73b3e, +0xf3b06b3b, 0xf771768c, 0xfa325055, 0xfef34de2, +0xc6bcf05f, 0xc27dede8, 0xcf3ecb31, 0xcbffd686, +0xd5b88683, 0xd1799b34, 0xdc3abded, 0xd8fba05a, +0x690ce0ee, 0x6dcdfd59, 0x608edb80, 0x644fc637, +0x7a089632, 0x7ec98b85, 0x738aad5c, 0x774bb0eb, +0x4f040d56, 0x4bc510e1, 0x46863638, 0x42472b8f, +0x5c007b8a, 0x58c1663d, 0x558240e4, 0x51435d53, +0x251d3b9e, 0x21dc2629, 0x2c9f00f0, 0x285e1d47, +0x36194d42, 0x32d850f5, 0x3f9b762c, 0x3b5a6b9b, +0x0315d626, 0x07d4cb91, 0x0a97ed48, 0x0e56f0ff, +0x1011a0fa, 0x14d0bd4d, 0x19939b94, 0x1d528623, +0xf12f560e, 0xf5ee4bb9, 0xf8ad6d60, 0xfc6c70d7, +0xe22b20d2, 0xe6ea3d65, 0xeba91bbc, 0xef68060b, +0xd727bbb6, 0xd3e6a601, 0xdea580d8, 0xda649d6f, +0xc423cd6a, 0xc0e2d0dd, 0xcda1f604, 0xc960ebb3, +0xbd3e8d7e, 0xb9ff90c9, 0xb4bcb610, 0xb07daba7, +0xae3afba2, 0xaafbe615, 0xa7b8c0cc, 0xa379dd7b, +0x9b3660c6, 0x9ff77d71, 0x92b45ba8, 0x9675461f, +0x8832161a, 0x8cf30bad, 0x81b02d74, 0x857130c3, +0x5d8a9099, 0x594b8d2e, 0x5408abf7, 0x50c9b640, +0x4e8ee645, 0x4a4ffbf2, 0x470cdd2b, 0x43cdc09c, +0x7b827d21, 0x7f436096, 0x7200464f, 0x76c15bf8, +0x68860bfd, 0x6c47164a, 0x61043093, 0x65c52d24, +0x119b4be9, 0x155a565e, 0x18197087, 0x1cd86d30, +0x029f3d35, 0x065e2082, 0x0b1d065b, 0x0fdc1bec, +0x3793a651, 0x3352bbe6, 0x3e119d3f, 0x3ad08088, +0x2497d08d, 0x2056cd3a, 0x2d15ebe3, 0x29d4f654, +0xc5a92679, 0xc1683bce, 0xcc2b1d17, 0xc8ea00a0, +0xd6ad50a5, 0xd26c4d12, 0xdf2f6bcb, 0xdbee767c, +0xe3a1cbc1, 0xe760d676, 0xea23f0af, 0xeee2ed18, +0xf0a5bd1d, 0xf464a0aa, 0xf9278673, 0xfde69bc4, +0x89b8fd09, 0x8d79e0be, 0x803ac667, 0x84fbdbd0, +0x9abc8bd5, 0x9e7d9662, 0x933eb0bb, 0x97ffad0c, +0xafb010b1, 0xab710d06, 0xa6322bdf, 0xa2f33668, +0xbcb4666d, 0xb8757bda, 0xb5365d03, 0xb1f740b4 +}; diff --git a/dbg_malloc.c b/dbg_malloc.c new file mode 100644 index 0000000..c012c7b --- /dev/null +++ b/dbg_malloc.c @@ -0,0 +1,28 @@ +#include "dbg_malloc.h" + +size_t dbg_malloc_mem_usage = 0; +size_t dbg_malloc_peak_usage = 0; + +#include +void* dbg_malloc(size_t size) { + void* ptr = malloc(size); + dbg_malloc_mem_usage += malloc_usable_size(ptr); + if (dbg_malloc_mem_usage > dbg_malloc_peak_usage) + dbg_malloc_peak_usage = dbg_malloc_mem_usage; + #ifdef DBG_MALLOC_PRINT + fprintf(stderr, " malloc(%3li) -> %4liB used\n", size, dbg_malloc_mem_usage); + #endif + return ptr; +} +void dbg_free(void* ptr) { + dbg_malloc_mem_usage -= malloc_usable_size(ptr); + free(ptr); + #ifdef DBG_MALLOC_PRINT + fprintf(stderr, " free() -> %4liB used\n", dbg_malloc_mem_usage); + #endif +} +size_t dbg_reset_peak() { + size_t old_peak = dbg_malloc_peak_usage; + dbg_malloc_peak_usage = dbg_malloc_mem_usage; + return old_peak; +} diff --git a/dbg_malloc.h b/dbg_malloc.h new file mode 100644 index 0000000..4dc49fb --- /dev/null +++ b/dbg_malloc.h @@ -0,0 +1,15 @@ +#ifndef _DBG_MALLOC_H +#define _DBG_MALLOC_H + +#include + +//#define DBG_MALLOC_PRINT + +extern size_t dbg_malloc_mem_usage; +extern size_t dbg_malloc_peak_usage; + +void* dbg_malloc(size_t size); +void dbg_free(void* ptr); +size_t dbg_reset_peak(); + +#endif diff --git a/lisp_string.c b/lisp_string.c new file mode 100644 index 0000000..7bc24a1 --- /dev/null +++ b/lisp_string.c @@ -0,0 +1,46 @@ +#include "lisp_string.h" + +lisp_string* lisp_string_create(char* str) { + int len = strlen(str); + lisp_string* lstr = dbg_malloc(len + sizeof(int)); + *((int*) lstr) = len; + strcpy(lstr + sizeof(int), str); + return lstr; +} +lisp_string* lisp_string_create_raw(char* buf, int len) { + lisp_string* lstr = dbg_malloc(len + sizeof(int)); + *((int*) lstr) = len; + memcpy(lstr + sizeof(int), buf, len); + return lstr; +} +lisp_string* lisp_string_alloc(int len) { + lisp_string* lstr = dbg_malloc(len + sizeof(int)); + *((int*) lstr) = len; + return lstr; +} +lisp_string* lisp_string_copy(lisp_string* lstr) { + return lisp_string_create_raw(lisp_string_data(lstr), lisp_string_len(lstr)); +} + +int lisp_string_cmp(lisp_string* a_lstr, lisp_string* b_lstr) { + if (a_lstr == NULL || b_lstr == NULL) + return (a_lstr > b_lstr) - (a_lstr < b_lstr); + + int len_a = lisp_string_len(a_lstr); + int len_b = lisp_string_len(b_lstr); + char* data_a = lisp_string_data(a_lstr); + char* data_b = lisp_string_data(b_lstr); + if (len_a > 0 && len_b > 0) { + int cmp = memcmp(data_a, data_b, len_a > len_b ? len_b : len_a); + if (cmp != 0) + return cmp; + } + return (len_a > len_b) - (len_a < len_b); +} + +void lisp_string_print(lisp_string* lstr) { + char* buf = lisp_string_data(lstr); + int len = lisp_string_len(lstr); + while (len--) + putchar(*(buf++)); +} diff --git a/lisp_string.h b/lisp_string.h new file mode 100644 index 0000000..fb193f9 --- /dev/null +++ b/lisp_string.h @@ -0,0 +1,23 @@ +#ifndef _LISP_STRING_H +#define _LISP_STRING_H + +#include +#include + +#include "dbg_malloc.h" +#include "lisp_types.h" + +__attribute__((always_inline)) static inline int lisp_string_len(lisp_string* lstr) { + return *((int*) lstr); +} +__attribute__((always_inline)) static inline char* lisp_string_data(lisp_string* lstr) { + return lstr + sizeof(int); +} +char* lisp_string_create(char* str); +char* lisp_string_create_raw(char* buf, int len); +char* lisp_string_alloc(int len); +char* lisp_string_copy(lisp_string* lstr); +int lisp_string_cmp(lisp_string* a_lstr, lisp_string* b_lstr); +void lisp_string_print(lisp_string* lstr); + +#endif diff --git a/lisp_types.h b/lisp_types.h new file mode 100644 index 0000000..498d303 --- /dev/null +++ b/lisp_types.h @@ -0,0 +1,34 @@ +#ifndef _LISP_TYPES_H +#define _LISP_TYPES_H + +#define LISP_T_CONS 0 +#define LISP_T_ATOM 1 +#define LISP_T_INT 2 +#define LISP_T_FLOAT 3 +#define LISP_T_STRING 4 +#define LISP_T_FUNPTR 5 + +typedef struct lisp_value lisp_value; +typedef struct lisp_cons lisp_cons; +typedef int lisp_atom; +typedef char lisp_string; +typedef void (*lisp_native_fun)(lisp_cons*, lisp_value*); + +struct lisp_value { + union { + lisp_cons* cons; + lisp_atom atom; + long _int; + float _float; + lisp_string* string; + lisp_native_fun funptr; + } value; + char type; +} __attribute__((packed)); + +struct lisp_cons { + lisp_value car; + lisp_value cdr; +} __attribute__((packed)); + +#endif diff --git a/main.c b/main.c new file mode 100644 index 0000000..3dde255 --- /dev/null +++ b/main.c @@ -0,0 +1,382 @@ +#include "main.h" + +lisp_cons* syms_alist; +lisp_cons* funs_alist; +lisp_cons* atoms_alist; + +bool lisp_is_nil(lisp_value value) { + return (value.type == LISP_T_CONS) && (value.value.cons == NULL); +} +bool lisp_is_equal(lisp_value a, lisp_value b) { + if (a.type != b.type) + return false; + switch (a.type) { + case LISP_T_CONS: + return a.value.cons == b.value.cons; + case LISP_T_ATOM: + return a.value.atom == b.value.atom; + case LISP_T_INT: + return a.value._int == b.value._int; + case LISP_T_FLOAT: + return a.value._float == b.value._float; + case LISP_T_STRING: + return lisp_string_cmp(a.value.string, b.value.string) == 0; + default: + return false; + } +} + +void lisp_cons_join(lisp_cons* head, lisp_cons* tail) { + while ((head->cdr.type == LISP_T_CONS) && !lisp_is_nil(head->cdr)) { + head = head->cdr.value.cons; + } + head->cdr.type = LISP_T_CONS; + head->cdr.value.cons = tail; +} + +lisp_atom atom_t; +lisp_atom atom_quote; + +#include "crc_table.h" +lisp_atom lisp_atomize(lisp_string* atom_lstr) { + char* buf = lisp_string_data(atom_lstr); + int len = lisp_string_len(atom_lstr); + lisp_atom atom = 0xFFFFFFFF; + while (len--) { + atom = (atom << 8) ^ crc32_table[((atom >> 24) ^ *buf) & 255]; + buf++; + } +#ifdef LISP_USE_ATOMS_ALIST + lisp_value key; + key.type = LISP_T_ATOM; + key.value.atom = atom; + if (lisp_alist_getptr(atoms_alist, key) == NULL) { + lisp_cons* pair = dbg_malloc(sizeof(lisp_cons)); + pair->car.type = LISP_T_ATOM; + pair->car.value.atom = atom; + pair->cdr.type = LISP_T_STRING; + pair->cdr.value.string = lisp_string_copy(atom_lstr); + lisp_cons* new_alist = dbg_malloc(sizeof(lisp_cons)); + new_alist->car.type = LISP_T_CONS; + new_alist->car.value.cons = pair; + new_alist->cdr.type = LISP_T_CONS; + new_alist->cdr.value.cons = atoms_alist; + atoms_alist = new_alist; + } +#endif + return atom; +} +lisp_atom lisp_atom_init(lisp_string* atom_lstr) { + lisp_atom atom = lisp_atomize(atom_lstr); + dbg_free(atom_lstr); + return atom; +} + +lisp_cons** lisp_alist_getptr(lisp_cons* alist, lisp_value key) { + while (alist != NULL) { + if (alist->car.type != LISP_T_CONS || alist->car.value.cons == NULL) + goto next; + lisp_cons* pair = alist->car.value.cons; + if (lisp_is_equal(pair->car, key)) + return &alist->car.value.cons; + next: + if (alist->cdr.type == LISP_T_CONS) + alist = alist->cdr.value.cons; + else + alist = NULL; + } + return NULL; +} +lisp_cons* lisp_alist_get(lisp_cons* alist, lisp_value key) { + lisp_cons** pairptr = lisp_alist_getptr(alist, key); + if (pairptr == NULL) + return NULL; + return *pairptr; +} +lisp_cons* lisp_alist_put(lisp_cons** alist, lisp_cons* pair) { + lisp_cons** pairptr = lisp_alist_getptr(*alist, pair->car); + if (pairptr != NULL) { + lisp_cons* old_pair = *pairptr; + *pairptr = pair; + return old_pair; + } + lisp_cons* new_alist = dbg_malloc(sizeof(lisp_cons)); + new_alist->car.type = LISP_T_CONS; + new_alist->car.value.cons = pair; + new_alist->cdr.type = LISP_T_CONS; + new_alist->cdr.value.cons = *alist; + *alist = new_alist; + return NULL; +} +lisp_cons* lisp_alist_del(lisp_cons** alist, lisp_value key) { + lisp_cons* alist_cur = *alist; + lisp_cons* alist_prev = NULL; + while (alist_cur != NULL) { + if (alist_cur->car.type != LISP_T_CONS || alist_cur->car.value.cons == NULL) + goto next; + lisp_cons* pair = alist_cur->car.value.cons; + if (lisp_is_equal(pair->car, key)) { + // remove current element from list + if (alist_prev != NULL) + alist_prev->cdr = alist_cur->cdr; + else if (alist_cur->cdr.type == LISP_T_CONS) + *alist = alist_cur->cdr.value.cons; + return pair; + } + next: + alist_prev = alist_cur; + if (alist_cur->cdr.type == LISP_T_CONS) + alist_cur = alist_cur->cdr.value.cons; + else + alist_cur = NULL; + } + return NULL; +} + +void test_print_value(lisp_value value) { + if (lisp_is_nil(value)) + printf("nil"); + else if (value.type == LISP_T_CONS) + test_print_cons(value.value.cons); + else if (value.type == LISP_T_ATOM) { +#ifdef LISP_USE_ATOMS_ALIST + lisp_cons* pair = lisp_alist_get(atoms_alist, value); + if (pair != NULL) + lisp_string_print(pair->cdr.value.string); + else +#endif + printf("", value.value.atom); + } else if (value.type == LISP_T_INT) + printf("%li", value.value._int); + else if (value.type == LISP_T_FLOAT) + printf("%g", value.value._float); + else if (value.type == LISP_T_STRING) { + putchar('\"'); + lisp_string_print(value.value.string); + putchar('\"'); + } else if (value.type == LISP_T_FUNPTR) + printf("", value.value.funptr); +} +void test_print_cons(lisp_cons* cons) { + printf("("); + while (cons != NULL) { + test_print_value(cons->car); + if (cons->cdr.type == LISP_T_CONS) { + cons = cons->cdr.value.cons; + if (cons != NULL) + printf(" "); + } else { + printf(" . "); + test_print_value(cons->cdr); + cons = NULL; + } + } + printf(")"); +} + +void recursive_free(lisp_cons* cons) { + while (cons != NULL) { + if (cons->car.type == LISP_T_STRING) + dbg_free(cons->car.value.string); + else if (cons->car.type == LISP_T_CONS) + recursive_free(cons->car.value.cons); + if (cons->cdr.type == LISP_T_STRING) + dbg_free(cons->cdr.value.string); + lisp_cons* next_cons = NULL; + if (cons->cdr.type == LISP_T_CONS) + next_cons = cons->cdr.value.cons; + dbg_free(cons); + cons = next_cons; + } +} + +bool fetch_tokens(lisp_cons** tokens) { + char buf[64]; + //test_print_cons(*tokens); + //printf("> "); + if (!fgets(buf, 64, stdin)) + return false; + lisp_tokenize(buf, strlen(buf), tokens); + return true; +} + +lisp_atom lisp_defun_native(lisp_string* lstr, lisp_native_fun funptr) { + lisp_atom atom = lisp_atom_init(lstr); + lisp_cons* cons = dbg_malloc(sizeof(lisp_cons)); + cons->car.type = LISP_T_ATOM; + cons->car.value.atom = atom; + cons->cdr.type = LISP_T_FUNPTR; + cons->cdr.value.funptr = funptr; + lisp_alist_put(&funs_alist, cons); + return atom; +} + +void lisp_evaluate_value(lisp_value input, lisp_value* result) { + if (input.type == LISP_T_ATOM) { + if (input.value.atom == atom_t) { + *result = input; + return; + } + lisp_cons* sym_pair = lisp_alist_get(syms_alist, input); + if (sym_pair != NULL) + *result = sym_pair->cdr; + else { + result->type = LISP_T_CONS; + result->value.cons = NULL; + } + } else if (input.type == LISP_T_CONS && !lisp_is_nil(input)) + lisp_evaluate(input.value.cons, result); + else + *result = input; +} +void lisp_evaluate(lisp_cons* cons, lisp_value* value) { + if (cons->car.value.atom == atom_quote) { + *value = cons->cdr.value.cons->car; + return; + } + if (cons->car.value.atom == atom_cond) { + lisp_macro_cond(cons->cdr.value.cons, value); + return; + } + lisp_cons* fun_cons = lisp_alist_get(funs_alist, cons->car); + if (fun_cons == NULL) { + fprintf(stderr, "EVAL ERROR! (no such fun)\n"); + value->type = LISP_T_CONS; + value->value.cons = NULL; + return; + } + lisp_cons* args = NULL; + lisp_cons* args_tail = NULL; + cons = cons->cdr.value.cons; + while (cons != NULL) { + lisp_cons* arg_cons = dbg_malloc(sizeof(lisp_cons)); + arg_cons->cdr.type = LISP_T_CONS; + arg_cons->cdr.value.cons = NULL; + lisp_evaluate_value(cons->car, &arg_cons->car); + cons = cons->cdr.value.cons; + if (args == NULL) + args = arg_cons; + if (args_tail == NULL) + args_tail = args; + else { + args_tail->cdr.value.cons = arg_cons; + args_tail = arg_cons; + } + } + if (fun_cons->cdr.type == LISP_T_FUNPTR) { + // native-fun + (*fun_cons->cdr.value.funptr)(args, value); + while (args != NULL) { + args_tail = args->cdr.value.cons; + dbg_free(args); + args = args_tail; + } + } else { + fprintf(stderr, "EVAL ERROR! (not a native-fun)\n"); + value->type = LISP_T_CONS; + value->value.cons = NULL; + return; + } +} +lisp_atom atom_cond; +void lisp_macro_cond(lisp_cons* cons, lisp_value* value) { + while (cons != NULL) { + lisp_cons* fork = cons->car.value.cons; + lisp_evaluate_value(fork->car, value); + if (!lisp_is_nil(*value)) { + fork = fork->cdr.value.cons; + while (fork != NULL) { + lisp_evaluate_value(fork->car, value); + fork = fork->cdr.value.cons; + } + return; + } + cons = cons->cdr.value.cons; + } + value->type = LISP_T_CONS; + value->value.cons = NULL; +} + +void lisp_set(lisp_cons* cons, lisp_value* value) { + lisp_cons* pair = dbg_malloc(sizeof(lisp_cons)); + pair->car = cons->car; + pair->cdr = cons->cdr.value.cons->car; + lisp_alist_put(&syms_alist, pair); + *value = pair->cdr; +} + +void lisp_fun(lisp_cons* cons, lisp_value* value) { + lisp_cons* pair = lisp_alist_get(funs_alist, cons->car); + *value = pair->cdr; +} + +lisp_atom atom_cons; +lisp_atom atom_atom; +lisp_atom atom_int; +lisp_atom atom_float; +lisp_atom atom_string; +lisp_atom atom_native_fun; + +int main() { + printf("sizeof(lisp_atom) = %lu\n", sizeof(lisp_atom)); + printf("sizeof(lisp_value) = %lu\n", sizeof(lisp_value)); + printf("sizeof(lisp_cons) = %lu\n", sizeof(lisp_cons)); + + atom_t = lisp_atom_init(lisp_string_create("t")); + atom_quote = lisp_atom_init(lisp_string_create("quote")); + + atom_cond = lisp_atom_init(lisp_string_create("cond")); + + atom_cons = lisp_atom_init(lisp_string_create("cons")); + atom_atom = lisp_atom_init(lisp_string_create("atom")); + atom_int = lisp_atom_init(lisp_string_create("int")); + atom_float = lisp_atom_init(lisp_string_create("float")); + atom_string = lisp_atom_init(lisp_string_create("string")); + atom_native_fun = lisp_atom_init(lisp_string_create("native-fun")); + + init_native_funs(); + lisp_defun_native(lisp_string_create("set"), &lisp_set); + lisp_defun_native(lisp_string_create("fun"), &lisp_fun); + + printf("Init: %4liB used\n", dbg_malloc_mem_usage); + + while (true) { + lisp_cons* tokens = NULL; + lisp_value value; + printf("> "); + lisp_tokenize_init(); + if (lisp_parse_recursive(&tokens, &fetch_tokens, &value)) { + //test_print_value(value); + //printf("\n"); + lisp_value result; + lisp_evaluate_value(value, &result); + test_print_value(result); + printf("\n"); + printf("Freeing sexpr...\n"); + if (value.type == LISP_T_CONS) + recursive_free(value.value.cons); + else if (value.type == LISP_T_STRING) + dbg_free(value.value.string); + printf("Freeing tokens...\n"); + recursive_free(tokens); + + if (lisp_is_nil(value)) + break; + } else { + printf("PARSE ERROR!\n"); + test_print_cons(tokens); + printf("\n"); + } + } + + printf("Freeing syms-alist...\n"); + recursive_free(syms_alist); + printf("Freeing funs-alist...\n"); + recursive_free(funs_alist); + printf("Freeing atoms-alist...\n"); + recursive_free(atoms_alist); + printf("Done: %4liB used (should be 0)\n", dbg_malloc_mem_usage); + printf("Peak: %4liB used\n", dbg_malloc_peak_usage); + + return 0; +} diff --git a/main.h b/main.h new file mode 100644 index 0000000..f514525 --- /dev/null +++ b/main.h @@ -0,0 +1,63 @@ +#ifndef _MAIN_H +#define _MAIN_H + +#include +#include +#include +#include +#include + +#include "dbg_malloc.h" +#include "lisp_types.h" +#include "lisp_string.h" +#include "parse.h" +#include "native_funs.h" + +/* LISP_USE_ATOMS_ALIST: + * If enabled, atom names will be stored in atoms_alist. + * This assists debugging and reflection, but makes atom evaluation + * slower and uses more memory. */ +#define LISP_USE_ATOMS_ALIST + +extern lisp_cons* syms_alist; +extern lisp_cons* funs_alist; +extern lisp_cons* atoms_alist; + +bool lisp_is_nil(lisp_value value); +bool lisp_is_equal(lisp_value a, lisp_value b); + +void lisp_cons_join(lisp_cons* head, lisp_cons* tail); +__attribute__((always_inline)) static inline lisp_cons* lisp_cons_pop(lisp_cons** head) { + lisp_cons* old_head = *head; + *head = old_head->cdr.value.cons; + return old_head; +} + +extern lisp_atom atom_t; +extern lisp_atom atom_quote; + +extern lisp_atom atom_cons; +extern lisp_atom atom_atom; +extern lisp_atom atom_int; +extern lisp_atom atom_float; +extern lisp_atom atom_string; +extern lisp_atom atom_native_fun; + +lisp_atom lisp_atomize(lisp_string* atom_lstr); + +lisp_cons** lisp_alist_getptr(lisp_cons* alist, lisp_value key); +lisp_cons* lisp_alist_get(lisp_cons* alist, lisp_value key); +lisp_cons* lisp_alist_put(lisp_cons** alist, lisp_cons* pair); +lisp_cons* lisp_alist_del(lisp_cons** alist, lisp_value key); + +void test_print_cons(lisp_cons* cons); +void test_print_value(lisp_value value); + +lisp_atom lisp_defun_native(lisp_string* lstr, lisp_native_fun funptr); + +void lisp_evaluate_value(lisp_value input, lisp_value* result); +void lisp_evaluate(lisp_cons* cons, lisp_value* value); +extern lisp_atom atom_cond; +void lisp_macro_cond(lisp_cons* cons, lisp_value* value); + +#endif diff --git a/native_funs.c b/native_funs.c new file mode 100644 index 0000000..e6dfaa5 --- /dev/null +++ b/native_funs.c @@ -0,0 +1,420 @@ +#include "native_funs.h" + +void lisp_add(lisp_cons* cons, lisp_value* value) { + long _int = 0; + float _float = 0.0f; + bool is_float = false; + while (cons != NULL) { + if (!is_float) { + if (cons->car.type == LISP_T_INT) + _int += cons->car.value._int; + else if (cons->car.type == LISP_T_FLOAT) { + _float = (float) _int; + is_float = true; + _float += cons->car.value._float; + } + } else { + if (cons->car.type == LISP_T_INT) + _float += cons->car.value._int; + else if (cons->car.type == LISP_T_FLOAT) + _float += cons->car.value._float; + } + cons = cons->cdr.value.cons; + } + if (is_float) { + value->type = LISP_T_FLOAT; + value->value._float = _float; + } else { + value->type = LISP_T_INT; + value->value._int = _int; + } +} +void lisp_sub(lisp_cons* cons, lisp_value* value) { + long _int = 0; + float _float = 0.0f; + bool is_float = false; + + if (cons->car.type == LISP_T_FLOAT) { + _float = cons->car.value._float; + is_float = true; + } else if (cons->car.type == LISP_T_INT) { + _int = cons->car.value._int; + } else { + value->type = LISP_T_CONS; + value->value.cons = NULL; + return; + } + + if (cons->cdr.value.cons == NULL) { + if (is_float) { + value->type = LISP_T_FLOAT; + value->value._float = -_float; + } else { + value->type = LISP_T_INT; + value->value._int = -_int; + } + return; + } else + cons = cons->cdr.value.cons; + + while (cons != NULL) { + if (!is_float) { + if (cons->car.type == LISP_T_INT) + _int -= cons->car.value._int; + else if (cons->car.type == LISP_T_FLOAT) { + _float = (float) _int; + is_float = true; + _float -= cons->car.value._float; + } + } else { + if (cons->car.type == LISP_T_INT) + _float -= cons->car.value._int; + else if (cons->car.type == LISP_T_FLOAT) + _float -= cons->car.value._float; + } + cons = cons->cdr.value.cons; + } + if (is_float) { + value->type = LISP_T_FLOAT; + value->value._float = _float; + } else { + value->type = LISP_T_INT; + value->value._int = _int; + } +} +void lisp_mul(lisp_cons* cons, lisp_value* value) { + long _int = 1; + float _float = 1; + bool is_float = false; + while (cons != NULL) { + if (!is_float) { + if (cons->car.type == LISP_T_INT) + _int *= cons->car.value._int; + else if (cons->car.type == LISP_T_FLOAT) { + _float = (float) _int; + is_float = true; + _float *= cons->car.value._float; + } + } else { + if (cons->car.type == LISP_T_INT) + _float *= cons->car.value._int; + else if (cons->car.type == LISP_T_FLOAT) + _float *= cons->car.value._float; + } + cons = cons->cdr.value.cons; + } + if (is_float) { + value->type = LISP_T_FLOAT; + value->value._float = _float; + } else { + value->type = LISP_T_INT; + value->value._int = _int; + } +} +void lisp_div(lisp_cons* cons, lisp_value* value) { + float _float = 0; + + if (cons->car.type == LISP_T_FLOAT) + _float = cons->car.value._float; + else if (cons->car.type == LISP_T_INT) + _float = cons->car.value._int; + else { + value->type = LISP_T_CONS; + value->value.cons = NULL; + return; + } + + cons = cons->cdr.value.cons; + while (cons != NULL) { + if (cons->car.type == LISP_T_INT) + _float /= cons->car.value._int; + else if (cons->car.type == LISP_T_FLOAT) + _float /= cons->car.value._float; + cons = cons->cdr.value.cons; + } + value->type = LISP_T_FLOAT; + value->value._float = _float; +} +void lisp_intdiv(lisp_cons* cons, lisp_value* value) { + long _int = 0; + + if (cons->car.type == LISP_T_FLOAT) + _int = cons->car.value._float; + else if (cons->car.type == LISP_T_INT) + _int = cons->car.value._int; + else { + value->type = LISP_T_CONS; + value->value.cons = NULL; + return; + } + + cons = cons->cdr.value.cons; + while (cons != NULL) { + if (cons->car.type == LISP_T_INT) + _int /= cons->car.value._int; + else if (cons->car.type == LISP_T_FLOAT) + _int /= cons->car.value._float; + cons = cons->cdr.value.cons; + } + value->type = LISP_T_INT; + value->value._int = _int; +} + +void lisp_not(lisp_cons* cons, lisp_value* value) { + if (lisp_is_nil(cons->car)) { + value->type = LISP_T_ATOM; + value->value.atom = atom_t; + } else { + value->type = LISP_T_CONS; + value->value.cons = NULL; + } +} +void lisp_or(lisp_cons* cons, lisp_value* value) { + while (cons != NULL) { + if (!lisp_is_nil(cons->car)) { + *value = cons->car; + return; + } + cons = cons->cdr.value.cons; + } + value->type = LISP_T_CONS; + value->value.cons = NULL; +} +void lisp_and(lisp_cons* cons, lisp_value* value) { + value->type = LISP_T_CONS; + value->value.cons = NULL; + while (cons != NULL) { + *value = cons->car; + if (lisp_is_nil(cons->car)) + return; + cons = cons->cdr.value.cons; + } +} + +void lisp_eq(lisp_cons* cons, lisp_value* value) { + lisp_value cmp_value = cons->car; + cons = cons->cdr.value.cons; + while (cons != NULL) { + if (!lisp_is_equal(cmp_value, cons->car)) { + value->type = LISP_T_CONS; + value->value.cons = NULL; + return; + } + cons = cons->cdr.value.cons; + } + *value = cmp_value; +} +void lisp_num_eq(lisp_cons* cons, lisp_value* value) { + lisp_value cmp_value = cons->car; + if (cmp_value.type != LISP_T_INT && cmp_value.type != LISP_T_FLOAT) { + value->type = LISP_T_CONS; + value->value.cons = NULL; + return; + } + cons = cons->cdr.value.cons; + while (cons != NULL) { + bool cmp = false; + if (cons->car.type == LISP_T_INT) { + if (cmp_value.type == LISP_T_INT) + cmp = (cmp_value.value._int == cons->car.value._int); + else if (cmp_value.type == LISP_T_FLOAT) + cmp = (cmp_value.value._float == cons->car.value._int); + } else if (cons->car.type == LISP_T_FLOAT) { + if (cmp_value.type == LISP_T_INT) + cmp = (cmp_value.value._int == cons->car.value._float); + else if (cmp_value.type == LISP_T_FLOAT) + cmp = (cmp_value.value._float == cons->car.value._float); + } + if (!cmp) { + value->type = LISP_T_CONS; + value->value.cons = NULL; + return; + } + cons = cons->cdr.value.cons; + } + *value = cmp_value; +} +void lisp_num_lt(lisp_cons* cons, lisp_value* value) { + lisp_value cmp_value = cons->car; + if (cmp_value.type != LISP_T_INT && cmp_value.type != LISP_T_FLOAT) { + value->type = LISP_T_CONS; + value->value.cons = NULL; + return; + } + cons = cons->cdr.value.cons; + while (cons != NULL) { + bool cmp = false; + if (cons->car.type == LISP_T_INT) { + if (cmp_value.type == LISP_T_INT) + cmp = (cmp_value.value._int < cons->car.value._int); + else if (cmp_value.type == LISP_T_FLOAT) + cmp = (cmp_value.value._float < cons->car.value._int); + } else if (cons->car.type == LISP_T_FLOAT) { + if (cmp_value.type == LISP_T_INT) + cmp = (cmp_value.value._int < cons->car.value._float); + else if (cmp_value.type == LISP_T_FLOAT) + cmp = (cmp_value.value._float < cons->car.value._float); + } + if (!cmp) { + value->type = LISP_T_CONS; + value->value.cons = NULL; + return; + } + cmp_value = cons->car; + cons = cons->cdr.value.cons; + } + *value = cmp_value; +} +void lisp_num_gt(lisp_cons* cons, lisp_value* value) { + lisp_value cmp_value = cons->car; + if (cmp_value.type != LISP_T_INT && cmp_value.type != LISP_T_FLOAT) { + value->type = LISP_T_CONS; + value->value.cons = NULL; + return; + } + cons = cons->cdr.value.cons; + while (cons != NULL) { + bool cmp = false; + if (cons->car.type == LISP_T_INT) { + if (cmp_value.type == LISP_T_INT) + cmp = (cmp_value.value._int > cons->car.value._int); + else if (cmp_value.type == LISP_T_FLOAT) + cmp = (cmp_value.value._float > cons->car.value._int); + } else if (cons->car.type == LISP_T_FLOAT) { + if (cmp_value.type == LISP_T_INT) + cmp = (cmp_value.value._int > cons->car.value._float); + else if (cmp_value.type == LISP_T_FLOAT) + cmp = (cmp_value.value._float > cons->car.value._float); + } + if (!cmp) { + value->type = LISP_T_CONS; + value->value.cons = NULL; + return; + } + cmp_value = cons->car; + cons = cons->cdr.value.cons; + } + *value = cmp_value; +} +void lisp_num_le(lisp_cons* cons, lisp_value* value) { + lisp_value cmp_value = cons->car; + if (cmp_value.type != LISP_T_INT && cmp_value.type != LISP_T_FLOAT) { + value->type = LISP_T_CONS; + value->value.cons = NULL; + return; + } + cons = cons->cdr.value.cons; + while (cons != NULL) { + bool cmp = false; + if (cons->car.type == LISP_T_INT) { + if (cmp_value.type == LISP_T_INT) + cmp = (cmp_value.value._int <= cons->car.value._int); + else if (cmp_value.type == LISP_T_FLOAT) + cmp = (cmp_value.value._float <= cons->car.value._int); + } else if (cons->car.type == LISP_T_FLOAT) { + if (cmp_value.type == LISP_T_INT) + cmp = (cmp_value.value._int <= cons->car.value._float); + else if (cmp_value.type == LISP_T_FLOAT) + cmp = (cmp_value.value._float <= cons->car.value._float); + } + if (!cmp) { + value->type = LISP_T_CONS; + value->value.cons = NULL; + return; + } + cmp_value = cons->car; + cons = cons->cdr.value.cons; + } + *value = cmp_value; +} +void lisp_num_ge(lisp_cons* cons, lisp_value* value) { + lisp_value cmp_value = cons->car; + if (cmp_value.type != LISP_T_INT && cmp_value.type != LISP_T_FLOAT) { + value->type = LISP_T_CONS; + value->value.cons = NULL; + return; + } + cons = cons->cdr.value.cons; + while (cons != NULL) { + bool cmp = false; + if (cons->car.type == LISP_T_INT) { + if (cmp_value.type == LISP_T_INT) + cmp = (cmp_value.value._int >= cons->car.value._int); + else if (cmp_value.type == LISP_T_FLOAT) + cmp = (cmp_value.value._float >= cons->car.value._int); + } else if (cons->car.type == LISP_T_FLOAT) { + if (cmp_value.type == LISP_T_INT) + cmp = (cmp_value.value._int >= cons->car.value._float); + else if (cmp_value.type == LISP_T_FLOAT) + cmp = (cmp_value.value._float >= cons->car.value._float); + } + if (!cmp) { + value->type = LISP_T_CONS; + value->value.cons = NULL; + return; + } + cmp_value = cons->car; + cons = cons->cdr.value.cons; + } + *value = cmp_value; +} + +void lisp_type_of(lisp_cons* cons, lisp_value* value) { + if (lisp_is_nil(cons->car)) { + value->type = LISP_T_CONS; + value->value.cons = NULL; + return; + } + value->type = LISP_T_ATOM; + switch (cons->car.type) { + case LISP_T_CONS: + value->value.atom = atom_cons; + break; + case LISP_T_ATOM: + value->value.atom = atom_atom; + break; + case LISP_T_INT: + value->value.atom = atom_int; + break; + case LISP_T_FLOAT: + value->value.atom = atom_float; + break; + case LISP_T_STRING: + value->value.atom = atom_string; + break; + case LISP_T_FUNPTR: + value->value.atom = atom_native_fun; + break; + } +} + +void lisp_addr_of(lisp_cons* cons, lisp_value* value) { + value->type = LISP_T_INT; + value->value._int = (long) cons->car.value.cons; +} + +void init_native_funs() { + // arithmetic + lisp_defun_native(lisp_string_create("+"), &lisp_add); + lisp_defun_native(lisp_string_create("-"), &lisp_sub); + lisp_defun_native(lisp_string_create("*"), &lisp_mul); + lisp_defun_native(lisp_string_create("/"), &lisp_div); + lisp_defun_native(lisp_string_create("int/"), &lisp_intdiv); + + // boolean logic + lisp_defun_native(lisp_string_create("not"), &lisp_not); + lisp_defun_native(lisp_string_create("or"), &lisp_or); + lisp_defun_native(lisp_string_create("and"), &lisp_and); + + // comparison + lisp_defun_native(lisp_string_create("eq"), &lisp_eq); + lisp_defun_native(lisp_string_create("="), &lisp_num_eq); + lisp_defun_native(lisp_string_create("<"), &lisp_num_lt); + lisp_defun_native(lisp_string_create(">"), &lisp_num_gt); + lisp_defun_native(lisp_string_create("<="), &lisp_num_le); + lisp_defun_native(lisp_string_create(">="), &lisp_num_ge); + + // etc + lisp_defun_native(lisp_string_create("type-of"), &lisp_type_of); + lisp_defun_native(lisp_string_create("addr-of"), &lisp_addr_of); +} diff --git a/native_funs.h b/native_funs.h new file mode 100644 index 0000000..a340391 --- /dev/null +++ b/native_funs.h @@ -0,0 +1,32 @@ +#ifndef _NATIVE_FUNS_H +#define _NATIVE_FUNS_H + +#include +#include + +#include "lisp_types.h" +#include "lisp_string.h" +#include "main.h" + +void lisp_add(lisp_cons* cons, lisp_value* value); +void lisp_sub(lisp_cons* cons, lisp_value* value); +void lisp_mul(lisp_cons* cons, lisp_value* value); +void lisp_div(lisp_cons* cons, lisp_value* value); +void lisp_intdiv(lisp_cons* cons, lisp_value* value); + +void lisp_not(lisp_cons* cons, lisp_value* value); +void lisp_or(lisp_cons* cons, lisp_value* value); +void lisp_and(lisp_cons* cons, lisp_value* value); + +void lisp_eq(lisp_cons* cons, lisp_value* value); +void lisp_num_eq(lisp_cons* cons, lisp_value* value); +void lisp_num_lt(lisp_cons* cons, lisp_value* value); +void lisp_num_gt(lisp_cons* cons, lisp_value* value); +void lisp_num_le(lisp_cons* cons, lisp_value* value); +void lisp_num_ge(lisp_cons* cons, lisp_value* value); + +void lisp_type_of(lisp_cons* cons, lisp_value* value); +void lisp_addr_of(lisp_cons* cons, lisp_value* value); + +void init_native_funs(); +#endif diff --git a/parse.c b/parse.c new file mode 100644 index 0000000..5c98c4b --- /dev/null +++ b/parse.c @@ -0,0 +1,327 @@ +#include "parse.h" + +#define lisp_tokenize_len 64 +char lisp_tokenize_buf[lisp_tokenize_len]; +int lisp_tokenize_pos; +bool lisp_tokenize_quote_mode; +bool lisp_tokenize_esc_mode; +void lisp_tokenize_init() { + lisp_tokenize_buf[0] = '\0'; + lisp_tokenize_pos = 0; + lisp_tokenize_quote_mode = false; + lisp_tokenize_esc_mode = false; +} +void lisp_tokenize_next(lisp_cons** head) { + lisp_tokenize_buf[lisp_tokenize_pos] = '\0'; + lisp_string* token_lstr = lisp_string_create(lisp_tokenize_buf); + lisp_tokenize_buf[0] = '\0'; + lisp_tokenize_pos = 0; + + lisp_cons* tail = dbg_malloc(sizeof(lisp_cons)); + tail->car.type = LISP_T_STRING; + tail->car.value.string = token_lstr; + tail->cdr.type = LISP_T_CONS; + tail->cdr.value.cons = NULL; + if (*head != NULL) + lisp_cons_join(*head, tail); + else + *head = tail; +} +void lisp_tokenize(char* buf, int len, lisp_cons** head) { + for (int i = 0; i < len; i++) { + if (lisp_tokenize_pos >= lisp_tokenize_len-1) { + lisp_tokenize_pos = lisp_tokenize_len-1; + lisp_tokenize_next(head); + } + char c = buf[i]; + if (lisp_tokenize_quote_mode) { + lisp_tokenize_buf[lisp_tokenize_pos++] = c; + if (c == '\\') + lisp_tokenize_esc_mode = true; + else if ((c == '"') & !lisp_tokenize_esc_mode) { // end of string + lisp_tokenize_next(head); + lisp_tokenize_quote_mode = false; + } else + lisp_tokenize_esc_mode = false; + continue; + } + + if (lisp_tokenize_esc_mode) { + lisp_tokenize_buf[lisp_tokenize_pos++] = c; + lisp_tokenize_esc_mode = false; + continue; + } + + if ((c == ' ') || (c == '\t') || (c == '\n') || (c == '\r') || (c == '\v') || (c == '\f')) { + if (lisp_tokenize_pos > 0) // whitespace, end of token + lisp_tokenize_next(head); + } else if (c == ')') { + // end current token + if (lisp_tokenize_pos > 0) + lisp_tokenize_next(head); + // ) is its own token + lisp_tokenize_buf[lisp_tokenize_pos++] = c; + lisp_tokenize_next(head); + } else if (c == '(') { + // ( is its own token + lisp_tokenize_buf[lisp_tokenize_pos++] = c; + lisp_tokenize_next(head); + } else if ((c == '"') && (lisp_tokenize_pos == 0)) { + // enable quotes mode + lisp_tokenize_buf[lisp_tokenize_pos++] = c; + lisp_tokenize_quote_mode = true; + } else if (c == '\\') { + lisp_tokenize_esc_mode = true; + } else { + lisp_tokenize_buf[lisp_tokenize_pos++] = c; + } + } +} + +bool lisp_parse_number(lisp_string* token_lstr, lisp_value* value) { + int token_len = lisp_string_len(token_lstr); + char* token_data = lisp_string_data(token_lstr); + + bool neg = false; + bool exp_neg = false; + bool exp_mode = false; + bool point = false; + bool valid = false; + long _int = 0; + float _float = 0.0f; + float weight = 0.1f; + int exp_i = 0; + int exp = 0; + for (int i = 0; i < token_len; i++) { + char c = token_data[i]; + if (!exp_mode) { + if (c == '-' && i == 0) { + neg = true; + } else if (c >= '0' && c <= '9') { + valid = true; + if (!point) + _int = (_int * 10) + (c - '0'); + else { + _float += ((c - '0') * weight); + weight /= 10.0f; + } + } else if (c == '.' && !point) { + point = true; + _float = (float) _int; + } else if (c == 'e' || c == 'E') { + valid = false; + exp_mode = true; + if (!point) + _float = (float) _int; + point = true; + exp_i = i+1; + } else { + valid = false; + break; + } + } else { + if (c == '-' && i == exp_i) { + exp_neg = true; + } else if (c >= '0' && c <= '9') { + valid = true; + exp = (exp * 10) + (c - '0'); + } else { + valid = false; + break; + } + } + } + if (valid && !point) { + if (neg) + _int = -_int; + value->type = LISP_T_INT; + value->value._int = _int; + return true; + } else if (valid) { + if (neg) + _float = -_float; + if (exp_neg) + exp = -exp; + value->type = LISP_T_FLOAT; + value->value._float = _float; + if (exp_mode) + value->value._float *= powf(10, exp); + return true; + } + return false; +} +bool lisp_parse_string(lisp_string* token_lstr, lisp_value* value) { + int token_len = lisp_string_len(token_lstr); + char* token_data = lisp_string_data(token_lstr); + + if (token_data[0] != '"') + return false; + + lisp_string* lstr = lisp_string_alloc(lisp_string_len(token_lstr) - 2); + int lstr_len = 0; + char* lstr_data = lisp_string_data(lstr); + + bool esc_mode = false; + char esc_hex_mode = 0; + char esc_hex = 0; + for (int i = 1; i < token_len-1; i++) { + char c = token_data[i]; + if (esc_mode) { + esc_mode = false; + switch (c) { + case 'b': + lstr_data[lstr_len++] = '\b'; + break; + case 'e': + lstr_data[lstr_len++] = '\e'; + break; + case 'f': + lstr_data[lstr_len++] = '\f'; + break; + case 'n': + lstr_data[lstr_len++] = '\n'; + break; + case 'r': + lstr_data[lstr_len++] = '\r'; + break; + case 't': + lstr_data[lstr_len++] = '\t'; + break; + case 'v': + lstr_data[lstr_len++] = '\v'; + break; + case 'x': + esc_hex_mode = 2; + esc_hex = 0; + break; + default: + lstr_data[lstr_len++] = c; + break; + } + } else if (esc_hex_mode > 0) { + esc_hex_mode--; + esc_hex <<= 4; + if (c <= '9') + esc_hex += (c - '0'); + else if (c <= 'F') + esc_hex += (c - ('A'-10)); + else + esc_hex += (c - ('a'-10)); + + if (esc_hex_mode == 0) + lstr_data[lstr_len++] = esc_hex; + } else { + if (c == '\\') { + esc_mode = true; + } else { + lstr_data[lstr_len++] = c; + } + } + } + *((int*) lstr) = lstr_len; + value->type = LISP_T_STRING; + value->value.string = lstr; + return true; +} +bool lisp_parse_scalar(lisp_string* token_lstr, lisp_value* value) { + char* buf = lisp_string_data(token_lstr); + if (buf[0] == '(' || buf[0] == ')' || buf[0] == '\'') // parentheses, quote + return false; + if (lisp_string_len(token_lstr) == 3 && buf[0] == 'n' && buf[1] == 'i' && buf[2] == 'l') { // nil + value->type = LISP_T_CONS; + value->value.cons = NULL; + return true; + } + + if (lisp_parse_string(token_lstr, value)) + return true; + if (lisp_parse_number(token_lstr, value)) + return true; + lisp_atom atom = lisp_atomize(token_lstr); + value->type = LISP_T_ATOM; + value->value.atom = atom; + return true; +} + +bool lisp_parse_recursive(lisp_cons** tokens, bool (*fetch_tokens)(lisp_cons**), lisp_value* value) { + while (*tokens == NULL) // fetch more tokens + if ((*fetch_tokens)(tokens) == false) + return false; + lisp_cons* cons = lisp_cons_pop(tokens); + lisp_string* token_lstr = cons->car.value.string; + char* buf = lisp_string_data(token_lstr); + if (buf[0] == '\'') { + lisp_string* new_lstr = lisp_string_create_raw(lisp_string_data(token_lstr)+1, lisp_string_len(token_lstr)-1); + dbg_free(token_lstr); + cons->car.value.string = new_lstr; + *tokens = cons; + lisp_cons* quote_cons = dbg_malloc(sizeof(lisp_cons)); + quote_cons->car.type = LISP_T_ATOM; + quote_cons->car.value.atom = atom_quote; + quote_cons->cdr.type = LISP_T_CONS; + quote_cons->cdr.value.cons = dbg_malloc(sizeof(lisp_cons)); + quote_cons->cdr.value.cons->cdr.type = LISP_T_CONS; + quote_cons->cdr.value.cons->cdr.value.cons = NULL; + if (!lisp_parse_recursive(tokens, fetch_tokens, "e_cons->cdr.value.cons->car)) + return false; + value->type = LISP_T_CONS; + value->value.cons = quote_cons; + return true; + } + if (buf[0] == '(') { + buf = NULL; + dbg_free(token_lstr); + lisp_cons* head = NULL; + lisp_cons* tail = NULL; + lisp_cons* new_cons = cons; + bool cdr_mode = false; + while (lisp_parse_recursive(tokens, fetch_tokens, &new_cons->car)) { + new_cons->cdr.type = LISP_T_CONS; + new_cons->cdr.value.cons = NULL; + if (head == NULL) + head = new_cons; + if (tail == NULL) + tail = head; + else { + if (cdr_mode) { + tail->cdr = new_cons->car; + dbg_free(new_cons); + } else { + tail->cdr.value.cons = new_cons; + tail = new_cons; + } + } + new_cons = dbg_malloc(sizeof(lisp_cons)); + + while (*tokens == NULL) // fetch more tokens + if ((*fetch_tokens)(tokens) == false) + return false; + token_lstr = (*tokens)->car.value.string; + if (lisp_string_len(token_lstr) == 1) { + if (lisp_string_data(token_lstr)[0] == ')') { + cons = lisp_cons_pop(tokens); + dbg_free(cons); + dbg_free(token_lstr); + break; + } else if (lisp_string_data(token_lstr)[0] == '.') { + cons = lisp_cons_pop(tokens); + dbg_free(cons); + dbg_free(token_lstr); + cdr_mode = true; + } + } + } + dbg_free(new_cons); + value->type = LISP_T_CONS; + value->value.cons = head; + + return true; + } + if (lisp_parse_scalar(token_lstr, value)) { + dbg_free(cons); + dbg_free(token_lstr); + return true; + } + *tokens = cons; + return false; +} diff --git a/parse.h b/parse.h new file mode 100644 index 0000000..0b63163 --- /dev/null +++ b/parse.h @@ -0,0 +1,20 @@ +#ifndef _PARSE_H +#define _PARSE_H + +#include + +#include "lisp_types.h" +#include "lisp_string.h" +#include "main.h" + +void lisp_tokenize_init(); +void lisp_tokenize_next(lisp_cons** head); +void lisp_tokenize(char* buf, int len, lisp_cons** head); + +bool lisp_parse_number(lisp_string* token_lstr, lisp_value* value); +bool lisp_parse_string(lisp_string* token_lstr, lisp_value* value); +bool lisp_parse_scalar(lisp_string* token_lstr, lisp_value* value); + +bool lisp_parse_recursive(lisp_cons** tokens, bool (*fetch_tokens)(lisp_cons**), lisp_value* value); + +#endif