diff --git a/piclib/built-in.scm b/piclib/built-in.scm index 711cca48..847d3de9 100644 --- a/piclib/built-in.scm +++ b/piclib/built-in.scm @@ -242,21 +242,6 @@ (picrin core-syntax) (picrin bootstrap-tools)) - (define *values-tag* (cons #f '())) - - (define (values . args) - (if (and (pair? args) - (null? (cdr args))) - (car args) - (cons *values-tag* args))) - - (define (call-with-values producer consumer) - (let ((res (producer))) - (if (and (pair? res) - (eq? *values-tag* (car res))) - (apply consumer (cdr res)) - (consumer res)))) - (define-syntax let*-values (er-macro-transformer (lambda (form r c) @@ -292,9 +277,7 @@ assn) (set! assn (cons `(,(r 'set!) ,(car vars) ,(r (car vars))) assn)))))))))) - (export values - call-with-values - let-values + (export let-values let*-values define-values)) @@ -338,9 +321,7 @@ do when unless _ ... syntax-error) -(export values - call-with-values - let-values +(export let-values let*-values define-values) diff --git a/src/cont.c b/src/cont.c index 773d8507..22dfd50b 100644 --- a/src/cont.c +++ b/src/cont.c @@ -280,10 +280,39 @@ pic_cont_dynamic_wind(pic_state *pic) return v; } +static pic_value +pic_cont_values(pic_state *pic) +{ + size_t argc; + pic_value *argv; + + pic_get_args(pic, "*", &argc, &argv); + + return pic_values_by_array(pic, argc, argv); +} + +static pic_value +pic_cont_call_with_values(pic_state *pic) +{ + struct pic_proc *producer, *consumer; + size_t argc; + pic_value args[256]; + + pic_get_args(pic, "ll", &producer, &consumer); + + pic_apply(pic, producer, pic_nil_value()); + + argc = pic_receive(pic, 256, args); + + return pic_apply(pic, consumer, pic_list_by_array(pic, argc, args)); +} + void pic_init_cont(pic_state *pic) { pic_defun(pic, "call-with-current-continuation", pic_cont_callcc); pic_defun(pic, "call/cc", pic_cont_callcc); pic_defun(pic, "dynamic-wind", pic_cont_dynamic_wind); + pic_defun(pic, "values", pic_cont_values); + pic_defun(pic, "call-with-values", pic_cont_call_with_values); }