diff --git a/collects/typed-racket/optimizer/tool/causality-merging.rkt b/collects/typed-racket/optimizer/tool/causality-merging.rkt index 193659b0bd..3d0c6df09c 100644 --- a/collects/typed-racket/optimizer/tool/causality-merging.rkt +++ b/collects/typed-racket/optimizer/tool/causality-merging.rkt @@ -13,7 +13,7 @@ (cond [(missed-opt-log-entry? new) (maybe-merge-with-parent new res)] [else - (cons new res)]))) ; no merging for opts and info + (cons new res)]))) ; no merging for opts ;; is parent the "parent" missed optimization of child? ;; this determines whether they get reported together or not diff --git a/collects/typed-racket/optimizer/tool/hidden-costs.rkt b/collects/typed-racket/optimizer/tool/hidden-costs.rkt index ae82000f23..6219a35224 100644 --- a/collects/typed-racket/optimizer/tool/hidden-costs.rkt +++ b/collects/typed-racket/optimizer/tool/hidden-costs.rkt @@ -4,14 +4,14 @@ (provide report-hidden-costs) -(define (report-hidden-costs TR-log profile hot-functions) +(define (report-hidden-costs info-log profile hot-functions) (apply append (for/list ([node (in-list (profile-nodes profile))]) - (process-profile-node node hot-functions TR-log + (process-profile-node node hot-functions info-log (profile-total-time profile))))) -(define (process-profile-node profile-entry hot-functions TR-log total-time) +(define (process-profile-node profile-entry hot-functions info-log total-time) (define produced-entries '()) (define (emit e) (set! produced-entries (cons e produced-entries))) @@ -30,15 +30,16 @@ (define (check-hidden-cost kind message badness) (when inside-hot-function? - (for/list ([TR-entry (in-list TR-log)] - #:when (info-log-entry? TR-entry) - #:when (equal? (log-entry-kind TR-entry) kind) - #:when (inside-us? (log-entry-pos TR-entry))) + (for/list ([info-entry (in-list info-log)] + #:when (info-log-entry? info-entry) + #:when (equal? (log-entry-kind info-entry) kind) + #:when (inside-us? (log-entry-pos info-entry))) (emit (missed-opt-log-entry "" ; kind not used at this point message - (log-entry-located-stx TR-entry) (log-entry-located-stx TR-entry) - (log-entry-pos TR-entry) 'typed-racket + (log-entry-located-stx info-entry) + (log-entry-located-stx info-entry) + (log-entry-pos info-entry) 'typed-racket '() '() badness))))) diff --git a/collects/typed-racket/optimizer/tool/instrumentation.rkt b/collects/typed-racket/optimizer/tool/instrumentation.rkt index ce832a6bdb..1e107338d2 100644 --- a/collects/typed-racket/optimizer/tool/instrumentation.rkt +++ b/collects/typed-racket/optimizer/tool/instrumentation.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require racket/class racket/gui/base racket/string racket/match +(require racket/class racket/gui/base racket/string racket/match racket/list unstable/syntax unstable/logging "structs.rkt" "sandbox.rkt") @@ -19,8 +19,9 @@ (build-path dir file) #f))) (file-predicate path)) - (define TR-log '()) - (define mzc-log '()) + (define TR-log '()) + (define mzc-log '()) + (define info-log '()) ; for hidden costs (with-intercepted-logging (lambda (l) ;; From mzc, create a log-entry from the info. @@ -33,7 +34,9 @@ ;; From TR, use the log-entry struct provided. (define entry (vector-ref l 2)) (when (right-file? entry) - (set! TR-log (cons entry TR-log)))) + (if (info-log-entry? entry) + (set! info-log (cons entry info-log)) + (set! TR-log (cons entry TR-log))))) (lambda () (run-inside-optimization-coach-sandbox this @@ -41,7 +44,13 @@ (void (compile (read-syntax (send this get-port-name) input)))))) 'debug 'TR-optimizer)) 'debug 'optimizer) - (values (reverse TR-log) (reverse mzc-log))) + ;; The raw TR logs may contain duplicates from the optimizer traversing + ;; the same piece of code multiple times. + ;; Duplicates are not significant (unlike for inlining logs) and we can + ;; prune them. + (values (reverse (remove-duplicates TR-log)) + (reverse mzc-log) + (reverse (remove-duplicates info-log)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/collects/typed-racket/optimizer/tool/report.rkt b/collects/typed-racket/optimizer/tool/report.rkt index e9edb9c8f5..b4037be30d 100644 --- a/collects/typed-racket/optimizer/tool/report.rkt +++ b/collects/typed-racket/optimizer/tool/report.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require racket/class racket/match racket/list +(require racket/class racket/match "structs.rkt" "instrumentation.rkt" "inlining.rkt" "hidden-costs.rkt" "locality-merging.rkt" "causality-merging.rkt") @@ -8,29 +8,20 @@ ;; profile is currently only used to refine the inlining logs (define (generate-report this profile) - (define-values (pre-TR-log mzc-log) (generate-logs this)) - ;; The raw TR log may contain duplicates from the optimizer traversing - ;; the same piece of code multiple times. - ;; Duplicates are not significant (unlike for inlining logs) and we can - ;; prune them. - (define TR-log (remove-duplicates pre-TR-log)) + (define-values (TR-log mzc-log info-log) (generate-logs this)) (define hot-functions (and profile (prune-profile profile))) (log->report (append (causality-merging (prune-cold-TR-failures TR-log profile hot-functions)) (report-inlining mzc-log profile hot-functions) (if profile - (report-hidden-costs TR-log profile hot-functions) + (report-hidden-costs info-log profile hot-functions) '())))) ;; Returns a report-entry or #f, which means prune. (define (log-entry->report-entry l) (match l - [(? info-log-entry? _) - ;; Info entries are only useful for log analysis, and should not be - ;; presented to users. Drop them. - #f] [(log-entry kind msg stx located-stx (? number? pos) provenance) (define start (sub1 pos)) (define end (+ start (syntax-span stx)))