#ifndef INCLUDED_LISP_H
#define INCLUDED_LISP_H

#include <setjmp.h>
#include <stdarg.h>
#include <stdbool.h>
#include <stddef.h>
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#include <stdnoreturn.h>

#if __has_attribute(format)
#    define PRINTF_FORMAT(first, second) \
        __attribute__((format(printf, first, second)))
#else
#    define PRINTF_FORMAT(first, second)
#endif

// ####################
// # Basic Structures #
// ####################
typedef enum {
    TYPE_STRING,
    TYPE_SYMBOL,
    TYPE_PAIR,
    TYPE_INTEGER,
    TYPE_FLOAT,
    TYPE_VECTOR,
    TYPE_FUNCTION,
    TYPE_HASHTABLE,
    N_LISP_TYPES,
} LispType;

struct _TypeNameEntry {
    const char *name;
    size_t len;
};
extern struct _TypeNameEntry LISP_TYPE_NAMES[N_LISP_TYPES];

#define LISP_OBJECT_HEADER \
    LispType type;         \
    ptrdiff_t ref_count;

typedef struct {
    LISP_OBJECT_HEADER;
} LispVal;

typedef struct {
    LISP_OBJECT_HEADER;

    char *data;
    size_t length;
    bool is_static;
} LispString;

typedef struct {
    LISP_OBJECT_HEADER;

    LispString *name;
    LispVal *plist;
    LispVal *function;
    LispVal *value;
    bool is_constant;
} LispSymbol;

typedef struct {
    LISP_OBJECT_HEADER;

    LispVal *head;
    LispVal *tail;
} LispPair;

typedef struct {
    LISP_OBJECT_HEADER;

    int64_t value;
} LispInteger;

typedef struct {
    LISP_OBJECT_HEADER;

    long double value;
} LispFloat;

typedef struct {
    LISP_OBJECT_HEADER;

    LispVal **data;
    size_t length;
} LispVector;

typedef struct {
    LISP_OBJECT_HEADER;

    LispVal *doc;
    LispVal *args;
    bool is_builtin;
    bool is_macro;

    size_t n_req;
    LispVal *rargs;
    size_t n_opt;
    LispVal *oargs;
    LispVal *kwargs; // hash table
    bool allow_other_keys;
    LispVal *rest_arg;
    union {
        void *builtin;
        LispVal *body;
    };

    LispVal *lexenv;
} LispFunction;

struct HashtableBucket {
    struct HashtableBucket *next;
    uint64_t hash;
    LispVal *key;
    LispVal *value;
};

#define LISP_HASHTABLE_INITIAL_SIZE     32
#define LISP_HASHTABLE_GROWTH_FACTOR    2
#define LISP_HASHTABLE_GROWTH_THRESHOLD 0.75f
#define LISP_HASHTABLE_SHRINK_THRESHOLD 0.25f

typedef struct {
    LISP_OBJECT_HEADER;

    struct HashtableBucket **data;
    size_t table_size;
    size_t count;
    LispVal *eq_fn;
    LispVal *hash_fn;
} LispHashtable;

// #######################
// # nil, unbound, and t #
// #######################
#define LISPVAL(obj) ((LispVal *) (obj))

extern LispSymbol _Qnil;
extern LispSymbol _Qunbound; // don't intern!
extern LispSymbol _Qt;

#define Qnil     (LISPVAL(&_Qnil))
#define Qunbound (LISPVAL(&_Qunbound))
#define Qt       (LISPVAL(&_Qt))

#define LISP_BOOL(v) ((v) ? Qt : Qnil)

// ###################
// # Type predicates #
// ###################
#define STATICP(v) (LISPVAL(v)->ref_count < 0)
#define TYPEOF(v)  (LISPVAL(v)->type)

// only use on symbols!
#define VALUE_CONSTANTP(v) (((LispSymbol *) (v))->is_constant)

#define NILP(v)       (((void *) (v)) == (void *) Qnil)
#define STRINGP(v)    (TYPEOF(v) == TYPE_STRING)
#define SYMBOLP(v)    (TYPEOF(v) == TYPE_SYMBOL)
#define PAIRP(v)      (TYPEOF(v) == TYPE_PAIR)
#define INTEGERP(v)   (TYPEOF(v) == TYPE_INTEGER)
#define FLOATP(v)     (TYPEOF(v) == TYPE_FLOAT)
#define VECTORP(v)    (TYPEOF(v) == TYPE_VECTOR)
#define FUNCTIONP(v)  (TYPEOF(v) == TYPE_FUNCTION)
#define HASHTABLEP(v) (TYPEOF(v) == TYPE_HASHTABLE)

#define ATOM(v) (TYPEOF(v) != TYPE_PAIR)

