#pragma once

#include "platform.h"
#include "utf8.h"
#include "ios.h"
#include "tbl.h"
#include "bitvector.h"
#include "htable_h.h"
HTPROT(ptrhash)

typedef struct sl_exctx sl_exctx;
typedef struct sl_builtin sl_builtin;
typedef struct sl_cons sl_cons;
typedef struct sl_cv sl_cv;
typedef struct sl_cvtable sl_cvtable;
typedef struct sl_fn sl_fn;
typedef struct sl_gensym sl_gensym;
typedef struct sl_readstate sl_readstate;
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)(sl_type *, sl_v, void *);
typedef sl_v (*sl_builtinfn)(sl_v *, int);

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

	TAG_BITS = 3,
	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,
};

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

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_F32, T_F64,

	// always a cvalue
	T_BIG = T_UNBOXED_NUM,
}sl_numtype;

#define is_nt_sint(nt) ((1<<(nt)) & (1<<T_S8 | 1<<T_S16 | 1<<T_S32 | 1<<T_S64))
#define is_nt_uint(nt) ((1<<(nt)) & (1<<T_U8 | 1<<T_U16 | 1<<T_U32 | 1<<T_U64 | 1<<T_P32 | 1<<T_P64))

#if defined(BITS64)
typedef s64int sl_fx;
#define FIXNUM_BITS (64-TAG_BITS)
#define UNBOXED_BITS (64-TAG_EXT_BITS)
#define TOP_BIT (1ULL<<63)
#define T_FIXNUM T_S64
#define PRIdFIXNUM PRId64
#else
typedef s32int sl_fx;
#define FIXNUM_BITS (32-TAG_BITS)
#define UNBOXED_BITS (32-TAG_EXT_BITS)
#define TOP_BIT (1U<<31)
#define T_FIXNUM T_S32
#define PRIdFIXNUM PRId32
#endif

#define FIXNUM_MAX (sl_fx)(+((sl_v)1<<(FIXNUM_BITS-1))-1)
#define FIXNUM_MIN (sl_fx)(-((sl_v)1<<(FIXNUM_BITS-1))-0)

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

// NOTE: sl_sym MUST have the same fields as sl_gensym first
// there are places where gensyms are treated as normal symbols
struct sl_sym {
	sl_type *type;
	sl_v binding;   // global value binding
	const char *name;
	u32int hash;
	u8int numtype;
	u8int size;
	u8int flags;
	u8int _dummy;
}sl_aligned(8);

struct sl_gensym {
	sl_type *type;
	sl_v binding;
	const char *name;
	u32int id;
}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 ANYARGS -10000
#define NONNUMERIC (0xff)
#define valid_numtype(v) ((v) <= T_F64)
#define tag(x) ((x) & 7)
#define tagext(x) ((x) & 0xff)
#define ptr(x) ((void*)((uintptr)(x) & (~(uintptr)7)))
#define tagptr(p, t) ((sl_v)(p) | (t))
#define fixnum(x) ((sl_v)(x)<<TAG_BITS)
#define numval(x) ((sl_fx)(x)>>TAG_BITS)
#define ubnumval(x) ((sl_fx)(x)>>(TAG_BITS+1+4))
#define uintval(x) (((unsigned int)(x))>>TAG_BITS)
#define builtin(n) tagptr(((sl_v)n<<TAG_BITS), TAG_FN)
#define special(x) (tagptr(((sl_v)x<<TAG_BITS), TAG_SPECIAL))
#define iscons(x) (tag(x) == TAG_CONS)
#define issym(x) (tag(x) == TAG_SYM)
#define isfixnum(x) (tag(x) == TAG_FIXNUM)
#define bothfixnums(x, y) (isfixnum(x) && isfixnum(y))
#define isvec(x) (tag(x) == TAG_VEC)
#define iscvalue(x) (tag(x) == TAG_CVALUE)
#define isunboxed(x) (tag(x) == TAG_UNBOXED)
#define isspecial(x) (tag(x) == TAG_SPECIAL)
#define isinlined(cv) ((cv)->data == (cv)->_space)
// doesn't lead to other values
#define leafp(a) (((a)&TAG_NONLEAF_MASK) != TAG_NONLEAF_MASK)

/* UNBOXED
 * integers: ...|xxxxxxxx|xxxxxxxx|xxxxxxxx|tttt0100|
 * runes:    ...|xxxxxxxx|xxxxxxxx|xxxxxxxx|11111100|
 */
#define TAG_UBNUM_SHIFT (TAG_BITS+1)
#define isubnum(x)  ((tagext(x) & ((1<<TAG_UBNUM_SHIFT)-1)) == (0<<TAG_BITS | TAG_UNBOXED))
#define ubnumtype(x) ((tagext(x)>>TAG_UBNUM_SHIFT) & 0xf)
#if BYTE_ORDER == LITTLE_ENDIAN
#define ubnumptr(v, nt) ((u8int*)&(v))
#else
#define ubnumptr(v, nt) ((u8int*)&(v)+sizeof(v)-unboxedtypes[nt]->size)
#endif
extern sl_type *unboxedtypes[T_UNBOXED_NUM];
extern sl_v unboxedtypesyms[T_UNBOXED_NUM];

