Pushed optimizations to auxiliary syntax classes.

collects/typed-scheme/optimizer/fixnum.rkt

@@ -6,16 +6,8 @@
          (types abbrev type-table utils subtype)
          (optimizer utils))
 
-(provide (all-defined-out))
+(provide fixnum-expr fixnum-opt-expr)
 
-(define-syntax-class fixnum-opt-expr
-  (pattern e:expr
-           #:when (subtypeof? #'e -Fixnum)
-           #:with opt ((optimize) #'e)))
-(define-syntax-class nonzero-fixnum-opt-expr
-  (pattern e:expr
-           #:when (or (isoftype? #'e -PositiveFixnum) (isoftype? #'e -NegativeFixnum))
-           #:with opt ((optimize) #'e)))
 
 (define (mk-fixnum-tbl generic)
   (mk-unsafe-tbl generic "fx~a" "unsafe-fx~a"))
@@ -52,7 +44,34 @@
            #:with unsafe (dict-ref tbl #'i)))
 
 
-(define (optimize-finum-expr stx)
+(define-syntax-class fixnum-expr
-  (syntax-parse stx #:literal-sets (kernel-literals)
+  (pattern e:expr
-                [e:fixnum-opt-expr
+           #:when (subtypeof? #'e -Fixnum)
-                 (syntax/loc stx e.opt)]))
+           #:with opt ((optimize) #'e)))
+(define-syntax-class nonzero-fixnum-expr
+  (pattern e:expr
+           #:when (or (isoftype? #'e -PositiveFixnum) (isoftype? #'e -NegativeFixnum))
+           #:with opt ((optimize) #'e)))
+
+(define-syntax-class fixnum-opt-expr
+  (pattern (#%plain-app op:fixnum-unary-op n:fixnum-expr)
+           #:with opt
+           (begin (log-optimization "unary fixnum" #'op)
+                  #'(op.unsafe n.opt)))
+  (pattern (#%plain-app (~var op (fixnum-op binary-fixnum-ops))
+                        n1:fixnum-expr
+                        n2:fixnum-expr
+                        ns:fixnum-expr ...)
+           #:with opt
+           (begin (log-optimization "binary fixnum" #'op)
+                  (n-ary->binary #'op.unsafe #'n1.opt #'n2.opt #'(ns.opt ...))))
+  (pattern (#%plain-app op:nonzero-fixnum-binary-op
+                        n1:fixnum-expr
+                        n2:nonzero-fixnum-expr)
+           #:with opt
+           (begin (log-optimization "binary nonzero fixnum" #'op)
+                  #'(op.unsafe n1.opt n2.opt)))
+  (pattern (#%plain-app (~and op (~literal exact->inexact)) n:fixnum-expr)
+           #:with opt
+           (begin (log-optimization "fixnum to float" #'op)
+                  #'(unsafe-fx->fl n.opt))))

collects/typed-scheme/optimizer/float.rkt

@@ -2,38 +2,18 @@
 
 (require syntax/parse
          syntax/id-table racket/dict
-         (for-template scheme/base scheme/flonum scheme/fixnum scheme/unsafe/ops)
+         (for-template scheme/base scheme/flonum scheme/unsafe/ops)
          "../utils/utils.rkt"
          (types abbrev type-table utils subtype)
          (optimizer utils fixnum))
 
-(provide (all-defined-out))
+(provide float-opt-expr float-op mk-float-tbl)
 
-(define-syntax-class float-opt-expr
-  (pattern e:expr
-           #:when (subtypeof? #'e -Flonum)
-           #:with opt ((optimize) #'e)))
-(define-syntax-class int-opt-expr
-  (pattern e:expr
-           #:when (subtypeof? #'e -Integer)
-           #:with opt ((optimize) #'e)))
-
-;; if the result of an operation is of type float, its non float arguments
-;; can be promoted, and we can use unsafe float operations
-;; note: none of the unary operations have types where non-float arguments
-;;  can result in float (as opposed to real) results
-(define-syntax-class float-arg-expr
-  (pattern e:fixnum-opt-expr
-           #:with opt #'(unsafe-fx->fl e.opt))
-  (pattern e:int-opt-expr
-           #:with opt #'(->fl e.opt))
-  (pattern e:float-opt-expr
-           #:with opt #'e.opt))
 
 (define (mk-float-tbl generic)
   (mk-unsafe-tbl generic "fl~a" "unsafe-fl~a"))
 
-(define binary-float-ops 
+(define binary-float-ops
   (mk-float-tbl (list #'+ #'- #'* #'/ #'min #'max)))
 (define binary-float-comps
   (dict-set
@@ -52,8 +32,57 @@
            #:when (dict-ref tbl #'i #f)
            #:with unsafe (dict-ref tbl #'i)))
 
+(define-syntax-class float-expr
+  (pattern e:expr
+           #:when (subtypeof? #'e -Flonum)
+           #:with opt ((optimize) #'e)))
+(define-syntax-class int-expr
+  (pattern e:expr
+           #:when (subtypeof? #'e -Integer)
+           #:with opt ((optimize) #'e)))
 
-(define (optimize-float-expr stx)
+;; if the result of an operation is of type float, its non float arguments
-  (syntax-parse stx #:literal-sets (kernel-literals)
+;; can be promoted, and we can use unsafe float operations
-                [e:float-opt-expr
+;; note: none of the unary operations have types where non-float arguments
-                 (syntax/loc stx e.opt)]))
+;;  can result in float (as opposed to real) results
+(define-syntax-class float-arg-expr
+  (pattern e:fixnum-expr
+           #:with opt #'(unsafe-fx->fl e.opt))
+  (pattern e:int-expr
+           #:with opt #'(->fl e.opt))
+  (pattern e:float-expr
+           #:with opt #'e.opt))
+
+(define-syntax-class float-opt-expr
+  (pattern (~and res (#%plain-app (~var op (float-op unary-float-ops)) f:float-expr))
+           #:when (subtypeof? #'res -Flonum)
+           #:with opt
+           (begin (log-optimization "unary float" #'op)
+                  #'(op.unsafe f.opt)))
+  (pattern (~and res (#%plain-app (~var op (float-op binary-float-ops))
+                                  f1:float-arg-expr
+                                  f2:float-arg-expr
+                                  fs:float-arg-expr ...))
+           ;; if the result is a float, we can coerce integers to floats and optimize
+           #:when (subtypeof? #'res -Flonum)
+           #:with opt
+           (begin (log-optimization "binary float" #'op)
+                  (n-ary->binary #'op.unsafe #'f1.opt #'f2.opt #'(fs.opt ...))))
+  (pattern (~and res (#%plain-app (~var op (float-op binary-float-comps))
+                                  f1:float-expr
+                                  f2:float-expr
+                                  fs:float-expr ...))
+           #:with opt
+           (begin (log-optimization "binary float comp" #'op)
+                  (n-ary->binary #'op.unsafe #'f1.opt #'f2.opt #'(fs.opt ...))))
+  
+  ;; we can optimize exact->inexact if we know we're giving it an Integer
+  (pattern (#%plain-app (~and op (~literal exact->inexact)) n:int-expr)
+           #:with opt
+           (begin (log-optimization "int to float" #'op)
+                  #'(->fl n.opt)))
+  ;; we can get rid of it altogether if we're giving it an inexact number
+  (pattern (#%plain-app (~and op (~literal exact->inexact)) f:float-expr)
+           #:with opt
+           (begin (log-optimization "float to float" #'op)
+                  #'f.opt)))

collects/typed-scheme/optimizer/inexact-complex.rkt

@@ -6,14 +6,9 @@
          (types abbrev type-table utils subtype)
          (optimizer utils float))
 
-(provide (all-defined-out))
+(provide inexact-complex-opt-expr)
 
 
-(define-syntax-class inexact-complex-opt-expr
-  (pattern e:expr
-           #:when (isoftype? #'e -InexactComplex)
-           #:with opt ((optimize) #'e)))
-
 ;; it's faster to take apart a complex number and use unsafe operations on
 ;; its parts than it is to use generic operations
 ;; we keep the real and imaginary parts unboxed as long as we stay within
@@ -127,8 +122,21 @@
 (define binary-inexact-complex-ops
   (mk-float-tbl (list #'+ #'- #'* #'/)))
 
+(define-syntax-class inexact-complex-expr
+  (pattern e:expr
+           #:when (isoftype? #'e -InexactComplex)
+           #:with opt ((optimize) #'e)))
 
-(define (optimize-inexact-complex-expr e)
+(define-syntax-class inexact-complex-opt-expr
-  (syntax-parse e #:literal-sets (kernel-literals)
+  (pattern (#%plain-app op:inexact-complex-unary-op n:inexact-complex-expr)
-                [e:inexact-complex-opt-expr
+           #:with opt
-                 (syntax/loc stx e.opt)]))
+           (begin (log-optimization "unary inexact complex" #'op)
+                  #'(op.unsafe n.opt)))
+  (pattern (~and exp (#%plain-app (~var op (float-op binary-inexact-complex-ops))
+                                  e:inexact-complex-expr ...))
+           #:with exp*:unboxed-inexact-complex-opt-expr #'exp
+           #:with opt
+           (begin (log-optimization "unboxed inexact complex" #'exp)
+                  (begin (reset-unboxed-gensym)
+                         #'(let* (exp*.bindings ...)
+                             (unsafe-make-flrectangular exp*.real-part exp*.imag-part))))))

collects/typed-scheme/optimizer/list.rkt

@@ -0,0 +1,35 @@
+#lang scheme/base
+
+(require syntax/parse
+         syntax/id-table racket/dict
+         unstable/match scheme/match
+         (for-template scheme/base scheme/unsafe/ops)
+         "../utils/utils.rkt" "../utils/tc-utils.rkt"
+         (rep type-rep)
+         (types abbrev type-table utils subtype)
+         (optimizer utils))
+
+(provide list-opt-expr)
+
+
+(define-syntax-class list-expr
+  (pattern e:expr
+           #:when (match (type-of #'e)
+                    [(tc-result1: (Listof: _)) #t]
+                    [(tc-result1: (List: _)) #t]
+                    [_ #f])
+           #:with opt ((optimize) #'e)))
+
+(define-syntax-class list-opt-expr
+  ;; if we're iterating (with the for macros) over something we know is a list,
+  ;; we can generate code that would be similar to if in-list had been used
+  (pattern (#%plain-app op:id _ l)
+           #:when (id-from? #'op 'make-sequence 'racket/private/for)
+           #:with l*:list-expr #'l
+           #:with opt
+           (begin (log-optimization "in-list" #'op)
+                  #'(let ((i l*.opt))
+                      (values unsafe-car unsafe-cdr i
+                              (lambda (x) (not (null? x)))
+                              (lambda (x) #t)
+                              (lambda (x y) #t))))))

collects/typed-scheme/optimizer/optimizer.rkt

@@ -2,192 +2,30 @@
 
 (require syntax/parse 
          syntax/id-table racket/dict
-         unstable/match scheme/match
          (for-template scheme/base scheme/flonum scheme/fixnum scheme/unsafe/ops racket/private/for)
-         "../utils/utils.rkt" "../utils/tc-utils.rkt"
+         "../utils/utils.rkt"
-         (rep type-rep)
          (types abbrev type-table utils subtype)
-         (optimizer utils fixnum float inexact-complex))
+         (optimizer utils fixnum float inexact-complex vector pair list struct))
 
 (provide optimize-top)
 
 
-(define-syntax-class pair-opt-expr
-  (pattern e:opt-expr
-           #:when (match (type-of #'e) ; type of the operand
-                    [(tc-result1: (Pair: _ _)) #t]
-                    [_ #f])
-           #:with opt #'e.opt))
-
-(define-syntax-class pair-unary-op
-  (pattern (~literal car) #:with unsafe #'unsafe-car)
-  (pattern (~literal cdr) #:with unsafe #'unsafe-cdr))
-
-(define-syntax-class vector-opt-expr
-  (pattern e:opt-expr
-           #:when (match (type-of #'e)
-                    [(tc-result1: (HeterogenousVector: _)) #t]
-                    [_ #f])
-           #:with opt #'e.opt))
-
-(define-syntax-class vector-op
-  ;; we need the * versions of these unsafe operations to be chaperone-safe
-  (pattern (~literal vector-ref)  #:with unsafe #'unsafe-vector*-ref)
-  (pattern (~literal vector-set!) #:with unsafe #'unsafe-vector*-set!))
-
-(define-syntax-class list-opt-expr
-  (pattern e:opt-expr
-           #:when (match (type-of #'e)
-                    [(tc-result1: (Listof: _)) #t]
-                    [(tc-result1: (List: _)) #t]
-                    [_ #f])
-           #:with opt #'e.opt))
-
-
 (define-syntax-class opt-expr
   (pattern e:opt-expr*
            #:with opt (syntax-recertify #'e.opt this-syntax (current-code-inspector) #f)))
 
-
 (define-syntax-class opt-expr*
   #:literal-sets (kernel-literals)
 
   ;; interesting cases, where something is optimized
-  (pattern (~and res (#%plain-app (~var op (float-op unary-float-ops)) f:float-opt-expr))
+  (pattern e:fixnum-opt-expr          #:with opt #'e.opt)
-           #:when (subtypeof? #'res -Flonum)
+  (pattern e:float-opt-expr           #:with opt #'e.opt)
-           #:with opt
+  (pattern e:inexact-complex-opt-expr #:with opt #'e.opt)
-           (begin (log-optimization "unary float" #'op)
+  (pattern e:vector-opt-expr          #:with opt #'e.opt)
-                  #'(op.unsafe f.opt)))
+  (pattern e:pair-opt-expr            #:with opt #'e.opt)
-  (pattern (~and res (#%plain-app (~var op (float-op binary-float-ops))
+  (pattern e:list-opt-expr            #:with opt #'e.opt)
-                                  f1:float-arg-expr
+  (pattern e:struct-opt-expr          #:with opt #'e.opt)
-                                  f2:float-arg-expr
-                                  fs:float-arg-expr ...))
-           ;; if the result is a float, we can coerce integers to floats and optimize
-           #:when (subtypeof? #'res -Flonum)
-           #:with opt
-           (begin (log-optimization "binary float" #'op)
-                  (n-ary->binary #'op.unsafe #'f1.opt #'f2.opt #'(fs.opt ...))))
-  (pattern (~and res (#%plain-app (~var op (float-op binary-float-comps))
-                                  f1:float-opt-expr
-                                  f2:float-opt-expr
-                                  fs:float-opt-expr ...))
-           #:with opt
-           (begin (log-optimization "binary float comp" #'op)
-                  (n-ary->binary #'op.unsafe #'f1.opt #'f2.opt #'(fs.opt ...))))
-
-  (pattern (#%plain-app op:fixnum-unary-op n:fixnum-opt-expr)
-           #:with opt
-           (begin (log-optimization "unary fixnum" #'op)
-                  #'(op.unsafe n.opt)))
-  (pattern (#%plain-app (~var op (fixnum-op binary-fixnum-ops))
-                        n1:fixnum-opt-expr
-                        n2:fixnum-opt-expr
-                        ns:fixnum-opt-expr ...)
-           #:with opt
-           (begin (log-optimization "binary fixnum" #'op)
-                  (n-ary->binary #'op.unsafe #'n1.opt #'n2.opt #'(ns.opt ...))))
-  (pattern (#%plain-app op:nonzero-fixnum-binary-op
-                        n1:fixnum-opt-expr
-                        n2:nonzero-fixnum-opt-expr)
-           #:with opt
-           (begin (log-optimization "binary nonzero fixnum" #'op)
-                  #'(op.unsafe n1.opt n2.opt)))
-
-  (pattern (#%plain-app op:inexact-complex-unary-op n:inexact-complex-opt-expr)
-           #:with opt
-           (begin (log-optimization "unary inexact complex" #'op)
-                  #'(op.unsafe n.opt)))
-  (pattern (~and exp (#%plain-app (~var op (float-op binary-inexact-complex-ops))
-                                  e:inexact-complex-opt-expr ...))
-           #:with exp*:unboxed-inexact-complex-opt-expr #'exp
-           #:with opt
-           (begin (log-optimization "unboxed inexact complex" #'exp)
-                  (begin (reset-unboxed-gensym)
-                         #'(let* (exp*.bindings ...)
-                             (unsafe-make-flrectangular exp*.real-part exp*.imag-part)))))
   
-  (pattern (#%plain-app (~and op (~literal exact->inexact)) n:fixnum-opt-expr)
-           #:with opt
-           (begin (log-optimization "fixnum to float" #'op)
-                  #'(unsafe-fx->fl n.opt)))
-  ;; we can optimize exact->inexact if we know we're giving it an Integer
-  (pattern (#%plain-app (~and op (~literal exact->inexact)) n:int-opt-expr)
-           #:with opt
-           (begin (log-optimization "int to float" #'op)
-                  #'(->fl n.opt)))
-  ;; we can get rid of it altogether if we're giving it an inexact number
-  (pattern (#%plain-app (~and op (~literal exact->inexact)) f:float-opt-expr)
-           #:with opt
-           (begin (log-optimization "float to float" #'op)
-                  #'f.opt))
-
-  (pattern (#%plain-app op:pair-unary-op p:pair-opt-expr)
-           #:with opt
-           (begin (log-optimization "unary pair" #'op)
-                  #'(op.unsafe p.opt)))
-
-  ;; vector-length of a known-length vector
-  (pattern (#%plain-app (~and op (~or (~literal vector-length)
-                                      (~literal unsafe-vector-length)
-                                      (~literal unsafe-vector*-length)))
-                        v:vector-opt-expr)
-           #:with opt
-           (begin (log-optimization "known-length vector" #'op)
-                  (match (type-of #'v)
-                    [(tc-result1: (HeterogenousVector: es))
-                     #`(begin v.opt #,(length es))]))) ; v may have side effects
-  ;; we can optimize vector-length on all vectors.
-  ;; since the program typechecked, we know the arg is a vector.
-  ;; we can optimize no matter what.
-  (pattern (#%plain-app (~and op (~literal vector-length)) v:opt-expr)
-           #:with opt
-           (begin (log-optimization "vector" #'op)
-                  #'(unsafe-vector*-length v.opt)))
-  ;; same for flvector-length
-  (pattern (#%plain-app (~and op (~literal flvector-length)) v:opt-expr)
-           #:with opt
-           (begin (log-optimization "flvector" #'op)
-                  #'(unsafe-flvector-length v.opt)))
-  ;; 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-opt-expr i:opt-expr new:opt-expr ...)
-           #:when (let ((len (match (type-of #'v)
-                               [(tc-result1: (HeterogenousVector: es)) (length es)]
-                               [_ 0]))
-                        (ival (or (syntax-parse #'i [((~literal quote) i:number) (syntax-e #'i)] [_ #f])
-                                  (match (type-of #'i)
-                                    [(tc-result1: (Value: (? number? i))) i]
-                                    [_ #f]))))
-                    (and (integer? ival) (exact? ival) (<= 0 ival (sub1 len))))
-           #:with opt
-           (begin (log-optimization "vector" #'op)
-                  #'(op.unsafe v.opt i.opt new.opt ...)))
-
-  ;; if we're iterating (with the for macros) over something we know is a list,
-  ;; we can generate code that would be similar to if in-list had been used
-  (pattern (#%plain-app op:id _ l)
-           #:when (id-from? #'op 'make-sequence 'racket/private/for)
-           #:with l*:list-opt-expr #'l
-           #:with opt
-           (begin (log-optimization "in-list" #'op)
-                  #'(let ((i l*.opt))
-                      (values unsafe-car unsafe-cdr i
-                              (lambda (x) (not (null? x)))
-                              (lambda (x) #t)
-                              (lambda (x y) #t)))))
-
-  ;; we can always optimize struct accessors and mutators
-  ;; if they typecheck, they're safe
-  (pattern (#%plain-app op:id s:opt-expr v:opt-expr ...)
-           #:when (or (struct-accessor? #'op) (struct-mutator? #'op))
-           #:with opt
-           (let ([idx (struct-fn-idx #'op)])
-             (if (struct-accessor? #'op)
-                 (begin (log-optimization "struct ref" #'op)
-                        #`(unsafe-struct-ref  s.opt #,idx))
-                 (begin (log-optimization "struct set" #'op)
-                        #`(unsafe-struct-set! s.opt #,idx v.opt ...)))))
-
   ;; boring cases, just recur down
   (pattern (#%plain-lambda formals e:opt-expr ...)
            #:with opt #'(#%plain-lambda formals e.opt ...))
@@ -205,7 +43,8 @@
            #:when (ormap (lambda (k) (free-identifier=? k #'kw))
                          (list #'if #'begin #'begin0 #'set! #'#%plain-app #'#%app #'#%expression
                                #'#%variable-reference #'with-continuation-mark))
-           #:with (expr*:opt-expr ...) #'(expr ...) ; we don't want to optimize in the cases that don't match the #:when clause
+           ;; we don't want to optimize in the cases that don't match the #:when clause
+           #:with (expr*:opt-expr ...) #'(expr ...)
            #:with opt #'(kw expr*.opt ...))
   (pattern other:expr
            #:with opt #'other))

collects/typed-scheme/optimizer/pair.rkt

@@ -0,0 +1,30 @@
+#lang scheme/base
+
+(require syntax/parse
+         syntax/id-table racket/dict
+         unstable/match scheme/match
+         (for-template scheme/base scheme/unsafe/ops)
+         "../utils/utils.rkt"
+         (rep type-rep)
+         (types abbrev type-table utils subtype)
+         (optimizer utils))
+
+(provide pair-opt-expr)
+
+
+(define-syntax-class pair-unary-op
+  (pattern (~literal car) #:with unsafe #'unsafe-car)
+  (pattern (~literal cdr) #:with unsafe #'unsafe-cdr))
+
+(define-syntax-class pair-expr
+  (pattern e:expr
+           #:when (match (type-of #'e) ; type of the operand
+                    [(tc-result1: (Pair: _ _)) #t]
+                    [_ #f])
+           #:with opt ((optimize) #'e)))
+
+(define-syntax-class pair-opt-expr
+  (pattern (#%plain-app op:pair-unary-op p:pair-expr)
+           #:with opt
+           (begin (log-optimization "unary pair" #'op)
+                  #'(op.unsafe p.opt))))

collects/typed-scheme/optimizer/struct.rkt

@@ -0,0 +1,26 @@
+#lang scheme/base
+
+(require syntax/parse
+         syntax/id-table racket/dict
+         unstable/match scheme/match
+         (for-template scheme/base scheme/unsafe/ops)
+         "../utils/utils.rkt"
+         (rep type-rep)
+         (types abbrev type-table utils subtype)
+         (optimizer utils))
+
+(provide struct-opt-expr)
+
+(define-syntax-class struct-opt-expr
+  ;; we can always optimize struct accessors and mutators
+  ;; if they typecheck, they're safe
+  (pattern (#%plain-app op:id s:expr v:expr ...)
+           #:when (or (struct-accessor? #'op) (struct-mutator? #'op))
+           #:with opt
+           (let ([idx (struct-fn-idx #'op)])
+             (if (struct-accessor? #'op)
+                 (begin (log-optimization "struct ref" #'op)
+                        #`(unsafe-struct-ref  #,((optimize) #'s) #,idx))
+                 (begin (log-optimization "struct set" #'op)
+                        #`(unsafe-struct-set! #,((optimize) #'s) #,idx
+                                              #,@(map (optimize) (syntax->list #'(v ...)))))))))

collects/typed-scheme/optimizer/vector.rkt

@@ -0,0 +1,63 @@
+#lang scheme/base
+
+(require syntax/parse
+         unstable/match scheme/match
+         (for-template scheme/base scheme/flonum scheme/unsafe/ops)
+         "../utils/utils.rkt"
+         (rep type-rep)
+         (types abbrev type-table utils subtype)
+         (optimizer utils))
+
+(provide vector-opt-expr)
+
+
+(define-syntax-class vector-op
+  ;; we need the * versions of these unsafe operations to be chaperone-safe
+  (pattern (~literal vector-ref)  #:with unsafe #'unsafe-vector*-ref)
+  (pattern (~literal vector-set!) #:with unsafe #'unsafe-vector*-set!))
+
+(define-syntax-class vector-expr
+  (pattern e:expr
+           #:when (match (type-of #'e)
+                    [(tc-result1: (HeterogenousVector: _)) #t]
+                    [_ #f])
+           #:with opt ((optimize) #'e)))
+
+(define-syntax-class vector-opt-expr
+  ;; vector-length of a known-length vector
+  (pattern (#%plain-app (~and op (~or (~literal vector-length)
+                                      (~literal unsafe-vector-length)
+                                      (~literal unsafe-vector*-length)))
+                        v:vector-expr)
+           #:with opt
+           (begin (log-optimization "known-length vector" #'op)
+                  (match (type-of #'v)
+                    [(tc-result1: (HeterogenousVector: es))
+                     #`(begin v.opt #,(length es))]))) ; v may have side effects
+  ;; we can optimize vector-length on all vectors.
+  ;; since the program typechecked, we know the arg is a vector.
+  ;; we can optimize no matter what.
+  (pattern (#%plain-app (~and op (~literal vector-length)) v:expr)
+           #:with opt
+           (begin (log-optimization "vector" #'op)
+                  #`(unsafe-vector*-length #,((optimize) #'v))))
+  ;; same for flvector-length
+  (pattern (#%plain-app (~and op (~literal flvector-length)) v:expr)
+           #:with opt
+           (begin (log-optimization "flvector" #'op)
+                  #`(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 ...)
+           #:when (let ((len (match (type-of #'v)
+                               [(tc-result1: (HeterogenousVector: es)) (length es)]
+                               [_ 0]))
+                        (ival (or (syntax-parse #'i [((~literal quote) i:number) (syntax-e #'i)] [_ #f])
+                                  (match (type-of #'i)
+                                    [(tc-result1: (Value: (? number? i))) i]
+                                    [_ #f]))))
+                    (and (integer? ival) (exact? ival) (<= 0 ival (sub1 len))))
+           #:with opt
+           (begin (log-optimization "vector" #'op)
+                  #`(op.unsafe v.opt #,((optimize) #'i)
+                               #,@(map (optimize) (syntax->list #'(new ...)))))))