compiler: lift functional expressions to load-time.

The idea behind this optimization is that certain expressions
that only calculate functions can be hoisted to load time.

These expressions meet these criteria:

1. Are not already in a top-level or load-time context.

2. Are function calls to a standard library
   functional operator like chain andf, orf, juxt, ...

3. Do not access any variables.

3. Do not access any functions other than public (usr package)
   global functions in the standard library.

An example of such an expression might be:

   [chain cdr [iff symbolp list]]

If such an expression is embedded in a function, we don't want
the function to re-calculate it every time, which requires
time and generates garbage. We can transform it to the
equivalent of:

   (load-time [chain cdr [iff symbolp list]])

to have it calculated once.

* share/txr/stdlib/compiler.tl (%functional-funs%,
%functional%): New global variables.
(compiler comp-fun-form): After compiling the function call,
check for the conditions for lifting. If so, compile the form
again as a load-time literal. The logic is similar to how
lambdas are lifted to load-time, though the conditions are

1 files changed, 17 insertions, 0 deletions

diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index d6ca1f45..5182fda0 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -294,6 +294,12 @@
 
 (defvarl %const-foldable% (hash-list %const-foldable-funs% :eq-based))
 
+(defvarl %functional-funs%
+  '(chain chand juxt andf orf notf iff iffi dup flipargs if or and
+    progn prog1 prog2 retf apf ipf callf mapf tf nilf))
+
+(defvarl %functional% (hash-list %functional-funs% :eq-based))
+
 (defvarl assumed-fun)
 
 (defvar *dedup*)
@@ -1252,6 +1258,17 @@
            (cfrag me.(comp-call-impl oreg env (if fbind 'call 'gcall)
                                      (if fbind fbind.loc me.(get-sidx sym))
                                      args)))
+      (when (and (not fbind)
+                 (not *load-time*)
+                 [%functional% sym])
+        (let ((ok-lift-var-pov (null cfrag.fvars))
+              (ok-lift-fun-pov (all cfrag.ffuns
+                                    (lambda (sym)
+                                      (and (not env.(lookup-fun sym))
+                                           (eq (symbol-package sym)
+                                               user-package))))))
+          (when (and ok-lift-var-pov ok-lift-fun-pov)
+            (set cfrag me.(compile oreg env ^(sys:load-time-lit nil ,form))))))
       (pushnew sym cfrag.ffuns)
       cfrag)))