diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-01-23 07:40:52 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-01-23 07:40:52 -0800 |
commit | dac211e5abde6f1bd9f0cc4300508bce8bf6968b (patch) | |
tree | 94708ea64086efec797b121d0271a150c4efe424 | |
parent | ff7890e39f2fee4920a85c85248ea65ce8f5510f (diff) | |
download | txr-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.tl | 24 | ||||
-rw-r--r-- | txr.1 | 98 |
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) @@ -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) |