suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Use racket's logging facilities for the optimizer logs.

Browse Source 
original commit: 7347da4919ca6c5a7496992c5cd9f0e83d215b5b
This commit is contained in:
Vincent St-Amour 2011-05-31 17:14:10 -04:00
parent f3e69a8ac4
commit 8b52f84497
2 changed files with 22 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
collects/typed-scheme/optimizer/optimizer.rkt
View File

@ -81,28 +81,18 @@
#:with opt #'other))
(define (optimize-top stx)
(let* ([log? (or *log-optimizations?* *log-missed-optimizations?*)]
[log-file? (and log? *log-to-log-file?*)]
[port (if log-file?
(open-output-file *log-file* #:exists 'append)
(current-output-port))])
(when log? ; Reset log. We don't want to accumulate after each top-level expression.
(clear-log))
(begin0
(parameterize ([current-output-port port]
[optimize (syntax-parser
[e:expr
#:when (and (not (syntax-property #'e 'typechecker:ignore))
(not (syntax-property #'e 'typechecker:ignore-some))
(not (syntax-property #'e 'typechecker:with-handlers)))
#:with e*:opt-expr #'e
#'e*.opt]
[e:expr #'e])])
(clear-log) ; Reset log. We don't want to accumulate after each top-level expression.
(begin0
(parameterize ([optimize (syntax-parser
[e:expr
#:when (and (not (syntax-property #'e 'typechecker:ignore))
(not (syntax-property #'e 'typechecker:ignore-some))
(not (syntax-property #'e 'typechecker:with-handlers)))
#:with e*:opt-expr #'e
#'e*.opt]
[e:expr #'e])])
(let ((result ((optimize) stx)))
(when *show-optimized-code*
(pretty-print (syntax->datum result)))
result))
(when log?
(print-log))
(when log-file?
(close-output-port port)))))
(print-log))) ; Now that we have the full log for this top-level expression, print it in order.

34
collects/typed-scheme/optimizer/utils.rkt
View File

@ -7,8 +7,7 @@
(types type-table utils subtype)
(rep type-rep))
(provide *log-file* *log-to-log-file?* log-optimization *log-optimizations?*
log-missed-optimization *log-missed-optimizations?*
(provide log-optimization log-missed-optimization
print-log clear-log
*show-optimized-code*
subtypeof? isoftype?
@ -17,12 +16,6 @@
unboxed-gensym reset-unboxed-gensym
optimize)
(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 (line+col->string stx)
(let ([line (syntax-line stx)]
[col (syntax-column stx)])
@ -37,7 +30,7 @@
;; a problem per se)
(define log-so-far (set))
(define (do-logging msg stx)
(let* ([new-message (format "~a ~a ~a -- ~a\n"
(let* ([new-message (format "~a ~a ~a -- ~a"
(syntax-source-file-name stx)
(line+col->string stx)
(syntax->datum stx)
@ -50,7 +43,7 @@
;; once the optimizer is done, we sort the log according to source
;; location, then print it
(define (print-log)
(for-each (lambda (x) (display (log-entry-msg x)))
(for-each (lambda (x) (log-warning (log-entry-msg x)))
(sort (set->list log-so-far)
(lambda (x y)
(match* (x y)
@ -74,25 +67,20 @@
(define (clear-log)
(set! log-so-far (set)))
(define *log-optimizations?* (in-command-line? "--log-optimizations"))
(define (log-optimization kind stx)
(when *log-optimizations?*
(do-logging kind stx)))
(define (log-optimization kind stx) (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-missed-optimizations?* (in-command-line? "--log-missed-optimizations"))
(define (log-missed-optimization kind stx [irritant #f])
(when *log-missed-optimizations?*
(do-logging (if irritant
(format "~a -- caused by: ~a ~a"
kind
(line+col->string irritant)
(syntax->datum irritant))
kind)
stx)))
(do-logging (if irritant
(format "~a -- caused by: ~a ~a"
kind
(line+col->string irritant)
(syntax->datum irritant))
kind)
stx))
;; if set to #t, the optimizer will dump its result to stdout before compilation
(define *show-optimized-code* #f)