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

Refactoring.

Browse Source
This commit is contained in:
Vincent St-Amour 2012-09-12 17:04:25 -04:00
parent 4c7e319cd2
commit 9fd9638252
2 changed files with 22 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
collects/typed-racket/optimizer/tool/logging.rkt
View File

@ -1,21 +0,0 @@
#lang racket/base
(require "mzc.rkt" unstable/logging)
(provide with-intercepted-opt-logging)
;; Intercepts both TR optimizer logging and mzc optimizer logging.
;; Interceptor accepts log-entry structs.
(define (with-intercepted-opt-logging interceptor thunk)
(with-intercepted-logging
(lambda (l)
;; From mzc, create a log-entry from the info.
(interceptor (mzc-opt-log-message->log-entry (vector-ref l 1))))
(lambda ()
(with-intercepted-logging
(lambda (l)
;; From TR, use the log-entry struct provided.
(interceptor (vector-ref l 2)))
thunk
'debug 'TR-optimizer))
'debug 'optimizer))

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

@ -1,9 +1,9 @@
#lang racket/base #lang racket/base
(require racket/class racket/gui/base racket/match racket/list (require racket/class racket/gui/base racket/match racket/list
unstable/syntax unstable/syntax unstable/logging
typed-racket/optimizer/logging typed-racket/optimizer/logging
"logging.rkt" "mzc.rkt" "sandbox.rkt") "mzc.rkt" "sandbox.rkt")
(provide (struct-out report-entry) (provide (struct-out report-entry)
(struct-out sub-report-entry) (struct-out sub-report-entry)
@ -44,16 +44,26 @@
(build-path dir file) (build-path dir file)
#f))) #f)))
(file-predicate path)) (file-predicate path))
(define log '()) (define TR-log '())
(with-intercepted-opt-logging (define mzc-log '())
(lambda (l) (with-intercepted-logging
(set! log (cons l log))) (lambda (l)
(lambda () ;; From mzc, create a log-entry from the info.
(run-inside-optimization-coach-sandbox (set! mzc-log (cons (mzc-opt-log-message->log-entry (vector-ref l 1))
this mzc-log)))
(lambda () (lambda ()
(void (compile (read-syntax (send this get-port-name) input))))))) (with-intercepted-logging
(filter right-file? (reverse log))) (lambda (l)
;; From TR, use the log-entry struct provided.
(set! TR-log (cons (vector-ref l 2) TR-log)))
(lambda ()
(run-inside-optimization-coach-sandbox
this
(lambda ()
(void (compile (read-syntax (send this get-port-name) input))))))
'debug 'TR-optimizer))
'debug 'optimizer)
(filter right-file? (append (reverse TR-log) (reverse mzc-log))))
;; converts log-entry structs to report-entry structs for further ;; converts log-entry structs to report-entry structs for further