inline static bool KEYWORDP(LispVal *v) {
    return SYMBOLP(v) && ((LispSymbol *) v)->name->length
           && ((LispSymbol *) v)->name->data[0] == ':';
}

inline static bool LISTP(LispVal *v) {
    return NILP(v) || PAIRP(v);
}

inline static bool NUMBERP(LispVal *v) {
    return INTEGERP(v) || FLOATP(v);
}

// ##################################
// # Macros for static declarations #
// ##################################
#define DEF_STATIC_STRING(name, value) \
    static LispString name = {         \
        .type = TYPE_STRING,           \
        .ref_count = -1,               \
        .data = value,                 \
        .length = sizeof(value) - 1,   \
        .is_static = true,             \
    };
#define DEF_STATIC_SYMBOL(c_name, lisp_name)         \
    DEF_STATIC_STRING(_Q##c_name##_name, lisp_name); \
    static LispSymbol _Q##c_name = {                 \
        .type = TYPE_SYMBOL,                         \
        .ref_count = -1,                             \
        .name = &_Q##c_name##_name,                  \
        .plist = Qnil,                               \
        .function = Qunbound,                        \
        .value = Qunbound,                           \
        .is_constant = false,                        \
    };                                               \
    LispVal *Q##c_name = LISPVAL(&_Q##c_name);
#define DECLARE_FUNCTION(c_name, args) \
    LispVal *F##c_name args;           \
    extern LispVal *Q##c_name;
// The args and doc fields are filled when the function is registered
#define _INTERNAL_DEFUN_EXTENDED(macrop, c_name, lisp_name, c_args) \
    LispVal *F##c_name c_args;                                      \
    DEF_STATIC_STRING(_Q##c_name##_name, lisp_name);                \
    static LispFunction _Q##c_name##_function = {                   \
        .type = TYPE_FUNCTION,                                      \
        .ref_count = -1,                                            \
        .is_builtin = true,                                         \
        .is_macro = macrop,                                         \
        .builtin = &F##c_name,                                      \
        .doc = Qnil,                                                \
        .args = Qnil,                                               \
        .rargs = Qnil,                                              \
        .oargs = Qnil,                                              \
        .rest_arg = Qnil,                                           \
        .kwargs = Qnil,                                             \
        .lexenv = Qnil,                                             \
    };                                                              \
    static LispSymbol _Q##c_name = {                                \
        .type = TYPE_SYMBOL,                                        \
        .ref_count = -1,                                            \
        .name = &_Q##c_name##_name,                                 \
        .plist = Qnil,                                              \
        .value = Qunbound,                                          \
        .function = LISPVAL(&_Q##c_name##_function),                \
        .is_constant = false,                                       \
    };                                                              \
    LispVal *Q##c_name = (LispVal *) &_Q##c_name;                   \
    LispVal *F##c_name c_args
#define DEFUN(c_name, lisp_name, c_args) \
    _INTERNAL_DEFUN_EXTENDED(false, c_name, lisp_name, c_args)
#define DEFMACRO(c_name, lisp_name, c_args) \
    _INTERNAL_DEFUN_EXTENDED(true, c_name, lisp_name, c_args)

// ###############
// # Loop macros #
// ###############
#define HASHTABLE_FOREACH(key_var, val_var, table, body)                    \
    {                                                                       \
        LispHashtable *__hashtable_foreach_table = (LispHashtable *) table; \
        for (size_t __hashtable_foreach_i = 0;                              \
             __hashtable_foreach_i < __hashtable_foreach_table->count;      \
             ++__hashtable_foreach_i) {                                     \
            struct HashtableBucket *__hashtable_foreach_cur =               \
                __hashtable_foreach_table->data[__hashtable_foreach_i];     \
            while (__hashtable_foreach_cur) {                               \
                LispVal *key_var = __hashtable_foreach_cur->key;            \
                LispVal *val_var = __hashtable_foreach_cur->value;          \
                {body};                                                     \
                __hashtable_foreach_cur = __hashtable_foreach_cur->next;    \
            }                                                               \
        }                                                                   \
    }
#define FOREACH(var, list)                                  \
    for (LispVal *__foreach_cur = list, *var = Fhead(list); \
         !NILP(__foreach_cur);                              \
         __foreach_cur = Ftail(__foreach_cur), var = Fhead(__foreach_cur))
#define FOREACH_TAIL(var, list) \
    for (LispVal *var = list; !NILP(var); var = Ftail(var))

// #############################
// # Allocation and references #
// #############################
void *lisp_malloc(size_t size);
void *lisp_realloc(void *old_ptr, size_t size);
#define lisp_free free

