diff --git a/lib/chibi/match-test.sld b/lib/chibi/match-test.sld index b64abe0c..3f3186fa 100644 --- a/lib/chibi/match-test.sld +++ b/lib/chibi/match-test.sld @@ -117,6 +117,15 @@ (test "Riastradh quasiquote" '(2 3) (match '(1 2 3) (`(1 ,b ,c) (list b c)))) + (test "unquote-splicing" '(2 3) + (match '(1 2 3) (`(1 ,@ls) ls))) + + (test "unquote-splicing tail" '(b c) + (match '(a b c d) (`(a ,@ls d) ls))) + + (test "unquote-splicing tail fail" #f + (match '(a b c e) (`(a ,@ls d) ls) (else #f))) + (test "trivial tree search" '(1 2 3) (match '(1 2 3) ((_ *** (a b c)) (list a b c)))) diff --git a/lib/chibi/match/match.scm b/lib/chibi/match/match.scm index c3b53644..d7145ee9 100644 --- a/lib/chibi/match/match.scm +++ b/lib/chibi/match/match.scm @@ -235,7 +235,7 @@ ;; performance can be found at ;; http://synthcode.com/scheme/match-cond-expand.scm ;; -;; 2020/07/06 - adding `..=' and `..*' patterns +;; 2020/07/06 - adding `..=' and `..*' patterns; fixing ,@ patterns ;; 2016/10/05 - treat keywords as literals, not identifiers, in Chicken ;; 2016/03/06 - fixing named match-let (thanks to Stefan Israelsson Tampe) ;; 2015/05/09 - fixing bug in var extraction of quasiquote patterns @@ -460,17 +460,15 @@ ;; QUASIQUOTE patterns (define-syntax match-quasiquote - (syntax-rules (unquote unquote-splicing quasiquote) + (syntax-rules (unquote unquote-splicing quasiquote or) ((_ v (unquote p) g+s sk fk i) (match-one v p g+s sk fk i)) ((_ v ((unquote-splicing p) . rest) g+s sk fk i) - (if (pair? v) - (match-one v - (p . tmp) - (match-quasiquote tmp rest g+s sk fk) - fk - i) - fk)) + ;; TODO: it is an error to have another unquote-splicing in rest, + ;; check this and signal explicitly + (match-extract-vars + p + (match-gen-ellipsis/qq v p rest g+s sk fk i) i ())) ((_ v (quasiquote p) g+s sk fk i . depth) (match-quasiquote v p g+s sk fk i #f . depth)) ((_ v (unquote p) g+s sk fk i x . depth) @@ -599,6 +597,33 @@ (else fk))))))))) +;; Variant of the above where the rest pattern is in a quasiquote. + +(define-syntax match-gen-ellipsis/qq + (syntax-rules () + ((_ v p r g+s (sk ...) fk i ((id id-ls) ...)) + (match-verify-no-ellipsis + r + (let* ((tail-len (length 'r)) + (ls v) + (len (and (list? ls) (length ls)))) + (if (or (not len) (< len tail-len)) + fk + (let loop ((ls ls) (n len) (id-ls '()) ...) + (cond + ((= n tail-len) + (let ((id (reverse id-ls)) ...) + (match-quasiquote ls r g+s (sk ...) fk i))) + ((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))) + (else + fk))))))))) + ;; Variant of above which takes an n/m range for the number of ;; repetitions. At least n elements much match, and up to m elements ;; are greedily consumed.