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

Minimal optimizer safe-to-unsafe commit

Browse Source
This commit is contained in:
Jay McCarthy 2016-04-05 15:43:44 -04:00
parent ee623160a4
commit cf70c4a241
5 changed files with 19 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
pkgs/racket-test-core/tests/racket/optimize.rktl
View File

@ -3129,6 +3129,7 @@
(test-use-unsafe 'mpair? 'mcdr 'unsafe-mcdr)
(test-use-unsafe 'box? 'unbox 'unsafe-unbox)
(test-use-unsafe 'vector? 'vector-length 'unsafe-vector-length)
(test-use-unsafe 'bytes? 'bytes-length 'unsafe-bytes-length)
(test-use-unsafe/savetype 'fixnum? 'bitwise-not 'unsafe-fxnot #f)
(test-use-unsafe/savetype 'fixnum? 'fxnot 'unsafe-fxnot #f))

9
racket/src/racket/src/optimize.c
View File

@ -2573,6 +2573,9 @@ static Scheme_Object *rator_implies_predicate(Scheme_Object *rator, int argc)
return scheme_list_pair_p_proc;
else if (SAME_OBJ(rator, scheme_mcons_proc))
return scheme_mpair_p_proc;
// XXX This could be implemented
// else if (SAME_OBJ(rator, scheme_make_byte_string_p))
// return scheme_byte_string_p_proc;
else if (SAME_OBJ(rator, scheme_list_proc)) {
if (argc >= 1)
return scheme_list_pair_p_proc;
@ -2817,6 +2820,8 @@ static Scheme_Object *do_expr_implies_predicate(Scheme_Object *expr, Optimize_In
return scheme_pair_p_proc;
if (SCHEME_MPAIRP(expr))
return scheme_mpair_p_proc;
if (SCHEME_BYTE_STRINGP(expr))
return scheme_byte_string_p_proc;
if (SCHEME_VOIDP(expr))
return scheme_void_p_proc;
if (SCHEME_EOFP(expr))
@ -3722,6 +3727,7 @@ static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimiz
check_known(info, app_o, rator, rand, "cdr", scheme_pair_p_proc, scheme_unsafe_cdr_proc);
check_known(info, app_o, rator, rand, "mcar", scheme_mpair_p_proc, scheme_unsafe_mcar_proc);
check_known(info, app_o, rator, rand, "mcdr", scheme_mpair_p_proc, scheme_unsafe_mcdr_proc);
check_known(info, app_o, rator, rand, "bytes-length", scheme_byte_string_p_proc, scheme_unsafe_bytes_len_proc);
/* It's not clear that these are useful, since a chaperone check is needed anyway: */
check_known(info, app_o, rator, rand, "unbox", scheme_box_p_proc, scheme_unsafe_unbox_proc);
check_known(info, app_o, rator, rand, "vector-length", scheme_vector_p_proc, scheme_unsafe_vector_length_proc);
@ -4639,7 +4645,8 @@ static int relevant_predicate(Scheme_Object *pred)
|| SAME_OBJ(pred, scheme_mpair_p_proc)
|| SAME_OBJ(pred, scheme_box_p_proc)
|| SAME_OBJ(pred, scheme_list_p_proc)
|| SAME_OBJ(pred, scheme_list_pair_p_proc)
|| SAME_OBJ(pred, scheme_list_pair_p_proc)
|| SAME_OBJ(pred, scheme_byte_string_p_proc)
|| SAME_OBJ(pred, scheme_vector_p_proc)
|| SAME_OBJ(pred, scheme_procedure_p_proc)
|| SAME_OBJ(pred, scheme_syntax_p_proc)

3
racket/src/racket/src/schpriv.h
View File

@ -546,6 +546,9 @@ extern Scheme_Object *scheme_unsafe_fxior_proc;
extern Scheme_Object *scheme_unsafe_fxxor_proc;
extern Scheme_Object *scheme_unsafe_fxrshift_proc;
extern Scheme_Object *scheme_byte_string_p_proc;
extern Scheme_Object *scheme_unsafe_bytes_len_proc;
extern Scheme_Object *scheme_unsafe_real_add1_proc;
extern Scheme_Object *scheme_unsafe_real_sub1_proc;
extern Scheme_Object *scheme_unsafe_real_abs_proc;

4
racket/src/racket/src/string.c
View File

@ -392,6 +392,8 @@ SHARED_OK static Scheme_Object *fs_change_props;
READ_ONLY static Scheme_Object *complete_symbol, *continues_symbol, *aborts_symbol, *error_symbol;
READ_ONLY Scheme_Object *scheme_byte_string_p_proc;
void
scheme_init_string (Scheme_Env *env)
{
@ -757,10 +759,12 @@ scheme_init_string (Scheme_Env *env)
1, 1, 1),
env);
REGISTER_SO(scheme_byte_string_p_proc);
p = scheme_make_folding_prim(byte_string_p, "bytes?", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED
| SCHEME_PRIM_IS_OMITABLE);
scheme_add_global_constant("bytes?", p, env);
scheme_byte_string_p_proc = p;
scheme_add_global_constant("make-bytes",
scheme_make_immed_prim(make_byte_string,

3
racket/src/racket/src/vector.c
View File

@ -35,6 +35,7 @@ READ_ONLY Scheme_Object *scheme_vector_ref_proc;
READ_ONLY Scheme_Object *scheme_vector_set_proc;
READ_ONLY Scheme_Object *scheme_list_to_vector_proc;
READ_ONLY Scheme_Object *scheme_unsafe_vector_length_proc;
READ_ONLY Scheme_Object *scheme_unsafe_bytes_len_proc;
/* locals */
static Scheme_Object *vector_p (int argc, Scheme_Object *argv[]);
@ -246,11 +247,13 @@ scheme_init_unsafe_vector (Scheme_Env *env)
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant("unsafe-string-set!", p, env);
REGISTER_SO(scheme_unsafe_bytes_len_proc);
p = scheme_make_immed_prim(unsafe_bytes_len, "unsafe-bytes-length", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-bytes-length", p, env);
scheme_unsafe_bytes_len_proc = p;
p = scheme_make_immed_prim(unsafe_bytes_ref, "unsafe-bytes-ref", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED