change get-info to use a separate namespace; add make-eval-factory and make-base-eval-factory
svn: r15205
This commit is contained in:
parent
3991270029
commit
c25ca25320
|
@ -6,6 +6,7 @@
|
||||||
"decode.ss"
|
"decode.ss"
|
||||||
scheme/file
|
scheme/file
|
||||||
scheme/sandbox
|
scheme/sandbox
|
||||||
|
scheme/promise
|
||||||
mzlib/string
|
mzlib/string
|
||||||
(for-syntax scheme/base))
|
(for-syntax scheme/base))
|
||||||
|
|
||||||
|
@ -23,6 +24,8 @@
|
||||||
as-examples
|
as-examples
|
||||||
|
|
||||||
make-base-eval
|
make-base-eval
|
||||||
|
make-base-eval-factory
|
||||||
|
make-eval-factory
|
||||||
close-eval
|
close-eval
|
||||||
|
|
||||||
scribble-eval-handler)
|
scribble-eval-handler)
|
||||||
|
@ -240,7 +243,37 @@
|
||||||
(parameterize ([sandbox-output 'string]
|
(parameterize ([sandbox-output 'string]
|
||||||
[sandbox-error-output 'string]
|
[sandbox-error-output 'string]
|
||||||
[sandbox-propagate-breaks #f])
|
[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)
|
(define (close-eval e)
|
||||||
(kill-evaluator e)
|
(kill-evaluator e)
|
||||||
|
|
|
@ -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[make-evaluator] or @scheme[make-module-evaluator] with the
|
||||||
@scheme[sandbox-output] and @scheme[sandbox-error-output] parameters
|
@scheme[sandbox-output] and @scheme[sandbox-error-output] parameters
|
||||||
set to @scheme['string]. If @scheme[eval] is not provided, an
|
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
|
Uses of @scheme[code:comment] and @schemeidfont{code:blank} are
|
||||||
stipped from each @scheme[datum] before evaluation.
|
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.}
|
@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 "")]{
|
@defproc[(close-eval [eval (any/c . -> . any)]) (one-of/c "")]{
|
||||||
|
|
||||||
Shuts down an evaluator produced by @scheme[make-base-eval]. Use
|
Shuts down an evaluator produced by @scheme[make-base-eval]. Use
|
||||||
|
|
|
@ -54,9 +54,21 @@
|
||||||
;; that is required).
|
;; that is required).
|
||||||
;; We are, however, trusting that the bytecode form of the
|
;; We are, however, trusting that the bytecode form of the
|
||||||
;; file (if any) matches the source.
|
;; 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")])))
|
[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))
|
;; directory-record = (make-directory-record nat nat key path (listof symbol))
|
||||||
;; eg: (make-directory-record 1 0 '(lib "mzlib") #"mzlib" '(name))
|
;; eg: (make-directory-record 1 0 '(lib "mzlib") #"mzlib" '(name))
|
||||||
(define-struct directory-record (maj min spec path syms))
|
(define-struct directory-record (maj min spec path syms))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user