From a134e4ffb7b6c3b279943df9a03818c64bacef29 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 24 Jun 2011 18:20:15 -0400
Subject: [PATCH] Have nicer information to present in pop-ups.

---
 collects/typed-scheme/optimizer/logging.rkt   |  8 ++---
 collects/typed-scheme/optimizer/tool/tool.rkt | 30 +++++++------------
 2 files changed, 15 insertions(+), 23 deletions(-)

diff --git a/collects/typed-scheme/optimizer/logging.rkt b/collects/typed-scheme/optimizer/logging.rkt
index 6013ca27bb..d683578686 100644
--- a/collects/typed-scheme/optimizer/logging.rkt
+++ b/collects/typed-scheme/optimizer/logging.rkt
@@ -16,7 +16,7 @@
         (format "~a:~a" line col)
         "(no location)")))
 
-(struct log-entry (msg stx pos) #:prefab)
+(struct log-entry (msg raw-msg stx pos) #:prefab)
 
 ;; to identify log messages that come from the optimizer
 ;; to be stored in the data section of log messages
@@ -45,7 +45,7 @@
                           #:from [from "TR opt"]
                           #:show-badness? [show-badness? #f])
   (let* ([new-message (gen-log-message msg stx from show-badness?)]
-         [new-entry (log-entry new-message stx (syntax-position stx))])
+         [new-entry (log-entry new-message msg stx (syntax-position stx))])
     (set! log-so-far (cons new-entry log-so-far))))
 
 ;; once the optimizer is done, we sort the log according to source
@@ -66,8 +66,8 @@
                                      (cons optimization-log-key x)))
             (sort (remove-duplicates log-so-far)
                   (match-lambda*
-                   [(list (log-entry msg-x stx-x pos-x)
-                          (log-entry msg-y stx-y pos-y))
+                   [(list (log-entry msg-x raw-x stx-x pos-x)
+                          (log-entry msg-y raw-y stx-y pos-y))
                     (cond [(not (or pos-x pos-y))
                            ;; neither have location, sort by message
                            (string<? msg-x msg-y)]
diff --git a/collects/typed-scheme/optimizer/tool/tool.rkt b/collects/typed-scheme/optimizer/tool/tool.rkt
index 81ab325885..5ac6f15dd9 100644
--- a/collects/typed-scheme/optimizer/tool/tool.rkt
+++ b/collects/typed-scheme/optimizer/tool/tool.rkt
@@ -46,25 +46,17 @@
   ;; highlight
   (define new-highlights
     (for/list ([l (in-list log)])
-      (let* ([stx (log-entry-stx l)]
-             [pos (sub1 (log-entry-pos l))]
-             [end (+ pos (syntax-span stx))]
-             [msg (log-entry-msg l)]
-             ;; opt or missed opt?
-             [opt? (regexp-match #rx"^TR opt:" msg)]
-             [color (if opt? "lightgreen" "pink")])
-        (send defs highlight-range pos end color)
-        (send defs set-clickback pos end
-              (lambda (ed start end)
-                (message-box "Performance Report" msg)))
-        (list pos end color)))) ; record the highlight, to undo it later
-  (set! highlights (append new-highlights highlights))
-  (message-box
-   "Performance Report"
-   (with-output-to-string
-    (lambda ()
-      (for ([l (in-list log)])
-        (displayln (log-entry-msg l)))))))
+      (match l
+        [(log-entry msg raw-msg stx (app sub1 pos))
+         (let* ([end  (+ pos (syntax-span stx))]
+                [opt? (regexp-match #rx"^TR opt:" msg)] ;; opt or missed opt?
+                [color (if opt? "lightgreen" "pink")])
+           (send defs highlight-range pos end color)
+           (send defs set-clickback pos end
+                 (lambda (ed start end)
+                   (message-box "Performance Report" raw-msg)))
+           (list pos end color))]))) ; record the highlight, to undo it later
+  (set! highlights (append new-highlights highlights)))
 
 (define remove-highlights-mixin
   (mixin ((class->interface text%)) ()