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

Alternate set of numeric functions

Browse source
This commit is contained in:
Justin Ethier 2016-03-16 22:52:05 -04:00
parent 8f4e66a7f7
commit ad85ca9761
2 changed files with 93 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
include/cyclone/runtime.h
View file

@ -213,6 +213,15 @@ object Cyc_is_procedure(void *data, object o);
object Cyc_is_macro(object o);
object Cyc_is_eof_object(object o);
object Cyc_is_cvar(object o);
object Cyc_sum_op2(void *data, common_type *x, object y);
object Cyc_sub_op2(void *data, common_type *x, object y);
object Cyc_mul_op2(void *data, common_type *x, object y);
object Cyc_div_op2(void *data, common_type *x, object y);
object Cyc_sum2(void *data, object cont, int argc, object n, ...);
object Cyc_sub2(void *data, object cont, int argc, object n, ...);
object Cyc_mul2(void *data, object cont, int argc, object n, ...);
object Cyc_div2(void *data, object cont, int argc, object n, ...);
object Cyc_num_op_va_list2(void *data, int argc, object (fn_op(void *, common_type *, object)), object n, va_list ns, common_type *buf);
common_type Cyc_sum_op(void *data, object x, object y);
common_type Cyc_sub_op(void *data, object x, object y);
common_type Cyc_mul_op(void *data, object x, object y);

84
runtime.c
View file

@ -1432,6 +1432,90 @@ object __halt(object obj) {
return nil;
}
#define declare_num_op2(FUNC, FUNC_OP, FUNC_APPLY, OP, DIV) \
object FUNC_OP(void *data, common_type *x, object y) { \
int tx = type_of(x), ty = type_of(y); \
if (DIV && \
((ty == integer_tag && integer_value(y) == 0) || \
(ty == double_tag && double_value(y) == 0.0))) { \
Cyc_rt_raise_msg(data, "Divide by zero"); \
} \
if (tx == integer_tag && ty == integer_tag) { \
x->integer_t.value = (x->integer_t.value) OP ((integer_type *)y)->value; \
} else if (tx == double_tag && ty == integer_tag) { \
x->double_t.value = x->double_t.value OP ((integer_type *)y)->value; \
} else if (tx == integer_tag && ty == double_tag) { \
x->double_t.hdr.mark = gc_color_red; \
x->double_t.hdr.grayed = 0; \
x->double_t.tag = double_tag; \
x->double_t.value = x->integer_t.value OP ((double_type *)y)->value; \
} else if (tx == double_tag && ty == double_tag) { \
x->double_t.value = x->double_t.value OP ((double_type *)y)->value; \
} else { \
make_string(s, "Bad argument type"); \
make_cons(c1, y, nil); \
make_cons(c0, &s, &c1); \
Cyc_rt_raise(data, &c0); \
} \
return x; \
} \
object FUNC(void *data, object cont, int argc, object n, ...) { \
common_type buffer; \
object result; \
va_list ap; \
va_start(ap, n); \
result = Cyc_num_op_va_list2(data, argc, FUNC_OP, n, ap, &buffer); \
va_end(ap); \
return result; \
} \
void FUNC_APPLY(void *data, int argc, object clo, object cont, object n, ...) { \
common_type buffer; \
object result; \
va_list ap; \
va_start(ap, n); \
result = Cyc_num_op_va_list2(data, argc - 1, FUNC_OP, n, ap, &buffer); \
va_end(ap); \
return_closcall1(data, cont, &result); \
}
declare_num_op2(Cyc_sum2, Cyc_sum_op2, dispatch_sum2, +, 0);
declare_num_op2(Cyc_sub2, Cyc_sub_op2, dispatch_sub2, -, 0);
declare_num_op2(Cyc_mul2, Cyc_mul_op2, dispatch_mul2, *, 0);
declare_num_op2(Cyc_div2, Cyc_div_op2, dispatch_div2, /, 1);
object Cyc_num_op_va_list2(void *data, int argc, object (fn_op(void *, common_type *, object)), object n, va_list ns, common_type *buf) {
int i;
if (argc == 0) {
buf->integer_t.hdr.mark = gc_color_red;
buf->integer_t.hdr.grayed = 0;
buf->integer_t.tag = integer_tag;
buf->integer_t.value = 0;
return buf;
}
if (type_of(n) == integer_tag) {
buf->integer_t.hdr.mark = gc_color_red;
buf->integer_t.hdr.grayed = 0;
buf->integer_t.tag = integer_tag;
buf->integer_t.value = ((integer_type *)n)->value;
} else if (type_of(n) == double_tag) {
buf->double_t.hdr.mark = gc_color_red;
buf->double_t.hdr.grayed = 0;
buf->double_t.tag = double_tag;
buf->double_t.value = ((double_type *)n)->value;
} else {
make_string(s, "Bad argument type");
make_cons(c1, n, nil);
make_cons(c0, &s, &c1);
Cyc_rt_raise(data, &c0);
}
for (i = 1; i < argc; i++) {
fn_op(data, buf, va_arg(ns, object));
}
return buf;
}
// TODO: support for integer value types
#define declare_num_op(FUNC, FUNC_OP, FUNC_APPLY, OP, DIV) \
common_type FUNC_OP(void *data, object x, object y) { \