ref: 75fa6d220de69bdb91954ea8cf942611b25214cb
dir: /src/operators.c/
#include "flisp.h"
#include "operators.h"
mpint *
conv_to_mpint(void *data, numerictype_t tag)
{
switch(tag){
case T_INT8: return itomp(*(int8_t*)data, nil);
case T_UINT8: return uitomp(*(uint8_t*)data, nil);
case T_INT16: return itomp(*(int16_t*)data, nil);
case T_UINT16: return uitomp(*(uint16_t*)data, nil);
case T_INT32: return itomp(*(int32_t*)data, nil);
case T_UINT32: return uitomp(*(uint32_t*)data, nil);
case T_INT64: return vtomp(*(int64_t*)data, nil);
case T_UINT64: return uvtomp(*(uint64_t*)data, nil);
case T_MPINT: return mpcopy(*(mpint**)data);
case T_FLOAT: return dtomp(*(float*)data, nil);
case T_DOUBLE: return dtomp(*(double*)data, nil);
}
return mpzero;
}
fl_purefn
double
conv_to_double(void *data, numerictype_t tag)
{
double d;
switch(tag){
case T_INT8: return *(int8_t*)data;
case T_UINT8: return *(uint8_t*)data;
case T_INT16: return *(int16_t*)data;
case T_UINT16: return *(uint16_t*)data;
case T_INT32: return *(int32_t*)data;
case T_UINT32: return *(uint32_t*)data;
case T_INT64:
d = *(int64_t*)data;
if(d > 0 && *(int64_t*)data < 0) // can happen!
d = -d;
return d;
case T_UINT64: return *(uint64_t*)data;
case T_MPINT: return mptod(*(mpint**)data);
case T_FLOAT: return *(float*)data;
case T_DOUBLE: return *(double*)data;
}
return 0;
}
// FIXME sign with mpint
#define CONV_TO_INTTYPE(name, ctype) \
fl_purefn \
ctype \
conv_to_##name(void *data, numerictype_t tag) \
{ \
switch(tag){ \
case T_INT8: return (ctype)*(int8_t*)data; \
case T_UINT8: return (ctype)*(uint8_t*)data; \
case T_INT16: return (ctype)*(int16_t*)data; \
case T_UINT16: return (ctype)*(uint16_t*)data; \
case T_INT32: return (ctype)*(int32_t*)data; \
case T_UINT32: return (ctype)*(uint32_t*)data; \
case T_INT64: return (ctype)*(int64_t*)data; \
case T_UINT64: return (ctype)*(uint64_t*)data; \
case T_MPINT: return (ctype)mptov(*(mpint**)data); \
case T_FLOAT: return (ctype)*(float*)data; \
case T_DOUBLE: return (ctype)*(double*)data; \
} \
return 0; \
}
CONV_TO_INTTYPE(int64, int64_t)
CONV_TO_INTTYPE(int32, int32_t)
CONV_TO_INTTYPE(uint32, uint32_t)
// this is needed to work around an UB casting negative
// floats and doubles to uint64. you need to cast to int64
// first.
fl_purefn
uint64_t
conv_to_uint64(void *data, numerictype_t tag)
{
int64_t s;
switch(tag){
case T_INT8: return *(int8_t*)data; break;
case T_UINT8: return *(uint8_t*)data; break;
case T_INT16: return *(int16_t*)data; break;
case T_UINT16: return *(uint16_t*)data; break;
case T_INT32: return *(int32_t*)data; break;
case T_UINT32: return *(uint32_t*)data; break;
case T_INT64: return *(int64_t*)data; break;
case T_UINT64: return *(uint64_t*)data; break;
case T_MPINT: return mptouv(*(mpint**)data); break;
case T_FLOAT:
if(*(float*)data >= 0)
return *(float*)data;
s = *(float*)data;
return s;
case T_DOUBLE:
if(*(double*)data >= 0)
return *(double*)data;
s = *(double*)data;
return s;
}
return 0;
}
fl_purefn
bool
cmp_same_lt(void *a, void *b, numerictype_t tag)
{
switch(tag){
case T_INT8: return *(int8_t*)a < *(int8_t*)b;
case T_UINT8: return *(uint8_t*)a < *(uint8_t*)b;
case T_INT16: return *(int16_t*)a < *(int16_t*)b;
case T_UINT16: return *(uint16_t*)a < *(uint16_t*)b;
case T_INT32: return *(int32_t*)a < *(int32_t*)b;
case T_UINT32: return *(uint32_t*)a < *(uint32_t*)b;
case T_INT64: return *(int64_t*)a < *(int64_t*)b;
case T_UINT64: return *(uint64_t*)a < *(uint64_t*)b;
case T_MPINT: return mpcmp(*(mpint**)a, *(mpint**)b) < 0;
case T_FLOAT: return *(float*)a < *(float*)b;
case T_DOUBLE: return *(double*)a < *(double*)b;
}
return false;
}
fl_purefn
bool
cmp_same_eq(void *a, void *b, numerictype_t tag)
{
switch(tag){
case T_INT8: return *(int8_t*)a == *(int8_t*)b;
case T_UINT8: return *(uint8_t*)a == *(uint8_t*)b;
case T_INT16: return *(int16_t*)a == *(int16_t*)b;
case T_UINT16: return *(uint16_t*)a == *(uint16_t*)b;
case T_INT32: return *(int32_t*)a == *(int32_t*)b;
case T_UINT32: return *(uint32_t*)a == *(uint32_t*)b;
case T_INT64: return *(int64_t*)a == *(int64_t*)b;
case T_UINT64: return *(uint64_t*)a == *(uint64_t*)b;
case T_MPINT: return mpcmp(*(mpint**)a, *(mpint**)b) == 0;
case T_FLOAT: return *(float*)a == *(float*)b && !isnan(*(float*)a);
case T_DOUBLE: return *(double*)a == *(double*)b && !isnan(*(double*)b);
}
return false;
}
/* FIXME one is allocated for all compare ops */
static mpint *cmpmpint;
bool
cmp_lt(void *a, numerictype_t atag, void *b, numerictype_t btag)
{
if(atag == btag)
return cmp_same_lt(a, b, atag);
double da = conv_to_double(a, atag);
double db = conv_to_double(b, btag);
// casting to double will only get the wrong answer for big int64s
// that differ in low bits
if(da < db && !isnan(da) && !isnan(db))
return true;
if(db < da)
return false;
if(cmpmpint == nil && (atag == T_MPINT || btag == T_MPINT))
cmpmpint = mpnew(0);
if(atag == T_UINT64){
if(btag == T_INT64)
return *(int64_t*)b >= 0 && *(uint64_t*)a < (uint64_t)*(int64_t*)b;
if(btag == T_DOUBLE)
return db >= 0 ? *(uint64_t*)a < (uint64_t)*(double*)b : 0;
if(btag == T_MPINT)
return mpcmp(uvtomp(*(uint64_t*)a, cmpmpint), *(mpint**)b) < 0;
}
if(atag == T_INT64){
if(btag == T_UINT64)
return *(int64_t*)a >= 0 && (uint64_t)*(int64_t*)a < *(uint64_t*)b;
if(btag == T_DOUBLE)
return db == db ? *(int64_t*)a < (int64_t)*(double*)b : 0;
if(btag == T_MPINT)
return mpcmp(vtomp(*(int64_t*)a, cmpmpint), *(mpint**)b) < 0;
}
if(btag == T_UINT64){
if(atag == T_DOUBLE)
return da >= 0 ? *(uint64_t*)b > (uint64_t)*(double*)a : 0;
if(atag == T_MPINT)
return mpcmp(*(mpint**)a, uvtomp(*(uint64_t*)b, cmpmpint)) < 0;
}
if(btag == T_INT64){
if(atag == T_DOUBLE)
return da == da ? *(int64_t*)b > (int64_t)*(double*)a : 0;
if(atag == T_MPINT)
return mpcmp(*(mpint**)a, vtomp(*(int64_t*)b, cmpmpint)) < 0;
}
return false;
}
bool
cmp_eq(void *a, numerictype_t atag, void *b, numerictype_t btag, bool equalnans)
{
union {
double d;
int64_t i64;
}u, v;
if(atag == btag && (!equalnans || atag < T_FLOAT))
return cmp_same_eq(a, b, atag);
double da = conv_to_double(a, atag);
double db = conv_to_double(b, btag);
if((int)atag >= T_FLOAT && (int)btag >= T_FLOAT){
if(equalnans){
u.d = da; v.d = db;
return u.i64 == v.i64;
}
return da == db;
}
if(da != db)
return false;
if(cmpmpint == nil && (atag == T_MPINT || btag == T_MPINT))
cmpmpint = mpnew(0);
if(atag == T_UINT64){
// this is safe because if a had been bigger than INT64_MAX,
// we would already have concluded that it's bigger than b.
if(btag == T_INT64)
return *(int64_t*)b >= 0 && *(uint64_t*)a == *(uint64_t*)b;
if(btag == T_DOUBLE)
return *(double*)b >= 0 && *(uint64_t*)a == (uint64_t)*(double*)b;
if(btag == T_MPINT)
return mpcmp(uvtomp(*(uint64_t*)a, cmpmpint), *(mpint**)b) == 0;
}
if(atag == T_INT64){
if(btag == T_UINT64)
return *(int64_t*)a >= 0 && *(uint64_t*)a == *(uint64_t*)b;
if(btag == T_DOUBLE)
return *(int64_t*)a == (int64_t)*(double*)b;
if(btag == T_MPINT)
return mpcmp(vtomp(*(int64_t*)a, cmpmpint), *(mpint**)b) == 0;
}
if(btag == T_UINT64){
if(atag == T_INT64)
return *(int64_t*)a >= 0 && *(uint64_t*)b == *(uint64_t*)a;
if(atag == T_DOUBLE)
return *(double*)a >= 0 && *(uint64_t*)b == (uint64_t)*(double*)a;
if(atag == T_MPINT)
return mpcmp(*(mpint**)a, uvtomp(*(uint64_t*)b, cmpmpint)) == 0;
}
if(btag == T_INT64){
if(atag == T_UINT64)
return *(int64_t*)b >= 0 && *(uint64_t*)b == *(uint64_t*)a;
if(atag == T_DOUBLE)
return *(int64_t*)b == (int64_t)*(double*)a;
if(atag == T_MPINT)
return mpcmp(*(mpint**)a, vtomp(*(int64_t*)b, cmpmpint)) == 0;
}
return true;
}