#include "inc/priv.h"
#include "inc/io.h"
#include "inc/str.h"
#include "inc/operators.h"
#include "inc/cvalues.h"
#include "inc/time.h"
#include "inc/table.h"
#include "inc/nan.h"
#include "inc/ieee754.h"
#include "tbl.h"

usize
llength(sl_v v)
{
	usize n = 0;
	while(iscons(v)){
		n++;
		v = cdr_(v);
	}
	if(sl_unlikely(v != sl_nil))
		cthrow(type_error(nil, "cons", v), v);
	return n;
}

static bool
int_valued(double x)
{
	union ieee754_double d;
	double i;
	d.d = modf(x, &i);
	return d.ieee.exponent == 0 && d.ieee.mantissa0 == 0 && d.ieee.mantissa1 == 0 && !isinf(x);
}

BUILTIN("nconc", nconc)
{
	if(sl_unlikely(nargs == 0))
		return sl_nil;

	sl_v lst, first = sl_nil;
	sl_v *pcdr = &first;
	sl_cons *c;
	int i = 0;

	while(1){
		lst = args[i++];
		if(i >= nargs)
			break;
		if(iscons(lst)){
			*pcdr = lst;
			c = ptr(sl_cons, lst);
			while(iscons(c->cdr))
				c = ptr(sl_cons, c->cdr);
			pcdr = &c->cdr;
		}else if(sl_unlikely(lst != sl_nil)){
			bthrow(type_error(nil, "cons", lst));
		}
	}
	*pcdr = lst;
	return first;
}

BUILTIN("assq", assq)
{
	argcount(2);

	sl_v item = args[0];
	sl_v v = args[1];
	sl_v bind;

	while(iscons(v)){
		bind = car_(v);
		if(iscons(bind) && car_(bind) == item)
			return bind;
		v = cdr_(v);
	}
	return sl_nil;
}

BUILTIN("memq", memq)
{
	argcount(2);

	sl_v v;
	sl_cons *c;
	for(v = args[1]; iscons(v); v = c->cdr){
		if((c = ptr(sl_cons, v))->car == args[0])
			return v;
	}
	return sl_nil;
}

BUILTIN("length", length)
{
	argcount(1);

	sl_v a = args[0];
	if(a == sl_nil)
		return fixnum(0);
	if(iscons(a)){
		usize n = 0;
		sl_v v = a, v2 = a;
		do{
			n++;
			v = cdr_(v);
			v2 = cdr_(v2);
			if(iscons(v2))
				v2 = cdr_(v2);
		}while(iscons(v) && iscons(v2) && sl_likely(v != v2));
		if(sl_unlikely(iscons(v2)))
			return sl_nil;
		n += llength(v);
		return size_wrap(n);
	}
	if(isvec(a))
		return size_wrap(vec_size(a));
	if(isstr(a)){
		bool err;
		return size_wrap(u8_runelen(cvalue_data(a), cvalue_len(args[0]), &err));
	}
	if(isarr(a))
		return size_wrap(cvalue_arrlen(a));
	if(ishashtable(a)){
		sl_htable *h = totable(a);
		return size_wrap(h->live);
	}
	if(isio(a)){
		ios *s = toio(a, true, true, false);
		if(sl_unlikely(s->bm != IOS_BUF_MEM))
			bthrow(error(sl_errarg, "requires in-memory io"));
		return size_wrap(s->size);
	}
	bthrow(type_error(nil, "sequence", a));
}

_Noreturn
BUILTIN("raise", raise)
{
	argcount(1);
	bthrow(raise(args[0]));
}

_Noreturn
BUILTIN("exit", exit)
{
	argcount_most(2);
	const char *status = (nargs > 0 && args[0] != sl_nil) ? tostr(args[0]) : nil;
	int code = nargs > 1 ? tofixnum(args[1]) : 0;
	sl_exit(status, code);
}

BUILTIN("sym", sym)
{
	argcount_least(1);
	sl_v name;
	if(nargs == 1 && isstr(args[0]))
		name = args[0];
	else
		name = fn_builtin_str(args, nargs);
	return mk_sym(cvalue_data(name), true);
}

BUILTIN("keyword?", keywordp)
{
	argcount(1);
	return iskeysym(args[0]) ? sl_t : sl_nil;
}

BUILTIN("top-level-value", top_level_value)
{
	argcount(1);
	sl_sym *sym = tosym(args[0]);
	if(sl_unlikely(sym->binding == sl_unbound))
		bthrow(unbound_error(args[0]));
	return sym->binding;
}

BUILTIN("set-top-level-value!", set_top_level_value)
{
	argcount(2);
	sl_sym *sym = tosym(args[0]);
	if(sl_unlikely(isconst(sym)))
		bthrow(const_error(args[0]));
	sym->binding = args[1];
	return args[1];
}

BUILTIN("makunbound", makunbound)
{
	argcount(1);
	sl_sym *sym = tosym(args[0]);
	if(sl_unlikely(isconst(sym)))
		bthrow(const_error(args[0]));
	sym->binding = sl_unbound;
	return sl_void;
}

BUILTIN("environment", environment)
{
	noargs();
	sl_v lst = sl_nil;
	sl_gc_handle(&lst);
	const char *k = nil;
	sl_sym *v;
	while(Tnext(slvm.symbols, &k, (void**)&v)){
		if(v->binding == sl_unbound)
			continue;
		if((v->flags & FLAG_CONST) != 0)
			continue;
		lst = mk_cons(tagptr(v, TAG_SYM), lst);
	}
	sl_free_gc_handles(1);
	return lst;
}

