diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-01-24 13:10:20 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-01-24 13:10:20 -0800 |
commit | 2a6e91240f8ff72cc340b7910cec23eea0533ccd (patch) | |
tree | 10cf58c8cdba93c36603eec991b90a38c260fb28 | |
parent | 87d89d601fba2dd1acc20e723b922da0e7210f1b (diff) | |
download | txr-2a6e91240f8ff72cc340b7910cec23eea0533ccd.tar.gz txr-2a6e91240f8ff72cc340b7910cec23eea0533ccd.tar.bz2 txr-2a6e91240f8ff72cc340b7910cec23eea0533ccd.zip |
matcher: rescind support for @(rcons ...) patterns.
There is no longer any way to write a @(rcons ...)
pattern using the range syntax, so there is no point in
supporting that operator. The silly syntax @@a..@b
which previously worked was actually due to a mistaken
requirement in the parser.
* share/txr/stdlib/match.tl (compile-range-match): Function
moved closer to compile-atom-match, below compile-vec-match.
The argument is now a range object containing patterns, so we
pull it apart with from and to.
(compile-atom-match): Pass range directly to
compile-range-match; no need to construct (rcons ...) syntax.
* tests/011/patmatch.tl: Add range tests from documentation
and a few others.
* txr.1: References to @(rcons ...) pattern scrubbed.
One wrong #R pattern example corrected.
-rw-r--r-- | share/txr/stdlib/match.tl | 38 | ||||
-rw-r--r-- | tests/011/patmatch.tl | 9 | ||||
-rw-r--r-- | txr.1 | 25 |
3 files changed, 31 insertions, 41 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index 8161d57f..d1c45559 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -156,6 +156,24 @@ vars (mappend .vars elem-matches) var-exprs (mappend .var-exprs elem-matches)))) +(defun compile-range-match (rcons-expr obj-var var-list) + (let ((from (from rcons-expr)) + (to (to rcons-expr))) + (let* ((from-match (compile-match from (gensym "from") var-list)) + (to-match (compile-match to (gensym "to") var-list)) + (guard (new match-guard + guard-expr ^(rangep ,obj-var) + pure-vars (list from-match.obj-var to-match.obj-var) + pure-var-exprs (list ^(from ,obj-var) ^(to ,obj-var))))) + (new compiled-match + pattern rcons-expr + obj-var obj-var + guard-chain (cons guard (append from-match.guard-chain + to-match.guard-chain)) + test-expr ^(and ,from-match.test-expr ,to-match.test-expr) + vars (append from-match.vars to-match.vars) + var-exprs (append from-match.var-exprs to-match.var-exprs))))) + (defun compile-atom-match (atom obj-var var-list) (flet ((compile-as-atom () (new compiled-match @@ -167,8 +185,7 @@ (compile-vec-match atom obj-var var-list) (compile-as-atom))) (range (if (non-triv-pat-p atom) - (compile-range-match ^(rcons ,(from atom) ,(to atom)) - obj-var var-list) + (compile-range-match atom obj-var var-list) (compile-as-atom))) (t (compile-as-atom))))) @@ -388,23 +405,6 @@ vars (mappend .vars hash-matches) var-exprs (mappend .var-exprs hash-matches))))) -(defun compile-range-match (rcons-expr obj-var var-list) - (tree-bind (op from to) rcons-expr - (let* ((from-match (compile-match from (gensym "from") var-list)) - (to-match (compile-match to (gensym "to") var-list)) - (guard (new match-guard - guard-expr ^(rangep ,obj-var) - pure-vars (list from-match.obj-var to-match.obj-var) - pure-var-exprs (list ^(from ,obj-var) ^(to ,obj-var))))) - (new compiled-match - pattern rcons-expr - obj-var obj-var - guard-chain (cons guard (append from-match.guard-chain - to-match.guard-chain)) - test-expr ^(and ,from-match.test-expr ,to-match.test-expr) - vars (append from-match.vars to-match.vars) - var-exprs (append from-match.var-exprs to-match.var-exprs))))) - (defun compile-match (pat : (obj-var (gensym)) (var-list (new var-list))) (cond ((consp pat) diff --git a/tests/011/patmatch.tl b/tests/011/patmatch.tl index d045c45b..ac474738 100644 --- a/tests/011/patmatch.tl +++ b/tests/011/patmatch.tl @@ -135,3 +135,12 @@ (test (when-match @(hash (x @y) (@(symbolp y) @datum)) #H(() (x k) (k 42)) datum) (42)) + +(test (if-match #R(10 20) 10..20 :yes :no) :yes) +(test (if-match #R(10 20) #R(10 20) :yes :no) :yes) +(test (if-match #R(10 20) #R(1 2) :yes :no) :no) +(test (when-match #R(@a @b) 1..2 (list a b)) (1 2)) +(test (when-match #R(@a 2) 1..2 a) 1) +(test (when-match #R(1 @a) 1..2 a) 2) +(test (when-match #R(2 @a) 1..2 a) nil) +(test (when-match #R(@a 1) 1..2 a) nil) @@ -39656,7 +39656,8 @@ binding .code a to .codn 3 . -The notation supports lists, vectors and atoms. Atoms are compared using the +The notation supports lists, vectors, ranges and atoms. Atoms are compared +using the .code equal function. Thus, in the above pattern, the 1 and 2 in the pattern match the corresponding 1 and 2 atoms in the object using @@ -39690,15 +39691,6 @@ can be significant. One sub-pattern may be expected to produce a match for a variable, which is then back-referenced in another sub-pattern. -Ranges can be -matched using the -.code "@(rcons ...)" -notation or its -.code .. -syntactic sugar, or using the -.code #R -printed representation. - A pattern can contain multiple occurrences of the same variable. Except in the case when these variables occur in different branches of an @@ -39886,21 +39878,10 @@ is matched against its .code to part. -Note: ranges can also be matched using the -.mono -.meti >> @(rcons from-pattern << to-pattern ) -.onom -operator, also expressible using its syntactic sugar -.mono -.meti >> @ from-pattern..to-pattern -.onom -described under Pattern operator -.codn rcons . - .TP* Examples: .verb - (if-match #R(10 20) 10..20 :yes :no) -> :no + (if-match #R(10 20) 10..20 :yes :no) -> :yes (if-match #R(10 20) #R(10 20) :yes :no) -> :yes (if-match #R(10 20) #R(1 2) :yes :no) -> :no |