mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-07-10 22:47:33 +02:00
track head ids in ellipsis tail
This commit is contained in:
parent
dda71763a5
commit
5860a65368
2 changed files with 14 additions and 9 deletions
|
@ -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))))
|
||||
|
|
|
@ -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))))))
|
||||
|
|
Loading…
Add table
Reference in a new issue