From c25ca2532010cdc5c413898a9a6e94905f710516 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 18 Jun 2009 10:35:13 +0000
Subject: [PATCH] change get-info to use a separate namespace; add
 make-eval-factory and make-base-eval-factory

svn: r15205
---
 collects/scribble/eval.ss                | 35 +++++++++++++++++++++++-
 collects/scribblings/scribble/eval.scrbl | 18 +++++++++++-
 collects/setup/getinfo.ss                | 14 +++++++++-
 3 files changed, 64 insertions(+), 3 deletions(-)

diff --git a/collects/scribble/eval.ss b/collects/scribble/eval.ss
index ad7df373da..eb5786db77 100644
--- a/collects/scribble/eval.ss
+++ b/collects/scribble/eval.ss
@@ -6,6 +6,7 @@
            "decode.ss"
            scheme/file
            scheme/sandbox
+           scheme/promise
            mzlib/string
            (for-syntax scheme/base))
 
@@ -23,6 +24,8 @@
            as-examples
            
            make-base-eval
+           make-base-eval-factory
+           make-eval-factory
            close-eval
 
            scribble-eval-handler)
@@ -240,7 +243,37 @@
        (parameterize ([sandbox-output 'string]
                       [sandbox-error-output 'string]
                       [sandbox-propagate-breaks #f])
-         (make-evaluator '(begin (require scheme/base)))))))
+         (make-evaluator '(begin))))))
+
+  (define (make-base-eval-factory mod-paths)
+    (let ([ns (delay (let ([ns (make-base-empty-namespace)])
+                       (parameterize ([current-namespace ns])
+                         (for-each
+                          (lambda (mod-path)
+                            (dynamic-require mod-path #f))
+                          mod-paths))
+                       ns))])
+      (lambda ()
+        (let ([ev (make-base-eval)]
+              [ns (force ns)])
+          ((scribble-eval-handler) 
+           ev #f
+           `(,(lambda ()
+                (for-each (lambda (mod-path) 
+                            (namespace-attach-module ns mod-path))
+                          mod-paths))))
+          ev))))
+
+  (define (make-eval-factory mod-paths)
+    (let ([base-factory (make-base-eval-factory mod-paths)])
+      (lambda ()
+        (let ([ev (base-factory)])
+          ((scribble-eval-handler) 
+           ev #f
+           `(,(lambda ()
+                (for-each (lambda (mod-path) (namespace-require mod-path))
+                          mod-paths))))
+          ev))))
 
   (define (close-eval e)
     (kill-evaluator e)
diff --git a/collects/scribblings/scribble/eval.scrbl b/collects/scribblings/scribble/eval.scrbl
index c0a55a42af..ab93e2af00 100644
--- a/collects/scribblings/scribble/eval.scrbl
+++ b/collects/scribblings/scribble/eval.scrbl
@@ -22,7 +22,8 @@ The @scheme[eval-expr] must produce a sandbox evaluator via
 @scheme[make-evaluator] or @scheme[make-module-evaluator] with the
 @scheme[sandbox-output] and @scheme[sandbox-error-output] parameters
 set to @scheme['string]. If @scheme[eval] is not provided, an
-evaluator is created using @scheme[make-base-eval].
+evaluator is created using @scheme[make-base-eval]. See also
+@scheme[make-eval-factory].
 
 Uses of @scheme[code:comment] and @schemeidfont{code:blank} are
 stipped from each @scheme[datum] before evaluation.
@@ -93,6 +94,21 @@ setting sandbox parameters to disable limits, set the outputs to
 @scheme['string], and not add extra security guards.}
 
 
+@defproc[(make-base-eval-factory [mod-paths (listof module-path?)]) (-> (any/c . -> . any))]{
+
+Produces a function that is like @scheme[make-base-eval], except that
+each module in @scheme[mod-paths] is attached to the evaluator's
+namespace. The modules are loaded and instantiated once (when the
+returned @scheme[make-base-eval]-like function is called the first
+time) and then attached to each evaluator that is created.}
+
+
+@defproc[(make-eval-factory [mod-paths (listof module-path?)]) (-> (any/c . -> . any))]{
+
+Like @scheme[make-base-eval-factor], but each module in @scheme[mod-paths] is
+also required into the top-level environment for each generated evaluator.}
+
+
 @defproc[(close-eval [eval (any/c . -> . any)]) (one-of/c "")]{
 
 Shuts down an evaluator produced by @scheme[make-base-eval]. Use
diff --git a/collects/setup/getinfo.ss b/collects/setup/getinfo.ss
index 8a47711556..87cd94b208 100644
--- a/collects/setup/getinfo.ss
+++ b/collects/setup/getinfo.ss
@@ -54,9 +54,21 @@
           ;; that is required).
           ;; We are, however, trusting that the bytecode form of the
           ;; file (if any) matches the source.
-          (dynamic-require file '#%info-lookup)]
+          (parameterize ([current-namespace (info-namespace)])
+            (dynamic-require file '#%info-lookup))]
          [else (err "does not contain a module of the right shape")])))
 
+(define info-namespace
+  ;; To avoid loading modules into the current namespace
+  ;; when get-info is called, load info modules in a separate
+  ;; namespace.
+  (let ([ns-box (make-weak-box #f)])
+    (lambda ()
+      (or (weak-box-value ns-box)
+          (let ([ns (make-base-empty-namespace)])
+            (set! ns-box (make-weak-box ns))
+            ns)))))
+
 ;; directory-record = (make-directory-record nat nat key path (listof symbol))
 ;; eg: (make-directory-record 1 0 '(lib "mzlib") #"mzlib" '(name))
 (define-struct directory-record (maj min spec path syms))