path: root/src/main.c

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <getopt.h>
#include <stdbool.h>

#include "lexer.h"
#include "value.h"
#include "env.h"

#ifdef ENABLE_MEMDEBUG
#define MEMDEBUG_OUT_OF_BOUNDS
#define MEMDEBUG_IMPLEMENTATION
#define MEMDEBUG_OUTPUT_DIR "files"
#endif

#include "common.h"
#include "builtin.h"

#define LEN(arr) (sizeof(arr)/sizeof(*(arr)))

// TODO:
// - 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 and better error messages

#define TOKEN(tctx) (tctx)->token

#define TOKEN_NEXT(tctx)                                 \
    ERR_Z(next_token(tctx), die("Can't get next token"))

#define TOKEN_ASSERT(token, 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(tctx, ttype, fail) do {        \
        TOKEN_ASSERT(TOKEN(tctx), ttype, fail)    \
        else {                                    \
            TOKEN_NEXT(tctx);                     \
        }                                         \
    } while(0)

#define TOKEN_MATCH(tctx, ttype, fail) do {       \
        TOKEN_NEXT(tctx);                         \
        TOKEN_ASSERT(TOKEN(tctx), ttype, fail);   \
    } while(0)


#define NOT_IMPLEMENTED() die("Not Implemented. ABORTING")

static void print_token(struct token *token)
{
    char buf[256] = {0};
    ERR_Z(token_value_string(token, LEN(buf), buf), return);
    info("%-12s %s", token_type_string[token->type], buf);
}

static void print_value(value_t value)
{
    char buf[256] = {0};
    value_string(value, sizeof(buf), buf);
    info("%-12s %s", value ?
         value_type_string[vvalue_type(value)] : "VALUE", buf);
}

static void print_toklist(struct toklist *toklist)
{
    info("TOKLIST_START");
    list_for_each(pos, &toklist->list) {
        struct toklist *entry = list_entry(pos, struct toklist, list);
        for(size_t i = 0; i < entry->tokens_len; i++)
            print_token(&entry->tokens[i]);
    }
    info("TOKLIST_END");
}

struct tctx {
    enum tctx_type {
        TCTX_LEXER,
        TCTX_TOKLIST
    } type;

    struct token *token;

    union {
        struct lex_ctx {
            lexer_t lexer;
            struct token token;
        } lex_ctx;

        struct tok_ctx {
            struct toklist *head;
            size_t idx;
        } tok_ctx;
    } value;
};

static void tctx_init_lexer(struct tctx *tctx, lexer_t lexer)
{
    tctx->type = TCTX_LEXER;
    tctx->value.lex_ctx.lexer = lexer;
    tctx->token = &tctx->value.lex_ctx.token;
}

static void tctx_init_toklist(struct tctx *tctx, struct toklist *list)
{
    tctx->type = TCTX_TOKLIST;
    tctx->value.tok_ctx.head = list;
    tctx->value.tok_ctx.idx = 0;
    tctx->token = NULL;
}

static struct token *next_token(struct tctx *tctx)
{
    switch(tctx->type) {
    case TCTX_LEXER: ;
        struct lex_ctx *l = &tctx->value.lex_ctx;
        ERR_NZ(lexer_token_next(l->lexer, &l->token), _r, goto fail);
        // tctx->token should already point to l->token
        break;
    case TCTX_TOKLIST: ;
        struct tok_ctx *t = &tctx->value.tok_ctx;
        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;
    }

    return tctx->token;
fail:
    tctx->token = NULL;
    return NULL;
}

static char *str_alloc_copy(char *src);

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);

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);

