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 | |
| 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.
| -rw-r--r-- | share/txr/stdlib/match.tl | 36 | ||||
| -rw-r--r-- | tests/011/patmatch.tl | 7 | ||||
| -rw-r--r-- | txr.1 | 24 |
3 files changed, 59 insertions, 8 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 diff --git a/tests/011/patmatch.tl b/tests/011/patmatch.tl index 85adb352..071243fb 100644 --- a/tests/011/patmatch.tl +++ b/tests/011/patmatch.tl @@ -187,6 +187,13 @@ (42)) (mtest + (when-match @(hash (a)) #H(() (a b)) t) t + (when-match @(hash (c)) #H(() (a b)) t) nil + (let ((x 'a)) (when-match @(hash (@x)) #H(() (a b)) t)) t + (let ((x 'd)) (when-match @(hash (@x)) #H(() (a b)) t)) nil + (when-match @(hash (@x)) #H(() (a b)) x) (a)) + +(mtest (if-match #R(10 20) 10..20 :yes :no) :yes (if-match #R(10 20) #R(10 20) :yes :no) :yes (if-match #R(10 20) #R(1 2) :yes :no) :no @@ -41159,7 +41159,7 @@ object's structure type: the type itself, rather than its symbolic name. .coNP Pattern operator @ hash .synb -.mets @(hash >> {( key-pattern << value-pattern )}*) +.mets @(hash >> {( key-pattern <> [ value-pattern ])}*) .syne .desc The @@ -41188,6 +41188,9 @@ pair against that object as described below. Each of the pairs must successfully match, otherwise the overall match fails. +The following requirements apply to key-value pattern pairs in which +the value pattern is specified. + If .meta key-pattern is a trivial pattern, then the semantics of the match is that @@ -41267,6 +41270,25 @@ such that the semantics can then be understood in terms of the .code coll operator matching against an association list. +The following requirements apply when the +.meta value-pattern +is omitted. + +If +.meta key-pattern +is a nontrivial pattern other than a variable pattern +for a variable which has an existing binding, then the pattern +is applied against the list of keys from the hash table, which +are retrieved as if using the +.code hash-keys +function. + +If +.meta key-pattern +is a variable pattern referring to an existing binding, then that pattern is +taken as a literal object. The match is successful if that object occurs as a +key in the hash table. + .TP* Example: .verb |