summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2021-01-24 13:10:20 -0800
committerKaz Kylheku <kaz@kylheku.com>2021-01-24 13:10:20 -0800
commit2a6e91240f8ff72cc340b7910cec23eea0533ccd (patch)
tree10cf58c8cdba93c36603eec991b90a38c260fb28
parent87d89d601fba2dd1acc20e723b922da0e7210f1b (diff)
downloadtxr-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.tl38
-rw-r--r--tests/011/patmatch.tl9
-rw-r--r--txr.125
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)
diff --git a/txr.1 b/txr.1
index b42cb75c..99e03045 100644
--- a/txr.1
+++ b/txr.1
@@ -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