Refactoring.
This commit is contained in:
parent
4c7e319cd2
commit
9fd9638252
|
@ -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))
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue
Block a user