inline static void *lisp_ref(void *val) {
    if (!STATICP(val)) {
        ++((LispVal *) val)->ref_count;
    }
    return val;
}

inline static void *lisp_float_ref(void *val) {
    if (LISPVAL(val)->ref_count > 0) {
        --LISPVAL(val)->ref_count;
    }
    return val;
}

void _internal_lisp_delete_object(LispVal *val);
inline static void *lisp_unref(void *val) {
    if (STATICP(val)) {
        return val;
    } else if (LISPVAL(val)->ref_count > 1) {
        --LISPVAL(val)->ref_count;
        return val;
    } else {
        _internal_lisp_delete_object(val);
        return Qnil;
    }
}
#define UNREF_INPLACE(variable)          \
    {                                    \
        variable = lisp_unref(variable); \
    }
inline static void lisp_unref_double_ptr(void **val) {
    lisp_unref(*val);
}
#define IGNORE_REF(val) (lisp_unref(lisp_ref(val)))

// ################
// # Constructors #
// ################
LispVal *make_lisp_string(const char *data, size_t length, bool take,
                          bool is_static);
#define STATIC_STRING(s) (make_lisp_string((s), sizeof(s) - 1, true, true))
LispVal *sprintf_lisp(const char *format, ...) PRINTF_FORMAT(1, 2);
LispVal *make_lisp_symbol(LispVal *name);
LispVal *make_lisp_pair(LispVal *head, LispVal *tail);
LispVal *make_lisp_integer(intmax_t value);
LispVal *make_lisp_float(long double value);
LispVal *make_lisp_vector(LispVal **data, size_t length);
void set_function_args(LispFunction *func, LispVal *args);
LispVal *make_lisp_function(LispVal *args, LispVal *doc, LispVal *lexenv,
                            LispVal *body, bool is_macro);
LispVal *make_lisp_hashtable(LispVal *eq_fn, LispVal *hash_fn);

// ########################
// # Utility and internal #
// ########################
bool strings_equal_nocase(const char *s1, const char *s2, size_t n);

DECLARE_FUNCTION(type_of, (LispVal * obj));
DECLARE_FUNCTION(pair, (LispVal * head, LispVal *tail));
DECLARE_FUNCTION(hash_string, (LispVal * obj));
DECLARE_FUNCTION(strings_equal, (LispVal * obj1, LispVal *obj2));
DECLARE_FUNCTION(id, (LispVal * obj));
DECLARE_FUNCTION(eq, (LispVal * obj1, LispVal *obj2));
DECLARE_FUNCTION(puthash, (LispVal * table, LispVal *key, LispVal *value));
DECLARE_FUNCTION(gethash, (LispVal * table, LispVal *key, LispVal *def));
DECLARE_FUNCTION(remhash, (LispVal * table, LispVal *key));
DECLARE_FUNCTION(hash_table_count, (LispVal * table));
LispVal *intern(const char *name, size_t length, bool take);
DECLARE_FUNCTION(intern, (LispVal * name));
#define INTERN_STATIC(name) (Fintern(STATIC_STRING(name)))

DECLARE_FUNCTION(sethead, (LispVal * pair, LispVal *head));
DECLARE_FUNCTION(settail, (LispVal * pair, LispVal *tail));
size_t list_length(LispVal *obj);
static inline LispVal *const_list(int len, ...) {
    LispVal *list = Qnil;
    LispVal *end;
    va_list args;
    va_start(args, len);
    while (len--) {
        LispVal *elt = va_arg(args, LispVal *);
        if (NILP(list)) {
            list = Fpair(elt, Qnil);
            end = list;
        } else {
            LispVal *new_end = Fpair(elt, Qnil);
            Fsettail(end, new_end);
            end = new_end;
        }
    }
    va_end(args);
    return list;
}
static inline LispVal *make_list(size_t len, LispVal **vals) {
    LispVal *list = Qnil;
    LispVal *end;
    for (size_t i = 0; i < len; ++i) {
        if (NILP(list)) {
            list = Fpair(vals[i], Qnil);
            end = list;
        } else {
            LispVal *new_end = Fpair(vals[i], Qnil);
            Fsettail(end, new_end);
            end = new_end;
        }
    }
    return list;
}
typedef void (*lisp_cleanup_func_t)(void *);
struct CleanupHandlerEntry {
    struct CleanupHandlerEntry *next;
    lisp_cleanup_func_t fun;
    void *data;
};
typedef struct StackFrame {
    struct StackFrame *next;
    bool hidden;
    LispSymbol *name;
    LispVal *detail; // function arguments
    LispVal *lexenv; // symbol -> value
    bool enable_handlers;
    LispVal *handlers; // symbol -> (error-var form)
    LispVal *unwind_forms;
    struct CleanupHandlerEntry *cleanup_handlers;

    jmp_buf start;
} StackFrame;

