diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-05-24 08:41:58 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-05-24 08:41:58 -0700 |
| commit | f2f951350516e4b959ef28f220e31b91b466fa16 (patch) | |
| tree | ee4958ffcac59dcfb909ca5e217d5a74a42b1569 /share/txr/stdlib/match.tl | |
| parent | 7b587fe3450c949f454778bfaf71870a5a872f6b (diff) | |
| download | txr-f2f951350516e4b959ef28f220e31b91b466fa16.tar.gz txr-f2f951350516e4b959ef28f220e31b91b466fa16.tar.bz2 txr-f2f951350516e4b959ef28f220e31b91b466fa16.zip | |
matcher: allow hash pattern to omit values.
The @(hash ...) operator now allows key-only patterns
like (42) or (@x), where x could be bound or unbound.
This has separate semantics from when a value is present.
* share/txr/stdlib/match.tl (compile-hash-match): Implement.
* tests/011/patmatch.tl: Test.
* txr.1: Document.
Diffstat (limited to 'share/txr/stdlib/match.tl')
| -rw-r--r-- | share/txr/stdlib/match.tl | 36 |
1 files changed, 29 insertions, 7 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index 0d99e7cf..fa0ccb80 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -469,16 +469,32 @@ (let* ((hash-alist-var (gensym "hash-alist-")) (hash-alt-val ^',(gensym "alt")) (need-alist-p nil) + (hash-keys-var (gensym "hash-keys-")) + (need-keys-p nil) (hash-matches (collect-each ((pair pairs)) - (mac-param-bind *match-form* (key val) pair + (mac-param-bind *match-form* (key : (val nil val-p)) pair (let ((key-pat-p (non-triv-pat-p key)) (val-pat-p (non-triv-pat-p val)) (key-var-sym (var-pat-p key))) (cond + ((and (not val-p) key-var-sym var-list.(exists key-var-sym)) + (let ((guard (new match-guard + test-expr ^(inhash ,obj-var + ,key-var-sym)))) + (new compiled-match + guard-chain (list guard)))) + ((and (not val-p) (not key-pat-p)) + (let ((guard (new match-guard + test-expr ^(inhash ,obj-var + ',key)))) + (new compiled-match + guard-chain (list guard)))) + ((not val-p) + (set need-keys-p t) + (compile-match key hash-keys-var var-list)) ((and key-var-sym var-list.(exists key-var-sym)) - (let ((vm (compile-match val (gensym "val") var-list)) - (val-sym (gensym "val"))) + (let ((vm (compile-match val (gensym "val") var-list))) vm.(add-guards-pre (new match-guard vars (list vm.obj-var) @@ -511,10 +527,16 @@ vm))))))) (guard (new match-guard guard-expr ^(hashp ,obj-var) - vars (if need-alist-p - (list hash-alist-var)) - var-exprs (if need-alist-p - (list ^(hash-alist ,obj-var)))))) + vars (append + (if need-alist-p + (list hash-alist-var)) + (if need-keys-p + (list hash-keys-var))) + var-exprs (append + (if need-alist-p + (list ^(hash-alist ,obj-var))) + (if need-keys-p + (list ^(hash-keys ,obj-var))))))) (new compiled-match pattern hash-expr obj-var obj-var |