diff --git a/collects/typed-racket/optimizer/float.rkt b/collects/typed-racket/optimizer/float.rkt index 17c341b3..2c5c7d9a 100644 --- a/collects/typed-racket/optimizer/float.rkt +++ b/collects/typed-racket/optimizer/float.rkt @@ -261,33 +261,33 @@ #'(unsafe-fl- n.opt 1.0))) ;; warn about (potentially) exact real arithmetic, in general + ;; Note: These patterns don't perform optimization. They only produce logging + ;; for consumption by Optimization Coach. (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))) + #:when (maybe-exact-rational? this-syntax) #:with opt (begin (log-optimization-info "exact real arith" this-syntax) - this-syntax)) ; no change + this-syntax)) (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)))) + #:when (andmap maybe-exact-rational? (syntax->list #'(n ...))) #:with opt (begin (log-optimization-info "exact real arith" this-syntax) - this-syntax)) ; no change + this-syntax)) (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))) + #:when (maybe-exact-rational? this-syntax) #:with opt (begin (log-optimization-info "exact real arith" this-syntax) - this-syntax)) ; no change + this-syntax)) ) + +(define (maybe-exact-rational? stx) + (and (subtypeof? stx -Real) + (not (subtypeof? stx -Flonum)) + (not (subtypeof? stx -Int))))