static int toklist_expr(struct tctx *tctx, struct toklist **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;

static void destroy_env(char *key, value_t value)
{
    (void)key;
    value_destroy(value);
}

static void destroy_global_env(char *key, value_t value)
{
    free(key);
    value_destroy(value);
}

int main(int argc, char **argv)
{
    int opt, repl_flag = 0;

#ifdef DEBUG
    char *filename = "files/test-lambda.l";
#else
    char *filename = NULL;
#endif

    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;
        }
    }

    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);

    for(size_t i = 0; i < BUILTIN_PROCEDURES; i++) {
        value_t proc_value = value_create(
            VALUE_PROC_BUILTIN,
            (void *)&builtin_proc_descriptions[i]);
        hashtable_insert(builtin_env->table,
                         (void *)builtin_proc_name_list[i],
                         (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);

        if(val == VALUE_EMPTY) {
            if(!repl_flag) {
                printf("%s:%zu: FAILED\n", filename, lexer_get_line(lexer));
                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_get_line(lexer), 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;
}

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 != vvalue_##type(proc).argc) {                          \
        err("Wrong number of arguemnts, expected %zu, but got %zu", \
            vvalue_##type(proc).argc, argc);                        \
        fail;                                                       \
    }

static value_t apply_lambda(struct proc *proc, value_t *args)
{
    value_t ret = VALUE_EMPTY;
    env_t env = ENV_EMPTY;
    struct tctx tctx = {0};

    ERR_Z(env = env_create(env_copy(proc->parent_env), destroy_env), goto exit);
    tctx_init_toklist(&tctx, proc->body);

    for(size_t i = 0; i < proc->argc; i++) {
        ERR_NZ(hashtable_insert(env->table,
                                (void*)proc->arg_keys[i]->value.atom,
                                (void*)value_copy(args[i]), NULL, NULL), _r, goto exit);
    }

    TOKEN_NEXT(&tctx);
    ret = evaluate_expr(env, &tctx);

exit:
    env_destroy(env);
    return ret;
}

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);

    switch(vvalue_type(proc)) {
    case VALUE_PROC:
        HAS_ENOUGH_ARGS(proc, proc, argc, return VALUE_EMPTY);
        return apply_lambda(&vvalue_proc(proc), argv);
    case VALUE_MACRO:
        HAS_ENOUGH_ARGS(proc, proc, argc, return VALUE_EMPTY);
        return apply_macro(env, &vvalue_proc(proc), argv);
    case VALUE_PROC_BUILTIN:
        HAS_ENOUGH_ARGS(proc, proc_builtin, argc, return VALUE_EMPTY);
        return vvalue_proc_builtin(proc).proc(argv);
    default:
        err("'%s' is not a procedure", value_type_string[vvalue_type(proc)]);
        return VALUE_EMPTY;
    }
}

value_t evaluate_expr(env_t env, struct tctx *tctx)
{
    value_t ret = VALUE_EMPTY;

    switch(TOKEN(tctx)->type) {
    case TOKEN_LP:
        ERR_Z(ret = evaluate_sexp(env, tctx), goto exit);
        break;
    case TOKEN_ID:
        ERR_Z(ret = evaluate_id(env, tctx), goto exit);
        break;
    case TOKEN_STR:
    case TOKEN_INT:
        ERR_Z(ret = value_from_token(TOKEN(tctx)), goto exit);
        break;
    case TOKEN_QUOTE:
        TOKEN_NEXT(tctx);
        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]);
        break;
    }

exit:
    return ret;
}

#define IS_NOT_FIRST(arg, fail)                                \
    if(arg != 0) {                                             \
        err("special forms can only be the first argument");   \
        fail;                                                  \
    }
#define SPECIAL_FORM(ret, argc, fn, fail) do {  \
        IS_NOT_FIRST(argc, fail);               \
        ERR_Z(ret = fn, fail);                  \
    } while(0)

value_t evaluate_sexp(env_t env, struct tctx *tctx)
{
    value_t ret = VALUE_EMPTY;
    value_t body[256] = {VALUE_EMPTY};
    size_t argc = 0;

    TOKEN_SKIP(tctx, TOKEN_LP, goto exit);

    for(argc = 0; TOKEN(tctx)->type != TOKEN_RP; argc++)
    {
        if(argc >= LEN(body)) {
            err("Too many arguments");
            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);
            goto exit;
        case TOKEN_DEFINE:
            SPECIAL_FORM(ret, argc, evaluate_define(env, tctx), goto exit);
            goto exit;
        case TOKEN_QUOTE_FORM:
            TOKEN_NEXT(tctx);
            SPECIAL_FORM(ret, argc, quote_expr(env, tctx, false), goto exit);
            TOKEN_MATCH(tctx, TOKEN_RP,
                        value_destroy(ret);
                        ret = VALUE_EMPTY;
                        goto exit);
            goto exit;
        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;
        }

        TOKEN_NEXT(tctx);
    }

    ret = apply(env, body[0], argc-1, &body[1]);

