diff --git a/collects/tests/typed-scheme/optimizer/missed-optimizations/fixnum.rkt b/collects/tests/typed-scheme/optimizer/missed-optimizations/fixnum.rkt new file mode 100644 index 0000000000..a5642281d5 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/missed-optimizations/fixnum.rkt @@ -0,0 +1,38 @@ +#; +( +TR opt: fixnum.rkt 29:10 (* x y) -- fixnum bounded expr +TR missed opt: fixnum.rkt 32:0 (+ (ann z Fixnum) 234) -- out of fixnum range +TR missed opt: fixnum.rkt 33:0 (* (ann x Index) (ann y Index)) -- out of fixnum range +TR missed opt: fixnum.rkt 34:0 (fx* (ann x Index) (ann y Index)) -- out of fixnum range +TR missed opt: fixnum.rkt 35:0 (abs (ann -3 Fixnum)) -- out of fixnum range +TR missed opt: fixnum.rkt 36:0 (+ (+ 300 301) (+ 301 302)) -- out of fixnum range +TR opt: fixnum.rkt 36:3 (+ 300 301) -- fixnum bounded expr +TR opt: fixnum.rkt 36:15 (+ 301 302) -- fixnum bounded expr +TR missed opt: fixnum.rkt 37:0 (fx+ (+ 300 301) (+ 301 302)) -- out of fixnum range +TR opt: fixnum.rkt 37:5 (+ 300 301) -- fixnum bounded expr +TR opt: fixnum.rkt 37:17 (+ 301 302) -- fixnum bounded expr +TR missed opt: fixnum.rkt 38:0 (fxquotient -4 -5) -- out of fixnum range +468 +234 +234 +3 +1204 +1204 +0 +) +#lang typed/racket + +(require racket/fixnum) + +(define x 3) +(define y 78) +(define z (* x y)) ; this should be optimized + +;; this should not, (+ Fixnum Byte), but it may look like it should +(+ (ann z Fixnum) 234) +(* (ann x Index) (ann y Index)) +(fx* (ann x Index) (ann y Index)) +(abs (ann -3 Fixnum)) +(+ (+ 300 301) (+ 301 302)) +(fx+ (+ 300 301) (+ 301 302)) +(fxquotient -4 -5) diff --git a/collects/tests/typed-scheme/optimizer/tests/fixnum-bounded-expr.rkt b/collects/tests/typed-scheme/optimizer/tests/fixnum-bounded-expr.rkt index d22251bc6e..66c923c073 100644 --- a/collects/tests/typed-scheme/optimizer/tests/fixnum-bounded-expr.rkt +++ b/collects/tests/typed-scheme/optimizer/tests/fixnum-bounded-expr.rkt @@ -1,29 +1,36 @@ #; ( -TR opt: fixnum-bounded-expr.rkt 60:2 (+ x (sqr y)) -- fixnum bounded expr -TR opt: fixnum-bounded-expr.rkt 66:2 (- x (* y y)) -- fixnum bounded expr -TR opt: fixnum-bounded-expr.rkt 66:7 (* y y) -- fixnum bounded expr -TR opt: fixnum-bounded-expr.rkt 73:2 (+ x y) -- fixnum bounded expr -TR opt: fixnum-bounded-expr.rkt 76:2 (+ x y) -- fixnum bounded expr -TR opt: fixnum-bounded-expr.rkt 81:0 (abs 45) -- fixnum fxabs -TR opt: fixnum-bounded-expr.rkt 84:0 (fx+ 5 2) -- fixnum fx+ -TR opt: fixnum-bounded-expr.rkt 85:0 (fx+ (+ 34 231) (* 24 25)) -- fixnum fx+ -TR opt: fixnum-bounded-expr.rkt 85:5 (+ 34 231) -- fixnum bounded expr -TR opt: fixnum-bounded-expr.rkt 85:16 (* 24 25) -- fixnum bounded expr -TR opt: fixnum-bounded-expr.rkt 86:0 (fx+ (+ (+ 34 231) 23) -4) -- fixnum fx+ -TR opt: fixnum-bounded-expr.rkt 86:5 (+ (+ 34 231) 23) -- fixnum bounded expr -TR opt: fixnum-bounded-expr.rkt 86:8 (+ 34 231) -- fixnum bounded expr -TR opt: fixnum-bounded-expr.rkt 87:0 (fx+ -4 (+ (+ 34 231) 23)) -- fixnum fx+ -TR opt: fixnum-bounded-expr.rkt 87:8 (+ (+ 34 231) 23) -- fixnum bounded expr -TR opt: fixnum-bounded-expr.rkt 87:11 (+ 34 231) -- fixnum bounded expr -TR opt: fixnum-bounded-expr.rkt 88:5 (+ 300 301) -- fixnum bounded expr -TR opt: fixnum-bounded-expr.rkt 88:17 (+ 301 302) -- fixnum bounded expr -TR opt: fixnum-bounded-expr.rkt 90:0 (fx- (+ 300 301) (+ 301 302)) -- fixnum fx- -TR opt: fixnum-bounded-expr.rkt 90:5 (+ 300 301) -- fixnum bounded expr -TR opt: fixnum-bounded-expr.rkt 90:17 (+ 301 302) -- fixnum bounded expr -TR opt: fixnum-bounded-expr.rkt 93:0 (fx* 4 5) -- fixnum fx* -TR opt: fixnum-bounded-expr.rkt 96:0 (fxquotient (ann 34 Nonnegative-Fixnum) (ann -4 Fixnum)) -- fixnum fxquotient -TR opt: fixnum-bounded-expr.rkt 99:0 (fxabs (ann 64235 Nonnegative-Fixnum)) -- fixnum fxabs +TR opt: fixnum-bounded-expr.rkt 67:2 (+ x (sqr y)) -- fixnum bounded expr +TR opt: fixnum-bounded-expr.rkt 73:2 (- x (* y y)) -- fixnum bounded expr +TR opt: fixnum-bounded-expr.rkt 73:7 (* y y) -- fixnum bounded expr +TR opt: fixnum-bounded-expr.rkt 80:2 (+ x y) -- fixnum bounded expr +TR opt: fixnum-bounded-expr.rkt 83:2 (+ x y) -- fixnum bounded expr +TR missed opt: fixnum-bounded-expr.rkt 86:2 (+ x y) -- out of fixnum range +TR opt: fixnum-bounded-expr.rkt 88:0 (abs 45) -- fixnum fxabs +TR missed opt: fixnum-bounded-expr.rkt 89:0 (abs (ann -3 Fixnum)) -- out of fixnum range +TR opt: fixnum-bounded-expr.rkt 91:0 (fx+ 5 2) -- fixnum fx+ +TR opt: fixnum-bounded-expr.rkt 92:0 (fx+ (+ 34 231) (* 24 25)) -- fixnum fx+ +TR opt: fixnum-bounded-expr.rkt 92:5 (+ 34 231) -- fixnum bounded expr +TR opt: fixnum-bounded-expr.rkt 92:16 (* 24 25) -- fixnum bounded expr +TR opt: fixnum-bounded-expr.rkt 93:0 (fx+ (+ (+ 34 231) 23) -4) -- fixnum fx+ +TR opt: fixnum-bounded-expr.rkt 93:5 (+ (+ 34 231) 23) -- fixnum bounded expr +TR opt: fixnum-bounded-expr.rkt 93:8 (+ 34 231) -- fixnum bounded expr +TR opt: fixnum-bounded-expr.rkt 94:0 (fx+ -4 (+ (+ 34 231) 23)) -- fixnum fx+ +TR opt: fixnum-bounded-expr.rkt 94:8 (+ (+ 34 231) 23) -- fixnum bounded expr +TR opt: fixnum-bounded-expr.rkt 94:11 (+ 34 231) -- fixnum bounded expr +TR missed opt: fixnum-bounded-expr.rkt 95:0 (fx+ (+ 300 301) (+ 301 302)) -- out of fixnum range +TR opt: fixnum-bounded-expr.rkt 95:5 (+ 300 301) -- fixnum bounded expr +TR opt: fixnum-bounded-expr.rkt 95:17 (+ 301 302) -- fixnum bounded expr +TR opt: fixnum-bounded-expr.rkt 97:0 (fx- (+ 300 301) (+ 301 302)) -- fixnum fx- +TR opt: fixnum-bounded-expr.rkt 97:5 (+ 300 301) -- fixnum bounded expr +TR opt: fixnum-bounded-expr.rkt 97:17 (+ 301 302) -- fixnum bounded expr +TR missed opt: fixnum-bounded-expr.rkt 98:0 (fx- (ann 3 Fixnum) (ann 4 Fixnum)) -- out of fixnum range +TR opt: fixnum-bounded-expr.rkt 100:0 (fx* 4 5) -- fixnum fx* +TR missed opt: fixnum-bounded-expr.rkt 101:0 (fx* 300 300) -- out of fixnum range +TR opt: fixnum-bounded-expr.rkt 103:0 (fxquotient (ann 34 Nonnegative-Fixnum) (ann -4 Fixnum)) -- fixnum fxquotient +TR missed opt: fixnum-bounded-expr.rkt 104:0 (fxquotient -4 -5) -- out of fixnum range +TR opt: fixnum-bounded-expr.rkt 106:0 (fxabs (ann 64235 Nonnegative-Fixnum)) -- fixnum fxabs +TR missed opt: fixnum-bounded-expr.rkt 107:0 (fxabs -4) -- out of fixnum range 28 89525 28 diff --git a/collects/typed-scheme/optimizer/fixnum.rkt b/collects/typed-scheme/optimizer/fixnum.rkt index 1036affb2c..8aa5e07d12 100644 --- a/collects/typed-scheme/optimizer/fixnum.rkt +++ b/collects/typed-scheme/optimizer/fixnum.rkt @@ -69,6 +69,22 @@ (define fixnum-opt-msg "Fixnum arithmetic specialization.") +(define (log-fixnum-missed-opt stx) + (log-missed-optimization + "out of fixnum range" + "This expression has all fixnum arguments but is not guaranteed to itself return a fixnum. Therefore, it cannot be safely optimized. Constraining the arguments to be of Byte or Index types may help." + stx)) + +;; general-purpose safety check for fixnum opts +;; some operations have different definitions of safe and have their own checks +;; if we make it this far, an optimization is likely to be expected by the +;; user, so we report a missed opt if the check fails +(define (check-if-safe stx) + (let ([safe-to-opt? (subtypeof? stx -Fixnum)]) + (unless safe-to-opt? + (log-fixnum-missed-opt stx)) + safe-to-opt?)) + (define-syntax-class fixnum-opt-expr #:commit (pattern (#%plain-app op:fixnum-unary-op n:fixnum-expr) @@ -109,7 +125,7 @@ ;; (if they typecheck with return type Fixnum) (pattern (#%plain-app (~var op (fixnum-op potentially-bounded-fixnum-ops)) n1:fixnum-expr n2:fixnum-expr ns:fixnum-expr ...) - #:when (subtypeof? this-syntax -Fixnum) + #:when (check-if-safe this-syntax) #:with opt (begin (log-optimization "fixnum bounded expr" fixnum-opt-msg this-syntax) (let ([post-opt (syntax->list #'(n1.opt n2.opt ns.opt ...))]) @@ -117,7 +133,7 @@ (car post-opt) (cadr post-opt) (cddr post-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) + #:when (check-if-safe this-syntax) #:with opt (begin (log-optimization "nonzero fixnum bounded expr" fixnum-opt-msg this-syntax) #'(op.unsafe n1.opt n2.opt))) @@ -125,40 +141,59 @@ ;; 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))) + #:when (let ([safe-to-opt? + (or (and (subtypeof? #'n1 -Index) (subtypeof? #'n2 -Index)) + (and (subtypeof? #'n1 -NonNegFixnum) (subtypeof? #'n2 -NonPosFixnum)) + (and (subtypeof? #'n1 -NonPosFixnum) (subtypeof? #'n2 -NonNegFixnum)))]) + (unless safe-to-opt? + (log-fixnum-missed-opt this-syntax)) + safe-to-opt?) #:with opt (begin (log-optimization "fixnum fx+" fixnum-opt-msg this-syntax) #'(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)) + #:when (let ([safe-to-opt? (and (subtypeof? #'n1 -NonNegFixnum) + (subtypeof? #'n2 -NonNegFixnum))]) + (unless safe-to-opt? + (log-fixnum-missed-opt this-syntax)) + safe-to-opt?) #:with opt (begin (log-optimization "fixnum fx-" fixnum-opt-msg this-syntax) #'(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)) + #:when (let ([safe-to-opt? (and (subtypeof? #'n1 -Byte) + (subtypeof? #'n2 -Byte))]) + (unless safe-to-opt? + (log-fixnum-missed-opt this-syntax)) + safe-to-opt?) #:with opt (begin (log-optimization "fixnum fx*" fixnum-opt-msg this-syntax) #'(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)) + #:when (let ([safe-to-opt? (and (subtypeof? #'n1 -NonNegFixnum) + (subtypeof? #'n2 -Fixnum))]) + (unless safe-to-opt? + (log-fixnum-missed-opt this-syntax)) + safe-to-opt?) #:with opt (begin (log-optimization "fixnum fxquotient" fixnum-opt-msg this-syntax) #'(unsafe-fxquotient n1.opt n2.opt))) (pattern (#%plain-app (~and op (~or (~literal fxabs) (~literal abs))) n:fixnum-expr) - #:when (subtypeof? #'n -NonNegFixnum) ; (abs min-fixnum) is not a fixnum + #:when (let ([safe-to-opt? (subtypeof? #'n -NonNegFixnum)]) ; (abs min-fixnum) is not a fixnum + (unless safe-to-opt? + (log-fixnum-missed-opt this-syntax)) + safe-to-opt?) #:with opt (begin (log-optimization "fixnum fxabs" fixnum-opt-msg this-syntax) #'(unsafe-fxabs n.opt))) (pattern (#%plain-app (~and op (~literal add1)) n:fixnum-expr) - #:when (subtypeof? this-syntax -Fixnum) + #:when (check-if-safe this-syntax) #:with opt (begin (log-optimization "fixnum add1" fixnum-opt-msg this-syntax) #'(unsafe-fx+ n.opt 1))) (pattern (#%plain-app (~and op (~literal sub1)) n:fixnum-expr) - #:when (subtypeof? this-syntax -Fixnum) + #:when (check-if-safe this-syntax) #:with opt (begin (log-optimization "fixnum sub1" fixnum-opt-msg this-syntax) #'(unsafe-fx- n.opt 1))))