diff options
author | Andy Wingo <wingo@pobox.com> | 2020-07-30 16:30:23 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2020-07-30 16:30:23 +0200 |
commit | f13b27a4cc6ea35e8595e7d926c5632eb797364a (patch) | |
tree | 06b9fc65d1f6ad1965ea04152aa4e214a7a7c8fd | |
parent | aa44a71750aa6b06fd4974330f2c71523a63ecd9 (diff) | |
download | guile-f13b27a4cc6ea35e8595e7d926c5632eb797364a.tar.gz |
Improve code generation for eq? on immediates
* module/language/tree-il/compile-bytecode.scm (canonicalize):
* module/language/tree-il/compile-cps.scm (canonicalize): Specialize
eq-false? and similar predicates.
-rw-r--r-- | module/language/tree-il/compile-bytecode.scm | 14 | ||||
-rw-r--r-- | module/language/tree-il/compile-cps.scm | 19 |
2 files changed, 33 insertions, 0 deletions
diff --git a/module/language/tree-il/compile-bytecode.scm b/module/language/tree-il/compile-bytecode.scm index b8d432f3c..59bed8d27 100644 --- a/module/language/tree-il/compile-bytecode.scm +++ b/module/language/tree-il/compile-bytecode.scm @@ -422,6 +422,20 @@ (($ <primcall> src '>= (a b)) (reify-branch src '<= (list b a))) (($ <primcall> src '> (a b)) (reify-branch src '< (list b a))) + ;; Specialize eq?. + (($ <primcall> src 'eq? (a b)) + (let ((a (if (const? b) a b)) + (b (if (const? b) b a))) + (define (simplify test) (reify-branch src test (list a))) + (match b + (($ <const> _ '()) (simplify 'eq-null?)) + (($ <const> _ #f) (simplify 'eq-false?)) + (($ <const> _ #t) (simplify 'eq-true?)) + (($ <const> _ #nil) (simplify 'eq-nil?)) + (($ <const> _ (? unspecified?)) (simplify 'unspecified?)) + (($ <const> _ (? eof-object?)) (simplify 'eof-object?)) + (_ (reify-branch src 'eq? (list a b)))))) + ;; Simplify "not". (($ <primcall> src 'not (x)) (finish-conditional diff --git a/module/language/tree-il/compile-cps.scm b/module/language/tree-il/compile-cps.scm index 334b4ce70..9484e84dc 100644 --- a/module/language/tree-il/compile-cps.scm +++ b/module/language/tree-il/compile-cps.scm @@ -2365,6 +2365,25 @@ integer." (make-const src #t) (make-const src #f))) + ;; Specialize eq?. + (($ <primcall> src 'eq? (a b)) + (define (reify-branch test args) + ;; No need to reduce as test is a branching primitive. + (make-conditional src (make-primcall src test args) + (make-const src #t) + (make-const src #f))) + (let ((a (if (const? b) a b)) + (b (if (const? b) b a))) + (define (simplify test) (reify-branch test (list a))) + (match b + (($ <const> _ '()) (simplify 'eq-null?)) + (($ <const> _ #f) (simplify 'eq-false?)) + (($ <const> _ #t) (simplify 'eq-true?)) + (($ <const> _ #nil) (simplify 'eq-nil?)) + (($ <const> _ (? unspecified?)) (simplify 'unspecified?)) + (($ <const> _ (? eof-object?)) (simplify 'eof-object?)) + (_ (reify-branch 'eq? (list a b)))))) + (($ <primcall> src (? branching-primitive? name) args) ;; No need to reduce because test is not reducible: reifying ;; #t/#f is the right thing. |