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

Fixed the optimizer so that it optimizes float comparisons.

Browse Source 
original commit: 382a45ad6fe99f758451631b07fac393333893a8
This commit is contained in:
Vincent St-Amour 2010-06-24 18:47:42 -04:00
parent fe3ce60a26
commit e96760613b
1 changed files with 12 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/typed-scheme/private/optimize.rkt
View File

@ -34,7 +34,9 @@
(dict-set (dict-set h g u) f u))))
(define binary-float-ops
(mk-float-tbl (list #'+ #'- #'* #'/ #'= #'<= #'< #'> #'>= #'min #'max)))
(mk-float-tbl (list #'+ #'- #'* #'/ #'min #'max)))
(define binary-float-comps
(mk-float-tbl (list #'= #'<= #'< #'> #'>=)))
(define unary-float-ops
(mk-float-tbl (list #'abs #'sin #'cos #'tan #'asin #'acos #'atan #'log #'exp
@ -94,12 +96,21 @@
;; unlike their safe counterparts, unsafe binary operators can only take 2 arguments
(pattern (~and res (#%plain-app (~var op (float-op binary-float-ops)) f1:float-arg-expr f2:float-arg-expr fs:float-arg-expr ...))
#:when (match (type-of #'res)
;; if the result is a float, we can coerce integers to floats and optimize
[(tc-result1: (== -Flonum type-equal?)) #t] [_ #f])
#:with opt
(begin (log-optimization "binary float" #'op)
(for/fold ([o #'f1.opt])
([e (syntax->list #'(f2.opt fs.opt ...))])
#`(op.unsafe #,o #,e))))
(pattern (~and res (#%plain-app (~var op (float-op binary-float-comps)) f1:float-opt-expr f2:float-opt-expr fs:float-opt-expr ...))
#:when (match (type-of #'res)
[(tc-result1: (== -Boolean type-equal?)) #t] [_ #f])
#:with opt
(begin (log-optimization "binary float comp" #'op)
(for/fold ([o #'f1.opt])
([e (syntax->list #'(f2.opt fs.opt ...))])
#`(op.unsafe #,o #,e))))
;; we can optimize exact->inexact if we know we're giving it an Integer
(pattern (#%plain-app (~and op (~literal exact->inexact)) n:int-opt-expr)