fix pattern list creation

4 files changed, 38 insertions, 20 deletions

diff --git a/multisyntax/patterns.scm b/multisyntax/patterns.scm
index 0e7a2b1..c31f9b7 100644
--- a/multisyntax/patterns.scm
+++ b/multisyntax/patterns.scm
@@ -49,26 +49,24 @@
   (define (proc key val names)
     (hashmap-update/default names
                             key
-                            (cut push-to-matched-ellipsis key <>)
+                            (cut push-to-matched-ellipsis val <>)
                             (make-matched-ellipsis '())))
   (hashmap-fold proc oldnames newnames))
 
 (define (compile-ellipsis match-patcar match-patcddr)
-  (letrec ((match*
-            (lambda (names stx)
-              (let ((stx (unwrap-syntax stx)))
-                (cond
-                  ((null? stx) names)
-                  ((not (pair? stx)) #f)
-                  ((match-patcar empty-map (car stx))
-                   => (lambda (newnames)
-                        (cond
-                          ((match* (merge-names names newnames)
-                                   (cdr stx))
-                           => values)
-                          (else (match-patcddr names stx)))))
-                  (else (match-patcddr names stx)))))))
-    match*))
+  (define (match* names stx)
+    (let ((stx (unwrap-syntax stx)))
+      (cond
+        ((null? stx) names)
+        ((not (pair? stx)) #f)
+        ((match-patcar empty-map (car stx))
+         => (lambda (newnames)
+              (cond
+                ((match* (merge-names names newnames) (cdr stx))
+                 => values)
+                (else (match-patcddr names stx)))))
+        (else (match-patcddr names stx)))))
+  match*)
 
 (define (compile-actual-pair match-patcar match-patcdr)
   (lambda (names stx)
diff --git a/multisyntax/patterns.sld b/multisyntax/patterns.sld
index 7659c3c..889d45f 100644
--- a/multisyntax/patterns.sld
+++ b/multisyntax/patterns.sld
@@ -14,8 +14,9 @@
  |#
 
 (define-library (multisyntax patterns)
-  (import (scheme base)
+  (import (scheme base) (scheme write)
           (srfi 26) (srfi 113) (srfi 146 hash)
           (multisyntax syntax-object))
-  (export compile-pattern)
+  (export compile-pattern matched-ellipsis?
+          matched-ellipsis-reversed-list)
   (include "patterns.scm"))
\ No newline at end of file
diff --git a/test/patterns.scm b/test/patterns.scm
index 7669b86..0e9df36 100644
--- a/test/patterns.scm
+++ b/test/patterns.scm
@@ -58,7 +58,26 @@
     (test-equal "first" 1 (hashmap-ref returned (empty-wrap 'x)))
     (test-equal "second" 2 (hashmap-ref returned (empty-wrap 'y)))))
 
+(define (test-simple-ellipsis)
+  (define matcher
+    (compile-pattern ellipsis
+                     empty-set
+                     (list (empty-wrap 'x) ellipsis)))
+  (let* ((list '(1 2 3 4 5 6 7 8))
+         (returned (matcher empty-map list))
+         (x-value (hashmap-ref returned (empty-wrap 'x))))
+    (test-assert "returned is matched-ellipsis"
+                 (matched-ellipsis? x-value))
+    (test-equal "(x ...)"
+                (reverse list)
+                (matched-ellipsis-reversed-list x-value)))
+  #;(let* ((returned (matcher empty-map '()))
+           (x-value (hashmap-ref returned (empty-wrap 'x))))))
+
 (define (test-patterns)
   (test-group "single match" (test-single-match))
   (test-group "test match in list" (test-match-in-list))
-  (test-group "test multiple matches in list" (test-multiple-matches-in-list)))
\ No newline at end of file
+  (test-group "test multiple matches in list"
+    (test-multiple-matches-in-list))
+  (test-group "simple ellipsis" (test-simple-ellipsis))
+  )
\ No newline at end of file
diff --git a/test/patterns.sld b/test/patterns.sld
index fac2736..0d58aa2 100644
--- a/test/patterns.sld
+++ b/test/patterns.sld
@@ -14,7 +14,7 @@
  |#
 
 (define-library (multisyntax patterns test)
-  (import (scheme base) (srfi 113) (srfi 146 hash)
+  (import (scheme base) (scheme write) (srfi 113) (srfi 146 hash)
           (multisyntax syntax-object)
           (multisyntax patterns))
   (cond-expand