~ chicken-core (chicken-5) e2960480729bc1cec339024818495114487b4a4d

commit e2960480729bc1cec339024818495114487b4a4d
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Sat Jul 5 13:54:29 2014 +1200
Commit:     Peter Bex <peter.bex@xs4all.nl>
CommitDate: Sat Jul 12 17:20:28 2014 +0200

    Add full lambda list support for letrec-values bindings
    
    Use the logic for multi-value assignment expansion already shared by
    set!-values and ##sys#canonicalize-body for letrec-values, too.
    
    Signed-off-by: Peter Bex <peter.bex@xs4all.nl>

diff --git a/NEWS b/NEWS
index dfaec6d6..6efec544 100644
--- a/NEWS
+++ b/NEWS
@@ -30,7 +30,8 @@
     ##sys#check-port-mode, ##sys#check-port*
 
 - Syntax expander
-  - define-values and set!-values now support full lambda lists
+  - define-values, set!-values and letrec-values now support full lambda
+    lists as binding forms
 
 - C API
   - Removed deprecated C_get_argument[_2] and
diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index baf6a351..c815bc80 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -416,21 +416,20 @@
  'letrec-values '()
  (##sys#er-transformer
   (lambda (form r c)
-    (##sys#check-syntax 'letrec-values form '(_ list . _))
+    (##sys#check-syntax 'letrec-values form '(_ #((lambda-list . _) 0) . _))
     (let ((vbindings (cadr form))
-	  (body (cddr form)))
-      (let* ([vars (apply ##sys#append (map (lambda (x) (car x)) vbindings))] 
-	     [aliases (map (lambda (v) (cons v (r (gensym v)))) vars)] 
-	     [lookup (lambda (v) (cdr (assq v aliases)))] )
-	`(##core#let
-	  ,(map (lambda (v) (##sys#list v '(##core#undefined))) vars)
-	  ,@(map (lambda (vb)
-		   `(##sys#call-with-values 
-		     (##core#lambda () ,(cadr vb))
-		     (##core#lambda ,(map lookup (car vb))
-			       ,@(map (lambda (v) `(##core#set! ,v ,(lookup v))) (car vb)) ) ) )
-		 vbindings)
-	  ,@body) ) ) ) ) )
+          (body (cddr form)))
+      (let ((vars  (map car vbindings))
+            (exprs (map cadr vbindings)))
+        `(##core#let
+          ,(map (lambda (v) (##sys#list v '(##core#undefined)))
+                (foldl (lambda (l v) ; flatten multi-value formals
+                         (##sys#append l (##sys#decompose-lambda-list
+					  v (lambda (a _ _) a))))
+                       '()
+                       vars))
+          ,@(map ##sys#expand-multiple-values-assignment vars exprs)
+          ,@body))))))
 
 (##sys#extend-macro-environment
  'nth-value 
diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm
index 59f7d63d..40c94704 100644
--- a/tests/syntax-tests.scm
+++ b/tests/syntax-tests.scm
@@ -62,6 +62,16 @@
   (foo 33))
 )
 
+;; letrec-values
+
+(t '(0 1 2 3 (4) (5 6))
+   (letrec-values ((() (values))
+                   ((a) (values 0))
+                   ((b c) (values 1 2))
+                   ((d . e) (values 3 4))
+                   (f (values 5 6)))
+     (list a b c d e f)))
+
 ;; from r5rs:
 
 (t 45