>From 5b84a123febf702a1e881823be649964de8b018f Mon Sep 17 00:00:00 2001
From: Evan Hanson <address@hidden>
Date: Sat, 5 Jul 2014 13:54:29 +1200
Subject: [PATCH 3/3] 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.
---
 NEWS                   |    3 ++-
 chicken-syntax.scm     |   26 ++++++++++++--------------
 tests/syntax-tests.scm |   10 ++++++++++
 3 files changed, 24 insertions(+), 15 deletions(-)

diff --git a/NEWS b/NEWS
index 12fd0bf..d730439 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 baf6a35..220f0e9 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -416,21 +416,19 @@
  '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 59f7d63..40c9470 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
-- 
1.7.10.4