add let-values and let*-values syntax macros

CHANGELOG.md

@@ -1,6 +1,9 @@
 ## 1.0.0-beta.8
+### Features
+* `let-values` and `let*-values` syntax macros
 ### Bugfix
 * fix empty vector literal
+* fix edge case in nested syntax-rules when variable in parent got expanded into identifier
 
 ## 1.0.0-beta.8
 ### Breaking

lib/R7RS.scm

@@ -52,6 +52,43 @@
   (typecheck "values-ref" values "values" 1)
   (typecheck "values-ref" n "number" 1)
   (--> values (valueOf) n))
+
+;; -----------------------------------------------------------------------------
+(define-syntax let-values
+  (syntax-rules ()
+    ((_ ()) nil)
+    ((_ () body ...) (begin body ...))
+    ((_ (((x ...) values) ...) body ...)
+     (apply (lambda (x ... ...)
+              body ...)
+            (vector->list (apply %vector-concat (map (lambda (x) ((. x "valueOf")))
+                                                     (list values ...)))))))
+  "(let-values binding body ...)
+
+   The macro work similar to let but variable is list of values and value
+   need to evaluate to result of calling values.")
+
+;; -----------------------------------------------------------------------------
+(define (%vector-concat . args)
+  (if (null? args)
+      #()
+      (begin
+        (typecheck "%vector-concat" (car args) "array")
+        (--> (car args) (concat (apply %vector-concat (cdr args)))))))
+
+;; -----------------------------------------------------------------------------
+(define-syntax let*-values
+  (syntax-rules ()
+    ((_ ()) nil)
+    ((_ () body ...) (begin body ...))
+    ((_ ((bind values) rest ...) . body)
+     (apply (lambda bind
+              (let*-values (rest ...) . body))
+            (vector->list ((. values "valueOf"))))))
+  "(let*-values binding body ...)
+
+   The macro work similar to let* but variable is list of values and value
+   need to evaluate to result of calling values.")
 ;; -----------------------------------------------------------------------------
 ;; R7RS division operators (Gauche Scheme) BSD license
 ;; Copyright (c) 2000-2020  Shiro Kawai  <[email protected]>
@@ -237,3 +274,4 @@
 (define raise throw)
 
 ;; -----------------------------------------------------------------------------
+

tests/std.scm

@@ -80,3 +80,15 @@
               "Expecting string, got number in expression `test` (argument 0)")
         (t.is (try (typecheck "test" 10 (list "string" "character") 0) (catch (e) e.message))
               "Expecting string or character, got number in expression `test` (argument 0)")))
+
+(test "std: let-values and let*-values"
+      (lambda (t)
+
+        (let ((a 10) (b 20) (c 30))
+          (let*-values (((a b c) (values 1 2 3)) ((x y z) (values a b c)))
+            (t.is (+ a b c x y z) 12)))
+
+        (let ((a 10) (b 20) (c 30))
+          (let-values (((a b c) (values 1 2 3)) ((x y z) (values a b c)))
+            (t.is (+ x y z) 60)
+            (t.is (+ a b c) 6)))))