From 2e5a4adcd2cfccf0b427f7367c09797277fdf434 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Wed, 31 Aug 2016 23:38:14 -0400
Subject: [PATCH] Attempt alternative let-values macro

---
 scheme/base.sld | 70 ++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 69 insertions(+), 1 deletion(-)

diff --git a/scheme/base.sld b/scheme/base.sld
index 97f9a885..cdc84e9e 100644
--- a/scheme/base.sld
+++ b/scheme/base.sld
@@ -1434,7 +1434,7 @@
      (call-with-values (lambda () expr)
        (lambda params (let*-values rest . body))))))
 
-(define-syntax let-values
+#;(define-syntax let-values
   (syntax-rules ()
     ((let-values ("step") (binds ...) bind expr maps () () . body)
      (let*-values (binds ... (bind expr)) (let maps . body)))
@@ -1448,6 +1448,74 @@
      (let-values ("step") () () expr () params rest . body))
     ))
 
+(define-syntax
+  let-values
+  (syntax-rules
+    ()
+    ((let-values (binding ...) body0 body1 ...)
+     (let-values
+       "bind"
+       (binding ...)
+       ()
+       ((lambda () body0 body1 ...))))
+       ;(begin body0 body1 ...)))
+    ((let-values "bind" () tmps body)
+     (let tmps body))
+    ((let-values
+       "bind"
+       ((b0 e0) binding ...)
+       tmps
+       body)
+     (let-values
+       "mktmp"
+       b0
+       e0
+       ()
+       (binding ...)
+       tmps
+       body))
+    ((let-values
+       "mktmp"
+       ()
+       e0
+       args
+       bindings
+       tmps
+       body)
+     (call-with-values
+       (lambda () e0)
+       (lambda args
+         (let-values "bind" bindings tmps body))))
+    ((let-values
+       "mktmp"
+       (a . b)
+       e0
+       (arg ...)
+       bindings
+       (tmp ...)
+       body)
+     (let-values
+       "mktmp"
+       b
+       e0
+       (arg ... x)
+       bindings
+       (tmp ... (a x))
+       body))
+    ((let-values
+       "mktmp"
+       a
+       e0
+       (arg ...)
+       bindings
+       (tmp ...)
+       body)
+     (call-with-values
+       (lambda () e0)
+       ;(lambda (arg ... x)
+       (lambda (arg ... . x)
+         (let-values "bind" bindings (tmp ... (a x)) body))))))
+
 (define-syntax guard
   (syntax-rules ()
     ((guard (var clause ...) e1 e2 ...)