rewrite numerical comparison logic

This should fix many corner cases. One big change from how this previously worked is that no comparison operators will return "these are equal" if at least one of the arguments is NaN - eq?, equal?, eqv? and = all will return NIL.

Sigrid Solveig Haflínudóttir committed 1 year ago

Commit 99a1b911 parent 6cf5e218 files · +114 −157Browse files

Unified · Split

8 files

src/cvalues.c +4 −15
src/equal.c +3 −3
src/equal.h +1 −1
src/operators.c +81 −115
src/operators.h +1 −4
src/sl.h +6 −1
src/vm.h +2 −2
test/unittest.sl +16 −16

src/cvalues.c+4−15

@@ -414,7 +414,7 @@ usize · 413 unmodified lines
414	414	tosize(sl_v n)
415	415	{
416	416	if(sl_unlikely(iscvalue(n))){
417		− if(sl_likely(numeric_compare(n, fixnum(0), false, false, true) >= 0)){
	417	+ if(sl_likely(numeric_compare(n, fixnum(0), false, true) >= 0)){
418	418	sl_cv *cv = ptr(n);
419	419	if(sizeof(usize) > 4)
420	420	return conv_to_u64(n, cv_data(cv), cv_numtype(cv));
@@ -1088,13 +1088,10 @@ num_to_ptr(sl_v a, sl_fx pi, sl_numtype pt, void **pp) · 667 unmodified lines
1088	1088	/*
1089	1089	returns -1, 0, or 1 based on ordering of a and b
1090	1090	eq: consider equality only, returning 0 or nonzero
1091		− eqnans: NaNs considered equal to each other
1092		− -0.0 not considered equal to 0.0
1093		− inexact not considered equal to exact
1094	1091	typeerr: if not 0, throws type errors, else returns 2 for type errors
1095	1092	*/
1096	1093	int
1097		−numeric_compare(sl_v a, sl_v b, bool eq, bool eqnans, bool typeerr)
	1094	+numeric_compare(sl_v a, sl_v b, bool eq, bool typeerr)
1098	1095	{
1099	1096	sl_fx ai, bi;
1100	1097	sl_numtype ta, tb;
@@ -1117,15 +1114,7 @@ numeric_compare(sl_v a, sl_v b, bool eq, bool eqnans, bool typeerr) · 16 unmodified lines
1117	1114	cthrow(type_error("b", "num", b), a);
1118	1115	return 2;
1119	1116	}
1120		− if(eq && eqnans && ((ta >= T_F32) != (tb >= T_F32)))
1121		− return 1;
1122		− if(cmp_eq(aptr, ta, bptr, tb, eqnans))
1123		− return 0;
1124		− if(eq)
1125		− return 1;
1126		− if(cmp_lt(aptr, ta, bptr, tb))
1127		− return -1;
1128		− return 1;
	1117	+ return cmp_numeric(aptr, ta, bptr, tb);
1129	1118	}
1130	1119
1131	1120	_Noreturn void
@@ -1370,7 +1359,7 @@ BUILTIN("lognot", lognot) · 238 unmodified lines
1370	1359	if(isfixnum(a))
1371	1360	return fixnum(~numval(a));
1372	1361	if(isubnum(a)){
1373		− if((ubnumtype(a) & 1) == 0){
	1362	+ if(is_nt_sint(ubnumtype(a))){
1374	1363	sl_fx s = ubnumval(a);
1375	1364	s = (sl_v)~s << TAG_EXT_BITS;
1376	1365	return ((sl_v)s & ~(sl_v)TAG_EXT_MASK) \| (a & TAG_EXT_MASK);

src/equal.c+3−3

@@ -80,7 +80,7 @@ compare_top: · 79 unmodified lines
80	80	if(isfixnum(b))
81	81	return (sl_fx)a < (sl_fx)b ? fixnum(-1) : fixnum(1);
82	82	if(isubnum(b) \|\| (iscvalue(b) && (cv = ptr(b), valid_numtype(cv_numtype(cv)))))
83		− return fixnum(numeric_compare(a, b, eq, true, false));
	83	+ return fixnum(numeric_compare(a, b, eq, false));
84	84	if(isrune(b))
85	85	return fixnum(1);
86	86	return fixnum(-1);
@@ -90,7 +90,7 @@ compare_top: · 3 unmodified lines
90	90	if(isrune(b))
91	91	return fixnum(1);
92	92	if(isfixnum(b) \|\| isubnum(b) \|\| (iscvalue(b) && (cv = ptr(b), valid_numtype(cv_numtype(cv)))))
93		− return fixnum(numeric_compare(a, b, eq, true, false));
	93	+ return fixnum(numeric_compare(a, b, eq, false));
94	94	return fixnum(-1);
95	95	case TAG_SYM:
96	96	if(eq \|\| tagb < TAG_SYM)
@@ -105,7 +105,7 @@ compare_top: · 8 unmodified lines
105	105	case TAG_CVALUE:
106	106	cv = ptr(a);
107	107	if(valid_numtype(cv_numtype(cv))){
108		− if((c = numeric_compare(a, b, eq, true, false)) != 2)
	108	+ if((c = numeric_compare(a, b, eq, false)) != 2)
109	109	return fixnum(c);
110	110	}
111	111	if(tagb == TAG_CVALUE)

src/equal.h+1−1

@@ -8,5 +8,5 @@ int equal_lispvalue(sl_v a, sl_v b); · 7 unmodified lines
8	8	uintptr hash_lispvalue(sl_v a);
9	9	sl_v bounded_compare(sl_v a, sl_v b, int bound, bool eq);
10	10	sl_v sl_compare(sl_v a, sl_v b, bool eq);
11		−int numeric_compare(sl_v a, sl_v b, bool eq, bool eqnans, bool typeerr);
	11	+int numeric_compare(sl_v a, sl_v b, bool eq, bool typeerr);
12	12	void comparehash_init(void);

src/operators.c+81−115

@@ -34,7 +34,7 @@ conv_to_double(sl_v v, void *data, sl_numtype tag) · 33 unmodified lines
34	34	case T_U32: case T_P32: return (u32int)data;
35	35	case T_S64:
36	36	d = (s64int)data;
37		− if(d > 0 && (s64int)data < 0) // can happen!
	37	+ if(d > 0 && (s64int)data < 0) // can happen!
38	38	d = -d;
39	39	return d;
40	40	case T_U64: case T_P64: return (u64int)data;
@@ -103,7 +103,7 @@ conv_to_u64(sl_v v, void *data, sl_numtype tag) · 62 unmodified lines
103	103	cthrow(type_error(nil, "num", v), v);
104	104	}
105	105
106		−sl_purefn
	106	+static sl_purefn
107	107	bool
108	108	cmp_same_lt(void a, void b, sl_numtype tag)
109	109	{
@@ -117,13 +117,13 @@ cmp_same_lt(void a, void b, sl_numtype tag) · 7 unmodified lines
117	117	case T_S64: return (s64int)a < (s64int)b;
118	118	case T_U64: case T_P64: return (u64int)a < (u64int)b;
119	119	case T_BIG: return mpcmp((mpint)a, (mpint**)b) < 0;
120		− case T_F32: return (float)a < (float)b;
121		− case T_F64: return (double)a < (double)b;
	120	+ case T_F32: return (float)a < (float)b && !isnan((float)a) && !isnan((float)b);
	121	+ case T_F64: return (double)a < (double)b && !isnan((double)a) && !isnan((double)b);
122	122	}
123	123	return false;
124	124	}
125	125
126		−sl_purefn
	126	+static sl_purefn
127	127	bool
128	128	cmp_same_eq(void a, void b, sl_numtype tag)
129	129	{
@@ -137,8 +137,8 @@ cmp_same_eq(void a, void b, sl_numtype tag) · 7 unmodified lines
137	137	case T_S64: return (s64int)a == (s64int)b;
138	138	case T_U64: case T_P64: return (u64int)a == (u64int)b;
139	139	case T_BIG: return mpcmp((mpint)a, (mpint**)b) == 0;
140		− case T_F32: return (float)a == (float)b && !isnan((float)a);
141		− case T_F64: return (double)a == (double)b && !isnan((double)b);
	140	+ case T_F32: return (float)a == (float)b && !isnan((float)a) && !isnan((float)b);
	141	+ case T_F64: return (double)a == (double)b && !isnan((double)a) && !isnan((double)b);
142	142	}
143	143	return false;
144	144	}
@@ -146,120 +146,86 @@ cmp_same_eq(void a, void b, sl_numtype tag) · 1 unmodified line
146	146	/* FIXME one is allocated for all compare ops */
147	147	static mpint *cmpmpint;
148	148
149		−bool
150		−cmp_lt(void a, sl_numtype atag, void b, sl_numtype btag)
	149	+static sl_numtype
	150	+promote(void x, sl_numtype nt, void d, mpint **m)
151	151	{
152		− if(atag == btag)
153		− return cmp_same_lt(a, b, atag);
154		−
155		− double da = conv_to_double(sl_nil, a, atag);
156		− double db = conv_to_double(sl_nil, b, btag);
157		−
158		− if(isnan(da) \|\| isnan(db))
159		− return false;
160		−
161		− // casting to double will only get the wrong answer for big int64s
162		− // that differ in low bits
163		− if(da < db)
164		− return true;
165		− if(db < da)
166		− return false;
167		−
168		− if(cmpmpint == nil && (atag == T_BIG \|\| btag == T_BIG))
169		− cmpmpint = mpnew(0);
170		−
171		− if(atag == T_U64){
172		− if(btag == T_S64)
173		− return (s64int)b >= 0 && (u64int)a < (u64int)(s64int)b;
174		− if(btag == T_F64)
175		− return db >= 0 ? (u64int)a < (u64int)(double)b : 0;
176		− if(btag == T_BIG)
177		− return mpcmp(uvtomp((u64int)a, cmpmpint), (mpint*)b) < 0;
178		− }
179		− if(atag == T_S64){
180		− if(btag == T_U64)
181		− return (s64int)a >= 0 && (u64int)(s64int)a < (u64int)b;
182		− if(btag == T_F64)
183		− return (s64int)a < (s64int)(double)b;
184		− if(btag == T_BIG)
185		− return mpcmp(vtomp((s64int)a, cmpmpint), (mpint*)b) < 0;
186		− }
187		− if(btag == T_U64){
188		− if(atag == T_F64)
189		− return da >= 0 ? (u64int)b > (u64int)(double)a : 0;
190		− if(atag == T_BIG)
191		− return mpcmp((mpint)a, uvtomp((u64int*)b, cmpmpint)) < 0;
192		− }
193		− if(btag == T_S64){
194		− if(atag == T_F64)
195		− return (s64int)b > (s64int)(double)a;
196		− if(atag == T_BIG)
197		− return mpcmp((mpint)a, vtomp((s64int*)b, cmpmpint)) < 0;
198		− }
199		− return false;
	152	+ if(nt >= T_F32){
	153	+ (double)d = conv_to_double(sl_nil, x, nt);
	154	+ nt = T_F64;
	155	+ }else if(is_nt_uint(nt)){
	156	+ (u64int)d = conv_to_u64(sl_nil, x, nt);
	157	+ nt = T_U64;
	158	+ }else if(is_nt_sint(nt)){
	159	+ (s64int)d = conv_to_s64(sl_nil, x, nt);
	160	+ nt = T_S64;
	161	+ }else if(nt == T_BIG){
	162	+ if(cmpmpint == nil)
	163	+ cmpmpint = mpnew(128);
	164	+ m = (mpint**)x;
	165	+ }else
	166	+ abort();
	167	+ return nt;
200	168	}
201	169
202		−bool
203		−cmp_eq(void a, sl_numtype atag, void b, sl_numtype btag, bool equalnans)
	170	+int
	171	+cmp_numeric(void ap, sl_numtype ant, void bp, sl_numtype bnt)
204	172	{
205		− union {
206		− double d;
207		− s64int i64;
208		− }u, v;
209		−
210		− if(atag == btag && (!equalnans \|\| atag < T_F32))
211		− return cmp_same_eq(a, b, atag);
212		−
213		− double da = conv_to_double(sl_nil, a, atag);
214		− double db = conv_to_double(sl_nil, b, btag);
	173	+ if(ant == bnt){
	174	+ if(cmp_same_eq(ap, bp, ant))
	175	+ return 0;
	176	+ return cmp_same_lt(ap, bp, ant) ? -1 : 1;
	177	+ }
215	178
216		− if((int)atag >= T_F32 && (int)btag >= T_F32){
217		− if(equalnans){
218		− u.d = da; v.d = db;
219		− return u.i64 == v.i64;
	179	+ union{
	180	+ u64int u;
	181	+ s64int s;
	182	+ double d;
	183	+ mpint *m;
	184	+ }a, b;
	185	+ ant = promote(ap, ant, &a.u, &a.m);
	186	+ bnt = promote(bp, bnt, &b.u, &b.m);
	187	+
	188	+ switch(ant){
	189	+ case T_U64:
	190	+ switch(bnt){
	191	+ case T_U64: return a.u < b.u ? -1 : (a.u == b.u ? 0 : 1);
	192	+ case T_S64: return a.u < b.u && b.s > 0 ? -1 : (a.u == b.u && b.s >= 0 ? 0 : 1);
	193	+ case T_F64: return isnan(b.d) ? 1 : (a.u < b.d && b.d > 0 ? -1 : (a.u == b.d && b.d >= 0 ? 0 : 1));
	194	+ case T_BIG: return mpcmp(uvtomp(a.u, cmpmpint), b.m);
	195	+ default: break;
	196	+ }
	197	+ break;
	198	+ case T_S64:
	199	+ switch(bnt){
	200	+ case T_S64: return a.s < b.s ? -1 : (a.s == b.s ? 0 : 1);
	201	+ case T_U64: return (a.s < 0 \|\| a.u < b.u) ? -1 : (a.u == b.u && a.s >= 0 ? 0 : 1);
	202	+ case T_F64: return isnan(b.d) ? 1 : (a.s < b.d ? -1 : (a.s == b.d ? 0 : 1));
	203	+ case T_BIG: return mpcmp(vtomp(a.s, cmpmpint), b.m);
	204	+ default: break;
	205	+ }
	206	+ break;
	207	+ case T_F64:
	208	+ if(isnan(a.d))
	209	+ return 1;
	210	+ switch(bnt){
	211	+ case T_F64: return isnan(b.d) ? 1 : (a.d < b.d ? -1 : (a.d == b.d ? 0 : 1));
	212	+ case T_U64: return (a.d < 0 \|\| a.d < b.u) ? -1 : (a.d == b.u ? 0 : 1);
	213	+ case T_S64: return a.d < b.s ? -1 : (a.d == b.s ? 0 : 1);
	214	+ case T_BIG: return mpcmp(dtomp(a.d, cmpmpint), b.m);
	215	+ default: break;
220	216	}
221		− return da == db;
	217	+ break;
	218	+ case T_BIG:
	219	+ switch(bnt){
	220	+ case T_U64: return mpcmp(a.m, uvtomp(b.u, cmpmpint));
	221	+ case T_S64: return mpcmp(a.m, vtomp(b.s, cmpmpint));
	222	+ case T_F64: return isnan(b.d) ? 1 : mpcmp(a.m, dtomp(b.d, cmpmpint));
	223	+ default: break;
	224	+ }
	225	+ break;
	226	+ default:
	227	+ break;
222	228	}
223	229
224		− if(da != db)
225		− return false;
226		−
227		− if(cmpmpint == nil && (atag == T_BIG \|\| btag == T_BIG))
228		− cmpmpint = mpnew(0);
229		−
230		− if(atag == T_U64){
231		− // this is safe because if a had been bigger than INT64_MAX,
232		− // we would already have concluded that it's bigger than b.
233		− if(btag == T_S64)
234		− return (s64int)b >= 0 && (u64int)a == (u64int)b;
235		− if(btag == T_F64)
236		− return (double)b >= 0 && (u64int)a == (u64int)(double)b;
237		− if(btag == T_BIG)
238		− return mpcmp(uvtomp((u64int)a, cmpmpint), (mpint*)b) == 0;
239		− }
240		− if(atag == T_S64){
241		− if(btag == T_U64)
242		− return (s64int)a >= 0 && (u64int)a == (u64int)b;
243		− if(btag == T_F64)
244		− return (s64int)a == (s64int)(double)b;
245		− if(btag == T_BIG)
246		− return mpcmp(vtomp((s64int)a, cmpmpint), (mpint*)b) == 0;
247		− }
248		− if(btag == T_U64){
249		− if(atag == T_S64)
250		− return (s64int)a >= 0 && (u64int)b == (u64int)a;
251		− if(atag == T_F64)
252		− return (double)a >= 0 && (u64int)b == (u64int)(double)a;
253		− if(atag == T_BIG)
254		− return mpcmp((mpint)a, uvtomp((u64int*)b, cmpmpint)) == 0;
255		− }
256		− if(btag == T_S64){
257		− if(atag == T_U64)
258		− return (s64int)b >= 0 && (u64int)b == (u64int)a;
259		− if(atag == T_F64)
260		− return (s64int)b == (s64int)(double)a;
261		− if(atag == T_BIG)
262		− return mpcmp((mpint)a, vtomp((s64int*)b, cmpmpint)) == 0;
263		− }
264		− return true;
	230	+ abort();
265	231	}

src/operators.h+1−4

@@ -16,7 +16,4 @@ double conv_to_double(sl_v v, void *data, sl_numtype tag) sl_nonnull(2); · 15 unmodified lines
16	16	#define conv_to_ptr conv_to_p32
17	17	#endif
18	18
19		−bool cmp_same_lt(void a, void b, sl_numtype tag) sl_nonnull(1, 2);
20		−bool cmp_same_eq(void a, void b, sl_numtype tag) sl_nonnull(1, 2);
21		−bool cmp_lt(void a, sl_numtype atag, void b, sl_numtype btag) sl_nonnull(1, 3);
22		−bool cmp_eq(void a, sl_numtype atag, void b, sl_numtype btag, bool equalnans) sl_nonnull(1, 3);
	19	+int cmp_numeric(void ap, sl_numtype ant, void bp, sl_numtype bnt);

src/sl.h+6−1

@@ -58,10 +58,15 @@ typedef enum { · 57 unmodified lines
58	58	T_S64, T_U64,
59	59	T_P64,
60	60	T_UNBOXED_NUM,
61		− T_BIG = T_UNBOXED_NUM,
62	61	T_F32, T_F64,
	62	+
	63	+ // always a cvalue
	64	+ T_BIG = T_UNBOXED_NUM,
63	65	}sl_numtype;
64	66
	67	+#define is_nt_sint(nt) ((1<<(nt)) & (1<<T_S8 \| 1<<T_S16 \| 1<<T_S32 \| 1<<T_S64))
	68	+#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))
	69	+
65	70	#if defined(BITS64)
66	71	typedef s64int sl_fx;
67	72	#define FIXNUM_BITS (64-TAG_BITS)

src/vm.h+2−2

@@ -195,7 +195,7 @@ LABEL(apply_lt):; · 194 unmodified lines
195	195	break;
196	196	}
197	197	}else{
198		− int x = numeric_compare(a, b, false, false, false);
	198	+ int x = numeric_compare(a, b, false, false);
199	199	if(x > 1)
200	200	x = numval(sl_compare(a, b, false));
201	201	if(x >= 0){
@@ -663,7 +663,7 @@ LABEL(apply_numeqp):; · 461 unmodified lines
663	663	v = sl_nil;
664	664	break;
665	665	}
666		− }else if(numeric_compare(a, b, true, false, true) != 0){
	666	+ }else if(numeric_compare(a, b, true, true) != 0){
667	667	v = sl_nil;
668	668	break;
669	669	}

test/unittest.sl+16−16

@@ -217,10 +217,10 @@ · 216 unmodified lines
217	217	(assert (nan? -nan.0))
218	218	(assert (nan? (f32 +nan.0)))
219	219	(assert (nan? (f32 -nan.0)))
220		−(assert (equal? +nan.0 +nan.0))
221		−(assert (equal? -nan.0 -nan.0))
222		−(assert (equal? (f32 +nan.0) (f32 +nan.0)))
223		−(assert (equal? (f32 -nan.0) (f32 -nan.0)))
	220	+(assert (not (equal? +nan.0 +nan.0)))
	221	+(assert (not (equal? -nan.0 -nan.0)))
	222	+(assert (not (equal? (f32 +nan.0) (f32 +nan.0))))
	223	+(assert (not (equal? (f32 -nan.0) (f32 -nan.0))))
224	224	(assert (not (= +nan.0 +nan.0)))
225	225	(assert (not (= +nan.0 -nan.0)))
226	226	(assert (not (= -nan.0 -nan.0)))
@@ -261,22 +261,22 @@ · 34 unmodified lines
261	261	(assert (not (and (>= 2 1 2) (<= 2 1 2))))
262	262
263	263	; -0.0 etc.
264		−(assert (not (equal? 0.0 0)))
	264	+(assert (equal? 0.0 0))
265	265	(assert (equal? 0.0 0.0))
266		−(assert (not (equal? -0.0 0.0)))
267		−(assert (not (equal? -0.0 0)))
268		−(assert (not (eqv? 0.0 0)))
269		−(assert (not (eqv? -0.0 0)))
270		−(assert (not (eqv? -0.0 0.0)))
	266	+(assert (equal? -0.0 0.0))
	267	+(assert (equal? -0.0 0))
	268	+(assert (eqv? 0.0 0))
	269	+(assert (eqv? -0.0 0))
	270	+(assert (eqv? -0.0 0.0))
271	271	(assert (= 0.0 -0.0))
272	272	; same but f32
273		−(assert (not (equal? 0.0f 0)))
	273	+(assert (equal? 0.0f 0))
274	274	(assert (equal? 0.0f 0.0f))
275		−(assert (not (equal? -0.0f 0.0f)))
276		−(assert (not (equal? -0.0f 0)))
277		−(assert (not (eqv? 0.0f 0)))
278		−(assert (not (eqv? -0.0f 0)))
279		−(assert (not (eqv? -0.0f 0.0f)))
	275	+(assert (equal? -0.0f 0.0f))
	276	+(assert (equal? -0.0f 0))
	277	+(assert (eqv? 0.0f 0))
	278	+(assert (eqv? -0.0f 0))
	279	+(assert (eqv? -0.0f 0.0f))
280	280	(assert (= 0.0f -0.0f))
281	281
282	282	; and, or

rewrite numerical comparison logic

Keyboard shortcuts

General

Issues and pull requests

Issues, pull requests and Inbox

Repository code