mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Add support for ..1' to match'.

Browse source 
Patch accepted upstream:
<http://lists.gnu.org/archive/html/guile-devel/2010-09/threads.html#00114>.

* module/ice-9/match.upstream.scm (match-two): Add support for `..1'.

* test-suite/tests/match.test ("matches")["list ..1", "list ..1, with
  predicate"]: New tests.
  ("doesn't match")["list ..1", "list ..1, with predicate"]: New tests.
This commit is contained in:
Ludovic Courtès 2010-09-27 22:50:36 +02:00
parent 56ec46a7c3
commit 1ffed5aa95
2 changed files with 27 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

6
module/ice-9/match.upstream.scm
View file

@ -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)))

23
test-suite/tests/match.test
View file

@ -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))))))