summaryrefslogtreecommitdiff
path: root/module/language/tree-il/compile-cps.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/language/tree-il/compile-cps.scm')
-rw-r--r--module/language/tree-il/compile-cps.scm31
1 files changed, 12 insertions, 19 deletions
diff --git a/module/language/tree-il/compile-cps.scm b/module/language/tree-il/compile-cps.scm
index 9484e84dc..f0c7de609 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -2107,6 +2107,18 @@
(($ <conditional> src test consequent alternate)
(define (convert-test cps test kt kf)
(match test
+ (($ <primcall> src 'eq? (a ($ <const> _ b)))
+ (convert-arg cps a
+ (lambda (cps a)
+ (with-cps cps
+ (build-term ($branch kf kt src 'eq-constant? b (a)))))))
+
+ (($ <primcall> src 'eq? (($ <const> _ a) b))
+ (convert-arg cps b
+ (lambda (cps b)
+ (with-cps cps
+ (build-term ($branch kf kt src 'eq-constant? a (b)))))))
+
(($ <primcall> src (? branching-primitive? name) args)
(convert-args cps args
(lambda (cps args)
@@ -2365,25 +2377,6 @@ 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.