From f2ee6341baa31d75f9734a93545eb2608dd5653c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 27 Sep 2010 23:52:10 +0200 Subject: [PATCH] Fix pattern variable extraction in `match' with `..1'. * module/ice-9/match.upstream.scm (match-extract-vars): Support `..1'. --- module/ice-9/match.upstream.scm | 3 ++- test-suite/tests/match.test | 5 +++++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/module/ice-9/match.upstream.scm b/module/ice-9/match.upstream.scm index bf3335b9b..df6b3d914 100644 --- a/module/ice-9/match.upstream.scm +++ b/module/ice-9/match.upstream.scm @@ -488,7 +488,7 @@ ;; (match-extract-vars pattern continuation (ids ...) (new-vars ...)) (define-syntax match-extract-vars - (syntax-rules (_ ___ *** ? $ = quote quasiquote and or not get! set!) + (syntax-rules (_ ___ ..1 *** ? $ = quote quasiquote and or not get! set!) ((match-extract-vars (? pred . p) . x) (match-extract-vars p . x)) ((match-extract-vars ($ rec . p) . x) @@ -518,6 +518,7 @@ (match-extract-vars (p ...) . x)) ((match-extract-vars _ (k ...) i v) (k ... v)) ((match-extract-vars ___ (k ...) i v) (k ... v)) + ((match-extract-vars ..1 (k ...) i v) (k ... v)) ((match-extract-vars *** (k ...) i v) (k ... v)) ;; This is the main part, the only place where we might add a new ;; var if it's an unbound symbol. diff --git a/test-suite/tests/match.test b/test-suite/tests/match.test index d1432d8af..f2e670c08 100644 --- a/test-suite/tests/match.test +++ b/test-suite/tests/match.test @@ -77,6 +77,11 @@ (((and x (? symbol?)) ..1) (equal? x '(a b c))))) + (pass-if "list ..1, nested" + (match '((1 2) (3 4)) + (((x ..1) ..1) + (equal? x '((1 2) (3 4)))))) + (pass-if "tree" (let ((tree '(one (two 2) (three 3 (and 4 (and 5)))))) (match tree