allow optimizer to move mcons and box-immutable

Suggested by Gustavo Massaccesi.
This commit is contained in:
Matthew Flatt 2014-01-05 06:45:16 -07:00
parent aeaf018d01
commit ff478f3173
4 changed files with 33 additions and 1 deletions

View File

@ -1586,6 +1586,32 @@
(test-bin 'eq?)
(test-bin 'eqv?))
(let ([test-move
(lambda (expr [same? #t])
(test-comp `(lambda (z)
(let ([x ,expr])
(let ([y (read)])
(list y x))))
`(lambda (z)
(list (read) ,expr))
same?))])
(test-move '(cons 1 2))
(test-move '(mcons 1 2))
(test-move '(list 1))
(test-move '(list 1 2))
(test-move '(list 1 2 3))
(test-move '(list* 1 2))
(test-move '(list* 1 2 3))
(test-move '(vector 1))
(test-move '(vector 1 2))
(test-move '(vector 1 2 3))
(test-move '(box 2))
(test-move '(box-immutable 2))
(test-move '(cons 1 2 3) #f)
(test-move '(mcons 1 2 3) #f)
(test-move '(box 1 2) #f)
(test-move '(box-immutable 1 2) #f))
(let ([test-use-unsafe
(lambda (pred op unsafe-op)
(test-comp `(module m racket/base

View File

@ -35,6 +35,7 @@ READ_ONLY Scheme_Object *scheme_mcons_proc;
READ_ONLY Scheme_Object *scheme_list_proc;
READ_ONLY Scheme_Object *scheme_list_star_proc;
READ_ONLY Scheme_Object *scheme_box_proc;
READ_ONLY Scheme_Object *scheme_box_immutable_proc;
READ_ONLY Scheme_Object *scheme_box_p_proc;
READ_ONLY Scheme_Object *scheme_hash_ref_proc;
READ_ONLY Scheme_Object *scheme_unsafe_cons_list_proc;
@ -432,7 +433,9 @@ scheme_init_list (Scheme_Env *env)
| SCHEME_PRIM_IS_OMITABLE);
scheme_add_global_constant(BOX, p, env);
REGISTER_SO(scheme_box_immutable_proc);
p = scheme_make_immed_prim(immutable_box, "box-immutable", 1, 1);
scheme_box_immutable_proc = p;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE);
scheme_add_global_constant("box-immutable", p, env);

View File

@ -954,11 +954,13 @@ static int is_movable_prim(Scheme_Object *rator, int n, int cross_lambda)
return values that contain all arguments: */
&& (SAME_OBJ(scheme_list_proc, rator)
|| (SAME_OBJ(scheme_cons_proc, rator) && (n == 2))
|| (SAME_OBJ(scheme_mcons_proc, rator) && (n == 2))
|| (SAME_OBJ(scheme_unsafe_cons_list_proc, rator) && (n == 2))
|| SAME_OBJ(scheme_list_star_proc, rator)
|| SAME_OBJ(scheme_vector_proc, rator)
|| SAME_OBJ(scheme_vector_immutable_proc, rator)
|| (SAME_OBJ(scheme_box_proc, rator) && (n == 1))))
|| (SAME_OBJ(scheme_box_proc, rator) && (n == 1))
|| (SAME_OBJ(scheme_box_immutable_proc, rator) && (n == 1))))
return 1;
return 0;

View File

@ -447,6 +447,7 @@ extern Scheme_Object *scheme_unsafe_vector_length_proc;
extern Scheme_Object *scheme_hash_ref_proc;
extern Scheme_Object *scheme_box_p_proc;
extern Scheme_Object *scheme_box_proc;
extern Scheme_Object *scheme_box_immutable_proc;
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;