summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2021-02-01 19:51:54 -0800
committerKaz Kylheku <kaz@kylheku.com>2021-02-01 19:51:54 -0800
commita2ebdf6228c7bee57ca9470477f09b2649501c2c (patch)
tree1b86de96bfd095883a5fac6116ddfbbc005ea570
parent91df29c08fc14d0344892891b1adf68894ea84c4 (diff)
downloadtxr-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.tl6
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)