allow optimizer to move mcons
and box-immutable
Suggested by Gustavo Massaccesi.
This commit is contained in:
parent
aeaf018d01
commit
ff478f3173
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
|
Loading…
Reference in New Issue
Block a user