#define mk_rune(r) (((sl_v)(r))<<TAG_EXT_BITS | 0xfc)
#define 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)
#define cons_index(c) (((sl_cons*)ptr(c))-((sl_cons*)slvm.fromspace))
#define ismarked(c) bitvector_get(sl.consflags, cons_index(c))
#define mark_cons(c) bitvector_set(sl.consflags, cons_index(c))
#define unmark_cons(c) bitvector_reset(sl.consflags, cons_index(c))

#define isforwarded(v) (((sl_v*)ptr(v))[0] == sl_unbound)
#define forwardloc(v) (((sl_v*)ptr(v))[1])
#define forward(v, to) \
	do{ \
		((sl_v*)ptr(v))[0] = sl_unbound; \
		((sl_v*)ptr(v))[1] = (sl_v)(to); \
	}while(0)

enum {
	VEC_VEC,
	VEC_STRUCT,
	VEC_TYPE_MASK = 3,
	VEC_GROWN = 1<<2,
};
#define vec_elt(v, i) (((sl_v*)ptr(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)
#define vec_grow_amt(x) ((x)<8 ? 5 : 6*((x)>>3))

// functions ending in _ are unsafe, faster versions
#define car_(v) (((sl_cons*)ptr(v))->car)
#define cdr_(v) (((sl_cons*)ptr(v))->cdr)
#define car(v) (tocons(v)->car)
#define cdr(v) (tocons(v)->cdr)
#define fn_bcode(f) (((sl_fn*)ptr(f))->bcode)
#define fn_vals(f) (((sl_fn*)ptr(f))->vals)
#define fn_env(f) (((sl_fn*)ptr(f))->env)
#define fn_name(f) (((sl_fn*)ptr(f))->name)
#define fn_maxstack(f) (((sl_fn*)ptr(f))->maxstack)
#define set(s, v) (((sl_sym*)ptr(s))->binding = (v))
#define setc(s, v) \
	do{ \
		sl_sym *sy = (sl_sym*)ptr(s); \
		sy->flags |= FLAG_CONST; \
		sy->binding = (v); \
	}while(0)
#define isconst(s) ((s)->flags & FLAG_CONST)
#define iskeyword(s) ((s)->flags & FLAG_KEYWORD)
#define sym_value(s) (((sl_sym*)ptr(s))->binding)
#define sym_name_(s) (((sl_sym*)ptr(s))->name)
#define sym_to_numtype(s) (((sl_sym*)ptr(s))->numtype)
#define ismanaged(v) ((((u8int*)ptr(v)) >= slvm.fromspace) && (((u8int*)ptr(v)) < slvm.fromspace+slvm.heapsize))
#define isgensym(v)  (issym(v) && ismanaged(v))
#define iscbuiltin(v) (iscvalue(v) && cv_class(ptr(v)) == sl_builtintype)
#define isfnbuiltin(v) ((v) < (N_BUILTINS<<TAG_BITS))
#define isfn(v) (tag(v) == TAG_FN || iscbuiltin(v))
// 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 PUSH(v) do{ \
	*sl.sp++ = (sl_v)(v); \
}while(0)

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

#define PUSH_SAFE(v) do{ \
	if(sl.sp >= sl.stackend) \
		sl_stack_grow(); \
	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 x) sl_constfn sl_hotfn;
int sl_init(usize heapsize);
int sl_load_system_image(sl_v ios);

_Noreturn void sl_exit(const char *status);

/* 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(void);

/* symbol table */
sl_v mk_gensym(void);
sl_v mk_sym(const char *str, bool copy) sl_hotfn sl_nonnull(1);
sl_v mk_csym_(const char *str, int len) sl_nonnull(1);
#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 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;

/* 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;

char *uint2str(char *dest, usize len, u64int num, int base) sl_nonnull(1);

/* error handling */
struct sl_readstate {
	sl_htable backrefs;
	sl_htable gensyms;
	sl_v source;
	ios_loc errloc;
	struct sl_readstate *prev;
};

struct sl_exctx {
	sl_readstate *rdst;
	struct sl_exctx *prev;
	sl_jmp_buf buf;
	usize osp;
	usize frame;
	int ngchnd;
};

void free_readstate(sl_readstate *rs) sl_nonnull(1);

#define SL_TRY_EXTERN \
	sl_exctx _ctx; \
	sl_savestate(&_ctx); \
	sl.exctx = &_ctx; \
	int l__ca; \
	if(!sl_setjmp(_ctx.buf)) \
		for(int l__tr = 1; l__tr; l__tr = 0, sl.exctx = sl.exctx->prev)

#define SL_CATCH_EXTERN_NO_RESTORE \
	else \
		for(l__ca=1; l__ca;)

#define SL_CATCH_EXTERN \
	else \
		for(l__ca=1; l__ca; l__ca=0, sl_restorestate(&_ctx))

