diff options
Diffstat (limited to 'module/language/scheme')
-rw-r--r-- | module/language/scheme/compile-tree-il.scm | 35 | ||||
-rw-r--r-- | module/language/scheme/spec.scm | 17 |
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))) |