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

Mark the result of more procedures as vector?

Browse Source 
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.
This commit is contained in:
Gustavo Massaccesi 2015-04-04 17:00:00 -03:00
parent 39fda5ec9e
commit 2be6eb9570
5 changed files with 48 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

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

@ -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);

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

@ -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;

13
racket/src/racket/src/struct.c
View File

@ -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",

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

@ -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!",