diff --git a/pkgs/racket-test-core/tests/racket/optimize.rktl b/pkgs/racket-test-core/tests/racket/optimize.rktl index a9d5b5a1fb..ed55e36b5c 100644 --- a/pkgs/racket-test-core/tests/racket/optimize.rktl +++ b/pkgs/racket-test-core/tests/racket/optimize.rktl @@ -1269,6 +1269,18 @@ (display (primitive? map)) (display (lambda (f l) (map f l) (procedure? f))))) +(test-comp '(lambda (w z) (vector? (list->vector w))) + '(lambda (w z) (list->vector w) #t)) +(test-comp '(lambda (w z) (vector? (struct->vector w))) + '(lambda (w z) (struct->vector w) #t)) +(test-comp '(lambda (w z) (vector? (struct->vector w z))) + '(lambda (w z) (struct->vector w z) #t)) + +(test-comp '(lambda (w z) (vector? (make-vector (w) (z)))) + '(lambda (w z) (make-vector (w) (z)) #t)) +(test-comp '(lambda (w z) (vector? (make-vector (w)))) + '(lambda (w z) (make-vector (w)) #t)) + (test-comp '(lambda (w z) (let ([x (list* w z)] [y (list* z w)]) diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c index 25aad22c35..a1379c36a6 100644 --- a/racket/src/racket/src/optimize.c +++ b/racket/src/racket/src/optimize.c @@ -2381,11 +2381,10 @@ static Scheme_Object *local_type_to_predicate(int t) static Scheme_Object *rator_implies_predicate(Scheme_Object *rator, int argc) { if (SCHEME_PRIMP(rator)) { - if ((argc == 2) - && (SAME_OBJ(rator, scheme_cons_proc) - || SAME_OBJ(rator, scheme_unsafe_cons_list_proc))) + if ((SAME_OBJ(rator, scheme_cons_proc) + || SAME_OBJ(rator, scheme_unsafe_cons_list_proc))) return scheme_pair_p_proc; - else if ((argc == 2) && SAME_OBJ(rator, scheme_mcons_proc)) + else if (SAME_OBJ(rator, scheme_mcons_proc)) return scheme_mpair_p_proc; else if (SAME_OBJ(rator, scheme_list_proc)) { if (argc >= 1) @@ -2396,11 +2395,13 @@ static Scheme_Object *rator_implies_predicate(Scheme_Object *rator, int argc) if (argc > 2) return scheme_pair_p_proc; } else if (SAME_OBJ(rator, scheme_vector_proc) - || SAME_OBJ(rator, scheme_vector_immutable_proc)) + || SAME_OBJ(rator, scheme_vector_immutable_proc) + || SAME_OBJ(rator, scheme_make_vector_proc) + || SAME_OBJ(rator, scheme_list_to_vector_proc) + || SAME_OBJ(rator, scheme_struct_to_vector_proc)) return scheme_vector_p_proc; - else if ((argc == 1) - && (SAME_OBJ(rator, scheme_box_proc) - || SAME_OBJ(rator, scheme_box_immutable_proc))) + else if (SAME_OBJ(rator, scheme_box_proc) + || SAME_OBJ(rator, scheme_box_immutable_proc)) return scheme_box_p_proc; { @@ -2807,7 +2808,7 @@ static Scheme_Object *finish_optimize_any_application(Scheme_Object *app, Scheme { check_known_rator(info, rator, 0); - if (context & OPT_CONTEXT_BOOLEAN) + if ((context & OPT_CONTEXT_BOOLEAN) && !info->escapes) if (rator_implies_predicate(rator, argc)) return make_discarding_sequence(app, scheme_true, info, 0); diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 9516b5ccfc..9d338b5f5b 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -458,9 +458,11 @@ extern Scheme_Object *scheme_list_proc; extern Scheme_Object *scheme_list_star_proc; extern Scheme_Object *scheme_vector_proc; extern Scheme_Object *scheme_vector_p_proc; +extern Scheme_Object *scheme_make_vector_proc; extern Scheme_Object *scheme_vector_immutable_proc; extern Scheme_Object *scheme_vector_ref_proc; extern Scheme_Object *scheme_vector_set_proc; +extern Scheme_Object *scheme_list_to_vector_proc; extern Scheme_Object *scheme_unsafe_vector_length_proc; extern Scheme_Object *scheme_hash_ref_proc; extern Scheme_Object *scheme_box_p_proc; @@ -470,6 +472,7 @@ extern Scheme_Object *scheme_call_with_values_proc; extern Scheme_Object *scheme_make_struct_type_proc; extern Scheme_Object *scheme_make_struct_field_accessor_proc; extern Scheme_Object *scheme_make_struct_field_mutator_proc; +extern Scheme_Object *scheme_struct_to_vector_proc; extern Scheme_Object *scheme_struct_type_p_proc; extern Scheme_Object *scheme_current_inspector_proc; extern Scheme_Object *scheme_make_inspector_proc; diff --git a/racket/src/racket/src/struct.c b/racket/src/racket/src/struct.c index b16df10fe6..1f08d4c73c 100644 --- a/racket/src/racket/src/struct.c +++ b/racket/src/racket/src/struct.c @@ -48,6 +48,7 @@ READ_ONLY Scheme_Object *scheme_write_special_symbol; READ_ONLY Scheme_Object *scheme_app_mark_impersonator_property; READ_ONLY Scheme_Object *scheme_liberal_def_ctx_type;; READ_ONLY Scheme_Object *scheme_object_name_property; +READ_ONLY Scheme_Object *scheme_struct_to_vector_proc; READ_ONLY static Scheme_Object *location_struct; READ_ONLY static Scheme_Object *write_property; @@ -659,11 +660,13 @@ scheme_init_struct (Scheme_Env *env) "struct-type-make-constructor", 1, 2), env); - scheme_add_global_constant("struct->vector", - scheme_make_prim_w_arity(struct_to_vector, - "struct->vector", - 1, 2), - env); + + REGISTER_SO(scheme_struct_to_vector_proc); + scheme_struct_to_vector_proc = scheme_make_noncm_prim(struct_to_vector, + "struct->vector", + 1, 2); + scheme_add_global_constant("struct->vector", scheme_struct_to_vector_proc, env); + scheme_add_global_constant("prefab-struct-key", scheme_make_immed_prim(prefab_struct_key, "prefab-struct-key", diff --git a/racket/src/racket/src/vector.c b/racket/src/racket/src/vector.c index 7c7c771b90..7ff4866af0 100644 --- a/racket/src/racket/src/vector.c +++ b/racket/src/racket/src/vector.c @@ -29,9 +29,11 @@ /* globals */ READ_ONLY Scheme_Object *scheme_vector_proc; READ_ONLY Scheme_Object *scheme_vector_p_proc; +READ_ONLY Scheme_Object *scheme_make_vector_proc; READ_ONLY Scheme_Object *scheme_vector_immutable_proc; 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; /* locals */ @@ -78,12 +80,11 @@ scheme_init_vector (Scheme_Env *env) scheme_add_global_constant("vector?", p, env); scheme_vector_p_proc = p; - scheme_add_global_constant("make-vector", - scheme_make_immed_prim(make_vector, - "make-vector", - 1, 2), - env); - + REGISTER_SO(scheme_make_vector_proc); + p = scheme_make_immed_prim(make_vector, "make-vector", 1, 2); + scheme_add_global_constant("make-vector", p, env); + scheme_make_vector_proc = p; + REGISTER_SO(scheme_vector_proc); p = scheme_make_immed_prim(vector, "vector", 0, -1); scheme_vector_proc = p; @@ -128,11 +129,14 @@ scheme_init_vector (Scheme_Env *env) "vector->list", 1, 1), env); - scheme_add_global_constant("list->vector", - scheme_make_immed_prim(list_to_vector, - "list->vector", - 1, 1), - env); + + REGISTER_SO(scheme_list_to_vector_proc); + p = scheme_make_immed_prim(list_to_vector, + "list->vector", + 1, 1); + scheme_list_to_vector_proc = p; + scheme_add_global_constant("list->vector", p, env); + scheme_add_global_constant("vector-fill!", scheme_make_immed_prim(vector_fill, "vector-fill!",