close-call -> missed-optimization

original commit: b598c4a1ebbe6eae71384355d2b0f55d0bed6fa7
This commit is contained in:
Vincent St-Amour 2011-05-17 16:43:57 -04:00
parent 7600062905
commit 5d201843e5
13 changed files with 40 additions and 40 deletions

View File

@ -121,8 +121,8 @@
(lambda (p thnk) (check-not-exn thnk))]
[(equal? dir "optimizer/tests/")
(lambda (p* thnk) (test-opt p))]
[(equal? dir "optimizer/close-calls/")
(lambda (p* thnk) (test-close-call p))])))
[(equal? dir "optimizer/missed-optimizations/")
(lambda (p* thnk) (test-missed-optimization p))])))
(test-suite
(path->string p)
(f
@ -141,4 +141,4 @@
(provide go go/text just-one
int-tests unit-tests compile-benchmarks
optimization-tests close-call-tests)
optimization-tests missed-optimization-tests)

View File

@ -2,8 +2,8 @@
(require racket/runtime-path
rackunit rackunit/text-ui)
(provide optimization-tests close-call-tests
test-opt test-close-call)
(provide optimization-tests missed-optimization-tests
test-opt test-missed-optimization)
(define (generate-log name dir flags)
;; some tests require other tests, so some fiddling is required
@ -38,14 +38,14 @@
(read)))))))
(define-runtime-path tests-dir "./tests")
(define-runtime-path close-calls-dir "./close-calls")
(define-runtime-path tests-dir "./tests")
(define-runtime-path missed-optimizations-dir "./missed-optimizations")
;; these two return lists of tests to be run for that category of tests
(define (test-opt name)
(list (compare-logs name tests-dir '#("--log-optimizations"))))
(define (test-close-call name)
(list (compare-logs name close-calls-dir '#("--log-close-calls"))))
(define (test-missed-optimization name)
(list (compare-logs name missed-optimizations-dir '#("--log-missed-optimizations"))))
;; proc returns the list of tests to be run on each file
(define (mk-suite suite-name dir proc)
@ -61,5 +61,5 @@
(define optimization-tests
(mk-suite "Optimization Tests" tests-dir test-opt))
(define close-call-tests
(mk-suite "Close Call Tests" close-calls-dir test-close-call))
(define missed-optimization-tests
(mk-suite "Missed Optimization Tests" missed-optimizations-dir test-missed-optimization))

View File

@ -8,7 +8,7 @@
(define unit? (make-parameter #f))
(define int? (make-parameter #f))
(define opt? (make-parameter #f))
(define close-calls? (make-parameter #f))
(define missed-opt? (make-parameter #f))
(define bench? (make-parameter #f))
(define single (make-parameter #f))
(current-namespace (make-base-namespace))
@ -17,11 +17,11 @@
["--unit" "run the unit tests" (unit? #t)]
["--int" "run the integration tests" (int? #t)]
["--opt" "run the optimization tests" (opt? #t)]
["--close-calls" "run the close call tests" (close-calls? #t)]
["--missed-opt" "run the missed optimization tests" (missed-opt? #t)]
["--benchmarks" "compile the typed benchmarks" (bench? #t)]
["--just" path "run only this test" (single (just-one path))]
["--nightly" "for the nightly builds" (begin (nightly? #t) (unit? #t) (opt? #t))]
["--all" "run all tests" (begin (unit? #t) (int? #t) (opt? #t) (close-calls? #t) (bench? #t))]
["--all" "run all tests" (begin (unit? #t) (int? #t) (opt? #t) (missed-opt? #t) (bench? #t))]
["--gui" "run using the gui"
(if (gui-available?)
(begin (exec go))
@ -33,10 +33,10 @@
[else
(make-test-suite
"Typed Racket Tests"
(append (if (unit?) (list unit-tests) '())
(if (int?) (list int-tests) '())
(if (opt?) (list optimization-tests) '())
(if (close-calls?) (list close-call-tests) '())
(if (bench?) (list (compile-benchmarks)) '())))])])
(append (if (unit?) (list unit-tests) '())
(if (int?) (list int-tests) '())
(if (opt?) (list optimization-tests) '())
(if (missed-opt?) (list missed-optimization-tests) '())
(if (bench?) (list (compile-benchmarks)) '())))])])
(unless (= 0 ((exec) to-run))
(eprintf "Typed Racket Tests did not pass.\n"))))

View File

@ -378,8 +378,8 @@
#:when (when (and (in-complex-layer? #'e)
(for/and ([subexpr (in-list (syntax->list #'(e.args ...)))])
(subtypeof? subexpr -Real)))
(log-close-call "unexpected complex value"
this-syntax #'e.op))
(log-missed-optimization "unexpected complex value"
this-syntax #'e.op))
;; We don't actually want to match.
#:when #f
#:with real-binding #'#f ; required, otherwise syntax/parse is not happy

View File

@ -91,14 +91,14 @@
;; opportunity, report it
;; ignore operations that stay within integers or rationals, since
;; these have nothing to do with float optimizations
[close-call? (and (not safe-to-opt?)
(in-real-layer? this-syntax))])
(when close-call?
(log-close-call "binary, args all float-arg-expr, return type not Float"
this-syntax
(for/first ([x (in-list (syntax->list #'(f1 f2 fs ...)))]
#:when (not (subtypeof? x -Flonum)))
x)))
[missed-optimization? (and (not safe-to-opt?)
(in-real-layer? this-syntax))])
(when missed-optimization?
(log-missed-optimization "binary, args all float-arg-expr, return type not Float"
this-syntax
(for/first ([x (in-list (syntax->list #'(f1 f2 fs ...)))]
#:when (not (subtypeof? x -Flonum)))
x)))
;; If an optimization was expected (whether it was safe or not doesn't matter),
;; report subexpressions doing expensive exact arithmetic (Exact-Rational and
;; Real arithmetic), since that extra precision would be "lost" by going to
@ -107,7 +107,7 @@
;; but it's more likely to be there by accident. I can't really think of many
;; use cases for computing exact intermediate results, then converting them to
;; floats at the end.
(when (or safe-to-opt? close-call?)
(when (or safe-to-opt? missed-optimization?)
(for ([subexpr (in-list (syntax->list #'(f1 f2 fs ...)))]
#:when (or (in-real-layer? subexpr)
(in-rational-layer? subexpr)))
@ -118,7 +118,7 @@
;; (vector-ref vector-of-rationals x)
;; which don't perform arithmetic despite returning numbers.
[e:arith-expr
(log-close-call
(log-missed-optimization
"exact arithmetic subexpression inside a float expression, extra precision discarded"
subexpr this-syntax)]
[_ #f])))

View File

@ -81,7 +81,7 @@
#:with opt #'other))
(define (optimize-top stx)
(let* ([log-file? (and (or *log-optimizations?* *log-close-calls?*)
(let* ([log-file? (and (or *log-optimizations?* *log-missed-optimizations?*)
*log-to-log-file?*)]
[port (if log-file?
(open-output-file *log-file* #:exists 'append)

View File

@ -45,8 +45,8 @@
;; it has to be a list, otherwise, there would have been
;; a type error
(begin
(log-close-call "car/cdr on a potentially empty list"
this-syntax #'p)
(log-missed-optimization "car/cdr on a potentially empty list"
this-syntax #'p)
#f))
#:with opt
(begin (log-optimization "pair" #'op)
@ -54,8 +54,8 @@
(pattern (#%plain-app op:mpair-op p:expr e:expr ...)
#:when (or (has-mpair-type? #'p)
(begin
(log-close-call "mpair op on a potentially empty mlist"
this-syntax #'p)
(log-missed-optimization "mpair op on a potentially empty mlist"
this-syntax #'p)
#f))
#:with opt
(begin (log-optimization "mutable pair" #'op)

View File

@ -8,7 +8,7 @@
(rep type-rep))
(provide *log-file* *log-to-log-file?* log-optimization *log-optimizations?*
log-close-call *log-close-calls?*
log-missed-optimization *log-missed-optimizations?*
*show-optimized-code*
subtypeof? isoftype?
mk-unsafe-tbl
@ -45,9 +45,9 @@
;; 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 [irritant #f])
(when *log-close-calls?*
(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