35 lines
1.2 KiB
Scheme
35 lines
1.2 KiB
Scheme
#lang scheme/base
|
|
(require (lib "list.ss"))
|
|
|
|
(define default-to-be-copied-module-specs
|
|
'(mzscheme
|
|
(lib "mred.ss" "mred")))
|
|
|
|
(define (make-make-servlet-namespace
|
|
#:to-be-copied-module-specs [to-be-copied-module-specs empty])
|
|
;; get the names of those modules.
|
|
(define (get-name spec)
|
|
(if (symbol? spec)
|
|
spec
|
|
(with-handlers ([exn? (lambda _ #f)])
|
|
((current-module-name-resolver) spec #f #f))))
|
|
(define to-be-copied-module-names
|
|
(map get-name
|
|
(append default-to-be-copied-module-specs
|
|
to-be-copied-module-specs)))
|
|
(lambda (#:additional-specs [additional-specs empty])
|
|
(define server-namespace (current-namespace))
|
|
(define new-namespace (make-base-empty-namespace))
|
|
(define additional-names (map get-name additional-specs))
|
|
(parameterize ([current-namespace new-namespace])
|
|
(namespace-require 'scheme/base)
|
|
(for-each (lambda (name)
|
|
(with-handlers ([exn? void])
|
|
(when name
|
|
(namespace-attach-module server-namespace name))))
|
|
(append to-be-copied-module-names
|
|
additional-names))
|
|
new-namespace)))
|
|
|
|
(provide
|
|
make-make-servlet-namespace) |