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

optimizer: more optimizations for begin0

Browse Source 
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.
This commit is contained in:
Gustavo Massaccesi 2014-09-13 08:48:59 -03:00 committed by Matthew Flatt
parent fbb6ae98b9
commit 60934f1415
3 changed files with 114 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl
View File

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

2
racket/src/racket/src/compile.c
View File

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

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

@ -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 <movable> ...) => (begin ... <movable>) */
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)