BUILTIN("const?", constp)
{
	argcount(1);
	if(issym(args[0]))
		return isconst(ptr(sl_sym, args[0])) ? sl_t : sl_nil;
	if(iscons(args[0])){
		if(car_(args[0]) == sl_quote)
			return sl_t;
		return sl_nil;
	}
	return sl_t;
}

BUILTIN("int-valued?", int_valuedp)
{
	argcount(1);
	sl_v v = args[0];
	if(isfixnum(v) || isubnum(v))
		return sl_t;
	if(iscvalue(v)){
		sl_numtype nt = cvalue_numtype(v);
		if(nt < T_F32)
			return sl_t;
		void *data = cvalue_data(v);
		if(nt == T_F32){
			float f = *(float*)data;
			if(int_valued(f))
				return sl_t;
		}else if(nt == T_F64){
			double d = *(double*)data;
			if(int_valued(d))
				return sl_t;
		}else
			abort();
	}
	return sl_nil;
}

BUILTIN("int?", intp)
{
	argcount(1);
	sl_v v = args[0];
	return (isfixnum(v) || isubnum(v) ||
			(iscvalue(v) && cvalue_numtype(v) < T_F32)) ?
		sl_t : sl_nil;
}

BUILTIN("bignum?", bignump)
{
	argcount(1);
	return isbignum(args[0]) ? sl_t : sl_nil;
}

BUILTIN("ptr?", ptrp)
{
	argcount(1);
	sl_v v = args[0];
	if(isubnum(v))
		return ubnumtype(v) == T_P32 || ubnumtype(v) == T_P64 ? sl_t : sl_nil;
	if(iscvalue(v)){
		sl_cv *p = ptr(sl_cv, v);
		return cv_numtype(p) == T_P32 || cv_numtype(p) == T_P64 ? sl_t : sl_nil;
	}
	return sl_nil;
}

BUILTIN("fixnum", fixnum)
{
	argcount_most(1);
	if(nargs == 0)
		return fixnum(0);
	sl_v v = args[0];
	if(isubnum(v))
		return fixnum(ubnumval(v));
	if(iscvalue(v)){
		sl_cv *p = ptr(sl_cv, v);
		return fixnum(conv_to_s64(v, cv_data(p), cv_numtype(p)));
	}
	if(isfixnum(v))
		return v;
	bthrow(type_error(nil, "num", v));
}

BUILTIN("truncate", truncate)
{
	argcount(1);
	sl_v v = args[0];
	if(isfixnum(v) || isubnum(v))
		return v;
	if(iscvalue(v)){
		sl_cv *cv = ptr(sl_cv, v);
		sl_numtype nt = cv_numtype(cv);
		if(valid_numtype(nt)){
			void *data = cv_data(cv);
			double d;
			if(nt == T_F32)
				d = *(float*)data;
			else if(nt == T_F64)
				d = *(double*)data;
			else
				return v;
			d = trunc(d);
			if(isnan(d) || isinf(d))
				return v;
			if(d < (double)INT64_MIN || d >= (double)((u64int)INT64_MAX+1))
				return mk_bignum(dtomp(d, nil));
			s64int s = trunc(d);
			if(s < FIXNUM_MIN || s > FIXNUM_MAX)
				return mk_bignum(vtomp(s, nil));
			return fixnum(s);
		}
	}
	bthrow(type_error(nil, "num", v));
}

BUILTIN("vec-alloc", vec_alloc)
{
	argcount_least(1);
	usize i = tosize(args[0]);
	sl_v v = alloc_vec(i, 0);
	int a = 1;
	for(usize k = 0; k < i; k++){
		sl_v f = a < nargs ? args[a] : sl_void;
		vec_elt(v, k) = f;
		if(sl_likely((a = (a + 1) % nargs) < 1))
			a = 1;
	}
	return v;
}

BUILTIN("copy-vec", copy_vec)
{
	argcount(1);
	sl_v v = args[0], v0;
	if(sl_unlikely(!isvec(v) || isstruct(v)))
		bthrow(type_error(nil, "vec", v));
	v0 = alloc_vec(vec_size(v), false);
	v = args[0]; // gc
	memcpy(&vec_elt(v0, 0), &vec_elt(v, 0), vec_size(v0)*sizeof(sl_v));
	return v0;
}

BUILTIN("time-now", time_now)
{
	noargs();
	return mk_u64(sec_realtime());
}

BUILTIN("nanoseconds-monotonic", nanoseconds_monotonic)
{
	noargs();
	return return_from_u64(nanosec_monotonic());
}

BUILTIN("time->str", time_str)
{
	argcount(1);
	u64int t = tou64(args[0]);
	char buf[64];
	timestr(t, buf, sizeof(buf));
	return str_from_cstr(buf);
}

BUILTIN("str->time", str_time)
{
	argcount(1);
	char *ptr = tostr(args[0]);
	return return_from_u64(parsetime(ptr));
}

BUILTIN("os-getenv", os_getenv)
{
	argcount(1);
	char *name = tostr(args[0]);
	char *val = getenv(name);
	if(val == nil)
		return sl_nil;
	return str_from_cstr(val);
}

BUILTIN("os-setenv", os_setenv)
{
	argcount(2);
	char *name = tostr(args[0]);
	int result;
	if(args[1] == sl_nil)
		result = unsetenv(name);
	else{
		char *val = tostr(args[1]);
		result = setenv(name, val, 1);
	}
	if(result != 0)
		bthrow(error(sl_errarg, "invalid environment variable"));
	return sl_t;
}