~ chicken-core (chicken-5) 4b184cd1fc756210580077faac43fedf327611d1
commit 4b184cd1fc756210580077faac43fedf327611d1
Author: megane <meganeka@gmail.com>
AuthorDate: Sun Oct 13 18:16:32 2019 +0300
Commit: megane <meganeka@gmail.com>
CommitDate: Sun Oct 13 18:16:32 2019 +0300
Revert "Revert half of "Add some optimizer simplification rules""
This reverts commit d8727f4a9bdfded30813a5a433b57eddf60c068f.
diff --git a/optimizer.scm b/optimizer.scm
index 7d9d773c..fbf60bac 100644
--- a/optimizer.scm
+++ b/optimizer.scm
@@ -857,6 +857,38 @@
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))))))))
Trap