diff options
| author | Kaz Kylheku <kazkylheku@vtech.ca> | 2021-01-18 19:59:36 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-01-18 19:59:36 -0800 |
| commit | a91aff6dfa0d97c4130a3a7c630466b8ec2e247b (patch) | |
| tree | 339b4109213548307cb780bc6e2f6119ee4f139d /share | |
| parent | 1e081d603a1bf43b8a63d559a00aebb82a5bdb20 (diff) | |
| download | txr-a91aff6dfa0d97c4130a3a7c630466b8ec2e247b.tar.gz txr-a91aff6dfa0d97c4130a3a7c630466b8ec2e247b.tar.bz2 txr-a91aff6dfa0d97c4130a3a7c630466b8ec2e247b.zip | |
matcher: add @(not) operator.
* share/txr/stdlib/match.tl (compile-not-match): New function.
(compile-match): Hook in not operator.
* txr.1: Documented.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/match.tl | 17 |
1 files changed, 17 insertions, 0 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index 5c6038f5..38145218 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -262,6 +262,22 @@ test-expr t vars (uniq (mappend .vars par-matches)))))))) +(defun compile-not-match (pattern obj-var) + (tree-bind (op pattern) pattern + (let* ((pm (compile-match pattern obj-var)) + (guard (new match-guard + guard-expr ^(not (let ,pm.(get-vars) + ,pm.(wrap-guards + ^(progn ,*pm.(assignments) + (when ,pm.test-expr + t)))))))) + (new compiled-match + pattern pattern + obj-var obj-var + guard-chain (list guard) + test-expr t + vars nil)))) + (defun compile-match (pat : (obj-var (gensym))) (cond ((consp pat) @@ -278,6 +294,7 @@ (some (compile-loop-match exp obj-var)) (or (compile-parallel-match exp obj-var)) (and (compile-parallel-match exp obj-var)) + (not (compile-not-match exp obj-var)) (op (compile-op-match exp obj-var)) (t (compile-predicate-match exp obj-var))) (compile-error *match-form* |