Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 13:49:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

change match names to SRFI 204

Browse source
This commit is contained in:
Alex Shinn 2020-09-04 18:33:25 +09:00
parent c82baa3aa9
commit 645bf03749
2 changed files with 56 additions and 55 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

68
lib/chibi/match-test.sld
View file

@ -186,50 +186,50 @@
(test "joined tail" '(1 2) (test "joined tail" '(1 2)
(match '(1 2 3) ((and (a ... b) x) a))) (match '(1 2 3) ((and (a ... b) x) a)))
(test "list ..1" '(a b c) (test "list **1" '(a b c)
(match '(a b c) ((x ..1) x))) (match '(a b c) ((x **1) x)))
(test "list ..1 failed" #f (test "list **1 failed" #f
(match '() (match '()
((x ..1) x) ((x **1) x)
(else #f))) (else #f)))
(test "list ..1 with predicate" '(a b c) (test "list **1 with predicate" '(a b c)
(match '(a b c) (match '(a b c)
(((and x (? symbol?)) ..1) x))) (((and x (? symbol?)) **1) x)))
(test "list ..1 with failed predicate" #f (test "list **1 with failed predicate" #f
(match '(a b 3) (match '(a b 3)
(((and x (? symbol?)) ..1) x) (((and x (? symbol?)) **1) x)
(else #f))) (else #f)))
(test "list ..= too few" #f (test "list =.. too few" #f
(match (list 1 2) ((a b ..= 2) b) (else #f))) (match (list 1 2) ((a b =.. 2) b) (else #f)))
(test "list ..=" '(2 3) (test "list =.." '(2 3)
(match (list 1 2 3) ((a b ..= 2) b) (else #f))) (match (list 1 2 3) ((a b =.. 2) b) (else #f)))
(test "list ..= too many" #f (test "list =.. too many" #f
(match (list 1 2 3 4) ((a b ..= 2) b) (else #f))) (match (list 1 2 3 4) ((a b =.. 2) b) (else #f)))
(test "list ..= tail" 4 (test "list =.. tail" 4
(match (list 1 2 3 4) ((a b ..= 2 c) c) (else #f))) (match (list 1 2 3 4) ((a b =.. 2 c) c) (else #f)))
(test "list ..= tail fail" #f (test "list =.. tail fail" #f
(match (list 1 2 3 4 5 6) ((a b ..= 2 c) c) (else #f))) (match (list 1 2 3 4 5 6) ((a b =.. 2 c) c) (else #f)))
(test "list ..* too few" #f (test "list *.. too few" #f
(match (list 1 2) ((a b ..* 2 4) b) (else #f))) (match (list 1 2) ((a b *.. 2 4) b) (else #f)))
(test "list ..* lo" '(2 3) (test "list *.. lo" '(2 3)
(match (list 1 2 3) ((a b ..* 2 4) b) (else #f))) (match (list 1 2 3) ((a b *.. 2 4) b) (else #f)))
(test "list ..* hi" '(2 3 4 5) (test "list *.. hi" '(2 3 4 5)
(match (list 1 2 3 4 5) ((a b ..* 2 4) b) (else #f))) (match (list 1 2 3 4 5) ((a b *.. 2 4) b) (else #f)))
(test "list ..* too many" #f (test "list *.. too many" #f
(match (list 1 2 3 4 5 6) ((a b ..* 2 4) b) (else #f))) (match (list 1 2 3 4 5 6) ((a b *.. 2 4) b) (else #f)))
(test "list ..* tail" 4 (test "list *.. tail" 4
(match (list 1 2 3 4) ((a b ..* 2 4 c) c) (else #f))) (match (list 1 2 3 4) ((a b *.. 2 4 c) c) (else #f)))
(test "list ..* tail 2" 5 (test "list *.. tail 2" 5
(match (list 1 2 3 4 5) ((a b ..* 2 4 c d) d) (else #f))) (match (list 1 2 3 4 5) ((a b *.. 2 4 c d) d) (else #f)))
(test "list ..* tail" 6 (test "list *.. tail" 6
(match (list 1 2 3 4 5 6) ((a b ..* 2 4 c) c) (else #f))) (match (list 1 2 3 4 5 6) ((a b *.. 2 4 c) c) (else #f)))
(test "list ..* tail fail" #f (test "list *.. tail fail" #f
(match (list 1 2 3 4 5 6 7) ((a b ..* 2 4 c) c) (else #f))) (match (list 1 2 3 4 5 6 7) ((a b *.. 2 4 c) c) (else #f)))
(test "match-named-let" 6 (test "match-named-let" 6
(match-let loop (((x . rest) '(1 2 3)) (match-let loop (((x . rest) '(1 2 3))

43
lib/chibi/match/match.scm
View file

@ -86,26 +86,26 @@
;;> \scheme{___} is provided as an alias for \scheme{...} when it is ;;> \scheme{___} is provided as an alias for \scheme{...} when it is
;;> inconvenient to use the ellipsis (as in a syntax-rules template). ;;> inconvenient to use the ellipsis (as in a syntax-rules template).
;;> The \scheme{..1} syntax is exactly like the \scheme{...} except ;;> The \scheme{**1} syntax is exactly like the \scheme{...} except
;;> that it matches one or more repetitions (like a regexp "+"). ;;> that it matches one or more repetitions (like a regexp "+").
;;> \example{(match (list 1 2) ((a b c ..1) c))} ;;> \example{(match (list 1 2) ((a b c **1) c))}
;;> \example{(match (list 1 2 3) ((a b c ..1) c))} ;;> \example{(match (list 1 2 3) ((a b c **1) c))}
;;> The \scheme{..*} syntax is like \scheme{...} except that it takes ;;> The \scheme{*..} syntax is like \scheme{...} except that it takes
;;> two trailing integers \scheme{<n>} and \scheme{<m>}, and requires ;;> two trailing integers \scheme{<n>} and \scheme{<m>}, and requires
;;> the pattern to match from \scheme{<n>} times. ;;> the pattern to match from \scheme{<n>} times.
;;> \example{(match (list 1 2 3) ((a b ..* 2 4) b))} ;;> \example{(match (list 1 2 3) ((a b *.. 2 4) b))}
;;> \example{(match (list 1 2 3 4 5 6) ((a b ..* 2 4) b))} ;;> \example{(match (list 1 2 3 4 5 6) ((a b *.. 2 4) b))}
;;> \example{(match (list 1 2 3 4) ((a b ..* 2 4 c) c))} ;;> \example{(match (list 1 2 3 4) ((a b *.. 2 4 c) c))}
;;> The \scheme{(<expr> ..= <n>)} syntax is a shorthand for ;;> The \scheme{(<expr> =.. <n>)} syntax is a shorthand for
;;> \scheme{(<expr> ..* <n> <n>)}. ;;> \scheme{(<expr> *.. <n> <n>)}.
;;> \example{(match (list 1 2) ((a b ..= 2) b))} ;;> \example{(match (list 1 2) ((a b =.. 2) b))}
;;> \example{(match (list 1 2 3) ((a b ..= 2) b))} ;;> \example{(match (list 1 2 3) ((a b =.. 2) b))}
;;> \example{(match (list 1 2 3 4) ((a b ..= 2) b))} ;;> \example{(match (list 1 2 3 4) ((a b =.. 2) b))}
;;> The boolean operators \scheme{and}, \scheme{or} and \scheme{not} ;;> The boolean operators \scheme{and}, \scheme{or} and \scheme{not}
;;> can be used to group and negate patterns analogously to their ;;> can be used to group and negate patterns analogously to their
@ -242,8 +242,9 @@
;; performance can be found at ;; performance can be found at
;; http://synthcode.com/scheme/match-cond-expand.scm ;; http://synthcode.com/scheme/match-cond-expand.scm
;; ;;
;; 2020/09/04 - perf fix for `not`; rename `..=', `..=', `..1' per SRFI 204
;; 2020/08/21 - fixing match-letrec with unhygienic insertion ;; 2020/08/21 - fixing match-letrec with unhygienic insertion
;; 2020/07/06 - adding `..=' and `..*' patterns; fixing ,@ patterns ;; 2020/07/06 - adding `..=' and `..=' patterns; fixing ,@ patterns
;; 2016/10/05 - treat keywords as literals, not identifiers, in Chicken ;; 2016/10/05 - treat keywords as literals, not identifiers, in Chicken
;; 2016/03/06 - fixing named match-let (thanks to Stefan Israelsson Tampe) ;; 2016/03/06 - fixing named match-let (thanks to Stefan Israelsson Tampe)
;; 2015/05/09 - fixing bug in var extraction of quasiquote patterns ;; 2015/05/09 - fixing bug in var extraction of quasiquote patterns
@ -369,7 +370,7 @@
;; pattern so far. ;; pattern so far.
(define-syntax match-two (define-syntax match-two
(syntax-rules (_ ___ ..1 ..= ..* *** quote quasiquote ? $ struct @ object = and or not set! get!) (syntax-rules (_ ___ **1 =.. *.. *** quote quasiquote ? $ struct @ object = and or not set! get!)
((match-two v () g+s (sk ...) fk i) ((match-two v () g+s (sk ...) fk i)
(if (null? v) (sk ... i) fk)) (if (null? v) (sk ... i) fk))
((match-two v (quote p) g+s (sk ...) fk i) ((match-two v (quote p) g+s (sk ...) fk i)
@ -406,15 +407,15 @@
(match-extract-vars p (match-gen-search v p q g+s sk fk i) i ())) (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-two v (p *** . q) g+s sk fk i)
(match-syntax-error "invalid use of ***" (p *** . q))) (match-syntax-error "invalid use of ***" (p *** . q)))
((match-two v (p ..1) g+s sk fk i) ((match-two v (p **1) g+s sk fk i)
(if (pair? v) (if (pair? v)
(match-one v (p ___) g+s sk fk i) (match-one v (p ___) g+s sk fk i)
fk)) fk))
((match-two v (p ..= n . r) g+s sk fk i) ((match-two v (p =.. n . r) g+s sk fk i)
(match-extract-vars (match-extract-vars
p p
(match-gen-ellipsis/range n n v p r g+s sk fk i) i ())) (match-gen-ellipsis/range n n v p r g+s sk fk i) i ()))
((match-two v (p ..* n m . r) g+s sk fk i) ((match-two v (p *.. n m . r) g+s sk fk i)
(match-extract-vars (match-extract-vars
p p
(match-gen-ellipsis/range n m v p r g+s sk fk i) i ())) (match-gen-ellipsis/range n m v p r g+s sk fk i) i ()))
@ -832,7 +833,7 @@
;; (match-extract-vars pattern continuation (ids ...) (new-vars ...)) ;; (match-extract-vars pattern continuation (ids ...) (new-vars ...))
(define-syntax match-extract-vars (define-syntax match-extract-vars
(syntax-rules (_ ___ ..1 ..= ..* *** ? $ struct @ object = quote quasiquote and or not get! set!) (syntax-rules (_ ___ **1 =.. *.. *** ? $ struct @ object = quote quasiquote and or not get! set!)
((match-extract-vars (? pred . p) . x) ((match-extract-vars (? pred . p) . x)
(match-extract-vars p . x)) (match-extract-vars p . x))
((match-extract-vars ($ rec . p) . x) ((match-extract-vars ($ rec . p) . x)
@ -869,9 +870,9 @@
((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 ___ (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)) ((match-extract-vars **1 (k ...) i v) (k ... v))
((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 *.. (k ...) i v) (k ... v))
;; This is the main part, the only place where we might add a new ;; This is the main part, the only place where we might add a new
;; var if it's an unbound symbol. ;; var if it's an unbound symbol.
((match-extract-vars p (k ...) (i ...) v) ((match-extract-vars p (k ...) (i ...) v)