_Noreturn void lerrorf(sl_v e, const char *format, ...) sl_printfmt(2, 3);
void sl_savestate(sl_exctx *_ctx) sl_nonnull(1);
void sl_restorestate(sl_exctx *_ctx) sl_nonnull(1);
_Noreturn void sl_raise(sl_v e);
_Noreturn void type_error(const char *what, const char *expected, sl_v got) sl_nonnull(2);
_Noreturn void bounds_error(sl_v arr, sl_v ind);
_Noreturn void const_error(sl_v sym);
_Noreturn void unbound_error(sl_v sym);
_Noreturn void arity_error(int nargs, int c);

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

#define argcount(nargs, c) \
	do{ \
		if(sl_unlikely(nargs != c)) \
			bthrow(arity_error(nargs, c)); \
		if(c == 0) \
			USED(args); \
	}while(0)

struct sl_cvtable {
	void (*print)(sl_v self, ios *f);
	void (*relocate)(sl_v oldv, sl_v newv);
	void (*finalize)(sl_v self);
	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;
	sl_type *eltype;  // for arrays
	sl_type *artype;  // (arr this)
	sl_cvinitfn init;
	usize size;
	usize elsz;
	sl_numtype numtype;
};

struct sl_cv {
	sl_type *type;
	union {
		void *data;
		sl_builtinfn cbuiltin;
	};
	usize len; // length of *data in bytes
	union {
		struct {
			u32int startbytes;
			u32int startrune;
		};
		u8int _space[1]; // variable size
	};
}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) ((sl_type*)(((uintptr)((sl_cv*)cv)->type)&~(uintptr)3))
#define cv_len(cv) (((sl_cv*)(cv))->len)
#define cv_type(cv) (cv_class(cv)->type)
#define cv_data(cv) (((sl_cv*)(cv))->data)
#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 cvalue_data(v) cv_data((sl_cv*)ptr(v))
#define cvalue_len(v) cv_len((sl_cv*)ptr(v))
#define value2c(type, v) ((type)cvalue_data(v))
#define cv_numtype(cv) (cv_class(cv)->numtype)

#define isbignum(v) (iscvalue(v) && cv_numtype(ptr(v)) == T_BIG)
#define tobignum(v) (*(mpint**)cv_data(ptr(v)))

#define BUILTIN(lname, cname) \
	sl_v fn_builtin_##cname(sl_v *args, int nargs)

#define BUILTIN_FN(l, c, attr) attr BUILTIN(l, c);
#include "builtin_fns.h"
#undef BUILTIN_FN

#include "opcodes.h"

enum {
	sl_unbound = special(0),
	sl_nil = special(1),
	sl_t = special(2),
	sl_void = special(3),
	sl_eof = special(4),
};

struct sl_proc {
	sl_v *sp;
	usize curr_frame;

	// saved execution state for an unwind target
	sl_exctx *exctx;
	usize throwing_frame;  // active frame when exception was thrown
	sl_v lasterror;

	sl_readstate *readstate;
	u32int *consflags;
	sl_v *stack;
	sl_v *stackend;
	u32int nstack;

	sl_htable printconses;
	u32int printlabel;
	bool print_pretty;
	bool print_princ;
	bool print_circle;
	bool print_radix;
	bool print_ptr_radix;
	sl_fx print_base;
	sl_fx print_ptr_base;
	sl_fx print_length;
	sl_fx print_level;
	sl_fx p_level;
	int scr_width;
	ssize hpos, vpos;
	uintptr cpc;
};

struct sl_vm {
	u8int *curheap;
	u8int *lim;
	usize malloc_pressure;
	sl_cv **finalizers;
	usize nfinalizers;
	usize maxfinalizers;
	Tbl *symbols;
	u32int gensym_ctr;
	// two static buffers for gensym printing so there can be two
	// gensym names available at a time, mostly for compare()
	char gsname[2][16];
	int gsnameno;
	bool exiting;
	bool grew;
	int ngchandles;
	int maxgchandles;
	sl_v **gchandles;
	usize gccalls;
	sl_htable reverse_dlsym_lookup;
	sl_htable types;
	u8int *fromspace;
	u8int *tospace;
	uintptr heapsize; // bytes
};

extern sl_thread(sl_proc *slp);
#define sl (*slp)

extern sl_vm slvm_;
#define slvm (slvm_)

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_builtinsym, 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_type *sl_bignumtype, *sl_builtintype;
extern sl_type *sl_s8type, *sl_u8type;
extern sl_type *sl_s16type, *sl_u16type;
extern sl_type *sl_s32type, *sl_u32type;
extern sl_type *sl_s64type, *sl_u64type;
extern sl_type *sl_p32type, *sl_p64type;
extern sl_type *sl_f32type, *sl_f64type;
extern sl_type *sl_utf8type, *sl_runetype;
extern sl_type *sl_strtype, *sl_runestrtype;

void sys_init(void);

_Noreturn void slmain(const u8int *boot, int bootsz, int argc, char **argv) sl_nonnull(1, 4);