suzanne.soy/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.
This commit is contained in:
Vincent St-Amour 2010-06-17 19:02:23 -04:00
parent 5d835ded47
commit 5e901b9ef2
1 changed files with 19 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3,7 +3,7 @@
(require syntax/parse (for-template scheme/base scheme/flonum scheme/unsafe/ops) (require syntax/parse (for-template scheme/base scheme/flonum scheme/unsafe/ops)
"../utils/utils.rkt" unstable/match scheme/match unstable/syntax "../utils/utils.rkt" unstable/match scheme/match unstable/syntax
(rep type-rep) (rep type-rep)
(types abbrev type-table utils)) (types abbrev type-table utils subtype))
(provide optimize) (provide optimize)
(define-syntax-class float-opt-expr (define-syntax-class float-opt-expr
@ -12,6 +12,20 @@
[(tc-result1: (== -Flonum type-equal?)) #t] [_ #f]) [(tc-result1: (== -Flonum type-equal?)) #t] [_ #f])
#:with opt #'e.opt)) #: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 (define-syntax-class float-binary-op
#:literals (+ - * / = <= < > >= min max #:literals (+ - * / = <= < > >= min max
fl+ fl- fl* fl/ fl= fl<= fl< fl> fl>= flmin flmax) fl+ fl- fl* fl/ fl= fl<= fl< fl> fl>= flmin flmax)
@ -63,7 +77,9 @@
(begin (log-optimization "unary float" #'op) (begin (log-optimization "unary float" #'op)
#'(op.unsafe f.opt))) #'(op.unsafe f.opt)))
;; unlike their safe counterparts, unsafe binary operators can only take 2 arguments ;; 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 ...) (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 #:with opt
(begin (log-optimization "binary float" #'op) (begin (log-optimization "binary float" #'op)
(for/fold ([o #'f1.opt]) (for/fold ([o #'f1.opt])