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

Improve TR's fixnum optimizations, using the new sub-fixnum types.

Browse Source 
original commit: 1f0386b46cc7ef08ac59d1d3453412f5eaf3f1e3
This commit is contained in:
Vincent St-Amour 2011-03-03 15:52:23 -05:00
parent cefc2bec81
commit c8a4abd264
8 changed files with 189 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/tests/typed-scheme/optimizer/tests/different-langs.rkt
View File

@ -1,10 +1,10 @@
#;
(
3
1/2
)
#lang typed/scheme
#:optimize
;; to see if the harness supports having the 2 versions of a test being
;; written in different languages
(+ 1 2)
(/ 1 2)

100
collects/tests/typed-scheme/optimizer/tests/fixnum-bounded-expr.rkt Normal file
View File

@ -0,0 +1,100 @@
#;
(
fixnum-bounded-expr.rkt line 60 col 3 - + - fixnum bounded expr
fixnum-bounded-expr.rkt line 66 col 8 - * - fixnum bounded expr
fixnum-bounded-expr.rkt line 66 col 3 - - - fixnum bounded expr
fixnum-bounded-expr.rkt line 73 col 3 - + - fixnum bounded expr
fixnum-bounded-expr.rkt line 76 col 3 - + - fixnum bounded expr
fixnum-bounded-expr.rkt line 81 col 1 - abs - fixnum bounded expr
fixnum-bounded-expr.rkt line 84 col 1 - fx+ - fixnum fx+
fixnum-bounded-expr.rkt line 85 col 6 - + - fixnum bounded expr
fixnum-bounded-expr.rkt line 85 col 17 - * - fixnum bounded expr
fixnum-bounded-expr.rkt line 85 col 1 - fx+ - fixnum fx+
fixnum-bounded-expr.rkt line 86 col 9 - + - fixnum bounded expr
fixnum-bounded-expr.rkt line 86 col 6 - + - fixnum bounded expr
fixnum-bounded-expr.rkt line 86 col 1 - fx+ - fixnum fx+
fixnum-bounded-expr.rkt line 87 col 12 - + - fixnum bounded expr
fixnum-bounded-expr.rkt line 87 col 9 - + - fixnum bounded expr
fixnum-bounded-expr.rkt line 87 col 1 - fx+ - fixnum fx+
fixnum-bounded-expr.rkt line 88 col 6 - + - fixnum bounded expr
fixnum-bounded-expr.rkt line 88 col 18 - + - fixnum bounded expr
fixnum-bounded-expr.rkt line 88 col 6 - + - fixnum bounded expr
fixnum-bounded-expr.rkt line 88 col 18 - + - fixnum bounded expr
fixnum-bounded-expr.rkt line 90 col 6 - + - fixnum bounded expr
fixnum-bounded-expr.rkt line 90 col 18 - + - fixnum bounded expr
fixnum-bounded-expr.rkt line 90 col 1 - fx- - fixnum fx-
fixnum-bounded-expr.rkt line 93 col 1 - fx* - fixnum fx*
fixnum-bounded-expr.rkt line 96 col 1 - fxquotient - fixnum fxquotient
fixnum-bounded-expr.rkt line 99 col 1 - fxabs - fixnum fxabs
28
89525
28
89525
291
291
291
45
3
7
865
284
284
1204
-2
-1
20
90000
-8
0
64235
4
)
#lang typed/racket
#:optimize
(require racket/fixnum)
(: f : Index Byte -> Nonnegative-Fixnum)
(define (f x y)
(+ x (sqr y)))
(f 3 5)
(f 35236 233)
(: g : Index Byte -> Fixnum)
(define (g x y)
(- x (* y y)))
(f 3 5)
(f 35236 233)
(let: ([x : Byte 45]
[y : Byte 246])
(+ x y))
(let: ([x : Index 45]
[y : Index 246])
(+ x y))
(let: ([x : Fixnum 45]
[y : Fixnum 246])
(+ x y)) ; this one can't be optimized, return type is not Fixnum
(abs 45) ; ok
(abs (ann -3 Fixnum)) ; not ok, result is not a fixnum
(fx+ 5 2)
(fx+ (+ 34 231) (* 24 25)) ; ok, (+ Index Index)
(fx+ (+ (+ 34 231) 23) -4) ; ok, (+ Nonnegative-Fixnum Nonnegative-Fixnum)
(fx+ -4 (+ (+ 34 231) 23)) ; ok, mirror case
(fx+ (+ 300 301) (+ 301 302)) ; not ok, (+ Fixnum Fixnum)
(fx- (+ 300 301) (+ 301 302)) ; ok, (+ Nonnegative-Fixnum Nonnegative-Fixnum)
(fx- (ann 3 Fixnum) (ann 4 Fixnum)) ; not ok
(fx* 4 5) ; ok, (* Byte Byte)
(fx* 300 300) ; not ok
(fxquotient (ann 34 Nonnegative-Fixnum) (ann -4 Fixnum))
(fxquotient -4 -5) ; not ok
(fxabs (ann 64235 Nonnegative-Fixnum)) ; ok
(fxabs -4) ; not ok

