diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2022-01-21 23:06:12 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2022-01-21 23:06:12 -0800 |
commit | 912954cca7ed1d778a2ee7f416e0461845836c7c (patch) | |
tree | 91ed2374948687177657ce38297c0642f7397c06 /stdlib | |
parent | 474790ae526c164b2852997501b78fab03dcf339 (diff) | |
download | txr-912954cca7ed1d778a2ee7f416e0461845836c7c.tar.gz txr-912954cca7ed1d778a2ee7f416e0461845836c7c.tar.bz2 txr-912954cca7ed1d778a2ee7f416e0461845836c7c.zip |
compiler: optimize some typep expressions.
* stdlib/compiler.tl (compiler compile): Handle typep symbol
via comp-typep method.
(compiler comp-typep): New method. This recognizes some
absolute truths: every object is of type t, and no object is
of type nil.
Diffstat (limited to 'stdlib')
-rw-r--r-- | stdlib/compiler.tl | 12 |
1 files changed, 12 insertions, 0 deletions
diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl index 7e1770b8..c73be316 100644 --- a/stdlib/compiler.tl +++ b/stdlib/compiler.tl @@ -508,6 +508,7 @@ ;; function call ((+ *) me.(comp-arith-form oreg env form)) ((- /) me.(comp-arith-neg-form oreg env form)) + (typep me.(comp-typep oreg env form)) (t me.(comp-fun-form oreg env form)))) ((and (consp sym) (eq (car sym) 'lambda)) me.(compile oreg env ^(call ,*form))) @@ -1279,6 +1280,17 @@ (rlcp ^(,nop ,a1 ,sform) form)))) (else me.(comp-fun-form oreg env form)))) +(defmeth compiler comp-typep (me oreg env form) + (match-case form + ((typep @exp @(require @(constantp @type) + (eq t (safe-const-eval type)))) + me.(compile oreg env ^(progn ,exp t))) + ((typep @exp @(require @(constantp @type) + (null (safe-const-eval type)))) + me.(compile oreg env ^(progn ,exp nil))) + (@else + me.(comp-fun-form oreg env form)))) + (defmeth compiler comp-fun-form (me oreg env form) (let* ((olev *opt-level*) (sym (car form)) |