mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Baseline compiler emits eq-immediate? as appropriate

Browse source 
* module/language/tree-il/compile-bytecode.scm (eq?): Define
  eq-immediate? as immediate emitter.
  (canonicalize): Don't fuss so much about eq?; only if commutation is
  needed.  (Perhaps a more generic commutation pass is needed.)
  (compile-closure): Add support for emit/immediate for branches.
This commit is contained in:
Andy Wingo 2020-08-01 22:52:47 +02:00
parent daf3e88a81
commit 1ee99d97db
1 changed files with 30 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -295,7 +295,15 @@
(eq? #:nargs 2 #:predicate? #t #:emit (lambda (asm a b kf) (eq? #:nargs 2 #:predicate? #t #:emit (lambda (asm a b kf)
(emit-eq? asm a b) (emit-eq? asm a b)
(emit-jne asm kf))) (emit-jne asm kf))
#:immediate-in-range? (lambda (x)
(and=>
(scm->immediate-bits x)
(lambda (bits)
(truncate-bits bits 16 x))))
#:emit/immediate (lambda (asm a b kf)
(emit-eq-immediate? asm a b)
(emit-jne asm kf)))
(< #:nargs 2 #:predicate? #t #:emit (lambda (asm a b kf) (< #:nargs 2 #:predicate? #t #:emit (lambda (asm a b kf)
(emit-<? asm a b) (emit-<? asm a b)
(emit-jnl asm kf))) (emit-jnl asm kf)))
@ -422,19 +430,10 @@
(($ <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?. ;; For eq? on constants, make the second arg the constant.
(($ <primcall> src 'eq? (a b)) (($ <primcall> src 'eq? ((and a ($ <const>))
(let ((a (if (const? b) a b)) (and b (not ($ <const>)))))
(b (if (const? b) b a))) (reify-branch src 'eq? (list 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))
@ -873,14 +872,26 @@ in the frame with for the lambda-case clause @var{clause}."
(($ <conditional> src ($ <primcall> tsrc name args) (($ <conditional> src ($ <primcall> tsrc name args)
consequent alternate) consequent alternate)
(maybe-emit-source tsrc) (maybe-emit-source tsrc)
(let ((emit (primitive-emitter (lookup-primitive name))) (let ((prim (lookup-primitive name))
(args (for-args args env))
(kf (gensym "false")) (kf (gensym "false"))
(kdone (gensym "done"))) (kdone (gensym "done")))
(maybe-emit-source src) (define (emit/immediate? val)
(and=> (primitive-immediate-in-range-predicate prim)
(lambda (pred) (pred val))))
(match args (match args
((a) (emit asm a kf)) ((a ($ <const> _ (? emit/immediate? b)))
((a b) (emit asm a b kf))) (let ((emit (primitive-emitter/immediate prim)))
(match (for-args (list a) env)
((a)
(maybe-emit-source src)
(emit asm a b kf)))))
(_
(let ((emit (primitive-emitter prim))
(args (for-args args env)))
(maybe-emit-source src)
(match args
((a) (emit asm a kf))
((a b) (emit asm a b kf))))))
(for-context consequent env ctx) (for-context consequent env ctx)
(unless (eq? ctx 'tail) (unless (eq? ctx 'tail)
(emit-j asm kdone)) (emit-j asm kdone))