#pragma once

#include "platform.h"

typedef struct sl_builtin sl_builtin;
typedef struct sl_cons sl_cons;
typedef struct sl_cbuiltin sl_cbuiltin;
typedef struct sl_cv sl_cv;
typedef struct sl_cvtable sl_cvtable;
typedef struct sl_fn sl_fn;
typedef struct sl_sym sl_sym;
typedef struct sl_type sl_type;

typedef struct sl_proc sl_proc;
typedef struct sl_vm sl_vm;

typedef uintptr sl_v;

typedef void (*sl_cvinitfn)(const sl_type *, sl_v, void *);
typedef sl_v (*sl_builtinfn)(sl_v *, int);

enum {
	TAG_FIXNUM,
	TAG_ESPECIAL,
	TAG_FN,
	TAG_VEC,
	TAG_UNBOXED,
	TAG_CVALUE,
	TAG_SYM,
	TAG_CONS,

	TAG_BITS = 3,
	TAG_MASK = (1<<TAG_BITS)-1,
	TAG_EXT_BITS = 8,
	TAG_EXT_MASK = (1<<TAG_EXT_BITS)-1,

	/* those were set to 7 and 3 strategically on purpose */
	TAG_NONLEAF_MASK = TAG_CONS & TAG_VEC,
};

#define tag(v) ((v) & TAG_MASK)
#define tagext(v) ((v) & TAG_EXT_MASK)

#define isfixnum(v) (tag(v) == TAG_FIXNUM)
#define isespecial(v) (tag(v) == TAG_ESPECIAL)
#define isfn(v) (tag(v) == TAG_FN || iscbuiltin(v))
#define isvec(v) (tag(v) == TAG_VEC)
#define isunboxed(v) (tag(v) == TAG_UNBOXED)
#define iscvalue(v) (tag(v) == TAG_CVALUE)
#define issym(v) (tag(v) == TAG_SYM)
#define iscons(v) (tag(v) == TAG_CONS)

enum {
	FLAG_CONST = 1<<0,
	FLAG_KEYWORD = 1<<1,
	FLAG_GENSYM = 1<<2,
};

typedef enum {
	T_S8, T_U8,
	T_S16, T_U16,
	T_S32, T_U32,
	T_P32,
	T_S64, T_U64,
	T_P64,
	T_UNBOXED_NUM,
	T_BIG = T_UNBOXED_NUM, // always a cvalue
	T_F32, T_F64,

	T_NONNUMERIC,
}sl_numtype;

#if defined(BITS64)
typedef s64int sl_fx;
#else
typedef s32int sl_fx;
#endif

struct sl_cons {
	sl_v car;
	sl_v cdr;
}sl_aligned(8);

struct sl_sym {
	const sl_type *type;
	sl_v binding;
	const char *name;
	union {
		u32int hash;
		u32int id; // gensym
	};
	u8int flags;
	u8int numtype;
	u8int size;
}sl_aligned(8);

struct sl_builtin {
	const char *name;
	int nargs;
};

#define fits_bits(x, b) (((x)>>(b-1)) == 0 || (~((x)>>(b-1))) == 0)
#define fits_fixnum(x) fits_bits((x), FIXNUM_BITS)

#define valid_numtype(v) ((v) < T_NONNUMERIC)
#define ptr(typ, v) ((typ*)((uintptr)(v) & (~(uintptr)TAG_MASK)))
#define tagptr(p, t) ((sl_v)(p) + t)
#define fixnum(v) ((sl_v)(v)<<TAG_BITS)
#define numval(v) ((sl_fx)(v)>>TAG_BITS)
#define u32numval(v) ((u32int)(v)>>TAG_BITS)
#define ubnumval(v) ((sl_fx)(v)>>TAG_EXT_BITS)
#define builtin(v) tagptr(((sl_v)(v)<<TAG_BITS), TAG_FN)
#define bothfixnums(x, y) (isfixnum(x) && isfixnum(y))
#define isinlined(cv) ((cv)->data == cv_space(cv))

#define mk_rune(r) (((sl_v)(r))<<TAG_EXT_BITS | 0xfc)
#define sl_isrune(v) (((v) & 0xff) == 0xfc)
#define torune(v) ((v)>>8)

