#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" usizellength(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 boolint_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));} _NoreturnBUILTIN("raise", raise){	argcount(1);	bthrow(raise(args[0]));} _NoreturnBUILTIN("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;}