#include "sl.h"#include "operators.h" mpint *conv_to_bignum(sl_v v, void *data, sl_numtype tag){ switch(tag){ case T_S8: return itomp(*(s8int*)data, nil); case T_U8: return uitomp(*(u8int*)data, nil); case T_S16: return itomp(*(s16int*)data, nil); case T_U16: return uitomp(*(u16int*)data, nil); case T_S32: return itomp(*(s32int*)data, nil); case T_U32: case T_P32: return uitomp(*(u32int*)data, nil); case T_S64: return vtomp(*(s64int*)data, nil); case T_U64: case T_P64: return uvtomp(*(u64int*)data, nil); case T_BIG: return mpcopy(*(mpint**)data); case T_F32: return dtomp(*(float*)data, nil); case T_F64: return dtomp(*(double*)data, nil); } cthrow(type_error(nil, "num", v), v);} sl_purefndoubleconv_to_double(sl_v v, void *data, sl_numtype tag){ double d; switch(tag){ case T_S8: return *(s8int*)data; case T_U8: return *(u8int*)data; case T_S16: return *(s16int*)data; case T_U16: return *(u16int*)data; case T_S32: return *(s32int*)data; case T_U32: case T_P32: return *(u32int*)data; case T_S64: d = *(s64int*)data; if(d > 0 && *(s64int*)data < 0) // can happen! d = -d; return d; case T_U64: case T_P64: return *(u64int*)data; case T_BIG: return mptod(*(mpint**)data); case T_F32: return *(float*)data; case T_F64: return *(double*)data; } cthrow(type_error(nil, "num", v), v);} // FIXME sign with mpint#define CONV_TO_INTTYPE(name, ctype) \sl_purefn \ctype \conv_to_##name(sl_v v, void *data, sl_numtype tag) \{ \ switch(tag){ \ case T_S8: return (ctype)*(s8int*)data; \ case T_U8: return (ctype)*(u8int*)data; \ case T_S16: return (ctype)*(s16int*)data; \ case T_U16: return (ctype)*(u16int*)data; \ case T_S32: return (ctype)*(s32int*)data; \ case T_U32: case T_P32: return (ctype)*(u32int*)data; \ case T_S64: case T_P64: return (ctype)*(s64int*)data; \ case T_U64: return (ctype)*(u64int*)data; \ case T_BIG: return (ctype)mptov(*(mpint**)data); \ case T_F32: return (ctype)*(float*)data; \ case T_F64: return (ctype)*(double*)data; \ } \ cthrow(type_error(nil, "num", v), v); \} CONV_TO_INTTYPE(s64, s64int)CONV_TO_INTTYPE(s32, s32int)CONV_TO_INTTYPE(u32, u32int) // this is needed to work around an UB casting negative// floats and doubles to uint64. you need to cast to int64// first.sl_purefnu64intconv_to_u64(sl_v v, void *data, sl_numtype tag){ s64int s; switch(tag){ case T_S8: return *(s8int*)data; break; case T_U8: return *(u8int*)data; break; case T_S16: return *(s16int*)data; break; case T_U16: return *(u16int*)data; break; case T_S32: return *(s32int*)data; break; case T_U32: case T_P32: return *(u32int*)data; break; case T_S64: return *(s64int*)data; break; case T_U64: case T_P64: return *(u64int*)data; break; case T_BIG: return mptouv(*(mpint**)data); break; case T_F32: if(*(float*)data >= 0) return *(float*)data; s = *(float*)data; return s; case T_F64: if(*(double*)data >= 0) return *(double*)data; s = *(double*)data; return s; } cthrow(type_error(nil, "num", v), v);} static sl_purefnboolcmp_same_lt(void *a, void *b, sl_numtype tag){ switch(tag){ case T_S8: return *(s8int*)a < *(s8int*)b; case T_U8: return *(u8int*)a < *(u8int*)b; case T_S16: return *(s16int*)a < *(s16int*)b; case T_U16: return *(u16int*)a < *(u16int*)b; case T_S32: return *(s32int*)a < *(s32int*)b; case T_U32: case T_P32: return *(u32int*)a < *(u32int*)b; case T_S64: return *(s64int*)a < *(s64int*)b; case T_U64: case T_P64: return *(u64int*)a < *(u64int*)b; case T_BIG: return mpcmp(*(mpint**)a, *(mpint**)b) < 0; case T_F32: return *(float*)a < *(float*)b && !isnan(*(float*)a) && !isnan(*(float*)b); case T_F64: return *(double*)a < *(double*)b && !isnan(*(double*)a) && !isnan(*(double*)b); } return false;} static sl_purefnboolcmp_same_eq(void *a, void *b, sl_numtype tag){ switch(tag){ case T_S8: return *(s8int*)a == *(s8int*)b; case T_U8: return *(u8int*)a == *(u8int*)b; case T_S16: return *(s16int*)a == *(s16int*)b; case T_U16: return *(u16int*)a == *(u16int*)b; case T_S32: return *(s32int*)a == *(s32int*)b; case T_U32: case T_P32: return *(u32int*)a == *(u32int*)b; case T_S64: return *(s64int*)a == *(s64int*)b; case T_U64: case T_P64: return *(u64int*)a == *(u64int*)b; case T_BIG: return mpcmp(*(mpint**)a, *(mpint**)b) == 0; case T_F32: return *(float*)a == *(float*)b && !isnan(*(float*)a) && !isnan(*(float*)b); case T_F64: return *(double*)a == *(double*)b && !isnan(*(double*)a) && !isnan(*(double*)b); } return false;} /* FIXME one is allocated for all compare ops */static mpint *cmpmpint; static sl_numtypepromote(void *x, sl_numtype nt, void *d, mpint **m){ if(nt >= T_F32){ *(double*)d = conv_to_double(sl_nil, x, nt); nt = T_F64; }else if(is_nt_uint(nt)){ *(u64int*)d = conv_to_u64(sl_nil, x, nt); nt = T_U64; }else if(is_nt_sint(nt)){ *(s64int*)d = conv_to_s64(sl_nil, x, nt); nt = T_S64; }else if(nt == T_BIG){ if(cmpmpint == nil) cmpmpint = mpnew(128); *m = *(mpint**)x; }else abort(); return nt;} intcmp_numeric(void *ap, sl_numtype ant, void *bp, sl_numtype bnt){ if(ant == bnt){ if(cmp_same_eq(ap, bp, ant)) return 0; return cmp_same_lt(ap, bp, ant) ? -1 : 1; } union{ u64int u; s64int s; double d; mpint *m; }a, b; ant = promote(ap, ant, &a.u, &a.m); bnt = promote(bp, bnt, &b.u, &b.m); switch(ant){ case T_U64: switch(bnt){ case T_U64: return a.u < b.u ? -1 : (a.u == b.u ? 0 : 1); case T_S64: return a.u < b.u && b.s > 0 ? -1 : (a.u == b.u && b.s >= 0 ? 0 : 1); 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)); case T_BIG: return mpcmp(uvtomp(a.u, cmpmpint), b.m); default: break; } break; case T_S64: switch(bnt){ case T_S64: return a.s < b.s ? -1 : (a.s == b.s ? 0 : 1); case T_U64: return (a.s < 0 || a.u < b.u) ? -1 : (a.u == b.u && a.s >= 0 ? 0 : 1); case T_F64: return isnan(b.d) ? 1 : (a.s < b.d ? -1 : (a.s == b.d ? 0 : 1)); case T_BIG: return mpcmp(vtomp(a.s, cmpmpint), b.m); default: break; } break; case T_F64: if(isnan(a.d)) return 1; switch(bnt){ case T_F64: return isnan(b.d) ? 1 : (a.d < b.d ? -1 : (a.d == b.d ? 0 : 1)); case T_U64: return (a.d < 0 || a.d < b.u) ? -1 : (a.d == b.u ? 0 : 1); case T_S64: return a.d < b.s ? -1 : (a.d == b.s ? 0 : 1); case T_BIG: return mpcmp(dtomp(a.d, cmpmpint), b.m); default: break; } break; case T_BIG: switch(bnt){ case T_U64: return mpcmp(a.m, uvtomp(b.u, cmpmpint)); case T_S64: return mpcmp(a.m, vtomp(b.s, cmpmpint)); case T_F64: return isnan(b.d) ? 1 : mpcmp(a.m, dtomp(b.d, cmpmpint)); default: break; } break; default: break; } abort();}
#include "sl.h"
#include "operators.h"
mpint *
conv_to_bignum(sl_v v, void *data, sl_numtype tag)
{
switch(tag){
case T_S8: return itomp(*(s8int*)data, nil);
case T_U8: return uitomp(*(u8int*)data, nil);
case T_S16: return itomp(*(s16int*)data, nil);
case T_U16: return uitomp(*(u16int*)data, nil);
case T_S32: return itomp(*(s32int*)data, nil);
case T_U32: case T_P32: return uitomp(*(u32int*)data, nil);
case T_S64: return vtomp(*(s64int*)data, nil);
case T_U64: case T_P64: return uvtomp(*(u64int*)data, nil);
case T_BIG: return mpcopy(*(mpint**)data);
case T_F32: return dtomp(*(float*)data, nil);
case T_F64: return dtomp(*(double*)data, nil);
}
cthrow(type_error(nil, "num", v), v);
}
sl_purefn
double
conv_to_double(sl_v v, void *data, sl_numtype tag)
{
double d;
switch(tag){
case T_S8: return *(s8int*)data;
case T_U8: return *(u8int*)data;
case T_S16: return *(s16int*)data;
case T_U16: return *(u16int*)data;
case T_S32: return *(s32int*)data;
case T_U32: case T_P32: return *(u32int*)data;
case T_S64:
d = *(s64int*)data;
if(d > 0 && *(s64int*)data < 0) // can happen!
d = -d;
return d;
case T_U64: case T_P64: return *(u64int*)data;
case T_BIG: return mptod(*(mpint**)data);
case T_F32: return *(float*)data;
case T_F64: return *(double*)data;
}
cthrow(type_error(nil, "num", v), v);
}
// FIXME sign with mpint
#define CONV_TO_INTTYPE(name, ctype) \
sl_purefn \
ctype \
conv_to_##name(sl_v v, void *data, sl_numtype tag) \
{ \
switch(tag){ \
case T_S8: return (ctype)*(s8int*)data; \
case T_U8: return (ctype)*(u8int*)data; \
case T_S16: return (ctype)*(s16int*)data; \
case T_U16: return (ctype)*(u16int*)data; \
case T_S32: return (ctype)*(s32int*)data; \
case T_U32: case T_P32: return (ctype)*(u32int*)data; \
case T_S64: case T_P64: return (ctype)*(s64int*)data; \
case T_U64: return (ctype)*(u64int*)data; \
case T_BIG: return (ctype)mptov(*(mpint**)data); \
case T_F32: return (ctype)*(float*)data; \
case T_F64: return (ctype)*(double*)data; \
} \
cthrow(type_error(nil, "num", v), v); \
}
CONV_TO_INTTYPE(s64, s64int)
CONV_TO_INTTYPE(s32, s32int)
CONV_TO_INTTYPE(u32, u32int)
// this is needed to work around an UB casting negative
// floats and doubles to uint64. you need to cast to int64
// first.
sl_purefn
u64int
conv_to_u64(sl_v v, void *data, sl_numtype tag)
{
s64int s;
switch(tag){
case T_S8: return *(s8int*)data; break;
case T_U8: return *(u8int*)data; break;
case T_S16: return *(s16int*)data; break;
case T_U16: return *(u16int*)data; break;
case T_S32: return *(s32int*)data; break;
case T_U32: case T_P32: return *(u32int*)data; break;
case T_S64: return *(s64int*)data; break;
case T_U64: case T_P64: return *(u64int*)data; break;
case T_BIG: return mptouv(*(mpint**)data); break;
case T_F32:
if(*(float*)data >= 0)
return *(float*)data;
s = *(float*)data;
return s;
case T_F64:
if(*(double*)data >= 0)
return *(double*)data;
s = *(double*)data;
return s;
}
cthrow(type_error(nil, "num", v), v);
}
static sl_purefn
bool
cmp_same_lt(void *a, void *b, sl_numtype tag)
{
switch(tag){
case T_S8: return *(s8int*)a < *(s8int*)b;
case T_U8: return *(u8int*)a < *(u8int*)b;
case T_S16: return *(s16int*)a < *(s16int*)b;
case T_U16: return *(u16int*)a < *(u16int*)b;
case T_S32: return *(s32int*)a < *(s32int*)b;
case T_U32: case T_P32: return *(u32int*)a < *(u32int*)b;
case T_S64: return *(s64int*)a < *(s64int*)b;
case T_U64: case T_P64: return *(u64int*)a < *(u64int*)b;
case T_BIG: return mpcmp(*(mpint**)a, *(mpint**)b) < 0;
case T_F32: return *(float*)a < *(float*)b && !isnan(*(float*)a) && !isnan(*(float*)b);
case T_F64: return *(double*)a < *(double*)b && !isnan(*(double*)a) && !isnan(*(double*)b);
}
return false;
}
static sl_purefn
bool
cmp_same_eq(void *a, void *b, sl_numtype tag)
{
switch(tag){
case T_S8: return *(s8int*)a == *(s8int*)b;
case T_U8: return *(u8int*)a == *(u8int*)b;
case T_S16: return *(s16int*)a == *(s16int*)b;
case T_U16: return *(u16int*)a == *(u16int*)b;
case T_S32: return *(s32int*)a == *(s32int*)b;
case T_U32: case T_P32: return *(u32int*)a == *(u32int*)b;
case T_S64: return *(s64int*)a == *(s64int*)b;
case T_U64: case T_P64: return *(u64int*)a == *(u64int*)b;
case T_BIG: return mpcmp(*(mpint**)a, *(mpint**)b) == 0;
case T_F32: return *(float*)a == *(float*)b && !isnan(*(float*)a) && !isnan(*(float*)b);
case T_F64: return *(double*)a == *(double*)b && !isnan(*(double*)a) && !isnan(*(double*)b);
}
return false;
}
/* FIXME one is allocated for all compare ops */
static mpint *cmpmpint;
static sl_numtype
promote(void *x, sl_numtype nt, void *d, mpint **m)
{
if(nt >= T_F32){
*(double*)d = conv_to_double(sl_nil, x, nt);
nt = T_F64;
}else if(is_nt_uint(nt)){
*(u64int*)d = conv_to_u64(sl_nil, x, nt);
nt = T_U64;
}else if(is_nt_sint(nt)){
*(s64int*)d = conv_to_s64(sl_nil, x, nt);
nt = T_S64;
}else if(nt == T_BIG){
if(cmpmpint == nil)
cmpmpint = mpnew(128);
*m = *(mpint**)x;
}else
abort();
return nt;
}
int
cmp_numeric(void *ap, sl_numtype ant, void *bp, sl_numtype bnt)
{
if(ant == bnt){
if(cmp_same_eq(ap, bp, ant))
return 0;
return cmp_same_lt(ap, bp, ant) ? -1 : 1;
}
union{
u64int u;
s64int s;
double d;
mpint *m;
}a, b;
ant = promote(ap, ant, &a.u, &a.m);
bnt = promote(bp, bnt, &b.u, &b.m);
switch(ant){
case T_U64:
switch(bnt){
case T_U64: return a.u < b.u ? -1 : (a.u == b.u ? 0 : 1);
case T_S64: return a.u < b.u && b.s > 0 ? -1 : (a.u == b.u && b.s >= 0 ? 0 : 1);
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));
case T_BIG: return mpcmp(uvtomp(a.u, cmpmpint), b.m);
default: break;
}
break;
case T_S64:
switch(bnt){
case T_S64: return a.s < b.s ? -1 : (a.s == b.s ? 0 : 1);
case T_U64: return (a.s < 0 || a.u < b.u) ? -1 : (a.u == b.u && a.s >= 0 ? 0 : 1);
case T_F64: return isnan(b.d) ? 1 : (a.s < b.d ? -1 : (a.s == b.d ? 0 : 1));
case T_BIG: return mpcmp(vtomp(a.s, cmpmpint), b.m);
default: break;
}
break;
case T_F64:
if(isnan(a.d))
return 1;
switch(bnt){
case T_F64: return isnan(b.d) ? 1 : (a.d < b.d ? -1 : (a.d == b.d ? 0 : 1));
case T_U64: return (a.d < 0 || a.d < b.u) ? -1 : (a.d == b.u ? 0 : 1);
case T_S64: return a.d < b.s ? -1 : (a.d == b.s ? 0 : 1);
case T_BIG: return mpcmp(dtomp(a.d, cmpmpint), b.m);
default: break;
}
break;
case T_BIG:
switch(bnt){
case T_U64: return mpcmp(a.m, uvtomp(b.u, cmpmpint));
case T_S64: return mpcmp(a.m, vtomp(b.s, cmpmpint));
case T_F64: return isnan(b.d) ? 1 : mpcmp(a.m, dtomp(b.d, cmpmpint));
default: break;
}
break;
default:
break;
}
abort();
}