diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt index f385fc38..0b74e9e4 100644 --- a/collects/typed-scheme/optimizer/optimizer.rkt +++ b/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))))) diff --git a/collects/typed-scheme/optimizer/utils.rkt b/collects/typed-scheme/optimizer/utils.rkt index 354a236c..ea6c8eb7 100644 --- a/collects/typed-scheme/optimizer/utils.rkt +++ b/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)