Repository: biwascheme/biwascheme (js)

Issue:
Nested unquote-splicing
It seems that expression `,@,@x` is ignored

```scheme
(define x '(1 2 3))
(define y '(11 22 33))
(define l '(x y))

``(,@,@l ,@,@l) 
```
it should evaluate to:

```scheme
(quasiquote ((unquote-splicing x y) (unquote-splicing x y)))
```

BiwaScheme returns:

```scheme
(quasiquote ((unquote-splicing (unquote-splicing l)) (unquote-splicing (unquote-splicing l))))
```

You should eval this and get:

```
(1 2 3 11 22 33)
```

But BiwaScheme return error:

```
unquote-splicing(,@) must be inside quasiquote(`) []
```

Pull request:
Support multi-value unquote
This PR fixes `unquote`, `unquote-splicing` to accept multiple values.

fix #346 

Patch:
diff --git a/src/library/r6rs_lib.js b/src/library/r6rs_lib.js
index f2f98d3..2283e1a 100644
--- a/src/library/r6rs_lib.js
+++ b/src/library/r6rs_lib.js
@@ -1349,100 +1349,90 @@ define_libfunc("dynamic-wind", 3, 3, function(ar, intp) {
 //        11.17  Quasiquotation
 // `() is expanded to `cons` and `append`.
 // `#() is expanded to `vector` and `vector-append`.