extern StackFrame *the_stack;
extern LispVal *Qtoplevel;
extern LispVal *Qparent_lexenv;

void stack_enter(LispVal *name, LispVal *detail, bool inherit);
void stack_leave(void);
void *register_cleanup(lisp_cleanup_func_t fun, void *data);
void free_double_ptr(void *ptr);
struct UnrefListData {
    LispVal **vals;
    size_t len;
};
void unref_free_list_double_ptr(void *ptr);
void cancel_cleanup(void *handle);
#define WITH_PUSH_FRAME(name, detail, inherit, body) \
    stack_enter(name, detail, inherit);              \
    if (setjmp(the_stack->start) == 0) {             \
        body                                         \
    }                                                \
    stack_leave();
#define WITH_CLEANUP(var, body)                                     \
    lisp_ref(var);                                                  \
    {                                                               \
        void *__with_cleanup_cleanup = register_cleanup(            \
            (lisp_cleanup_func_t) & lisp_unref_double_ptr, &(var)); \
        {body};                                                     \
        cancel_cleanup(__with_cleanup_cleanup);                     \
        lisp_unref(var);                                            \
    }

DECLARE_FUNCTION(backtrace, ());
noreturn DECLARE_FUNCTION(throw, (LispVal * signal, LispVal *rest));

extern LispVal *Qshutdown_signal;
extern LispVal *Qtype_error;
extern LispVal *Qread_error;
extern LispVal *Qeof_error;
extern LispVal *Qvoid_variable_error;
extern LispVal *Qvoid_function_error;
extern LispVal *Qcircular_error;
extern LispVal *Qmalformed_lambda_list_error;
extern LispVal *Qargument_error;

#define CHECK_TYPE(type, val)      \
    if (TYPEOF(val) != type) {     \
        Fthrow(Qtype_error, Qnil); \
    }

extern LispVal *Vobarray;

#define REGISTER_SYMBOL(sym) \
    Fputhash(Vobarray, LISPVAL(((LispSymbol *) Q##sym)->name), Q##sym)
#define REGISTER_STATIC_FUNCTION(obj, args, docstr)            \
    ((LispFunction *) (obj))->doc = STATIC_STRING(docstr);     \
    {                                                          \
        LispVal *src = STATIC_STRING(args);                    \
        lisp_ref(src);                                         \
        set_function_args((LispFunction *) (obj), Fread(src)); \
        lisp_unref(src);                                       \
    }
#define REGISTER_FUNCTION(fn, args, docstr) \
    REGISTER_SYMBOL(fn);                    \
    REGISTER_STATIC_FUNCTION(((LispSymbol *) Q##fn)->function, args, docstr);

void lisp_init(void);
void lisp_shutdown(void);
void register_static_function(LispVal *func);

extern LispVal *Qbackquote;
extern LispVal *Qcomma;
DECLARE_FUNCTION(quote, (LispVal * form));

DECLARE_FUNCTION(symbol_function, (LispVal * symbol, LispVal *resolve));
DECLARE_FUNCTION(symbol_value, (LispVal * symbol));
DECLARE_FUNCTION(eval_in_env, (LispVal * form, LispVal *lexenv));
DECLARE_FUNCTION(eval, (LispVal * form));
DECLARE_FUNCTION(funcall, (LispVal * function, LispVal *rest));
DECLARE_FUNCTION(apply, (LispVal * function, LispVal *rest));
DECLARE_FUNCTION(head, (LispVal * list));
DECLARE_FUNCTION(tail, (LispVal * list));
noreturn DECLARE_FUNCTION(exit, (LispVal * code));
DECLARE_FUNCTION(print, (LispVal * obj));
DECLARE_FUNCTION(println, (LispVal * obj));
DECLARE_FUNCTION(not, (LispVal * obj));
DECLARE_FUNCTION(when, (LispVal * cond, LispVal *t));
DECLARE_FUNCTION(if, (LispVal * cond, LispVal *t, LispVal *nil));
DECLARE_FUNCTION(add, (LispVal * n1, LispVal *n2));
DECLARE_FUNCTION(setq, (LispVal * name, LispVal *value));
DECLARE_FUNCTION(progn, (LispVal * forms));
DECLARE_FUNCTION(fset, (LispVal * sym, LispVal *new_func));
DECLARE_FUNCTION(defun, (LispVal * name, LispVal *args, LispVal *body));

void debug_dump(FILE *stream, void *obj, bool newline);
void debug_print_hashtable(FILE *stream, LispVal *table);
extern LispVal *Qopt;
extern LispVal *Qkey;
extern LispVal *Qallow_other_keys;
extern LispVal *Qrest;

#endif