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

Separate TR optimization and info logs.

Browse Source
This commit is contained in:
Vincent St-Amour 2012-11-25 16:47:37 -05:00
parent 677550cbe2
commit 4933d9f00f
4 changed files with 28 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/typed-racket/optimizer/tool/causality-merging.rkt
View File

@ -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

19
collects/typed-racket/optimizer/tool/hidden-costs.rkt
View File

@ -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)))))

19
collects/typed-racket/optimizer/tool/instrumentation.rkt
View File

@ -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))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

15
collects/typed-racket/optimizer/tool/report.rkt
View File

@ -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)))