diff --git a/collects/tests/typed-scheme/optimizer/generic/flvector-length.rkt b/collects/tests/typed-scheme/optimizer/generic/flvector-length.rkt new file mode 100644 index 0000000000..34add4295a --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/flvector-length.rkt @@ -0,0 +1,3 @@ +(module flvector-length typed/scheme #:optimize + (require racket/unsafe/ops racket/flonum) + (flvector-length (flvector 0.0 1.2))) diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-float-promotion.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-float-promotion.rkt index ee0f3875b5..169909bef6 100644 --- a/collects/tests/typed-scheme/optimizer/generic/invalid-float-promotion.rkt +++ b/collects/tests/typed-scheme/optimizer/generic/invalid-float-promotion.rkt @@ -1,3 +1,2 @@ (module float-promotion typed/scheme #:optimize - (require racket/unsafe/ops) - (/ 1 2.0)) + (/ 1 2.0)) ; result is not a float, can't optimize diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-vector-ref.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-vector-ref.rkt new file mode 100644 index 0000000000..0336e1097d --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/invalid-vector-ref.rkt @@ -0,0 +1,2 @@ +(module invalid-vector-ref typed/scheme #:optimize + (vector-ref (vector 1 2 3) 0)) ; type is (Vectorof Integer), length is unknown, can't optimize diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-vector-set.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-vector-set.rkt new file mode 100644 index 0000000000..91f333c7a4 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/invalid-vector-set.rkt @@ -0,0 +1,2 @@ +(module invalid-vector-set typed/scheme #:optimize + (vector-set! (vector 1 2) 0 2)) ; type is (Vectorof Integer), length is ot known, can't optimize diff --git a/collects/tests/typed-scheme/optimizer/generic/quote.rkt b/collects/tests/typed-scheme/optimizer/generic/quote.rkt new file mode 100644 index 0000000000..2d62416fb7 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/quote.rkt @@ -0,0 +1,2 @@ +(module quote typed/scheme #:optimize + '(+ 1.0 2.0)) diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-length-nested.rkt b/collects/tests/typed-scheme/optimizer/generic/vector-length-nested.rkt new file mode 100644 index 0000000000..ade363e1bf --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/vector-length-nested.rkt @@ -0,0 +1,7 @@ +(module vector-length typed/scheme #:optimize + (require racket/unsafe/ops) + (vector-length + (vector-ref + (ann (vector (vector 1 2) 2 3) + (Vector (Vectorof Integer) Integer Integer)) + 0))) diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-length.rkt b/collects/tests/typed-scheme/optimizer/generic/vector-length.rkt new file mode 100644 index 0000000000..51093a0955 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/vector-length.rkt @@ -0,0 +1,3 @@ +(module vector-length typed/scheme #:optimize + (require racket/unsafe/ops) + (vector-length (vector 1 2 3))) diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-ref-set-ref.rkt b/collects/tests/typed-scheme/optimizer/generic/vector-ref-set-ref.rkt new file mode 100644 index 0000000000..711633ea97 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/vector-ref-set-ref.rkt @@ -0,0 +1,7 @@ +(module vector-ref-set-ref typed/scheme #:optimize + (require racket/unsafe/ops) + (: x (Vector Integer String)) + (define x (vector 1 "1")) + (vector-ref x 0) + (vector-set! x 1 "2") + (vector-ref x 1)) diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-ref.rkt b/collects/tests/typed-scheme/optimizer/generic/vector-ref.rkt new file mode 100644 index 0000000000..00261f8ac9 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/vector-ref.rkt @@ -0,0 +1,3 @@ +(module vector-ref typed/scheme #:optimize + (require racket/unsafe/ops) + (vector-ref (ann (vector 1 2) (Vector Integer Integer)) 0)) diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-set-quote.rkt b/collects/tests/typed-scheme/optimizer/generic/vector-set-quote.rkt new file mode 100644 index 0000000000..063b78d3be --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/vector-set-quote.rkt @@ -0,0 +1,5 @@ +(module vector-set-quote typed/scheme #:optimize + (require racket/unsafe/ops) + (vector-set! (ann (vector '(1 2)) (Vector Any)) + 0 + '(+ 1.0 2.0))) ; we should not optimize under quote diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-set.rkt b/collects/tests/typed-scheme/optimizer/generic/vector-set.rkt new file mode 100644 index 0000000000..5f29aa5e57 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/vector-set.rkt @@ -0,0 +1,5 @@ +(module vector-set typed/scheme #:optimize + (require racket/unsafe/ops) + (vector-set! (ann (vector 1 2) (Vector Integer Integer)) + 0 + 1)) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/flvector-length.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/flvector-length.rkt new file mode 100644 index 0000000000..66e8d715c3 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/flvector-length.rkt @@ -0,0 +1,3 @@ +(module flvector-length typed/scheme #:optimize + (require racket/unsafe/ops racket/flonum) + (unsafe-flvector-length (flvector 0.0 1.2))) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/invalid-float-promotion.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/invalid-float-promotion.rkt index ee0f3875b5..169909bef6 100644 --- a/collects/tests/typed-scheme/optimizer/hand-optimized/invalid-float-promotion.rkt +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/invalid-float-promotion.rkt @@ -1,3 +1,2 @@ (module float-promotion typed/scheme #:optimize - (require racket/unsafe/ops) - (/ 1 2.0)) + (/ 1 2.0)) ; result is not a float, can't optimize diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/invalid-vector-ref.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/invalid-vector-ref.rkt new file mode 100644 index 0000000000..0336e1097d --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/invalid-vector-ref.rkt @@ -0,0 +1,2 @@ +(module invalid-vector-ref typed/scheme #:optimize + (vector-ref (vector 1 2 3) 0)) ; type is (Vectorof Integer), length is unknown, can't optimize diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/invalid-vector-set.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/invalid-vector-set.rkt new file mode 100644 index 0000000000..91f333c7a4 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/invalid-vector-set.rkt @@ -0,0 +1,2 @@ +(module invalid-vector-set typed/scheme #:optimize + (vector-set! (vector 1 2) 0 2)) ; type is (Vectorof Integer), length is ot known, can't optimize diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/quote.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/quote.rkt new file mode 100644 index 0000000000..2d62416fb7 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/quote.rkt @@ -0,0 +1,2 @@ +(module quote typed/scheme #:optimize + '(+ 1.0 2.0)) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/vector-length-nested.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/vector-length-nested.rkt new file mode 100644 index 0000000000..ce4126033f --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/vector-length-nested.rkt @@ -0,0 +1,7 @@ +(module vector-length typed/scheme #:optimize + (require racket/unsafe/ops) + (unsafe-vector*-length + (unsafe-vector*-ref + (ann (vector (vector 1 2) 2 3) + (Vector (Vectorof Integer) Integer Integer)) + 0))) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/vector-length.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/vector-length.rkt new file mode 100644 index 0000000000..61175f80f1 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/vector-length.rkt @@ -0,0 +1,3 @@ +(module vector-length typed/scheme #:optimize + (require racket/unsafe/ops) + (unsafe-vector*-length (vector 1 2 3))) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/vector-ref-set-ref.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/vector-ref-set-ref.rkt new file mode 100644 index 0000000000..645f0f0025 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/vector-ref-set-ref.rkt @@ -0,0 +1,7 @@ +(module vector-ref-set-ref typed/scheme #:optimize + (require racket/unsafe/ops) + (: x (Vector Integer String)) + (define x (vector 1 "1")) + (unsafe-vector*-ref x 0) + (unsafe-vector*-set! x 1 "2") + (unsafe-vector*-ref x 1)) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/vector-ref.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/vector-ref.rkt new file mode 100644 index 0000000000..2e149631ca --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/vector-ref.rkt @@ -0,0 +1,3 @@ +(module vector-ref typed/scheme #:optimize + (require racket/unsafe/ops) + (unsafe-vector*-ref (ann (vector 1 2) (Vector Integer Integer)) 0)) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/vector-set-quote.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/vector-set-quote.rkt new file mode 100644 index 0000000000..3245b5dc8e --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/vector-set-quote.rkt @@ -0,0 +1,5 @@ +(module vector-set-quote typed/scheme #:optimize + (require racket/unsafe/ops) + (unsafe-vector*-set! (ann (vector '(1 2)) (Vector Any)) + 0 + '(+ 1.0 2.0))) ; we should not optimize under quote diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/vector-set.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/vector-set.rkt new file mode 100644 index 0000000000..2c7a7a228b --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/vector-set.rkt @@ -0,0 +1,5 @@ +(module vector-set typed/scheme #:optimize + (require racket/unsafe/ops) + (unsafe-vector*-set! (ann (vector 1 2) (Vector Integer Integer)) + 0 + 1)) diff --git a/collects/typed-scheme/private/optimize.rkt b/collects/typed-scheme/private/optimize.rkt index c415b1b400..09c38d9fe3 100644 --- a/collects/typed-scheme/private/optimize.rkt +++ b/collects/typed-scheme/private/optimize.rkt @@ -54,6 +54,18 @@ (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 opt-expr (pattern e:opt-expr* #:with opt (syntax-recertify #'e.opt this-syntax (current-code-inspector) #f))) @@ -90,6 +102,32 @@ #:with opt (begin (log-optimization "unary pair" #'op) #'(op.unsafe p.opt))) + ;; 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 (~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 (~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 ...))) ;; boring cases, just recur down (pattern (#%plain-lambda formals e:opt-expr ...)