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

Do partial bounds checking elimination for flvector operations.

Browse Source 
original commit: a7459c5ee7f6ed135dc5a26e3e2788365326530d
This commit is contained in:
Vincent St-Amour 2011-07-06 18:04:25 -04:00
parent 3f2a0df532
commit 6779719a18
2 changed files with 60 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
collects/tests/typed-scheme/optimizer/tests/bounds-check.rkt
View File

@ -1,16 +1,25 @@
#;
(
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
TR opt: bounds-check.rkt 25:2 (vector-ref v i) -- vector access splitting
TR opt: bounds-check.rkt 28:2 (vector-set! v i n) -- vector access splitting
TR opt: bounds-check.rkt 31:2 (vector-ref v i) -- vector access splitting
TR opt: bounds-check.rkt 34:2 (vector-set! v i n) -- vector access splitting
TR opt: bounds-check.rkt 46:2 (flvector-ref v i) -- flvector access splitting
TR opt: bounds-check.rkt 49:2 (flvector-set! v i n) -- flvector access splitting
TR opt: bounds-check.rkt 52:2 (flvector-ref v i) -- flvector access splitting
TR opt: bounds-check.rkt 55:2 (flvector-set! v i n) -- flvector access splitting
3
4
5
3.0
4.0
5.0
)
#lang typed/racket
(require racket/flonum)
(: f (All (X) ((Vectorof X) Fixnum -> X)))
(define (f v i)
(vector-ref v i))
@ -30,3 +39,24 @@ TR opt: bounds-check.rkt 25:2 (vector-set! v i n) -- vector access splitting
(displayln (h v 2))
(a v 2 5)
(displayln (f v 2))
(: ff (FlVector Fixnum -> Float))
(define (ff v i)
(flvector-ref v i))
(: fg (FlVector Fixnum Float -> Void))
(define (fg v i n)
(flvector-set! v i n))
(: fh (FlVector Index -> Float))
(define (fh v i)
(flvector-ref v i))
(: fa (FlVector Index Float -> Void))
(define (fa v i n)
(flvector-set! v i n))
(define: fv : FlVector (flvector 1.0 2.0 3.0 4.0))
(displayln (ff fv 2))
(fg fv 2 4.0)
(displayln (fh fv 2))
(fa fv 2 5.0)
(displayln (ff fv 2))

33
collects/typed-scheme/optimizer/vector.rkt
View File

@ -1,7 +1,7 @@
#lang scheme/base
(require syntax/parse unstable/syntax
racket/match
racket/match racket/flonum
(for-template scheme/base racket/flonum scheme/unsafe/ops)
"../utils/utils.rkt"
(rep type-rep)
@ -16,6 +16,10 @@
;; we need the * versions of these unsafe operations to be chaperone-safe
(pattern (~literal vector-ref) #:with unsafe #'unsafe-vector-ref #:with unsafe-no-impersonator #'unsafe-vector*-ref)
(pattern (~literal vector-set!) #:with unsafe #'unsafe-vector-set! #:with unsafe-no-impersonator #'unsafe-vector*-set!))
(define-syntax-class flvector-op
#:commit
(pattern (~literal flvector-ref) #:with unsafe #'unsafe-flvector-ref)
(pattern (~literal flvector-set!) #:with unsafe #'unsafe-flvector-set!))
(define-syntax-class known-length-vector-expr
#:commit
@ -69,25 +73,40 @@
(pattern (#%plain-app op:vector-op v:expr i:fixnum-expr new:expr ...)
#:with opt
(begin (log-optimization "vector access splitting" this-syntax)
(let ([safe-fallback #`(op new-v new-i #,@(syntax-map (optimize) #'(new ...)))])
(let ([safe-fallback #`(op new-v new-i #,@(syntax-map (optimize) #'(new ...)))]
[i-known-nonneg? (subtypeof? #'i -NonNegFixnum)])
#`(let ([new-i #,((optimize) #'i)]
[new-v #,((optimize) #'v)])
;; do the impersonator check up front, to avoid doing it twice (length and op)
(if (impersonator? new-v)
(if #,(let ([one-sided #'(unsafe-fx< new-i (unsafe-vector-length v))])
(if (subtypeof? #'i -NonNegFixnum)
(if i-known-nonneg?
;; 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 ...)))
#,safe-fallback)
#,safe-fallback) ; will error. to give the right error message
;; not an impersonator, can use unsafe-vector* ops
(if #,(let ([one-sided #'(unsafe-fx< new-i (unsafe-vector*-length v))])
(if (subtypeof? #'i -NonNegFixnum)
;; we know it's nonnegative, one-sided check
(if i-known-nonneg?
one-sided
#`(and (unsafe-fx>= new-i 0)
#,one-sided)))
(op.unsafe-no-impersonator new-v new-i #,@(syntax-map (optimize) #'(new ...)))
#,safe-fallback)))))))
#,safe-fallback))))))
;; similarly for flvectors
(pattern (#%plain-app op:flvector-op v:expr i:fixnum-expr new:expr ...)
#:with opt
(begin (log-optimization "flvector access splitting" this-syntax)
(let ([safe-fallback #`(op new-v new-i #,@(syntax-map (optimize) #'(new ...)))]
[i-known-nonneg? (subtypeof? #'i -NonNegFixnum)])
#`(let ([new-i #,((optimize) #'i)]
[new-v #,((optimize) #'v)])
(if #,(let ([one-sided #'(unsafe-fx< new-i (unsafe-flvector-length v))])
(if i-known-nonneg?
one-sided
#`(and (unsafe-fx>= new-i 0)
#,one-sided)))
(op.unsafe new-v new-i #,@(syntax-map (optimize) #'(new ...)))
#,safe-fallback))))))