From 799f765f3f1fe18901636c124f1ae62df46f93a8 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sun, 3 May 2020 11:52:21 -0700
Subject: compiler: implement lambda lifting.

This is what the recent load-time changes were grooming the
compiler toward. When we compile a lambda, we can look at the
function and variable refernces it is making. If the lambda
makes no lexical function or variable references, we can lift
that lambda into load time, so that it's instantiated once and
then re-used out of a D register.  Effectively, it becomes a
top-level function.

* share/txr/stdlib/compiler.tl (compiler comp-lambda-impl):
New method, formed by renaming comp-lambda.
(compiler comp-lambda): Turned not wrapper for comp-lambda
impl which compiles the lambda, and checks for the conditions
for hoisting it into load time, which is currently done by
generating the sys:load-time-lit form around it and re-compiling.
---
 share/txr/stdlib/compiler.tl | 16 +++++++++++++++-
 1 file changed, 15 insertions(+), 1 deletion(-)

(limited to 'share')

diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index 8b8baa20..4d776296 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -815,7 +815,7 @@
                    (uni (diff bfrag.ffuns lexfuns)
                         (if rec (diff ffuns lexfuns) ffuns))))))))
 
-(defmeth compiler comp-lambda (me oreg env form)
+(defmeth compiler comp-lambda-impl (me oreg env form)
   (mac-param-bind form (op par-syntax . body) form
     (let* ((*load-time* nil)
            (pars (new (fun-param-parser par-syntax form)))
@@ -913,6 +913,20 @@
                        (uni [reduce-left uni ifrags nil .ffuns]
                             bfrag.ffuns)))))))))
 
+(defmeth compiler comp-lambda (me oreg env form)
+  (if *load-time*
+    me.(comp-lambda-impl oreg env form)
+    (let* ((lambda-frag me.(comp-lambda-impl oreg env form))
+           (ok-lift-var-pov (all lambda-frag.fvars
+                                 (lambda (sym)
+                                   (not env.(lookup-var sym)))))
+           (ok-lift-fun-pov (all lambda-frag.ffuns
+                                 (lambda (sym)
+                                   (not env.(lookup-fun sym))))))
+      (if (and ok-lift-var-pov ok-lift-fun-pov)
+        me.(compile oreg env ^(sys:load-time-lit nil ,form))
+        lambda-frag))))
+
 (defmeth compiler comp-fun (me oreg env form)
   (mac-param-bind form (op arg) form
     (let ((fbin env.(lookup-fun arg t)))
-- 
cgit v1.2.3