From ff478f31732543a9b7ef6fb9635e64f9ea203e49 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 5 Jan 2014 06:45:16 -0700 Subject: [PATCH] allow optimizer to move `mcons` and `box-immutable` Suggested by Gustavo Massaccesi. --- .../racket-test/tests/racket/optimize.rktl | 26 +++++++++++++++++++ racket/src/racket/src/list.c | 3 +++ racket/src/racket/src/optimize.c | 4 ++- racket/src/racket/src/schpriv.h | 1 + 4 files changed, 33 insertions(+), 1 deletion(-) diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl index 0e1a67bb36..971d77ad70 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl +++ b/pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl @@ -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 diff --git a/racket/src/racket/src/list.c b/racket/src/racket/src/list.c index fd83ecbfcd..717777ddef 100644 --- a/racket/src/racket/src/list.c +++ b/racket/src/racket/src/list.c @@ -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); diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c index e30e8c2d04..f5cd71ede1 100644 --- a/racket/src/racket/src/optimize.c +++ b/racket/src/racket/src/optimize.c @@ -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; diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index e9945cec4c..302b3268c8 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -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;