[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-3-17-gf65
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-3-17-gf65e2b1 |
|
Date: |
Sun, 20 Sep 2009 20:31:51 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=f65e2b1ec5ae1962e57322ac3085ab4d44025694
The branch, master has been updated
via f65e2b1ec5ae1962e57322ac3085ab4d44025694 (commit)
via 60c6a7409501d55405834f12603a21042678ff8f (commit)
via 87c595c757b7db84ffdcfda96f736ab235e674a8 (commit)
from f5a51caec1bf1900b269da6e07fe466199372970 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit f65e2b1ec5ae1962e57322ac3085ab4d44025694
Author: Ludovic Courtès <address@hidden>
Date: Mon Aug 17 22:28:54 2009 +0200
Honor and confine expansion-time side-effects to `current-reader'.
* module/language/scheme/spec.scm (scheme)[#:reader]: Honor the
compilation environment's `current-reader'.
* module/system/base/compile.scm (*compilation-environment*): New
fluid.
(current-compilation-environment): New procedure.
(make-compilation-module): Provide a fresh `current-reader' fluid.
(read-and-compile): Set `*compilation-environment*' appropriately.
(compile): Likewise.
* test-suite/tests/compiler.test (read-and-compile): New.
("current-reader"): New test prefix.
commit 60c6a7409501d55405834f12603a21042678ff8f
Author: Ludovic Courtès <address@hidden>
Date: Sun Sep 20 22:29:28 2009 +0200
Fix copyright in `(srfi srfi-4 gnu)'.
commit 87c595c757b7db84ffdcfda96f736ab235e674a8
Author: Ludovic Courtès <address@hidden>
Date: Fri Aug 14 19:30:14 2009 +0200
Compile in a fresh module by default.
* module/system/base/compile.scm (make-compilation-module,
language-default-environment): New procedures.
(read-and-compile, compile): Have ENV default to
`(language-default-environment from)'.
(compile-and-load): Compile in `(current-module)'.
* module/system/repl/common.scm (repl-compile): Explicitly compile in
the current module so that macro definitions are visible.
* libguile/load.c (kw_env): New variable.
(do_try_autocompile): Call `compile-file' with `#:env (current-module)'.
* test-suite/tests/compiler.test ("psyntax")["compile uses a fresh module by
default", "compile-time definitions are isolated"]: New tests.
["compile in current module"]: Specify `#:env (current-module)'.
["redefinition"]: Adjust.
* test-suite/tests/bytevectors.test (c&e): Explicitly compile in the
current module so that its imports are visible.
-----------------------------------------------------------------------
Summary of changes:
libguile/load.c | 6 +++-
module/language/scheme/spec.scm | 16 ++++++++-
module/srfi/srfi-4/gnu.scm | 2 +-
module/system/base/compile.scm | 45 +++++++++++++++++++++++--
module/system/repl/common.scm | 5 ++-
test-suite/tests/bytevectors.test | 5 ++-
test-suite/tests/compiler.test | 66 +++++++++++++++++++++++++++++++-----
7 files changed, 124 insertions(+), 21 deletions(-)
diff --git a/libguile/load.c b/libguile/load.c
index 246cf89..10cbdb2 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -601,6 +601,8 @@ compiled_is_fresh (SCM full_filename, SCM compiled_filename)
return res;
}
+SCM_KEYWORD (kw_env, "env");
+
static SCM
do_try_autocompile (void *data)
{
@@ -617,7 +619,9 @@ do_try_autocompile (void *data)
if (scm_is_true (compile_file))
{
- SCM res = scm_call_1 (scm_variable_ref (compile_file), source);
+ /* Auto-compile in the context of the current module. */
+ SCM res = scm_call_3 (scm_variable_ref (compile_file), source,
+ kw_env, scm_current_module ());
scm_puts (";;; compiled ", scm_current_error_port ());
scm_display (res, scm_current_error_port ());
scm_newline (scm_current_error_port ());
diff --git a/module/language/scheme/spec.scm b/module/language/scheme/spec.scm
index df61858..f88537f 100644
--- a/module/language/scheme/spec.scm
+++ b/module/language/scheme/spec.scm
@@ -19,6 +19,7 @@
;;; Code:
(define-module (language scheme spec)
+ #:use-module (system base compile)
#:use-module (system base language)
#:use-module (language scheme compile-tree-il)
#:use-module (language scheme decompile-tree-il)
@@ -37,7 +38,20 @@
(define-language scheme
#:title "Guile Scheme"
#:version "0.5"
- #:reader read
+ #:reader (lambda args
+ ;; Read using the compilation environment's current reader.
+ ;; Don't use the current module's `current-reader' because
+ ;; it might be set, e.g., to the REPL's reader, so we'd
+ ;; enter an infinite recursion.
+ ;; FIXME: Handle `read-options' as well.
+ (let* ((mod (current-compilation-environment))
+ (cr (and (module? mod)
+ (module-ref mod 'current-reader)))
+ (read (if (and cr (fluid-ref cr))
+ (fluid-ref cr)
+ read)))
+ (apply read args)))
+
#:compilers `((tree-il . ,compile-tree-il))
#:decompilers `((tree-il . ,decompile-tree-il))
#:evaluator (lambda (x module) (primitive-eval x))
diff --git a/module/srfi/srfi-4/gnu.scm b/module/srfi/srfi-4/gnu.scm
index d3f73b3..c5c41ea 100644
--- a/module/srfi/srfi-4/gnu.scm
+++ b/module/srfi/srfi-4/gnu.scm
@@ -1,6 +1,6 @@
;;; Extensions to SRFI-4
-;; Copyright (C) 2001, 2002, 2004, 2006, 2009 Free Software Foundation,
Inc.
+;; Copyright (C) 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
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 26dd29e..d1cb3be 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -28,6 +28,7 @@
#:use-module (ice-9 receive)
#:export (syntax-error
*current-language*
+ current-compilation-environment
compiled-file-name compile-file compile-and-load
compile
decompile)
@@ -63,6 +64,12 @@
(define (current-language)
(fluid-ref *current-language*))
+(define *compilation-environment* (make-fluid))
+(define (current-compilation-environment)
+ "Return the current compilation environment (a module) or #f. This
+function should only be called from stages in the compiler tower."
+ (fluid-ref *compilation-environment*))
+
(define (call-once thunk)
(let ((entered #f))
(dynamic-wind
@@ -161,7 +168,8 @@
(define* (compile-and-load file #:key (from 'scheme) (to 'value) (opts '()))
(read-and-compile (open-input-file file)
- #:from from #:to to #:opts opts))
+ #:from from #:to to #:opts opts
+ #:env (current-module)))
;;;
@@ -190,6 +198,29 @@
(else
(lp (cdr in) (caar in))))))
+(define (make-compilation-module)
+ "Return a fresh module to be used as the compilation environment."
+
+ ;; 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-module)))
+ (beautify-user-module! m)
+
+ ;; Provide a separate `current-reader' fluid so that the Scheme language
+ ;; reader doesn't get to see the REPL's settings for `current-reader',
+ ;; which would lead to an infinite loop.
+ (module-define! m 'current-reader (make-fluid))
+
+ m))
+
+(define (language-default-environment lang)
+ "Return the default compilation environment for source language LANG."
+ (if (or (eq? lang 'scheme)
+ (eq? lang (lookup-language 'scheme)))
+ (make-compilation-module)
+ #f))
+
(define* (read-and-compile port #:key
(env #f)
(from (current-language))
@@ -198,8 +229,12 @@
(let ((from (ensure-language from))
(to (ensure-language to)))
(let ((joint (find-language-joint from to)))
- (with-fluids ((*current-language* from))
- (let lp ((exps '()) (env #f) (cenv env))
+ (with-fluids ((*current-language* from)
+ (*compilation-environment*
+ (or env
+ (language-default-environment from))))
+ (let lp ((exps '()) (env #f)
+ (cenv (fluid-ref *compilation-environment*)))
(let ((x ((language-reader (current-language)) port)))
(cond
((eof-object? x)
@@ -228,7 +263,9 @@
warnings))))
(receive (exp env cenv)
- (compile-fold (compile-passes from to opts) x env opts)
+ (let ((env (or env (language-default-environment from))))
+ (with-fluids ((*compilation-environment* env))
+ (compile-fold (compile-passes from to opts) x env opts)))
exp))
diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm
index 2db4518..c9106e1 100644
--- a/module/system/repl/common.scm
+++ b/module/system/repl/common.scm
@@ -1,6 +1,6 @@
;;; Repl common routines
-;; Copyright (C) 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2008, 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
@@ -68,7 +68,8 @@
((memq #:t opts) 'ghil)
((memq #:c opts) 'glil)
(else 'objcode)))))
- (compile form #:from (repl-language repl) #:to to #:opts opts)))
+ (compile form #:from (repl-language repl) #:to to #:opts opts
+ #:env (current-module))))
(define (repl-parse repl form)
(let ((parser (language-parser (repl-language repl))))
diff --git a/test-suite/tests/bytevectors.test
b/test-suite/tests/bytevectors.test
index 1009fb0..26d7cf6 100644
--- a/test-suite/tests/bytevectors.test
+++ b/test-suite/tests/bytevectors.test
@@ -31,12 +31,13 @@
(begin (pass-if (string-append test-name " (eval)")
(primitive-eval 'exp))
(pass-if (string-append test-name " (compile)")
- (compile 'exp #:to 'value))))
+ (compile 'exp #:to 'value #:env (current-module)))))
((_ (pass-if-exception test-name exc exp))
(begin (pass-if-exception (string-append test-name " (eval)")
exc (primitive-eval 'exp))
(pass-if-exception (string-append test-name " (compile)")
- exc (compile 'exp #:to 'value))))))
+ exc (compile 'exp #:to 'value
+ #:env (current-module)))))))
(define-syntax with-test-prefix/c&e
(syntax-rules ()
diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test
index f9fabd7..ed6f033 100644
--- a/test-suite/tests/compiler.test
+++ b/test-suite/tests/compiler.test
@@ -18,7 +18,11 @@
(define-module (test-suite tests compiler)
:use-module (test-suite lib)
:use-module (test-suite guile-test)
- :use-module (system base compile))
+ :use-module (system base compile)
+ :use-module ((system vm vm) #:select (the-vm vm-load)))
+
+(define read-and-compile
+ (@@ (system base compile) read-and-compile))
@@ -30,18 +34,23 @@
(with-test-prefix "psyntax"
- (pass-if "redefinition"
- ;; In this case the locally-bound `round' must have the same value as the
- ;; imported `round'. See the same test in `syntax.test' for details.
+ (pass-if "compile uses a fresh module by default"
(begin
- (compile '(define round round))
- (compile '(eq? round (@@ (guile) round)))))
+ (compile '(define + -))
+ (eq? (compile '+) +)))
+
+ (pass-if "compile-time definitions are isolated"
+ (begin
+ (compile '(define foo-bar #t))
+ (not (module-variable (current-module) 'foo-bar))))
(pass-if "compile in current module"
(let ((o (begin
- (compile '(define-macro (foo) 'bar))
- (compile '(let ((bar 'ok)) (foo))))))
- (and (module-ref (current-module) 'foo)
+ (compile '(define-macro (foo) 'bar)
+ #:env (current-module))
+ (compile '(let ((bar 'ok)) (foo))
+ #:env (current-module)))))
+ (and (macro? (module-ref (current-module) 'foo))
(eq? o 'ok))))
(pass-if "compile in fresh module"
@@ -52,4 +61,41 @@
(compile '(define-macro (foo) 'bar) #:env m)
(compile '(let ((bar 'ok)) (foo)) #:env m))))
(and (module-ref m 'foo)
- (eq? o 'ok)))))
+ (eq? o 'ok))))
+
+ (pass-if "redefinition"
+ ;; In this case the locally-bound `round' must have the same value as the
+ ;; imported `round'. See the same test in `syntax.test' for details.
+ (let ((m (make-module)))
+ (beautify-user-module! m)
+ (compile '(define round round) #:env m)
+ (eq? round (module-ref m 'round)))))
+
+
+(with-test-prefix "current-reader"
+
+ (pass-if "default compile-time current-reader differs"
+ (not (eq? (compile 'current-reader)
+ current-reader)))
+
+ (pass-if "compile-time changes are honored and isolated"
+ ;; Make sure changing `current-reader' as the side-effect of a defmacro
+ ;; actually works.
+ (let ((r (fluid-ref current-reader))
+ (input (open-input-string
+ "(define-macro (install-reader!)
+ ;;(format #t \"current-reader = ~A~%\" current-reader)
+ (fluid-set! current-reader
+ (let ((first? #t))
+ (lambda args
+ (if first?
+ (begin
+ (set! first? #f)
+ ''ok)
+ (read (open-input-string \"\"))))))
+ #f)
+ (install-reader!)
+ this-should-be-ignored")))
+ (and (eq? (vm-load (the-vm) (read-and-compile input))
+ 'ok)
+ (eq? r (fluid-ref current-reader))))))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-3-17-gf65e2b1,
Ludovic Courtès <=