diff options
| -rw-r--r-- | .gitignore | 2 | ||||
| -rw-r--r-- | Makefile | 4 | ||||
| -rw-r--r-- | README.md | 2 | ||||
| -rw-r--r-- | files/test.l | 2 | ||||
| -rw-r--r-- | src/env.c | 16 | ||||
| -rw-r--r-- | src/env.h | 8 | ||||
| -rw-r--r-- | src/lexer.c | 37 | ||||
| -rw-r--r-- | src/lexer.h | 3 | ||||
| -rw-r--r-- | src/main.c | 195 | ||||
| -rw-r--r-- | src/value.c | 32 | ||||
| -rw-r--r-- | src/value.h | 7 |
11 files changed, 224 insertions, 84 deletions
@@ -1,3 +1,3 @@ bin/ obj/ -file/*.log
\ No newline at end of file +**.log
\ No newline at end of file @@ -4,7 +4,7 @@ ifdef PROD CFLAGS := -std=c99 -Wpedantic -O3 -s # production flags else CFLAGS := -std=c99 -Wall -Wextra -Wpedantic -Wshadow -Wpointer-arith \ - -Wstrict-prototypes -Wmissing-prototypes -Wcast-qual -g -DDEBUG + -Wstrict-prototypes -Wmissing-prototypes -Wcast-qual -g3 -DDEBUG ifdef MEMDEBUG CFLAGS += -DENABLE_MEMDEBUG @@ -27,7 +27,7 @@ OBJS = $(SRCS:$(SRC)/%.c=$(OBJ)/%-$(FLAGHASH).o) DEPS = $(OBJS:%.o=%.d) -include $(DEPS) -.PHONY: all clean $(NAME) analyze valgrind +.PHONY: all clean $(NAME) analyze valgrind cppcheck .DEFAULT_GOAL := all all: $(NAME) @@ -2,7 +2,7 @@ A simple lisp/scheme interpreter -### TODO +#### TODO * lambda * macros diff --git a/files/test.l b/files/test.l index 49b4cad..65707ed 100644 --- a/files/test.l +++ b/files/test.l @@ -1,3 +1,5 @@ +(lambda (a b) (blah kajflkj foo bar)) + (define a 69) '(sn ,(+ a 1)) (define a 70) @@ -3,7 +3,7 @@ #include "common.h" #include "env.h" -#include "hashtable.h" +#include "value.h" #define ENV_TABLE_CAP (1 << 8) @@ -32,17 +32,13 @@ static bool equal(void *key1, void *key2) return false; } -static void env_add_ref(env_t env); - env_t env_create(env_t parent, env_destroy_func destroy_func) { env_t env = malloc(sizeof(*env)); env->destroy_func = destroy_func; env->parent = parent; - env->refs = 0; + env->refs = 1; - env_add_ref(env); - ERR_Z(env->table = hashtable_create(ENV_TABLE_CAP, hash, equal), env_destroy(env)); @@ -58,7 +54,6 @@ void env_destroy(env_t env) if(env->refs > 0) return; - hashtable_for_each_item(env->table, item, i) { env->destroy_func((char *)item->key, (value_t)item->data); } @@ -67,12 +62,13 @@ void env_destroy(env_t env) free(env); } - -static void env_add_ref(env_t env) +env_t env_copy(env_t env) { env->refs++; if(env->parent) { - env_add_ref(env->parent); + env_copy(env->parent); } + + return env; } @@ -2,14 +2,14 @@ #define ENV_H // #include "value.h" -typedef struct value * value_t; +typedef struct value * _value_t; #include "hashtable.h" typedef struct symbol_table *env_t; #define ENV_EMPTY NULL -typedef void (*env_destroy_func)(char *key, value_t value); +typedef void (*env_destroy_func)(char *key, _value_t value); struct symbol_table { hashtable_t table; @@ -21,10 +21,8 @@ struct symbol_table { }; env_t env_create(env_t parent, env_destroy_func destroy_func); +env_t env_copy(env_t env); void env_destroy(env_t env); -int env_insert(env_t env, value_t key, value_t data); -int env_query (env_t env, value_t key, value_t *data); -int env_delete(env_t env, value_t key); #endif diff --git a/src/lexer.c b/src/lexer.c index 407be25..b8897da 100644 --- a/src/lexer.c +++ b/src/lexer.c @@ -120,6 +120,43 @@ 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) + +void token_clone(struct token *dest, struct token *src) +{ + dest->type = src->type; + + switch(src->type) { + case TOKEN_ID: + STR_ALLOC_COPY(dest->value.id, src->value.id); + return; + case TOKEN_STR: + STR_ALLOC_COPY(dest->value.str, src->value.str); + return; + case TOKEN_INT: + dest->value.num = src->value.num; + return; + default: return; + } +} + +void token_dealloc(struct token *token) +{ + switch(token->type) { + case TOKEN_ID: + free(token->value.id); + return; + case TOKEN_STR: + free(token->value.str); + return; + default: return; + } +} + static int on_separator(lexer_t lexer, enum token_type type) { if(lexer->acc_idx > 0) return acc_empty(lexer); diff --git a/src/lexer.h b/src/lexer.h index 7c67028..c2e4637 100644 --- a/src/lexer.h +++ b/src/lexer.h @@ -55,4 +55,7 @@ int lexer_token_next(lexer_t lexer, struct token *token); int token_value_string(struct token *token, size_t buf_sz, char *buf); +void token_clone(struct token *dest, struct token *src); +void token_dealloc(struct token *token); + #endif @@ -33,28 +33,27 @@ ERR_NZ(lexer_token_next(lexer, &token), r, \ die("Can't get next token")); \ print_token(&token); \ - } while(0); + } while(0) #endif -#define TOKEN_SKIP(ttype, fail) do { \ - if(token.type == ttype) { \ - TOKEN_NEXT(); \ - break; \ - } \ +#define TOKEN_ASSERT(ttype, fail) \ + if(token.type != ttype) { \ err("Expected token '%s', not '%s'", \ token_type_string[ttype], \ token_type_string[token.type]); \ fail; \ + } + +#define TOKEN_SKIP(ttype, fail) do { \ + TOKEN_ASSERT(ttype, fail) \ + else { \ + TOKEN_NEXT(); \ + } \ } while(0) -#define TOKEN_MATCH(ttype, fail) do { \ - TOKEN_NEXT(); \ - if(token.type == ttype) break; \ - \ - err("Expected token '%s', not '%s'", \ - token_type_string[ttype], \ - token_type_string[token.type]); \ - fail; \ +#define TOKEN_MATCH(ttype, fail) do { \ + TOKEN_NEXT(); \ + TOKEN_ASSERT(ttype, fail); \ } while(0) #define HAS_ENOUGH_ARGS(proc, type, argc, fail) \ @@ -88,14 +87,18 @@ env_t env = ENV_EMPTY; struct token token; value_t apply(value_t proc, size_t argc, value_t *argv); -value_t evaluate(void); + +value_t evaluate_expr(void); value_t evaluate_sexp(void); value_t evaluate_id(void); value_t evaluate_lambda(void); value_t evaluate_define(void); -value_t evaluate_quote(void); + +value_t quote_expr(void); value_t quote_sexp(void); +size_t toklist_expr(struct token **toklist); + static void destroy_env(char *key, value_t value) { (void)key; @@ -121,6 +124,7 @@ int main(void) (void *)builtin_proc_name_list[i], (void *)proc_value, NULL, NULL); } + char *filename = "files/test.l"; FILE *fp = fopen(filename, "r"); @@ -131,10 +135,10 @@ int main(void) lexer = lexer_create(fp); while(lexer_token_next(lexer, &token) == 0) { - value_t val = evaluate(); + value_t val = evaluate_expr(); - #ifdef FDEBUG - print_value(); + #ifdef DEBUG + print_value(val); #else char buf[256] = {0}; value_string(val, LEN(buf), buf); @@ -148,7 +152,7 @@ int main(void) fclose(fp); env_destroy(env); - env_destroy(user_env); + // env_destroy(user_env); return 0; } @@ -160,6 +164,11 @@ value_t apply(value_t proc, size_t argc, value_t *argv) switch(proc->type) { case VALUE_PROC: HAS_ENOUGH_ARGS(proc, proc, argc, return VALUE_EMPTY); + // create new env + // evaluate body + // destroy new env + // switch back to the previous env + NOT_IMPLEMENTED(); return VALUE_EMPTY; case VALUE_PROC_BUILTIN: @@ -179,12 +188,9 @@ value_t apply(value_t proc, size_t argc, value_t *argv) #define SPECIAL_FORM(ret, argc, fn, fail) do { \ IS_NOT_FIRST(argc, fail); \ ERR_Z(ret = fn, fail); \ - TOKEN_MATCH(TOKEN_RP, \ - ret = VALUE_EMPTY; \ - fail); \ } while(0) -value_t evaluate(void) +value_t evaluate_expr(void) { value_t ret = VALUE_EMPTY; @@ -201,7 +207,7 @@ value_t evaluate(void) break; case TOKEN_QUOTE: TOKEN_NEXT(); - ERR_Z(ret = evaluate_quote(), goto exit); + ERR_Z(ret = quote_expr(), goto exit); break; default: err("Did not exptect token '%s'", token_type_string[token.type]); @@ -236,10 +242,14 @@ value_t evaluate_sexp(void) goto exit; case TOKEN_QUOTE_FORM: TOKEN_NEXT(); - SPECIAL_FORM(ret, argc, evaluate_quote(), goto exit); + SPECIAL_FORM(ret, argc, quote_expr(), goto exit); + TOKEN_MATCH(TOKEN_RP, + value_destroy(ret); + ret = VALUE_EMPTY; + goto exit); goto exit; default: - ERR_Z(body[argc] = evaluate(), goto exit); + ERR_Z(body[argc] = evaluate_expr(), goto exit); break; } @@ -283,7 +293,56 @@ value_t evaluate_id(void) value_t evaluate_lambda(void) { - NOT_IMPLEMENTED(); + value_t ret = VALUE_EMPTY; + + value_t args[32] = {VALUE_EMPTY}; + size_t argc = 0; + value_t *arg_keys = NULL; + + struct token *body = NULL; + size_t body_len = 0; + + TOKEN_SKIP(TOKEN_LAMBDA, goto fail); + TOKEN_SKIP(TOKEN_LP, goto fail); + + while(token.type != TOKEN_RP) + { + if(argc >= LEN(args)) { + err("Too many arguments"); + goto fail; + } + + if(token.type != TOKEN_ID) { + err("Token '%s' not expected in lambda args", token_type_string[token.type]); + goto fail; + } + + ERR_Z(args[argc++] = value_from_token(&token), goto fail); + + TOKEN_NEXT(); + } + + ERR_Z(body_len = toklist_expr(&body), goto fail); + + TOKEN_MATCH(TOKEN_RP, goto fail); + + arg_keys = calloc(argc, sizeof(*arg_keys)); + memcpy(arg_keys, args, argc * sizeof(*arg_keys)); + + struct proc proc = {env_copy(env), arg_keys, argc, body, body_len}; + ERR_Z(ret = value_create(VALUE_PROC, &proc), goto fail); + + return ret; + +fail: + err("Procedure creation failed"); + for(size_t i = 0; i < argc; i++) value_destroy(args[i]); + if(body) { + for(size_t i = 0; i < body_len; i++) token_dealloc(&body[i]); + free(body); + } + if(arg_keys) free(arg_keys); + return VALUE_EMPTY; } #define STR_ALLOC_COPY(dest, str) do { \ @@ -295,14 +354,15 @@ value_t evaluate_lambda(void) value_t evaluate_define(void) { // TODO: don't alloc when the key is the same - - value_t ret = VALUE_EMPTY; - char *key = NULL; - - TOKEN_SKIP(TOKEN_DEFINE, goto exit); + char *key = NULL; // only in the outside environement - if(env->parent != user_env) goto exit; + if(env->parent != user_env) { + err("define can only be called in the outermost environement"); + goto fail; + } + + TOKEN_SKIP(TOKEN_DEFINE, goto fail); switch(token.type) { @@ -311,34 +371,40 @@ value_t evaluate_define(void) break; default: err("Did not exptect token '%s'", token_type_string[token.type]); - goto exit; + goto fail; } TOKEN_NEXT(); - ERR_Z(ret = evaluate(), goto exit); - TOKEN_MATCH(TOKEN_RP, goto exit); + value_t val = VALUE_EMPTY; + ERR_Z(val = evaluate_expr(), goto fail); + + TOKEN_MATCH(TOKEN_RP, + value_destroy(val); + goto fail); value_t prevval = VALUE_EMPTY; char *prevkey = NULL; - + ERR_NZ( - hashtable_insert(user_env->table, (void *)key, (void *)ret, + hashtable_insert(user_env->table, (void *)key, (void *)val, (void**)&prevkey, (void **)&prevval), r, { err("Couldn't insert symbol into the hashtable due to %s", strerror(r)); - value_destroy(ret); - free(key); - return VALUE_EMPTY; + value_destroy(val); // the copy + goto fail; }); if(prevkey) free(prevkey); value_destroy(prevval); -exit: + return VALUE_EMPTY; + +fail: + if(key) free(key); return VALUE_EMPTY; } -value_t evaluate_quote(void) +value_t quote_expr(void) { value_t ret = VALUE_EMPTY; @@ -362,7 +428,7 @@ value_t evaluate_quote(void) break; case TOKEN_UNQUOTE: TOKEN_SKIP(TOKEN_UNQUOTE, goto exit); - ERR_Z(ret = evaluate(), goto exit); + ERR_Z(ret = evaluate_expr(), goto exit); break; default: err("Did not exptect token '%s'", token_type_string[token.type]); @@ -377,7 +443,7 @@ value_t quote_sexp(void) value_t ret = VALUE_EMPTY; value_t left = VALUE_EMPTY; value_t right = VALUE_EMPTY; - value_t nil = VALUE_EMPTY; + value_t nil = VALUE_EMPTY; // TODO: make global nil and copy it ERR_Z(nil = value_create(VALUE_NIL, NULL), goto exit); @@ -390,14 +456,14 @@ value_t quote_sexp(void) goto exit; } - ERR_Z(left = evaluate_quote(), goto exit); + ERR_Z(left = quote_expr(), goto exit); TOKEN_NEXT(); if(token.type == TOKEN_DOT) { // Parse cons TOKEN_NEXT(); - ERR_Z(right = evaluate_quote(), return VALUE_EMPTY); + ERR_Z(right = quote_expr(), return VALUE_EMPTY); TOKEN_MATCH(TOKEN_RP, return VALUE_EMPTY); struct cons cons = {value_copy(left), value_copy(right)}; @@ -411,7 +477,7 @@ value_t quote_sexp(void) while(token.type != TOKEN_RP) { value_t new = VALUE_EMPTY; - ERR_Z(new = evaluate_quote(), + ERR_Z(new = quote_expr(), goto exit); value_t new_cons = VALUE_EMPTY; @@ -434,3 +500,34 @@ exit: value_destroy(nil); return ret; } + +size_t toklist_expr(struct token **toklist) +{ + struct token tokens[256]; + size_t tokens_len = 0; + + size_t depth = 0; + do { + TOKEN_NEXT(); + + if(tokens_len >= LEN(tokens)) { + err("Too many tokens in expr"); + goto fail; + } + + if(token.type == TOKEN_LP) depth++; + else if(token.type == TOKEN_RP) depth--; + + token_clone(&tokens[tokens_len++], &token); + + } while(depth > 0); + + *toklist = calloc(tokens_len, sizeof(*tokens)); + memcpy(*toklist, tokens, tokens_len * sizeof(*tokens)); + + return tokens_len; + +fail: + for(size_t i = 0; i < tokens_len; i++) token_dealloc(&tokens[i]); + return 0; +} diff --git a/src/value.c b/src/value.c index 233b83c..3c06fa3 100644 --- a/src/value.c +++ b/src/value.c @@ -32,17 +32,17 @@ const char * const value_type_string[] = { X(VALUE_PROC_BUILTIN, \ FN(snprintf, "%p", *(void **)&VALUE(v).proc_builtin.proc)) -#define DR(value) (--(value)->refs == 0) -#define VALUE_DESTROY_TABLE(X, v) \ - X(VALUE_NIL, (void)DR(v)) \ - X(VALUE_ATOM, if(DR(v)) free(VALUE(v).atom)) \ - X(VALUE_STR, if(DR(v)) free(VALUE(v).str)) \ - X(VALUE_INT, (void)DR(v)) \ - X(VALUE_CONS, (void)DR(v); \ - value_destroy(VALUE(v).cons.left); \ - value_destroy(VALUE(v).cons.right)) \ - X(VALUE_PROC, if(DR(v)) proc_destroy(&VALUE(v).proc)) \ - X(VALUE_PROC_BUILTIN, (void)DR(v)) +#define NOREFS(value) (--(value)->refs == 0) +#define VALUE_DESTROY_TABLE(X, v) \ + X(VALUE_NIL, (void)NOREFS(v)) \ + X(VALUE_ATOM, if(NOREFS(v)) free(VALUE(v).atom)) \ + X(VALUE_STR, if(NOREFS(v)) free(VALUE(v).str)) \ + X(VALUE_INT, (void)NOREFS(v)) \ + X(VALUE_CONS, (void)NOREFS(v); \ + value_destroy(VALUE(v).cons.left); \ + value_destroy(VALUE(v).cons.right)) \ + 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; @@ -147,6 +147,7 @@ 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) { + return 0; (void)buf; (void)buf_sz; (void)proc; NOT_IMPLEMENTED(); @@ -154,6 +155,11 @@ static int proc_print(char *buf, size_t buf_sz, struct proc *proc) static void proc_destroy(struct proc *proc) { - (void)proc; - NOT_IMPLEMENTED(); + for(size_t i = 0; i < proc->argc; i++) value_destroy(proc->arg_keys[i]); + free(proc->arg_keys); + + for(size_t i = 0; i < proc->body_len; i++) token_dealloc(&proc->body[i]); + free(proc->body); + + env_destroy(proc->parent_env); } diff --git a/src/value.h b/src/value.h index c2f43e3..ed30b99 100644 --- a/src/value.h +++ b/src/value.h @@ -39,12 +39,13 @@ struct value { } cons; struct proc { - size_t argc; - value_t *arg_keys; env_t parent_env; - size_t body_len; + value_t *arg_keys; + size_t argc; + struct token *body; + size_t body_len; } proc; struct proc_builtin { |