Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-03 19:26:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Issue #510 - Implement exact using runtime functions

Browse source
This commit is contained in:
Justin Ethier 2023-09-12 19:20:38 -07:00
parent 29a27098a8
commit abaed9f6f2
3 changed files with 6 additions and 74 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

70
include/cyclone/runtime.h
View file

@ -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

6
runtime.c
View file

@ -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);
@ -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);

4
scheme/base.sld
View file

@ -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); "