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

Don't compute the logs if no-one's reading the logs.

Browse Source
This commit is contained in:
Vincent St-Amour 2012-02-09 16:39:48 -05:00
parent e134e7cd38
commit 4b84e56fa6
1 changed files with 55 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/typed-racket/optimizer/logging.rkt
View File

@ -14,6 +14,12 @@
;;--------------------------------------------------------------------
(define TR-logging-level 'debug)
;; 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))
;; to identify log messages that come from the optimizer
;; to be stored in the data section of log messages
;; external tools/scripts (like the test harness) can look for it
@ -32,10 +38,11 @@
(define (log-optimization kind msg stx)
(when (anyone-listening?)
(let ([new-entry
(opt-log-entry kind msg
stx (locate-stx stx) (syntax-position stx))])
(set! log-so-far (cons new-entry log-so-far))))
(set! log-so-far (cons new-entry log-so-far)))))
;;--------------------------------------------------------------------
@ -95,6 +102,7 @@
;; Attempts to merge the incoming missed optimization with existing ones.
;; Otherwise, adds the new one to the log.
(define (log-missed-optimization kind msg stx [irritants '()])
(when (anyone-listening?)
(let* (;; for convenience, if a single irritant is given, wrap it in a list
;; implicitly
[irritants (if (list? irritants) irritants (list irritants))]
@ -135,7 +143,7 @@
missed-optimizations-log)))]
[else
;; no related entry, just add the new one
(cons new missed-optimizations-log)]))))
(cons new missed-optimizations-log)])))))
;; When we know all missed opts are known and merging has been done, we
;; can add them to the regular log.
@ -195,7 +203,7 @@
(define logger (current-logger))
(add-missed-opts-to-log)
(for ([x (in-list log-so-far)])
(log-message logger 'debug
(log-message logger TR-logging-level
(format-log-entry x)
(cons optimization-log-key x))))
@ -213,7 +221,7 @@
;; only intercepts TR log messages
(define (with-intercepted-tr-logging interceptor thunk)
(with-intercepted-logging
#:level 'debug
#:level TR-logging-level
(lambda (l) ;; look only for optimizer messages
(when (log-message-from-tr-opt? l)
(interceptor l)))