Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-14 08:17:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Added round, ceil, floor, truncate

Browse source
This commit is contained in:
Justin Ethier 2016-01-24 22:24:12 -05:00
parent 4dc2e78ce8
commit 48e88d41a7
2 changed files with 26 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
include/cyclone/runtime.h
View file

@ -93,6 +93,16 @@ object Cyc_global_set(void *thd, object *glo, object value);
} \ } \
return_closcall1(data, cont, &d) return_closcall1(data, cont, &d)
#define return_exact_double_op(data, cont, OP, z) \
make_int(i, 0); \
Cyc_check_num(data, z); \
if (type_of(z) == integer_tag) { \
i.value = (int)OP(((integer_type *)z)->value); \
} else { \
i.value = (int)OP(((double_type *)z)->value); \
} \
return_closcall1(data, cont, &i)
/* Prototypes for primitive functions. */ /* Prototypes for primitive functions. */
extern object Cyc_global_variables; extern object Cyc_global_variables;

16
scheme/base.sld
View file

@ -92,6 +92,10 @@
cond-expand cond-expand
when when
quasiquote quasiquote
floor
ceiling
truncate
round
) )
(begin (begin
;; Features implemented by this Scheme ;; Features implemented by this Scheme
@ -648,4 +652,16 @@
(else (else
#f)))) #f))))
(define-c floor
"(void *data, int argc, closure _, object k, object z)"
" return_exact_double_op(data, k, floor, z); ")
(define-c ceiling
"(void *data, int argc, closure _, object k, object z)"
" return_exact_double_op(data, k, ceil, z); ")
(define-c truncate
"(void *data, int argc, closure _, object k, object z)"
" return_exact_double_op(data, k, (int), z); ")
(define-c round
"(void *data, int argc, closure _, object k, object z)"
" return_exact_double_op(data, k, round, z); ")
)) ))