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

swap vector*-ref' and vector-ref', etc.

Browse Source 
Merge to 5.0.2
(cherry picked from commit 5d8e000d6d)
This commit is contained in:
Matthew Flatt 2010-10-25 10:51:35 -06:00 committed by Ryan Culpepper
parent e7a2a3b062
commit 6f2f04b979
12 changed files with 79 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/racket/match/compiler.rkt
View File

@ -105,10 +105,10 @@
esc)]
[(n ...) ns])
#`[(#,arity)
(let ([tmps (unsafe-vector*-ref #,x n)] ...)
(let ([tmps (unsafe-vector-ref #,x n)] ...)
body)]))))])])
#`[(vector? #,x)
(case (unsafe-vector*-length #,x)
(case (unsafe-vector-length #,x)
clauses ...
[else (#,esc)])])]
;; it's a structure
@ -117,7 +117,7 @@
(let* ([s (Row-first-pat (car rows))]
[accs (Struct-accessors s)]
[accs (if (Struct-complete? s)
(build-list (length accs) (λ (i) #`(λ (x) (unsafe-struct*-ref x #,i))))
(build-list (length accs) (λ (i) #`(λ (x) (unsafe-struct-ref x #,i))))
accs)]
[pred (Struct-pred s)])
(compile-con-pat accs pred Struct-ps))]

6
collects/racket/private/for.rkt
View File

@ -420,7 +420,7 @@
(define (:vector-gen v start stop step)
(values
;; pos->element
(lambda (i) (unsafe-vector*-ref v i))
(lambda (i) (unsafe-vector-ref v i))
;; next-pos
;; Minor optimisation. I assume add1 is faster than \x.x+1
(if (= step 1) add1 (lambda (i) (+ i step)))
@ -1236,9 +1236,9 @@
(define-sequence-syntax *in-vector
(lambda () #'in-vector)
(vector-like-gen #'vector?
#'unsafe-vector*-length
#'unsafe-vector-length
#'in-vector
#'unsafe-vector*-ref))
#'unsafe-vector-ref))
(define-sequence-syntax *in-string
(lambda () #'in-string)

28
collects/racket/vector.rkt
View File

@ -59,9 +59,9 @@
;; length is passed to save the computation
(define (vector-map/update f target length vs)
(for ([i (in-range length)])
(unsafe-vector*-set!
(unsafe-vector-set!
target i
(apply f (map (lambda (vec) (unsafe-vector*-ref vec i)) vs)))))
(apply f (map (lambda (vec) (unsafe-vector-ref vec i)) vs)))))
;; check that `v' is a vector
;; that `v' and all the `vs' have the same length
@ -77,12 +77,12 @@
0 f))
(unless (vector? v)
(raise-type-error name "vector" 1 v))
(let ([len (unsafe-vector*-length v)])
(let ([len (unsafe-vector-length v)])
(for ([e (in-list vs)]
[i (in-naturals 2)])
(unless (vector? e)
(raise-type-error name "vector" e i))
(unless (= len (unsafe-vector*-length e))
(unless (= len (unsafe-vector-length e))
(raise
(make-exn:fail:contract
(format "~e: all vectors must have same size; ~a"
@ -138,8 +138,8 @@
([i (in-range len)]
#:when
(apply f
(unsafe-vector*-ref v i)
(map (lambda (v) (unsafe-vector*-ref v i)) vs)))
(unsafe-vector-ref v i)
(map (lambda (v) (unsafe-vector-ref v i)) vs)))
(add1 c))
(error 'vector-count "all vectors must have same size")))
(for/fold ([cnt 0]) ([i (in-vector v)] #:when (f i))
@ -150,7 +150,7 @@
(raise-type-error name "vector" v))
(unless (exact-nonnegative-integer? n)
(raise-type-error name "non-negative exact integer" n))
(let ([len (unsafe-vector*-length v)])
(let ([len (unsafe-vector-length v)])
(unless (<= 0 n len)
(raise-mismatch-error
name
@ -186,14 +186,14 @@
(let* ([vs (cons v vs)]
[lens (for/list ([e (in-list vs)] [i (in-naturals)])
(if (vector? e)
(unsafe-vector*-length e)
(unsafe-vector-length e)
(raise-type-error 'vector-append "vector" e i)))]
[new-v (make-vector (apply + lens))])
(let loop ([start 0] [lens lens] [vs vs])
(when (pair? lens)
(let ([len (car lens)] [v (car vs)])
(for ([i (in-range len)])
(unsafe-vector*-set! new-v (+ i start) (unsafe-vector*-ref v i)))
(unsafe-vector-set! new-v (+ i start) (unsafe-vector-ref v i)))
(loop (+ start len) (cdr lens) (cdr vs)))))
new-v))
@ -203,13 +203,13 @@
(procedure-arity-includes? f 1))
(raise-type-error name "procedure (arity 1)" f))
(unless (and (vector? xs)
(< 0 (unsafe-vector*-length xs)))
(< 0 (unsafe-vector-length xs)))
(raise-type-error name "non-empty vector" xs))
(let ([init-min-var (f (unsafe-vector*-ref xs 0))])
(let ([init-min-var (f (unsafe-vector-ref xs 0))])
(unless (real? init-min-var)
(raise-type-error name "procedure that returns real numbers" f))
(let-values ([(min* min-var*)
(for/fold ([min (unsafe-vector*-ref xs 0)]
(for/fold ([min (unsafe-vector-ref xs 0)]
[min-var init-min-var])
([e (in-vector xs 1)])
(let ([new-min (f e)])
@ -228,11 +228,11 @@
(define (name val vec)
(unless (vector? vec)
(raise-type-error 'name "vector" 1 vec))
(let ([sz (unsafe-vector*-length vec)])
(let ([sz (unsafe-vector-length vec)])
(let loop ([k 0])
(cond [(= k sz) #f]
[(cmp val
(unsafe-vector*-ref vec k))
(unsafe-vector-ref vec k))
k]
[else (loop (unsafe-fx+ 1 k))])))))

28
collects/scribblings/reference/unsafe.scrbl
View File

@ -192,22 +192,22 @@ Unsafe variants of @scheme[car], @scheme[cdr], @scheme[mcar],
@deftogether[(
@defproc[(unsafe-unbox [v (and/c box? (not/c chaperone?))]) any/c]
@defproc[(unsafe-set-box! [v (and/c box? (not/c chaperone?))] [val any/c]) void?]
@defproc[(unsafe-unbox* [b box?]) fixnum?]
@defproc[(unsafe-set-box*! [b box?] [k fixnum?]) void?]
@defproc[(unsafe-unbox [b box?]) fixnum?]
@defproc[(unsafe-set-box! [b box?] [k fixnum?]) void?]
@defproc[(unsafe-unbox* [v (and/c box? (not/c chaperone?))]) any/c]
@defproc[(unsafe-set-box*! [v (and/c box? (not/c chaperone?))] [val any/c]) void?]
)]{
Unsafe versions of @scheme[unbox] and @scheme[set-box!].}
@deftogether[(
@defproc[(unsafe-vector-length [v (and/c vector? (not/c chaperone?))]) fixnum?]
@defproc[(unsafe-vector-ref [v (and/c vector? (not/c chaperone?))] [k fixnum?]) any/c]
@defproc[(unsafe-vector-set! [v (and/c vector? (not/c chaperone?))] [k fixnum?] [val any/c]) void?]
@defproc[(unsafe-vector*-length [v vector?]) fixnum?]
@defproc[(unsafe-vector*-ref [v vector?] [k fixnum?]) any/c]
@defproc[(unsafe-vector*-set! [v vector?] [k fixnum?] [val any/c]) void?]
@defproc[(unsafe-vector-length [v vector?]) fixnum?]
@defproc[(unsafe-vector-ref [v vector?] [k fixnum?]) any/c]
@defproc[(unsafe-vector-set! [v vector?] [k fixnum?] [val any/c]) void?]
@defproc[(unsafe-vector*-length [v (and/c vector? (not/c chaperone?))]) fixnum?]
@defproc[(unsafe-vector*-ref [v (and/c vector? (not/c chaperone?))] [k fixnum?]) any/c]
@defproc[(unsafe-vector*-set! [v (and/c vector? (not/c chaperone?))] [k fixnum?] [val any/c]) void?]
)]{
Unsafe versions of @scheme[vector-length], @scheme[vector-ref], and
@ -282,10 +282,10 @@ Unsafe versions of @scheme[u16vector-ref] and
@deftogether[(
@defproc[(unsafe-struct-ref [v (not/c chaperone?)] [k fixnum?]) any/c]
@defproc[(unsafe-struct-set! [v (not/c chaperone?)] [k fixnum?] [val any/c]) void?]
@defproc[(unsafe-struct*-ref [v any/c] [k fixnum?]) any/c]
@defproc[(unsafe-struct*-set! [v any/c] [k fixnum?] [val any/c]) void?]
@defproc[(unsafe-struct-ref [v any/c] [k fixnum?]) any/c]
@defproc[(unsafe-struct-set! [v any/c] [k fixnum?] [val any/c]) void?]
@defproc[(unsafe-struct*-ref [v (not/c chaperone?)] [k fixnum?]) any/c]
@defproc[(unsafe-struct*-set! [v (not/c chaperone?)] [k fixnum?] [val any/c]) void?]
)]{
Unsafe field access and update for an instance of a structure

16
collects/tests/racket/benchmarks/shootout/nbody-vec.rkt
View File

@ -94,10 +94,10 @@ Correct output N = 1000 is
(let loop-i ([i 0] [px 0.0] [py 0.0] [pz 0.0])
(if (unsafe-fx= i *system-size*)
(begin
(set-body-vx! (unsafe-vector-ref *system* 0) (fl/ (fl- 0.0 px) +solar-mass+))
(set-body-vy! (unsafe-vector-ref *system* 0) (fl/ (fl- 0.0 py) +solar-mass+))
(set-body-vz! (unsafe-vector-ref *system* 0) (fl/ (fl- 0.0 pz) +solar-mass+)))
(let ([i1 (unsafe-vector-ref *system* i)])
(set-body-vx! (unsafe-vector*-ref *system* 0) (fl/ (fl- 0.0 px) +solar-mass+))
(set-body-vy! (unsafe-vector*-ref *system* 0) (fl/ (fl- 0.0 py) +solar-mass+))
(set-body-vz! (unsafe-vector*-ref *system* 0) (fl/ (fl- 0.0 pz) +solar-mass+)))
(let ([i1 (unsafe-vector*-ref *system* i)])
(loop-i (unsafe-fx+ i 1)
(fl+ px (fl* (body-vx i1) (body-mass i1)))
(fl+ py (fl* (body-vy i1) (body-mass i1)))
@ -108,7 +108,7 @@ Correct output N = 1000 is
(let loop-o ([o 0] [e 0.0])
(if (unsafe-fx= o *system-size*)
e
(let* ([o1 (unsafe-vector-ref *system* o)]
(let* ([o1 (unsafe-vector*-ref *system* o)]
[e (fl+ e (fl* (fl* 0.5 (body-mass o1))
(fl+ (fl+ (fl* (body-vx o1) (body-vx o1))
(fl* (body-vy o1) (body-vy o1)))
@ -116,7 +116,7 @@ Correct output N = 1000 is
(let loop-i ([i (unsafe-fx+ o 1)] [e e])
(if (unsafe-fx= i *system-size*)
(loop-o (unsafe-fx+ o 1) e)
(let* ([i1 (unsafe-vector-ref *system* i)]
(let* ([i1 (unsafe-vector*-ref *system* i)]
[dx (fl- (body-x o1) (body-x i1))]
[dy (fl- (body-y o1) (body-y i1))]
[dz (fl- (body-z o1) (body-z i1))]
@ -128,13 +128,13 @@ Correct output N = 1000 is
(define (advance)
(let loop-o ([o 0])
(unless (unsafe-fx= o *system-size*)
(let* ([o1 (unsafe-vector-ref *system* o)])
(let* ([o1 (unsafe-vector*-ref *system* o)])
(let loop-i ([i (unsafe-fx+ o 1)]
[vx (body-vx o1)]
[vy (body-vy o1)]
[vz (body-vz o1)])
(if (unsafe-fx< i *system-size*)
(let* ([i1 (unsafe-vector-ref *system* i)]
(let* ([i1 (unsafe-vector*-ref *system* i)]
[dx (fl- (body-x o1) (body-x i1))]
[dy (fl- (body-y o1) (body-y i1))]
[dz (fl- (body-z o1) (body-z i1))]

18
collects/tests/racket/unsafe.rktl
View File

@ -231,9 +231,9 @@
#:pre (lambda () (set-box! b 12))
#:post (lambda (x) (list x (unbox b)))
#:literal-ok? #f)))
(test-un 3 'unsafe-unbox* (chaperone-box (box 3)
(lambda (b v) v)
(lambda (b v) v)))
(test-un 3 'unsafe-unbox (chaperone-box (box 3)
(lambda (b v) v)
(lambda (b v) v)))
(for ([star (list values (add-star "vector"))])
(test-bin 5 (star 'unsafe-vector-ref) #(1 5 7) 1)
@ -243,13 +243,13 @@
#:pre (lambda () (vector-set! v 2 0))
#:post (lambda (x) (list x (vector-ref v 2)))
#:literal-ok? #f)))
(test-bin 5 'unsafe-vector*-ref (chaperone-vector #(1 5 7)
(lambda (v i x) x)
(lambda (v i x) x))
(test-bin 5 'unsafe-vector-ref (chaperone-vector #(1 5 7)
(lambda (v i x) x)
(lambda (v i x) x))
1)
(test-un 3 'unsafe-vector*-length (chaperone-vector #(1 5 7)
(lambda (v i x) x)
(lambda (v i x) x)))
(test-un 3 'unsafe-vector-length (chaperone-vector #(1 5 7)
(lambda (v i x) x)
(lambda (v i x) x)))
(test-bin 53 'unsafe-bytes-ref #"157" 1)
(test-un 3 'unsafe-bytes-length #"157")

4
collects/typed-scheme/optimizer/box.rkt
View File

@ -21,8 +21,8 @@
(define-syntax-class box-op
#:commit
;; we need the * versions of these unsafe operations to be chaperone-safe
(pattern (~literal unbox) #:with unsafe #'unsafe-unbox*)
(pattern (~literal set-box!) #:with unsafe #'unsafe-set-box*!))
(pattern (~literal unbox) #:with unsafe #'unsafe-unbox)
(pattern (~literal set-box!) #:with unsafe #'unsafe-set-box!))
(define-syntax-class box-opt-expr
#:commit

4
collects/typed-scheme/optimizer/sequence.rkt
View File

@ -51,8 +51,8 @@
#:with opt
(begin (log-optimization "in-vector" #'op)
#'(let* ((i v*.opt)
(len (unsafe-vector*-length i)))
(values (lambda (x) (unsafe-vector*-ref i x))
(len (unsafe-vector-length i)))
(values (lambda (x) (unsafe-vector-ref i x))
(lambda (x) (unsafe-fx+ 1 x))
0
(lambda (x) (unsafe-fx< x len))

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

@ -14,8 +14,8 @@
(define-syntax-class vector-op
#:commit
;; 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!))
(pattern (~literal vector-ref) #:with unsafe #'unsafe-vector-ref)
(pattern (~literal vector-set!) #:with unsafe #'unsafe-vector-set!))
(define-syntax-class vector-expr
#:commit
@ -43,7 +43,7 @@
(pattern (#%plain-app (~and op (~literal vector-length)) v:expr)
#:with opt
(begin (log-optimization "vector-length" #'op)
#`(unsafe-vector*-length #,((optimize) #'v))))
#`(unsafe-vector-length #,((optimize) #'v))))
;; same for flvector-length
(pattern (#%plain-app (~and op (~literal flvector-length)) v:expr)
#:with opt

1
doc/release-notes/racket/HISTORY.txt
View File

@ -1,6 +1,7 @@
Version 5.0.2, October 2010
Changed body of `when', `unless', `cond' clauses, `case'
clauses, and `match' clauses to be internal-definition contexts
Swapped unsafe-vector*-ref with unsafe-vector-ref, etc.
Added ->i to the contract library, improved ->*, adding #:pre and
#:post, as well as making the optional arguments clause optional.
Added #true and #false, and changed #t/#T and #f/#F to

32
src/racket/src/jit.c
View File

@ -7025,10 +7025,10 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
GC_CAN_IGNORE jit_insn *reffail, *ref;
int unsafe = 0, for_fl = 0, for_fx = 0, can_chaperone = 0;
if (IS_NAMED_PRIM(rator, "unsafe-vector-length")
if (IS_NAMED_PRIM(rator, "unsafe-vector*-length")
|| IS_NAMED_PRIM(rator, "unsafe-fxvector-length")) {
unsafe = 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-vector*-length")) {
} else if (IS_NAMED_PRIM(rator, "unsafe-vector-length")) {
unsafe = 1;
can_chaperone = 1;
} else if (IS_NAMED_PRIM(rator, "flvector-length")) {
@ -7151,7 +7151,7 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
__END_TINY_JUMPS__(1);
return 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-unbox")) {
} else if (IS_NAMED_PRIM(rator, "unsafe-unbox*")) {
LOG_IT(("inlined unbox\n"));
mz_runstack_skipped(jitter, 1);
@ -7164,7 +7164,7 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
(void)jit_ldxi_p(JIT_R0, JIT_R0, &SCHEME_BOX_VAL(0x0));
return 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-unbox*")) {
} else if (IS_NAMED_PRIM(rator, "unsafe-unbox")) {
GC_CAN_IGNORE jit_insn *ref, *ref2;
LOG_IT(("inlined unbox\n"));
@ -8215,7 +8215,7 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
which = 0;
for_fx = 1;
can_chaperone = 0;
} else if (IS_NAMED_PRIM(rator, "unsafe-vector-ref")) {
} else if (IS_NAMED_PRIM(rator, "unsafe-vector*-ref")) {
which = 0;
unsafe = 1;
can_chaperone = 0;
@ -8224,7 +8224,7 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
unsafe = 1;
can_chaperone = 0;
for_fx = 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-vector*-ref")) {
} else if (IS_NAMED_PRIM(rator, "unsafe-vector-ref")) {
which = 0;
unsafe = 1;
} else if (IS_NAMED_PRIM(rator, "flvector-ref")) {
@ -8236,13 +8236,13 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
jitter->unbox = 0;
}
can_chaperone = 0;
} else if (IS_NAMED_PRIM(rator, "unsafe-struct-ref")) {
} else if (IS_NAMED_PRIM(rator, "unsafe-struct*-ref")) {
which = 0;
unsafe = 1;
base_offset = ((int)&((Scheme_Structure *)0x0)->slots);
can_chaperone = 0;
for_struct = 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-struct*-ref")) {
} else if (IS_NAMED_PRIM(rator, "unsafe-struct-ref")) {
which = 0;
unsafe = 1;
base_offset = ((int)&((Scheme_Structure *)0x0)->slots);
@ -8482,13 +8482,13 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
return 1;
} else if (IS_NAMED_PRIM(rator, "set-box!")
|| IS_NAMED_PRIM(rator, "unsafe-set-box*!")) {
|| IS_NAMED_PRIM(rator, "unsafe-set-box!")) {
GC_CAN_IGNORE jit_insn *ref, *ref2, *ref3, *reffail;
int unsafe;
LOG_IT(("inlined set-box!\n"));
unsafe = IS_NAMED_PRIM(rator, "unsafe-set-box*!");
unsafe = IS_NAMED_PRIM(rator, "unsafe-set-box!");
generate_two_args(app->rand1, app->rand2, jitter, 1, 2);
CHECK_LIMIT();
@ -8522,8 +8522,8 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
(void)jit_movi_p(JIT_R0, scheme_void);
return 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-set-box!")) {
LOG_IT(("inlined unsafe-set-box!\n"));
} else if (IS_NAMED_PRIM(rator, "unsafe-set-box*!")) {
LOG_IT(("inlined unsafe-set-box*!\n"));
generate_two_args(app->rand1, app->rand2, jitter, 1, 2);
CHECK_LIMIT();
@ -8766,7 +8766,7 @@ static int generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
} else if (IS_NAMED_PRIM(rator, "fxvector-set!")) {
which = 0;
for_fx = 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-vector-set!")) {
} else if (IS_NAMED_PRIM(rator, "unsafe-vector*-set!")) {
which = 0;
unsafe = 1;
can_chaperone = 0;
@ -8775,19 +8775,19 @@ static int generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
unsafe = 1;
can_chaperone = 0;
for_fx = 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-vector*-set!")) {
} else if (IS_NAMED_PRIM(rator, "unsafe-vector-set!")) {
which = 0;
unsafe = 1;
} else if (IS_NAMED_PRIM(rator, "flvector-set!")) {
which = 3;
base_offset = ((int)&SCHEME_FLVEC_ELS(0x0));
} else if (IS_NAMED_PRIM(rator, "unsafe-struct-set!")) {
} else if (IS_NAMED_PRIM(rator, "unsafe-struct*-set!")) {
which = 0;
unsafe = 1;
base_offset = ((int)&((Scheme_Structure *)0x0)->slots);
can_chaperone = 0;
for_struct = 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-struct*-set!")) {
} else if (IS_NAMED_PRIM(rator, "unsafe-struct-set!")) {
which = 0;
unsafe = 1;
base_offset = ((int)&((Scheme_Structure *)0x0)->slots);

8
src/racket/src/list.c
View File

@ -3431,12 +3431,12 @@ static Scheme_Object *unsafe_set_mcdr (int argc, Scheme_Object *argv[])
return scheme_void;
}
static Scheme_Object *unsafe_unbox (int argc, Scheme_Object *argv[])
static Scheme_Object *unsafe_unbox_star (int argc, Scheme_Object *argv[])
{
return SCHEME_BOX_VAL(argv[0]);
}
static Scheme_Object *unsafe_unbox_star (int argc, Scheme_Object *argv[])
static Scheme_Object *unsafe_unbox (int argc, Scheme_Object *argv[])
{
if (SCHEME_NP_CHAPERONEP(argv[0]))
return chaperone_unbox(argv[0]);
@ -3444,13 +3444,13 @@ static Scheme_Object *unsafe_unbox_star (int argc, Scheme_Object *argv[])
return SCHEME_BOX_VAL(argv[0]);
}
static Scheme_Object *unsafe_set_box (int argc, Scheme_Object *argv[])
static Scheme_Object *unsafe_set_box_star (int argc, Scheme_Object *argv[])
{
SCHEME_BOX_VAL(argv[0]) = argv[1];
return scheme_void;
}
static Scheme_Object *unsafe_set_box_star (int argc, Scheme_Object *argv[])
static Scheme_Object *unsafe_set_box (int argc, Scheme_Object *argv[])
{
if (SCHEME_NP_CHAPERONEP(argv[0]))
chaperone_set_box(argv[0], argv[1]);