exit:
    for(size_t i = 0; i < argc; i++)
        value_destroy(body[i]);
    return ret;
}

value_t evaluate_id(env_t env, struct tctx *tctx)
{
    if(env == ENV_EMPTY) {
        return evaluate_id(global_env, tctx);
    }

    value_t ret = VALUE_EMPTY;
    ERR_NZ(hashtable_query(env->table, (void *)TOKEN(tctx)->value.id, (void **)&ret), _r, goto fail);

    return value_copy(ret);

fail:
    if(env == global_env->parent) {
        err("Symbol %s is unbound", TOKEN(tctx)->value.id);
        return VALUE_EMPTY;
    }
    return evaluate_id(env->parent, tctx);
}

value_t evaluate_lambda(env_t env, struct tctx *tctx)
{
    value_t ret = VALUE_EMPTY;

    value_t args[32] = {VALUE_EMPTY};
    size_t argc = 0;
    value_t *arg_keys = NULL;

    struct toklist *body = NULL;

    TOKEN_SKIP(tctx, TOKEN_LAMBDA, goto fail);
    TOKEN_SKIP(tctx, TOKEN_LP, goto fail);

    while(TOKEN(tctx)->type != TOKEN_RP)
    {
        if(argc >= LEN(args)) {
            err("Too many arguments");
            goto fail;
        }

        if(TOKEN(tctx)->type != TOKEN_ID) {
            err("Token '%s' not expected in lambda args", token_type_string[TOKEN(tctx)->type]);
            goto fail;
        }

        ERR_Z(args[argc++] = value_from_token(TOKEN(tctx)), goto fail);

        TOKEN_NEXT(tctx);
    }

    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};
    ERR_Z(ret = value_create(VALUE_PROC, &proc),
          env_destroy(env); // remove the copy
          goto fail);

    return ret;

fail:
    err("Procedure creation failed");
    for(size_t i = 0; i < argc; i++) value_destroy(args[i]);
    if(body) toklist_destroy(body);
    if(arg_keys) free(arg_keys);
    return VALUE_EMPTY;
}

value_t evaluate_define(env_t env, struct tctx *tctx)
{
    // TODO: don't alloc when the key is the same
    char *key = NULL;

    // only in the outside environement
    if(env != ENV_EMPTY) {
        err("define can only be called in the outermost environement");
        goto fail;
    }

    TOKEN_SKIP(tctx, TOKEN_DEFINE, 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;
    }

    TOKEN_NEXT(tctx);

    value_t val = VALUE_EMPTY;
    ERR_Z(val = evaluate_expr(env, tctx), goto fail);

    TOKEN_MATCH(tctx, TOKEN_RP,
                value_destroy(val);
                goto fail);

    value_t prevval = VALUE_EMPTY;
    char *prevkey = NULL;

    ERR_NZ(
        hashtable_insert(global_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(val); // the copy
            goto fail;
        });

    if(prevkey) free(prevkey);
    value_destroy(prevval);
    return value_copy(global_nil);

fail:
    if(key) free(key);
    return VALUE_EMPTY;
}

value_t evaluate_if(env_t env, struct tctx *tctx)
{
    value_t ret = VALUE_EMPTY;
    value_t cond = VALUE_EMPTY;

    TOKEN_SKIP(tctx, TOKEN_IF, goto exit);

    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(vvalue_type(cond) == VALUE_INT,
          err("expected condition to evaluate to VALUE_INT");
          goto exit);

    if(vvalue_num(cond)) {
        TOKEN_NEXT(tctx);
        ret = evaluate_expr(env, tctx);

        toklist_expr(tctx, NULL); // skip one expression
    } else {
        toklist_expr(tctx, NULL); // skip one expression

        TOKEN_NEXT(tctx);
        ret = evaluate_expr(env, tctx);
    }

    TOKEN_MATCH(tctx, TOKEN_RP, goto exit);

exit:
    value_destroy(cond);
    return ret;
}

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);
    value_set_type(lambda, 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;

    switch(TOKEN(tctx)->type) {
    case TOKEN_ID:
    case TOKEN_STR:
    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_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, is_quasi), goto exit);
        break;

    default:
        err("Did not exptect token '%s'", token_type_string[TOKEN(tctx)->type]);
        break;
    }
