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

Do expansion inside a sandbox.

Browse Source
This commit is contained in:
Vincent St-Amour 2011-07-29 17:48:54 -04:00
parent ea1ae29e0f
commit 7775779e6a
1 changed files with 34 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
collects/typed-scheme/optimizer/tool/report.rkt
View File

@ -1,9 +1,7 @@
#lang racket/base #lang racket/base
(require racket/class racket/gui/base racket/match racket/serialize (require racket/class racket/gui/base racket/match racket/port racket/serialize
unstable/syntax) unstable/syntax unstable/port racket/sandbox
(require (prefix-in tr: typed-scheme/typed-reader)
typed-scheme/optimizer/logging) typed-scheme/optimizer/logging)
(provide (struct-out report-entry) (provide (struct-out report-entry)
@ -32,42 +30,51 @@
(define portname (send this get-port-name)) (define portname (send this get-port-name))
(define input (open-input-text-editor this)) (define input (open-input-text-editor this))
(port-count-lines! input) (port-count-lines! input)
(define log '())
(define unsaved-file? (define unsaved-file?
(and (symbol? portname) (and (symbol? portname)
(regexp-match #rx"^unsaved-editor" (symbol->string portname)))) (regexp-match #rx"^unsaved-editor" (symbol->string portname))))
(define good-portname-cache #f) (define good-portname-cache #f)
(define (right-file? f) ; does the log-entry refer to the file we're in? (define (right-file? l) ; does the log-entry refer to the file we're in?
(define log-entry-data (cdr (vector-ref l 2))) ; log-entry struct
(define stx (log-entry-stx log-entry-data))
(define path
(if (and (pseudo-syntax-source-directory stx)
(pseudo-syntax-source-file-name stx))
(build-path (deserialize (pseudo-syntax-source-directory stx))
(deserialize (pseudo-syntax-source-file-name stx)))
#f))
(cond [(and good-portname-cache ; cache is populated (cond [(and good-portname-cache ; cache is populated
(equal? f good-portname-cache)) (equal? path good-portname-cache))
#t] #t]
;; no cache, ask directly ;; no cache, ask directly
[(send this port-name-matches? f) [(send this port-name-matches? path)
(set! good-portname-cache f) ; populate cache (set! good-portname-cache path) ; populate cache
#t] #t]
[unsaved-file? [unsaved-file?
;; we assume that any log entry without a filename comes from ;; we assume that any log entry without a filename comes from
;; the unsaved editor ;; the unsaved editor
(not f)] (not path)]
[else ; different file [else ; different file
#f])) #f]))
(with-intercepted-tr-logging (define sandbox
(lambda (l) (parameterize ([sandbox-output 'string]
(define log-entry-data (cdr (vector-ref l 2))) ; log-entry struct [sandbox-input input]
(define stx (log-entry-stx log-entry-data)) [sandbox-make-code-inspector current-code-inspector]
(define path [sandbox-eval-limits #f])
(if (and (pseudo-syntax-source-directory stx) (make-evaluator 'racket/base
(pseudo-syntax-source-file-name stx)) '(require (prefix-in tr: typed-scheme/typed-reader)
(build-path (deserialize (pseudo-syntax-source-directory stx)) typed-scheme/optimizer/logging)
(deserialize (pseudo-syntax-source-file-name stx))) `(define portname ,portname))))
#f)) (sandbox
(when (right-file? path) '(with-intercepted-tr-logging
(set! log (cons log-entry-data log)))) write
(lambda () (lambda ()
(parameterize ([current-namespace (make-base-namespace)] (parameterize ([current-namespace (make-base-namespace)]
[read-accept-reader #t]) [read-accept-reader #t])
(expand (tr:read-syntax portname input))))) (void (expand (tr:read-syntax portname (current-input-port))))))))
log) (for/list ([x (with-input-from-string (get-output sandbox) read-all)]
#:when (right-file? x))
(cdr (vector-ref x 2)))) ; get the log-entry part
;; converts log-entry structs to report-entry structs for further ;; converts log-entry structs to report-entry structs for further
;; processing ;; processing