diff options
| -rw-r--r-- | Makefile | 2 | ||||
| -rw-r--r-- | files/test-lambda.l | 41 | ||||
| -rw-r--r-- | src/builtin.h | 78 | ||||
| -rw-r--r-- | src/common.h | 12 | ||||
| -rw-r--r-- | src/env.c | 12 | ||||
| -rw-r--r-- | src/hashtable.c | 32 | ||||
| -rw-r--r-- | src/lexer.c | 26 | ||||
| -rw-r--r-- | src/lexer.h | 5 | ||||
| -rw-r--r-- | src/main.c | 115 | ||||
| -rw-r--r-- | src/memdebug.h | 30 | ||||
| -rw-r--r-- | src/value.c | 144 | ||||
| -rw-r--r-- | src/value.h | 6 |
12 files changed, 296 insertions, 207 deletions
@@ -59,4 +59,4 @@ valgrind: $(NAME) valgrind -s --leak-check=full --show-leak-kinds=all $(BIN)/$(NAME) cppcheck: clean - cppcheck --enable=all $(SRCS) 2> cppcheck.log + cppcheck --enable=all $(SRCS) --check-level=exhaustive 2> cppcheck.log diff --git a/files/test-lambda.l b/files/test-lambda.l index e088ad6..71ef0bd 100644 --- a/files/test-lambda.l +++ b/files/test-lambda.l @@ -4,20 +4,47 @@ '(a b ,((lambda (a) '(test . ,a)) 69) c d) -(define fib (lambda (c) (fib-rec 0 1 0 c))) -(define fib-rec (lambda (a b n c) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define fib (lambda (c) (_fib 0 1 0 c))) +(define _fib (lambda (a b n c) (if (= n c) b - (fib-rec b (+ a b) (+ n 1) c)))) + (_fib b (+ a b) (+ n 1) c)))) + + -(define do (lambda (c f) (do-rec f 0 0 c))) -(define do-rec (lambda (f r n c) + +(define do (lambda (c f) (_do f '() 0 c))) + +(define _do (lambda (f r n c) (if (= n c) r - (do-rec f (f n) (+ n 1) c)))) + (_do f (cons (f n) r) (+ n 1) c)))) ;; comment ;; another comment ;; fib(13) -(do 10 (lambda (n) (display (fib n)))) ; comment +;(do 10 (lambda (n) (display (fib n)))) ; comment + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define +list (lambda (l) (_+list l 0))) +(define _+list (lambda (l acc) + (if (nil? l) + acc + (_+list (cdr l) (+ acc (car l)))))) +(+list '(10 12)) + +(define * (lambda (a n) (+list (do n (lambda (n) a))))) + +(* 9 7) + +(define reverse (lambda (l) (_reverse l '()))) +(define _reverse (lambda (l n) + (if (nil? l) n + (_reverse (cdr l) (cons (car l) n))))) + +;; (+list (do 100 (lambda (n) (fib n)))) +(reverse (do 100 (lambda (n) (fib n)))) diff --git a/src/builtin.h b/src/builtin.h index 43d7ee2..51dd89c 100644 --- a/src/builtin.h +++ b/src/builtin.h @@ -8,17 +8,16 @@ X(cons, "cons", 2) \ X(car, "car", 1) \ X(cdr, "cdr", 1) \ - X(display,"display", 1) \ + X(display,"display", 1) \ + X(is_nil, "nil?", 1) \ // Number of builtin procedures #define PLUS_ONE(_symbol, _name, _argc) 1 + #define BUILTIN_PROCEDURES PROCEDURES(PLUS_ONE) 0 // Forward decalration of the procedures -#define DECLARE_PROCEDURE(proc) value_t proc(value_t *args) #define FORWARD_DECLARATION(symbol, _name, _argc) \ - DECLARE_PROCEDURE(symbol); - + value_t symbol(value_t *args); PROCEDURES(FORWARD_DECLARATION) // Fill procedure struct for the value_t @@ -39,40 +38,34 @@ const char *builtin_proc_name_list[] = { // ----- Definitions ----- -#define ASSERT_TYPE(proc, args, pos, vtype, fail) \ - if(args[pos]->type != vtype) { \ - err("Expected arg %d of %s to be %s instead of %s", \ - pos, #proc, "", ""); \ - fail; \ +#define ASSERT_TYPE(proc, args, pos, vtype, fail) \ + if(args[pos]->type != vtype) { \ + err("Expected arg %d of '%s' to be %s instead of %s", \ + pos, #proc, \ + value_type_string[vtype], \ + value_type_string[args[pos]->type]); \ + fail; \ } -#define PROC_ASSERT_TYPE(pos, vtype, fail) \ - ASSERT_TYPE(P, args, pos, vtype, fail) - -#define P plus -DECLARE_PROCEDURE(P) +value_t plus(value_t *args) { - PROC_ASSERT_TYPE(0, VALUE_INT, return VALUE_EMPTY); - PROC_ASSERT_TYPE(1, VALUE_INT, return VALUE_EMPTY); + ASSERT_TYPE(plus, args, 0, VALUE_INT, return VALUE_EMPTY); + ASSERT_TYPE(plus, args, 1, VALUE_INT, return VALUE_EMPTY); int sum = args[0]->value.num + args[1]->value.num; return value_create(VALUE_INT, &sum); } -#undef P -#define P minus -DECLARE_PROCEDURE(P) +value_t minus(value_t *args) { - PROC_ASSERT_TYPE(0, VALUE_INT, return VALUE_EMPTY); - PROC_ASSERT_TYPE(1, VALUE_INT, return VALUE_EMPTY); + ASSERT_TYPE(minus, args, 0, VALUE_INT, return VALUE_EMPTY); + ASSERT_TYPE(minus, args, 1, VALUE_INT, return VALUE_EMPTY); int difference = args[0]->value.num - args[1]->value.num; return value_create(VALUE_INT, &difference); } -#undef P -#define P equal -DECLARE_PROCEDURE(P) +value_t equal(value_t *args) { int f = 0; int t = 1; @@ -90,48 +83,45 @@ l_false: l_true: return value_create(VALUE_INT, &t); } -#undef P -#define P cons -DECLARE_PROCEDURE(P) +value_t cons(value_t *args) { struct cons cons = {value_copy(args[0]), value_copy(args[1])}; return value_create(VALUE_CONS, &cons); } -#undef P -#define P car -DECLARE_PROCEDURE(P) +value_t car(value_t *args) { - PROC_ASSERT_TYPE(0, VALUE_CONS, return VALUE_EMPTY); + ASSERT_TYPE(car, args, 0, VALUE_CONS, return VALUE_EMPTY); value_t left = value_copy(args[0]->value.cons.left); return left; } -#undef P -#define P cdr -DECLARE_PROCEDURE(P) +value_t cdr(value_t *args) { - PROC_ASSERT_TYPE(0, VALUE_CONS, return VALUE_EMPTY); + ASSERT_TYPE(cdr, args, 0, VALUE_CONS, return VALUE_EMPTY); value_t right = value_copy(args[0]->value.cons.right); return right; } -#undef P -#define P display -DECLARE_PROCEDURE(P) +value_t display(value_t *args) { char buf[256]; - value_string(args[0], (sizeof(buf)/sizeof(*buf)), buf); + value_string(args[0], sizeof(buf), buf); + + // if(bytes > sizeof(buf)) ... - #ifdef DEBUG - info("%s", buf); - #else printf("%s\n", buf); - #endif return value_copy(args[0]); } -#undef P + +value_t is_nil(value_t *args) +{ + int f = 0, t = 1; + if(args[0]->type == VALUE_NIL) + return value_create(VALUE_INT, &t); + return value_create(VALUE_INT, &f); +} diff --git a/src/common.h b/src/common.h index b91459a..225f217 100644 --- a/src/common.h +++ b/src/common.h @@ -11,8 +11,15 @@ #define _YELLOW "\033[0;33m" #define _RST "\033[0m" -#define _log_print(...) fprintf(stdout, __VA_ARGS__) +#define _log_print(...) fprintf(stderr, __VA_ARGS__) + +#ifdef DEBUG #define _log(color, message) _log_print("[%s] %s%-7s"_RST" ", timenow(), color, message) +#define _log_file() _log_print(__FILE__":%d: ", __LINE__) +#else +#define _log(color, message) _log_print("%s%-7s"_RST" ", color, message) +#define _log_file() +#endif #define info(...) do { \ _log(_GREEN, "[INFO]"); \ @@ -20,7 +27,7 @@ } while(0) #define err(...) do { \ _log(_RED, "[ERROR]"); \ - _log_print(__FILE__":%d: ", __LINE__); \ + _log_file(); \ _log_print(__VA_ARGS__); _log_print("\n"); \ } while(0) #define die(...) do { \ @@ -95,4 +102,3 @@ DIE_ALLOC_BUILDER(realloc, (void *ptr, size_t size), (ptr, size)) // #endif #endif - @@ -8,7 +8,7 @@ #define ENV_TABLE_CAP (1 << 8) static unsigned long str_hash(char *str) -{ +{ unsigned long hash = 5381; int c; @@ -38,20 +38,20 @@ env_t env_create(env_t parent, env_destroy_func destroy_func) env->destroy_func = destroy_func; env->parent = parent; env->refs = 1; - + ERR_Z(env->table = hashtable_create(ENV_TABLE_CAP, hash, equal), env_destroy(env)); - + return env; } void env_destroy(env_t env) { if(!env) return; - + env->refs--; env_destroy(env->parent); - + if(env->refs > 0) return; hashtable_for_each_item(env->table, item, i) { @@ -65,7 +65,7 @@ void env_destroy(env_t env) env_t env_copy(env_t env) { if(env == ENV_EMPTY) return ENV_EMPTY; - + env->refs++; env_copy(env->parent); diff --git a/src/hashtable.c b/src/hashtable.c index 5ef1839..9f5d2e1 100644 --- a/src/hashtable.c +++ b/src/hashtable.c @@ -25,7 +25,7 @@ hashtable_t hashtable_create(size_t cap, hashtable_hash_func hash_func, hashtabl ht->size = 0; ERR_ERRNO_SET(hashtable_grow(ht, cap), goto fail); - + return ht; fail: hashtable_destroy(ht); @@ -35,15 +35,15 @@ fail: void hashtable_destroy(hashtable_t ht) { if(!ht) return; - + if(ht->table) { hashtable_for_each_item_safe(ht, item, i) { free(item); } - + free(ht->table); } - + free(ht); } @@ -66,7 +66,7 @@ int hashtable_insert(hashtable_t ht, void *key, void *data, void **prevkey, void struct hashtable_item *item, *prev; hashtable_find_item(ht, idx, key, &item, &prev); - + if(item) { if(prevkey) *prevkey = item->key; if(prevdata) *prevdata = item->data; @@ -74,49 +74,49 @@ int hashtable_insert(hashtable_t ht, void *key, void *data, void **prevkey, void item->data = data; return 0; } - + ERR_Z(item = malloc(sizeof(*item)), return -ENOMEM); - + item->key = key; item->data = data; item->next = NULL; hashtable_table_append_item(ht->table, idx, item); ht->size++; - + if(ht->size > (ht->cap * 3/4)) { return hashtable_grow(ht, 1 << ht->cap); } - + return 0; } int hashtable_query(hashtable_t ht, void *key, void **data) { size_t idx = HASH(ht, key); - + struct hashtable_item *item; ERR_NZ_RET(hashtable_find_item(ht, idx, key, &item, NULL)); *data = item->data; - + return 0; } int hashtable_delete(hashtable_t ht, void *key) { size_t idx = HASH(ht, key); - + struct hashtable_item *item, *prev; ERR_NZ_RET(hashtable_find_item(ht, idx, key, &item, &prev)); - + if(prev) prev->next = item->next; else ht->table[idx] = item->next; free(item); - + return 0; } @@ -137,7 +137,7 @@ static int hashtable_grow(hashtable_t ht, size_t cap) ht->table = new_table; ht->cap = cap; - + return 0; } @@ -153,7 +153,7 @@ static int hashtable_find_item(hashtable_t ht, size_t idx, void *key, struct has } if(prev) *prev = _item; } - + return -ENOENT; } diff --git a/src/lexer.c b/src/lexer.c index b546fda..93c7f44 100644 --- a/src/lexer.c +++ b/src/lexer.c @@ -7,7 +7,7 @@ #define CH(lexer) (lexer)->str[(lexer)->str_idx] #define TOKEN_SEPARATOR_TABLE(X, l) \ - X((';' == CH(l)), CH(l) = '\0') \ + X((';' == CH(l)), lexer_clear_line(l)) \ X(('(' == CH(l)), on_separator(l, TOKEN_LP)) \ X((')' == CH(l)), on_separator(l, TOKEN_RP)) \ X(('\''== CH(l)), on_separator(l, TOKEN_QUOTE)) \ @@ -78,7 +78,7 @@ lexer_t lexer_create(FILE *fp) lexer->acc_idx = 0; memset(lexer->acc, 0, sizeof(lexer->acc)); memset(lexer->str, 0, sizeof(lexer->str)); - + lexer->token.type = TOKEN_NONE; return lexer; @@ -90,12 +90,18 @@ void lexer_destroy(lexer_t lexer) free(lexer); } +int lexer_clear_line(lexer_t lexer) +{ + lexer->str[lexer->str_idx] = '\0'; + return 0; +} + int lexer_token_next(lexer_t lexer, struct token *token) { if(lexer->acc_idx == 0 && lexer->acc[0] != '\0') { memset(lexer->acc, 0, sizeof(lexer->acc)); } - + while(lexer->token.type == TOKEN_NONE) { if(lexer->str[lexer->str_idx] == '\0') { @@ -103,10 +109,10 @@ int lexer_token_next(lexer_t lexer, struct token *token) lexer->str_idx = 0; lexer->line++; } - + TOKEN_SEPARATOR_TABLE(CALLBACK, lexer) TABLE_END; } - + *token = lexer->token; lexer->token.type = TOKEN_NONE; return 0; @@ -116,7 +122,7 @@ int token_value_string(struct token *token, size_t buf_sz, char *buf) { #define AS_STRING(ttype, ...) \ case ttype: return snprintf(buf, buf_sz, __VA_ARGS__); - + switch(token->type) { TOKEN_VALUE_STRING_TABLE(AS_STRING, token->value); } @@ -175,7 +181,7 @@ static int acc_add_char(lexer_t lexer, char ch) if(lexer->acc_idx >= LEN(lexer->acc) - 1) { return -ENAMETOOLONG; } - + lexer->acc[lexer->acc_idx++] = ch; lexer->str_idx++; @@ -183,10 +189,10 @@ static int acc_add_char(lexer_t lexer, char ch) } static int acc_empty(lexer_t lexer) -{ +{ TOKEN_VALUE_TABLE(CALLBACK_BLIND, lexer) TABLE_END; lexer->acc_idx = 0; - + return 0; } @@ -210,6 +216,6 @@ static int is_special(char *str, enum token_type *type) } else TOKEN_SPECIALS_TABLE(IS_SPECIAL) TABLE_END; - + return 0; } diff --git a/src/lexer.h b/src/lexer.h index b47f800..e40ab05 100644 --- a/src/lexer.h +++ b/src/lexer.h @@ -27,7 +27,7 @@ struct token { enum token_type { TOKEN_TYPES(TO_ENUM) } type; - + union { char *id; char *str; @@ -41,7 +41,7 @@ typedef struct lexer * lexer_t; struct lexer { FILE *fp; size_t line; - + char str[256]; size_t str_idx; @@ -52,6 +52,7 @@ struct lexer { lexer_t lexer_create(FILE *fp); void lexer_destroy(lexer_t lexer); +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); @@ -1,6 +1,7 @@ #include <stdio.h> #include <stdlib.h> #include <string.h> +#include <getopt.h> #include "lexer.h" #include "value.h" @@ -9,7 +10,6 @@ #ifdef ENABLE_MEMDEBUG #define MEMDEBUG_OUT_OF_BOUNDS #define MEMDEBUG_IMPLEMENTATION -#define MEMDEBUG_MAIN_VOID #define MEMDEBUG_OUTPUT_DIR "files" #endif @@ -22,7 +22,7 @@ // - Think about memory leakage and on non fatal errors // like failed list creation and faild s-exp parsing // - Check for functions not wrapped in ERR_* macro -// - Add more error messages +// - Add more and better error messages #define TOKEN(tctx) (tctx)->token @@ -120,10 +120,6 @@ static struct token *next_token(struct tctx *tctx) break; } - #ifdef DEBUG - // print_token(tctx->token); - #endif - return tctx->token; fail: tctx->token = NULL; @@ -147,6 +143,7 @@ value_t quote_sexp(env_t env, struct tctx *tctx); size_t toklist_expr(struct tctx *tctx, struct token **toklist); static env_t global_env = ENV_EMPTY; +static value_t global_nil = VALUE_EMPTY; static void destroy_env(char *key, value_t value) { @@ -160,22 +157,40 @@ static void destroy_global_env(char *key, value_t value) value_destroy(value); } -int main(void) +int main(int argc, char **argv) { + int opt, repl_flag = 0; +#ifdef DEBUG char *filename = "files/test-lambda.l"; +#else + char *filename = NULL; +#endif - FILE *fp = fopen(filename, "r"); - if(!fp) { - die("fopen: %s", strerror(errno)); + while((opt = getopt(argc, argv, "rhf:")) != -1) { + switch(opt) { + case 'h': + printf("help????"); + return 0; + case 'r': repl_flag = 1; break; + case 'f': filename = optarg; break; + default: + err("No such option %c", opt); + return 1; + } } - lexer_t lexer = lexer_create(fp); + if(optind < argc) { + filename = argv[optind]; + } + + if(!filename) repl_flag = 1; + env_t builtin_env = env_create(ENV_EMPTY, destroy_env); global_env = env_create(builtin_env, destroy_global_env); + global_nil = value_create(VALUE_NIL, NULL); - // add builtins for(size_t i = 0; i < BUILTIN_PROCEDURES; i++) { value_t proc_value = value_create( VALUE_PROC_BUILTIN, @@ -185,28 +200,51 @@ int main(void) (void *)proc_value, NULL, NULL); } + FILE *fp = stdin; + if(!repl_flag) { + fp = fopen(filename, "r"); + if(!fp) { + die("fopen: %s", strerror(errno)); + } + } + + lexer_t lexer = lexer_create(fp); + struct tctx tctx = {0}; tctx_init_lexer(&tctx, lexer); + if(repl_flag) printf("> "); while(next_token(&tctx)) { value_t val = evaluate_expr(ENV_EMPTY, &tctx); - #ifdef DEBUG - info("Line %zu evaluates to:", lexer->line); - print_value(val); - #else - char buf[256] = {0}; - value_string(val, LEN(buf), buf); - printf("%s:%zu: %s\n", filename, lexer->line, buf); - #endif + if(val == VALUE_EMPTY) { + if(!repl_flag) { + printf("%s:%zu: FAILED\n", filename, lexer->line); + break; + } else { + printf("=> FAILED\n"); + lexer_clear_line(lexer); + } + } else { + char buf[256] = {0}; + value_string(val, sizeof(buf), buf); + + if(!repl_flag) { + printf("%s:%zu: %s\n", filename, lexer->line, buf); + } else { + printf("=> %s\n", buf); + } + } + if(repl_flag) printf("> "); value_destroy(val); } lexer_destroy(lexer); fclose(fp); + value_destroy(global_nil); env_destroy(global_env); return 0; } @@ -243,8 +281,7 @@ exit: value_t apply(value_t proc, size_t argc, value_t *argv) { - // TODO: make a global nil and copy it - if(proc == VALUE_EMPTY) return value_create(VALUE_NIL, NULL); + if(proc == VALUE_EMPTY) return value_copy(global_nil); switch(proc->type) { case VALUE_PROC: @@ -338,23 +375,8 @@ value_t evaluate_sexp(env_t env, struct tctx *tctx) TOKEN_NEXT(tctx); } -#ifdef DEBUG - // info("------------------"); - // info("Applying procedure"); - // print_value(body[0]); - // info("With Arguemnts"); - // if(argc > 0) - // for(size_t i = 0; i < argc-1; i++) print_value(body[i+1]); -#endif - ret = apply(body[0], argc-1, &body[1]); -#ifdef DEBUG - // info("Returns"); - // print_value(ret); - // info("-----------------"); -#endif - exit: for(size_t i = 0; i < argc; i++) value_destroy(body[i]); @@ -488,7 +510,7 @@ value_t evaluate_define(env_t env, struct tctx *tctx) if(prevkey) free(prevkey); value_destroy(prevval); - return VALUE_EMPTY; + return value_copy(global_nil); fail: if(key) free(key); @@ -504,6 +526,13 @@ value_t evaluate_if(env_t env, struct tctx *tctx) ERR_Z(cond = evaluate_expr(env, tctx), goto exit); + // if(cond->type == VALUE_NIL) { + // toklist_expr(tctx, NULL); // skip one expression + // TOKEN_NEXT(tctx); + // TOKEN_MATCH(tctx, TOKEN_RP, goto exit); + // goto exit; + // } + ERR_Z(cond->type == VALUE_INT, err("expected condition to evaluate to VALUE_INT"); goto exit); @@ -567,16 +596,11 @@ value_t quote_sexp(env_t env, struct tctx *tctx) value_t ret = VALUE_EMPTY; value_t left = VALUE_EMPTY; value_t right = VALUE_EMPTY; - value_t nil = VALUE_EMPTY; - - // TODO: make global nil and copy it - ERR_Z(nil = value_create(VALUE_NIL, NULL), goto exit); TOKEN_SKIP(tctx, TOKEN_LP, goto exit); - // Parse NIL if(TOKEN(tctx)->type == TOKEN_RP) { - ret = value_copy(nil); + ret = value_copy(global_nil); goto exit; } @@ -596,7 +620,7 @@ value_t quote_sexp(env_t env, struct tctx *tctx) } // Parse list - right = value_copy(nil); + right = value_copy(global_nil); value_t *rightmost = &right; // the final nil while(TOKEN(tctx)->type != TOKEN_RP) { @@ -636,7 +660,6 @@ value_t quote_sexp(env_t env, struct tctx *tctx) exit: value_destroy(left); value_destroy(right); - value_destroy(nil); return ret; } diff --git a/src/memdebug.h b/src/memdebug.h index d219397..358203a 100644 --- a/src/memdebug.h +++ b/src/memdebug.h @@ -15,7 +15,7 @@ * - MEMDEBUG_OUTPUT_DIR - set the directory for the log, * by default it is the current directory (automatically * enables the MEMDEBUG_OUTPUT_LOG - */ + */ void *__memdebug_malloc(size_t size, char *file, int line); void *__memdebug_calloc(size_t nmemb, size_t size, char *file, int line); @@ -48,7 +48,7 @@ void __memdebug_free(void *ptr, char *file, int line); #define MEMDEBUG_OUTPUT_DIR "." #endif -#ifdef MEMDEBUG_OUTPUT_LOG +#ifdef MEMDEBUG_OUTPUT_LOG #define MEMDEBUG_OUTPUT_FMT "memdebug-%lu.log" #endif @@ -103,7 +103,7 @@ void *__memdebug_malloc(size_t size, char *file, int line) #endif MEMDEBUG_LOG_FUNC(malloc, addr, file, line); - + MEMDEBUG_LOG("size: %zu, ret: %p", size, addr); MEMDEBUG_LOG("\n"); @@ -120,9 +120,9 @@ void *__memdebug_realloc(void *ptr, size_t size, char *file, int line) ptr, size + MEMDEBUG_OUT_OF_BOUNDS_EXTRA_SIZE); MEMDEBUG_OUT_OF_BOUNDS_CHECK(addr, size); #endif - + MEMDEBUG_LOG_FUNC(realloc, addr, file, line); - + MEMDEBUG_LOG("ptr: %p, size: %zu, ret: %p", ptr, size, addr); MEMDEBUG_LOG("\n"); @@ -140,9 +140,9 @@ void *__memdebug_calloc(size_t nmemb, size_t size, char *file, int line) MEMDEBUG_OUT_OF_BOUNDS_CHECK(addr, nmemb * size); memset(addr, 0, nmemb * size); #endif - + MEMDEBUG_LOG_FUNC(calloc, addr, file, line); - + MEMDEBUG_LOG("nmemb: %zu, size: %zu, ret: %p", nmemb, size, addr); MEMDEBUG_LOG("\n"); @@ -151,9 +151,9 @@ void *__memdebug_calloc(size_t nmemb, size_t size, char *file, int line) } void __memdebug_free(void *ptr, char *file, int line) -{ +{ MEMDEBUG_LOG_FUNC(free, (void *)1, file, line); - + MEMDEBUG_LOG("ptr: %p", ptr); #ifdef MEMDEBUG_OUT_OF_BOUNDS @@ -164,11 +164,11 @@ void __memdebug_free(void *ptr, char *file, int line) MEMDEBUG_LOG(", "); MEMDEBUG_LOG("out-of-bounds-check: "); - + if(suffix == (memdebug_suffix)MEMDEBUG_MAGIC_SUFFIX) MEMDEBUG_LOG("SUCCESS"); else MEMDEBUG_LOG("FAILED"); - + ptr -= sizeof(size_t); } #endif @@ -193,15 +193,15 @@ int main(int argc, char **argv) (void)argc; (void)argv; #endif - + #ifdef MEMDEBUG_OUTPUT_LOG size_t filename_sz = 64 + sizeof(MEMDEBUG_OUTPUT_DIR) + sizeof(MEMDEBUG_OUTPUT_FMT); char *filename = malloc(filename_sz); if(!filename) return -ENOMEM; - + memset(filename, 0, filename_sz); snprintf(filename, filename_sz, MEMDEBUG_OUTPUT_DIR"/"MEMDEBUG_OUTPUT_FMT, time(NULL)); - + _memdebug_fp = fopen(filename, "w"); if(!_memdebug_fp) { perror(filename); @@ -210,7 +210,7 @@ int main(int argc, char **argv) } int ret = CALL_MAIN; - + fclose(_memdebug_fp); free(filename); return ret; diff --git a/src/value.c b/src/value.c index d7df858..54c0d20 100644 --- a/src/value.c +++ b/src/value.c @@ -5,14 +5,6 @@ #include "value.h" #include "lexer.h" -// TODO: -// - create VALUE_MANAGE_TABLE which manages -// both creation and destruction -// - check the buffer size in cons creation - -// FIX: -// - remove warning for void pointer cast at line 30 - #define NOT_IMPLEMENTED() die("Not Implemented. ABORTING") const char * const value_type_string[] = { @@ -21,7 +13,7 @@ const char * const value_type_string[] = { #define VALUE(_value) (_value)->value -#define FN(fn, ...) fn(buf, buf_sz, __VA_ARGS__) +#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)")) \ X(VALUE_ATOM, FN(snprintf, "%s", VALUE(v).atom)) \ @@ -44,23 +36,51 @@ const char * const value_type_string[] = { X(VALUE_PROC, if(NOREFS(v)) proc_destroy(&VALUE(v).proc)) \ X(VALUE_PROC_BUILTIN, (void)NOREFS(v)) -#define CASE_RETURN_APPLY(vtype, apply) \ - case vtype: return apply; -#define CASE_APPLY_BREAK(vtype, apply) \ - case vtype: apply; break; +#define CREATE(vtype, value) return value_create(vtype, value) +#define VALUE_FROM_TOKEN_TABLE(X, t) \ + X(TOKEN_INT, CREATE(VALUE_INT, &t->value.num)) \ + X(TOKEN_STR, \ + char *str = str_alloc_copy(t->value.str); \ + CREATE(VALUE_STR, &str)) \ + X(TOKEN_ID, \ + char *atom = str_alloc_copy(t->value.id); \ + CREATE(VALUE_ATOM, &atom)) + +#define CASE_APPLY(vtype, apply) \ + case vtype: ; apply; break; + +#define VALUE_MEMBER_TABLE(X) \ + X(VALUE_ATOM, atom) \ + X(VALUE_STR, str) \ + X(VALUE_INT, num) \ + X(VALUE_CONS, cons) \ + X(VALUE_PROC, proc) \ + X(VALUE_PROC_BUILTIN, proc_builtin) + + +static char *str_alloc_copy(char *src); static int cons_print(char *buf, size_t buf_sz, struct cons *cons); static int proc_print(char *buf, size_t buf_sz, struct proc *proc); -// static value_t proc_create(...); static void proc_destroy(struct proc *proc); + +#define MEMBER_COPY(vtype, member) \ + case vtype: memcpy(&_value->value.member, value, \ + sizeof(_value->value.member)); \ + break; + value_t value_create(enum value_type type, void *value) { value_t _value = malloc(sizeof(*_value)); _value->type = type; - if(value != NULL) - _value->value = *(union value_union *)value; + + switch(type) { + VALUE_MEMBER_TABLE(MEMBER_COPY); + default: break; + } + _value->refs = 1; return _value; @@ -69,35 +89,20 @@ value_t value_create(enum value_type type, void *value) void value_destroy(value_t value) { if(!value) return; - + switch(value->type) { - VALUE_DESTROY_TABLE(CASE_APPLY_BREAK, value); + VALUE_DESTROY_TABLE(CASE_APPLY, value); } if(value->refs == 0) free(value); } -#define STR_ALLOC_COPY(dest, str) do { \ - size_t len = strlen(str) + 1; \ - dest = malloc(len); \ - memcpy((dest), (str), len); \ - } while(0) - value_t value_from_token(struct token *token) -{ +{ switch(token->type) { - case TOKEN_ID: ; - char *atom = NULL; - STR_ALLOC_COPY(atom, token->value.id); - return value_create(VALUE_ATOM, &atom); - case TOKEN_STR: ; - char *str = NULL; - STR_ALLOC_COPY(str, token->value.str); - return value_create(VALUE_STR, &str); - case TOKEN_INT: - return value_create(VALUE_INT, &token->value); + VALUE_FROM_TOKEN_TABLE(CASE_APPLY, token) default: err("Cannot turn token '%s' to a value", token_type_string[token->type]); @@ -108,59 +113,90 @@ value_t value_from_token(struct token *token) value_t value_copy(value_t value) { if(!value) return value; - + value->refs++; - + if(value->type == VALUE_CONS) { value_copy(value->value.cons.left); value_copy(value->value.cons.right); } - + return value; } int value_string(value_t value, size_t buf_sz, char *buf) { if(!value) return snprintf(buf, buf_sz, "(empty)"); - + switch(value->type) { - VALUE_STRING_TABLE(CASE_RETURN_APPLY, value, buf, buf_sz) + VALUE_STRING_TABLE(CASE_APPLY, value, buf, buf_sz) } return 0; } +static char *str_alloc_copy(char *src) +{ + if(!src) return src; + + size_t len = strlen(src) + 1; + return memcpy(malloc(len), src, len); +} + static int cons_print(char *buf, size_t buf_sz, struct cons *cons) { - // TODO: check for size and off by one errors - int offset = 0; - buf[offset++] = '('; - offset += value_string(cons->left, buf_sz-offset, buf+offset); +#define HAS_SPACE if(offset < buf_sz) +#define SET_CHAR(ch) HAS_SPACE { buf[offset++] = ch; } +#define SET_VALUE_STRING(v) \ + HAS_SPACE { \ + offset += value_string(v, buf_sz-offset, buf+offset); \ + } /*else { \ + offset += value_string(v, 0, NULL); \ + } */ + + size_t offset = 0; + + SET_CHAR('('); + SET_VALUE_STRING(cons->left); value_t right = cons->right; while(right->type == VALUE_CONS) { - buf[offset++] = ' '; - offset += value_string(right->value.cons.left, - buf_sz-offset, buf+offset); + SET_CHAR(' '); + SET_VALUE_STRING(right->value.cons.left) right = right->value.cons.right; } if(right->type != VALUE_NIL) { - buf[offset++] = ' '; - buf[offset++] = '.'; - buf[offset++] = ' '; - offset += value_string(right, buf_sz-offset, buf+offset); + SET_CHAR(' '); + SET_CHAR('.'); + SET_CHAR(' '); + SET_VALUE_STRING(right); + } + + SET_CHAR(')'); + + SET_CHAR('\0') else { + if(buf_sz == 0) goto exit; + + char str[] = "...)"; + + if(buf_sz <= sizeof(str)) { + buf[0] = '\0'; + goto exit; + } + + memcpy(buf+buf_sz - sizeof(str), str, sizeof(str)); } - buf[offset++] = ')'; - return offset; +exit: + return (int)offset; } static int proc_print(char *buf, size_t buf_sz, struct proc *proc) { return 0; (void)buf; (void)buf_sz; - (void)proc; + (void)proc; NOT_IMPLEMENTED(); } diff --git a/src/value.h b/src/value.h index ed30b99..61b8252 100644 --- a/src/value.h +++ b/src/value.h @@ -16,13 +16,13 @@ typedef value_t (*builtin_proc_t)(value_t *args); X(VALUE_INT) \ X(VALUE_CONS) \ X(VALUE_PROC) \ - X(VALUE_PROC_BUILTIN) + X(VALUE_PROC_BUILTIN) #define TO_ENUM(type) type, #define TO_STRING(type) #type, extern const char * const value_type_string[]; - + struct value { enum value_type { VALUE_TYPES(TO_ENUM) @@ -40,7 +40,7 @@ struct value { struct proc { env_t parent_env; - + value_t *arg_keys; size_t argc; |