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

add `unsafe-list-{ref,set}'

Browse Source 
Use the new functions in `syntax-case'; the benefit is small, and
 it's mostly useful as hint to the optimizer that the operation
 can be dropped if the result isn't used
This commit is contained in:
Matthew Flatt 2011-07-07 16:34:49 -06:00
parent 848bba80a3
commit 65b1a569a0
9 changed files with 1025 additions and 938 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/racket/private/stxcase.rkt
View File

@ -2,7 +2,7 @@
;; syntax-case and syntax
(module stxcase '#%kernel
(#%require "stx.rkt" "small-scheme.rkt" '#%paramz
(#%require "stx.rkt" "small-scheme.rkt" '#%paramz '#%unsafe
"ellipses.rkt"
(for-syntax "stx.rkt" "small-scheme.rkt" "sc.rkt" '#%kernel))
@ -409,29 +409,23 @@
[(= tail-pattern-var pos)
(cond
[(eq? pos 0) 'tail]
[(eq? pos 1) (quote-syntax cdr)]
[(eq? pos 2) (quote-syntax cddr)]
[(eq? pos 3) (quote-syntax cdddr)]
[(eq? pos 4) (quote-syntax cddddr)]
[(eq? pos 1) (quote-syntax unsafe-cdr)]
[else 'tail])]
[(eq? pos 0) (quote-syntax car)]
[(eq? pos 1) (quote-syntax cadr)]
[(eq? pos 2) (quote-syntax caddr)]
[(eq? pos 3) (quote-syntax cadddr)]
[(eq? pos 0) (quote-syntax unsafe-car)]
[else #f])])
(cond
[(eq? accessor 'tail)
(if (zero? pos)
rslt
(list
(quote-syntax list-tail)
(quote-syntax unsafe-list-tail)
rslt
pos))]
[accessor (list
accessor
rslt)]
[else (list
(quote-syntax list-ref)
(quote-syntax unsafe-list-ref)
rslt
pos)])))))
pattern-vars temp-vars)

6
collects/scribblings/reference/pairs.scrbl
View File

@ -213,11 +213,13 @@ the list's first element is position @racket[0]. If the list has
@exnraise[exn:fail:contract].
The @racket[lst] argument need not actually be a list; @racket[lst]
must merely start with a chain of at least @racket[pos] pairs.
must merely start with a chain of at least @racket[(add1 pos)] pairs.
@mz-examples[
(list-ref (list 'a 'b 'c) 0)
(list-ref (list 'a 'b 'c) 1)
(list-ref (list 'a 'b 'c) 2)
(list-ref (cons 1 2) 0)
]}
@ -232,6 +234,8 @@ The @racket[lst] argument need not actually be a list; @racket[lst]
must merely start with a chain of at least @racket[pos] pairs.
@mz-examples[
(list-tail (list 1 2 3 4) 2)
(list-ref (cons 1 2) 1)
(list-ref 'not-a-pair 0)
]}

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

@ -191,6 +191,17 @@ Unsafe variants of @racket[car], @racket[cdr], @racket[mcar],
@racket[mcdr], @racket[set-mcar!], and @racket[set-mcdr!].}
@deftogether[(
@defproc[(unsafe-list-ref [lst any/c] [pos (and/c exact-nonnegative-integer? fixnum?)]) any/c]
@defproc[(unsafe-list-tail [lst any/c] [pos (and/c exact-nonnegative-integer? fixnum?)]) any/c]
)]{
Unsafe variants of @racket[list-ref] and @racket[list-tail], where
@racket[pos] must be a @tech{fixnum}, and @racket[lst] must start with
at least @racket[(add1 pos)] (for @racket[unsafe-list-ref]) or
@racket[pos] (for @racket[unsafe-list-tail]) pairs.}
@deftogether[(
@defproc[(unsafe-unbox [b box?]) fixnum?]
@defproc[(unsafe-set-box! [b box?] [k fixnum?]) void?]

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

@ -46,11 +46,11 @@
(test result (compose post (eval `(lambda (x y) (,proc x y)))) x y)
(when lit-ok?
(pre)
(test result (compose post (eval `(lambda (y) (,proc ,x y)))) y)
(test result (compose post (eval `(lambda (y) (,proc ',x y)))) y)
(pre)
(test result (compose post (eval `(lambda () (,proc ,x ,y))))))
(test result (compose post (eval `(lambda () (,proc ',x ',y))))))
(pre)
(test result (compose post (eval `(lambda (x) (,proc x ,y)))) x))
(test result (compose post (eval `(lambda (x) (,proc x ',y)))) x))
(define (test-un result proc x)
(test result (eval proc) x)
(test result (eval `(lambda (x) (,proc x))) x)
@ -221,6 +221,12 @@
#:pre (lambda () (set-mcdr! v 0))
#:post (lambda (x) (mcdr v))
#:literal-ok? #f))
(test-bin 5 'unsafe-list-ref (cons 5 9) 0)
(test-bin 8 'unsafe-list-ref (cons 5 (cons 8 9)) 1)
(test-bin 9 'unsafe-list-ref (cons 5 (cons 8 (cons 9 10))) 2)
(test-bin (cons 5 9) 'unsafe-list-tail (cons 5 9) 0)
(test-bin 9 'unsafe-list-tail (cons 5 9) 1)
(test-bin 8 'unsafe-list-tail (cons 5 (cons 9 8)) 2)
(for ([star (list values (add-star "box"))])
(test-un 3 (star 'unsafe-unbox) #&3)

1840
src/racket/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

28
src/racket/src/jitinline.c
View File

@ -2337,6 +2337,34 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
else
(void)jit_calli(sjc.list_tail_code);
return 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-list-ref")
|| IS_NAMED_PRIM(rator, "unsafe-list-tail")) {
if (SCHEME_INTP(app->rand2)) {
intptr_t v = SCHEME_INT_VAL(app->rand2);
if ((v >= 0) && (v <= 10)) {
mz_runstack_skipped(jitter, 2);
scheme_generate_non_tail(app->rand1, jitter, 0, 1, 0);
CHECK_LIMIT();
mz_runstack_unskipped(jitter, 2);
while (v--) {
jit_ldxi_p(JIT_R0, JIT_R0, (intptr_t)&SCHEME_CDR(0x0));
}
if (IS_NAMED_PRIM(rator, "unsafe-list-ref"))
jit_ldxi_p(JIT_R0, JIT_R0, (intptr_t)&SCHEME_CAR(0x0));
return 1;
}
}
generate_two_args(app->rand1, app->rand2, jitter, 1, 2);
if (IS_NAMED_PRIM(rator, "unsafe-list-ref"))
(void)jit_calli(sjc.list_ref_code);
else
(void)jit_calli(sjc.list_tail_code);
return 1;
} else if (IS_NAMED_PRIM(rator, "set-mcar!")
|| IS_NAMED_PRIM(rator, "set-mcdr!")) {

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

@ -148,6 +148,8 @@ static Scheme_Object *table_placeholder_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_car (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_cdr (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_list_ref (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_list_tail (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_mcar (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_mcdr (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_set_mcar (int argc, Scheme_Object *argv[]);
@ -733,6 +735,16 @@ scheme_init_unsafe_list (Scheme_Env *env)
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant ("unsafe-cdr", p, env);
p = scheme_make_folding_prim(unsafe_list_ref, "unsafe-list-tail", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant ("unsafe-list-ref", p, env);
p = scheme_make_folding_prim(unsafe_list_tail, "unsafe-list-tail", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant ("unsafe-list-tail", p, env);
p = scheme_make_immed_prim(unsafe_mcar, "unsafe-mcar", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant ("unsafe-mcar", p, env);
@ -3457,6 +3469,38 @@ static Scheme_Object *unsafe_cdr (int argc, Scheme_Object *argv[])
return SCHEME_CDR(argv[0]);
}
static Scheme_Object *unsafe_list_ref (int argc, Scheme_Object *argv[])
{
int i;
Scheme_Object *v;
if (scheme_current_thread->constant_folding) return scheme_checked_list_ref(argc, argv);
v = argv[0];
i = SCHEME_INT_VAL(argv[1]);
while (i--) {
v = SCHEME_CDR(v);
}
return SCHEME_CAR(v);
}
static Scheme_Object *unsafe_list_tail (int argc, Scheme_Object *argv[])
{
int i;
Scheme_Object *v;
if (scheme_current_thread->constant_folding) return scheme_checked_list_tail(argc, argv);
v = argv[0];
i = SCHEME_INT_VAL(argv[1]);
while (i--) {
v = SCHEME_CDR(v);
}
return v;
}
static Scheme_Object *unsafe_mcar (int argc, Scheme_Object *argv[])
{
return SCHEME_CAR(argv[0]);

2
src/racket/src/schminc.h
View File

@ -14,7 +14,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1026
#define EXPECTED_UNSAFE_COUNT 76
#define EXPECTED_UNSAFE_COUNT 78
#define EXPECTED_FLFXNUM_COUNT 68
#define EXPECTED_FUTURES_COUNT 11

4
src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "5.1.2.1"
#define MZSCHEME_VERSION "5.1.2.2"
#define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 1
#define MZSCHEME_VERSION_Z 2
#define MZSCHEME_VERSION_W 1
#define MZSCHEME_VERSION_W 2
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)