// allocate n consecutive conses
#define cons_reserve(n) tagptr(alloc_words((n)*2), TAG_CONS)

#if defined(FWD_BIT)
#define isforwarded(v) \
	((*ptr(sl_v, (v)) & FWD_BIT) && !isfixnum(*ptr(sl_v, (v))) && !isunboxed(*ptr(sl_v, (v))))
#define forwardloc(v) (*ptr(sl_v, (v)) ^ FWD_BIT)
#define forward(v, to) do{ *ptr(sl_v, (v)) = (sl_v)(to) | FWD_BIT; }while(0)
#else
#define isforwarded(v) (ptr(sl_v, (v))[0] == sl_unbound)
#define forwardloc(v) (ptr(sl_v, (v))[1])
#define forward(v, to) \
	do{ ptr(sl_v, (v))[0] = sl_unbound; ptr(sl_v, (v))[1] = (sl_v)(to); }while(0)
#endif

enum {
	VEC_VEC,
	VEC_STRUCT,
	VEC_TYPE_MASK = 3,
	VEC_GROWN = 1<<2,
};

#define vec_elt(v, i) (ptr(sl_v, (v))[1+(i)])
#define vec_size(v) numval(vec_elt((v), -1))
#define vec_setsize(v, n, type) do{ vec_elt((v), -1) = fixnum(n) | (type); }while(0)
#define vec_type(v) (vec_elt((v), -1) & VEC_TYPE_MASK)
#define isstruct(v) (vec_type(v) == VEC_STRUCT)

// supplied and non-NIL
#define nonnil(v) ((v) != sl_unbound && (v) != sl_nil)

// functions ending in _ are unsafe, faster versions
#define car_(v) (ptr(sl_cons, (v))->car)
#define cdr_(v) (ptr(sl_cons, (v))->cdr)
#define car(v) (tocons(v)->car)
#define cdr(v) (tocons(v)->cdr)

// utility for iterating over all arguments in a builtin
// i=index, i0=start index, arg = var for each arg, args = arg array
// assumes "nargs" is the argument count
#define FOR_ARGS(i, i0, arg, args) for(i=i0; i<nargs && ((arg=args[i]) || 1); i++)

#define N_BUILTINS ((int)N_OPCODES)

#define sym_value(s) (ptr(sl_sym, (s))->binding)
#define sym_numtype(s) (ptr(sl_sym, (s))->numtype)
#define set(s, v) (sym_value(s) = (v))
#define setc(s, v) \
	do{ \
		sl_sym *sy = ptr(sl_sym, (s)); \
		sy->flags |= FLAG_CONST; \
		sy->binding = (v); \
	}while(0)
#define isconst(s) ((s)->flags & FLAG_CONST)
#define ismanaged(v) (ptr(u8int, (v)) >= slvm.fromspace && ptr(u8int, (v)) < slvm.fromspace+slvm.heapsize)
#define isgensym(v)  (issym(v) && (ptr(sl_sym, (v))->flags & FLAG_GENSYM))
#define iskeysym(v)  (issym(v) && (ptr(sl_sym, (v))->flags & FLAG_KEYWORD))
#define iscbuiltin(v) (iscvalue(v) && cvalue_class(v) == sl_builtintype)
#define isfnbuiltin(v) ((sl_v)(v) < builtin(N_BUILTINS))

#define PUSH(v) do{ \
	*sl.sp++ = (sl_v)(v); \
}while(0)

#define stack_for(n) do{ \
	while(sl.sp+(n) >= sl.stackend) \
		sl_stack_grow(0); \
}while(0)

#define PUSH_SAFE(v) do{ \
	if(sl.sp >= sl.stackend) \
		sl_stack_grow(0); \
	PUSH(v); \
}while(0)

#if defined(NDEBUG)
#define POPN(n) do{ sl.sp -= (n); }while(0)
#define POP() (*(--sl.sp))
#else
#define POPN(n) do{ \
	int __nn = (n); \
	sl.sp -= __nn; \
	for(int __i = 0; __i < __nn; __i++) \
		sl.sp[__i] = sl_unbound; \
}while(0)
#define POP() (sl.sp[0] = sl_unbound, *(--sl.sp))
#endif

bool isbuiltin(sl_v v) sl_constfn sl_hotfn;

