From cb41d9262a71113c979bf1b7a8cc8417936d7404 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 10 Dec 2013 08:48:26 -0800
Subject: [PATCH] add `define-values` syntax

---
 piclib/built-in.scm | 31 +++++++++++++++++++++++++++++--
 1 file changed, 29 insertions(+), 2 deletions(-)

diff --git a/piclib/built-in.scm b/piclib/built-in.scm
index e8332e07..46c84b3e 100644
--- a/piclib/built-in.scm
+++ b/piclib/built-in.scm
@@ -281,6 +281,12 @@
   (define (cdar p) (cdr (car p)))
   (define (caar p) (car (car p)))
 
+  (define (map f list)
+    (if (null? list)
+        list
+        (cons (f (car list))
+              (map f (cdr list)))))
+
   (define-syntax let*-values
     (er-macro-transformer
      (lambda (form r c)
@@ -297,10 +303,30 @@
      (lambda (form r c)
        `(,(r 'let*-values) ,@(cdr form)))))
 
+  (define-syntax define-values
+    (er-macro-transformer
+     (lambda (form r c)
+       (let ((formals (cadr form)))
+         `(,(r 'begin)
+            ,@(do ((vars formals (cdr vars))
+                   (defs '()))
+                  ((pair? vars)
+                   defs)
+                (set! defs (cons `(,(r 'define) ,(car vars) #f) defs)))
+            (,(r 'call-with-values)
+                (,(r 'lambda) () ,@(cddr form))
+              (,(r 'lambda) (,@(map r formals))
+                ,@(do ((vars formals (cdr vars))
+                       (assn '()))
+                      ((pair? vars)
+                       assn)
+                    (set! assn (cons `(,(r 'set!) ,(car vars) ,(r (car vars))) assn))))))))))
+
   (export values
           call-with-values
           let-values
-          let*-values))
+          let*-values
+          define-values))
 
 (import (picrin macro)
         (picrin core-syntax)
@@ -316,7 +342,8 @@
 (export values
         call-with-values
         let-values
-        let*-values)
+        let*-values
+        define-values)
 
 (define (any pred list)
   (if (null? list)