linked list and macros

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
diff --git a/src/main.c b/src/main.c
index 0ddb7f9..d0227e8 100644
--- a/src/main.c
+++ b/src/main.c
@@ -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 {