mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Improve code generation for eq? on immediates

Browse source 
* module/language/tree-il/compile-bytecode.scm (canonicalize):
* module/language/tree-il/compile-cps.scm (canonicalize): Specialize
  eq-false? and similar predicates.
This commit is contained in:
Andy Wingo 2020-07-30 16:30:23 +02:00
parent aa44a71750
commit f13b27a4cc
2 changed files with 33 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

14
module/language/tree-il/compile-bytecode.scm
View file

@ -422,6 +422,20 @@
(($ <primcall> src '>= (a b)) (reify-branch src '<= (list b a))) (($ <primcall> src '>= (a b)) (reify-branch src '<= (list b a)))
(($ <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". ;; Simplify "not".
(($ <primcall> src 'not (x)) (($ <primcall> src 'not (x))
(finish-conditional (finish-conditional

19
module/language/tree-il/compile-cps.scm
View file

@ -2365,6 +2365,25 @@ integer."
(make-const src #t) (make-const src #t)
(make-const src #f))) (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) (($ <primcall> src (? branching-primitive? name) args)
;; No need to reduce because test is not reducible: reifying ;; No need to reduce because test is not reducible: reifying
;; #t/#f is the right thing. ;; #t/#f is the right thing.