From c8a4abd264a8704402b2e9be7f3fda720dc3eac1 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Thu, 3 Mar 2011 15:52:23 -0500 Subject: [PATCH] Improve TR's fixnum optimizations, using the new sub-fixnum types. original commit: 1f0386b46cc7ef08ac59d1d3453412f5eaf3f1e3 --- .../optimizer/tests/different-langs.rkt | 4 +- .../optimizer/tests/fixnum-bounded-expr.rkt | 100 ++++++++++++++++++ .../optimizer/tests/float-complex-fixnum.rkt | 15 +-- .../optimizer/tests/float-promotion.rkt | 5 +- .../optimizer/tests/known-vector-length.rkt | 2 +- .../typed-scheme/optimizer/tests/mpair.rkt | 13 +-- .../optimizer/tests/unary-fixnum-nested.rkt | 8 +- collects/typed-scheme/optimizer/fixnum.rkt | 69 +++++++++++- 8 files changed, 189 insertions(+), 27 deletions(-) create mode 100644 collects/tests/typed-scheme/optimizer/tests/fixnum-bounded-expr.rkt diff --git a/collects/tests/typed-scheme/optimizer/tests/different-langs.rkt b/collects/tests/typed-scheme/optimizer/tests/different-langs.rkt index cee704bb..c6fe02b7 100644 --- a/collects/tests/typed-scheme/optimizer/tests/different-langs.rkt +++ b/collects/tests/typed-scheme/optimizer/tests/different-langs.rkt @@ -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) diff --git a/collects/tests/typed-scheme/optimizer/tests/fixnum-bounded-expr.rkt b/collects/tests/typed-scheme/optimizer/tests/fixnum-bounded-expr.rkt new file mode 100644 index 00000000..199b8245 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/tests/fixnum-bounded-expr.rkt @@ -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 diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-fixnum.rkt b/collects/tests/typed-scheme/optimizer/tests/float-complex-fixnum.rkt index 0d565583..3846c610 100644 --- a/collects/tests/typed-scheme/optimizer/tests/float-complex-fixnum.rkt +++ b/collects/tests/typed-scheme/optimizer/tests/float-complex-fixnum.rkt @@ -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 ) diff --git a/collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt b/collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt index 383a9a05..09a956c5 100644 --- a/collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt +++ b/collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt @@ -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 ) diff --git a/collects/tests/typed-scheme/optimizer/tests/known-vector-length.rkt b/collects/tests/typed-scheme/optimizer/tests/known-vector-length.rkt index c1503b60..ca37593f 100644 --- a/collects/tests/typed-scheme/optimizer/tests/known-vector-length.rkt +++ b/collects/tests/typed-scheme/optimizer/tests/known-vector-length.rkt @@ -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 ) diff --git a/collects/tests/typed-scheme/optimizer/tests/mpair.rkt b/collects/tests/typed-scheme/optimizer/tests/mpair.rkt index ae62abbb..6cf8381b 100644 --- a/collects/tests/typed-scheme/optimizer/tests/mpair.rkt +++ b/collects/tests/typed-scheme/optimizer/tests/mpair.rkt @@ -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 ) diff --git a/collects/tests/typed-scheme/optimizer/tests/unary-fixnum-nested.rkt b/collects/tests/typed-scheme/optimizer/tests/unary-fixnum-nested.rkt index ff5a1212..6ce57123 100644 --- a/collects/tests/typed-scheme/optimizer/tests/unary-fixnum-nested.rkt +++ b/collects/tests/typed-scheme/optimizer/tests/unary-fixnum-nested.rkt @@ -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)))) diff --git a/collects/typed-scheme/optimizer/fixnum.rkt b/collects/typed-scheme/optimizer/fixnum.rkt index 37ff249f..c8ee0533 100644 --- a/collects/typed-scheme/optimizer/fixnum.rkt +++ b/collects/typed-scheme/optimizer/fixnum.rkt @@ -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))))