mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-07-05 04:06:36 +02:00
adding ..1' patterns to match (analog of regex
+' patterns)
This commit is contained in:
parent
67af0bb675
commit
09a5565418
2 changed files with 26 additions and 3 deletions
|
@ -28,6 +28,7 @@
|
|||
;; performance can be found at
|
||||
;; http://synthcode.com/scheme/match-cond-expand.scm
|
||||
;;
|
||||
;; 2010/09/26 - adding `..1' patterns (thanks to Ludovic Court<72>«²s)
|
||||
;; 2010/09/07 - fixing identifier extraction in some `...' and `***' patterns
|
||||
;; 2009/11/25 - adding `***' tree search patterns
|
||||
;; 2008/03/20 - fixing bug where (a ...) matched non-lists
|
||||
|
@ -126,7 +127,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)
|
||||
|
@ -162,6 +163,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 ($ rec p ...) g+s sk fk i)
|
||||
(if (is-a? v rec)
|
||||
(match-record-refs v rec 0 (p ...) g+s sk fk i)
|
||||
|
@ -503,7 +508,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)
|
||||
|
@ -534,6 +539,7 @@
|
|||
((match-extract-vars _ (k ...) i v) (k ... v))
|
||||
((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))
|
||||
;; This is the main part, the only place where we might add a new
|
||||
;; var if it's an unbound symbol.
|
||||
((match-extract-vars p (k ...) (i ...) v)
|
||||
|
@ -541,7 +547,7 @@
|
|||
((new-sym?
|
||||
(syntax-rules (i ...)
|
||||
((new-sym? p sk fk) sk)
|
||||
((new-sym? x sk fk) fk))))
|
||||
((new-sym? any sk fk) fk))))
|
||||
(new-sym? random-sym-to-match
|
||||
(k ... ((p p-ls) . v))
|
||||
(k ... v))))
|
||||
|
|
|
@ -141,4 +141,21 @@
|
|||
(test "joined tail" '(1 2)
|
||||
(match '(1 2 3) ((and (a ... b) x) a)))
|
||||
|
||||
(test "list ..1" '(a b c)
|
||||
(match '(a b c) ((x ..1) x)))
|
||||
|
||||
(test "list ..1 failed" #f
|
||||
(match '()
|
||||
((x ..1) x)
|
||||
(else #f)))
|
||||
|
||||
(test "list ..1 with predicate" '(a b c)
|
||||
(match '(a b c)
|
||||
(((and x (? symbol?)) ..1) x)))
|
||||
|
||||
(test "list ..1 with failed predicate" #f
|
||||
(match '(a b 3)
|
||||
(((and x (? symbol?)) ..1) x)
|
||||
(else #f)))
|
||||
|
||||
(test-end)
|
||||
|
|
Loading…
Add table
Reference in a new issue