From 60934f1415a35f5d6fa168f36fa2b42d0af85efd Mon Sep 17 00:00:00 2001 From: Gustavo Massaccesi Date: Sat, 13 Sep 2014 08:48:59 -0300 Subject: [PATCH] optimizer: more optimizations for begin0 Move begin0 inside begin, for example (begin0 (begin X Y) Z) ==> (begin X (begin0 Y Z)) Try to replace more begin0 with begin when the first expression is movable Drop the begin0 when it has only one non omitable expression that preserves the continuation marks. --- .../racket-test/tests/racket/optimize.rktl | 35 +++++- racket/src/racket/src/compile.c | 2 +- racket/src/racket/src/optimize.c | 106 +++++++++++++----- 3 files changed, 114 insertions(+), 29 deletions(-) diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl index 20163252d5..4f69af851e 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl +++ b/pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl @@ -906,8 +906,16 @@ (test-comp 5 '(begin0 (begin0 5 'hi "apple" 1.5))) (test-comp 5 '(begin0 (begin0 5 'hi "apple") 1.5)) -; Can't drop `begin0' if the first expresson is not valueable: -(test-comp '(begin0 (begin0 (+ 1 2) 0) 0) '(begin0 (begin0 (+ 1 2) 'hi "apple") 1.5)) +; Can't drop `begin0' if the first expresson is may change cotinuation marks: +(test-comp '(lambda () 3) + '(lambda () (begin0 (begin0 (+ 1 2) 'hi "apple") 1.5))) +(test-comp '(lambda () (let ([sum +]) (begin0 (begin0 (+ 1 2) 'hi "apple") 1.5))) + '(lambda () (let ([sum +]) (begin0 (begin0 (sum 1 2) 'hi "apple") 1.5)))) +(test-comp '(lambda (f) (begin0 (begin0 (f 1 2) #f) #f)) + '(lambda (f) (begin0 (begin0 (f 1 2) 'hi "apple") 1.5))) +(test-comp '(lambda (f) (f 1 2)) + '(lambda (f) (begin0 (begin0 (f 1 2) 'hi "apple") 1.5)) + #f) (test-comp 5 '(begin 'hi "apple" 1.5 5)) (test-comp 5 '(begin (begin 'hi "apple" 1.5) 5)) @@ -917,6 +925,29 @@ (test-comp 5 '(begin (begin 'hi "apple" 1.5 5))) (test-comp 5 '(begin 'hi (begin "apple" 1.5 5))) +(test-comp '(lambda () (begin (random) 5)) + '(lambda () (begin0 5 (random)))) +(test-comp '(lambda () (begin (read) 5)) + '(lambda () (begin0 5 (read)))) +(test-comp '(lambda () (begin (random) (cons 1 2))) + '(lambda () (begin0 (cons 1 2) (random)))) +(test-comp '(lambda () (begin (read) (cons 1 2))) + '(lambda () (begin0 (cons 1 2) (read))) + #f) + +(test-comp '(lambda () (random)) + '(lambda () (begin0 (random) #f))) +(test-comp '(lambda (f) (f)) + '(lambda (f) (begin0 (f) #f)) + #f) + +(test-comp '(lambda (f) (begin (random) (begin0 (f) 7))) + '(lambda (f) (begin0 (begin (random) (f)) 7))) +(test-comp '(lambda () (begin (random) (random) (cons 1 2))) + '(lambda () (begin0 (begin (random) (cons 1 2)) (random)))) + + + (test-comp '(let ([x 8][y 9]) (lambda () x)) '(let ([x 8][y 9]) (lambda () (if #f y x)))) (test-comp '(let ([x 8][y 9]) (lambda () (+ x y))) diff --git a/racket/src/racket/src/compile.c b/racket/src/racket/src/compile.c index 83e3a3f6b3..7261983060 100644 --- a/racket/src/racket/src/compile.c +++ b/racket/src/racket/src/compile.c @@ -3015,7 +3015,7 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt) } if (addconst) - o->array[i] = scheme_make_integer(0); + o->array[i] = scheme_void; return (Scheme_Object *)o; } diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c index 389337bd33..2e7e7a7ee0 100644 --- a/racket/src/racket/src/optimize.c +++ b/racket/src/racket/src/optimize.c @@ -4370,8 +4370,11 @@ case_lambda_shift(Scheme_Object *data, int delta, int after_depth) static Scheme_Object * begin0_optimize(Scheme_Object *obj, Optimize_Info *info, int context) { - int i, count, drop = 0, prev_size, single_result = 0; + int i, count, drop = 0, prev_size, single_result = 0, preserves_marks = 0; + int kclock, sclock, movable; Scheme_Sequence *s = (Scheme_Sequence *)obj; + Scheme_Object *inside = NULL, *expr, *orig_first; + int id_offset = 0; Scheme_Object *le; Optimize_Info_Sequence info_seq; @@ -4389,8 +4392,12 @@ begin0_optimize(Scheme_Object *obj, Optimize_Info *info, int context) ? scheme_optimize_result_context(context) : 0)); - if (!i) + if (!i) { single_result = info->single_result; + preserves_marks = info->preserves_marks; + kclock = info->kclock; + sclock = info->sclock; + } /* Inlining and constant propagation can expose omittable expressions: */ if (i) @@ -4405,37 +4412,84 @@ begin0_optimize(Scheme_Object *obj, Optimize_Info *info, int context) } } - if (drop) { - Scheme_Sequence *s2; - int j = 0; - - if ((s->count - drop) == 1) { - /* can't drop down to 1 expression */ - s->array[s->count-1] = scheme_false; - --drop; - } - - s2 = scheme_malloc_sequence(s->count - drop); - s2->so.type = s->so.type; - s2->count = s->count - drop; - - for (i = 0; i < s->count; i++) { - if (s->array[i]) { - s2->array[j++] = s->array[i]; - } - } - - obj = (Scheme_Object *)s2; - } - optimize_info_seq_done(info, &info_seq); info->preserves_marks = 1; info->single_result = single_result; + if (drop && (s->count - drop) == 1 && (preserves_marks == 1)) { + /* If the first expression preserves marks we can drop the begin0 */ + return s->array[0]; + } + + expr = s->array[0]; + orig_first = s->array[0]; + extract_tail_inside(&expr, &inside, &id_offset); + + if (id_offset) { + /* don't change the first expression if it needs to be shifted */ + inside = NULL; + expr = s->array[0]; + id_offset = 0; + } + + /* Try optimize (begin0 ...) => (begin ... ) */ + if (movable_expression(expr, info, 0, 0, kclock != info->kclock, + sclock != info->sclock, 0, 50)) { + if ((s->count - drop) == 1) { + /* drop the begin0 */ + info->size -= 1; + /* expr = expr */ + } else { + Scheme_Sequence *s2; + int j = 0; + + s2 = scheme_malloc_sequence(s->count - drop); + s2->so.type = scheme_sequence_type; + s2->count = s->count - drop; + + for (i = 1; i < s->count; i++) { + if (s->array[i]) { + s2->array[j++] = s->array[i]; + } + } + s2->array[j++] = expr; + + expr = (Scheme_Object *)s2; + } + } else { + if (drop && (s->count - drop) == 1) { + /* can't drop down to 1 expression */ + s->array[s->count-1] = scheme_void; + --drop; + info->size += 1; + } + + if (drop) { + Scheme_Sequence *s2; + int j = 0; + + s2 = scheme_malloc_sequence(s->count - drop); + s2->so.type = s->so.type; + s2->count = s->count - drop; + + s2->array[j++] = expr; + for (i = 1; i < s->count; i++) { + if (s->array[i]) { + s2->array[j++] = s->array[i]; + } + } + + expr = (Scheme_Object *)s2; + } else { + s->array[0] = expr; + expr = (Scheme_Object *)s; + } + } + info->size += 1; - return obj; + return replace_tail_inside(expr, inside, orig_first); } static Scheme_Object *do_define_syntaxes_optimize(Scheme_Object *data, Optimize_Info *info)