exit:
    return ret;
}

value_t quote_sexp(env_t env, struct tctx *tctx, bool is_quasi)
{
    value_t ret   = VALUE_EMPTY;
    value_t left  = VALUE_EMPTY;
    value_t right = VALUE_EMPTY;

    TOKEN_SKIP(tctx, TOKEN_LP, goto exit);

    if(TOKEN(tctx)->type == TOKEN_RP) {
        ret = value_copy(global_nil);
        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, is_quasi), return VALUE_EMPTY);
        TOKEN_MATCH(tctx, TOKEN_RP, return VALUE_EMPTY);

        struct cons cons = {value_copy(left), value_copy(right)};
        ret = value_create(VALUE_CONS, &cons);
        goto exit;
    }

    // Parse list
    right = value_copy(global_nil);
    value_t *rightmost = &right; // the final nil
    while(TOKEN(tctx)->type != TOKEN_RP)
    {
        value_t new = VALUE_EMPTY;

        if(TOKEN(tctx)->type == TOKEN_DOT) {
            TOKEN_NEXT(tctx);

            ERR_Z(new = quote_expr(env, tctx, is_quasi), goto exit);

            TOKEN_MATCH(tctx, TOKEN_RP,
                        value_destroy(new);
                        goto exit);

            value_destroy(*rightmost); // destroy the copied nil
            *rightmost = new;
            break;
        }

        ERR_Z(new = quote_expr(env, tctx, is_quasi),
              goto exit);

        value_t new_cons = VALUE_EMPTY;
        struct cons cons = {new, *rightmost};
        ERR_Z(new_cons = value_create(VALUE_CONS, &cons),
              value_destroy(new);
              goto exit);

        *rightmost = new_cons;
        rightmost = &vvalue_cons(new_cons).right;

        TOKEN_NEXT(tctx);
    }

    struct cons cons = {value_copy(left), value_copy(right)};
    ret = value_create(VALUE_CONS, &cons);
exit:
    value_destroy(left);
    value_destroy(right);
    return ret;
}


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[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)) {
            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--;

        // printf("%zu\n", depth);
        // print_token(TOKEN(tctx));

        if(toklist)
            token_clone(&tokens[tokens_len++], 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);
    }

    return 0;
}

#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(vvalue_type(value)) {
    case VALUE_ATOM:
        // fix me
        if(strcmp(vvalue_atom(value), "lambda") == 0) {
            SET_TOKEN_TYPE(&token, TOKEN_LAMBDA);
            break;
        } else if(strcmp(vvalue_atom(value), "if") == 0) {
            SET_TOKEN_TYPE(&token, TOKEN_IF);
            break;
        } else if(strcmp(vvalue_atom(value), "quote") == 0) {
            SET_TOKEN_TYPE(&token, TOKEN_QUOTE_FORM);
            break;
        } else if(strcmp(vvalue_atom(value), "'") == 0) {
            SET_TOKEN_TYPE(&token, TOKEN_QUOTE);
            break;
        }

        SET_TOKEN_TYPE(&token, TOKEN_ID);
        SET_TOKEN_VALUE(&token, id,
                        str_alloc_copy(vvalue_atom(value)));
        break;
    case VALUE_STR:
        SET_TOKEN_TYPE(&token, TOKEN_STR);
        SET_TOKEN_VALUE(&token, str,
                        str_alloc_copy(vvalue_atom(value)));
        break;
    case VALUE_INT:
        SET_TOKEN_TYPE(&token, TOKEN_INT);
        SET_TOKEN_VALUE(&token, num, vvalue_num(value));
        break;
    case VALUE_CONS:
        return cons_to_toklist(value);
    default:
        err("Cant turn '%s' to a token", value_type_string[vvalue_type(value)]);
        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 = vvalue_cons(value).left;
        value = vvalue_cons(value).right;

        struct toklist *new = NULL;
        ERR_Z(new = value_to_toklist(left), goto fail);
        ADD_TOKLIST(tail, new);

        if(vvalue_type(value) == VALUE_NIL) break;
        if(vvalue_type(value) != 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:
    err("Failed to turn value to toklist");
    toklist_destroy(list_entry(list_get_head(tail), struct toklist, list));
    return NULL;
}