compile lexical variable access and closure creation to the new ops

* module/language/glil.scm (<glil>): New GLIL type, <glil-lexical>,
  which will subsume other lexical types.
* module/language/glil/compile-assembly.scm: Compile <glil-lexical>.
  (make-open-binding): Change the interpretation of the second argument
  -- instead of indicating an "external" var, it now indicates a boxed
  var.
  (open-binding): Adapt to new glil-bind format.
* module/language/tree-il/analyze.scm: Add a lot more docs.
  (analyze-lexicals): Change the allocation algorithm and output format
  to allow the tree-il->glil compiler to capture free variables
  appropriately and to reference bound variables in boxes if necessary.
  Amply documented.

* module/language/tree-il/compile-glil.scm (compile-glil): Compile
  lexical variable access to <glil-lexical>. Emit variable capture and
  closure creation code here, instead of leaving that task to the
  GLIL->assembly compiler.

* test-suite/tests/tree-il.test: Update expected code emission.

1 files changed, 39 insertions, 37 deletions

diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index ec410b52b..21efa8e31 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -129,45 +129,45 @@
   (assert-tree-il->glil
    (let (x) (y) ((const 1)) (lexical x y))
    (program 0 0 1 0 ()
-            (const 1) (bind (x local 0)) (local set 0)
-            (local ref 0) (call return 1)
+            (const 1) (bind (x #f 0)) (lexical #t #f set 0)
+            (lexical #t #f ref 0) (call return 1)
             (unbind)))
 
   (assert-tree-il->glil
    (let (x) (y) ((const 1)) (begin (lexical x y) (const #f)))
    (program 0 0 1 0 ()
-            (const 1) (bind (x local 0)) (local set 0)
+            (const 1) (bind (x #f 0)) (lexical #t #f set 0)
             (const #f) (call return 1)
             (unbind)))
 
   (assert-tree-il->glil
    (let (x) (y) ((const 1)) (apply (primitive null?) (lexical x y)))
    (program 0 0 1 0 ()
-            (const 1) (bind (x local 0)) (local set 0)
-            (local ref 0) (call null? 1) (call return 1)
+            (const 1) (bind (x #f 0)) (lexical #t #f set 0)
+            (lexical #t #f ref 0) (call null? 1) (call return 1)
             (unbind))))
 
 (with-test-prefix "lexical sets"
   (assert-tree-il->glil
    (let (x) (y) ((const 1)) (set! (lexical x y) (const 2)))
-   (program 0 0 0 1 ()
-            (const 1) (bind (x external 0)) (external set 0 0)
-            (const 2) (external set 0 0) (void) (call return 1)
+   (program 0 0 1 0 ()
+            (const 1) (bind (x #t 0)) (lexical #t #t box 0)
+            (const 2) (lexical #t #t set 0) (void) (call return 1)
             (unbind)))
 
   (assert-tree-il->glil
    (let (x) (y) ((const 1)) (begin (set! (lexical x y) (const 2)) (const #f)))
-   (program 0 0 0 1 ()
-            (const 1) (bind (x external 0)) (external set 0 0)
-            (const 2) (external set 0 0) (const #f) (call return 1)
+   (program 0 0 1 0 ()
+            (const 1) (bind (x #t 0)) (lexical #t #t box 0)
+            (const 2) (lexical #t #t set 0) (const #f) (call return 1)
             (unbind)))
 
   (assert-tree-il->glil
    (let (x) (y) ((const 1))
      (apply (primitive null?) (set! (lexical x y) (const 2))))
-   (program 0 0 0 1 ()
-            (const 1) (bind (x external 0)) (external set 0 0)
-            (const 2) (external set 0 0) (void) (call null? 1) (call return 1)
+   (program 0 0 1 0 ()
+            (const 1) (bind (x #t 0)) (lexical #t #t box 0)
+            (const 2) (lexical #t #t set 0) (void) (call null? 1) (call return 1)
             (unbind))))
 
 (with-test-prefix "module refs"
@@ -322,7 +322,7 @@
    (lambda (x) (y) () (const 2))
    (program 0 0 0 0 ()
             (program 1 0 0 0 ()
-                     (bind (x local 0))
+                     (bind (x #f 0))
                      (const 2) (call return 1))
             (call return 1)))
 
@@ -330,7 +330,7 @@
    (lambda (x x1) (y y1) () (const 2))
    (program 0 0 0 0 ()
             (program 2 0 0 0 ()
-                     (bind (x local 0) (x1 local 1))
+                     (bind (x #f 0) (x1 #f 1))
                      (const 2) (call return 1))
             (call return 1)))
 
@@ -338,7 +338,7 @@
    (lambda x y () (const 2))
    (program 0 0 0 0 ()
             (program 1 1 0 0 ()
-                     (bind (x local 0))
+                     (bind (x #f 0))
                      (const 2) (call return 1))
             (call return 1)))
 
@@ -346,7 +346,7 @@
    (lambda (x . x1) (y . y1) () (const 2))
    (program 0 0 0 0 ()
             (program 2 1 0 0 ()
-                     (bind (x local 0) (x1 local 1))
+                     (bind (x #f 0) (x1 #f 1))
                      (const 2) (call return 1))
             (call return 1)))
 
@@ -354,27 +354,29 @@
    (lambda (x . x1) (y . y1) () (lexical x y))
    (program 0 0 0 0 ()
             (program 2 1 0 0 ()
-                     (bind (x local 0) (x1 local 1))
-                     (local ref 0) (call return 1))
+                     (bind (x #f 0) (x1 #f 1))
+                     (lexical #t #f ref 0) (call return 1))
             (call return 1)))
 
   (assert-tree-il->glil
    (lambda (x . x1) (y . y1) () (lexical x1 y1))
    (program 0 0 0 0 ()
             (program 2 1 0 0 ()
-                     (bind (x local 0) (x1 local 1))
-                     (local ref 1) (call return 1))
+                     (bind (x #f 0) (x1 #f 1))
+                     (lexical #t #f ref 1) (call return 1))
             (call return 1)))
 
   (assert-tree-il->glil
    (lambda (x) (x1) () (lambda (y) (y1) () (lexical x x1)))
    (program 0 0 0 0 ()
-            (program 1 0 0 1 ()
-                     (bind (x external 0))
-                     (local ref 0) (external set 0 0)
+            (program 1 0 0 0 ()
+                     (bind (x #f 0))
                      (program 1 0 0 0 ()
-                              (bind (y local 0))
-                              (external ref 1 0) (call return 1))
+                              (bind (y #f 0))
+                              (lexical #f #f ref 0) (call return 1))
+                     (lexical #t #f ref 0)
+                     (call vector 1)
+                     (call make-closure2 2)
                      (call return 1))
             (call return 1))))
 
@@ -399,12 +401,12 @@
             (let (a) (b) ((const 2))
                  (lexical a b))))
    (program 0 0 1 0 ()
-            (const 1) (bind (x local 0)) (local set 0)
-            (local ref 0) (branch br-if-not ,l1)
-            (local ref 0) (call return 1)
+            (const 1) (bind (x #f 0)) (lexical #t #f set 0)
+            (lexical #t #f ref 0) (branch br-if-not ,l1)
+            (lexical #t #f ref 0) (call return 1)
             (label ,l2)
-            (const 2) (bind (a local 0)) (local set 0)
-            (local ref 0) (call return 1)
+            (const 2) (bind (a #f 0)) (lexical #t #f set 0)
+            (lexical #t #f ref 0) (call return 1)
             (unbind)
             (unbind))
    (eq? l1 l2))
@@ -416,12 +418,12 @@
             (let (a) (b) ((const 2))
                  (lexical x y))))
    (program 0 0 2 0 ()
-            (const 1) (bind (x local 0)) (local set 0)
-            (local ref 0) (branch br-if-not ,l1)
-            (local ref 0) (call return 1)
+            (const 1) (bind (x #f 0)) (lexical #t #f set 0)
+            (lexical #t #f ref 0) (branch br-if-not ,l1)
+            (lexical #t #f ref 0) (call return 1)
             (label ,l2)
-            (const 2) (bind (a local 1)) (local set 1)
-            (local ref 0) (call return 1)
+            (const 2) (bind (a #f 1)) (lexical #t #f set 1)
+            (lexical #t #f ref 0) (call return 1)
             (unbind)
             (unbind))
    (eq? l1 l2)))