diff --git a/contrib/10.callcc/callcc.c b/contrib/10.callcc/callcc.c index 00c35a8c..8f6a2c15 100644 --- a/contrib/10.callcc/callcc.c +++ b/contrib/10.callcc/callcc.c @@ -1,4 +1,5 @@ #include "picrin.h" +#include "picrin/object.h" struct pic_fullcont { jmp_buf jmp; @@ -29,7 +30,7 @@ struct pic_fullcont { struct pic_object **arena; size_t arena_size, arena_idx; - pic_value results; + pic_vec *results; }; static void @@ -91,7 +92,7 @@ cont_mark(pic_state *pic, void *data, void (*mark)(pic_state *, pic_value)) mark(pic, cont->ptable); /* result values */ - mark(pic, cont->results); + mark(pic, pic_obj_value(cont->results)); } static const pic_data_type cont_type = { "continuation", cont_dtor, cont_mark }; @@ -158,7 +159,7 @@ save_cont(pic_state *pic, struct pic_fullcont **c) cont->arena = pic_malloc(pic, sizeof(struct pic_object *) * pic->arena_size); memcpy(cont->arena, pic->arena, sizeof(struct pic_object *) * pic->arena_size); - cont->results = pic_undef_value(pic); + cont->results = pic_make_vec(pic, 0, NULL); } static void @@ -225,7 +226,7 @@ cont_call(pic_state *pic) pic_get_args(pic, "*", &argc, &argv); cont = pic_data(pic, pic_closure_ref(pic, 0)); - cont->results = pic_make_list(pic, argc, argv); + cont->results = pic_make_vec(pic, argc, argv); /* execute guard handlers */ pic_wind(pic, pic->cp, cont->cp); @@ -233,36 +234,14 @@ cont_call(pic_state *pic) restore_cont(pic, cont); } -pic_value -pic_callcc_full(pic_state *pic, struct pic_proc *proc) -{ - struct pic_fullcont *cont; - - save_cont(pic, &cont); - if (setjmp(cont->jmp)) { - return pic_values_by_list(pic, cont->results); - } - else { - struct pic_proc *c; - - /* save the continuation object in proc */ - c = pic_lambda(pic, cont_call, 1, pic_obj_value(pic_data_value(pic, cont, &cont_type))); - - return pic_call(pic, proc, 1, pic_obj_value(c)); - } -} - static pic_value -pic_callcc_callcc(pic_state *pic) +pic_callcc(pic_state *pic, struct pic_proc *proc) { - struct pic_proc *proc; struct pic_fullcont *cont; - pic_get_args(pic, "l", &proc); - save_cont(pic, &cont); if (setjmp(cont->jmp)) { - return pic_values_by_list(pic, cont->results); + return pic_valuesk(pic, cont->results->len, cont->results->data); } else { struct pic_proc *c; @@ -276,6 +255,16 @@ pic_callcc_callcc(pic_state *pic) } } +static pic_value +pic_callcc_callcc(pic_state *pic) +{ + struct pic_proc *proc; + + pic_get_args(pic, "l", &proc); + + return pic_callcc(pic, proc); +} + #define pic_redefun(pic, lib, name, func) \ pic_set(pic, lib, name, pic_obj_value(pic_lambda(pic, func, 0))) diff --git a/contrib/10.math/math.c b/contrib/10.math/math.c index 0fc2ff92..cbaeec7a 100644 --- a/contrib/10.math/math.c +++ b/contrib/10.math/math.c @@ -17,13 +17,13 @@ pic_number_floor2(pic_state *pic) ? i / j : (i / j) - 1; - return pic_values2(pic, pic_int_value(pic, k), pic_int_value(pic, i - k * j)); + return pic_return(pic, 2, pic_int_value(pic, k), pic_int_value(pic, i - k * j)); } else { double q, r; q = floor((double)i/j); r = i - j * q; - return pic_values2(pic, pic_float_value(pic, q), pic_float_value(pic, r)); + return pic_return(pic, 2, pic_float_value(pic, q), pic_float_value(pic, r)); } } @@ -36,14 +36,14 @@ pic_number_trunc2(pic_state *pic) pic_get_args(pic, "II", &i, &e1, &j, &e2); if (e1 && e2) { - return pic_values2(pic, pic_int_value(pic, i/j), pic_int_value(pic, i - (i/j) * j)); + return pic_return(pic, 2, pic_int_value(pic, i/j), pic_int_value(pic, i - (i/j) * j)); } else { double q, r; q = trunc((double)i/j); r = i - j * q; - return pic_values2(pic, pic_float_value(pic, q), pic_float_value(pic, r)); + return pic_return(pic, 2, pic_float_value(pic, q), pic_float_value(pic, r)); } } diff --git a/contrib/30.regexp/src/regexp.c b/contrib/30.regexp/src/regexp.c index fd8bca76..dd611975 100644 --- a/contrib/30.regexp/src/regexp.c +++ b/contrib/30.regexp/src/regexp.c @@ -125,7 +125,7 @@ pic_regexp_regexp_match(pic_state *pic) matches = pic_reverse(pic, matches); positions = pic_reverse(pic, positions); } - return pic_values2(pic, matches, positions); + return pic_return(pic, 2, matches, positions); } static pic_value diff --git a/extlib/benz/cont.c b/extlib/benz/cont.c index 7bce50f8..9eeb20bf 100644 --- a/extlib/benz/cont.c +++ b/extlib/benz/cont.c @@ -5,6 +5,40 @@ #include "picrin.h" #include "picrin/object.h" +void +pic_save_point(pic_state *pic, struct pic_cont *cont) +{ + /* save runtime context */ + cont->cp = pic->cp; + cont->sp_offset = pic->sp - pic->stbase; + cont->ci_offset = pic->ci - pic->cibase; + cont->xp_offset = pic->xp - pic->xpbase; + cont->arena_idx = pic->arena_idx; + cont->ip = pic->ip; + cont->ptable = pic->ptable; + cont->prev = pic->cc; + cont->results = pic_make_vec(pic, 0, NULL); + cont->id = pic->ccnt++; + + pic->cc = cont; +} + +void +pic_load_point(pic_state *pic, struct pic_cont *cont) +{ + pic_wind(pic, pic->cp, cont->cp); + + /* load runtime context */ + pic->cp = cont->cp; + pic->sp = pic->stbase + cont->sp_offset; + pic->ci = pic->cibase + cont->ci_offset; + pic->xp = pic->xpbase + cont->xp_offset; + pic->arena_idx = cont->arena_idx; + pic->ip = cont->ip; + pic->ptable = cont->ptable; + pic->cc = cont->prev; +} + void pic_wind(pic_state *pic, pic_checkpoint *here, pic_checkpoint *there) { @@ -21,7 +55,7 @@ pic_wind(pic_state *pic, pic_checkpoint *here, pic_checkpoint *there) } } -pic_value +static pic_value pic_dynamic_wind(pic_state *pic, struct pic_proc *in, struct pic_proc *thunk, struct pic_proc *out) { pic_checkpoint *here; @@ -49,40 +83,6 @@ pic_dynamic_wind(pic_state *pic, struct pic_proc *in, struct pic_proc *thunk, st return val; } -void -pic_save_point(pic_state *pic, struct pic_cont *cont) -{ - /* save runtime context */ - cont->cp = pic->cp; - cont->sp_offset = pic->sp - pic->stbase; - cont->ci_offset = pic->ci - pic->cibase; - cont->xp_offset = pic->xp - pic->xpbase; - cont->arena_idx = pic->arena_idx; - cont->ip = pic->ip; - cont->ptable = pic->ptable; - cont->prev = pic->cc; - cont->results = pic_undef_value(pic); - cont->id = pic->ccnt++; - - pic->cc = cont; -} - -void -pic_load_point(pic_state *pic, struct pic_cont *cont) -{ - pic_wind(pic, pic->cp, cont->cp); - - /* load runtime context */ - pic->cp = cont->cp; - pic->sp = pic->stbase + cont->sp_offset; - pic->ci = pic->cibase + cont->ci_offset; - pic->xp = pic->xpbase + cont->xp_offset; - pic->arena_idx = cont->arena_idx; - pic->ip = cont->ip; - pic->ptable = cont->ptable; - pic->cc = cont->prev; -} - #define CV_ID 0 #define CV_ESCAPE 1 @@ -109,7 +109,7 @@ cont_call(pic_state *pic) } cont = pic_data_ptr(pic_closure_ref(pic, CV_ESCAPE))->data; - cont->results = pic_make_list(pic, argc, argv); + cont->results = pic_make_vec(pic, argc, argv); pic_load_point(pic, cont); @@ -130,7 +130,7 @@ pic_make_cont(pic_state *pic, struct pic_cont *cont) return c; } -pic_value +static pic_value pic_callcc(pic_state *pic, struct pic_proc *proc) { struct pic_cont cont; @@ -138,7 +138,7 @@ pic_callcc(pic_state *pic, struct pic_proc *proc) pic_save_point(pic, &cont); if (PIC_SETJMP(pic, cont.jmp)) { - return pic_values_by_list(pic, cont.results); + return pic_valuesk(pic, cont.results->len, cont.results->data); } else { pic_value val; @@ -151,88 +151,43 @@ pic_callcc(pic_state *pic, struct pic_proc *proc) } } -static pic_value -pic_va_values(pic_state *pic, int n, ...) +pic_value +pic_return(pic_state *pic, int n, ...) { - pic_vec *args = pic_make_vec(pic, n); va_list ap; - int i = 0; + pic_value ret; va_start(ap, n); - - while (i < n) { - args->data[i++] = va_arg(ap, pic_value); - } - + ret = pic_vreturn(pic, n, ap); va_end(ap); - - return pic_values(pic, n, args->data); + return ret; } pic_value -pic_values0(pic_state *pic) +pic_vreturn(pic_state *pic, int n, va_list ap) { - return pic_va_values(pic, 0); + pic_value *retv = pic_alloca(pic, sizeof(pic_value) * n); + int i; + + for (i = 0; i < n; ++i) { + retv[i] = va_arg(ap, pic_value); + } + return pic_valuesk(pic, n, retv); } pic_value -pic_values1(pic_state *pic, pic_value arg1) -{ - return pic_va_values(pic, 1, arg1); -} - -pic_value -pic_values2(pic_state *pic, pic_value arg1, pic_value arg2) -{ - return pic_va_values(pic, 2, arg1, arg2); -} - -pic_value -pic_values3(pic_state *pic, pic_value arg1, pic_value arg2, pic_value arg3) -{ - return pic_va_values(pic, 3, arg1, arg2, arg3); -} - -pic_value -pic_values4(pic_state *pic, pic_value arg1, pic_value arg2, pic_value arg3, pic_value arg4) -{ - return pic_va_values(pic, 4, arg1, arg2, arg3, arg4); -} - -pic_value -pic_values5(pic_state *pic, pic_value arg1, pic_value arg2, pic_value arg3, pic_value arg4, pic_value arg5) -{ - return pic_va_values(pic, 5, arg1, arg2, arg3, arg4, arg5); -} - -pic_value -pic_values(pic_state *pic, int argc, pic_value *argv) +pic_valuesk(pic_state *pic, int argc, pic_value *argv) { int i; for (i = 0; i < argc; ++i) { pic->sp[i] = argv[i]; } - pic->ci->retc = (int)argc; + pic->ci->retc = argc; return argc == 0 ? pic_undef_value(pic) : pic->sp[0]; } -pic_value -pic_values_by_list(pic_state *pic, pic_value list) -{ - pic_value v, it; - int i; - - i = 0; - pic_for_each (v, list, it) { - pic->sp[i++] = v; - } - pic->ci->retc = i; - - return pic_nil_p(pic, list) ? pic_undef_value(pic) : pic->sp[0]; -} - int pic_receive(pic_state *pic, int n, pic_value *argv) { @@ -246,7 +201,6 @@ pic_receive(pic_state *pic, int n, pic_value *argv) for (i = 0; i < retc && i < n; ++i) { argv[i] = ci->fp[i]; } - return retc; } @@ -278,7 +232,7 @@ pic_cont_values(pic_state *pic) pic_get_args(pic, "*", &argc, &argv); - return pic_values(pic, argc, argv); + return pic_valuesk(pic, argc, argv); } static pic_value @@ -293,7 +247,7 @@ pic_cont_call_with_values(pic_state *pic) pic_call(pic, producer, 0); argc = pic_receive(pic, 0, NULL); - args = pic_make_vec(pic, argc); + args = pic_make_vec(pic, argc, NULL); pic_receive(pic, argc, args->data); diff --git a/extlib/benz/eval.c b/extlib/benz/eval.c index 2d112e74..264c3272 100644 --- a/extlib/benz/eval.c +++ b/extlib/benz/eval.c @@ -230,7 +230,7 @@ analyze_lambda(pic_state *pic, analyze_scope *up, pic_value form) body = analyze(pic, scope, body); analyze_deferred(pic, scope); - args = pic_make_vec(pic, kh_size(&scope->args)); + args = pic_make_vec(pic, kh_size(&scope->args), NULL); for (i = 0; pic_pair_p(pic, formals); formals = pic_cdr(pic, formals), i++) { args->data[i] = pic_car(pic, formals); } @@ -239,7 +239,7 @@ analyze_lambda(pic_state *pic, analyze_scope *up, pic_value form) rest = pic_obj_value(scope->rest); } - locals = pic_make_vec(pic, kh_size(&scope->locals)); + locals = pic_make_vec(pic, kh_size(&scope->locals), NULL); j = 0; if (scope->rest != NULL) { locals->data[j++] = pic_obj_value(scope->rest); @@ -252,7 +252,7 @@ analyze_lambda(pic_state *pic, analyze_scope *up, pic_value form) } } - captures = pic_make_vec(pic, kh_size(&scope->captures)); + captures = pic_make_vec(pic, kh_size(&scope->captures), NULL); for (it = kh_begin(&scope->captures), j = 0; it < kh_end(&scope->captures); ++it) { if (kh_exist(&scope->captures, it)) { captures->data[j++] = pic_obj_value(kh_key(&scope->captures, it)); @@ -818,7 +818,7 @@ codegen(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos) static struct pic_irep * pic_codegen(pic_state *pic, pic_value obj) { - pic_vec *empty = pic_make_vec(pic, 0); + pic_vec *empty = pic_make_vec(pic, 0, NULL); codegen_context c, *cxt = &c; codegen_context_init(pic, cxt, NULL, NULL, empty, empty, empty); diff --git a/extlib/benz/include/picrin.h b/extlib/benz/include/picrin.h index 08637904..907bd3dc 100644 --- a/extlib/benz/include/picrin.h +++ b/extlib/benz/include/picrin.h @@ -100,6 +100,11 @@ pic_value pic_closure_ref(pic_state *, int i); void pic_closure_set(pic_state *, int i, pic_value v); pic_value pic_funcall(pic_state *, const char *lib, const char *name, int n, ...); +pic_value pic_return(pic_state *, int n, ...); +pic_value pic_vreturn(pic_state *, int n, va_list); +pic_value pic_valuesk(pic_state *, int n, pic_value *retv); +int pic_receive(pic_state *, int n, pic_value *retv); + void pic_make_library(pic_state *, const char *lib); void pic_in_library(pic_state *, const char *lib); bool pic_find_library(pic_state *, const char *lib); @@ -230,7 +235,7 @@ pic_value pic_reverse(pic_state *, pic_value list); pic_value pic_append(pic_state *, pic_value xs, pic_value ys); /* vector */ -pic_vec *pic_make_vec(pic_state *, int); +pic_vec *pic_make_vec(pic_state *, int, pic_value *); pic_value pic_vec_ref(pic_state *, pic_vec *, int); void pic_vec_set(pic_state *, pic_vec *, int, pic_value); int pic_vec_len(pic_state *, pic_vec *); @@ -272,7 +277,6 @@ int pic_str_hash(pic_state *, struct pic_string *); #include "picrin/type.h" #include "picrin/state.h" - #include "picrin/cont.h" void *pic_default_allocf(void *, void *, size_t); diff --git a/extlib/benz/include/picrin/cont.h b/extlib/benz/include/picrin/cont.h index b224597d..6b6edcf0 100644 --- a/extlib/benz/include/picrin/cont.h +++ b/extlib/benz/include/picrin/cont.h @@ -22,7 +22,7 @@ struct pic_cont { pic_value ptable; pic_code *ip; - pic_value results; + pic_vec *results; struct pic_cont *prev; }; @@ -33,19 +33,6 @@ void pic_load_point(pic_state *, struct pic_cont *); struct pic_proc *pic_make_cont(pic_state *, struct pic_cont *); void pic_wind(pic_state *, pic_checkpoint *, pic_checkpoint *); -pic_value pic_dynamic_wind(pic_state *, struct pic_proc *, struct pic_proc *, struct pic_proc *); - -pic_value pic_values0(pic_state *); -pic_value pic_values1(pic_state *, pic_value); -pic_value pic_values2(pic_state *, pic_value, pic_value); -pic_value pic_values3(pic_state *, pic_value, pic_value, pic_value); -pic_value pic_values4(pic_state *, pic_value, pic_value, pic_value, pic_value); -pic_value pic_values5(pic_state *, pic_value, pic_value, pic_value, pic_value, pic_value); -pic_value pic_values(pic_state *, int, pic_value *); -pic_value pic_values_by_list(pic_state *, pic_value); -int pic_receive(pic_state *, int, pic_value *); - -pic_value pic_callcc(pic_state *, struct pic_proc *); #if defined(__cplusplus) } diff --git a/extlib/benz/read.c b/extlib/benz/read.c index 2441f677..88e636b2 100644 --- a/extlib/benz/read.c +++ b/extlib/benz/read.c @@ -596,7 +596,7 @@ read_vector(pic_state *pic, xFILE *file, int c) list = read(pic, file, c); - vec = pic_make_vec(pic, pic_length(pic, list)); + vec = pic_make_vec(pic, pic_length(pic, list), NULL); pic_for_each (elem, list, it) { vec->data[i++] = elem; @@ -641,7 +641,7 @@ read_label_set(pic_state *pic, xFILE *file, int i) if (vect) { pic_vec *tmp; - kh_val(h, it) = val = pic_obj_value(pic_make_vec(pic, 0)); + kh_val(h, it) = val = pic_obj_value(pic_make_vec(pic, 0, NULL)); tmp = pic_vec_ptr(read(pic, file, c)); PIC_SWAP(pic_value *, tmp->data, pic_vec_ptr(val)->data); diff --git a/extlib/benz/vector.c b/extlib/benz/vector.c index 965d46e3..339a346b 100644 --- a/extlib/benz/vector.c +++ b/extlib/benz/vector.c @@ -6,7 +6,7 @@ #include "picrin/object.h" struct pic_vector * -pic_make_vec(pic_state *pic, int len) +pic_make_vec(pic_state *pic, int len, pic_value *argv) { struct pic_vector *vec; int i; @@ -14,8 +14,12 @@ pic_make_vec(pic_state *pic, int len) vec = (struct pic_vector *)pic_obj_alloc(pic, sizeof(struct pic_vector), PIC_TYPE_VECTOR); vec->len = len; vec->data = (pic_value *)pic_malloc(pic, sizeof(pic_value) * len); - for (i = 0; i < len; ++i) { - vec->data[i] = pic_undef_value(pic); + if (argv == NULL) { + for (i = 0; i < len; ++i) { + vec->data[i] = pic_undef_value(pic); + } + } else { + memcpy(vec->data, argv, sizeof(pic_value) * len); } return vec; } @@ -33,17 +37,13 @@ pic_vec_vector_p(pic_state *pic) static pic_value pic_vec_vector(pic_state *pic) { - int argc, i; + int argc; pic_value *argv; pic_vec *vec; pic_get_args(pic, "*", &argc, &argv); - vec = pic_make_vec(pic, argc); - - for (i = 0; i < argc; ++i) { - vec->data[i] = argv[i]; - } + vec = pic_make_vec(pic, argc, argv); return pic_obj_value(vec); } @@ -57,7 +57,7 @@ pic_vec_make_vector(pic_state *pic) n = pic_get_args(pic, "i|o", &k, &v); - vec = pic_make_vec(pic, k); + vec = pic_make_vec(pic, k, NULL); if (n == 2) { for (i = 0; i < k; ++i) { vec->data[i] = v; @@ -140,26 +140,23 @@ pic_vec_vector_copy_i(pic_state *pic) static pic_value pic_vec_vector_copy(pic_state *pic) { - pic_vec *vec, *to; - int n, start, end, i = 0; + pic_vec *from, *to; + int n, start, end; - n = pic_get_args(pic, "v|ii", &vec, &start, &end); + n = pic_get_args(pic, "v|ii", &from, &start, &end); switch (n) { case 1: start = 0; case 2: - end = vec->len; + end = from->len; } if (end < start) { pic_errorf(pic, "vector-copy: end index must not be less than start index"); } - to = pic_make_vec(pic, end - start); - while (start < end) { - to->data[i++] = vec->data[start++]; - } + to = pic_make_vec(pic, end - start, from->data + start); return pic_obj_value(to); } @@ -179,7 +176,7 @@ pic_vec_vector_append(pic_state *pic) len += pic_vec_ptr(argv[i])->len; } - vec = pic_make_vec(pic, len); + vec = pic_make_vec(pic, len, NULL); len = 0; for (i = 0; i < argc; ++i) { @@ -234,7 +231,7 @@ pic_vec_vector_map(pic_state *pic) : pic_vec_ptr(argv[i])->len; } - vec = pic_make_vec(pic, len); + vec = pic_make_vec(pic, len, NULL); for (i = 0; i < len; ++i) { vals = pic_nil_value(pic); @@ -284,7 +281,7 @@ pic_vec_list_to_vector(pic_state *pic) pic_get_args(pic, "o", &list); - vec = pic_make_vec(pic, pic_length(pic, list)); + vec = pic_make_vec(pic, pic_length(pic, list), NULL); data = vec->data; @@ -373,7 +370,7 @@ pic_vec_string_to_vector(pic_state *pic) pic_errorf(pic, "string->vector: end index must not be less than start index"); } - vec = pic_make_vec(pic, end - start); + vec = pic_make_vec(pic, end - start, NULL); for (i = 0; i < end - start; ++i) { vec->data[i] = pic_char_value(pic, pic_str_ref(pic, str, i + start));