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

Expose more of the TR opt logging.

Browse Source
This commit is contained in:
Vincent St-Amour 2011-07-21 12:04:07 -04:00
parent 73140544ce
commit 30146b7b8c
1 changed files with 9 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/typed-scheme/optimizer/logging.rkt
View File

@ -6,6 +6,7 @@
(provide log-optimization log-missed-optimization (provide log-optimization log-missed-optimization
print-log clear-log print-log clear-log
log-message-from-tr-opt?
with-intercepted-tr-logging with-tr-logging-to-port with-intercepted-tr-logging with-tr-logging-to-port
(struct-out log-entry) (struct-out log-entry)
(struct-out opt-log-entry) (struct-out opt-log-entry)
@ -223,16 +224,18 @@
;;-------------------------------------------------------------------- ;;--------------------------------------------------------------------
(define (log-message-from-tr-opt? l)
(let ([data (vector-ref l 2)])
(and (pair? data)
(eq? (car data) optimization-log-key))))
;; only intercepts TR log messages ;; only intercepts TR log messages
(define (with-intercepted-tr-logging interceptor thunk) (define (with-intercepted-tr-logging interceptor thunk)
(with-intercepted-logging (with-intercepted-logging
#:level 'warning #:level 'warning
(lambda (l) (lambda (l) ;; look only for optimizer messages
(let ([data (vector-ref l 2)]) (when (log-message-from-tr-opt? l)
;; look only for optimizer messages (interceptor l)))
(when (and (pair? data)
(eq? (car data) optimization-log-key))
(interceptor l))))
thunk)) thunk))
(define (with-tr-logging-to-port port thunk) (define (with-tr-logging-to-port port thunk)