summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-04-16 15:20:40 +0200
committerAndy Wingo <wingo@pobox.com>2009-04-16 15:20:40 +0200
commitb41b92c9d1c439ddfc5c081b3949e9d1763de181 (patch)
tree5b24839cf3c6ff8b69140f020b0f9499dbd28369
parent275baf01136895093570725fe55c4104725a9387 (diff)
downloadguile-b41b92c9d1c439ddfc5c081b3949e9d1763de181.tar.gz
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.
-rw-r--r--module/language/assembly/compile-bytecode.scm2
-rw-r--r--module/language/bytecode/spec.scm2
-rw-r--r--module/language/ecmascript/compile-ghil.scm1
-rw-r--r--module/language/ghil/compile-glil.scm3
-rw-r--r--module/language/glil/spec.scm2
-rw-r--r--module/language/objcode/spec.scm4
-rw-r--r--module/language/scheme/compile-ghil.scm15
-rw-r--r--module/system/base/compile.scm2
8 files changed, 19 insertions, 12 deletions
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)