More reductions for (if t v v) and (eq? v v)
Reduce (eq? v v) ==> #t (if t v v) ==> (begin t v) (if v v #f) ==> v when v is a local or a top level variable. Previously, the last two reductions were used only with local variables. Also, move the (if x #t #f) ==> (not x) reduction after branch optimization.
This commit is contained in:
Gustavo Massaccesi
parent
6cd225e073
commit
5a378ca883
|
|
@ -1042,18 +1042,38 @@
|
|||
(test-comp '(lambda (x) (eq? 7 x))
|
||||
'(lambda (x) (eqv? 7 x)))
|
||||
|
||||
(test-comp #t
|
||||
'(eq? 7 7))
|
||||
(test-comp #f
|
||||
'(eq? 9 6))
|
||||
(test-comp #t
|
||||
'(eqv? 7 7))
|
||||
(test-comp #f
|
||||
'(eqv? 9 6))
|
||||
(test-comp #t
|
||||
'(equal? 7 7))
|
||||
(test-comp #f
|
||||
'(equal? 9 6))
|
||||
; car is a primitive, map is required from another module
|
||||
(let ([test-equal?
|
||||
(lambda (e?)
|
||||
(test-comp #t
|
||||
`(,e? 7 7))
|
||||
(test-comp #f
|
||||
`(,e? 9 6))
|
||||
(test-comp #t
|
||||
`(,e? (values 1 2) (values 1 2))
|
||||
#f)
|
||||
(test-comp '(lambda (x) #t)
|
||||
`(lambda (x) (,e? x x)))
|
||||
(test-comp '(lambda (x) #t)
|
||||
`(lambda (x) (,e? car car)))
|
||||
(test-comp '(lambda (x) (list map #t))
|
||||
`(lambda (x) (list map (,e? map map))))
|
||||
(test-comp '(module ? racket/base
|
||||
(define x (if (zero? (random 2)) '() '(1)))
|
||||
#t)
|
||||
`(module ? racket/base
|
||||
(define x (if (zero? (random 2)) '() '(1)))
|
||||
(,e? x x)))
|
||||
(test-comp '(letrec ([x #t]
|
||||
[y (random)])
|
||||
(list x x y y))
|
||||
`(letrec ([x (,e? y y)]
|
||||
[y (random)])
|
||||
(list x x y y))
|
||||
#f))])
|
||||
(test-equal? eq?)
|
||||
(test-equal? eqv?)
|
||||
(test-equal? equal?))
|
||||
|
||||
(test-comp '(let ([x 3]) x)
|
||||
'((lambda (x) x) 3))
|
||||
|
|
@ -1761,11 +1781,29 @@
|
|||
|
||||
(test-comp '(lambda (x) (if x x #f))
|
||||
'(lambda (x) x))
|
||||
(test-comp '(lambda (x y) (set! x y) (if x x #f))
|
||||
'(lambda (x y) (set! x y) x))
|
||||
(test-comp '(lambda (x) (if (cons 1 x) 78 78))
|
||||
'(lambda (x) 78))
|
||||
(test-comp '(lambda (x) (if (null? x) 78 78))
|
||||
'(lambda (x) 78))
|
||||
(test-comp '(lambda (x) (if (values 1 2) 78 78))
|
||||
'(lambda (x) (values 1 2) 78)
|
||||
#f)
|
||||
(test-comp '(if (values 1 2) (values 1 2) #f)
|
||||
'(values 1 2)
|
||||
#f)
|
||||
; car is a primitive, map is required from another module
|
||||
(test-comp '(lambda (x) (if (null? x) car car))
|
||||
'(lambda (x) car))
|
||||
(test-comp '(lambda (x) (if (null? x) map map))
|
||||
'(lambda (x) map))
|
||||
(test-comp '(module ? racket/base
|
||||
(define x (if (zero? (random 2)) '() '(1)))
|
||||
(if (null? x) x x))
|
||||
'(module ? racket/base
|
||||
(define x (if (zero? (random 2)) '() '(1)))
|
||||
x))
|
||||
(test-comp '(lambda (x) (if (null? x) x x))
|
||||
'(lambda (x) x))
|
||||
(test-comp '(lambda (x) (if (null? x) null x))
|
||||
|
|
@ -1884,21 +1922,45 @@
|
|||
(if (let ([y (random)]) (pair? x)) 1 2)))
|
||||
'(lambda (x)
|
||||
(cons (car x)
|
||||
(begin (let ([y (random)]) (void (pair? x))) 1))))
|
||||
(let ([y (random)]) 1))))
|
||||
(test-comp '(lambda (x)
|
||||
(cons (car x)
|
||||
(if (begin (random) (random) (pair? x)) 1 2)))
|
||||
'(lambda (x)
|
||||
(cons (car x)
|
||||
(begin (random) (random) 1))))
|
||||
(test-comp '(lambda (x)
|
||||
(cons (car x)
|
||||
(if (begin (random) (random) (box? x)) 1 2)))
|
||||
'(lambda (x)
|
||||
(cons (car x)
|
||||
(begin (random) (random) 2))))
|
||||
(test-comp '(lambda (x)
|
||||
(if (begin (random) (random) (cons x x)) 1 2))
|
||||
'(lambda (x)
|
||||
(begin (random) (random) 1)))
|
||||
(test-comp '(lambda (x)
|
||||
(if (let ([n (random)]) (random n) (random n) (cons (car x) x)) 1 2))
|
||||
(if (begin (random) (random) (not (cons x x))) 1 2))
|
||||
'(lambda (x)
|
||||
(let ([n (random)]) (random n) (random n) (car x) (void) 1)))
|
||||
(begin (random) (random) 2)))
|
||||
(test-comp '(lambda (x)
|
||||
(if (let ([n (random 9)]) (random n) (random n) (cons (car x) x)) 1 2))
|
||||
'(lambda (x)
|
||||
(let ([n (random 9)]) (random n) (random n) (car x) 1)))
|
||||
(test-comp '(lambda (x)
|
||||
(if (let ([n (random 9)]) (random n) (random n) (not (cons (car x) x))) 1 2))
|
||||
'(lambda (x)
|
||||
(let ([n (random 9)]) (random n) (random n) (car x) 2)))
|
||||
|
||||
(test-comp '(lambda (x)
|
||||
(if (let ([n (random 9)]) (random n) (random n) (cons (car x) x)) (cons x 1) (cons x 2)))
|
||||
'(lambda (x)
|
||||
(let ([n (random 9)]) (random n) (random n) (car x) (cons x 1))))
|
||||
(test-comp '(lambda (x)
|
||||
(if (let ([n (random 9)]) (random n) (random n) (not (cons (car x) x))) (cons x 1) (cons x 2)))
|
||||
'(lambda (x)
|
||||
(let ([n (random 9)]) (random n) (random n) (car x) (cons x 2))))
|
||||
|
||||
(test-comp '(lambda (x)
|
||||
(if (begin (random) (not (begin (random) x))) 1 2))
|
||||
'(lambda (x)
|
||||
|
|
|
|||
|
|
@ -154,6 +154,8 @@ static int single_valued_noncm_expression(Scheme_Object *expr, int fuel);
|
|||
static Scheme_Object *optimize_ignored(Scheme_Object *e, Optimize_Info *info,
|
||||
int expected_vals, int maybe_omittable,
|
||||
int fuel);
|
||||
static Scheme_Object *equivalent_exprs(Scheme_Object *a, Scheme_Object *b,
|
||||
Optimize_Info *a_info, Optimize_Info *b_info, int context);
|
||||
static int movable_expression(Scheme_Object *expr, Optimize_Info *info,
|
||||
int cross_lambda, int cross_k, int cross_s,
|
||||
int check_space, int fuel);
|
||||
|
|
@ -682,6 +684,12 @@ static Scheme_Object *make_discarding_reverse_sequence(Scheme_Object *e1, Scheme
|
|||
return do_make_discarding_sequence(e1, e2, info, 0, 1);
|
||||
}
|
||||
|
||||
static Scheme_Object *make_discarding_sequence_3(Scheme_Object *e1, Scheme_Object *e2, Scheme_Object *e3,
|
||||
Optimize_Info *info)
|
||||
{
|
||||
return make_discarding_sequence(e1, make_discarding_sequence(e2, e3, info), info);
|
||||
}
|
||||
|
||||
static Scheme_Object *make_discarding_app_sequence(Scheme_App_Rec *appr, int result_pos, Scheme_Object *result,
|
||||
Optimize_Info *info)
|
||||
/* Generalize do_make_discarding_sequence() to a sequence of argument
|
||||
|
|
@ -3697,6 +3705,15 @@ static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimiz
|
|||
}
|
||||
}
|
||||
|
||||
if ((SAME_OBJ(app->rator, scheme_equal_proc)
|
||||
|| SAME_OBJ(app->rator, scheme_eqv_proc)
|
||||
|| SAME_OBJ(app->rator, scheme_eq_proc))
|
||||
&& equivalent_exprs(app->rand1, app->rand2, NULL, NULL, 0)) {
|
||||
info->preserves_marks = 1;
|
||||
info->single_result = 1;
|
||||
return make_discarding_sequence_3(app->rand1, app->rand2, scheme_true, info);
|
||||
}
|
||||
|
||||
/* Optimize `equal?' or `eqv?' test on certain types
|
||||
to `eq?'. This is especially helpful for the JIT. */
|
||||
if ((SAME_OBJ(app->rator, scheme_equal_proc)
|
||||
|
|
@ -3724,13 +3741,7 @@ static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimiz
|
|||
if (!SAME_OBJ(pred1, pred2)) {
|
||||
info->preserves_marks = 1;
|
||||
info->single_result = 1;
|
||||
return do_make_discarding_sequence(app->rand1,
|
||||
do_make_discarding_sequence(app->rand2,
|
||||
scheme_false,
|
||||
info,
|
||||
0, 0),
|
||||
info,
|
||||
0, 0);
|
||||
return make_discarding_sequence_3(app->rand1, app->rand2, scheme_false, info);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -4181,12 +4192,23 @@ static Scheme_Object *collapse_local(Scheme_Object *var, Optimize_Info *info, in
|
|||
return NULL;
|
||||
}
|
||||
|
||||
/* This function is used to reduce:
|
||||
(if <x> a b) => (begin <x> <result-a-or-b>)
|
||||
(if a b #f) => a , and similar
|
||||
(eq? a b) => (begin a b #t)
|
||||
The function considers only values and variable references, so <a> and <b> don't have side effects.
|
||||
But each reduction has a very different behavior for expressions with side effects. */
|
||||
static Scheme_Object *equivalent_exprs(Scheme_Object *a, Scheme_Object *b,
|
||||
Optimize_Info *a_info, Optimize_Info *b_info, int context)
|
||||
{
|
||||
if (SAME_OBJ(a, b))
|
||||
return a;
|
||||
|
||||
if (SAME_TYPE(SCHEME_TYPE(a), scheme_ir_toplevel_type)
|
||||
&& SAME_TYPE(SCHEME_TYPE(b), scheme_ir_toplevel_type)
|
||||
&& (SCHEME_TOPLEVEL_POS(a) == SCHEME_TOPLEVEL_POS(b)))
|
||||
return a;
|
||||
|
||||
if (b_info
|
||||
&& SAME_TYPE(SCHEME_TYPE(a), scheme_ir_local_type)
|
||||
&& (SCHEME_TYPE(b) > _scheme_ir_values_types_)) {
|
||||
|
|
@ -4390,7 +4412,6 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
|
|||
Optimize_Info *then_info, *else_info;
|
||||
Optimize_Info *then_info_init, *else_info_init;
|
||||
Optimize_Info_Sequence info_seq;
|
||||
Scheme_Object *pred;
|
||||
|
||||
b = (Scheme_Branch_Rec *)o;
|
||||
|
||||
|
|
@ -4399,21 +4420,14 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
|
|||
fb = b->fbranch;
|
||||
|
||||
/* Convert (if <id> expr <id>) to (if <id> expr #f) */
|
||||
if (SAME_TYPE(SCHEME_TYPE(t), scheme_ir_local_type)
|
||||
&& SAME_OBJ(t, fb)) {
|
||||
if (equivalent_exprs(t, fb, NULL, NULL, 0)) {
|
||||
fb = scheme_false;
|
||||
}
|
||||
|
||||
if (context & OPT_CONTEXT_BOOLEAN) {
|
||||
/* For test position, convert (if <id> <id> expr) to (if <id> #t expr) */
|
||||
if (SAME_TYPE(SCHEME_TYPE(t), scheme_ir_local_type)
|
||||
&& SAME_OBJ(t, tb)) {
|
||||
/* For test position, convert (if <id> <id> expr) to (if <id> #t expr) */
|
||||
if ((context & OPT_CONTEXT_BOOLEAN)
|
||||
&& equivalent_exprs(t, tb, NULL, NULL, 0)) {
|
||||
tb = scheme_true;
|
||||
}
|
||||
|
||||
/* Convert (if <expr> #t #f) to <expr> */
|
||||
if (SAME_OBJ(tb, scheme_true) && SAME_OBJ(fb, scheme_false))
|
||||
return scheme_optimize_expr(t, info, context);
|
||||
}
|
||||
|
||||
optimize_info_seq_init(info, &info_seq);
|
||||
|
|
@ -4449,24 +4463,29 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
|
|||
break;
|
||||
}
|
||||
|
||||
pred = expr_implies_predicate(t2, info, NULL, 5);
|
||||
if (pred) {
|
||||
/* (if (let () (cons x y)) a b) => (if (begin (let () (begin x y #<void>)) #t/#f) a b) */
|
||||
Scheme_Object *test_val = SAME_OBJ(pred, scheme_not_proc) ? scheme_false : scheme_true;
|
||||
if (!(SCHEME_TYPE(t2) > _scheme_ir_values_types_)) {
|
||||
/* (if (let (...) (cons x y)) a b) => (if (begin (let (...) (begin x y #<void>)) #t/#f) a b)
|
||||
but don't expand (if (let (...) (begin x K)) a b) */
|
||||
Scheme_Object *pred;
|
||||
|
||||
t2 = optimize_ignored(t2, info, 1, 0, 5);
|
||||
t = replace_tail_inside(t2, inside, t);
|
||||
|
||||
t2 = test_val;
|
||||
if (scheme_omittable_expr(t, 1, 5, 0, info, NULL)) {
|
||||
t = test_val;
|
||||
inside = NULL;
|
||||
} else {
|
||||
t = make_sequence_2(t, test_val);
|
||||
inside = t;
|
||||
pred = expr_implies_predicate(t2, info, NULL, 5);
|
||||
if (pred) {
|
||||
Scheme_Object *test_val = SAME_OBJ(pred, scheme_not_proc) ? scheme_false : scheme_true;
|
||||
|
||||
t2 = optimize_ignored(t2, info, 1, 0, 5);
|
||||
t = replace_tail_inside(t2, inside, t);
|
||||
|
||||
t2 = test_val;
|
||||
if (scheme_omittable_expr(t, 1, 5, 0, info, NULL)) {
|
||||
t = test_val;
|
||||
inside = NULL;
|
||||
} else {
|
||||
t = make_sequence_2(t, test_val);
|
||||
inside = t;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
if (SCHEME_TYPE(t2) > _scheme_ir_values_types_) {
|
||||
/* Branch is statically known */
|
||||
Scheme_Object *xb;
|
||||
|
|
@ -4479,6 +4498,7 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
|
|||
else
|
||||
xb = scheme_optimize_expr(tb, info, scheme_optimize_tail_context(context));
|
||||
|
||||
optimize_info_seq_done(info, &info_seq);
|
||||
return replace_tail_inside(xb, inside, t);
|
||||
}
|
||||
}
|
||||
|
|
@ -4563,25 +4583,31 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
|
|||
return make_optimize_prim_application2(scheme_not_proc, t, info, context);
|
||||
}
|
||||
|
||||
/* Try optimize: (if <omitable-expr> v v) => v */
|
||||
/* For test position, convert (if <expr> #t #f) to <expr> */
|
||||
if ((context & OPT_CONTEXT_BOOLEAN)
|
||||
&& SAME_OBJ(tb, scheme_true) && SAME_OBJ(fb, scheme_false)) {
|
||||
info->size -= 2;
|
||||
return t;
|
||||
}
|
||||
|
||||
/* Try optimize: (if <expr> v v) => (begin <expr> v) */
|
||||
{
|
||||
Scheme_Object *nb;
|
||||
|
||||
nb = equivalent_exprs(tb, fb, then_info_init, else_info_init, context);
|
||||
if (nb) {
|
||||
info->size -= 1; /* could be more precise */
|
||||
info->size -= 1;
|
||||
return make_discarding_first_sequence(t, nb, info);
|
||||
}
|
||||
}
|
||||
|
||||
/* Try optimize: (if x x #f) => x
|
||||
This pattern is included in the previous reduction,
|
||||
but this is still useful if x is mutable */
|
||||
if (SAME_TYPE(SCHEME_TYPE(t), scheme_ir_local_type)
|
||||
&& SAME_OBJ(t, tb)
|
||||
&& SCHEME_FALSEP(fb)) {
|
||||
info->size -= 2;
|
||||
return t;
|
||||
but this is still useful if x is mutable or a top level*/
|
||||
if (SCHEME_FALSEP(fb)
|
||||
&& equivalent_exprs(t, tb, NULL, NULL, 0)) {
|
||||
info->size -= 2;
|
||||
return t;
|
||||
}
|
||||
|
||||
/* Convert: (if (if M N #f) M2 K) => (if M (if N M2 K) K)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user