The attached patch adds two optimization rules for certain uses of
##core#inline. It basically rewrites
(let ((<var> (##core#inline ...)))
(<kont> ... <var> ...))
into
(<kont> ... (##core##inline ...) ...)
plus a variation on this. Removing the intermediate "let" form gives
more opportunities to merge conditionals into ##core#cond forms,
which in turn may reduce intermediate CPS lambdas.
While investigating a problem with coops, I noticed that the slot-
lookup cache was quite suboptimal, caused by the above mentioned
CPS lambdas in a procedure that ought to be very tight, using only
low-level operations. Applying this change improved the code
quite a bit. Note that in general, binding intermediate values to
"let"-bound variables is important for optimizations, but for
##core#inline forms this can be relaxed since these inline ops
are in most cases not further analyzed by the optimizer (with the
exception of lfa2, which doesn't use the target variable of a binding).
There are quite a few hits of this rewrite in the core system, but, alas,
the results seem to be negligible. Mario was so kind to run the
benchmark suite on this, but the differences seem to be more the
usual fluctuation than any substantial gain or loss.
Benchmarking slot-lookup in coops with this patch gives some minor
improvement, but not a lot.
felix
From 41604a3f87290041f654728e76380d9a343e80db Mon Sep 17 00:00:00 2001
From: felix <fe...@call-with-current-continuation.org>
Date: Fri, 30 Aug 2019 10:09:22 +0200
Subject: [PATCH] Add some optimizer simplification rules
Certain combinations of conditionals and ##core#inline operations turns
out to reduce the opportunity for collapsing continuation lambdas,
specifically, constructs like
(if ...
(let ((<var> (##core#inline ...)))
(<kvar> (##core#inline ... <var> ...)))
(<kvar> ...))
could not be optimized into a simpler form
(<kvar> ... (##core#cond ...) ...)
and thus not be contracted.
This patch rewrites the given form (and a variation using
##core#call) into a nested ##core#inline expression, making
the contraction possible.
---
optimizer.scm | 74 ++++++++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 73 insertions(+), 1 deletion(-)
diff --git a/optimizer.scm b/optimizer.scm
index 8017ef19..5d80ad12 100644
--- a/optimizer.scm
+++ b/optimizer.scm
@@ -792,7 +792,79 @@
(make-node
'if d
(list (make-node '##core#inline (list op) args)
- x y) ) ) ) ) )
+ x y) ) ) ) )
+
+ ;; (let ((<var1> (##core#inline <op1> ...)))
+ ;; (<var2> (##core#inline <op2> ... <var1> ...)))
+ ;; -> (<var2> (##core#inline <op2> ... (##core#inline <op2> ...)
+ ;; ...))
+ ;; - <var1> is used only once.
+ `((let (var) (##core#inline (op1) . args1)
+ (##core#call p
+ (##core#variable (kvar))
+ (##core#inline (op2) . args2)))
+ (var op1 args1 p kvar op2 args2)
+ ,(lambda (db may-rewrite var op1 args1 p kvar op2 args2)
+ (and may-rewrite ; give other optimizations a chance first
+ (not (eq? var kvar))
+ (not (db-get db kvar 'contractable))
+ (= 1 (length (db-get-list db var 'references)))
+ (let loop ((args args2) (nargs '()) (ok #f))
+ (cond ((null? args)
+ (and ok
+ (make-node
+ '##core#call p
+ (list (varnode kvar)
+ (make-node
+ '##core#inline
+ (list op2)
+ (reverse nargs))))))
+ ((and (eq? '##core#variable
+ (node-class (car args)))
+ (eq? var
+ (car (node-parameters (car args)))))
+ (loop (cdr args)
+ (cons (make-node
+ '##core#inline
+ (list op1)
+ args1)
+ nargs)
+ #t))
+ (else (loop (cdr args)
+ (cons (car args) nargs)
+ ok)))))))
+
+ ;; (let ((<var1> (##core#inline <op> ...)))
+ ;; (<var2> ... <var1> ...))
+ ;; -> (<var2> ... (##core#inline <op> ...) ...)
+ ;; ...))
+ ;; - <var1> is used only once.
+ `((let (var) (##core#inline (op) . args1)
+ (##core#call p . args2))
+ (var op args1 p args2)
+ ,(lambda (db may-rewrite var op args1 p args2)
+ (and may-rewrite ; give other optimizations a chance first
+ (= 1 (length (db-get-list db var 'references)))
+ (let loop ((args args2) (nargs '()) (ok #f))
+ (cond ((null? args)
+ (and ok
+ (make-node
+ '##core#call p
+ (reverse nargs))))
+ ((and (eq? '##core#variable
+ (node-class (car args)))
+ (eq? var
+ (car (node-parameters (car args)))))
+ (loop (cdr args)
+ (cons (make-node
+ '##core#inline
+ (list op)
+ args1)
+ nargs)
+ #t))
+ (else (loop (cdr args)
+ (cons (car args) nargs)
+ ok))))))))
(register-simplifications
--
2.19.1
_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers
