Add logging infrastructure to log close calls.

original commit: 303e1f7f883be6ada89b665d58cf40eade568ec6

collects/typed-scheme/optimizer/optimizer.rkt

@@ -81,11 +81,11 @@
            #:with opt #'other))
 
 (define (optimize-top stx)
-  (let ((port (if (and *log-optimizations?*
-                       *log-optimizatons-to-log-file?*)
-                  (open-output-file *optimization-log-file*
-                                    #:exists 'append)
-                  (current-output-port))))
+  (let* ([log-file? (and (or *log-optimizations?* *log-close-calls?*)
+                         *log-to-log-file?*)]
+         [port (if log-file?
+                   (open-output-file *log-file* #:exists 'append)
+                   (current-output-port))])
     (begin0
       (parameterize ([current-output-port port]
                      [optimize (syntax-parser
@@ -100,6 +100,5 @@
           (when *show-optimized-code*
             (pretty-print (syntax->datum result)))
           result))
-      (when (and *log-optimizations?*
-                 *log-optimizatons-to-log-file?*)
+      (when log-file?
         (close-output-port port)))))

collects/typed-scheme/optimizer/utils.rkt

@@ -7,27 +7,42 @@
          (types type-table utils subtype)
          (rep type-rep))
 
-(provide log-optimization *log-optimizations?* *log-optimizatons-to-log-file?*
-         *optimization-log-file* *show-optimized-code*
+(provide *log-file* *log-to-log-file?* log-optimization *log-optimizations?*
+         log-close-call *log-close-calls?*
+         *show-optimized-code*
          subtypeof? isoftype?
          mk-unsafe-tbl
          n-ary->binary
          unboxed-gensym reset-unboxed-gensym
          optimize)
 
-(define *log-optimizations?*
-  (member "--log-optimizations"
-          (vector->list (current-command-line-arguments))))
-(define *log-optimizatons-to-log-file?* #f)
-(define *optimization-log-file* "opt-log")
+(define (in-command-line? opt)
+  (member opt (vector->list (current-command-line-arguments))))
+
+(define *log-file* "opt-log")
+(define *log-to-log-file?* #f) ; otherwise, goes to stdout
+
+(define (do-logging msg stx)
+  (printf "~a line ~a col ~a - ~a - ~a\n"
+          (syntax-source-file-name stx)
+          (syntax-line stx) (syntax-column stx)
+          (syntax->datum stx)
+          msg))
+
+(define *log-optimizations?* (in-command-line? "--log-optimizations"))
 (define (log-optimization kind stx)
-  (if *log-optimizations?*
-      (printf "~a line ~a col ~a - ~a - ~a\n"
-              (syntax-source-file-name stx)
-              (syntax-line stx) (syntax-column stx)
-              (syntax->datum stx)
-              kind)
-      #t))
+  (when *log-optimizations?*
+    (do-logging kind stx)))
+
+;; Keep track of optimizations that "almost" happened, with the intention
+;; of reporting them to the user.
+;; This is meant to help users understand what hurts the performance of
+;; their programs.
+(define *log-close-calls?* (in-command-line? "--log-close-calls"))
+(define (log-close-call kind stx)
+  (when *log-close-calls?*
+    (do-logging kind stx)))
+
 ;; if set to #t, the optimizer will dump its result to stdout before compilation
 (define *show-optimized-code* #f)