summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2020-07-30 16:30:23 +0200
committerAndy Wingo <wingo@pobox.com>2020-07-30 16:30:23 +0200
commitf13b27a4cc6ea35e8595e7d926c5632eb797364a (patch)
tree06b9fc65d1f6ad1965ea04152aa4e214a7a7c8fd
parentaa44a71750aa6b06fd4974330f2c71523a63ecd9 (diff)
downloadguile-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.scm14
-rw-r--r--module/language/tree-il/compile-cps.scm19
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.