From 1d084888fddb7c3efb32f82b137d1c433cb50135 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Thu, 28 Jun 2012 12:41:40 -0400 Subject: [PATCH] Filter reports by provenance (TR / mzc). Can't easily combine with filtering by opt / missed opt, so I dropped it. --- collects/typed-racket/optimizer/logging.rkt | 6 ++++-- collects/typed-racket/optimizer/tool/display.rkt | 2 +- collects/typed-racket/optimizer/tool/mzc.rkt | 7 ++++--- collects/typed-racket/optimizer/tool/report.rkt | 10 ++++++---- collects/typed-racket/optimizer/tool/tool.rkt | 8 ++++++-- 5 files changed, 21 insertions(+), 12 deletions(-) diff --git a/collects/typed-racket/optimizer/logging.rkt b/collects/typed-racket/optimizer/logging.rkt index 17db6d3273..c9f2514434 100644 --- a/collects/typed-racket/optimizer/logging.rkt +++ b/collects/typed-racket/optimizer/logging.rkt @@ -31,7 +31,7 @@ (define optimization-log-key 'log-message-coming-from-the-TR-optimizer) ;; msg is for consumption by the DrRacket tool -(struct log-entry (kind msg stx located-stx pos) #:prefab) +(struct log-entry (kind msg stx located-stx pos provenance) #:prefab) ;; for optimizations only (not missed optimizations, those are below) (struct opt-log-entry log-entry () #:prefab) @@ -39,7 +39,8 @@ (define (log-optimization kind msg stx) (when (anyone-listening?) (emit-log-message - (opt-log-entry kind msg stx (locate-stx stx) (syntax-position stx))))) + (opt-log-entry kind msg stx (locate-stx stx) (syntax-position stx) + 'typed-racket)))) ;;-------------------------------------------------------------------- @@ -70,6 +71,7 @@ (emit-log-message (missed-opt-log-entry kind msg stx (locate-stx stx) (syntax-position stx) + 'typed-racket irritants '() 1))))) diff --git a/collects/typed-racket/optimizer/tool/display.rkt b/collects/typed-racket/optimizer/tool/display.rkt index 10b607eec9..3d9668f926 100644 --- a/collects/typed-racket/optimizer/tool/display.rkt +++ b/collects/typed-racket/optimizer/tool/display.rkt @@ -29,7 +29,7 @@ ;; each sub-entry is displayed in its own text%, contained in the main ;; editor, to simplify irritant highlighting (define ((format-sub-report-entry pane) s) - (match-define (sub-report-entry stx msg) s) + (match-define (sub-report-entry stx msg provenance) s) (define usable-width (- popup-width 20)) ; minus the scrollbar diff --git a/collects/typed-racket/optimizer/tool/mzc.rkt b/collects/typed-racket/optimizer/tool/mzc.rkt index 64002e064a..1665266f48 100644 --- a/collects/typed-racket/optimizer/tool/mzc.rkt +++ b/collects/typed-racket/optimizer/tool/mzc.rkt @@ -45,6 +45,7 @@ (inliner-log-entry kind kind forged-stx forged-stx (syntax-position forged-stx) + 'mzc evt)) (define inlining-event-regexp @@ -158,7 +159,7 @@ #:when (not (null? group))) (define head (car group)) (match head ; events are grouped, first element is representative - [(log-entry kind msg stx located-stx pos) + [(log-entry kind msg stx located-stx pos provenance) ;; We consider that a function is a loop if it gets inlined in itself ;; at least once. @@ -224,13 +225,13 @@ kind (format "Missed Inlining ~a\n~a" aggregation-string recommendation) - stx located-stx pos + stx located-stx pos provenance '() '() (+ n-failures (- n-out-of-fuels n-successes))) ; badness (opt-log-entry kind (format "Inlining ~a" aggregation-string) - stx located-stx pos))]))) + stx located-stx pos provenance))]))) (append tr-logs new-inline-log-entries)) (define (format-aggregation-string diff --git a/collects/typed-racket/optimizer/tool/report.rkt b/collects/typed-racket/optimizer/tool/report.rkt index 63c624f141..eb023cd5d0 100644 --- a/collects/typed-racket/optimizer/tool/report.rkt +++ b/collects/typed-racket/optimizer/tool/report.rkt @@ -21,7 +21,8 @@ ;; otherwise, it's the sum for all the subs (struct report-entry (subs start end badness)) ;; multiple of these can be contained in a report-entry -(struct sub-report-entry (stx msg)) +;; provenance is one of: 'typed-racket 'mzc +(struct sub-report-entry (stx msg provenance)) (struct opt-report-entry sub-report-entry ()) (struct missed-opt-report-entry sub-report-entry (badness irritants)) @@ -87,14 +88,14 @@ (define (log->report log) (define (log-entry->report-entry l) (match l - [(log-entry kind msg stx located-stx (? number? pos)) + [(log-entry kind msg stx located-stx (? number? pos) provenance) (define start (sub1 pos)) (define end (+ start (syntax-span stx))) ;; When we first create report entries, they have a single sub. (report-entry (list (if (opt-log-entry? l) - (opt-report-entry located-stx msg) + (opt-report-entry located-stx msg provenance) (missed-opt-report-entry - located-stx msg + located-stx msg provenance (missed-opt-log-entry-badness l) (missed-opt-log-entry-irritants l)))) start end @@ -139,6 +140,7 @@ (log-entry-stx parent) ; we report the outermost one (log-entry-located-stx parent) (log-entry-pos parent) + (log-entry-provenance parent) (remove-duplicates (append (remove (log-entry-stx child) diff --git a/collects/typed-racket/optimizer/tool/tool.rkt b/collects/typed-racket/optimizer/tool/tool.rkt index 8b5c2048be..cf7e38449f 100644 --- a/collects/typed-racket/optimizer/tool/tool.rkt +++ b/collects/typed-racket/optimizer/tool/tool.rkt @@ -42,8 +42,12 @@ ;; Note: at the point where these are called, report entries have ;; a single sub. (define check-boxes - `(("Report missed optimizations?" . ,missed-opt-report-entry?) - ("Report optimizations?" . ,opt-report-entry?))) + `(("Report Typed Racket optimizations?" . + ,(match-lambda [(sub-report-entry s m 'typed-racket) #t] + [_ #f])) + ("Report inlining optimizations?" . + ,(match-lambda [(sub-report-entry s m 'mzc) #t] + [_ #f])))) (define/public (get-check-boxes) check-boxes) (define filters (map cdr check-boxes)) ; all enabled by default ;; called by the frame, where the check-boxes are