From 0632d9fae41f47a5d5102a0e68b750ba08b688f1 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Fri, 26 Aug 2016 22:21:02 -0400
Subject: [PATCH] Added  let*-values and let-values

---
 CHANGELOG.md                       |  1 +
 docs/Scheme-Language-Compliance.md |  2 +-
 scheme/base.sld                    | 28 ++++++++++++++++++++++++++--
 srfi/vectors/vectors-test.scm      |  5 +++--
 4 files changed, 31 insertions(+), 5 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 290a21c9..8cb7b32c 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -11,6 +11,7 @@ Features:
     - SRFI 132 sorting library
 - Added SRFI 2, `and-let*`
 - Added `parameterize` from section 4.2.6 of R7RS to the `(scheme base)` library.
+- Added ` let-values` and ` let*-values` to `(scheme base)`.
 - Modified the makefile to also search current working directories for headers and libraries.
 
 Bug Fixes:
diff --git a/docs/Scheme-Language-Compliance.md b/docs/Scheme-Language-Compliance.md
index 9781ed96..72a91725 100644
--- a/docs/Scheme-Language-Compliance.md
+++ b/docs/Scheme-Language-Compliance.md
@@ -15,7 +15,7 @@ Section | Status | Comments
 4.1 Primitive expression types | Partial | `include` and `include-ci` are not implemented, although `include` may be specified as part of a library definition.
 4.2 Derived expression types | Partial | 
 4.2.1 Conditionals | Yes | 
-4.2.2 Binding constructs | Partial | Missing `let-values` and `let*-values`
+4.2.2 Binding constructs | Yes |
 4.2.3 Sequencing | Yes | 
 4.2.4 Iteration | Yes |
 4.2.5 Delayed evaluation | Yes |
diff --git a/scheme/base.sld b/scheme/base.sld
index d4feaef3..2b5221a3 100644
--- a/scheme/base.sld
+++ b/scheme/base.sld
@@ -149,6 +149,8 @@
     let
     let*
     letrec
+    let*-values
+    let-values
     begin
     case
     cond
@@ -208,8 +210,6 @@
 ; unclassified TODO's:
 ;    import
 ;    include
-;    let*-values
-;    let-values
 ;    let-syntax
 ;    letrec-syntax
 ;;;;
@@ -1415,6 +1415,30 @@
     ((letrec* ((var val) ...) . body)
      (let () (define var val) ... . body))))
 
+(define-syntax let*-values
+  (syntax-rules ()
+    ((let*-values () . body)
+     (begin . body))
+    ((let*-values (((a) expr) . rest) . body)
+     (let ((a expr)) (let*-values rest . body)))
+    ((let*-values ((params expr) . rest) . body)
+     (call-with-values (lambda () expr)
+       (lambda params (let*-values rest . body))))))
+
+(define-syntax let-values
+  (syntax-rules ()
+    ((let-values ("step") (binds ...) bind expr maps () () . body)
+     (let*-values (binds ... (bind expr)) (let maps . body)))
+    ((let-values ("step") (binds ...) bind old-expr maps () ((params expr) . rest) . body)
+     (let-values ("step") (binds ... (bind old-expr)) () expr maps params rest . body))
+    ((let-values ("step") binds (bind ...) expr (maps ...) (x . y) rest . body)
+     (let-values ("step") binds (bind ... tmp) expr (maps ... (x tmp)) y rest . body))
+    ((let-values ("step") binds (bind ...) expr (maps ...) x rest . body)
+     (let-values ("step") binds (bind ... . tmp) expr (maps ... (x tmp)) () rest . body))
+    ((let-values ((params expr) . rest) . body)
+     (let-values ("step") () () expr () params rest . body))
+    ))
+
 (define-syntax guard
   (syntax-rules ()
     ((guard (var clause ...) e1 e2 ...)
diff --git a/srfi/vectors/vectors-test.scm b/srfi/vectors/vectors-test.scm
index 4f5e980e..9254bc02 100644
--- a/srfi/vectors/vectors-test.scm
+++ b/srfi/vectors/vectors-test.scm
@@ -1,5 +1,6 @@
-(cond-expand
-  (cyclone (import (scheme base) (srfi 133)))
+(import (scheme base) (srfi 133) (scheme cyclone test))
+#;(cond-expand
+  (cyclone (import (scheme base) (srfi 133) (scheme cyclone test)))
   (chicken (use test srfi-133))
   (chibi (import (scheme base) (chibi test) (vectors))))
 (test-group "vectors"