/* memory */
sl_v sl_relocate(sl_v v) sl_hotfn;
void sl_gc(bool mustgrow);
void sl_gc_handle(sl_v *pv) sl_nonnull(1);
void sl_free_gc_handles(int n);
void sl_stack_grow(int dummy);

/* symbol table */
sl_v mk_gensym(void);
sl_v mk_sym(const char *str, bool copy) sl_hotfn sl_nonnull(1) sl_cstr(1);
sl_v mk_csym_(const char *str, int len) sl_nonnull(1) sl_cstr(1) sl_rd(1, 2);
#define mk_csym(str) mk_csym_(str, sizeof(str)-1)
const char *sym_name(sl_v v) sl_returns_nonnull;

/* read, eval, print main entry points */
sl_v sl_toplevel_eval(sl_v expr);
sl_v sl_apply(sl_v f, sl_v l);
sl_v sl_applyn(int n, sl_v f, ...);

/* object model manipulation */
sl_v mk_cons(sl_v a, sl_v b);
sl_v mk_list2(sl_v a, sl_v b);
sl_v mk_listn(int n, ...);
bool sl_isnum(sl_v v) sl_purefn;
sl_v alloc_vec(usize n, bool init);

/* consistent iswprint and wcwidth */
int sl_iswprint(Rune c) sl_constfn;
int sl_wcwidth(Rune c) sl_constfn;
int sl_wcwidth_vs16(Rune c) sl_constfn;

/* safe casts */
sl_cons *tocons(sl_v v) sl_purefn sl_returns_nonnull;
sl_sym *tosym(sl_v v) sl_purefn sl_returns_nonnull;
sl_fx tofixnum(sl_v v) sl_purefn;
char *tostr(sl_v v) sl_purefn sl_returns_nonnull;
double todouble(sl_v a) sl_purefn;

/* conses */
sl_v alloc_cons(void) sl_hotfn;
void *alloc_words(usize n) sl_hotfn sl_returns_nonnull sl_alloc;

/* error handling */
_Noreturn void sl_error(sl_v e, const char *format, ...) sl_printfmt(2, 3);
_Noreturn void sl_raise(sl_v e);
_Noreturn void sl_type_error(const char *what, const char *expected, sl_v got) sl_nonnull(2) sl_cstr(1) sl_cstr(2);
_Noreturn void sl_bounds_error(sl_v arr, sl_v ind);
_Noreturn void sl_const_error(sl_v sym);
_Noreturn void sl_unbound_error(sl_v sym);
_Noreturn void sl_arity_error(int nargs, int c, sl_v r);
_Noreturn void sl_divide_by_0_error(void);

#define bthrow(stmt) do{ sys_setcurrpc(0); sl_##stmt; }while(1)
#define cthrow(stmt, a) do{ sys_setcallpc(a); sl_##stmt; }while(1)

#define argcount(c) \
	do{ \
		if((c) == 0) \
			USED(args); \
		if(sl_unlikely(nargs != (c))) \
			bthrow(arity_error(nargs, (c), sl_nil)); \
	}while(0)
#define argcount_least(c) \
	do{ \
		if(sl_unlikely(nargs < (c))) \
			bthrow(arity_error(nargs, (c), sl_minsym)); \
	}while(0)
#define argcount_most(c) \
	do{ \
		if(sl_unlikely(nargs > (c))) \
			bthrow(arity_error(nargs, (c), sl_maxsym)); \
	}while(0)
#define noargs() argcount(0)

typedef struct ios ios;

struct sl_cvtable {
	void (*print)(sl_v self);
	void (*relocate)(sl_v oldv, sl_v newv);
	void (*finalize)(sl_v self); // always non-nil
	void (*print_traverse)(sl_v self);
	sl_v (*bounded_compare)(sl_v a, sl_v b, int bound, bool eq);
};

struct sl_type {
	sl_v type;
	sl_cvtable *vtable;
	const sl_type *eltype;  // for arrays
	const sl_type *artype;  // (arr this)
	sl_cvinitfn init;
	usize size;
	usize elsz;
	sl_numtype numtype;
};

// has to be same as sl_cv (almost)
struct sl_cbuiltin {
	const sl_type *type;
	union {
		void *data;
		sl_builtinfn cbuiltin;
	};
	usize len;
};

