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

The optimizer now promotes integers to floats when they are used as

Browse Source 
arguments to a function whose result is a float.

original commit: 5e901b9ef28a9d48f41fb05e7e4be57b34897180
This commit is contained in:
Vincent St-Amour 2010-06-17 19:02:23 -04:00
parent a4b8973528
commit 034e27a280
1 changed files with 19 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3,7 +3,7 @@
(require syntax/parse (for-template scheme/base scheme/flonum scheme/unsafe/ops)
"../utils/utils.rkt" unstable/match scheme/match unstable/syntax
(rep type-rep)
(types abbrev type-table utils))
(types abbrev type-table utils subtype))
(provide optimize)
(define-syntax-class float-opt-expr
@ -12,6 +12,20 @@
[(tc-result1: (== -Flonum type-equal?)) #t] [_ #f])
#:with opt #'e.opt))
;; if the result of an operation is of type float, its non float arguments
;; can be promoted, and we can use unsafe float operations
;; note: none of the unary operations have types where non-float arguments
;; can result in float (as opposed to real) results
(define-syntax-class float-arg-expr
(pattern e:opt-expr
#:when (match (type-of #'e)
[(tc-result1: (== -Integer (lambda (x y) (subtype y x)))) #t] [_ #f])
#:with opt #'(->fl e.opt))
(pattern e:opt-expr
#:when (match (type-of #'e)
[(tc-result1: (== -Flonum type-equal?)) #t] [_ #f])
#:with opt #'e.opt))
(define-syntax-class float-binary-op
#:literals (+ - * / = <= < > >= min max
fl+ fl- fl* fl/ fl= fl<= fl< fl> fl>= flmin flmax)
@ -63,8 +77,10 @@
(begin (log-optimization "unary float" #'op)
#'(op.unsafe f.opt)))
;; unlike their safe counterparts, unsafe binary operators can only take 2 arguments
(pattern (#%plain-app op:float-binary-op f1:float-opt-expr f2:float-opt-expr fs:float-opt-expr ...)
#:with opt
(pattern (~and res (#%plain-app op:float-binary-op f1:float-arg-expr f2:float-arg-expr fs:float-arg-expr ...))
#:when (match (type-of #'res)
[(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 ...))])