Mark the result of more procedures as vector?

The result of some procedures is a vector, but they are not omittable
because they may rise an error. With the recent changes of the
predicate reduction these cases are correctly handled.

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)])

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)
+    if ((SAME_OBJ(rator, scheme_cons_proc)
-        && (SAME_OBJ(rator, scheme_cons_proc)
+         || SAME_OBJ(rator, scheme_unsafe_cons_list_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)
+    else if (SAME_OBJ(rator, scheme_box_proc)
-             && (SAME_OBJ(rator, scheme_box_proc)
+             || SAME_OBJ(rator, scheme_box_immutable_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);
 

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;

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,
+  REGISTER_SO(scheme_struct_to_vector_proc);
-						      "struct->vector",
+  scheme_struct_to_vector_proc = scheme_make_noncm_prim(struct_to_vector,
-						      1, 2),
+                                                        "struct->vector",
-			     env);
+                                                        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",

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,11 +80,10 @@ scheme_init_vector (Scheme_Env *env)
   scheme_add_global_constant("vector?", p, env);
   scheme_vector_p_proc = p;
 
-  scheme_add_global_constant("make-vector", 
+  REGISTER_SO(scheme_make_vector_proc);
-			     scheme_make_immed_prim(make_vector, 
+  p = scheme_make_immed_prim(make_vector, "make-vector", 1, 2);
-						    "make-vector", 
+  scheme_add_global_constant("make-vector", p, env);
-						    1, 2), 
+  scheme_make_vector_proc = p;
-			     env);
 
   REGISTER_SO(scheme_vector_proc);
   p = scheme_make_immed_prim(vector, "vector", 0, -1);
@@ -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, 
+  REGISTER_SO(scheme_list_to_vector_proc);
-						    "list->vector", 
+  p = scheme_make_immed_prim(list_to_vector, 
-						    1, 1), 
+                             "list->vector", 
-			     env);
+                             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!",