From fdc1f86f092b0dff0e20e50df6ece3ec9237fc3c Mon Sep 17 00:00:00 2001
From: Hamayama <hamay1010@gmail.com>
Date: Tue, 3 Jul 2018 12:41:00 +0900
Subject: [PATCH 1/2] Fix syntax-rules on ellipsis escape templates

---
 lib/init-7.scm       | 36 +++++++++++++++++-------------------
 tests/r7rs-tests.scm | 14 ++++++++++++++
 2 files changed, 31 insertions(+), 19 deletions(-)

diff --git a/lib/init-7.scm b/lib/init-7.scm
index e9af9f37..5243ea9e 100644
--- a/lib/init-7.scm
+++ b/lib/init-7.scm
@@ -820,13 +820,10 @@
             ((null? p) (list _and (list _null? v) (k vars)))
             (else (list _and (list _equal? v p) (k vars))))))))
     (define ellipsis-mark?
-      (if (if ellipsis-specified?
-              (memq ellipsis lits)
-              (any (lambda (x) (compare ellipsis x)) lits))
-          (lambda (x) #f)
-          (if ellipsis-specified?
-              (lambda (x) (eq? ellipsis x))
-              (lambda (x) (compare ellipsis x)))))
+      (let ((cmp (if ellipsis-specified? eq? compare)))
+        (if (any (lambda (x) (cmp ellipsis x)) lits)
+            (lambda (x) #f)
+            (lambda (x) (cmp ellipsis x)))))
     (define (ellipsis-escape? x) (and (pair? x) (ellipsis-mark? (car x))))
     (define (ellipsis? x)
       (and (pair? x) (pair? (cdr x)) (ellipsis-mark? (cadr x))))
@@ -862,7 +859,7 @@
          ((vector? x) (lp (vector->list x) free))
          (else free))))
     (define (expand-template tmpl vars)
-      (let lp ((t tmpl) (dim 0))
+      (let lp ((t tmpl) (dim 0) (ell-esc #f))
         (cond
          ((identifier? t)
           (cond
@@ -875,12 +872,13 @@
             (list _rename (list _quote t)))))
          ((pair? t)
           (cond
-           ((ellipsis-escape? t)
-            (list _quote
-                  (if (pair? (cdr t))
-                      (if (pair? (cddr t)) (cddr t) (cadr t))
-                      (cdr t))))
-           ((ellipsis? t)
+           ((and (ellipsis-escape? t) (not ell-esc))
+            (lp (if (pair? (cdr t))
+                    (if (pair? (cddr t)) (cddr t) (cadr t))
+                    (cdr t))
+                dim
+                #t))
+           ((and (ellipsis? t) (not ell-esc))
             (let* ((depth (ellipsis-depth t))
                    (ell-dim (+ dim depth))
                    (ell-vars (free-vars (car t) vars ell-dim)))
@@ -889,9 +887,9 @@
                 (error "too many ...'s"))
                ((and (null? (cdr (cdr t))) (identifier? (car t)))
                 ;; shortcut for (var ...)
-                (lp (car t) ell-dim))
+                (lp (car t) ell-dim ell-esc))
                (else
-                (let* ((once (lp (car t) ell-dim))
+                (let* ((once (lp (car t) ell-dim ell-esc))
                        (nest (if (and (null? (cdr ell-vars))
                                       (identifier? once)
                                       (eq? once (car vars)))
@@ -905,9 +903,9 @@
                                  ((= d 1) many))))
                   (if (null? (ellipsis-tail t))
                       many ;; shortcut
-                      (list _append many (lp (ellipsis-tail t) dim))))))))
-           (else (list _cons3 (lp (car t) dim) (lp (cdr t) dim) (list _quote t)))))
-         ((vector? t) (list _list->vector (lp (vector->list t) dim)))
+                      (list _append many (lp (ellipsis-tail t) dim ell-esc))))))))
+           (else (list _cons3 (lp (car t) dim ell-esc) (lp (cdr t) dim ell-esc) (list _quote t)))))
+         ((vector? t) (list _list->vector (lp (vector->list t) dim ell-esc)))
          ((null? t) (list _quote '()))
          (else t))))
     (list
diff --git a/tests/r7rs-tests.scm b/tests/r7rs-tests.scm
index e9ee59b3..174d9ba8 100644
--- a/tests/r7rs-tests.scm
+++ b/tests/r7rs-tests.scm
@@ -447,6 +447,20 @@
 (be-like-begin3 sequence3)
 (test 5 (sequence3 2 3 4 5))
 
+;; ellipsis escape
+(define-syntax elli-esc-1
+  (syntax-rules ()
+    ((_)
+     '(... ...))
+    ((_ x)
+     '(... (x ...)))
+    ((_ x y)
+     '(... (... x y)))))
+
+(test '... (elli-esc-1))
+(test '(100 ...) (elli-esc-1 100))
+(test '(... 100 200) (elli-esc-1 100 200))
+
 ;; Syntax pattern with ellipsis in middle of proper list.
 (define-syntax part-2
   (syntax-rules ()

From 216d6a8d8751a88b339a5128acf2ba25b6694045 Mon Sep 17 00:00:00 2001
From: Hamayama <hamay1010@gmail.com>
Date: Thu, 5 Jul 2018 00:53:17 +0900
Subject: [PATCH 2/2] Revert and fix syntax-rules by reflecting review

---
 lib/init-7.scm | 17 ++++++++---------
 1 file changed, 8 insertions(+), 9 deletions(-)

diff --git a/lib/init-7.scm b/lib/init-7.scm
index 5243ea9e..87857fd6 100644
--- a/lib/init-7.scm
+++ b/lib/init-7.scm
@@ -820,10 +820,13 @@
             ((null? p) (list _and (list _null? v) (k vars)))
             (else (list _and (list _equal? v p) (k vars))))))))
     (define ellipsis-mark?
-      (let ((cmp (if ellipsis-specified? eq? compare)))
-        (if (any (lambda (x) (cmp ellipsis x)) lits)
-            (lambda (x) #f)
-            (lambda (x) (cmp ellipsis x)))))
+      (if (if ellipsis-specified?
+              (memq ellipsis lits)
+              (any (lambda (x) (compare ellipsis x)) lits))
+          (lambda (x) #f)
+          (if ellipsis-specified?
+              (lambda (x) (eq? ellipsis x))
+              (lambda (x) (compare ellipsis x)))))
     (define (ellipsis-escape? x) (and (pair? x) (ellipsis-mark? (car x))))
     (define (ellipsis? x)
       (and (pair? x) (pair? (cdr x)) (ellipsis-mark? (cadr x))))
@@ -873,11 +876,7 @@
          ((pair? t)
           (cond
            ((and (ellipsis-escape? t) (not ell-esc))
-            (lp (if (pair? (cdr t))
-                    (if (pair? (cddr t)) (cddr t) (cadr t))
-                    (cdr t))
-                dim
-                #t))
+            (lp (if (and (pair? (cdr t)) (null? (cddr t))) (cadr t) (cdr t)) dim #t))
            ((and (ellipsis? t) (not ell-esc))
             (let* ((depth (ellipsis-depth t))
                    (ell-dim (+ dim depth))