summaryrefslogtreecommitdiff
path: root/module/language/scheme
diff options
context:
space:
mode:
Diffstat (limited to 'module/language/scheme')
-rw-r--r--module/language/scheme/compile-tree-il.scm35
-rw-r--r--module/language/scheme/spec.scm17
2 files changed, 14 insertions, 38 deletions
diff --git a/module/language/scheme/compile-tree-il.scm b/module/language/scheme/compile-tree-il.scm
index 4ac33d77e..5d01a2651 100644
--- a/module/language/scheme/compile-tree-il.scm
+++ b/module/language/scheme/compile-tree-il.scm
@@ -1,6 +1,6 @@
;;; Guile Scheme specification
-;; Copyright (C) 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -24,40 +24,11 @@
;;; environment := #f
;;; | MODULE
-;;; | COMPILE-ENV
-;;; compile-env := (MODULE LEXICALS . EXTERNALS)
-(define (cenv-module env)
- (cond ((not env) #f)
- ((module? env) env)
- ((and (pair? env) (module? (car env))) (car env))
- (else (error "bad environment" env))))
-
-(define (cenv-lexicals env)
- (cond ((not env) '())
- ((module? env) '())
- ((pair? env) (cadr env))
- (else (error "bad environment" env))))
-
-(define (cenv-externals env)
- (cond ((not env) '())
- ((module? env) '())
- ((pair? env) (cddr env))
- (else (error "bad environment" env))))
-
-(define (make-cenv module lexicals externals)
- (cons module (cons lexicals externals)))
-
-(define (location x)
- (and (pair? x)
- (let ((props (source-properties x)))
- (and (not (null? props))
- props))))
(define (compile-tree-il x e opts)
(save-module-excursion
(lambda ()
- (and=> (cenv-module e) set-current-module)
+ (set-current-module e)
(let* ((x (sc-expand x 'c '(compile load eval)))
- (cenv (make-cenv (current-module)
- (cenv-lexicals e) (cenv-externals e))))
+ (cenv (current-module)))
(values x cenv cenv)))))
diff --git a/module/language/scheme/spec.scm b/module/language/scheme/spec.scm
index c05236126..6cfbc422f 100644
--- a/module/language/scheme/spec.scm
+++ b/module/language/scheme/spec.scm
@@ -41,11 +41,7 @@
#:reader (lambda (port env)
;; Use the binding of current-reader from the environment.
;; FIXME: Handle `read-options' as well?
- ((or (and=> (and=> (module-variable
- (cond ((pair? env) (car env))
- (env)
- (else (current-module)))
- 'current-reader)
+ ((or (and=> (and=> (module-variable env 'current-reader)
variable-ref)
fluid-ref)
read)
@@ -55,4 +51,13 @@
#:decompilers `((tree-il . ,decompile-tree-il))
#:evaluator (lambda (x module) (primitive-eval x))
#:printer write
- )
+ #:make-default-environment
+ (lambda ()
+ ;; Ideally we'd duplicate the whole module hierarchy so that `set!',
+ ;; `fluid-set!', etc. don't have any effect in the current environment.
+ (let ((m (make-fresh-user-module)))
+ ;; Provide a separate `current-reader' fluid so that
+ ;; compile-time changes to `current-reader' are
+ ;; limited to the current compilation unit.
+ (module-define! m 'current-reader (make-fluid))
+ m)))