diff --git a/pkgs/racket-test-core/tests/racket/optimize.rktl b/pkgs/racket-test-core/tests/racket/optimize.rktl index e18ad7c072..bd674ffbe2 100644 --- a/pkgs/racket-test-core/tests/racket/optimize.rktl +++ b/pkgs/racket-test-core/tests/racket/optimize.rktl @@ -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) diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c index a4b08ef1a7..6ee9266dc1 100644 --- a/racket/src/racket/src/optimize.c +++ b/racket/src/racket/src/optimize.c @@ -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 a b) => (begin ) + (if a b #f) => a , and similar + (eq? a b) => (begin a b #t) + The function considers only values and variable references, so and 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 expr ) to (if 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 expr) to (if #t expr) */ - if (SAME_TYPE(SCHEME_TYPE(t), scheme_ir_local_type) - && SAME_OBJ(t, tb)) { + /* For test position, convert (if expr) to (if #t expr) */ + if ((context & OPT_CONTEXT_BOOLEAN) + && equivalent_exprs(t, tb, NULL, NULL, 0)) { tb = scheme_true; - } - - /* Convert (if #t #f) to */ - 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 #)) #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 #)) #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 v v) => v */ + /* For test position, convert (if #t #f) to */ + if ((context & OPT_CONTEXT_BOOLEAN) + && SAME_OBJ(tb, scheme_true) && SAME_OBJ(fb, scheme_false)) { + info->size -= 2; + return t; + } + + /* Try optimize: (if v v) => (begin 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)