Re: ‘match’ and “k or more” patterns

[Ludovic Courtès]

Hi Alex,

Alex Shinn <address@hidden> writes:

> On Mon, Sep 6, 2010 at 9:12 PM, Ludovic Courtès <address@hidden> wrote:

[...]

>> I do!  :-)
>>
>>  http://git.sv.gnu.org/cgit/guile-rpc.git/tree/modules/rpc/compiler.scm#n312
>>
>> Well it uses only ‘..1’.  The same code would work with ‘..1’ replaced
>> by ‘...’, but then errors in the input wouldn’t be detected as nicely.
>
> "..1" is actually useful

The attached patch adds support for ‘..1’.  I’ll apply it to Guile if
you’re OK with applying it upstream.

What do you think?

BTW, I had fearfully avoided to hack a pattern matcher until now and I
was pleased to see how tractable this code is!

Thanks,
Ludo’.

pgpeUYYofDrHh.pgp
Description: PGP signature

diff --git a/module/ice-9/match.upstream.scm b/module/ice-9/match.upstream.scm
index 963b89f..bf3335b 100644
--- a/module/ice-9/match.upstream.scm
+++ b/module/ice-9/match.upstream.scm
@@ -125,7 +125,7 @@
 ;; pattern so far.
 
 (define-syntax match-two
-  (syntax-rules (_ ___ *** quote quasiquote ? $ = and or not set! get!)
+  (syntax-rules (_ ___ ..1 *** quote quasiquote ? $ = and or not set! get!)
     ((match-two v () g+s (sk ...) fk i)
      (if (null? v) (sk ... i) fk))
     ((match-two v (quote p) g+s (sk ...) fk i)
@@ -161,6 +161,10 @@
      (match-extract-vars p (match-gen-search v p q g+s sk fk i) i ()))
     ((match-two v (p *** . q) g+s sk fk i)
      (match-syntax-error "invalid use of ***" (p *** . q)))
+    ((match-two v (p ..1) g+s sk fk i)
+     (if (pair? v)
+         (match-one v (p ___) g+s sk fk i)
+         fk))
     ((match-two v (p . q) g+s sk fk i)
      (if (pair? v)
          (let ((w (car v)) (x (cdr v)))
diff --git a/test-suite/tests/match.test b/test-suite/tests/match.test
index 70a15ec..d1432d8 100644
--- a/test-suite/tests/match.test
+++ b/test-suite/tests/match.test
@@ -67,6 +67,16 @@
         ((x . rest)
          (and (eq? x 'a) (equal? rest '(b c)))))))
 
+  (pass-if "list ..1"
+    (match '(a b c)
+      ((x ..1)
+       (equal? x '(a b c)))))
+
+  (pass-if "list ..1, with predicate"
+    (match '(a b c)
+      (((and x (? symbol?)) ..1)
+       (equal? x '(a b c)))))
+
   (pass-if "tree"
     (let ((tree '(one (two 2) (three 3 (and 4 (and 5))))))
       (match tree
@@ -79,4 +89,15 @@
   (pass-if-exception "tree"
     exception:match-error
     (match '(a (b c))
-      ((foo (bar)) #t))))
+      ((foo (bar)) #t)))
+
+  (pass-if-exception "list ..1"
+    exception:match-error
+    (match '()
+      ((x ..1) #f)))
+
+  (pass-if-exception "list ..1, with predicate"
+    exception:match-error
+    (match '(a 0)
+      (((and x (? symbol?)) ..1)
+       (equal? x '(a b c))))))