diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-02-01 19:51:54 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-02-01 19:51:54 -0800 |
commit | a2ebdf6228c7bee57ca9470477f09b2649501c2c (patch) | |
tree | 1b86de96bfd095883a5fac6116ddfbbc005ea570 | |
parent | 91df29c08fc14d0344892891b1adf68894ea84c4 (diff) | |
download | txr-a2ebdf6228c7bee57ca9470477f09b2649501c2c.tar.gz txr-a2ebdf6228c7bee57ca9470477f09b2649501c2c.tar.bz2 txr-a2ebdf6228c7bee57ca9470477f09b2649501c2c.zip |
matcher: struct: move type test before slot tests.
In the loose form of the @(struct ...) match, the struct type
is matched by a pattern. This pattern should execute before
the object is tested for the presence of the required slots
by by guard1. It should not come between testing for the
presence of slots, and then testing their contents.
* share/txr/stdlib/match.tl (compile-struct-match): Do not
lump together the type-match and slot-matches into a single
all-matches list. Emit type-match's guard before guard1,
and the slot-matches guards after. The order is
basic test (guard0), struct type pattern match (type-match),
slots-present (guard1) and then slot contents (slot-matches).
-rw-r--r-- | share/txr/stdlib/match.tl | 6 |
1 files changed, 2 insertions, 4 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index ab2a3398..b2d7b2c1 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -134,9 +134,6 @@ slot-patterns slot-gensyms]) (type-match (if loose-p (compile-match required-type type-gensym var-list))) - (all-matches (if loose-p - (cons type-match slot-matches) - slot-matches)) (slot-val-exprs [mapcar (ret ^(slot ,obj-var ',@1)) required-slots]) (guard0 (if loose-p (list (new match-guard @@ -168,8 +165,9 @@ pattern struct-pat obj-var obj-var guard-chain (append guard0 + type-match.?guard-chain guard1 - (mappend .guard-chain all-matches)))))) + (mappend .guard-chain slot-matches)))))) (defun compile-var-match (sym obj-var var-list) (or (null sym) (bindable sym) |