[Guile-commits] 08/09: Improve tail recursion in compiler

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 7f4bbc3dba5e7fea1aa66aad246ba6d0a5674e18
Author: Andy Wingo <address@hidden>
AuthorDate: Mon May 11 14:48:45 2020 +0200

    Improve tail recursion in compiler
    
    * module/language/tree-il/compile-bytecode.scm (compile-closure): Make
      it so that for-tail is actually tail-recursive.  Likewise improve tail
      recursion for the other helpers.
---
 module/language/tree-il/compile-bytecode.scm | 18 ++++++------------
 1 file changed, 6 insertions(+), 12 deletions(-)

diff --git a/module/language/tree-il/compile-bytecode.scm 
b/module/language/tree-il/compile-bytecode.scm
index ac6ffba..f5e0664 100644
--- a/module/language/tree-il/compile-bytecode.scm
+++ b/module/language/tree-il/compile-bytecode.scm
@@ -1023,9 +1023,7 @@ in the frame with for the lambda-case clause 
@var{clause}."
         (($ <seq>)          (visit-seq exp env 'effect))
         (($ <let>)          (visit-let exp env 'effect))
         (($ <fix>)          (visit-fix exp env 'effect))
-        (($ <let-values>)   (visit-let-values exp env 'effect)))
-
-      (values))
+        (($ <let-values>)   (visit-let-values exp env 'effect))))
 
     (define (for-value-at exp env base)
       ;; The baseline compiler follows a stack discipline: compiling
@@ -1182,8 +1180,7 @@ in the frame with for the lambda-case clause 
@var{clause}."
         (($ <seq>)          (visit-seq exp env `(value-at . ,base)))
         (($ <let>)          (visit-let exp env `(value-at . ,base)))
         (($ <fix>)          (visit-fix exp env `(value-at . ,base)))
-        (($ <let-values>)   (visit-let-values exp env `(value-at . ,base))))
-      dst-env)
+        (($ <let-values>)   (visit-let-values exp env `(value-at . ,base)))))
 
     (define (for-value exp env)
       (match (and (lexical-ref? exp)
@@ -1194,7 +1191,8 @@ in the frame with for the lambda-case clause 
@var{clause}."
          (for-push exp env))))
 
     (define (for-push exp env)
-      (for-value-at exp env env))
+      (for-value-at exp env env)
+      (push-temp env))
 
     (define (for-init sym init env)
       (match (lookup-lexical sym env)
@@ -1237,9 +1235,7 @@ in the frame with for the lambda-case clause 
@var{clause}."
         (($ <seq>)          (visit-seq exp env `(values-at . ,base)))
         (($ <let>)          (visit-let exp env `(values-at . ,base)))
         (($ <fix>)          (visit-fix exp env `(values-at . ,base)))
-        (($ <let-values>)   (visit-let-values exp env `(values-at . ,base))))
-
-      (values))
+        (($ <let-values>)   (visit-let-values exp env `(values-at . ,base)))))
 
     (define (for-values exp env)
       (for-values-at exp env env))
@@ -1274,9 +1270,7 @@ in the frame with for the lambda-case clause 
@var{clause}."
         (($ <seq>)          (visit-seq exp env 'tail))
         (($ <let>)          (visit-let exp env 'tail))
         (($ <fix>)          (visit-fix exp env 'tail))
-        (($ <let-values>)   (visit-let-values exp env 'tail)))
-
-      (values))
+        (($ <let-values>)   (visit-let-values exp env 'tail))))
 
     (match clause
       (($ <lambda-case> src req opt rest kw inits syms body alt)