diff options
Diffstat (limited to 'module/language/tree-il/compile-cps.scm')
-rw-r--r-- | module/language/tree-il/compile-cps.scm | 31 |
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. |