Tweak syntax-rules to be consistent with R7RS.

My understanding has been appropriately adjusted by R7RS editors.

diff --git a/src/runtime/syntax-rules.scm b/src/runtime/syntax-rules.scm
index 2471db6445072d838fa40cca3ed992bade52159f..bd133f5fbde58c64fd9f550137ce77f5da65fc2f 100644 (file)
--- a/src/runtime/syntax-rules.scm
+++ b/src/runtime/syntax-rules.scm
@@ -218,16 +218,10 @@ USA.
   (let loop ((p p))
     (case (car p)
       ((list dotted-list vector)
-       (if (and (eq? 'dotted-list (car p))
-               (special-dot-tail? p))
-          (if (any segment? (cdr p))
-              (syntax-error "No ellipses allowed in pattern:" pattern))
-          (begin
-            (if (fix:> (count segment? (cdr p)) 1)
-                (syntax-error "Only one ellipsis allowed in pattern:" pattern))
-            (if (any (lambda (elt) (fix:> (count-segments elt) 1)) (cdr p))
-                (syntax-error "No nested ellipses allowed in pattern:"
-                              pattern))))
+       (if (fix:> (count segment? (cdr p)) 1)
+          (syntax-error "Only one ellipsis allowed in pattern:" pattern))
+       (if (any (lambda (elt) (fix:> (count-segments elt) 1)) (cdr p))
+          (syntax-error "No nested ellipses allowed in pattern:" pattern))
        (for-each (lambda (elt)
                   (loop (strip-segments elt)))
                 (cdr p)))
@@ -393,11 +387,6 @@ USA.
        (loop (segment-body elt) (fix:+ n 1))
        n)))
 
-(define (special-dot-tail? p)
-  (let ((tail-pat (last p)))
-    (or (eq? 'var (car tail-pat))
-       (eq? 'anon-var (car tail-pat)))))
-
 ;; Like quote but doesn't strip syntactic closures:
 (define (syntax-quote expression)
   `(,(classifier->keyword

diff --git a/tests/runtime/test-syntax.scm b/tests/runtime/test-syntax.scm
index 4ffe37dc968fded7c8c61b8fec34b018703d56ed..f8697494b7a0f9dc1c30f3962717fa72f151ec97 100644 (file)
--- a/tests/runtime/test-syntax.scm
+++ b/tests/runtime/test-syntax.scm
@@ -346,4 +346,22 @@ USA.
       (assert-pair (caddr x))
       (assert-eq (car (caddr x)) 'c)
       (assert-eq (cdr (caddr x)) (cadr x))
-      (assert-eq (cadddr x) (caddr x)))))
\ No newline at end of file
+      (assert-eq (cadddr x) (caddr x)))))
+
+(define-test 'dotted-list
+  (lambda ()
+
+    ;; Dotted-list pattern without ellipsis acts like rest parameter of lambda:
+    (define-syntax foo
+      (syntax-rules ()
+       ((_ a b . c)
+        (quote (a b c)))))
+    (assert-equal (foo 1 2 3 4) '(1 2 (3 4)))
+
+    ;; Dotted-list pattern with ellipsis matches final cdr of input:
+    (define-syntax bar
+      (syntax-rules ()
+       ((_ a b ... . c)
+        (quote (a (b ...) c)))))
+    (assert-equal (bar 1 2 3 4) '(1 (2 3 4) ()))
+    (assert-equal (bar 1 2 3 . 4) '(1 (2 3) 4))))
\ No newline at end of file