compilation passes return third value: the continuation environment

* module/system/base/compile.scm: Expect compile passes to produce three
  values, not two. The third is the "continuation environment", the
  environment that can be used to compile a subsequent expression from
  the same source language. For example, expansion-time side effects can
  set the current module, which would be reflected appropriately in the
  continuation environment.

* module/language/assembly/compile-bytecode.scm:
* module/language/bytecode/spec.scm:
* module/language/ecmascript/compile-ghil.scm:
* module/language/ghil/compile-glil.scm:
* module/language/glil/spec.scm:
* module/language/objcode/spec.scm:
* module/language/scheme/compile-ghil.scm:
* module/system/base/compile.scm: Update compile passes to return a
  continuation environment.

diff --git a/module/language/assembly/compile-bytecode.scm b/module/language/assembly/compile-bytecode.scm
index 6e7e34e..00a324c 100644 (file)
--- a/module/language/assembly/compile-bytecode.scm
+++ b/module/language/assembly/compile-bytecode.scm
@@ -40,7 +40,7 @@
               (get-addr (lambda () i)))
        (write-bytecode assembly write-byte get-addr '())
        (if (= i (u8vector-length v))
-           (values v env)
+           (values v env env)
            (error "incorrect length in assembly" i (u8vector-length v)))))
     (else (error "bad assembly" assembly))))
 

diff --git a/module/language/bytecode/spec.scm b/module/language/bytecode/spec.scm
index 7d9b955..dff724a 100644 (file)
--- a/module/language/bytecode/spec.scm
+++ b/module/language/bytecode/spec.scm
@@ -25,7 +25,7 @@
   #:export (bytecode))
 
 (define (compile-objcode x e opts)
-  (values (bytecode->objcode x) e))
+  (values (bytecode->objcode x) e e))
 
 (define (decompile-objcode x e opts)
   (values (objcode->bytecode x) e))

diff --git a/module/language/ecmascript/compile-ghil.scm b/module/language/ecmascript/compile-ghil.scm
index d4c2261..92d71ec 100644 (file)
--- a/module/language/ecmascript/compile-ghil.scm
+++ b/module/language/ecmascript/compile-ghil.scm
@@ -41,6 +41,7 @@
          (-> (lambda vars #f '()
                      (-> (begin (list (@impl js-init '())
                                       (comp exp e)))))))))
+   env
    env))
 
 (define (location x)

diff --git a/module/language/ghil/compile-glil.scm b/module/language/ghil/compile-glil.scm
index c816b0e..863d260 100644 (file)
--- a/module/language/ghil/compile-glil.scm
+++ b/module/language/ghil/compile-glil.scm
@@ -29,7 +29,8 @@
 (define (compile-glil x e opts)
   (if (memq #:O opts) (set! x (optimize x)))
   (values (codegen x)
-          (and e (cons (car e) (cddr e)))))
+          (and e (cons (car e) (cddr e)))
+          e))
 
 \f
 ;;;

diff --git a/module/language/glil/spec.scm b/module/language/glil/spec.scm
index 3e4e10c..dbe379e 100644 (file)
--- a/module/language/glil/spec.scm
+++ b/module/language/glil/spec.scm
@@ -30,7 +30,7 @@
   (apply write (unparse-glil exp) port))
 
 (define (compile-asm x e opts)
-  (values (compile-assembly x) e))
+  (values (compile-assembly x) e e))
 
 (define-language glil
   #:title      "Guile Lowlevel Intermediate Language (GLIL)"

diff --git a/module/language/objcode/spec.scm b/module/language/objcode/spec.scm
index 9ce8bf5..c608299 100644 (file)
--- a/module/language/objcode/spec.scm
+++ b/module/language/objcode/spec.scm
@@ -40,8 +40,8 @@
         (save-module-excursion
          (lambda ()
            (set-current-module (objcode-env-module e))
-           (values (thunk) #f)))
-        (values (thunk) #f))))
+           (values (thunk) #f e)))
+        (values (thunk) #f e))))
 
 ;; since locals are allocated on the stack and can have limited scope,
 ;; in many cases we use one local for more than one lexical variable. so

diff --git a/module/language/scheme/compile-ghil.scm b/module/language/scheme/compile-ghil.scm
index 587a173..f1816e1 100644 (file)
--- a/module/language/scheme/compile-ghil.scm
+++ b/module/language/scheme/compile-ghil.scm
@@ -56,6 +56,8 @@
         ((pair? env) (cddr env))
         (else (error "bad environment" env))))
 
+(define (make-cenv module lexicals externals)
+  (cons module (cons lexicals externals)))
 
 \f
 
@@ -65,11 +67,14 @@
      (and=> (cenv-module e) set-current-module)
      (call-with-ghil-environment (cenv-ghil-env e) '()
        (lambda (env vars)
-         (values (make-ghil-lambda env #f vars #f '() (translate-1 env #f x))
-                 (and e
-                      (cons* (cenv-module e)
-                             (ghil-env-parent env)
-                             (cenv-externals e)))))))))
+         (let ((x (make-ghil-lambda env #f vars #f '()
+                                    (translate-1 env #f x))))
+           (values x
+                   (and e
+                        (cons* (cenv-module e)
+                               (ghil-env-parent env)
+                               (cenv-externals e)))
+                   (make-cenv (current-module) '() '()))))))))
 
 \f
 ;;;

diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 8919023..99c80b2 100644 (file)
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -157,7 +157,7 @@
 (define (compile-fold passes exp env opts)
   (if (null? passes)
       exp
-      (receive (exp env) ((car passes) exp env opts)
+      (receive (exp env cenv) ((car passes) exp env opts)
         (compile-fold (cdr passes) exp env opts))))
 
 (define (compile-time-environment)