mirror of
https://github.com/justinethier/cyclone.git
synced 2025-07-03 19:26:34 +02:00
Issue #510 - Implement exact using runtime functions
This commit is contained in:
parent
29a27098a8
commit
abaed9f6f2
3 changed files with 6 additions and 74 deletions
|
@ -504,74 +504,8 @@ int Cyc_have_mstreams();
|
||||||
} \
|
} \
|
||||||
return_closcall1(data, cont, &d)
|
return_closcall1(data, cont, &d)
|
||||||
|
|
||||||
/**
|
void Cyc_exact(void *data, object cont, object z);
|
||||||
* Implementation of exact
|
object Cyc_exact_no_cps(void *data, object ptr, object z);
|
||||||
*/
|
|
||||||
#define return_exact_op(data, cont, OP, z) \
|
|
||||||
int i = 0; \
|
|
||||||
Cyc_check_num(data, z); \
|
|
||||||
if (obj_is_int(z)) { \
|
|
||||||
i = obj_obj2int(z); \
|
|
||||||
} else if (type_of(z) == integer_tag) { \
|
|
||||||
i = (int)OP(((integer_type *)z)->value); \
|
|
||||||
} else if (type_of(z) == bignum_tag) { \
|
|
||||||
return_closcall1(data, cont, z); \
|
|
||||||
} else if (type_of(z) == complex_num_tag) { \
|
|
||||||
double dreal = OP(creal(((complex_num_type *) z)->value)); \
|
|
||||||
double dimag = OP(cimag(((complex_num_type *) z)->value)); \
|
|
||||||
make_complex_num(num, dreal, dimag); \
|
|
||||||
return_closcall1(data, cont, &num); \
|
|
||||||
} else { \
|
|
||||||
double d = ((double_type *)z)->value; \
|
|
||||||
if (isnan(d)) { \
|
|
||||||
Cyc_rt_raise2(data, "Expected number but received", z); \
|
|
||||||
} else if (d == INFINITY) { \
|
|
||||||
Cyc_rt_raise2(data, "Expected number but received", z); \
|
|
||||||
} else if (d == -INFINITY) { \
|
|
||||||
Cyc_rt_raise2(data, "Expected number but received", z); \
|
|
||||||
} else if (d > CYC_FIXNUM_MAX || d < CYC_FIXNUM_MIN){ \
|
|
||||||
alloc_bignum(data, bn); \
|
|
||||||
BIGNUM_CALL(mp_set_double(&bignum_value(bn), d)); \
|
|
||||||
return_closcall1(data, cont, bn); \
|
|
||||||
} \
|
|
||||||
i = (int)OP(((double_type *)z)->value); \
|
|
||||||
} \
|
|
||||||
return_closcall1(data, cont, obj_int2obj(i))
|
|
||||||
|
|
||||||
/**
|
|
||||||
* Directly compute exact
|
|
||||||
*/
|
|
||||||
#define return_exact_op_no_cps(data, ptr, OP, z) \
|
|
||||||
int i = 0; \
|
|
||||||
Cyc_check_num(data, z); \
|
|
||||||
if (obj_is_int(z)) { \
|
|
||||||
i = obj_obj2int(z); \
|
|
||||||
} else if (type_of(z) == integer_tag) { \
|
|
||||||
i = (int)OP(((integer_type *)z)->value); \
|
|
||||||
} else if (type_of(z) == bignum_tag) { \
|
|
||||||
return z; \
|
|
||||||
} else if (type_of(z) == complex_num_tag) { \
|
|
||||||
double dreal = OP(creal(((complex_num_type *) z)->value)); \
|
|
||||||
double dimag = OP(cimag(((complex_num_type *) z)->value)); \
|
|
||||||
double complex unboxed = dreal + (dimag * I); \
|
|
||||||
assign_complex_num(ptr, unboxed); \
|
|
||||||
return ptr; \
|
|
||||||
} else { \
|
|
||||||
double d = ((double_type *)z)->value; \
|
|
||||||
if (isnan(d)) { \
|
|
||||||
Cyc_rt_raise2(data, "Expected number but received", z); \
|
|
||||||
} else if (d == INFINITY) { \
|
|
||||||
Cyc_rt_raise2(data, "Expected number but received", z); \
|
|
||||||
} else if (d == -INFINITY) { \
|
|
||||||
Cyc_rt_raise2(data, "Expected number but received", z); \
|
|
||||||
} else if (d > CYC_FIXNUM_MAX || d < CYC_FIXNUM_MIN){ \
|
|
||||||
alloc_bignum(data, bn); \
|
|
||||||
BIGNUM_CALL(mp_set_double(&bignum_value(bn), d)); \
|
|
||||||
return bn; \
|
|
||||||
} \
|
|
||||||
i = (int)OP(((double_type *)z)->value); \
|
|
||||||
} \
|
|
||||||
return obj_int2obj(i);
|
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* Take Scheme object that is a number and return the number as a C type
|
* Take Scheme object that is a number and return the number as a C type
|
||||||
|
|
|
@ -8596,12 +8596,11 @@ void Cyc_exact(void *data, object cont, object z)
|
||||||
Cyc_rt_raise2(data, "Expected number but received", z);
|
Cyc_rt_raise2(data, "Expected number but received", z);
|
||||||
} else if (d == -INFINITY) {
|
} else if (d == -INFINITY) {
|
||||||
Cyc_rt_raise2(data, "Expected number but received", z);
|
Cyc_rt_raise2(data, "Expected number but received", z);
|
||||||
|
#if defined(__STDC_IEC_559__) || defined(__GCC_IEC_559)
|
||||||
} else if (d > CYC_FIXNUM_MAX || d < CYC_FIXNUM_MIN){
|
} else if (d > CYC_FIXNUM_MAX || d < CYC_FIXNUM_MIN){
|
||||||
alloc_bignum(data, bn);
|
alloc_bignum(data, bn);
|
||||||
BIGNUM_CALL(mp_set_double(&bignum_value(bn), d));
|
BIGNUM_CALL(mp_set_double(&bignum_value(bn), d));
|
||||||
return_closcall1(data, cont, bn);
|
return_closcall1(data, cont, bn);
|
||||||
// TODO: mp_set_double not supported on macos !?!
|
|
||||||
#if defined(__STDC_IEC_559__) || defined(__GCC_IEC_559)
|
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
i = (int)round(((double_type *)z)->value);
|
i = (int)round(((double_type *)z)->value);
|
||||||
|
@ -8633,12 +8632,11 @@ object Cyc_exact_no_cps(void *data, object ptr, object z)
|
||||||
Cyc_rt_raise2(data, "Expected number but received", z);
|
Cyc_rt_raise2(data, "Expected number but received", z);
|
||||||
} else if (d == -INFINITY) {
|
} else if (d == -INFINITY) {
|
||||||
Cyc_rt_raise2(data, "Expected number but received", z);
|
Cyc_rt_raise2(data, "Expected number but received", z);
|
||||||
|
#if defined(__STDC_IEC_559__) || defined(__GCC_IEC_559)
|
||||||
} else if (d > CYC_FIXNUM_MAX || d < CYC_FIXNUM_MIN){
|
} else if (d > CYC_FIXNUM_MAX || d < CYC_FIXNUM_MIN){
|
||||||
alloc_bignum(data, bn);
|
alloc_bignum(data, bn);
|
||||||
BIGNUM_CALL(mp_set_double(&bignum_value(bn), d));
|
BIGNUM_CALL(mp_set_double(&bignum_value(bn), d));
|
||||||
return bn;
|
return bn;
|
||||||
// TODO: mp_set_double not supported on macos !?!
|
|
||||||
#if defined(__STDC_IEC_559__) || defined(__GCC_IEC_559)
|
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
i = (int)round(((double_type *)z)->value);
|
i = (int)round(((double_type *)z)->value);
|
||||||
|
|
|
@ -1382,9 +1382,9 @@
|
||||||
" return_double_op_no_cps(data, ptr, round, z);")
|
" return_double_op_no_cps(data, ptr, round, z);")
|
||||||
(define-c exact
|
(define-c exact
|
||||||
"(void *data, int argc, closure _, object k, object z)"
|
"(void *data, int argc, closure _, object k, object z)"
|
||||||
" return_exact_op(data, k, round, z); "
|
" Cyc_exact(data, k, z); "
|
||||||
"(void *data, object ptr, object z)"
|
"(void *data, object ptr, object z)"
|
||||||
" return_exact_op_no_cps(data, ptr, round, z);")
|
" return Cyc_exact_no_cps(data, ptr, z);")
|
||||||
(define-c inexact
|
(define-c inexact
|
||||||
"(void *data, int argc, closure _, object k, object z)"
|
"(void *data, int argc, closure _, object k, object z)"
|
||||||
" return_inexact_double_or_cplx_op(data, k, (double), (double complex), z); "
|
" return_inexact_double_or_cplx_op(data, k, (double), (double complex), z); "
|
||||||
|
|
Loading…
Add table
Reference in a new issue