From 5860a653680cc5fd632058e710d84c4ed49a06f5 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Wed, 26 Aug 2020 17:24:38 +0900 Subject: [PATCH] track head ids in ellipsis tail --- lib/chibi/match-test.sld | 5 +++++ lib/chibi/match/match.scm | 18 +++++++++--------- 2 files changed, 14 insertions(+), 9 deletions(-) diff --git a/lib/chibi/match-test.sld b/lib/chibi/match-test.sld index 9e0074f3..fc335a53 100644 --- a/lib/chibi/match-test.sld +++ b/lib/chibi/match-test.sld @@ -39,6 +39,8 @@ (test "duplicate symbols pass" 'ok (match '(ok . ok) ((x . x) x))) (test "duplicate symbols fail" 'ok (match '(ok . bad) ((x . x) 'bad) (else 'ok))) + (test "duplicate symbols fail 2" 'ok + (match '(ok bad) ((x x) 'bad) (else 'ok))) (test "duplicate symbols samth" 'ok (match '(ok . ok) ((x . 'bad) x) (('ok . x) x))) (test "duplicate symbols bound" 3 @@ -106,6 +108,9 @@ (match '((a . 1) (b . 2) 3) (((x . y) ... last) (list x y last)))) + (test "single duplicate tail" #f + (match '(1 2) ((foo ... foo) foo) (_ #f))) + (test "multiple tail" '((a b) (1 2) (c . 3) (d . 4) (e . 5)) (match '((a . 1) (b . 2) (c . 3) (d . 4) (e . 5)) (((x . y) ... u v w) (list x y u v w)))) diff --git a/lib/chibi/match/match.scm b/lib/chibi/match/match.scm index 82527ea8..cf407e00 100644 --- a/lib/chibi/match/match.scm +++ b/lib/chibi/match/match.scm @@ -581,7 +581,7 @@ fk i))) (else fk))))) - ((_ v p r g+s (sk ...) fk i ((id id-ls) ...)) + ((_ v p r g+s sk fk (i ...) ((id id-ls) ...)) ;; general case, trailing patterns to match, keep track of the ;; remaining list length so we don't need any backtracking (match-verify-no-ellipsis @@ -595,14 +595,14 @@ (cond ((= n tail-len) (let ((id (reverse id-ls)) ...) - (match-one ls r (#f #f) (sk ...) fk i))) + (match-one ls r (#f #f) sk fk (i ... id ...)))) ((pair? ls) (let ((w (car ls))) (match-one w p ((car ls) (set-car! ls)) (match-drop-ids (loop (cdr ls) (- n 1) (cons id id-ls) ...)) fk - i))) + (i ...)))) (else fk))))))))) @@ -610,7 +610,7 @@ (define-syntax match-gen-ellipsis/qq (syntax-rules () - ((_ v p r g+s (sk ...) fk i ((id id-ls) ...)) + ((_ v p r g+s (sk ...) fk (i ...) ((id id-ls) ...)) (match-verify-no-ellipsis r (let* ((tail-len (length 'r)) @@ -622,14 +622,14 @@ (cond ((= n tail-len) (let ((id (reverse id-ls)) ...) - (match-quasiquote ls r g+s (sk ...) fk i))) + (match-quasiquote ls r g+s (sk ...) fk (i ... id ...)))) ((pair? ls) (let ((w (car ls))) (match-one w p ((car ls) (set-car! ls)) (match-drop-ids (loop (cdr ls) (- n 1) (cons id id-ls) ...)) fk - i))) + (i ...)))) (else fk))))))))) @@ -639,7 +639,7 @@ (define-syntax match-gen-ellipsis/range (syntax-rules () - ((_ %lo %hi v p r g+s (sk ...) fk i ((id id-ls) ...)) + ((_ %lo %hi v p r g+s (sk ...) fk (i ...) ((id id-ls) ...)) ;; general case, trailing patterns to match, keep track of the ;; remaining list length so we don't need any backtracking (match-verify-no-ellipsis @@ -654,14 +654,14 @@ (cond ((= j len) (let ((id (reverse id-ls)) ...) - (match-one ls r (#f #f) (sk ...) fk i))) + (match-one ls r (#f #f) (sk ...) fk (i ... id ...)))) ((pair? ls) (let ((w (car ls))) (match-one w p ((car ls) (set-car! ls)) (match-drop-ids (loop (cdr ls) (+ j 1) (cons id id-ls) ...)) fk - i))) + (i ...)))) (else fk))) fk))))))