diff options
author | Andy Wingo <wingo@pobox.com> | 2020-05-11 14:48:45 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2020-05-11 14:48:45 +0200 |
commit | 7f4bbc3dba5e7fea1aa66aad246ba6d0a5674e18 (patch) | |
tree | feb60e7b24e7ff651a2b0ed53560de9e734b3e9d /module/language/tree-il/compile-bytecode.scm | |
parent | 35160ade03bea1c5bac54e2f5fa5591068e0a557 (diff) | |
download | guile-7f4bbc3dba5e7fea1aa66aad246ba6d0a5674e18.tar.gz |
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.
Diffstat (limited to 'module/language/tree-il/compile-bytecode.scm')
-rw-r--r-- | module/language/tree-il/compile-bytecode.scm | 18 |
1 files changed, 6 insertions, 12 deletions
diff --git a/module/language/tree-il/compile-bytecode.scm b/module/language/tree-il/compile-bytecode.scm index ac6ffba17..f5e0664e2 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) |