~ chicken-core (chicken-5) 25a9b9932014f8ff84825658c054a91e6c0630f3

commit 25a9b9932014f8ff84825658c054a91e6c0630f3
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Thu Jul 3 22:08:22 2014 +1200
Commit:     Peter Bex <peter.bex@xs4all.nl>
CommitDate: Sat Jul 12 16:34:55 2014 +0200

    Add full lambda list support for define-values and set!-values
    
    Previously, the macro transformers for define-values and set!-values
    only allowed proper lists as formals. This adds full lambda list
    support, so that symbols and improper lists can be used as well.
    
    Signed-off-by: Peter Bex <peter.bex@xs4all.nl>

diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index 7a281583..ff3f4947 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -325,35 +325,37 @@
  'set!-values '()
  (##sys#er-transformer
   (lambda (form r c)
-    (##sys#check-syntax 'set!-values form '(_ #(variable 0) _))
-    (let ((vars (cadr form))
+    (##sys#check-syntax 'set!-values form '(_ lambda-list _))
+    (let ((formals (cadr form))
 	  (exp (caddr form)))
-      (cond ((null? vars)
-	     ;; may this be simply "exp"?
-	     `(##sys#call-with-values
-	       (##core#lambda () ,exp)
-	       (##core#lambda () (##core#undefined))) )
-	    ((null? (cdr vars))
-	     `(##core#set! ,(car vars) ,exp)) 
-	    (else
-	     (let ([aliases (map gensym vars)])
-	       `(##sys#call-with-values
-		 (##core#lambda () ,exp)
-		 (##core#lambda ,aliases
-			   ,@(map (lambda (v a)
-				    `(##core#set! ,v ,a))
-				  vars aliases) ) ) ) ) ) ))))
+      (##sys#decompose-lambda-list
+       formals
+       (lambda (vars argc rest)
+	 (let ((aliases    (if (symbol? formals) '() (map gensym formals)))
+	       (rest-alias (if (not rest) '() (gensym rest))))
+	   `(##sys#call-with-values
+	     (##core#lambda () ,exp)
+	     (##core#lambda
+	      ,(append aliases rest-alias)
+	      ,@(map (lambda (v a) `(##core#set! ,v ,a)) vars aliases)
+	      ,@(cond
+		  ((null? formals) '((##core#undefined)))
+		  ((null? rest-alias) '())
+		  (else `((##core#set! ,rest ,rest-alias)))))))))))))
 
 (set! ##sys#define-values-definition
   (##sys#extend-macro-environment
    'define-values '()
    (##sys#er-transformer
     (lambda (form r c)
-      (##sys#check-syntax 'define-values form '(_ #(variable 0) _))
-      (for-each (lambda (nm)
-                  (let ((name (##sys#get nm '##core#macro-alias nm)))
-                    (##sys#register-export name (##sys#current-module))))
-                (cadr form))
+      (##sys#check-syntax 'define-values form '(_ lambda-list _))
+      (##sys#decompose-lambda-list
+       (cadr form)
+       (lambda (vars argc rest)
+         (for-each (lambda (nm)
+                     (let ((name (##sys#get nm '##core#macro-alias nm)))
+                       (##sys#register-export name (##sys#current-module))))
+                   vars)))
       `(,(r 'set!-values) ,@(cdr form))))))
 
 (##sys#extend-macro-environment