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

Refactor arithmetic hidden cost logging.

Browse Source 
original commit: 50777aaca4b580173c9f618f9c2f65fd9463dc8c
This commit is contained in:
Vincent St-Amour 2012-11-29 18:11:56 -05:00
parent 5111bed780
commit f5e1e7bbfd
1 changed files with 13 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/typed-racket/optimizer/float.rkt
View File

@ -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))))