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

va_args version of apply for eval

Browse source
This commit is contained in:
Justin Ethier 2016-06-29 22:14:58 -04:00
parent 552fb19822
commit 63e476839f
2 changed files with 71 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
include/cyclone/types.h
View file

@ -440,6 +440,13 @@ typedef pair_type *pair;
n.pair_car = a; \ n.pair_car = a; \
n.pair_cdr = d; n.pair_cdr = d;
#define set_pair(n,a,d) \
n->hdr.mark = gc_color_red; \
n->hdr.grayed = 0; \
n->tag = pair_tag; \
n->pair_car = a; \
n->pair_cdr = d;
#define make_cell(n,a) make_pair(n,a,NULL); #define make_cell(n,a) make_pair(n,a,NULL);
#define car(x) (((pair_type *) x)->pair_car) #define car(x) (((pair_type *) x)->pair_car)

72
runtime.c
View file

@ -3248,28 +3248,80 @@ void apply_va(void *data, object cont, int argc, object func, ...)
apply(data, cont, func, tmp); apply(data, cont, func, tmp);
} }
#define stack_append(lis, value) { \
pair_type *tmp2 = alloca(sizeof(pair_type)); \
set_pair(tmp2, value, lis); \
lis = tmp2; \
}
#define stack_list_prepend(src, dest) { \
while (src) { \
pair_type *tmp2 = alloca(sizeof(pair_type)); \
set_pair(tmp2, car(src), dest); \
dest = tmp2; \
src = cdr(src); \
} \
}
void dispatch_apply_va(void *data, int argc, object clo, object cont, object func, ...) void dispatch_apply_va(void *data, int argc, object clo, object cont, object func, ...)
{ {
object tmp = NULL; list lis = NULL, tmp, l;
int i; int i;
va_list ap; va_list ap;
argc = argc - 1; // Required for "dispatch" function argc = argc - 1; // Required for "dispatch" function
// TODO: pack all this up in a macro, and use it for apply_va also // TODO: pack all this up in a macro, and use it for apply_va also
// TODO: validate last arg is a list // TODO: validate last arg is a list
// TODO: if only one non-func arg, just call apply with it (fast path)
// TODO: else, append all args to a new list (local allocs via alloca),
// and apply that list
va_start(ap, func); va_start(ap, func);
if (argc == 2) {
// Fast path, nothing to append
lis = va_arg(ap, object);
Cyc_check_pair_or_null(data, lis);
} else {
for (i = 1; i < argc; i++) { for (i = 1; i < argc; i++) {
tmp = va_arg(ap, object); tmp = va_arg(ap, object);
if (tmp == NULL){
continue;
} else if (is_object_type(tmp)) {
if (type_of(tmp) == pair_tag) {
l = tmp;
stack_list_prepend(l, lis);
//while (l) {
// pair_type *tmp2 = alloca(sizeof(pair_type));
// set_pair(tmp2, car(l), lis);
// lis = tmp2;
// l = cdr(l);
//}
} else {
stack_append(lis, tmp);
//pair_type *tmp2 = alloca(sizeof(pair_type));
//set_pair(tmp2, tmp, lis);
//lis = tmp2;
}
} else {
stack_append(lis, tmp);
//pair_type *tmp2 = alloca(sizeof(pair_type));
//set_pair(tmp2, tmp, lis);
//lis = tmp2;
}
}
// Reverse lis
l = lis;
lis = NULL;
stack_list_prepend(l, lis);
//while (l) {
// pair_type *tmp2 = alloca(sizeof(pair_type));
// set_pair(tmp2, car(l), lis);
// lis = tmp2;
// l = cdr(l);
//}
} }
va_end(ap); va_end(ap);
// fprintf(stdout, "DEBUG applying argc %d, func ", argc); //fprintf(stdout, "DEBUG applying argc %d, func ", argc);
// Cyc_display(func, stdout); //Cyc_display(func, stdout);
// fprintf(stdout, " to values "); //fprintf(stdout, " to values ");
// Cyc_display(tmp, stdout); //Cyc_display(lis, stdout);
// fprintf(stdout, "\n"); //fprintf(stdout, "\n");
apply(data, cont, func, tmp); apply(data, cont, func, lis);
} }
/* /*