#include "inc/priv.h"#include "inc/operators.h"#include "inc/cvalues.h"#include "inc/equal.h"#include "inc/hashing.h" enum {	BOUNDED_COMPARE_BOUND = 128,	BOUNDED_HASH_BOUND = 16384,}; #if defined(BITS64)#define MIX(a, b) inthash((u64int)(a) ^ (u64int)(b));#define doublehash(a) inthash(a)#else#define MIX(a, b) int64to32hash((u64int)(a)<<32 | (u64int)(b));#define doublehash(a) int64to32hash(a)#endif sl_purefnsl_nonnull(1)static sl_veq_class(sl_htable *table, sl_v key){	sl_v c = (sl_v)ptrhash_get(table, (void*)key);	if(c == (sl_v)HT_NOTFOUND)		return sl_nil;	if(c == key)		return c;	return eq_class(table, c);} sl_nonnull(1)static voideq_union(sl_htable *table, sl_v a, sl_v b, sl_v c, sl_v cb){	sl_v ca = c == sl_nil ? a : c;	if(cb != sl_nil)		ptrhash_put(table, (void*)cb, (void*)ca);	ptrhash_put(table, (void*)a, (void*)ca);	ptrhash_put(table, (void*)b, (void*)ca);} static sl_v cyc_compare(sl_v a, sl_v b, sl_htable *table, bool eq) sl_nonnull(3); static sl_vbounded_vec_compare(sl_v a, sl_v b, int bound, bool eq){	usize la = vec_size(a);	usize lb = vec_size(b);	usize m, i;	if(eq && la != lb)		return fixnum(1);	m = la < lb ? la : lb;	for(i = 0; i < m; i++){		sl_v d = bounded_compare(vec_elt(a, i), vec_elt(b, i), bound-1, eq);		if(d == sl_nil || numval(d) != 0)			return d;	}	if(la < lb)		return fixnum(-1);	if(la > lb)		return fixnum(1);	return fixnum(0);} // strange comparisons are resolved arbitrarily but consistently.// ordering: num < function < vec < cvalue < symbol < conssl_vbounded_compare(sl_v a, sl_v b, int bound, bool eq){	sl_v d;	sl_cv *cv; compare_top:	if(a == b)		return fixnum(0);	if(bound <= 0)		return sl_nil;	int taga = tag(a);	int tagb = tag(b);	int c;	switch(taga){	case TAG_FIXNUM:		if(isfixnum(b))			return (sl_fx)a < (sl_fx)b ? fixnum(-1) : fixnum(1);		if((c = numeric_compare(a, b, false)) <= 1)			return fixnum(c);		if(sl_isrune(b))			return fixnum(1);		return fixnum(-1);	case TAG_UNBOXED:		if(sl_isrune(a))			return fixnum(sl_isrune(b) && (sl_fx)a < (sl_fx)b ? -1 : 1);		if(sl_isrune(b))			return fixnum(1);		if((c = numeric_compare(a, b, false)) <= 1)			return fixnum(c);		return fixnum(-1);	case TAG_SYM:		if(eq || tagb < TAG_SYM)			return fixnum(1);		if(tagb > TAG_SYM)			return fixnum(-1);		return fixnum(strcmp(sym_name(a), sym_name(b)));	case TAG_VEC:		if(isvec(b))			return bounded_vec_compare(a, b, bound, eq);		break;	case TAG_CVALUE:		cv = ptr(sl_cv, a);		if(valid_numtype(cv_numtype(cv))){			if((c = numeric_compare(a, b, false)) <= 1)				return fixnum(c);		}		if(tagb == TAG_CVALUE)			return cvalue_compare(a, b, bound-1, eq);		break;	case TAG_FN:		if(tagb == TAG_FN){			if(!isfnbuiltin(a) && !isfnbuiltin(b)){				sl_fn *fa = ptr(sl_fn, a);				sl_fn *fb = ptr(sl_fn, b);				d = bounded_compare(fa->bcode, fb->bcode, bound-1, eq);				if(d == sl_nil || numval(d) != 0)					return d;				d = bounded_compare(fa->vals, fb->vals, bound-1, eq);				if(d == sl_nil || numval(d) != 0)					return d;				d = bounded_compare(fa->env, fb->env, bound-1, eq);				if(d == sl_nil || numval(d) != 0)					return d;				return fixnum(0);			}			return numval(a) < numval(b) ? fixnum(-1) : fixnum(1);		}		break;	case TAG_ESPECIAL:		if(tagb == TAG_ESPECIAL){			taga = a;			tagb = b;		}		break;	case TAG_CONS:		if(tagb < TAG_CONS)			return fixnum(1);		d = bounded_compare(car_(a), car_(b), bound-1, eq);		if(d == sl_nil || numval(d) != 0)			return d;		a = cdr_(a); b = cdr_(b);		bound--;		goto compare_top;	}	return taga < tagb ? fixnum(-1) : fixnum(1);} sl_nonnull(3)static sl_vcyc_vec_compare(sl_v a, sl_v b, sl_htable *table, bool eq){	usize la = vec_size(a);	usize lb = vec_size(b);	usize m, i;	sl_v d, xa, xb, ca, cb; 	// first try to prove them different with no recursion	if(eq && la != lb)		return fixnum(1);	m = la < lb ? la : lb;	for(i = 0; i < m; i++){		xa = vec_elt(a, i);		xb = vec_elt(b, i);		if(leafp(xa) || leafp(xb)){			d = bounded_compare(xa, xb, 1, eq);			if(d != sl_nil && numval(d) != 0)				return d;		}else if(tag(xa) < tag(xb))			return fixnum(-1);		else if(tag(xa) > tag(xb))			return fixnum(1);	} 	ca = eq_class(table, a);	cb = eq_class(table, b);	if(ca != sl_nil && ca == cb)		return fixnum(0); 	eq_union(table, a, b, ca, cb); 	for(i = 0; i < m; i++){		xa = vec_elt(a, i);		xb = vec_elt(b, i);		if(!leafp(xa) || tag(xa) == TAG_FN){			d = cyc_compare(xa, xb, table, eq);			if(numval(d) != 0)				return d;		}	} 	if(la < lb)		return fixnum(-1);	if(la > lb)		return fixnum(1);	return fixnum(0);} static sl_vcyc_compare(sl_v a, sl_v b, sl_htable *table, bool eq){	sl_v d, ca, cb;cyc_compare_top:	if(a == b)		return fixnum(0);	if(iscons(a)){		if(!iscons(b))			return fixnum(1);		sl_v aa = car_(a);		sl_v da = cdr_(a);		sl_v ab = car_(b);		sl_v db = cdr_(b);		int tagaa = tag(aa);		int tagda = tag(da);		int tagab = tag(ab);		int tagdb = tag(db);		if(leafp(aa) || leafp(ab)){			d = bounded_compare(aa, ab, 1, eq);			if(d != sl_nil && numval(d) != 0)				return d;		}		if(tagaa < tagab)			return fixnum(-1);		if(tagaa > tagab)			return fixnum(1);		if(leafp(da) || leafp(db)){			d = bounded_compare(da, db, 1, eq);			if(d != sl_nil && numval(d) != 0)				return d;		}		if(tagda < tagdb)			return fixnum(-1);		if(tagda > tagdb)			return fixnum(1); 		ca = eq_class(table, a);		cb = eq_class(table, b);		if(ca != sl_nil && ca == cb)			return fixnum(0); 		eq_union(table, a, b, ca, cb);		d = cyc_compare(aa, ab, table, eq);		if(numval(d) != 0)			return d;		a = da;		b = db;		goto cyc_compare_top;	}	if(isvec(a) && isvec(b))		return cyc_vec_compare(a, b, table, eq);	if(isfn(a) && isfn(b)){		sl_fn *fa = ptr(sl_fn, a);		sl_fn *fb = ptr(sl_fn, b);		d = bounded_compare(fa->bcode, fb->bcode, 1, eq);		if(numval(d) != 0)			return d; 		ca = eq_class(table, a);		cb = eq_class(table, b);		if(ca != sl_nil && ca == cb)			return fixnum(0); 		eq_union(table, a, b, ca, cb);		d = cyc_compare(fa->vals, fb->vals, table, eq);		if(numval(d) != 0)			return d;		a = fa->env;		b = fb->env;		goto cyc_compare_top;	}	return bounded_compare(a, b, 1, eq);} static sl_htable equal_eq_hashtable; voidcomparehash_init(void){	htable_new(&equal_eq_hashtable, 512);} // 'eq' means unordered comparison is sufficientsl_vsl_compare(sl_v a, sl_v b, bool eq){	sl_v guess = bounded_compare(a, b, BOUNDED_COMPARE_BOUND, eq);	if(guess == sl_nil){		guess = cyc_compare(a, b, &equal_eq_hashtable, eq);		htable_reset(&equal_eq_hashtable, 512);	}	return guess;} /*  optimizations:  - use hash updates instead of calling lookup then insert. i.e. get the	bp once and use it twice.  * preallocate hash table and call reset() instead of new/free  * less redundant tag checking, 3-bit tags*/ // *oob: output argument, means we hit the limit specified by 'bound'sl_nonnull(3)static uintptrbounded_hash(sl_v a, int bound, bool *oob){	union {		double d;		s64int i64;	}u;	usize i, len;	sl_cv *cv;	void *data;	uintptr h = 0;	int tg = tag(a);	bool oob2; 	*oob = false;	switch(tg){	case TAG_FIXNUM:		u.d = (double)numval(a);		return doublehash(u.i64);	case TAG_UNBOXED:		if(sl_isrune(a))			return inthash(torune(a));		if(isubnum(a))			u.d = (double)ubnumval(a);		else			abort();		return doublehash(u.i64);	case TAG_FN:		if(!isfnbuiltin(a))			return bounded_hash(ptr(sl_fn, a)->bcode, bound, oob);		return inthash(a);	case TAG_ESPECIAL:		return inthash(-(sl_fx)a);	case TAG_SYM:		return ptr(sl_sym, a)->hash;	case TAG_CVALUE:		cv = ptr(sl_cv, a);		data = cv_data(cv);		sl_numtype nt = cv_numtype(cv);		if(valid_numtype(nt)){			u.d = conv_to_double(a, data, nt);			return doublehash(u.i64);		}		return memhash(data, cv_len(cv));	case TAG_VEC:		if(bound <= 0){			*oob = true;			return 1;		}		len = vec_size(a);		for(i = 0; i < len; i++){			h = MIX(h, bounded_hash(vec_elt(a, i), bound/2, &oob2)^1);			if(oob2)				bound /= 2;			*oob = *oob || oob2;		}		return h;	case TAG_CONS:		do{			if(bound <= 0){				*oob = true;				return h;			}			h = MIX(h, bounded_hash(car_(a), bound/2, &oob2));			// bounds balancing: try to share the bounds efficiently			// so we can hash better when a list is cdr-deep (a common case)			if(oob2)				bound /= 2;			else				bound--;			// recursive OOB propagation. otherwise this case is slow:			// #2=((#0=(#1=(#1#) . #0#)) . #2#)			*oob = *oob || oob2;			a = cdr_(a);		}while(iscons(a));		h = MIX(h, bounded_hash(a, bound-1, &oob2)^2);		*oob = *oob || oob2;		return h;	}	return 0;} boolequal_lispvalue(sl_v a, sl_v b){	if((1<<tag(a) | 1<<tag(b)) & (1<<TAG_FIXNUM | 1<<TAG_FN | 1<<TAG_SYM))		return a == b;	return sl_compare(a, b, true) == 0;} static uintptrhash_lispvalue(sl_v a){	bool oob = false;	return bounded_hash(a, BOUNDED_HASH_BOUND, &oob);} #define HTNAME(suffix) equalhash##suffix#define HFUNC(v) hash_lispvalue((sl_v)(v))#define EQFUNC(x, y) equal_lispvalue((sl_v)(x), (sl_v)(y)) #include "inc/htable_c.h"