Propagate profile information to inlining analysis.

collects/typed-racket/optimizer/tool/mzc.rkt

@@ -4,7 +4,8 @@
 
 (require typed-racket/optimizer/logging
          unstable/syntax racket/match unstable/match racket/list racket/string
-         unstable/list)
+         unstable/list
+         "profiling.rkt")
 
 (provide mzc-opt-log-message->log-entry
          post-process-inline-log)
@@ -140,7 +141,7 @@
 ;; We aggregate results for each function.
 ;; Log messages produced by the inliner are very raw, unlike the TR logs,
 ;; which have gone through some aggregation. We do the aggregation here.
-(define (post-process-inline-log log)
+(define (post-process-inline-log log profile)
   (define-values (inliner-logs tr-logs)
     (partition inliner-log-entry? log))
   (define grouped-events
@@ -152,10 +153,17 @@
                                            (not (self-out-of-fuel? x)))
                                          g))]
                 #:when (not (null? group)))
-      (define head (car group))
-      (match head ; events are grouped, first element is representative
+      (match (car group) ; events are grouped, first element is representative
         [(log-entry kind msg stx located-stx pos provenance)
 
+         ;; #f if no profiling info is available for this function
+         (define (pos->node pos)
+           (and profile
+                (for/first ([p (in-list (profile-nodes profile))]
+                            #:when (equal? pos (node-pos p)))
+                  p)))
+         (define profile-entry (pos->node pos))
+
          ;; We consider that a function is a loop if it gets inlined in itself
          ;; at least once.
          ;; We treat loops specially, mostly to avoid spurious reports.

collects/typed-racket/optimizer/tool/profiling.rkt

@@ -4,7 +4,18 @@
 
 (require "sandbox.rkt")
 
-(provide generate-profile)
+(provide generate-profile
+         node-source node-line node-col node-pos node-span
+         (all-from-out profile/analyzer))
+
+(define ((mk accessor) node)
+  (define src (node-src node))
+  (and src (accessor src)))
+(define node-source  (mk srcloc-source))
+(define node-line    (mk srcloc-line))
+(define node-col     (mk srcloc-column))
+(define node-pos     (mk srcloc-position))
+(define node-span    (mk srcloc-span))
 
 (define compiled-module-name 'optimization-coach-compiled-module)
 
@@ -28,8 +39,5 @@
   (define (right-file? node)
     (define src (node-src node))
     (equal? (and src (srcloc-source src)) res-mpi))
-  (define nodes
-    (filter right-file? (profile-nodes (analyze-samples snapshots))))
-  (for ([n nodes])
-    (printf "~a -- ~a -- ~a -- ~a\n" (node-id n) (node-total n) (node-self n) (node-src n)))
-  nodes)
+  (define orig-profile (analyze-samples snapshots))
+  (filter right-file? (profile-nodes orig-profile)))

collects/typed-racket/optimizer/tool/report.rkt

@@ -25,10 +25,12 @@
 (struct opt-report-entry        sub-report-entry ())
 (struct missed-opt-report-entry sub-report-entry (badness irritants))
 
-(define (generate-report this)
+;; profile is currently only used to refine the inlining logs
+(define (generate-report this profile)
   (log->report
    (post-process-inline-log
-    (generate-log this))))
+    (generate-log this)
+    profile)))
 
 
 (define (generate-log this)

collects/typed-racket/optimizer/tool/tool.rkt

@@ -120,10 +120,14 @@
       ;; source is either a copy of the definitions text (we're not in the
       ;; main thread, so operating on the definitions directly is a bad idea)
       ;; or #f, in which case the report cache is used.
-      (define/public (add-highlights #:source [source #f])
+      ;; profile is either a list of analyzed profile nodes (in which case we
+      ;; use it to refine the report) or #f. Profile information causes the
+      ;; report to be recomputed, invalidating the cache.
+      (define/public (add-highlights #:source  [source  #f]
+                                     #:profile [profile #f])
         (clear-highlights)
-        (unless (and report-cache (not source))
-          (set! report-cache (generate-report source)))
+        (unless (and report-cache (not source) (not profile))
+          (set! report-cache (generate-report source profile)))
         (define report
           (collapse-report
            (for/list ([entry (in-list report-cache)]
@@ -171,8 +175,10 @@
                              [callback (lambda _
                                          (popup-fun text start end))]))))))
 
+      ;; gather profiling information, and use it to generate a refined report
       (define/public (optimization-coach-profile source)
-        (generate-profile this source))
+        (add-highlights #:source  source
+                        #:profile (generate-profile this source)))
 
       (super-new)))