diff --git a/collects/typed-scheme/optimizer/fixnum.rkt b/collects/typed-scheme/optimizer/fixnum.rkt index 378015e228..8959261e2c 100644 --- a/collects/typed-scheme/optimizer/fixnum.rkt +++ b/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) - (syntax-parse stx #:literal-sets (kernel-literals) - [e:fixnum-opt-expr - (syntax/loc stx e.opt)])) +(define-syntax-class fixnum-expr + (pattern e:expr + #:when (subtypeof? #'e -Fixnum) + #: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)))) diff --git a/collects/typed-scheme/optimizer/float.rkt b/collects/typed-scheme/optimizer/float.rkt index 7b2ef5cb14..15675b37ae 100644 --- a/collects/typed-scheme/optimizer/float.rkt +++ b/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) - (syntax-parse stx #:literal-sets (kernel-literals) - [e:float-opt-expr - (syntax/loc stx e.opt)])) +;; 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-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))) diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt index 629d775642..bdaaadc32e 100644 --- a/collects/typed-scheme/optimizer/inexact-complex.rkt +++ b/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) - (syntax-parse e #:literal-sets (kernel-literals) - [e:inexact-complex-opt-expr - (syntax/loc stx e.opt)])) +(define-syntax-class inexact-complex-opt-expr + (pattern (#%plain-app op:inexact-complex-unary-op n:inexact-complex-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-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)))))) diff --git a/collects/typed-scheme/optimizer/list.rkt b/collects/typed-scheme/optimizer/list.rkt new file mode 100644 index 0000000000..272a21edd7 --- /dev/null +++ b/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)))))) diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt index 0551832388..7e7995427b 100644 --- a/collects/typed-scheme/optimizer/optimizer.rkt +++ b/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" - (rep type-rep) + "../utils/utils.rkt" (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)) - #: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-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 e:fixnum-opt-expr #:with opt #'e.opt) + (pattern e:float-opt-expr #:with opt #'e.opt) + (pattern e:inexact-complex-opt-expr #:with opt #'e.opt) + (pattern e:vector-opt-expr #:with opt #'e.opt) + (pattern e:pair-opt-expr #:with opt #'e.opt) + (pattern e:list-opt-expr #:with opt #'e.opt) + (pattern e:struct-opt-expr #:with opt #'e.opt) - (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)) diff --git a/collects/typed-scheme/optimizer/pair.rkt b/collects/typed-scheme/optimizer/pair.rkt new file mode 100644 index 0000000000..0ac9a77af6 --- /dev/null +++ b/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)))) diff --git a/collects/typed-scheme/optimizer/struct.rkt b/collects/typed-scheme/optimizer/struct.rkt new file mode 100644 index 0000000000..575b985e9f --- /dev/null +++ b/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 ...))))))))) diff --git a/collects/typed-scheme/optimizer/vector.rkt b/collects/typed-scheme/optimizer/vector.rkt new file mode 100644 index 0000000000..1014414767 --- /dev/null +++ b/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 ...)))))))