15
collects/tests/typed-scheme/optimizer/tests/float-complex-fixnum.rkt
View File

@ -1,12 +1,13 @@
#;
(
float-complex-fixnum.rkt line 16 col 4 - modulo - binary nonzero fixnum
float-complex-fixnum.rkt line 16 col 4 - modulo - binary nonzero fixnum
float-complex-fixnum.rkt line 16 col 3 - (#%app modulo (quote 2) (quote 1)) - float-coerce-expr in complex ops
float-complex-fixnum.rkt line 16 col 16 - 1.0+2.0i - unboxed literal
float-complex-fixnum.rkt line 16 col 25 - 3.0+6.0i - unboxed literal
float-complex-fixnum.rkt line 16 col 1 - + - unboxed binary float complex
float-complex-fixnum.rkt line 16 col 0 - (#%app + (#%app modulo (quote 2) (quote 1)) (quote 1.0+2.0i) (quote 3.0+6.0i)) - unboxed float complex
float-complex-fixnum.rkt line 17 col 4 - modulo - binary nonzero fixnum
float-complex-fixnum.rkt line 17 col 4 - modulo - binary nonzero fixnum
float-complex-fixnum.rkt line 17 col 4 - modulo - binary nonzero fixnum
float-complex-fixnum.rkt line 17 col 3 - (#%app modulo (quote 2) (quote 1)) - float-coerce-expr in complex ops
float-complex-fixnum.rkt line 17 col 16 - 1.0+2.0i - unboxed literal
float-complex-fixnum.rkt line 17 col 25 - 3.0+6.0i - unboxed literal
float-complex-fixnum.rkt line 17 col 1 - + - unboxed binary float complex
float-complex-fixnum.rkt line 17 col 0 - (#%app + (#%app modulo (quote 2) (quote 1)) (quote 1.0+2.0i) (quote 3.0+6.0i)) - unboxed float complex
4.0+8.0i
)

5
collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt
View File

@ -1,8 +1,9 @@
#;
(
float-promotion.rkt line 13 col 4 - modulo - binary nonzero fixnum
float-promotion.rkt line 13 col 1 - + - binary float
float-promotion.rkt line 14 col 4 - modulo - binary nonzero fixnum
float-promotion.rkt line 14 col 4 - modulo - binary nonzero fixnum
float-promotion.rkt line 14 col 1 - + - binary float
float-promotion.rkt line 15 col 1 - + - binary float
2.0
1e+200
)

2
collects/tests/typed-scheme/optimizer/tests/known-vector-length.rkt
View File

@ -1,7 +1,7 @@
#;
(
known-vector-length.rkt line 11 col 6 - vector-length - known-length vector-length
known-vector-length.rkt line 11 col 6 - vector-length - known-length vector-length
known-vector-length.rkt line 11 col 1 - + - fixnum bounded expr
4
)

13
collects/tests/typed-scheme/optimizer/tests/mpair.rkt
View File

@ -1,11 +1,12 @@
#;
(
mpair.rkt line 18 col 1 - mcar - mutable pair
mpair.rkt line 19 col 1 - mcdr - mutable pair
mpair.rkt line 20 col 1 - set-mcar! - mutable pair
mpair.rkt line 21 col 1 - set-mcdr! - mutable pair
mpair.rkt line 21 col 14 - + - binary float
mpair.rkt line 27 col 7 - mcar - mutable pair
mpair.rkt line 19 col 1 - mcar - mutable pair
mpair.rkt line 20 col 1 - mcdr - mutable pair
mpair.rkt line 21 col 1 - set-mcar! - mutable pair
mpair.rkt line 21 col 14 - + - fixnum bounded expr
mpair.rkt line 22 col 1 - set-mcdr! - mutable pair
mpair.rkt line 22 col 14 - + - binary float
mpair.rkt line 28 col 7 - mcar - mutable pair
1
1.0
)

8
collects/tests/typed-scheme/optimizer/tests/unary-fixnum-nested.rkt
View File

@ -1,11 +1,11 @@
#;
(
unary-fixnum-nested.rkt line 11 col 6 - bitwise-not - unary fixnum
unary-fixnum-nested.rkt line 11 col 1 - abs - unary fixnum
4
unary-fixnum-nested.rkt line 11 col 14 - bitwise-not - unary fixnum
unary-fixnum-nested.rkt line 11 col 1 - bitwise-not - unary fixnum
3
)
#lang typed/scheme
#:optimize
(abs (bitwise-not (length '(1 2 3))))
(bitwise-not (bitwise-not (length '(1 2 3))))

69
collects/typed-scheme/optimizer/fixnum.rkt
View File

@ -9,8 +9,8 @@
(provide fixnum-expr fixnum-opt-expr)
(define (mk-fixnum-tbl generic)
(mk-unsafe-tbl generic "fx~a" "unsafe-fx~a"))
(define (mk-fixnum-tbl generic [fx-specific-too? #t])
(mk-unsafe-tbl generic (if fx-specific-too? "fx~a" "~a") "unsafe-fx~a"))
;; due to undefined behavior when results are out of the fixnum range, only some
;; fixnum operations can be optimized
@ -31,8 +31,7 @@
#'fxxor #'unsafe-fxxor))
(define-syntax-class fixnum-unary-op
#:commit
(pattern (~or (~literal bitwise-not) (~literal fxnot)) #:with unsafe #'unsafe-fxnot)
(pattern (~or (~literal abs) (~literal fxabs)) #:with unsafe #'unsafe-fxabs))
(pattern (~or (~literal bitwise-not) (~literal fxnot)) #:with unsafe #'unsafe-fxnot))
;; closed on fixnums, but 2nd argument must not be 0
(define-syntax-class nonzero-fixnum-binary-op
#:commit
@ -40,6 +39,16 @@
(pattern (~or (~literal modulo) (~literal fxmodulo)) #:with unsafe #'unsafe-fxmodulo)
(pattern (~or (~literal remainder) (~literal fxremainder)) #:with unsafe #'unsafe-fxremainder))
;; these operations are not closed on fixnums, but we can sometimes guarantee
;; that results will be within fixnum range
;; if their return type is a subtype of Fixnum, we can optimize
;; obviously, we can't include fx-specific ops here, since their return type is
;; always Fixnum, and we rely on the error behavior if that would be violated
(define potentially-bounded-fixnum-ops
(mk-fixnum-tbl (list #'+ #'- #'* #'abs) #f))
(define potentially-bounded-nonzero-fixnum-ops
(mk-fixnum-tbl (list #'quotient #'remainder) #f))
(define-syntax-class (fixnum-op tbl)
#:commit
(pattern i:id
@ -91,4 +100,54 @@
(pattern (#%plain-app (~and op (~literal zero?)) n:fixnum-expr)
#:with opt
(begin (log-optimization "fixnum zero?" #'op)
#'(unsafe-fx= n.opt 0))))
#'(unsafe-fx= n.opt 0)))
;; The following are not closed on fixnums, but we can guarantee that results
;; won't exceed fixnum range in some cases.
;; (if they typecheck with return type Fixnum)
(pattern (#%plain-app (~var op (fixnum-op potentially-bounded-fixnum-ops))
ns:fixnum-expr ...)
#:when (subtypeof? this-syntax -Fixnum)
#:with opt
(begin (log-optimization "fixnum bounded expr" #'op)
(if (> (length (syntax->list #'(ns ...))) 2)
(let ([post-opt (syntax->list #'(ns.opt ...))])
(n-ary->binary #'op.unsafe
(car post-opt) (cadr post-opt) (cddr post-opt)))
#'(op.unsafe ns.opt ...))))
(pattern (#%plain-app (~var op (fixnum-op potentially-bounded-nonzero-fixnum-ops))
n1:fixnum-expr n2:nonzero-fixnum-expr)
#:when (subtypeof? this-syntax -Fixnum)
#:with opt
(begin (log-optimization "nonzero fixnum bounded expr" #'op)
#'(op.unsafe n1.opt n2.opt)))
;; for fx-specific ops, we need to mimic the typing rules of their generic
;; counterparts, since fx-specific ops rely on error behavior for typechecking
;; and thus their return type cannot be used directly for optimization
(pattern (#%plain-app (~and op (~literal fx+)) n1:fixnum-expr n2:fixnum-expr)
#:when (or (and (subtypeof? #'n1 -Index) (subtypeof? #'n2 -Index))
(and (subtypeof? #'n1 -NonNegFixnum) (subtypeof? #'n2 -NonPosFixnum))
(and (subtypeof? #'n1 -NonPosFixnum) (subtypeof? #'n2 -NonNegFixnum)))
#:with opt
(begin (log-optimization "fixnum fx+" #'op)
#'(unsafe-fx+ n1.opt n2.opt)))
(pattern (#%plain-app (~and op (~literal fx-)) n1:fixnum-expr n2:fixnum-expr)
#:when (and (subtypeof? #'n1 -NonNegFixnum) (subtypeof? #'n2 -NonNegFixnum))
#:with opt
(begin (log-optimization "fixnum fx-" #'op)
#'(unsafe-fx- n1.opt n2.opt)))
(pattern (#%plain-app (~and op (~literal fx*)) n1:fixnum-expr n2:fixnum-expr)
#:when (and (subtypeof? #'n1 -Byte) (subtypeof? #'n2 -Byte))
#:with opt
(begin (log-optimization "fixnum fx*" #'op)
#'(unsafe-fx* n1.opt n2.opt)))
(pattern (#%plain-app (~and op (~literal fxquotient)) n1:fixnum-expr n2:fixnum-expr)
#:when (and (subtypeof? #'n1 -NonNegFixnum) (subtypeof? #'n2 -Fixnum))
#:with opt
(begin (log-optimization "fixnum fxquotient" #'op)
#'(unsafe-fxquotient n1.opt n2.opt)))
(pattern (#%plain-app (~and op (~literal fxabs)) n:fixnum-expr)
#:when (subtypeof? #'n -NonNegFixnum) ; (abs min-fixnum) is not a fixnum
#:with opt
(begin (log-optimization "fixnum fxabs" #'op)
#'(unsafe-fxabs n.opt))))