diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-01-26 00:46:57 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-01-26 00:46:57 -0800 |
| commit | deae97f0dfdf0ea33bba2912f05bb6b350553b94 (patch) | |
| tree | 7d7a344efe14c3c5acb861870d07d71038f1face /share | |
| parent | 030f25146ff5d2f6671ef1b615fc4217004632e5 (diff) | |
| download | txr-deae97f0dfdf0ea33bba2912f05bb6b350553b94.tar.gz txr-deae97f0dfdf0ea33bba2912f05bb6b350553b94.tar.bz2 txr-deae97f0dfdf0ea33bba2912f05bb6b350553b94.zip | |
matcher: allow pat/var argument: @[expr var pat]
* share/txr/stdlib/match.tl (compile-dwim-predicate-match):
Drop redundant bindable check of sym, since compile-var-match
checks this. Support third argument which gives a pattern or
variable which captures the value from the predicate function,
which might be interesting (not just true/false).
* tests/011/patmatch.tl: New tests.
* txr.1: Documented.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/match.tl | 26 |
1 files changed, 21 insertions, 5 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index 00918f37..04118c64 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -195,12 +195,28 @@ var-match)) (defun compile-dwim-predicate-match (pred-expr obj-var var-list) - (mac-param-bind *match-form* (dwim fun : sym) pred-expr - (or (null sym) (bindable sym) - (compile-error *match-form* "~s is not a symbol" sym)) + (mac-param-bind *match-form* (dwim fun : sym pat) pred-expr (let ((var-match (compile-var-match sym obj-var var-list))) - (set var-match.test-expr ^(and ,var-match.test-expr [,fun ,obj-var])) - var-match))) + (if pat + (let* ((pat-match (if (symbolp pat) + (compile-var-match pat (gensym) var-list) + (compile-match pat (gensym) var-list))) + (guard (new match-guard + vars (list pat-match.obj-var) + var-exprs (list ^[,fun ,obj-var])))) + (new compiled-match + pattern pred-expr + obj-var obj-var + guard-chain (cons guard (append var-match.guard-chain + pat-match.guard-chain)) + vars (append var-match.vars pat-match.vars) + var-exprs (append var-match.var-exprs pat-match.var-exprs) + test-expr ^(and ,var-match.test-expr + ,pat-match.test-expr + ,pat-match.obj-var))) + (progn + (set var-match.test-expr ^(and ,var-match.test-expr [,fun ,obj-var])) + var-match))))) (defun compile-predicate-match (pred-expr obj-var var-list) (mac-param-bind *match-form* (fun : sym) pred-expr |