From a8845e3dcb99b25b82d0cb567fb389b2d67da1a8 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Thu, 21 Jul 2011 12:04:07 -0400 Subject: [PATCH] Expose more of the TR opt logging. original commit: 30146b7b8c7a4bde11f5d356f6be9cbc5d46377a --- collects/typed-scheme/optimizer/logging.rkt | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/collects/typed-scheme/optimizer/logging.rkt b/collects/typed-scheme/optimizer/logging.rkt index e0148e6f..06f26eb1 100644 --- a/collects/typed-scheme/optimizer/logging.rkt +++ b/collects/typed-scheme/optimizer/logging.rkt @@ -6,6 +6,7 @@ (provide log-optimization log-missed-optimization print-log clear-log + log-message-from-tr-opt? with-intercepted-tr-logging with-tr-logging-to-port (struct-out 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 (define (with-intercepted-tr-logging interceptor thunk) (with-intercepted-logging #:level 'warning - (lambda (l) - (let ([data (vector-ref l 2)]) - ;; look only for optimizer messages - (when (and (pair? data) - (eq? (car data) optimization-log-key)) - (interceptor l)))) + (lambda (l) ;; look only for optimizer messages + (when (log-message-from-tr-opt? l) + (interceptor l))) thunk)) (define (with-tr-logging-to-port port thunk)