diff --git a/pkgs/racket-test-core/tests/racket/optimize.rktl b/pkgs/racket-test-core/tests/racket/optimize.rktl index 3b456e64be..0787cd97ed 100644 --- a/pkgs/racket-test-core/tests/racket/optimize.rktl +++ b/pkgs/racket-test-core/tests/racket/optimize.rktl @@ -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)) diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c index 2bb3487d2f..7e3d4d45ab 100644 --- a/racket/src/racket/src/optimize.c +++ b/racket/src/racket/src/optimize.c @@ -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) diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index a6be09e7ee..b46d5fc1f9 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -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; diff --git a/racket/src/racket/src/string.c b/racket/src/racket/src/string.c index a3ebd33032..1959a33282 100644 --- a/racket/src/racket/src/string.c +++ b/racket/src/racket/src/string.c @@ -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, diff --git a/racket/src/racket/src/vector.c b/racket/src/racket/src/vector.c index 4f58f759ff..4423bd9cda 100644 --- a/racket/src/racket/src/vector.c +++ b/racket/src/racket/src/vector.c @@ -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