suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

emptied the namespace when executing a module

Browse Source 
svn: r9923
This commit is contained in:
Robby Findler 2008-05-21 17:43:14 +00:00
parent c5ef53525a
commit c5f4bc9e20
5 changed files with 579 additions and 561 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/drscheme/private/language.ss
View File

@ -567,7 +567,7 @@
(super-new)))
;; create-module-based-language-executable :
;; (is-a?/c area-container<%>) string module-spec module-spec sexp (union boolean? 'ask) boolean?
;; (is-a?/c area-container<%>) string (or #f module-spec) module-spec sexp (union boolean? 'ask) boolean?
;; -> void
(define (create-module-based-language-executable parent
program-filename
@ -890,11 +890,13 @@
(call-with-output-file bootstrap-tmp-filename
(λ (port)
(write `(let () ;; cannot use begin, since it gets flattened to top-level (and re-compiled!)
,@(if use-copy?
,@(if module-language-spec
(if use-copy?
(list
`(namespace-require/copy ',module-language-spec))
(list
`(namespace-require/constant ',module-language-spec)))
'())
,@(if transformer-module-language-spec
(list `(namespace-require `(for-syntax ,transformer-module-language-spec)))
(list))
@ -914,11 +916,16 @@
#:exists 'truncate #:mode 'text)))
(let* ([pre-to-be-embedded-module-specs0
(if (or (not transformer-module-language-spec)
(equal? module-language-spec transformer-module-language-spec))
(cond
[(and module-language-spec transformer-module-language-spec)
(if (equal? module-language-spec transformer-module-language-spec)
(list module-language-spec)
(list module-language-spec
transformer-module-language-spec))]
(list module-language-spec transformer-module-language-spec))]
[module-language-spec
(list module-language-spec)]
[transformer-module-language-spec
(list transformer-module-language-spec)]
[else '()])]
[pre-to-be-embedded-module-specs1
(if gui?
(cons '(lib "mred/mred.ss")
@ -969,7 +976,7 @@
gui?
use-copy?))))
;; create-module-based-distribution : ... -> void (see docs)
;; create-distribution-for-executable : ... -> void (see docs)
(define (create-distribution-for-executable distribution-filename
gui?
make-executable)
@ -1116,7 +1123,7 @@
(path->string executable-filename)
executable-filename))))
;; initialize-module-based-language : boolean module-spec module-spec ((-> void) -> void)
;; initialize-module-based-language : boolean (or #f module-spec) module-spec ((-> void) -> void)
(define (initialize-module-based-language use-copy?
module-spec
transformer-module-spec
@ -1127,9 +1134,10 @@
(λ (x)
(display (exn-message x))
(newline))])
(when module-spec
(if use-copy?
(namespace-require/copy module-spec)
(namespace-require/constant module-spec))
(namespace-require/constant module-spec)))
(when transformer-module-spec
(namespace-require `(for-syntax ,transformer-module-spec)))))))

3
collects/drscheme/private/launcher-bootstrap.ss
View File

@ -41,7 +41,8 @@
to-be-copied-module-names)
(namespace-set-variable-value! 'argv program-argv)
(current-command-line-arguments program-argv)
(namespace-require language-module-spec)
(when language-module-spec
(namespace-require language-module-spec))
(when use-require/copy?
(namespace-require/copy language-module-spec))
(when transformer-module-spec

39
collects/drscheme/private/module-language.ss
View File

@ -1,20 +1,20 @@
#lang scheme/base
(module module-language mzscheme
(provide module-language@)
(require mzlib/unit
mzlib/class
(provide module-language@)
(require scheme/unit
scheme/class
mred
compiler/embed
launcher
framework
string-constants
"drsig.ss"
mzlib/contract)
scheme/contract)
(define op (current-output-port))
(define (oprintf . args) (apply fprintf op args))
(define op (current-output-port))
(define (oprintf . args) (apply fprintf op args))
(define-unit module-language@
(define-unit module-language@
(import [prefix drscheme:language-configuration: drscheme:language-configuration/internal^]
[prefix drscheme:language: drscheme:language^]
[prefix drscheme:unit: drscheme:unit^]
@ -128,10 +128,10 @@
[get-require-module-name
(λ ()
;; "clearing out" the module-name via datum->syntax-object ensures
;; "clearing out" the module-name via datum->syntax ensures
;; that check syntax doesn't think the original module name
;; is being used in this require (so it doesn't get turned red)
(datum->syntax-object #'here (syntax-e module-name)))])
(datum->syntax #'here (syntax-e module-name)))])
(λ ()
(set! iteration-number (+ iteration-number 1))
(cond
@ -213,7 +213,7 @@
#f ;; verbose?
(list (list #f program-filename))
null
(parameterize ([current-namespace (make-namespace 'empty)])
(parameterize ([current-namespace (make-empty-namespace)])
(namespace-require 'mzscheme)
(compile
`(namespace-require '',(string->symbol (path->string short-program-name)))))
@ -223,7 +223,7 @@
executable-filename))))))))
(super-new
(module 'scheme/base)
(module #f)
(language-position (list "Module"))
(language-numbers (list -32768)))))
@ -414,14 +414,17 @@
;; is the fully path-expanded name with a directory prefix,
;; if the file has been saved
(define (transform-module filename stx)
(syntax-case stx (module)
(syntax-case* stx (module) (λ (x y) (eq? (syntax-e x) (syntax-e y)))
[(module name lang bodies ...)
(let ([v-name (syntax name)])
(when filename
(check-filename-matches filename
(syntax-object->datum (syntax name))
(syntax->datum (syntax name))
stx))
(values v-name stx))]
;; rewrite the module to use the scheme/base version of `module'
(values v-name
#`(#,(datum->syntax #'here 'module)
name lang bodies ...)))]
[else
(raise-syntax-error 'module-language
"only module expressions are allowed"
@ -433,12 +436,12 @@
(define (get-module-name-prefix path)
(and path
(let-values ([(base name dir)
(split-path (normal-case-path (simplify-path (expand-path path) #f)))])
(split-path (normal-case-path (simplify-path (expand-user-path path) #f)))])
(string->symbol (format ",~a" (bytes->string/latin-1 (path->bytes base)))))))
;; build-name : path -> symbol
(define (build-name pre-path)
(let ([path (normal-case-path (simplify-path (expand-path pre-path) #f))])
(let ([path (normal-case-path (simplify-path (expand-user-path pre-path) #f))])
(let-values ([(base name dir) (split-path path)])
(string->symbol (format ",~a"
(bytes->string/latin-1
@ -563,4 +566,4 @@
[else
(loop (+ pos 1))]))))
(super-new)))))
(super-new))))

3
collects/drscheme/tool-lib.ss
View File

@ -1198,7 +1198,8 @@ all of the names in the tools library, for use defining keybindings
@scheme[module-language-spec] and
@scheme[transformer-module-language-spec] specify the
settings of the initial namespace, both the transformer
portion and the regular portion.
portion and the regular portion. Both may be @scheme[#f]
to indicate there are no initial bindings.
The @scheme[init-code] argument is an s-expression representing
the code for a module. This module is expected to provide

5
collects/tests/drscheme/module-lang-test.ss
View File

@ -120,6 +120,11 @@
"x"
"2")
(make-test
"#lang scheme\n(eval 'cons)"
#f
". compile: bad syntax; reference to top-level identifier is not allowed, because no #%top syntax transformer is bound in: cons")
(make-test
(format "~s" `(module m (file ,(path->string (build-path this-dir "module-lang-test-tmp.ss"))) 1 2 3))
"1" ;; just make sure no errors.