From a474eb9838d96ed7223f940a48f9d1503e5cafaf Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 26 Nov 2012 16:08:20 -0500
Subject: [PATCH] Report hidden parameter accesses.

---
 collects/typed-racket/optimizer/tool/mzc.rkt  | 47 +++++++++++++++++--
 .../typed-racket/optimizer/tool/report.rkt    |  2 +-
 2 files changed, 43 insertions(+), 6 deletions(-)

diff --git a/collects/typed-racket/optimizer/tool/mzc.rkt b/collects/typed-racket/optimizer/tool/mzc.rkt
index fd595d9d45..76a08d97d2 100644
--- a/collects/typed-racket/optimizer/tool/mzc.rkt
+++ b/collects/typed-racket/optimizer/tool/mzc.rkt
@@ -155,16 +155,22 @@
 ;; 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 profile)
+(define (post-process-inline-log log profile TR-log)
   (define hot-functions (and profile (prune-profile profile)))
   (define grouped-events
     (group-by equal? #:key log-entry-pos log)) ; right file, so that's enough
-  (apply append
-         (for/list ([group (in-list grouped-events)])
-           (process-function group profile hot-functions))))
+  (apply
+   append
+   (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.
-(define (process-function log profile hot-functions)
+(define (process-function log profile hot-functions TR-log)
   (define produced-entries '())
   (let/ec escape
     ;; 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
 
+(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)
   (+ (n-failures group) (- (n-out-of-fuels group) (n-successes group))))
 
diff --git a/collects/typed-racket/optimizer/tool/report.rkt b/collects/typed-racket/optimizer/tool/report.rkt
index e06de62370..ee0bb3835e 100644
--- a/collects/typed-racket/optimizer/tool/report.rkt
+++ b/collects/typed-racket/optimizer/tool/report.rkt
@@ -30,7 +30,7 @@
   (define-values (TR-log mzc-log) (generate-logs this))
   (log->report
    (append TR-log
-           (post-process-inline-log mzc-log profile))))
+           (post-process-inline-log mzc-log profile TR-log))))
 
 
 (define (generate-logs this)