suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Typed Scheme now optimizes (fl)vector-length for all vectors and

Browse Source 
vector-(ref,set!) for vectors of known length.
This commit is contained in:
Vincent St-Amour 2010-06-24 13:20:47 -04:00
parent fd987546b3
commit b345d5f0f0
23 changed files with 118 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/tests/typed-scheme/optimizer/generic/flvector-length.rkt Normal file
View File

@ -0,0 +1,3 @@
(module flvector-length typed/scheme #:optimize
(require racket/unsafe/ops racket/flonum)
(flvector-length (flvector 0.0 1.2)))

3
collects/tests/typed-scheme/optimizer/generic/invalid-float-promotion.rkt
View File

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

2
collects/tests/typed-scheme/optimizer/generic/invalid-vector-ref.rkt Normal file
View File

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

2
collects/tests/typed-scheme/optimizer/generic/invalid-vector-set.rkt Normal file
View File

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

2
collects/tests/typed-scheme/optimizer/generic/quote.rkt Normal file
View File

@ -0,0 +1,2 @@
(module quote typed/scheme #:optimize
'(+ 1.0 2.0))

7
collects/tests/typed-scheme/optimizer/generic/vector-length-nested.rkt Normal file
View File

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

3
collects/tests/typed-scheme/optimizer/generic/vector-length.rkt Normal file
View File

@ -0,0 +1,3 @@
(module vector-length typed/scheme #:optimize
(require racket/unsafe/ops)
(vector-length (vector 1 2 3)))

7
collects/tests/typed-scheme/optimizer/generic/vector-ref-set-ref.rkt Normal file
View File

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

3
collects/tests/typed-scheme/optimizer/generic/vector-ref.rkt Normal file
View File

@ -0,0 +1,3 @@
(module vector-ref typed/scheme #:optimize
(require racket/unsafe/ops)
(vector-ref (ann (vector 1 2) (Vector Integer Integer)) 0))

5
collects/tests/typed-scheme/optimizer/generic/vector-set-quote.rkt Normal file
View File

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

5
collects/tests/typed-scheme/optimizer/generic/vector-set.rkt Normal file
View File

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

3
collects/tests/typed-scheme/optimizer/hand-optimized/flvector-length.rkt Normal file
View File

@ -0,0 +1,3 @@
(module flvector-length typed/scheme #:optimize
(require racket/unsafe/ops racket/flonum)
(unsafe-flvector-length (flvector 0.0 1.2)))

3
collects/tests/typed-scheme/optimizer/hand-optimized/invalid-float-promotion.rkt
View File

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

2
collects/tests/typed-scheme/optimizer/hand-optimized/invalid-vector-ref.rkt Normal file
View File

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

2
collects/tests/typed-scheme/optimizer/hand-optimized/invalid-vector-set.rkt Normal file
View File

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

2
collects/tests/typed-scheme/optimizer/hand-optimized/quote.rkt Normal file
View File

@ -0,0 +1,2 @@
(module quote typed/scheme #:optimize
'(+ 1.0 2.0))

7
collects/tests/typed-scheme/optimizer/hand-optimized/vector-length-nested.rkt Normal file
View File

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

3
collects/tests/typed-scheme/optimizer/hand-optimized/vector-length.rkt Normal file
View File

@ -0,0 +1,3 @@
(module vector-length typed/scheme #:optimize
(require racket/unsafe/ops)
(unsafe-vector*-length (vector 1 2 3)))

7
collects/tests/typed-scheme/optimizer/hand-optimized/vector-ref-set-ref.rkt Normal file
View File

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

3
collects/tests/typed-scheme/optimizer/hand-optimized/vector-ref.rkt Normal file
View File

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

5
collects/tests/typed-scheme/optimizer/hand-optimized/vector-set-quote.rkt Normal file
View File

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

5
collects/tests/typed-scheme/optimizer/hand-optimized/vector-set.rkt Normal file
View File

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

38
collects/typed-scheme/private/optimize.rkt
View File

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