-var expand_qq = function(f, lv){
-  if(f instanceof BiwaSymbol || f === nil){
-    return List(Sym("quote"), f);
-  }
-  else if(f instanceof Pair){
-    var car = f.car;
-    if(car instanceof Pair && car.car === Sym("unquote-splicing")){
-      if(lv == 1) {
-        if (f.cdr === nil) {
-          return f.car.cdr.car;
-        } else {
-          return List(Sym("append"),
-                      f.car.cdr.car,
-                      expand_qq(f.cdr, lv));
-        }
-      }
-      else
-        return List(Sym("cons"),
-                    List(Sym("list"),
-                         List(Sym("quote"), Sym("unquote-splicing")),
-                         expand_qq(f.car.cdr.car, lv-1)),
-                    expand_qq(f.cdr, lv));
-    }
-    else if(car === Sym("unquote")){
-      if(lv == 1)
-        return f.cdr.car;
-      else
-        return List(Sym("list"),
-                    List(Sym("quote"), Sym("unquote")),
-                    expand_qq(f.cdr.car, lv-1));
-    }
-    else if(car === Sym("quasiquote"))
-      return List(Sym("list"),
-                  List(Sym("quote"), Sym("quasiquote")),
-                  expand_qq(f.cdr.car, lv+1));
-    else
+const expandQuasiquote = function(x, depth){
+  if (x instanceof Pair) {
+    if (x.car === Sym("quasiquote")) {
       return List(Sym("cons"),
-                  expand_qq(f.car, lv),
-                  expand_qq(f.cdr, lv));
-  }
-  else if(f instanceof Array){
-    var vecs = [[]];
-    for(var i=0; i<f.length; i++){
-      if(f[i] instanceof Pair && f[i].car === Sym("unquote-splicing")) {
-        if (lv == 1) {
-          var item = List(Sym("list->vector"), f[i].cdr.car);
-          item["splicing"] = true;
-          vecs.push(item);
-          vecs.push([]);
-        }
-        else {
-          var item = List(Sym("cons"),
-                       List(Sym("list"),
-                            List(Sym("quote"), Sym("unquote-splicing")),
-                            expand_qq(f[i].car.cdr.car, lv-1)),
-                       expand_qq(f[i].cdr, lv));
-          vecs[vecs.length-1].push(item);
-        }
-      }
-      else {
-        // Expand other things as the same as if they are in a list quasiquote
-        vecs[vecs.length-1].push(expand_qq(f[i], lv));
+                  List(Sym("quote"), Sym("quasiquote")),
+                  expandQuasiquote(x.cdr, depth+1));
+    } else if (x.car === Sym("unquote") ||
+               x.car === Sym("unquote-splicing")) {
+      if (depth > 0) {
+        return List(Sym("cons"),
+                    List(Sym("quote"), x.car),
+                    expandQuasiquote(x.cdr, depth-1));
+      } else if (x.car === Sym("unquote") &&
+                 x.cdr instanceof Pair && // Check if it has only one argument
+                 x.cdr.cdr === nil) {
+        return x.cdr.car;
+      } else {
+        throw new BiwaError("invalid use of quasiquote");
       }
+    } else if (x.cdr === nil) {
+      return expandQqList(x.car, depth);
+    } else {
+      // Use `append` because there may be a `,@` in the list
+      return List(Sym("append"),
+               expandQqList(x.car, depth),
+               expandQuasiquote(x.cdr, depth));
     }
+  } else if (x instanceof Array) {
+    const l = array_to_list(x);
+    return List(Sym("list->vector"),
+             List(Sym("append"),
+               expandQqList(l.car, depth),
+               expandQuasiquote(l.cdr, depth)));
+  } else {
+    return List(Sym("quote"), x);
+  }
+}
 
-    var vectors = vecs.map(function(vec){
-      if (vec["splicing"]) {
-        return vec;
-      }
-      else {
-        return Cons(Sym("vector"),
-                    array_to_list(vec));
+// Auxiliary function for expandQuasiquote
+// Expands an item in a list context
+const expandQqList = function(x, depth){
+  if (x instanceof Pair) {
+    if (x.car === Sym("quasiquote")) {
+      return List(Sym("list"),
+               List(Sym("cons"),
+                    List(Sym("quasiquote"), x.car),
+                    expandQuasiquote(x.cdr, depth+1)));
+    } else if (x.car === Sym("unquote") ||
+               x.car === Sym("unquote-splicing")) {
+      if (depth > 0) {
+        return List(Sym("list"),
+                 List(Sym("cons"),
+                      List(Sym("quote"), x.car),
+                      expandQuasiquote(x.cdr, depth-1)));
+      } else if (x.car === Sym("unquote")) {
+        return Cons(Sym("list"), x.cdr);
+      } else { // i.e. x.car === Sym("unquote-splicing")
+        return Cons(Sym("append"), x.cdr);
       }
-    });
-    if (vectors.length == 1) {
-       return Cons(Sym("vector"),
-                   array_to_list(vecs[0]));
-    }
-    else {
-      return Cons(Sym("vector-append"),
-                  array_to_list(vectors));
+    } else {
+      return List(Sym("list"),
+               List(Sym("append"),
+                 expandQqList(x.car, depth),
+                 expandQuasiquote(x.cdr, depth)));
     }
+  } else if (x instanceof Array) {
+    const l = array_to_list(x);
+    return List(Sym("list"),
+             List(Sym("list->vector"),
+               List(Sym("append"),
+                 expandQqList(l.car, depth),
+                 expandQuasiquote(l.cdr, depth))));
+  } else {
+    return List(Sym("quote"),
+             List(x));
   }
-  else
-    return f;
 }
+
 define_syntax("quasiquote", function(x){
-  return expand_qq(x.cdr.car, 1);
+  return expandQuasiquote(x.cdr.car, 0);
 })
-//unquote
 define_syntax("unquote", function(x){
   throw new BiwaError("unquote(,) must be inside quasiquote(`)");
 })
-//unquote-splicing
 define_syntax("unquote-splicing", function(x){
   throw new BiwaError("unquote-splicing(,@) must be inside quasiquote(`)");
 })


Test patch:
diff --git a/test/helper.js b/test/helper.js
index 38f2f51..ffdc1de 100644
--- a/test/helper.js
+++ b/test/helper.js
@@ -1,11 +1,26 @@
 import BiwaScheme from "../src/main.js"
 
+// Default error handler
 var on_error = function(e){
   console.warn(e);
   throw e;
 }
+
+// Evaluates `str` and returns the resulting Scheme value
+function evaluate(str, func) {
+  return (new BiwaScheme.Interpreter(on_error)).evaluate(str, func||new Function());
+}
+
+// Evaluates `str` and returns expectation
 function ev(str, func) {
-  return expect((new BiwaScheme.Interpreter(on_error)).evaluate(str, func||new Function()));
+  const v = evaluate(str, func);
+  return expect(v);
+}
+
+// Same as ev but makes the result into a string by to_write
+function ew(str, func) {
+  const v = evaluate(str, func);
+  return expect(BiwaScheme.to_write(v));
 }
 
-export { ev }
+export { ev, ew }
diff --git a/test/r7rs/base.test.js b/test/r7rs/base.test.js
index d9f8267..2919c21 100644
--- a/test/r7rs/base.test.js
+++ b/test/r7rs/base.test.js
@@ -1,4 +1,44 @@
-import { ev } from "../helper.js"
+import { ev, ew } from "../helper.js"
+
+describe('4.2.8 Quasiquotation', () => {
+  test('simple', () => {
+    ew("`(list ,(+ 1 2) 4)").toBe("(list 3 4)");
+  })
+  test('binding', () => {
+    ew("(let ((name 'a)) `(list ,name ',name))").toBe("(list a (quote a))"); 
+  })
+  test('splicing', () => {
+    ew("`(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b)").toBe("(a 3 4 5 6 b)");
+  })
+  test('improper list', () => {
+    ew("`(( foo ,(- 10 3)) ,@(cdr '(c)) . ,(car '(cons)))").toBe("((foo 7) . cons)");
+  })
+  test('nested', () => {
+    ew("`(a b `(c d))").toBe("(a b (quasiquote (c d)))");
+  })
+  test('nested + splicing', () => {
+    ew("(let1 ls '(4) `(1 `(2 ,(3 ,@ls))))")
+      .toBe("(1 (quasiquote (2 (unquote (3 4)))))");
+  })
+  test('vector quasiquotation', () => {
+    ew("`#(10 5 ,(sqrt 4) ,@(map sqrt '(16 9)) 8)").toBe("#(10 5 2 4 3 8)");
+  })
+  test('vector (nested)', () => {
+    ew("(let1 ls '(4) `#(1 `#(2 ,#(3 ,@ls))))")
+      .toBe("#(1 (quasiquote #(2 (unquote #(3 4)))))");
+  })
+  test('not a list', () => {
+    ew("`(,1 ,@2)").toBe("(1 . 2)");
+  })
+  test('bug #346', () => {
+    ew("(define l '(x y)) ``(,@,@l ,@,@l)").toBe(
+      "(quasiquote ((unquote-splicing x y) (unquote-splicing x y)))");
+    ew("(define x '(1 2)) \
+        (define y '(3 4)) \
+        (quasiquote ((unquote-splicing x y) (unquote-splicing x y)))")
+    .toBe("(1 2 3 4 1 2 3 4)");
+  })
+})
 
 describe('6.6 Characters', () => {
   test('char<?', function(){