First stab at optimizing bounds checking.

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))

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 ...))))))))