Skip to content

Commit

Permalink
Issue #510 - Implement exact using runtime functions
Browse files Browse the repository at this point in the history
  • Loading branch information
justinethier committed Sep 13, 2023
1 parent 29a2709 commit abaed9f
Show file tree
Hide file tree
Showing 3 changed files with 6 additions and 74 deletions.
70 changes: 2 additions & 68 deletions include/cyclone/runtime.h
Original file line number Diff line number Diff line change
Expand Up @@ -504,74 +504,8 @@ int Cyc_have_mstreams();
} \
return_closcall1(data, cont, &d)

/**
* Implementation of exact
*/
#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);
void Cyc_exact(void *data, object cont, object z);
object Cyc_exact_no_cps(void *data, object ptr, object z);

/**
* Take Scheme object that is a number and return the number as a C type
Expand Down
6 changes: 2 additions & 4 deletions runtime.c
Original file line number Diff line number Diff line change
Expand Up @@ -8596,12 +8596,11 @@ void Cyc_exact(void *data, object cont, object z)
Cyc_rt_raise2(data, "Expected number but received", z);
} else if (d == -INFINITY) {
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){
alloc_bignum(data, bn);
BIGNUM_CALL(mp_set_double(&bignum_value(bn), d));
return_closcall1(data, cont, bn);
// TODO: mp_set_double not supported on macos !?!
#if defined(__STDC_IEC_559__) || defined(__GCC_IEC_559)
#endif
}
i = (int)round(((double_type *)z)->value);
Expand Down Expand Up @@ -8633,12 +8632,11 @@ object Cyc_exact_no_cps(void *data, object ptr, object z)
Cyc_rt_raise2(data, "Expected number but received", z);
} else if (d == -INFINITY) {
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){
alloc_bignum(data, bn);
BIGNUM_CALL(mp_set_double(&bignum_value(bn), d));
return bn;
// TODO: mp_set_double not supported on macos !?!
#if defined(__STDC_IEC_559__) || defined(__GCC_IEC_559)
#endif
}
i = (int)round(((double_type *)z)->value);
Expand Down
4 changes: 2 additions & 2 deletions scheme/base.sld
Original file line number Diff line number Diff line change
Expand Up @@ -1382,9 +1382,9 @@
" return_double_op_no_cps(data, ptr, round, z);")
(define-c exact
"(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)"
" return_exact_op_no_cps(data, ptr, round, z);")
" return Cyc_exact_no_cps(data, ptr, z);")
(define-c inexact
"(void *data, int argc, closure _, object k, object z)"
" return_inexact_double_or_cplx_op(data, k, (double), (double complex), z); "
Expand Down

0 comments on commit abaed9f

Please sign in to comment.