diff --git a/collects/tests/typed-scheme/optimizer/tests/bounds-check.rkt b/collects/tests/typed-scheme/optimizer/tests/bounds-check.rkt new file mode 100644 index 0000000000..7b47b2c1be --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/tests/bounds-check.rkt @@ -0,0 +1,32 @@ +#; +( +TR opt: bounds-check.rkt 16:2 (vector-ref v i) -- vector access splitting +TR opt: bounds-check.rkt 19:2 (vector-set! v i n) -- vector access splitting +TR opt: bounds-check.rkt 22:2 (vector-ref v i) -- vector access splitting +TR opt: bounds-check.rkt 25:2 (vector-set! v i n) -- vector access splitting +3 +4 +5 +) + +#lang typed/racket + +(: f (All (X) ((Vectorof X) Fixnum -> X))) +(define (f v i) + (vector-ref v i)) +(: g (All (X) ((Vectorof X) Fixnum X -> Void))) +(define (g v i n) + (vector-set! v i n)) +(: h (All (X) ((Vectorof X) Index -> X))) +(define (h v i) + (vector-ref v i)) +(: a (All (X) ((Vectorof X) Index X -> Void))) +(define (a v i n) + (vector-set! v i n)) + +(define: v : (Vectorof Integer) (vector 1 2 3 4)) +(displayln (f v 2)) +(g v 2 4) +(displayln (h v 2)) +(a v 2 5) +(displayln (f v 2)) diff --git a/collects/typed-scheme/optimizer/vector.rkt b/collects/typed-scheme/optimizer/vector.rkt index c18da3cbff..11e7e937b3 100644 --- a/collects/typed-scheme/optimizer/vector.rkt +++ b/collects/typed-scheme/optimizer/vector.rkt @@ -5,8 +5,8 @@ (for-template scheme/base racket/flonum scheme/unsafe/ops) "../utils/utils.rkt" (rep type-rep) - (types type-table utils) - (optimizer utils logging)) + (types type-table utils numeric-tower) + (optimizer utils logging fixnum)) (provide vector-opt-expr) @@ -17,7 +17,7 @@ (pattern (~literal vector-ref) #:with unsafe #'unsafe-vector-ref) (pattern (~literal vector-set!) #:with unsafe #'unsafe-vector-set!)) -(define-syntax-class vector-expr +(define-syntax-class known-length-vector-expr #:commit (pattern e:expr #:when (match (type-of #'e) @@ -31,7 +31,7 @@ (pattern (#%plain-app (~and op (~or (~literal vector-length) (~literal unsafe-vector-length) (~literal unsafe-vector*-length))) - v:vector-expr) + v:known-length-vector-expr) #:with opt (begin (log-optimization "known-length vector-length" #'op) (match (type-of #'v) @@ -51,7 +51,7 @@ #`(unsafe-flvector-length #,((optimize) #'v)))) ;; we can optimize vector ref and set! on vectors of known length if we know ;; the index is within bounds (for now, literal or singleton type) - (pattern (#%plain-app op:vector-op v:vector-expr i:expr new:expr ...) + (pattern (#%plain-app op:vector-op v:known-length-vector-expr i:expr new:expr ...) #:when (let ((len (match (type-of #'v) [(tc-result1: (HeterogenousVector: es)) (length es)] [_ 0])) @@ -63,4 +63,18 @@ #:with opt (begin (log-optimization "vector" #'op) #`(op.unsafe v.opt #,((optimize) #'i) - #,@(syntax-map (optimize) #'(new ...)))))) + #,@(syntax-map (optimize) #'(new ...))))) + ;; we can do the bounds checking separately, to eliminate some of the checks + (pattern (#%plain-app op:vector-op v:expr i:fixnum-expr new:expr ...) + #:with opt + (begin (log-optimization "vector access splitting" this-syntax) + #`(let ([new-i #,((optimize) #'i)] + [new-v #,((optimize) #'v)]) + (if #,(let ([one-sided #'(unsafe-fx< new-i (unsafe-vector*-length v))]) + (if (subtypeof? #'i -NonNegFixnum) + ;; we know it's nonnegative, one-sided check + one-sided + #`(and (unsafe-fx>= new-i 0) + #,one-sided))) + (op.unsafe new-v new-i #,@(syntax-map (optimize) #'(new ...))) + (op new-v new-i #,@(syntax-map (optimize) #'(new ...))))))))