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.

1 files changed, 34 insertions, 1 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))