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

adjust DrScheme to run #lang-specified runtime configuration

Browse Source 
svn: r18762
This commit is contained in:
Matthew Flatt 2010-04-08 15:32:02 +00:00
parent 8b31b1b552
commit 8fbd16261f
3 changed files with 48 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -309,9 +309,24 @@
(parameterize ([current-namespace (current-namespace)])
;; the prompt makes it continue after an error
(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))
(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
(expr-getter *pre module-expr *post))
@ -350,6 +365,7 @@
#:mred? gui?
#:verbose? #f ;; verbose?
#:modules (list (list #f program-filename))
#:configure-via-first-module? #t
#:literal-expression
(begin
(parameterize ([current-namespace (make-base-empty-namespace)])

11
collects/errortrace/errortrace-lib.ss
View File

@ -44,6 +44,8 @@
(define (add-test-coverage-init-code stx)
(syntax-case stx (#%plain-module-begin)
[(mod name init-import (#%plain-module-begin b1 b2 body ...))
(copy-props
stx
#`(#,(namespace-module-identifier) name init-import
#,(syntax-recertify
#`(#%plain-module-begin
@ -52,7 +54,7 @@
body ...)
(list-ref (syntax->list stx) 3)
orig-inspector
#f))]))
#f)))]))
(define (annotate-covered-file filename-path [display-string #f])
(annotate-file filename-path
@ -103,6 +105,9 @@
[else
(< (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
@ -416,6 +421,8 @@
[(mod name init-import (#%plain-module-begin body ...))
(add-test-coverage-init-code
(normal
(copy-props
top-e
#`(#,(namespace-module-identifier) name init-import
#,(syntax-recertify
#`(#%plain-module-begin
@ -428,7 +435,7 @@
body ...)
(list-ref (syntax->list top-e) 3)
orig-inspector
#f))))])))]
#f)))))])))]
[_else
(normal top-e)])))

2
collects/errortrace/stacktrace.ss
View File

@ -304,6 +304,7 @@
(datum->syntax
expr
x
expr
expr)))))]
[else (same-k)])))))
@ -312,6 +313,7 @@
[(syntax? expr)
(datum->syntax expr
(append-rebuild (syntax-e expr) end)
expr
expr)]
[(pair? expr)
(cons (car expr) (append-rebuild (cdr expr) end))]