Fix OC for new logging system.

This commit is contained in:
Vincent St-Amour 2012-09-07 17:23:26 -04:00
parent 5a24b57a95
commit 39100bd3e3
3 changed files with 19 additions and 21 deletions

View File

@ -14,15 +14,16 @@
;;--------------------------------------------------------------------
(define TR-logging-level 'debug)
(define TR-logger (make-logger 'TR-optimizer (current-logger)))
(define (emit-log-message l)
(log-message (current-logger) TR-logging-level
(log-message TR-logger TR-logging-level
(format-log-entry l)
(cons optimization-log-key l)))
;; producing logs can be expensive, don't do it if no-one's listening
;; to the logs
(define (anyone-listening?) (log-level? (current-logger) TR-logging-level))
(define (anyone-listening?) (log-level? TR-logger TR-logging-level))
;; to identify log messages that come from the optimizer
;; to be stored in the data section of log messages

View File

@ -9,7 +9,7 @@
;; Intercepts both TR optimizer logging and mzc optimizer logging.
;; Interceptor accepts log-entry structs.
(define (with-intercepted-opt-logging interceptor thunk)
(with-intercepted-logging #:level 'debug
(with-intercepted-logging
(lambda (l)
(cond [(log-message-from-tr-opt? l)
;; From TR, use the log-entry struct provided.
@ -18,4 +18,5 @@
[(log-message-from-mzc-opt? (vector-ref l 1))
;; From mzc, create a log-entry from the info.
(interceptor (mzc-opt-log-message->log-entry (vector-ref l 1)))]))
thunk))
thunk
'debug 'optimizer 'debug 'TR-optimizer))

View File

@ -13,21 +13,17 @@
;;; Low-level log parsing. Goes from strings to log-entry structs.
(define mzc-optimizer-regexp "^mzc optimizer: ")
(define success-regexp "inlining: ")
(define failure-regexp "no inlining: ")
(define out-of-fuel-regexp "no inlining, out of fuel: ")
(define any-inlining-event-regexp
(string-append mzc-optimizer-regexp
"("
(string-join (list success-regexp
(format "^optimizer: (~a)" (string-join (list success-regexp
failure-regexp
out-of-fuel-regexp)
"|")
")"))
"|")))
(define (log-message-from-mzc-opt? l)
(regexp-match mzc-optimizer-regexp l))
(regexp-match any-inlining-event-regexp l))
(struct inliner-log-entry log-entry (inlining-event) #:prefab)