#lang scheme (require scheme/runtime-path) (define mzscheme-module-spec 'mzscheme) (define mred-module-spec 'mred) (define default-to-be-copied-module-specs (list mzscheme-module-spec mred-module-spec)) (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]) (define scheme/base-module-spec 'scheme/base) (namespace-require scheme/base-module-spec) (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))) (define make-servlet-namespace/c (->* () (#:additional-specs (listof module-path?)) namespace?)) (provide/contract [make-servlet-namespace/c contract?] [make-make-servlet-namespace (->* () (#:to-be-copied-module-specs (listof module-path?)) make-servlet-namespace/c)])