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-logging-level 'debug)
(define TR-logger (make-logger 'TR-optimizer (current-logger)))
(define (emit-log-message l) (define (emit-log-message l)
(log-message (current-logger) TR-logging-level (log-message TR-logger TR-logging-level
(format-log-entry l) (format-log-entry l)
(cons optimization-log-key l))) (cons optimization-log-key l)))
;; producing logs can be expensive, don't do it if no-one's listening ;; producing logs can be expensive, don't do it if no-one's listening
;; to the logs ;; 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 identify log messages that come from the optimizer
;; to be stored in the data section of log messages ;; 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. ;; Intercepts both TR optimizer logging and mzc optimizer logging.
;; Interceptor accepts log-entry structs. ;; Interceptor accepts log-entry structs.
(define (with-intercepted-opt-logging interceptor thunk) (define (with-intercepted-opt-logging interceptor thunk)
(with-intercepted-logging #:level 'debug (with-intercepted-logging
(lambda (l) (lambda (l)
(cond [(log-message-from-tr-opt? l) (cond [(log-message-from-tr-opt? l)
;; From TR, use the log-entry struct provided. ;; From TR, use the log-entry struct provided.
@ -18,4 +18,5 @@
[(log-message-from-mzc-opt? (vector-ref l 1)) [(log-message-from-mzc-opt? (vector-ref l 1))
;; From mzc, create a log-entry from the info. ;; From mzc, create a log-entry from the info.
(interceptor (mzc-opt-log-message->log-entry (vector-ref l 1)))])) (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. ;;; Low-level log parsing. Goes from strings to log-entry structs.
(define mzc-optimizer-regexp "^mzc optimizer: ")
(define success-regexp "inlining: ") (define success-regexp "inlining: ")
(define failure-regexp "no inlining: ") (define failure-regexp "no inlining: ")
(define out-of-fuel-regexp "no inlining, out of fuel: ") (define out-of-fuel-regexp "no inlining, out of fuel: ")
(define any-inlining-event-regexp (define any-inlining-event-regexp
(string-append mzc-optimizer-regexp (format "^optimizer: (~a)" (string-join (list success-regexp
"("
(string-join (list success-regexp
failure-regexp failure-regexp
out-of-fuel-regexp) out-of-fuel-regexp)
"|") "|")))
")"))
(define (log-message-from-mzc-opt? l) (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) (struct inliner-log-entry log-entry (inlining-event) #:prefab)