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

Report hidden parameter accesses.

Browse Source
This commit is contained in:
Vincent St-Amour 2012-11-26 16:08:20 -05:00
parent cc168d148d
commit a474eb9838
2 changed files with 43 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
collects/typed-racket/optimizer/tool/mzc.rkt
View File

@ -155,16 +155,22 @@
;; We aggregate results for each function. ;; We aggregate results for each function.
;; Log messages produced by the inliner are very raw, unlike the TR logs, ;; Log messages produced by the inliner are very raw, unlike the TR logs,
;; which have gone through some aggregation. We do the aggregation here. ;; which have gone through some aggregation. We do the aggregation here.
(define (post-process-inline-log log profile) (define (post-process-inline-log log profile TR-log)
(define hot-functions (and profile (prune-profile profile))) (define hot-functions (and profile (prune-profile profile)))
(define grouped-events (define grouped-events
(group-by equal? #:key log-entry-pos log)) ; right file, so that's enough (group-by equal? #:key log-entry-pos log)) ; right file, so that's enough
(apply append (apply
(for/list ([group (in-list grouped-events)]) append
(process-function group profile hot-functions)))) (append
(for/list ([group (in-list grouped-events)])
(process-function group profile hot-functions TR-log))
(if profile
(for/list ([node (in-list (profile-nodes profile))])
(process-profile-node node grouped-events hot-functions TR-log))
'()))))
;; Process the inlining logs corresponding to a single function. ;; Process the inlining logs corresponding to a single function.
(define (process-function log profile hot-functions) (define (process-function log profile hot-functions TR-log)
(define produced-entries '()) (define produced-entries '())
(let/ec escape (let/ec escape
;; prune this entry from the logs, but return what we produced so far ;; prune this entry from the logs, but return what we produced so far
@ -353,6 +359,37 @@
produced-entries]))) ; return the list of new entries produced-entries]))) ; return the list of new entries
(define (process-profile-node profile-entry grouped-events hot-functions TR-log)
(define produced-entries '())
(define (emit e) (set! produced-entries (cons e produced-entries)))
(define inside-hot-function? (memq profile-entry hot-functions))
(define (pos-inside-us? pos)
(define our-pos (node-pos profile-entry))
(define our-span (node-span profile-entry))
(and pos our-pos our-span (<= our-pos pos (+ our-pos our-span))))
(when inside-hot-function?
(for ([TR-entry (in-list TR-log)]
#:when (info-log-entry? TR-entry)
#:when (equal? (log-entry-kind TR-entry) "hidden parameter")
#:when (pos-inside-us? (log-entry-pos TR-entry)))
(emit (missed-opt-log-entry
"" ; kind not used at this point
(string-append "This function may implicitly dereference the "
"`current-output-port' parameter. " ;; TODO hard coded
"It may be faster to take the value of the "
"parameter once, outside hot code, and pass it "
"to this function as an argument.")
(log-entry-located-stx TR-entry) (log-entry-located-stx TR-entry)
(log-entry-pos TR-entry) 'typed-racket
'() '()
20)))) ;; TODO have actual badness
produced-entries)
(define (group-badness group) (define (group-badness group)
(+ (n-failures group) (- (n-out-of-fuels group) (n-successes group)))) (+ (n-failures group) (- (n-out-of-fuels group) (n-successes group))))

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

@ -30,7 +30,7 @@
(define-values (TR-log mzc-log) (generate-logs this)) (define-values (TR-log mzc-log) (generate-logs this))
(log->report (log->report
(append TR-log (append TR-log
(post-process-inline-log mzc-log profile)))) (post-process-inline-log mzc-log profile TR-log))))
(define (generate-logs this) (define (generate-logs this)