[Guile-commits] 05/06: Baseline O(1) access to frame-base env

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit f66111a2033ec714688a830a802fb9ae7d0d4d10
Author: Andy Wingo <address@hidden>
AuthorDate: Mon May 11 16:43:08 2020 +0200

    Baseline O(1) access to frame-base env
    
    * module/language/tree-il/compile-bytecode.scm (compile-closure): No
      need to search for frame-base.
---
 module/language/tree-il/compile-bytecode.scm | 25 ++++++++++---------------
 1 file changed, 10 insertions(+), 15 deletions(-)

diff --git a/module/language/tree-il/compile-bytecode.scm 
b/module/language/tree-il/compile-bytecode.scm
index 70bdfed..680738e 100644
--- a/module/language/tree-il/compile-bytecode.scm
+++ b/module/language/tree-il/compile-bytecode.scm
@@ -752,26 +752,21 @@ in the frame with for the lambda-case clause 
@var{clause}."
            (lookup-lexical sym prev)))
       (_ (error "sym not found!" sym))))
 
-  (define (frame-base env)
-    (match env
-      (($ <env> _ 'frame-base #f)
-       env)
-      (($ <env> prev)
-       (frame-base prev))))
-
   (define (compile-body clause module-scope free-vars frame-size)
-    (define (push-free-var sym idx env)
-      (make-env env sym sym idx #t (assigned? sym) #f))
+    (define frame-base
+      (make-env #f 'frame-base #f #f #f #f (- frame-size 1)))
 
-    (define (push-closure env)
-      (push-local 'closure #f
-                  (make-env env 'frame-base #f #f #f #f (- frame-size 1))))
+    (define (push-free-var sym idx env)
+      (make-env env sym sym idx #t (assigned? sym) (env-next-local env)))
 
     (define (push-local name sym env)
       (let ((idx (env-next-local env)))
         (emit-definition asm name (- frame-size idx 1) 'scm)
         (make-env env name sym idx #f (assigned? sym) (1- idx))))
 
+    (define (push-closure env)
+      (push-local 'closure #f env))
+
     (define (push-local-alias name sym idx env)
       (make-env env name sym idx #f #f (env-next-local env)))
 
@@ -793,7 +788,7 @@ in the frame with for the lambda-case clause @var{clause}."
             ((sym . free)
              (lp (1+ idx) free
                  (push-free-var sym idx env))))))
-      (fold push-local (push-closure (push-free-vars #f)) names syms))
+      (fold push-local (push-closure (push-free-vars frame-base)) names syms))
 
     (define (stack-height env)
       (- frame-size (env-next-local env) 1))
@@ -850,7 +845,7 @@ in the frame with for the lambda-case clause @var{clause}."
              ('tail
               ;; Would be nice if we could invoke the body in true tail
               ;; context, but that's not how it currently is.
-              (for-values-at body env (frame-base env))
+              (for-values-at body env frame-base)
               (emit-unwind asm)
               (emit-handle-interrupts asm)
               (emit-return-values asm))
@@ -1254,7 +1249,7 @@ in the frame with for the lambda-case clause 
@var{clause}."
              ($ <module-set>)
              ($ <lambda>)
              ($ <primcall>))
-         (for-values-at exp env (frame-base env))
+         (for-values-at exp env frame-base)
          (emit-handle-interrupts asm)
          (emit-return-values asm))