close-call -> missed-optimization
original commit: b598c4a1ebbe6eae71384355d2b0f55d0bed6fa7
This commit is contained in:
parent
7600062905
commit
5d201843e5
|
@ -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)
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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"))))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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])))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user