diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-02-01 19:45:12 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-02-01 19:45:12 -0800 |
| commit | 91df29c08fc14d0344892891b1adf68894ea84c4 (patch) | |
| tree | 51fcb81e230f12796c9b8163d443ed714a28eb56 | |
| parent | 19e01d79bc89115c73f2a953bd77b9a9acb9d326 (diff) | |
| download | txr-91df29c08fc14d0344892891b1adf68894ea84c4.tar.gz txr-91df29c08fc14d0344892891b1adf68894ea84c4.tar.bz2 txr-91df29c08fc14d0344892891b1adf68894ea84c4.zip | |
matcher: struct: make guards lists; eliminate backquote.
* share/txr/stdlib/match.tl (compile-struct-match): make
guard0 and guard1 lists match-guard items. Replace
backquote with straight append.
| -rw-r--r-- | share/txr/stdlib/match.tl | 28 |
1 files changed, 15 insertions, 13 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index 2c47ca2a..ab2a3398 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -139,19 +139,20 @@ slot-matches)) (slot-val-exprs [mapcar (ret ^(slot ,obj-var ',@1)) required-slots]) (guard0 (if loose-p - (new match-guard - pure-temps (list type-gensym) - pure-temp-exprs (list ^(struct-type ,obj-var)) - guard-expr ^(structp ,obj-var)))) - (guard1 (new match-guard - pure-temps slot-gensyms - pure-temp-exprs slot-val-exprs - guard-expr (if loose-p - ^(and ,*(mapcar - (ret ^(slotp ,type-gensym ',@1)) + (list (new match-guard + pure-temps (list type-gensym) + pure-temp-exprs (list ^(struct-type ,obj-var)) + guard-expr ^(structp ,obj-var))))) + (guard1 (list (new match-guard + pure-temps slot-gensyms + pure-temp-exprs slot-val-exprs + guard-expr (if loose-p + ^(and ,*(mapcar + (ret ^(slotp ,type-gensym + ',@1)) required-slots)) ^(subtypep (typeof ,obj-var) - ',required-type))))) + ',required-type)))))) (unless loose-p (let ((type (find-struct-type required-type))) (if type @@ -166,8 +167,9 @@ (new compiled-match pattern struct-pat obj-var obj-var - guard-chain ^(,*(if guard0 (list guard0)) ,guard1 - ,*(mappend .guard-chain all-matches)))))) + guard-chain (append guard0 + guard1 + (mappend .guard-chain all-matches)))))) (defun compile-var-match (sym obj-var var-list) (or (null sym) (bindable sym) |