diff options
| -rw-r--r-- | README.md | 5 | ||||
| -rw-r--r-- | files/test-lambda.l | 14 | ||||
| -rw-r--r-- | src/common.h | 2 | ||||
| -rw-r--r-- | src/env.c | 75 | ||||
| -rw-r--r-- | src/env.h | 5 | ||||
| -rw-r--r-- | src/hamt.c | 337 | ||||
| -rw-r--r-- | src/hamt.h | 45 | ||||
| -rw-r--r-- | src/lexer.c | 59 | ||||
| -rw-r--r-- | src/lexer.h | 10 | ||||
| -rw-r--r-- | src/main.c | 68 | ||||
| -rw-r--r-- | src/value.c | 56 | ||||
| -rw-r--r-- | src/value.h | 6 |
12 files changed, 193 insertions, 489 deletions
@@ -1,12 +1,9 @@ -g### nlisp +### nlisp A simple lisp/scheme interpreter #### TODO -* hamt for allocations - * reduce allocations -* overhaul environement/closures * improve errors * FFI diff --git a/files/test-lambda.l b/files/test-lambda.l index d58169a..3136452 100644 --- a/files/test-lambda.l +++ b/files/test-lambda.l @@ -92,3 +92,17 @@ (cond (((= 1 2) 3) ((= 1 (+ 1 1)) (+ 6 2)) (1 (quote test)))) + +(defmacro begin (vars) + (foldr (lambda (var rest) `((lambda (__) ,rest) ,var)) '__ vars)) + +(begin + ((define inc (lambda (a) (+ a 1))) + (inc 1))) + +(define inc (lambda (a) (+ a 1))) + +(begin + ((+ 0 1) + (define a inc))) + ;; (a 1))) diff --git a/src/common.h b/src/common.h index 225f217..4f580b9 100644 --- a/src/common.h +++ b/src/common.h @@ -47,6 +47,8 @@ static inline char *timenow(void) #include <errno.h> +#define NOT_IMPLEMENTED() die("Not Implemented. ABORTING") + #define ERR_NZ(e, r, on_fail) do { \ int r; \ if((r = e)) { on_fail; } \ @@ -25,9 +25,21 @@ struct env_kv { int flags; }; -#include "mempool.h" -MEMPOOL_GENERATE(env, struct env, 256) -MEMPOOL_GENERATE(env_kv, struct env_kv, 1024) +// #ifdef ENABLE_MEMPOOL + #include "mempool.h" + MEMPOOL_GENERATE(env, struct env, 256) + MEMPOOL_GENERATE(env_kv, struct env_kv, 1024) + + #define env_alloc() env_mempool_allocate() + #define env_free(v) env_mempool_free(v) + #define env_kv_alloc() env_kv_mempool_allocate() + #define env_kv_free(v) env_kv_mempool_free(v) +// #else + // #define env_alloc() malloc(sizeof(struct env)) + // #define env_free(v) free(v) + // #define env_kv_alloc() malloc(sizeof(struct env_kv)) + // #define env_kv_free(v) free(v) +// #endif static int equal(char *key1, char *key2) { @@ -36,7 +48,7 @@ static int equal(char *key1, char *key2) static struct env_kv *env_kv_create(char *key, value_t value, int flags) { - struct env_kv *pair = env_kv_mempool_allocate(); + struct env_kv *pair = env_kv_alloc(); pair->key = key; pair->value = value; @@ -52,12 +64,12 @@ static void env_kv_destroy(struct env_kv *pair) free(pair->key); value_destroy(pair->value); - env_kv_mempool_free(pair); + env_kv_free(pair); } env_t env_create(env_t parent) { - env_t env = env_mempool_allocate(); + env_t env = env_alloc(); env->parent = env_copy(parent); env->head = NULL; @@ -83,7 +95,7 @@ void env_destroy(env_t env) } env_destroy(env->parent); - env_mempool_free(env); + env_free(env); } int env_insert(env_t env, char *key, _value_t value, @@ -139,18 +151,37 @@ env_t env_copy(env_t env) return env; } -// void env_print(env_t env) -// { -// printf("REFS: %d\n", env->refs); -// printf("CREFS: %d\n", env->circular_refs); -// if(!env || !env->head) return; -// list_for_each_entry(struct env_kv, pair, list, env->head) { -// printf("ENTRY: %s %s\n", pair->key, pair->value); -// } - -// if(env->parent) { -// printf("---- PARENT ----\n"); -// env_print(env->parent); -// printf("-- END PARENT --\n"); -// } -// } +int env_depend(env_t parent, env_t dep) +{ + if(!dep || !parent) return 0; + if(dep == parent) return 1; + + return env_depend(parent, dep->parent); +} + +#ifdef DEBUG +static void _env_print(env_t env, int depth) +{ + (void)depth; + + printf("refs: %d\n", env->refs); + printf("crefs: %d\n", env->circular_refs); + if(!env || !env->head) return; + list_for_each_entry(struct env_kv, pair, list, env->head) { + printf(" %s %s\n", pair->key, pair->value); + } + + if(env->parent) { + printf("--- parent start ---\n"); + _env_print(env->parent, depth+2); + printf("---- parent end ----\n"); + } +} + +void env_print(env_t env) +{ + printf("--- env start ---\n"); + _env_print(env, 0); + printf("---- env end ----\n"); +} +#endif @@ -22,5 +22,10 @@ int env_insert(env_t env, char *key, _value_t value, int env_query(env_t env, char *key, _value_t *data); env_t env_copy(env_t env); +int env_depend(env_t parent, env_t dep); + +#ifdef DEBUG +void env_print(env_t env); +#endif #endif diff --git a/src/hamt.c b/src/hamt.c deleted file mode 100644 index a6be3ba..0000000 --- a/src/hamt.c +++ /dev/null @@ -1,337 +0,0 @@ -#include <stdio.h> -#include <stdlib.h> -#include <stdint.h> -#include <string.h> -#include <assert.h> -#include "hamt.h" - -#include "mempool.h" -MEMPOOL_GENERATE(hamt, struct hamt, 16) -MEMPOOL_GENERATE(hl, struct hamt_nodelist, 64) -MEMPOOL_GENERATE(hi, struct hamt_item, 32) - -#define tag_ptr(ptr, tag) ((uintptr_t)(ptr) | (tag)) -#define untag_ptr(ptr, tag) ((uintptr_t)(ptr) & ~(tag)) -#define is_tagged(ptr, tag) ((uintptr_t)(ptr) & (tag)) - -#define HAMT_ITEM_TAG 0x1 -#define TAG_NODELIST(ptr) \ - (hamtptr_t)untag_ptr(ptr, HAMT_ITEM_TAG) -#define TAG_ITEM(ptr) \ - (hamtptr_t)tag_ptr(ptr, HAMT_ITEM_TAG) -#define AS_NODELIST(ptr) \ - ((struct hamt_nodelist *)untag_ptr(ptr, HAMT_ITEM_TAG)) -#define AS_ITEM(ptr) \ - ((struct hamt_item *)untag_ptr(ptr, HAMT_ITEM_TAG)) -#define AS_VOIDPTR(ptr) \ - ((void *)untag_ptr(ptr, HAMT_ITEM_TAG) -#define IS_NODELIST(hamtptr) \ - !is_tagged(hamtptr, HAMT_ITEM_TAG) -#define IS_ITEM(hamtptr) \ - is_tagged(hamtptr, HAMT_ITEM_TAG) - -#define for_each_item(item, head) \ - for(struct hamt_item *item = (head), *next = NULL; \ - item && (next = item->next, 1); item = next) - -#define popcount(i) __builtin_popcount(i) - -#define BITS 6 -#define BITS_MASK 0x3f - -static inline struct hamt_nodelist *hamt_nodelist_alloc(void); -static inline struct hamt_item *hamt_item_alloc(void); - -static void hamtptr_destroy(hamtptr_t hamtptr); -static inline void hamtptr_add_ref(hamtptr_t hamtptr); - -// static void hamt_print_hamtptr(hamtptr_t hamtptr, int depth); - -hamt_t hamt_create(hamt_equal_fn equal_fn, hamt_hash_fn hash_fn) -{ - // hamt_t hamt = malloc(sizeof(*hamt)); - hamt_t hamt = hamt_mempool_allocate(); - hamt->equal_fn = equal_fn; - hamt->hash_fn = hash_fn; - hamt->root = TAG_NODELIST(hamt_nodelist_alloc()); - - return hamt; -} - -void hamt_destroy(hamt_t hamt) -{ - if(!hamt) return; - - hamtptr_destroy(hamt->root); - // free(hamt); - hamt_mempool_free(hamt); -} - -hamt_t hamt_clone(hamt_t src) -{ - // hamt_t hamt = malloc(sizeof(*hamt)); - hamt_t hamt = hamt_mempool_allocate(); - - if(!src) return hamt; - - hamt->equal_fn = src->equal_fn; - hamt->hash_fn = src->hash_fn; - hamt->root = src->root; - hamtptr_add_ref(hamt->root); - - return hamt; -} - -static int hamt_find_hamtptr(hamtptr_t root, hamtptr_t *ret, uint32_t *hash) -{ - *ret = root; - - for(size_t i = 0; i < sizeof(*hash)*8/BITS; i++) { - assert(IS_NODELIST(*ret)); - struct hamt_nodelist *nodelist = AS_NODELIST(*ret); - - size_t rawidx = *hash & BITS_MASK; - if(!(nodelist->bitmask & (1 << rawidx))) { - return sizeof(*hash)*8/BITS - i; - } - - *hash >>= BITS; - - size_t idx = popcount(nodelist->bitmask & ((1 << rawidx) - 1)); - *ret = nodelist->list[idx]; - } - - return 0; -} - -int hamt_get(hamt_t hamt, void *key, void **data) -{ - hamtptr_t hamtptr; - uint32_t hash = hamt->hash_fn(key); - - if(hamt_find_hamtptr(hamt->root, &hamtptr, &hash) != 0) - return 1; - - assert(IS_ITEM(hamtptr)); - struct hamt_item *item = AS_ITEM(hamtptr); - - while(!hamt->equal_fn(key, item->key)) { - if(item->next == NULL) return 1; - item = item->next; - } - - *data = item->data; - return 0; -} - -static hamtptr_t hamt_build(uint32_t hash, size_t iter, struct hamt_item **item) -{ - if(iter == 1) { - *item = hamt_item_alloc(); - return TAG_ITEM(*item); - } - - hash >>= BITS; - size_t next_idx = hash & BITS_MASK; - - hamtptr_t next = hamt_build(hash, iter-1, item); - - struct hamt_nodelist *nodelist = hamt_nodelist_alloc(); - - // nodelist->list = &next; - nodelist->list = calloc(1, sizeof(*nodelist->list)); - nodelist->list[0] = next; - - nodelist->bitmask = 1 << next_idx; - - return TAG_NODELIST(nodelist); -} - -static hamtptr_t hamt_insert_hamtptr(hamtptr_t root, hamtptr_t hamtptr, uint32_t hash, hamt_equal_fn equal_fn) -{ - if(IS_ITEM(root)) { - struct hamt_item *item = AS_ITEM(root); - - if(equal_fn(item->key, AS_ITEM(hamtptr)->key)) { - item->refs--; - AS_ITEM(hamtptr)->next = item->next; - return hamtptr; - } - - if(item->next) { - hamtptr = hamt_insert_hamtptr(TAG_ITEM(item->next), hamtptr, hash, equal_fn); - } - - struct hamt_item *new; - - if(item->refs == 1) { - new = item; - } else { - item->refs--; - new = hamt_item_alloc(); - new->key = item->key; - new->data = item->data; - } - - new->next = AS_ITEM(hamtptr); - return TAG_ITEM(new); - } - - struct hamt_nodelist *nodelist = AS_NODELIST(root); - - size_t rawidx = hash & BITS_MASK; - size_t idx = popcount(nodelist->bitmask & ((1 << rawidx) - 1)); - - size_t list_len = popcount(nodelist->bitmask); - size_t newlist_len = list_len; - - if(nodelist->bitmask & (1 << rawidx)) { - hamtptr = hamt_insert_hamtptr(nodelist->list[idx], hamtptr, hash >> BITS, equal_fn); - - if(nodelist->refs == 1) { - nodelist->list[idx] = hamtptr; - return TAG_NODELIST(nodelist); - } - } else { - newlist_len++; - } - - hamtptr_t *newlist = calloc(newlist_len, sizeof(*newlist)); - newlist[idx] = hamtptr; - - for(size_t i = 0; i < idx; i++) - newlist[i] = nodelist->list[i]; - - if(list_len == newlist_len) - for(size_t i = idx+1; i < newlist_len; i++) - newlist[i] = nodelist->list[i]; - else - for(size_t i = idx+1; i < newlist_len; i++) - newlist[i] = nodelist->list[i-1]; - - struct hamt_nodelist *new; - - if(nodelist->refs == 1) { - new = nodelist; - free(nodelist->list); - } else { - nodelist->refs--; - new = hamt_nodelist_alloc(); - } - - new->list = newlist; - new->bitmask = nodelist->bitmask | (1 << rawidx); - return TAG_NODELIST(new); -} - -int hamt_set(hamt_t hamt, void *key, void *data, void **keyptr, void **prevdata) -{ - hamtptr_t hamtptr; - uint32_t hash = hamt->hash_fn(key); - uint32_t hash_cpy = hash; - - size_t iter; - if((iter = hamt_find_hamtptr(hamt->root, &hamtptr, &hash_cpy)) != 0) { - struct hamt_item *item; - hamtptr_t new = hamt_build(hash_cpy, iter, &item); - - hamt->root = hamt_insert_hamtptr(hamt->root, new, hash, hamt->equal_fn); - - item->key = key; - item->data = data; - return 0; - } - - assert(IS_ITEM(hamtptr)); - - for_each_item(item, AS_ITEM(hamtptr)) { - if(hamt->equal_fn(item->key, key)) { - if(keyptr) *keyptr = item->key; - if(prevdata) *prevdata = item->data; - if(item->refs == 1) { - item->data = data; - return 0; - } - - key = item->key; - break; - } - } - - struct hamt_item *new = hamt_item_alloc(); - new->key = key; - new->data = data; - - hamt->root = hamt_insert_hamtptr(hamt->root, TAG_ITEM(new), hash, hamt->equal_fn); - return 0; -} - -static inline struct hamt_nodelist *hamt_nodelist_alloc(void) -{ - // struct hamt_nodelist *nodelist = malloc(sizeof(*nodelist)); - struct hamt_nodelist *nodelist = hl_mempool_allocate(); - nodelist->refs = 1; - nodelist->list = 0; - nodelist->bitmask = 0; - return nodelist; -} - -static inline struct hamt_item *hamt_item_alloc(void) -{ - // struct hamt_item *item = malloc(sizeof(*item)); - struct hamt_item *item = hi_mempool_allocate(); - item->refs = 1; - item->key = NULL; - item->data = NULL; - item->next = NULL; - return item; -} - -static inline void hamtptr_destroy(hamtptr_t hamtptr) -{ - if(IS_NODELIST(hamtptr)) { - struct hamt_nodelist *nodelist = AS_NODELIST(hamtptr); - - for(size_t i = 0; i < popcount(nodelist->bitmask); i++) - hamtptr_destroy(nodelist->list[i]); - - if(--nodelist->refs == 0) { - free(nodelist->list); - // free(nodelist); - hl_mempool_free(nodelist); - } - } else { - for_each_item(item, AS_ITEM(hamtptr)) - if(--item->refs == 0) - hi_mempool_free(item); - // free(item); - } -} - -static inline void hamtptr_add_ref(hamtptr_t hamtptr) -{ - if(IS_NODELIST(hamtptr)) { - for(size_t i = 0; i < popcount(AS_NODELIST(hamtptr)->bitmask); i++) - hamtptr_add_ref(AS_NODELIST(hamtptr)->list[i]); - AS_NODELIST(hamtptr)->refs++; - } else { - for_each_item(item, AS_ITEM(hamtptr)) - item->refs++; - } -} - -// static void hamt_print_hamtptr(hamtptr_t hamtptr, int depth) -// { -// for(int i = 0; i < depth; i++) printf(" "); - -// if(IS_NODELIST(hamtptr)) { -// printf("%d, MASK %b\n", AS_NODELIST(hamtptr)->refs, AS_NODELIST(hamtptr)->bitmask); -// for(size_t i = 0; i < popcount(AS_NODELIST(hamtptr)->bitmask); i++) { -// hamt_print_hamtptr(AS_NODELIST(hamtptr)->list[i], depth+1); -// } -// } else { -// printf("%d, %s: %s\n", AS_ITEM(hamtptr)->refs, (char *)AS_ITEM(hamtptr)->key, (char *)AS_ITEM(hamtptr)->data); -// if(AS_ITEM(hamtptr)->next) -// hamt_print_hamtptr(TAG_ITEM(AS_ITEM(hamtptr)->next), depth+1); -// } -// } diff --git a/src/hamt.h b/src/hamt.h deleted file mode 100644 index 6ef27ba..0000000 --- a/src/hamt.h +++ /dev/null @@ -1,45 +0,0 @@ -#ifndef HAMT_H -#define HAMT_H - -#include <stdint.h> - -typedef struct hamt *hamt_t; - -// tagged pointer to either -// hamt_item or hamt_nodelist -typedef uintptr_t hamtptr_t; - -struct hamt_item { - uint32_t refs; - - void *key; - void *data; - struct hamt_item *next; -}; - -struct hamt_nodelist { - uint32_t refs; - - uint64_t bitmask; - hamtptr_t *list; -}; - -typedef int (*hamt_equal_fn)(void *key1, void *key2); -typedef uint32_t (*hamt_hash_fn)(void *key); - -struct hamt { - hamt_equal_fn equal_fn; - hamt_hash_fn hash_fn; - - hamtptr_t root; -}; - -hamt_t hamt_create(hamt_equal_fn equal_fn, hamt_hash_fn hash_fn); -void hamt_destroy(hamt_t hamt); - -hamt_t hamt_clone(hamt_t src); - -int hamt_get(hamt_t hamt, void *key, void **data); -int hamt_set(hamt_t hamt, void *key, void *data, void **keyptr, void **prevdata); - -#endif diff --git a/src/lexer.c b/src/lexer.c index cd83006..29e084c 100644 --- a/src/lexer.c +++ b/src/lexer.c @@ -133,11 +133,22 @@ int token_value_string(struct token *token, size_t buf_sz, char *buf) return 0; } -#define STR_ALLOC_COPY(dest, str) do { \ - size_t len = strlen(str) + 1; \ - dest = malloc(len); \ - memcpy((dest), (str), len); \ - } while(0) +char *token_value_static_string(struct token *token) +{ + static char str[1024]; + + if(token_value_string(token, sizeof(str), str) > 0) + return str; + return NULL; +} + +static char *str_alloc_copy(char *src) +{ + if(!src) return src; + + size_t len = strlen(src) + 1; + return memcpy(malloc(len), src, len); +} void token_clone(struct token *dest, struct token *src) { @@ -145,10 +156,10 @@ void token_clone(struct token *dest, struct token *src) switch(src->type) { case TOKEN_ID: - STR_ALLOC_COPY(dest->value.id, src->value.id); + dest->value.id = str_alloc_copy(src->value.id); return; case TOKEN_STR: - STR_ALLOC_COPY(dest->value.str, src->value.str); + dest->value.str = str_alloc_copy(src->value.str); return; case TOKEN_INT: dest->value.num = src->value.num; @@ -170,7 +181,20 @@ void token_dealloc(struct token *token) } } -void toklist_destroy(struct toklist *toklist) +struct toklist *toklist_alloc(struct token *tokens, size_t tokens_len) +{ + struct toklist *toklist; + toklist = malloc(sizeof(*toklist)); + LIST_EMPTY(&toklist->list); + + toklist->tokens = calloc(tokens_len, sizeof(*tokens)); + memcpy(toklist->tokens, tokens, tokens_len * sizeof(*tokens)); + toklist->tokens_len = tokens_len; + + return toklist; +} + +void toklist_dealloc(struct toklist *toklist) { list_for_each_safe(head, &toklist->list) { toklist = list_entry(head, struct toklist, list); @@ -181,6 +205,25 @@ void toklist_destroy(struct toklist *toklist) free(toklist); } } +#ifdef DEBUG +void token_print(struct token *token) +{ + printf("%-12s %s\n", + token_type_string[token->type], + token_value_static_string(token)); +} + +void toklist_print(struct toklist *toklist) +{ + printf("--- toklis start ---\n"); + list_for_each(pos, &toklist->list) { + struct toklist *entry = list_entry(pos, struct toklist, list); + for(size_t i = 0; i < entry->tokens_len; i++) + token_print(&entry->tokens[i]); + } + printf("---- toklis end ----\n"); +} +#endif static int on_separator(lexer_t lexer, enum token_type type) { diff --git a/src/lexer.h b/src/lexer.h index 632811e..0cbda75 100644 --- a/src/lexer.h +++ b/src/lexer.h @@ -68,9 +68,17 @@ int lexer_clear_line(lexer_t lexer); int lexer_token_next(lexer_t lexer, struct token *token); int token_value_string(struct token *token, size_t buf_sz, char *buf); +char *token_value_static_string(struct token *token); void token_clone(struct token *dest, struct token *src); void token_dealloc(struct token *token); -void toklist_destroy(struct toklist *toklist); + +struct toklist *toklist_alloc(struct token *tokens, size_t tokens_len); +void toklist_dealloc(struct toklist *toklist); + +#ifdef DEBUG +void token_print(struct token *token); +void toklist_print(struct toklist *toklist); +#endif #endif @@ -50,34 +50,6 @@ } while(0) -#define NOT_IMPLEMENTED() die("Not Implemented. ABORTING") - -static void print_token(struct token *token) -{ - char buf[256] = {0}; - ERR_Z(token_value_string(token, LEN(buf), buf), return); - info("%-12s %s", token_type_string[token->type], buf); -} - -static void print_value(value_t value) -{ - char buf[256] = {0}; - value_string(value, sizeof(buf), buf); - info("%-12s %s", value ? - value_type_string[vvalue_type(value)] : "VALUE", buf); -} - -static void print_toklist(struct toklist *toklist) -{ - info("TOKLIST_START"); - list_for_each(pos, &toklist->list) { - struct toklist *entry = list_entry(pos, struct toklist, list); - for(size_t i = 0; i < entry->tokens_len; i++) - print_token(&entry->tokens[i]); - } - info("TOKLIST_END"); -} - struct tctx { enum tctx_type { TCTX_LEXER, @@ -313,7 +285,7 @@ static value_t apply_macro(env_t env, struct proc *proc, value_t *args) ret = evaluate_expr(env, &tctx); exit: - if(toklist) toklist_destroy(toklist); + if(toklist) toklist_dealloc(toklist); value_destroy(macro_ret); return ret; @@ -506,7 +478,7 @@ value_t evaluate_lambda(env_t env, struct tctx *tctx) fail: err("Procedure creation failed"); for(size_t i = 0; i < argc; i++) value_destroy(args[i]); - if(body) toklist_destroy(body); + if(body) toklist_dealloc(body); if(arg_keys) free(arg_keys); return VALUE_EMPTY; } @@ -539,7 +511,13 @@ value_t evaluate_define(env_t env, struct tctx *tctx) value_t prevval = VALUE_EMPTY; int flags = ENV_KV_FREE_KEY; - flags |= (vvalue_type(val) == VALUE_PROC) ? ENV_KV_CIRCULAR_REF : 0; + + if(vvalue_type(val) == VALUE_PROC) { + flags |= (env == global_env || + env_depend(env, vvalue_proc(val).parent_env)) + ? ENV_KV_CIRCULAR_REF : 0; + + } ERR_NZ( env_insert(env, key, val, &prevval, flags), @@ -759,19 +737,6 @@ exit: } -static struct toklist *toklist_create(struct token *tokens, size_t tokens_len) -{ - struct toklist *toklist; - toklist = malloc(sizeof(*toklist)); - LIST_EMPTY(&toklist->list); - - toklist->tokens = calloc(tokens_len, sizeof(*tokens)); - memcpy(toklist->tokens, tokens, tokens_len * sizeof(*tokens)); - toklist->tokens_len = tokens_len; - - return toklist; -} - #define IS_OP(token) (token->type == TOKEN_QUOTE || \ token->type == TOKEN_QUASI || \ token->type == TOKEN_UNQUOTE) @@ -790,7 +755,7 @@ static int toklist_expr(struct tctx *tctx, struct toklist **toklist) if(tokens_len >= LEN(tokens)) { if(toklist) { - tail = list_add(tail, &toklist_create(tokens, tokens_len)->list); + tail = list_add(tail, &toklist_alloc(tokens, tokens_len)->list); } tokens_len = 0; } @@ -799,7 +764,7 @@ static int toklist_expr(struct tctx *tctx, struct toklist **toklist) else if(TOKEN(tctx)->type == TOKEN_RP) depth--; // printf("%zu\n", depth); - // print_token(TOKEN(tctx)); + // token_print(TOKEN(tctx)); if(toklist) token_clone(&tokens[tokens_len++], TOKEN(tctx)); @@ -807,7 +772,7 @@ static int toklist_expr(struct tctx *tctx, struct toklist **toklist) } while(depth != 0 || IS_OP(TOKEN(tctx))); if(toklist) { - tail = list_add(tail, &toklist_create(tokens, tokens_len)->list); + tail = list_add(tail, &toklist_alloc(tokens, tokens_len)->list); *toklist = list_entry(list_get_head(tail), struct toklist, list); } @@ -836,6 +801,9 @@ static struct toklist *value_to_toklist(value_t value) } else if(strcmp(vvalue_atom(value), "'") == 0) { SET_TOKEN_TYPE(&token, TOKEN_QUOTE); break; + } else if(strcmp(vvalue_atom(value), "define") == 0) { + SET_TOKEN_TYPE(&token, TOKEN_DEFINE); + break; } SET_TOKEN_TYPE(&token, TOKEN_ID); @@ -858,14 +826,14 @@ static struct toklist *value_to_toklist(value_t value) return NULL; } - return toklist_create(&token, 1); + return toklist_alloc(&token, 1); } static struct list_head *add_token_toklist(enum token_type type, struct list_head *tail) { struct token token = {0}; token.type = type; - return list_add(tail, &(toklist_create(&token, 1)->list)); + return list_add(tail, &(toklist_alloc(&token, 1)->list)); } static struct toklist *cons_to_toklist(value_t value) @@ -902,6 +870,6 @@ static struct toklist *cons_to_toklist(value_t value) return list_entry(list_get_head(tail), struct toklist, list); fail: err("Failed to turn value to toklist"); - toklist_destroy(list_entry(list_get_head(tail), struct toklist, list)); + toklist_dealloc(list_entry(list_get_head(tail), struct toklist, list)); return NULL; } diff --git a/src/value.c b/src/value.c index 94a7acd..547da96 100644 --- a/src/value.c +++ b/src/value.c @@ -1,21 +1,27 @@ +#include <stdio.h> #include <stdlib.h> #include <string.h> #include "common.h" #include "value.h" + #include "lexer.h" -#include "mempool.h" -MEMPOOL_GENERATE(value, struct value, 64) -#define NOT_IMPLEMENTED() die("Not Implemented. ABORTING") +// #ifdef ENABLE_MEMPOOL + #include "mempool.h" + MEMPOOL_GENERATE(value, struct value, 64) + #define value_alloc() value_mempool_allocate() + #define value_free(v) value_mempool_free(v) +// #else + // #define value_alloc() malloc(sizeof(struct value)) + // #define value_free(v) free(v) +// #endif const char * const value_type_string[] = { VALUE_TYPES(TO_STRING) }; -#define VALUE(_value) (_value)->value - #define FN(fn, ...) return fn(buf, buf_sz, __VA_ARGS__) #define VALUE_STRING_TABLE(X, v, buf, buf_sz) \ X(VALUE_NIL, FN(snprintf, "(nil)")) \ @@ -34,9 +40,9 @@ const char * const value_type_string[] = { X(VALUE_ATOM, if(NOREFS(v)) free(vvalue_atom(v))) \ X(VALUE_STR, if(NOREFS(v)) free(vvalue_str(v))) \ X(VALUE_INT, (void)NOREFS(v)) \ - X(VALUE_CONS, (void)NOREFS(v); \ + X(VALUE_CONS, if(NOREFS(v)) { \ value_destroy(vvalue_cons(v).left); \ - value_destroy(vvalue_cons(v).right)) \ + value_destroy(vvalue_cons(v).right);}) \ X(VALUE_PROC, if(NOREFS(v)) proc_destroy(&vvalue_proc(v))) \ X(VALUE_MACRO, if(NOREFS(v)) proc_destroy(&vvalue_proc(v))) \ X(VALUE_PROC_BUILTIN, (void)NOREFS(v)) @@ -63,12 +69,6 @@ const char * const value_type_string[] = { X(VALUE_MACRO, proc) \ X(VALUE_PROC_BUILTIN, proc_builtin) -// #define value_alloc() malloc(sizeof(struct value)) -// #define value_dealloc(v) free(v) -#define value_alloc() value_mempool_allocate() -#define value_free(v) value_mempool_free(v) - - static char *str_alloc_copy(char *src); static int cons_print(char *buf, size_t buf_sz, struct cons *cons); @@ -123,14 +123,8 @@ value_t value_from_token(struct token *token) value_t value_copy(value_t value) { if(!value) return value; - + value_inc_refs(value); - - if(vvalue_type(value) == VALUE_CONS) { - value_copy(vvalue_cons(value).left); - value_copy(vvalue_cons(value).right); - } - return value; } @@ -145,6 +139,24 @@ int value_string(value_t value, size_t buf_sz, char *buf) return 0; } +char *value_static_string(value_t value) +{ + static char str[1024] = {0}; + + if(value_string(value, sizeof(str), str) > 0) + return str; + return NULL; +} + +#ifdef DEBUG +void value_print(value_t value) +{ + printf("%-12s %s", value ? + value_type_string[vvalue_type(value)] : "", + value_static_string(value)); +} +#endif + static char *str_alloc_copy(char *src) { if(!src) return src; @@ -204,10 +216,10 @@ exit: static int proc_print(char *buf, size_t buf_sz, struct proc *proc) { - return 0; (void)buf; (void)buf_sz; (void)proc; NOT_IMPLEMENTED(); + return 0; } static void proc_destroy(struct proc *proc) @@ -215,6 +227,6 @@ static void proc_destroy(struct proc *proc) for(size_t i = 0; i < proc->argc; i++) value_destroy(proc->arg_keys[i]); free(proc->arg_keys); - toklist_destroy(proc->body); + toklist_dealloc(proc->body); env_destroy(proc->parent_env); } diff --git a/src/value.h b/src/value.h index f5f66d3..48d178c 100644 --- a/src/value.h +++ b/src/value.h @@ -77,6 +77,12 @@ void value_destroy(value_t value); value_t value_from_token(struct token *token); value_t value_copy(value_t value); + int value_string(value_t value, size_t buf_sz, char *buf); +char *value_static_string(value_t value); + +#ifdef DEBUG +void value_print(value_t value); +#endif #endif |