Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-23 20:15:05 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Complex number support

Browse source
This commit is contained in:
Justin Ethier 2018-05-14 14:20:24 -04:00
parent 0fd185a5fe
commit 1fcf947dd3
2 changed files with 52 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
include/cyclone/runtime.h
View file

@ -311,6 +311,44 @@ void Cyc_io_read_token(void *data, object cont, object port);
} \
return_closcall1(data, cont, &d)
#define return_inexact_double_or_cplx_op_no_cps(data, ptr, OP, CPLX_OP, z) \
double unboxed; \
Cyc_check_num(data, z); \
if (obj_is_int(z)) { \
unboxed = OP(obj_obj2int(z)); \
} else if (type_of(z) == integer_tag) { \
unboxed = OP(((integer_type *)z)->value); \
} else if (type_of(z) == bignum_tag) { \
unboxed = OP(mp_get_double(&bignum_value(z))); \
} else if (type_of(z) == complex_num_tag) { \
double complex unboxed = CPLX_OP(complex_num_value(z)); \
assign_complex_num(ptr, unboxed); \
return ptr; \
} else { \
unboxed = OP(((double_type *)z)->value); \
} \
assign_double(ptr, unboxed); \
return ptr;
#define return_inexact_double_or_cplx_op(data, cont, OP, CPLX_OP, z) \
make_double(d, 0.0); \
Cyc_check_num(data, z); \
if (obj_is_int(z)) { \
d.value = OP(obj_obj2int(z)); \
} else if (type_of(z) == integer_tag) { \
d.value = OP(((integer_type *)z)->value); \
} else if (type_of(z) == bignum_tag) { \
d.value = OP(mp_get_double(&bignum_value(z))); \
} else if (type_of(z) == complex_num_tag) { \
complex_num_type cn; \
double complex unboxed = CPLX_OP(complex_num_value(z)); \
assign_complex_num((&cn), unboxed); \
return_closcall1(data, cont, &cn); \
} else { \
d.value = OP(((double_type *)z)->value); \
} \
return_closcall1(data, cont, &d)
#define return_exact_double_op(data, cont, OP, z) \
int i = 0; \
Cyc_check_num(data, z); \

26
scheme/inexact.sld
View file

@ -27,14 +27,16 @@
(er-macro-transformer
(lambda (expr rename compare)
(let* ((fnc (cadr expr))
(op (caddr expr)))
(op (caddr expr))
(complex-op (cadddr expr))
)
`(define-c ,fnc
"(void *data, int argc, closure _, object k, object z)"
,(string-append
" return_inexact_double_op(data, k, " op ", z);")
" return_inexact_double_or_cplx_op(data, k, " op ", " complex-op ", z);")
"(void *data, object ptr, object z)"
,(string-append
" return_inexact_double_op_no_cps(data, ptr, " op ", z);"))))))
" return_inexact_double_or_cplx_op_no_cps(data, ptr, " op ", " complex-op ", z);"))))))
(define-c nan?
"(void *data, int argc, closure _, object k, object z)"
@ -65,13 +67,13 @@
(c-log z1)
(let ((z2* (car z2)))
(/ (c-log z1) (c-log z2*)))))
(define-inexact-op c-log "log")
(define-inexact-op exp "exp")
(define-inexact-op sqrt "sqrt")
(define-inexact-op sin "sin")
(define-inexact-op cos "cos")
(define-inexact-op tan "tan")
(define-inexact-op asin "asin")
(define-inexact-op acos "acos")
(define-inexact-op atan "atan")
(define-inexact-op c-log "log" "clog")
(define-inexact-op exp "exp" "cexp")
(define-inexact-op sqrt "sqrt" "csqrt")
(define-inexact-op sin "sin" "csin")
(define-inexact-op cos "cos" "ccos")
(define-inexact-op tan "tan" "ctan")
(define-inexact-op asin "asin" "casin")
(define-inexact-op acos "acos" "cacos")
(define-inexact-op atan "atan" "catan")
))