Report potential exact rational arithmetic in hot code.

This commit is contained in:
Vincent St-Amour 2012-10-20 12:15:18 -04:00
parent 6e9ed24eae
commit 4271675f69
2 changed files with 50 additions and 1 deletions

View File

@ -258,4 +258,36 @@
#:with opt
(begin (log-optimization "float sub1" float-opt-msg this-syntax)
(add-disappeared-use #'op)
#'(unsafe-fl- n.opt 1.0))))
#'(unsafe-fl- n.opt 1.0)))
;; warn about (potentially) exact real arithmetic, in general
(pattern (#%plain-app (~var op (float-op binary-float-ops))
n ...)
#:when (and (subtypeof? this-syntax -Real)
(not (subtypeof? this-syntax -Flonum))
(not (subtypeof? this-syntax -Int)))
#:with opt
(begin (log-optimization-info "exact real arith"
this-syntax)
this-syntax)) ; no change
(pattern (#%plain-app (~var op (float-op binary-float-comps))
n ...)
;; can't look at return type, since it's always bool
#:when (for/and ([arg (syntax->list #'(n ...))])
(and (subtypeof? arg -Real)
(not (subtypeof? arg -Flonum))
(not (subtypeof? arg -Int))))
#:with opt
(begin (log-optimization-info "exact real arith"
this-syntax)
this-syntax)) ; no change
(pattern (#%plain-app (~var op (float-op unary-float-ops))
n ...)
#:when (and (subtypeof? this-syntax -Real)
(not (subtypeof? this-syntax -Flonum))
(not (subtypeof? this-syntax -Int)))
#:with opt
(begin (log-optimization-info "exact real arith"
this-syntax)
this-syntax)) ; no change
)

View File

@ -406,6 +406,23 @@
'() '()
20)))) ;; TODO have actual badness
(when inside-hot-function?
(for ([TR-entry (in-list TR-log)]
#:when (info-log-entry? TR-entry)
#:when (equal? (log-entry-kind TR-entry) "exact real arith")
#:when (pos-inside-us? (log-entry-pos TR-entry)))
(emit (missed-opt-log-entry
"" ; kind not used at this point
(string-append
"This expression may use exact rational arithmetic, which is inefficient. "
"You can avoid this by using operations that don't return fractional "
;; TODO don't hard-code `quotient', show the right one depending on the operation
"results, such as `quotient', or using floating-point numbers.")
(log-entry-located-stx TR-entry) (log-entry-located-stx TR-entry)
(log-entry-pos TR-entry) 'typed-racket
'() '()
20)))) ;; TODO have actual badness
produced-entries)
(define (group-badness group)