struct sl_cv {
	const sl_type *type;
	union {
		void *data;
		sl_builtinfn cbuiltin;
	};
	usize len; // length of *data in bytes
	// inline data follows here
	union {
		u8int _space;
		struct {
			// only for non-inlined strings
			u32int startbytes;
			u32int startrune;
		};
	};
}sl_aligned(8);

struct sl_fn {
	sl_v vals;
	sl_v bcode;
	sl_v env;
	sl_v name;
	usize maxstack;
}sl_aligned(8);

#define cv_class(cv) ((const sl_type*)((uintptr)(cv)->type&~(uintptr)TAG_MASK))
#define cv_data(cv) ((cv)->data)
#define cv_len(cv) ((cv)->len)
#define cv_type(cv) (cv_class(cv)->type)
#define cv_numtype(cv) (cv_class(cv)->numtype)
#define cv_isstr(cv) (cv_class(cv)->eltype == sl_utf8type)
#define cv_isPOD(cv) (cv_class(cv)->init != nil && cv_numtype(cv) != T_BIG)
#define cv_space(cv) ((u8int*)(cv)+sl_offsetof(sl_cv, _space))

#define cvalue_data(v) cv_data(ptr(sl_cv, (v)))
#define cvalue_len(v) cv_len(ptr(sl_cv, (v)))
#define cvalue_numtype(v) cv_numtype(ptr(sl_cv, (v)))
#define cvalue_class(v) cv_class(ptr(sl_cv, (v)))
#define value2c(type, v) ((type)cvalue_data(v))

#define isbignum(v) (iscvalue(v) && cv_numtype(ptr(sl_cv, (v))) == T_BIG)
#define tobignum(v) (*(mpint**)cvalue_data(v))

#include "opcodes.h"

#define especial(x) (tagptr(((sl_v)x<<TAG_BITS), TAG_ESPECIAL))
enum {
	sl_unbound = especial(0),
	sl_nil = especial(1),
	sl_t = especial(2),
	sl_void = especial(3),
	sl_eof = especial(4),
};
#undef especial

#if 0
// FIXME(sigrid): stays disabled until it becomes useful
extern sl_thread(sl_proc *slp);
extern sl_thread(sl_vm *slvmp);
#else
extern sl_proc *slp;
extern sl_vm *slvmp;
#endif

#define sl (*slp)
#define slvm (*slvmp)

extern sl_v sl_builtinssym, sl_quote, sl_lambda, sl_comma, sl_commaat;
extern sl_v sl_commadot, sl_trycatch, sl_backquote;
extern sl_v sl_conssym, sl_symsym, sl_fixnumsym, sl_vecsym, sl_vu8sym;
extern sl_v sl_defsym, sl_defmacrosym, sl_forsym, sl_setqsym, sl_listsym;
extern sl_v sl_boolsym, sl_nullsym, sl_evalsym, sl_fnsym, sl_trimsym, sl_strsym;
extern sl_v sl_errio, sl_errparse, sl_errtype, sl_errarg, sl_errmem, sl_errconst;
extern sl_v sl_errdiv0, sl_errbounds, sl_err, sl_errkey, sl_errunbound, sl_erroom;
extern sl_v sl_emptyvec, sl_emptystr;

extern sl_v sl_tablesym, sl_arrsym;
extern sl_v sl_s8sym, sl_u8sym, sl_s16sym, sl_u16sym, sl_s32sym, sl_u32sym;
extern sl_v sl_s64sym, sl_u64sym, sl_p32sym, sl_p64sym, sl_ptrsym, sl_bignumsym;
extern sl_v sl_utf8sym, sl_runesym, sl_f32sym, sl_f64sym, sl_vecstructsym, sl_structsym;
extern sl_v sl_minsym, sl_maxsym, sl_extrasym;

extern const sl_type *sl_bignumtype, *sl_builtintype;
extern const sl_type *sl_s8type, *sl_u8type;
extern const sl_type *sl_s16type, *sl_u16type;
extern const sl_type *sl_s32type, *sl_u32type;
extern const sl_type *sl_s64type, *sl_u64type;
extern const sl_type *sl_p32type, *sl_p64type;
extern const sl_type *sl_f32type, *sl_f64type;
extern const sl_type *sl_utf8type, *sl_runetype;
extern const sl_type *sl_strtype, *sl_runestrtype;