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.

diff --git a/libguile/load.c b/libguile/load.c
index 246cf89..10cbdb2 100644 (file)
--- 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/system/base/compile.scm b/module/system/base/compile.scm
index 26dd29e..ea1e3f2 100644 (file)
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -161,7 +161,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)))
 
 \f
 ;;;
@@ -190,6 +191,23 @@
           (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)
+    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))
@@ -199,7 +217,8 @@
         (to (ensure-language to)))
     (let ((joint (find-language-joint from to)))
       (with-fluids ((*current-language* from))
-        (let lp ((exps '()) (env #f) (cenv env))
+        (let lp ((exps '()) (env #f)
+                 (cenv (or env (language-default-environment from))))
           (let ((x ((language-reader (current-language)) port)))
             (cond
              ((eof-object? x)
@@ -228,7 +247,8 @@
                     warnings))))
 
   (receive (exp env cenv)
-      (compile-fold (compile-passes from to opts) x env opts)
+      (let ((env (or env (language-default-environment from))))
+        (compile-fold (compile-passes from to opts) x env opts))
     exp))
 
 \f

diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm
index 2db4518..c9106e1 100644 (file)
--- 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 (file)
--- 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..2eb0e78 100644 (file)
--- a/test-suite/tests/compiler.test
+++ b/test-suite/tests/compiler.test
@@ -30,18 +30,23 @@
 \f
 (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 + -))
+      (eq? (compile '+) +)))
+
+  (pass-if "compile-time definitions are isolated"
     (begin
-      (compile '(define round round))
-      (compile '(eq? round (@@ (guile) round)))))
+      (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 +57,12 @@
                  (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)))))