diff options
| -rw-r--r-- | files/test-lambda.l | 8 | ||||
| -rw-r--r-- | src/lexer.c | 17 | ||||
| -rw-r--r-- | src/lexer.h | 11 | ||||
| -rw-r--r-- | src/list.h | 83 | ||||
| -rw-r--r-- | src/main.c | 324 | ||||
| -rw-r--r-- | src/value.c | 57 | ||||
| -rw-r--r-- | src/value.h | 4 |
7 files changed, 414 insertions, 90 deletions
diff --git a/files/test-lambda.l b/files/test-lambda.l index 71ef0bd..d15f3ff 100644 --- a/files/test-lambda.l +++ b/files/test-lambda.l @@ -2,7 +2,7 @@ (define add4 (make-add 4)) (add4 5) -'(a b ,((lambda (a) '(test . ,a)) 69) c d) +`(a b ,((lambda (a) `(test . ,a)) 69) c d) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -48,3 +48,9 @@ ;; (+list (do 100 (lambda (n) (fib n)))) (reverse (do 100 (lambda (n) (fib n)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; don't know about a good example +(defmacro m (a) `(+ ,a 57)) +(m (+ 1 2)) + diff --git a/src/lexer.c b/src/lexer.c index 93c7f44..cd83006 100644 --- a/src/lexer.c +++ b/src/lexer.c @@ -11,6 +11,7 @@ X(('(' == CH(l)), on_separator(l, TOKEN_LP)) \ X((')' == CH(l)), on_separator(l, TOKEN_RP)) \ X(('\''== CH(l)), on_separator(l, TOKEN_QUOTE)) \ + X(('`' == CH(l)), on_separator(l, TOKEN_QUASI)) \ X((',' == CH(l)), on_separator(l, TOKEN_UNQUOTE)) \ X(isspace(CH(l)), on_separator(l, TOKEN_NONE)) \ X(TABLE_ELSE, acc_add_char(l, CH(l))) @@ -31,12 +32,14 @@ X(TOKEN_LAMBDA, "lambda") \ X(TOKEN_DEFINE, "define") \ X(TOKEN_QUOTE_FORM, "quote") \ - X(TOKEN_IF, "if") + X(TOKEN_IF, "if") \ + X(TOKEN_DEFMACRO, "defmacro") #define TOKEN_VALUE_STRING_TABLE(X, tvalue) \ X(TOKEN_LP, "(") \ X(TOKEN_RP, ")") \ X(TOKEN_QUOTE, "'") \ + X(TOKEN_QUASI, "`") \ X(TOKEN_UNQUOTE, ",") \ X(TOKEN_ID, "%s", tvalue.id) \ X(TOKEN_STR, "%s", tvalue.str) \ @@ -167,6 +170,18 @@ void token_dealloc(struct token *token) } } +void toklist_destroy(struct toklist *toklist) +{ + list_for_each_safe(head, &toklist->list) { + toklist = list_entry(head, struct toklist, list); + for(size_t i = 0; i < toklist->tokens_len; i++) { + token_dealloc(&toklist->tokens[i]); + } + free(toklist->tokens); + free(toklist); + } +} + 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 e40ab05..6a14050 100644 --- a/src/lexer.h +++ b/src/lexer.h @@ -2,6 +2,7 @@ #define LEXER_H #include <stdio.h> +#include "list.h" #define TOKEN_TYPES(X) \ X(TOKEN_LP) \ @@ -11,11 +12,13 @@ X(TOKEN_INT) \ X(TOKEN_DOT) \ X(TOKEN_QUOTE) \ + X(TOKEN_QUASI) \ X(TOKEN_UNQUOTE) \ X(TOKEN_LAMBDA) \ X(TOKEN_DEFINE) \ X(TOKEN_QUOTE_FORM) \ X(TOKEN_IF) \ + X(TOKEN_DEFMACRO) \ X(TOKEN_NONE) #define TO_ENUM(type) type, @@ -35,6 +38,13 @@ struct token { } value; }; +struct toklist { + struct token *tokens; + size_t tokens_len; + + struct list_head list; +}; + typedef struct lexer * lexer_t; #define LEXER_EMPTY NULL @@ -59,5 +69,6 @@ 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); +void toklist_destroy(struct toklist *toklist); #endif diff --git a/src/list.h b/src/list.h new file mode 100644 index 0000000..2a9df61 --- /dev/null +++ b/src/list.h @@ -0,0 +1,83 @@ +#ifndef LIST_H +#define LIST_H + +#define offsetof(TYPE, MEMBER) ((size_t) &((TYPE *)0)->MEMBER) +#define container_of(ptr, type, member) ((type *)((char *)(ptr) - offsetof(type, member))) + +struct list_head { + struct list_head *prev; + struct list_head *next; +}; + +#define LIST_END NULL + +#define LIST_EMPTY(list) do { \ + (list)->next = LIST_END; \ + (list)->prev = LIST_END; \ + } while(0); + +#define list_entry(ptr, type, member) \ + container_of(ptr, type, member) + +#define list_next_entry(entry, type, member) \ + list_entry(entry->member.next, type, member) + +#define list_for_each(pos, start) \ + for(struct list_head *pos = start; pos; pos = pos->next) +#define list_for_each_entry(type, entry, member, start) \ + for(type *entry = list_entry((start), type, member); \ + entry; \ + entry = (entry->member.next == LIST_END ? NULL : \ + list_next_entry(entry, type, member))) + +#define list_for_each_safe(pos, start) \ + for(struct list_head *pos = (start), *__next = LIST_END; \ + pos && (__next = pos->next,1); \ + pos = __next) + +static inline int list_is_head(struct list_head *l) +{ + return l->prev == LIST_END; +} + +static inline int list_is_tail(struct list_head *l) +{ + return l->next == LIST_END; +} + +static inline struct list_head *list_get_head(struct list_head *l) +{ + while(!list_is_head(l)) l = l->prev; + return l; +} + +static inline struct list_head *list_get_tail(struct list_head *l) +{ + while(!list_is_tail(l)) l = l->next; + return l; +} + +static inline struct list_head *list_add( + struct list_head *head, + struct list_head *new) +{ + if(head) { + new->next = head->next; + head->next = new; + } + new->prev = head; + return new; +} + +static inline struct list_head *list_append( + struct list_head *head, + struct list_head *new) +{ + if(head) { + head->next = new; + } + new->prev = head; + return new; +} + +#endif @@ -2,6 +2,7 @@ #include <stdlib.h> #include <string.h> #include <getopt.h> +#include <stdbool.h> #include "lexer.h" #include "value.h" @@ -62,11 +63,22 @@ static void print_token(struct token *token) static void print_value(value_t value) { char buf[256] = {0}; - value_string(value, LEN(buf), buf); + value_string(value, sizeof(buf), buf); info("%-12s %s", value ? value_type_string[value->type] : "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, @@ -82,8 +94,7 @@ struct tctx { } lex_ctx; struct tok_ctx { - struct token *list; - size_t len; + struct toklist *head; size_t idx; } tok_ctx; } value; @@ -96,11 +107,10 @@ static void tctx_init_lexer(struct tctx *tctx, lexer_t lexer) tctx->token = &tctx->value.lex_ctx.token; } -static void tctx_init_toklist(struct tctx *tctx, struct token *toklist, size_t len) +static void tctx_init_toklist(struct tctx *tctx, struct toklist *list) { tctx->type = TCTX_TOKLIST; - tctx->value.tok_ctx.list = toklist; - tctx->value.tok_ctx.len = len; + tctx->value.tok_ctx.head = list; tctx->value.tok_ctx.idx = 0; tctx->token = NULL; } @@ -115,8 +125,12 @@ static struct token *next_token(struct tctx *tctx) break; case TCTX_TOKLIST: ; struct tok_ctx *t = &tctx->value.tok_ctx; - if(t->idx == t->len) goto fail; - tctx->token = &t->list[t->idx++]; + while(t->idx >= t->head->tokens_len) { + ERR_NZ(list_is_tail(&t->head->list), _r, goto fail); + t->head = list_next_entry(t->head, struct toklist, list); + t->idx = 0; + } + tctx->token = &t->head->tokens[t->idx++]; break; } @@ -126,8 +140,9 @@ fail: return NULL; } +static char *str_alloc_copy(char *src); -value_t apply(value_t proc, size_t argc, value_t *argv); +value_t apply(env_t env, value_t proc, size_t argc, value_t *argv); value_t evaluate_expr(env_t env, struct tctx *tctx); value_t evaluate_sexp(env_t env, struct tctx *tctx); @@ -136,11 +151,15 @@ value_t evaluate_id (env_t env, struct tctx *tctx); value_t evaluate_lambda(env_t env, struct tctx *tctx); value_t evaluate_define(env_t env, struct tctx *tctx); value_t evaluate_if (env_t env, struct tctx *tctx); +value_t evaluate_defmacro(env_t env, struct tctx *tctx); + +value_t quote_expr(env_t env, struct tctx *tctx, bool is_quasi); +value_t quote_sexp(env_t env, struct tctx *tctx, bool is_quasi); -value_t quote_expr(env_t env, struct tctx *tctx); -value_t quote_sexp(env_t env, struct tctx *tctx); +static int toklist_expr(struct tctx *tctx, struct toklist **toklist); -size_t toklist_expr(struct tctx *tctx, struct token **toklist); +static struct toklist *value_to_toklist(value_t value); +static struct toklist *cons_to_toklist(value_t value); static env_t global_env = ENV_EMPTY; static value_t global_nil = VALUE_EMPTY; @@ -249,6 +268,14 @@ int main(int argc, char **argv) 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); +} + #define HAS_ENOUGH_ARGS(proc, type, argc, fail) \ if(argc != proc->value.type.argc) { \ err("Wrong number of arguemnts, expected %zu, but got %zu", \ @@ -263,7 +290,7 @@ static value_t apply_lambda(struct proc *proc, value_t *args) struct tctx tctx = {0}; ERR_Z(env = env_create(env_copy(proc->parent_env), destroy_env), goto exit); - tctx_init_toklist(&tctx, proc->body, proc->body_len); + tctx_init_toklist(&tctx, proc->body); for(size_t i = 0; i < proc->argc; i++) { ERR_NZ(hashtable_insert(env->table, @@ -279,7 +306,30 @@ exit: return ret; } -value_t apply(value_t proc, size_t argc, value_t *argv) +static value_t apply_macro(env_t env, struct proc *proc, value_t *args) +{ + value_t ret = VALUE_EMPTY; + value_t macro_ret = VALUE_EMPTY; + + struct toklist *toklist = NULL; + + ERR_Z(macro_ret = apply_lambda(proc, args), goto exit); + ERR_Z(toklist = value_to_toklist(macro_ret), goto exit); + + struct tctx tctx = {0}; + tctx_init_toklist(&tctx, toklist); + + TOKEN_NEXT(&tctx); + ret = evaluate_expr(env, &tctx); + +exit: + if(toklist) toklist_destroy(toklist); + value_destroy(macro_ret); + + return ret; +} + +value_t apply(env_t env, value_t proc, size_t argc, value_t *argv) { if(proc == VALUE_EMPTY) return value_copy(global_nil); @@ -287,11 +337,14 @@ value_t apply(value_t proc, size_t argc, value_t *argv) case VALUE_PROC: HAS_ENOUGH_ARGS(proc, proc, argc, return VALUE_EMPTY); return apply_lambda(&proc->value.proc, argv); + case VALUE_MACRO: + HAS_ENOUGH_ARGS(proc, proc, argc, return VALUE_EMPTY); + return apply_macro(env, &proc->value.proc, argv); case VALUE_PROC_BUILTIN: HAS_ENOUGH_ARGS(proc, proc_builtin, argc, return VALUE_EMPTY); return proc->value.proc_builtin.proc(argv); default: - err("Value is not a procedure"); + err("'%s' is not a procedure", value_type_string[proc->type]); return VALUE_EMPTY; } } @@ -313,7 +366,11 @@ value_t evaluate_expr(env_t env, struct tctx *tctx) break; case TOKEN_QUOTE: TOKEN_NEXT(tctx); - ERR_Z(ret = quote_expr(env, tctx), goto exit); + ERR_Z(ret = quote_expr(env, tctx, false), goto exit); + break; + case TOKEN_QUASI: + TOKEN_NEXT(tctx); + ERR_Z(ret = quote_expr(env, tctx, true), goto exit); break; default: err("Did not exptect token '%s'", token_type_string[TOKEN(tctx)->type]); @@ -349,6 +406,14 @@ value_t evaluate_sexp(env_t env, struct tctx *tctx) goto exit; } + if(body[0]) + if(body[0]->type == VALUE_MACRO) { + ERR_Z(body[argc] = quote_expr(env, tctx, false), goto exit); + + TOKEN_NEXT(tctx); + continue; + } + switch(TOKEN(tctx)->type) { case TOKEN_LAMBDA: SPECIAL_FORM(ret, argc, evaluate_lambda(env, tctx), goto exit); @@ -358,7 +423,7 @@ value_t evaluate_sexp(env_t env, struct tctx *tctx) goto exit; case TOKEN_QUOTE_FORM: TOKEN_NEXT(tctx); - SPECIAL_FORM(ret, argc, quote_expr(env, tctx), goto exit); + SPECIAL_FORM(ret, argc, quote_expr(env, tctx, false), goto exit); TOKEN_MATCH(tctx, TOKEN_RP, value_destroy(ret); ret = VALUE_EMPTY; @@ -367,6 +432,9 @@ value_t evaluate_sexp(env_t env, struct tctx *tctx) case TOKEN_IF: SPECIAL_FORM(ret, argc, evaluate_if(env, tctx), goto exit); goto exit; + case TOKEN_DEFMACRO: + SPECIAL_FORM(ret, argc, evaluate_defmacro(env, tctx), goto exit); + goto exit; default: ERR_Z(body[argc] = evaluate_expr(env, tctx), goto exit); break; @@ -375,7 +443,7 @@ value_t evaluate_sexp(env_t env, struct tctx *tctx) TOKEN_NEXT(tctx); } - ret = apply(body[0], argc-1, &body[1]); + ret = apply(env, body[0], argc-1, &body[1]); exit: for(size_t i = 0; i < argc; i++) @@ -410,8 +478,7 @@ value_t evaluate_lambda(env_t env, struct tctx *tctx) size_t argc = 0; value_t *arg_keys = NULL; - struct token *body = NULL; - size_t body_len = 0; + struct toklist *body = NULL; TOKEN_SKIP(tctx, TOKEN_LAMBDA, goto fail); TOKEN_SKIP(tctx, TOKEN_LP, goto fail); @@ -433,14 +500,14 @@ value_t evaluate_lambda(env_t env, struct tctx *tctx) TOKEN_NEXT(tctx); } - ERR_Z(body_len = toklist_expr(tctx, &body), goto fail); + ERR_NZ(toklist_expr(tctx, &body), _r, goto fail); TOKEN_MATCH(tctx, 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}; + struct proc proc = {env_copy(env), arg_keys, argc, body}; ERR_Z(ret = value_create(VALUE_PROC, &proc), env_destroy(env); // remove the copy goto fail); @@ -450,20 +517,11 @@ 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) { - for(size_t i = 0; i < body_len; i++) token_dealloc(&body[i]); - free(body); - } + if(body) toklist_destroy(body); if(arg_keys) free(arg_keys); return VALUE_EMPTY; } -#define STR_ALLOC_COPY(dest, str) do { \ - size_t len = strlen(str) + 1; \ - dest = malloc(len); \ - memcpy((dest), (str), len); \ - } while(0) - value_t evaluate_define(env_t env, struct tctx *tctx) { // TODO: don't alloc when the key is the same @@ -480,7 +538,7 @@ value_t evaluate_define(env_t env, struct tctx *tctx) switch(TOKEN(tctx)->type) { case TOKEN_ID: - STR_ALLOC_COPY(key, TOKEN(tctx)->value.id); + key = str_alloc_copy(TOKEN(tctx)->value.id); break; default: err("Did not exptect token '%s'", token_type_string[TOKEN(tctx)->type]); @@ -556,7 +614,53 @@ exit: return ret; } -value_t quote_expr(env_t env, struct tctx *tctx) +value_t evaluate_defmacro(env_t env, struct tctx *tctx) +{ + char *key = NULL; + value_t lambda = VALUE_EMPTY; + + TOKEN_SKIP(tctx, TOKEN_DEFMACRO, goto fail); + + switch(TOKEN(tctx)->type) + { + case TOKEN_ID: + key = str_alloc_copy(TOKEN(tctx)->value.id); + break; + default: + err("Did not exptect token '%s'", token_type_string[TOKEN(tctx)->type]); + goto fail; + } + + // unsafe and bad + tctx->token->type = TOKEN_LAMBDA; + + ERR_Z(lambda = evaluate_lambda(env, tctx), goto fail); + lambda->type = VALUE_MACRO; + + // TOKEN_MATCH(tctx, TOKEN_RP, goto fail); + + value_t prevval = VALUE_EMPTY; + char *prevkey = NULL; + + ERR_NZ( + hashtable_insert(global_env->table, (void *)key, (void *)lambda, + (void**)&prevkey, (void **)&prevval), + r, { + err("Couldn't insert symbol into the hashtable due to %s", strerror(r)); + goto fail; + }); + + if(prevkey) free(prevkey); + value_destroy(prevval); + return value_copy(global_nil); + +fail: + value_destroy(lambda); + if(key)free(key); + return VALUE_EMPTY; +} + +value_t quote_expr(env_t env, struct tctx *tctx, bool is_quasi) { value_t ret = VALUE_EMPTY; @@ -566,23 +670,28 @@ value_t quote_expr(env_t env, struct tctx *tctx) case TOKEN_INT: ERR_Z(ret = value_from_token(TOKEN(tctx)), goto exit); break; + case TOKEN_UNQUOTE: + if(is_quasi) { + TOKEN_SKIP(tctx, TOKEN_UNQUOTE, goto exit); + ERR_Z(ret = evaluate_expr(env, tctx), goto exit); + break; + } case TOKEN_QUOTE: + case TOKEN_QUASI: case TOKEN_LAMBDA: case TOKEN_DEFINE: case TOKEN_QUOTE_FORM: - case TOKEN_IF: ; + case TOKEN_IF: + case TOKEN_DEFMACRO: ; char name[64] = {0}; ERR_Z(token_value_string(TOKEN(tctx), LEN(name), name), goto exit); struct token temp = {0}; temp.type = TOKEN_ID; temp.value.id = name; ERR_Z(ret = value_from_token(&temp), goto exit); break; case TOKEN_LP: - ERR_Z(ret = quote_sexp(env, tctx), goto exit); - break; - case TOKEN_UNQUOTE: - TOKEN_SKIP(tctx, TOKEN_UNQUOTE, goto exit); - ERR_Z(ret = evaluate_expr(env, tctx), goto exit); + ERR_Z(ret = quote_sexp(env, tctx, is_quasi), goto exit); break; + default: err("Did not exptect token '%s'", token_type_string[TOKEN(tctx)->type]); break; @@ -591,7 +700,7 @@ exit: return ret; } -value_t quote_sexp(env_t env, struct tctx *tctx) +value_t quote_sexp(env_t env, struct tctx *tctx, bool is_quasi) { value_t ret = VALUE_EMPTY; value_t left = VALUE_EMPTY; @@ -604,14 +713,14 @@ value_t quote_sexp(env_t env, struct tctx *tctx) goto exit; } - ERR_Z(left = quote_expr(env, tctx), goto exit); + ERR_Z(left = quote_expr(env, tctx, is_quasi), goto exit); TOKEN_NEXT(tctx); if(TOKEN(tctx)->type == TOKEN_DOT) { // Parse cons TOKEN_NEXT(tctx); - ERR_Z(right = quote_expr(env, tctx), return VALUE_EMPTY); + ERR_Z(right = quote_expr(env, tctx, is_quasi), return VALUE_EMPTY); TOKEN_MATCH(tctx, TOKEN_RP, return VALUE_EMPTY); struct cons cons = {value_copy(left), value_copy(right)}; @@ -629,7 +738,7 @@ value_t quote_sexp(env_t env, struct tctx *tctx) if(TOKEN(tctx)->type == TOKEN_DOT) { TOKEN_NEXT(tctx); - ERR_Z(new = quote_expr(env, tctx), goto exit); + ERR_Z(new = quote_expr(env, tctx, is_quasi), goto exit); TOKEN_MATCH(tctx, TOKEN_RP, value_destroy(new); @@ -640,7 +749,7 @@ value_t quote_sexp(env_t env, struct tctx *tctx) break; } - ERR_Z(new = quote_expr(env, tctx), + ERR_Z(new = quote_expr(env, tctx, is_quasi), goto exit); value_t new_cons = VALUE_EMPTY; @@ -663,37 +772,136 @@ exit: return ret; } -#define IS_OP(token) (token->type == TOKEN_QUOTE) -size_t toklist_expr(struct tctx *tctx, struct token **toklist) +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) + +static int toklist_expr(struct tctx *tctx, struct toklist **toklist) { - struct token tokens[256]; + struct token tokens[64] = {0}; size_t tokens_len = 0; + struct list_head *tail = LIST_END; + size_t depth = 0; + do { TOKEN_NEXT(tctx); if(tokens_len >= LEN(tokens)) { - err("Too many tokens in expr"); - goto fail; + if(toklist) { + tail = list_add(tail, &toklist_create(tokens, tokens_len)->list); + } + tokens_len = 0; } if(TOKEN(tctx)->type == TOKEN_LP) depth++; else if(TOKEN(tctx)->type == TOKEN_RP) depth--; + + if(toklist) + token_clone(&tokens[tokens_len++], TOKEN(tctx)); - token_clone(&tokens[tokens_len++], TOKEN(tctx)); + } while(depth != 0 || IS_OP(TOKEN(tctx))); - } while(depth > 0 || IS_OP(TOKEN(tctx))); + if(toklist) { + tail = list_add(tail, &toklist_create(tokens, tokens_len)->list); + *toklist = list_entry(list_get_head(tail), struct toklist, list); + } - if(!toklist) goto fail; + return 0; + +// fail: + // for(size_t i = 0; i < tokens_len; i++) token_dealloc(&tokens[i]); + // return 1; +} + +#define SET_TOKEN_TYPE(t, ttype) (t)->type = (ttype) +#define SET_TOKEN_VALUE(t, member, tvalue) (t)->value.member = (tvalue) + +static struct toklist *value_to_toklist(value_t value) +{ + struct token token = {0}; + + switch(value->type) { + case VALUE_ATOM: + SET_TOKEN_TYPE(&token, TOKEN_ID); + SET_TOKEN_VALUE(&token, id, + str_alloc_copy(value->value.atom)); + break; + case VALUE_STR: + SET_TOKEN_TYPE(&token, TOKEN_STR); + SET_TOKEN_VALUE(&token, str, + str_alloc_copy(value->value.str)); + break; + case VALUE_INT: + SET_TOKEN_TYPE(&token, TOKEN_INT); + SET_TOKEN_VALUE(&token, num, value->value.num); + break; + case VALUE_CONS: + return cons_to_toklist(value); + default: + err("Cant turn '%s' to a token", value_type_string[value->type]); + return NULL; + } + + return toklist_create(&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)); +} + +static struct toklist *cons_to_toklist(value_t value) +{ +#define ADD_TOKEN(tail, ttype) \ + tail = add_token_toklist(ttype, tail) +#define ADD_TOKLIST(tail, toklist) \ + tail = list_get_tail(list_append(tail, &toklist->list)) + + struct list_head *tail = LIST_END; + + ADD_TOKEN(tail, TOKEN_LP); + + while(1) { + value_t left = value->value.cons.left; + value = value->value.cons.right; - *toklist = calloc(tokens_len, sizeof(*tokens)); - memcpy(*toklist, tokens, tokens_len * sizeof(*tokens)); + struct toklist *new = NULL; + ERR_Z(new = value_to_toklist(left), goto fail); + ADD_TOKLIST(tail, new); - return tokens_len; + if(value->type == VALUE_NIL) break; + if(value->type != VALUE_CONS) { + ADD_TOKEN(tail, TOKEN_DOT); + ERR_Z(new = value_to_toklist(value), goto fail); + ADD_TOKLIST(tail, new); + break; + } + } + + ADD_TOKEN(tail, TOKEN_RP); + + return list_entry(list_get_head(tail), struct toklist, list); fail: - for(size_t i = 0; i < tokens_len; i++) token_dealloc(&tokens[i]); - return 0; + err("Failed to turn value to toklist"); + toklist_destroy(list_entry(list_get_head(tail), struct toklist, list)); + return NULL; } diff --git a/src/value.c b/src/value.c index 54c0d20..9a7f9b6 100644 --- a/src/value.c +++ b/src/value.c @@ -14,26 +14,28 @@ const char * const value_type_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)")) \ - X(VALUE_ATOM, FN(snprintf, "%s", VALUE(v).atom)) \ - X(VALUE_STR, FN(snprintf, "%s", VALUE(v).str)) \ - X(VALUE_INT, FN(snprintf, "%d", VALUE(v).num)) \ - X(VALUE_CONS, FN(cons_print, &VALUE(v).cons)) \ - X(VALUE_PROC, FN(proc_print, &VALUE(v).proc)) \ - X(VALUE_PROC_BUILTIN, \ +#define VALUE_STRING_TABLE(X, v, buf, buf_sz) \ + X(VALUE_NIL, FN(snprintf, "(nil)")) \ + X(VALUE_ATOM, FN(snprintf, "%s", VALUE(v).atom)) \ + X(VALUE_STR, FN(snprintf, "%s", VALUE(v).str)) \ + X(VALUE_INT, FN(snprintf, "%d", VALUE(v).num)) \ + X(VALUE_CONS, FN(cons_print, &VALUE(v).cons)) \ + X(VALUE_PROC, FN(proc_print, &VALUE(v).proc)) \ + X(VALUE_MACRO, FN(proc_print, &VALUE(v).proc)) \ + X(VALUE_PROC_BUILTIN, \ FN(snprintf, "%p", *(void **)&VALUE(v).proc_builtin.proc)) #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)) \ +#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_MACRO, if(NOREFS(v)) proc_destroy(&VALUE(v).proc)) \ X(VALUE_PROC_BUILTIN, (void)NOREFS(v)) #define CREATE(vtype, value) return value_create(vtype, value) @@ -49,12 +51,13 @@ const char * const value_type_string[] = { #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) \ +#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_MACRO, proc) \ X(VALUE_PROC_BUILTIN, proc_builtin) @@ -162,7 +165,7 @@ static int cons_print(char *buf, size_t buf_sz, struct cons *cons) value_t right = cons->right; while(right->type == VALUE_CONS) { SET_CHAR(' '); - SET_VALUE_STRING(right->value.cons.left) + SET_VALUE_STRING(right->value.cons.left); right = right->value.cons.right; } @@ -189,7 +192,7 @@ static int cons_print(char *buf, size_t buf_sz, struct cons *cons) } exit: - return (int)offset; + return (int)offset-1; // -1 because of \0 } static int proc_print(char *buf, size_t buf_sz, struct proc *proc) @@ -205,8 +208,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); - for(size_t i = 0; i < proc->body_len; i++) token_dealloc(&proc->body[i]); - free(proc->body); - + toklist_destroy(proc->body); env_destroy(proc->parent_env); } diff --git a/src/value.h b/src/value.h index 61b8252..264e083 100644 --- a/src/value.h +++ b/src/value.h @@ -16,6 +16,7 @@ typedef value_t (*builtin_proc_t)(value_t *args); X(VALUE_INT) \ X(VALUE_CONS) \ X(VALUE_PROC) \ + X(VALUE_MACRO) \ X(VALUE_PROC_BUILTIN) #define TO_ENUM(type) type, @@ -44,8 +45,7 @@ struct value { value_t *arg_keys; size_t argc; - struct token *body; - size_t body_len; + struct toklist *body; } proc; struct proc_builtin { |