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

More integer_type conversions

Browse source
This commit is contained in:
justin 2016-03-15 10:48:58 -04:00
parent 33b56d24ea
commit 40b075ace9
2 changed files with 29 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
include/cyclone/runtime.h
View file

@ -11,10 +11,10 @@
/* Error checking definitions */
#define Cyc_check_num_args(data, fnc_name, num_args, args) { \
integer_type l = Cyc_length(data, args); \
if (num_args > l.value) { \
object l = Cyc_length2(data, args); \
if (num_args > obj_obj2int(l)) { \
char buf[128]; \
snprintf(buf, 127, "Expected %d arguments but received %d.", num_args, l.value); \
snprintf(buf, 127, "Expected %d arguments but received %d.", num_args, obj_obj2int(l)); \
Cyc_rt_raise_msg(data, buf); \
} \
}
@ -87,7 +87,9 @@ object Cyc_global_set(void *thd, object *glo, object value);
#define return_inexact_double_op(data, cont, OP, z) \
make_double(d, 0.0); \
Cyc_check_num(data, z); \
if (type_of(z) == integer_tag) { \
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 { \
d.value = OP(((double_type *)z)->value); \
@ -97,7 +99,9 @@ object Cyc_global_set(void *thd, object *glo, object value);
#define return_exact_double_op(data, cont, OP, z) \
make_int(i, 0); \
Cyc_check_num(data, z); \
if (type_of(z) == integer_tag) { \
if (obj_is_int(z)) { \
i.value = obj_obj2int(z); \
} else if (type_of(z) == integer_tag) { \
i.value = (int)OP(((integer_type *)z)->value); \
} else { \
i.value = (int)OP(((double_type *)z)->value); \
@ -105,9 +109,10 @@ object Cyc_global_set(void *thd, object *glo, object value);
return_closcall1(data, cont, &i)
#define unbox_number(n) \
((type_of(n) == integer_tag) ? \
((integer_type *)n)->value : \
((double_type *)n)->value)
((obj_is_int(n) ? obj_obj2int(n) : \
((type_of(n) == integer_tag) ? \
((integer_type *)n)->value : \
((double_type *)n)->value)))
/* Prototypes for primitive functions. */
@ -121,6 +126,7 @@ object Cyc_set_cvar(object var, object value);
object apply(void *data, object cont, object func, object args);
void Cyc_apply(void *data, int argc, closure cont, object prim, ...);
integer_type Cyc_string_cmp(void *data, object str1, object str2);
object Cyc_string_cmp2(void *data, object str1, object str2);
void dispatch_string_91append(void *data, int argc, object clo, object cont, object str1, ...);
list mcons(object,object);
cvar_type *mcvar(object *var);
@ -145,6 +151,8 @@ object Cyc_set_car(void *, object l, object val) ;
object Cyc_set_cdr(void *, object l, object val) ;
integer_type Cyc_length(void *d, object l);
integer_type Cyc_vector_length(void *data, object v);
object Cyc_length2(void *d, object l);
object Cyc_vector_length2(void *data, object v);
object Cyc_vector_ref(void *d, object v, object k);
object Cyc_vector_set(void *d, object v, object k, object obj);
object Cyc_make_vector(void *data, object cont, object len, object fill);
@ -160,13 +168,16 @@ int octstr2int(const char *str);
int hexstr2int(const char *str);
object Cyc_string_append(void *data, object cont, int argc, object str1, ...);
integer_type Cyc_string_length(void *data, object str);
object Cyc_string_length2(void *data, object str);
object Cyc_substring(void *data, object cont, object str, object start, object end);
object Cyc_string_ref(void *data, object str, object k);
object Cyc_string_set(void *data, object str, object k, object chr);
object Cyc_installation_dir(void *data, object cont, object type);
object Cyc_command_line_arguments(void *data, object cont);
integer_type Cyc_system(object cmd);
object Cyc_system2(object cmd);
integer_type Cyc_char2integer(object chr);
object Cyc_char2integer2(object chr);
object Cyc_integer2char(void *data, object n);
void Cyc_halt(closure);
object __halt(object obj);

14
scheme/base.sld
View file

@ -916,7 +916,9 @@
(define-c abs
"(void *data, int argc, closure _, object k, object num)"
" Cyc_check_num(data, num);
if (type_of(num) == integer_tag) {
if (obj_is_int(num)) {
return_closcall1(data, k, obj_int2obj( abs( obj_obj2int(num))));
} else if (type_of(num) == integer_tag) {
make_int(i, abs(((integer_type *)num)->value));
return_closcall1(data, k, &i);
} else {
@ -929,12 +931,16 @@
" int i, j;
Cyc_check_num(data, num1);
Cyc_check_num(data, num2);
if (type_of(num1) == integer_tag) {
if (obj_is_int(num1)) {
i = obj_obj2int(num1);
} else if (type_of(num1) == integer_tag) {
i = ((integer_type *)num1)->value;
} else if (type_of(num1) == double_tag) {
i = ((double_type *)num1)->value;
}
if (type_of(num2) == integer_tag) {
if (obj_is_int(num2)) {
j = obj_obj2int(num2);
} else if (type_of(num2) == integer_tag) {
j = ((integer_type *)num2)->value;
} else if (type_of(num2) == double_tag) {
j = ((double_type *)num2)->value;
@ -956,7 +962,7 @@
(define-c exact?
"(void *data, int argc, closure _, object k, object num)"
" Cyc_check_num(data, num);
if (type_of(num) == integer_tag)
if (obj_is_int(num) || type_of(num) == integer_tag)
return_closcall1(data, k, boolean_t);
return_closcall1(data, k, boolean_f); ")
(define (inexact? num) (not (exact? num)))