diff --git a/module/language/assembly/compile-bytecode.scm b/module/language/assembly/compile-bytecode.scm index 6e7e34efc..00a324c31 100644 --- 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 7d9b955a7..dff724a63 100644 --- 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 d4c2261a0..92d71ec16 100644 --- 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 c816b0e6c..863d2603b 100644 --- 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)) ;;; diff --git a/module/language/glil/spec.scm b/module/language/glil/spec.scm index 3e4e10c6a..dbe379e70 100644 --- 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 9ce8bf5e5..c60829974 100644 --- 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 587a173fe..f1816e18c 100644 --- 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))) @@ -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) '() '())))))))) ;;; diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm index 891902367..99c80b2fd 100644 --- 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)