implement values and call-with-values with C

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)
 

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);
 }