summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2021-01-23 07:40:52 -0800
committerKaz Kylheku <kaz@kylheku.com>2021-01-23 07:40:52 -0800
commitdac211e5abde6f1bd9f0cc4300508bce8bf6968b (patch)
tree94708ea64086efec797b121d0271a150c4efe424
parentff7890e39f2fee4920a85c85248ea65ce8f5510f (diff)
downloadtxr-dac211e5abde6f1bd9f0cc4300508bce8bf6968b.tar.gz
txr-dac211e5abde6f1bd9f0cc4300508bce8bf6968b.tar.bz2
txr-dac211e5abde6f1bd9f0cc4300508bce8bf6968b.zip
matcher: add support for range objects.
* share/txr/stdlib/match.tl (compile-atom-match): Handle range type, via transformation to rcons operator and compile-range-mach. (compile-range-match): New function. (compile-match): Hook in compile-range-match for @(rcons). (non-triv-pat-p): Handle range case. * txr.1: Documented.
-rw-r--r--share/txr/stdlib/match.tl24
-rw-r--r--txr.198
2 files changed, 122 insertions, 0 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl
index af85ef8c..c8990c6a 100644
--- a/share/txr/stdlib/match.tl
+++ b/share/txr/stdlib/match.tl
@@ -161,6 +161,10 @@
(vec (if (non-triv-pat-p atom)
(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-as-atom)))
(t (compile-as-atom)))))
(defun compile-op-match (op-expr obj-var var-list)
@@ -379,6 +383,23 @@
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)
+ vars (list from-match.obj-var to-match.obj-var)
+ 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)
@@ -399,6 +420,7 @@
(not (compile-not-match exp obj-var var-list))
(op (compile-op-match exp obj-var var-list))
(hash (compile-hash-match exp obj-var var-list))
+ (rcons (compile-range-match exp obj-var var-list))
(t (compile-predicate-match exp obj-var var-list)))
(compile-error *match-form*
"unrecognized pattern syntax ~s" pat))))
@@ -469,6 +491,8 @@
((@(op eq 'sys:var) @(bindable) . @nil) t)
((@pat . @rest) (or (non-triv-pat-p pat)
(non-triv-pat-p rest)))
+ (#R(@from @to) (or (non-triv-pat-p from)
+ (non-triv-pat-p to)))
(@(some @(non-triv-pat-p)) t)))
(defun var-pat-p (syntax)
diff --git a/txr.1 b/txr.1
index a20ff1ca..4ca78509 100644
--- a/txr.1
+++ b/txr.1
@@ -39690,6 +39690,15 @@ 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
@@ -39857,6 +39866,47 @@ against the corresponding vector element.
--> (2 4)
.brev
+.NP* Range match
+.synb
+.mets >> #R( from-pattern << to-pattern )
+.syne
+.desc
+A pattern match for a range can be expressed by embedding pattern
+expressions in the
+.code #R
+notation. The resulting pattern requires the corresponding object
+to be a range, otherwise the match fails. If the corresponding
+object is a range, then the
+.meta from-pattern
+is matched against its
+.code from
+and the
+.meta to-pattern
+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) #R(10 20) :yes :no) -> :yes
+ (if-match #R(10 20) #R(1 2) :yes :no) -> :no
+
+ (when-match #R(@a @b) 1..2 (list a b)) -> (1 2)
+.brev
+
.coNP Pattern operator @ struct
.synb
.mets @(struct < name >> { slot-name << pattern }*)
@@ -40093,6 +40143,54 @@ operator matching against an association list.
--> (42)
.brev
+.coNP Pattern operator @ rcons
+.synb
+.mets >> @(rcons from-pattern << to-pattern )
+.mets >> @ from-pattern..to-pattern
+.syne
+.desc
+The
+.code rcons
+pattern matches a range. There is no semantic difference
+between the
+.code cons
+operator and the
+.mono
+.meti >> #R( from-pattern << to-pattern )
+.onom
+syntax. Refer to the Range match section for a semantic description.
+
+Note that if the dotdot syntactic sugar is used, the leading
+.code @
+is still required, because the unadorned expression
+.code "(rcons ...)"
+matches a list beginning with the symbol
+.code rcons
+and not a range object.
+In particular, note that
+.code "@(rcons @a @b)"
+corresponds to
+.code "@@a..@b"
+and not
+.code "@a..@b"
+or
+.codn "@(@a..@b)" .
+
+.TP* Examples:
+
+.verb
+ (if-match @(rcons 1 2) 1..2 :yes :no) -> :yes
+ (when-match @(rcons @a @b) (list a b)) -> (1 2)
+
+ ;; not a range match: match rcons source code:
+ (when-match @a..@b 'x..y (list a b)) -> (x y)
+
+ ;; de-sugared precise equivalent of previous:
+ (when-match (rcons @a @b) '(rcons x y)
+ (list a b)) -> (x y)
+.brev
+
+
.coNP Pattern operator @ let
.synb
.mets @(let < name << pattern)