adjust DrScheme to run #lang-specified runtime configuration
svn: r18762
This commit is contained in:
parent
8b31b1b552
commit
8fbd16261f
|
@ -309,9 +309,24 @@
|
||||||
(parameterize ([current-namespace (current-namespace)])
|
(parameterize ([current-namespace (current-namespace)])
|
||||||
;; the prompt makes it continue after an error
|
;; the prompt makes it continue after an error
|
||||||
(call-with-continuation-prompt
|
(call-with-continuation-prompt
|
||||||
(λ () (with-stack-checkpoint (namespace-require modspec)))))
|
(λ () (with-stack-checkpoint
|
||||||
|
(begin
|
||||||
|
(*do-module-specified-configuration modspec)
|
||||||
|
(namespace-require modspec))))))
|
||||||
(current-namespace (module->namespace modspec))
|
(current-namespace (module->namespace modspec))
|
||||||
(check-interactive-language))
|
(check-interactive-language))
|
||||||
|
(define (*do-module-specified-configuration modspec)
|
||||||
|
(let ([info (module->language-info modspec #t)])
|
||||||
|
(when info
|
||||||
|
(let ([get-info
|
||||||
|
((dynamic-require (vector-ref info 0)
|
||||||
|
(vector-ref info 1))
|
||||||
|
(vector-ref info 2))])
|
||||||
|
(let ([config (get-info 'configure-runtime #f)])
|
||||||
|
(when config
|
||||||
|
((dynamic-require (vector-ref config 0)
|
||||||
|
(vector-ref config 1))
|
||||||
|
(vector-ref config 2))))))))
|
||||||
;; here's where they're all combined with the module expression
|
;; here's where they're all combined with the module expression
|
||||||
(expr-getter *pre module-expr *post))
|
(expr-getter *pre module-expr *post))
|
||||||
|
|
||||||
|
@ -350,6 +365,7 @@
|
||||||
#:mred? gui?
|
#:mred? gui?
|
||||||
#:verbose? #f ;; verbose?
|
#:verbose? #f ;; verbose?
|
||||||
#:modules (list (list #f program-filename))
|
#:modules (list (list #f program-filename))
|
||||||
|
#:configure-via-first-module? #t
|
||||||
#:literal-expression
|
#:literal-expression
|
||||||
(begin
|
(begin
|
||||||
(parameterize ([current-namespace (make-base-empty-namespace)])
|
(parameterize ([current-namespace (make-base-empty-namespace)])
|
||||||
|
|
|
@ -44,6 +44,8 @@
|
||||||
(define (add-test-coverage-init-code stx)
|
(define (add-test-coverage-init-code stx)
|
||||||
(syntax-case stx (#%plain-module-begin)
|
(syntax-case stx (#%plain-module-begin)
|
||||||
[(mod name init-import (#%plain-module-begin b1 b2 body ...))
|
[(mod name init-import (#%plain-module-begin b1 b2 body ...))
|
||||||
|
(copy-props
|
||||||
|
stx
|
||||||
#`(#,(namespace-module-identifier) name init-import
|
#`(#,(namespace-module-identifier) name init-import
|
||||||
#,(syntax-recertify
|
#,(syntax-recertify
|
||||||
#`(#%plain-module-begin
|
#`(#%plain-module-begin
|
||||||
|
@ -52,7 +54,7 @@
|
||||||
body ...)
|
body ...)
|
||||||
(list-ref (syntax->list stx) 3)
|
(list-ref (syntax->list stx) 3)
|
||||||
orig-inspector
|
orig-inspector
|
||||||
#f))]))
|
#f)))]))
|
||||||
|
|
||||||
(define (annotate-covered-file filename-path [display-string #f])
|
(define (annotate-covered-file filename-path [display-string #f])
|
||||||
(annotate-file filename-path
|
(annotate-file filename-path
|
||||||
|
@ -103,6 +105,9 @@
|
||||||
[else
|
[else
|
||||||
(< (list-ref x 1) (list-ref y 1))])))))
|
(< (list-ref x 1) (list-ref y 1))])))))
|
||||||
|
|
||||||
|
(define (copy-props orig new)
|
||||||
|
(datum->syntax orig (syntax-e new) orig orig))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Profiling run-time support
|
;; Profiling run-time support
|
||||||
|
|
||||||
|
@ -416,6 +421,8 @@
|
||||||
[(mod name init-import (#%plain-module-begin body ...))
|
[(mod name init-import (#%plain-module-begin body ...))
|
||||||
(add-test-coverage-init-code
|
(add-test-coverage-init-code
|
||||||
(normal
|
(normal
|
||||||
|
(copy-props
|
||||||
|
top-e
|
||||||
#`(#,(namespace-module-identifier) name init-import
|
#`(#,(namespace-module-identifier) name init-import
|
||||||
#,(syntax-recertify
|
#,(syntax-recertify
|
||||||
#`(#%plain-module-begin
|
#`(#%plain-module-begin
|
||||||
|
@ -428,7 +435,7 @@
|
||||||
body ...)
|
body ...)
|
||||||
(list-ref (syntax->list top-e) 3)
|
(list-ref (syntax->list top-e) 3)
|
||||||
orig-inspector
|
orig-inspector
|
||||||
#f))))])))]
|
#f)))))])))]
|
||||||
[_else
|
[_else
|
||||||
(normal top-e)])))
|
(normal top-e)])))
|
||||||
|
|
||||||
|
|
|
@ -304,6 +304,7 @@
|
||||||
(datum->syntax
|
(datum->syntax
|
||||||
expr
|
expr
|
||||||
x
|
x
|
||||||
|
expr
|
||||||
expr)))))]
|
expr)))))]
|
||||||
[else (same-k)])))))
|
[else (same-k)])))))
|
||||||
|
|
||||||
|
@ -312,6 +313,7 @@
|
||||||
[(syntax? expr)
|
[(syntax? expr)
|
||||||
(datum->syntax expr
|
(datum->syntax expr
|
||||||
(append-rebuild (syntax-e expr) end)
|
(append-rebuild (syntax-e expr) end)
|
||||||
|
expr
|
||||||
expr)]
|
expr)]
|
||||||
[(pair? expr)
|
[(pair? expr)
|
||||||
(cons (car expr) (append-rebuild (cdr expr) end))]
|
(cons (car expr) (append-rebuild (cdr expr) end))]
|
||||||
|
|
Loading…
Reference in New Issue
Block a user