diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2023-08-09 19:31:07 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2023-08-09 19:31:07 -0700 |
| commit | 174c054bbc54aefa4068d2863b43fabd9914ebd2 (patch) | |
| tree | 5be2b03c66ec0ce6cec0d24d0b3bb3103bcba04b | |
| parent | 3c0c679b74016f0219c31d82578b99e53e531c78 (diff) | |
| download | txr-174c054bbc54aefa4068d2863b43fabd9914ebd2.tar.gz txr-174c054bbc54aefa4068d2863b43fabd9914ebd2.tar.bz2 txr-174c054bbc54aefa4068d2863b43fabd9914ebd2.zip | |
compiler/match: eliminate (subtypep (typeof x) y).
* stdlib/compiler.tl (compiler comp-fun-form): Recognize
the pattern (subtypep (typeof x) y) and rewrite it to
(typep x y).
* stdlib/match.tl (compile-struct-match): Don't generate
the (subtype (typeof x) y) pattern, but (typeof x y).
| -rw-r--r-- | stdlib/compiler.tl | 2 | ||||
| -rw-r--r-- | stdlib/match.tl | 3 |
2 files changed, 3 insertions, 2 deletions
diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl index 58685741..a837571e 100644 --- a/stdlib/compiler.tl +++ b/stdlib/compiler.tl @@ -1411,6 +1411,8 @@ (set form (rlcp ^(,bin ,a ,b) form))) ((- @a) (set form (rlcp ^(neg ,a) form))) + ((subtypep (typeof @a) @b) + (set form (rlcp ^(typep ,a ,b) form))) ((@(or ignore nilf) . @args) (if (eql sym 'ignore) (each ((a args)) diff --git a/stdlib/match.tl b/stdlib/match.tl index 65382cc2..333596b2 100644 --- a/stdlib/match.tl +++ b/stdlib/match.tl @@ -163,8 +163,7 @@ (ret ^(slotp ,type-gensym ',@1)) required-slots)) - ^(subtypep (typeof ,obj-var) - ',required-type)))))) + ^(typep ,obj-var ',required-type)))))) (unless loose-p (let ((type (find-struct-type required-type))) (if type |