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

Abstract out right file filtering.

Browse Source
This commit is contained in:
Vincent St-Amour 2012-08-29 16:44:40 -04:00
parent a65d7532f2
commit 5d4bbfaf6c
1 changed files with 22 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
collects/typed-racket/optimizer/tool/report.rkt
View File

@ -71,22 +71,15 @@
(close-output-port log-out) (close-output-port log-out)
(sync log-done-chan)))))) (sync log-done-chan))))))
(define (generate-log this) ;; Returns a predicate that, given a path, returns whether it corresponds
;; to the right file.
(define (make-file-predicate this)
(define portname (send this get-port-name)) (define portname (send this get-port-name))
(define input (open-input-text-editor this))
(port-count-lines! input)
(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? l) ; does the log-entry refer to the file we're in? (lambda (path) ; (or/c path? #f)
(define stx (log-entry-stx l))
(define path
(let ([dir (syntax-source-directory stx)]
[file (syntax-source-file-name stx)])
(if (and dir file)
(build-path dir file)
#f)))
(cond [(and good-portname-cache ; cache is populated (cond [(and good-portname-cache ; cache is populated
(equal? path good-portname-cache)) (equal? path good-portname-cache))
#t] #t]
@ -101,14 +94,30 @@
(set! good-portname-cache path) ; populate cache (set! good-portname-cache path) ; populate cache
#t] #t]
[else ; different file [else ; different file
#f])) #f])))
(define (generate-log this)
(define file-predicate (make-file-predicate this))
(define input (open-input-text-editor this))
(port-count-lines! input)
(define (right-file? l) ; does the log-entry refer to the file we're in?
(define stx (log-entry-stx l))
(define path
(let ([dir (syntax-source-directory stx)]
[file (syntax-source-file-name stx)])
(if (and dir file)
(build-path dir file)
#f)))
(file-predicate path))
(define log '()) (define log '())
(with-intercepted-opt-logging (with-intercepted-opt-logging
(lambda (l) (lambda (l)
(set! log (cons l log))) (set! log (cons l log)))
(lambda () (lambda ()
(run-inside-optimization-coach-sandbox (run-inside-optimization-coach-sandbox
this (lambda () (void (compile (read-syntax portname input))))))) this
(lambda ()
(void (compile (read-syntax (send this get-port-name) input)))))))
(filter right-file? (reverse log))) (filter right-file? (reverse log)))