From c22d38f6d943ef0e925390dfd4f0b165fd0a693e Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 7 Feb 2024 22:36:37 -0800
Subject: compiler: implement inlining for chain expressions.

The opip syntax and its variants transforms into
chain expressions. Currently, we emit actual chain
function calls, and so all the chain arguments
that are lambda expressions have become closures.
In this commit, an inlining optimization is introduced
which turns some chain function calls into chained
expressions. The lambdas are then immediately called,
and so succumb to the lambda-eliminating optimization.

* stdlib/compiler.tl (compiler comp-fun-form): Handle
chain forms. At optimization level 6 or higher, if
the form is eligible for the transform, perform it.
(inline-chain-rec, can-inline-chain, inline-chain):
New functions.

* txr.1: Mention that *opt-level* 6 does this chain
optimization.
---
 stdlib/compiler.tl | 35 ++++++++++++++++++++++++++++++++++-
 txr.1              |  7 ++++++-
 2 files changed, 40 insertions(+), 2 deletions(-)

diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl
index 735b83d7..00dbd292 100644
--- a/stdlib/compiler.tl
+++ b/stdlib/compiler.tl
@@ -1423,7 +1423,12 @@
            (return-from comp-fun-form me.(compile oreg env
                                                   ^(progn ,*args nil))))
           ((@(or identity use + * min max logior logand) @a)
-           (return-from comp-fun-form me.(compile oreg env a)))))
+           (return-from comp-fun-form me.(compile oreg env a)))
+          (@(require (chain . @nil)
+                     (> olev 5)
+                     (can-inline-chain form))
+           (return-from comp-fun-form me.(compile oreg env
+                                                  (inline-chain form))))))
 
       (when (plusp olev)
         (tree-case form
@@ -2298,6 +2303,34 @@
                    ,*lm-body))
               lm-expr)))))
 
+(defun inline-chain-rec (form arg)
+  (match-ecase form
+    ((chain @fun)
+     ^(call ,fun ,arg))
+    ((chain @fun . @rest)
+     (inline-chain-rec ^(chain ,*rest) ^(call ,fun ,arg)))))
+
+(defun can-inline-chain (form)
+  (let (yes)
+    (each ((f (cdr form)))
+      (if-match @(or @(symbolp)
+                     (sys:lisp1-value @(symbolp))
+                     (lambda . @lam))
+                f
+        (if lam (set yes t))
+        (return-from can-inline-chain nil)))
+    yes))
+
+(defun inline-chain (form)
+  (match-case form
+    ((chain @fun) fun)
+    ((chain @fun . @rest)
+     (with-gensyms (args)
+       ^(lambda ,args
+          ,(inline-chain-rec ^(chain ,*rest)
+                             ^(apply ,fun ,args)))))
+    ((chain) form)))
+
 (defun orig-form (form)
   (whilet ((anc (macro-ancestor form)))
     (set form anc))
diff --git a/txr.1 b/txr.1
index d3bb4423..c6dfe829 100644
--- a/txr.1
+++ b/txr.1
@@ -90939,7 +90939,12 @@ More peephole optimizations are applied.
 .IP 6
 Additional iterations of the levels 4 and 5 optimizations are performed,
 if the previous iterations have coalesced some basic blocks of the program
-graph.
+graph. Also, at this level,
+.code chain
+expressions containing lambdas are inlined, eliminating the closures.
+These expressions arise out of
+.code opip
+syntax and its derivatives.
 .IP 7
 Certain more rarely applicable optimizations are applied which reduce code size
 by merging some identical code blocks, or improving some more rarely
-- 
cgit v1.2.3