From 8045eeaa27eb9009ce03607032f2b1beada1e4bd Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Mon, 1 Feb 2021 19:51:54 -0800 Subject: 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). --- share/txr/stdlib/match.tl | 6 ++---- 1 file 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) -- cgit v1.2.3