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

Fixed the behavior of the optimizer on sqrt.

Browse Source 
original commit: 351de3f767cd7b32fe75963e206c7c8da379d26b
This commit is contained in:
Vincent St-Amour 2010-07-01 14:12:42 -04:00
parent 1ebe111f88
commit fbf7cbd494
3 changed files with 18 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/tests/typed-scheme/optimizer/generic/invalid-sqrt.rkt Normal file
View File

@ -0,0 +1,2 @@
(module invalid-sqrt typed/scheme #:optimize
(sqrt -2.0)) ; not a nonnegative flonum, can't optimize

5
collects/tests/typed-scheme/optimizer/generic/sqrt.rkt Normal file
View File

@ -0,0 +1,5 @@
(module sqrt typed/scheme #:optimize
(require racket/unsafe/ops)
(: f (Nonnegative-Float -> Nonnegative-Float))
(define (f x)
(sqrt x)))

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

@ -6,26 +6,24 @@
(types abbrev type-table utils subtype))
(provide optimize)
;; for use in match
(define (subtypeof x y)
(subtype y x))
;; is the syntax object s's type a subtype of t?
(define (subtypeof s t)
(match (type-of s)
[(tc-result1: (== t (lambda (x y) (subtype y x)))) #t] [_ #f]))
(define-syntax-class float-opt-expr
(pattern e:opt-expr
#:when (match (type-of #'e)
[(tc-result1: (== -Flonum subtypeof)) #t] [_ #f])
#:when (subtypeof #'e -Flonum)
#:with opt #'e.opt))
(define-syntax-class int-opt-expr
(pattern e:opt-expr
#:when (match (type-of #'e)
[(tc-result1: (== -Integer subtypeof)) #t] [_ #f])
#:when (subtypeof #'e -Integer)
#:with opt #'e.opt))
(define-syntax-class fixnum-opt-expr
(pattern e:opt-expr
#:when (match (type-of #'e)
[(tc-result1: (== -Fixnum subtypeof)) #t] [_ #f])
#:when (subtypeof #'e -Fixnum)
#:with opt #'e.opt))
(define-syntax-class nonzero-fixnum-opt-expr
(pattern e:opt-expr
@ -151,14 +149,14 @@
#:literal-sets (kernel-literals)
;; interesting cases, where something is optimized
(pattern (#%plain-app (~var op (float-op unary-float-ops)) f:float-opt-expr)
(pattern (~and res (#%plain-app (~var op (float-op unary-float-ops)) f:float-opt-expr))
#:when (subtypeof #'res -Flonum)
#:with opt
(begin (log-optimization "unary float" #'op)
#'(op.unsafe f.opt)))
(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 subtypeof)) #t] [_ #f])
;; if the result is a float, we can coerce integers to floats and optimize
#:when (subtypeof #'res -Flonum)
#:with opt
(begin (log-optimization "binary float" #'op)
(n-ary->binary #'op.unsafe #'f1.opt #'f2.opt #'(fs.opt ...))))