From 509da64135f412acd8522747daa3568524ac59ae Mon Sep 17 00:00:00 2001 From: Gustavo Massaccesi Date: Sun, 6 Mar 2016 23:47:46 -0300 Subject: [PATCH] reduce (let ([x ]) #f) => (begin #f) Sometimes the optimizer removes all the references to a variable but it doesn't detect that the variable is unused, so it keeps the definition. Later, the sfs detects the unused variable so it marks it, but it doesn't remove the let form. --- .../tests/racket/optimize.rktl | 56 ++++++-- racket/src/racket/src/optimize.c | 121 +++++++++--------- 2 files changed, 107 insertions(+), 70 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/optimize.rktl b/pkgs/racket-test-core/tests/racket/optimize.rktl index 27e153c7af..716227891f 100644 --- a/pkgs/racket-test-core/tests/racket/optimize.rktl +++ b/pkgs/racket-test-core/tests/racket/optimize.rktl @@ -1750,10 +1750,48 @@ (test-comp '(letrec ([x (cons 1 1)][y x]) (cons x y)) '(letrec ([x (cons 1 1)][y x]) (cons x x))) +;; Remove unnecessary bindings (test-comp '(let ([f (lambda (x) x)]) f) - (syntax-property (datum->syntax #f '(lambda (x) x) (vector 'here #f #f #f #f)) + (syntax-property (datum->syntax #f '(lambda (x) x) (vector 'here #f #f #f #f)) 'inferred-name 'f)) +(test-comp '(let ([f (lambda (x) x)]) f f) + (syntax-property (datum->syntax #f '(lambda (x) x) (vector 'here #f #f #f #f)) + 'inferred-name + 'f)) +(test-comp '(lambda (g) (let ([f (g)]) f)) + '(lambda (g) (values (g)))) +(test-comp '(lambda (g) (let ([f (g)]) f f)) + '(lambda (g) (values (g)))) +(test-comp '(lambda (x) (let ([f (car x)]) f)) + '(lambda (x) (car x))) +(test-comp '(lambda (x) (let ([f (car x)]) f f)) + '(lambda (x) (car x))) +(test-comp '(lambda (g) (let* ([i (g 0)] [f (g i)]) f)) + '(lambda (g) (let* ([i (g 0)]) (values (g i))))) +(test-comp '(lambda (g) (let* ([i (g 0)] [f (g i)]) f f)) + '(lambda (g) (let* ([i (g 0)]) (values (g i))))) +(test-comp '(lambda (g) (let* ([i (g 0)] [f (car i)]) f)) + '(lambda (g) (let* ([i (g 0)]) (car i)))) +(test-comp '(lambda (g) (let* ([i (g 0)] [f (car i)]) f f)) + '(lambda (g) (let* ([i (g 0)]) (car i)))) +(test-comp '(let ([f (lambda (x) x)]) 7) + 7) +(test-comp '(let ([f (lambda (x) x)]) f 7) + 7) +(test-comp '(lambda (g) (let* ([i (g 0)] [f (car i)]) 7)) + '(lambda (g) (let* ([i (g 0)]) (begin (car i) 7)))) +(test-comp '(lambda (g) (let* ([i (g 0)] [f (car i)]) f 7)) + '(lambda (g) (let* ([i (g 0)]) (begin (car i) 7)))) +(test-comp '(lambda (g) (let* ([i (g 0)] [f (box i)]) 7)) + '(lambda (g) (let* ([i (g 0)]) 7))) +(test-comp '(lambda (g) (let* ([i (g 0)] [f (box i)]) f 7)) + '(lambda (g) (let* ([i (g 0)]) 7))) +(test-comp '(lambda (g) (let* ([i (g 0)] [f (g i)]) 7)) + '(lambda (g) (let* ([i (g 0)]) (begin (values (g i)) 7)))) +(test-comp '(lambda (g) (let* ([i (g 0)] [f (g i)]) f 7)) + '(lambda (g) (let* ([i (g 0)]) (begin (values (g i)) 7)))) + (test-comp '(letrec ([f (lambda (x) x)]) (f 10) @@ -2064,9 +2102,9 @@ (values x)) '(let ([x (+ (cons 1 2) 0)]) x)) -(test-comp '(let ([x (+ (random) 0)]) +(test-comp '(let ([x (+ (random) 3)]) (values x)) - '(let ([x (+ (random) 0)]) + '(let ([x (+ (random) 3)]) x)) (test-comp '(lambda (x) (begin (random) x)) @@ -2089,9 +2127,12 @@ '(lambda (f) (if (values (f)) 0 1))) -(test-comp '(let ([x (+ (cons 1 2) 0)]) +(test-comp '(let ([x (+ (cons 1 2) 3)]) (- x 8)) - '(- (+ (cons 1 2) 0) 8)) + '(- (+ (cons 1 2) 3) 8)) +(test-comp '(let ([x (+ (random) 3)]) + (- x 8)) + '(- (+ (random) 3) 8)) (test-comp '(let ([x (peek-char)]) (cons x 10)) @@ -3699,11 +3740,10 @@ (+ v v))]) x)) '(lambda (v) - (begin0 + (values (with-continuation-mark 'x 10 - (+ v v)) - #f))) + (+ v v))))) (test-comp `(lambda (x y f) (set! x 5) diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c index 57b74066a6..d59d6ce598 100644 --- a/racket/src/racket/src/optimize.c +++ b/racket/src/racket/src/optimize.c @@ -855,7 +855,7 @@ static Scheme_Object *make_application_3(Scheme_Object *a, Scheme_Object *b, Sch } static Scheme_Object *replace_tail_inside(Scheme_Object *alt, Scheme_Object *inside, Scheme_Object *orig) -/* Installs a new expression inthe result position of various forms, such as `begin`; +/* Installs a new expression in the result position of various forms, such as `begin`; extract_tail_inside() needs to be consistent with this function */ { if (inside) { @@ -3552,14 +3552,16 @@ static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimiz info->single_result = -info->single_result; } - if ((SAME_OBJ(scheme_values_proc, rator) - || SAME_OBJ(scheme_list_star_proc, rator)) - && ((context & OPT_CONTEXT_SINGLED) - || scheme_omittable_expr(rand, 1, -1, 0, info, info) - || single_valued_noncm_expression(rand, 5))) { + if (SAME_OBJ(scheme_values_proc, rator) + || SAME_OBJ(scheme_list_star_proc, rator)) { + SCHEME_APPN_FLAGS(app) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL); info->preserves_marks = 1; info->single_result = 1; - return replace_tail_inside(rand, inside, app->rand); + if ((context & OPT_CONTEXT_SINGLED) + || scheme_omittable_expr(rand, 1, -1, 0, info, info) + || single_valued_noncm_expression(rand, 5)) { + return replace_tail_inside(rand, inside, app->rand); + } } if (SCHEME_PRIMP(rator)) { @@ -6159,21 +6161,6 @@ static void set_application_types(Scheme_Object *o, Optimize_Info *info, int fue } } -static int can_unwrap(Scheme_Object *v) -/* Can `v` be unwrapped from `(let ([x v]) v)`? */ -{ - Scheme_Type lhs; - lhs = SCHEME_TYPE(v); - if ((lhs == scheme_ir_lambda_type) - || (lhs == scheme_case_lambda_sequence_type) - || (lhs == scheme_ir_local_type) - || (lhs == scheme_ir_toplevel_type) - || (lhs == scheme_ir_quote_syntax_type) - || (lhs > _scheme_ir_values_types_)) - return 1; - return 0; -} - static void flip_transitive(Scheme_Hash_Table *ht, int on) /* Adjust usage flags based on recorded tentative uses */ { @@ -6274,37 +6261,21 @@ static Scheme_Object *optimize_lets(Scheme_Object *form, Optimize_Info *info, in } } - /* Special case: (let ([x E]) x). - If E is lambda, case-lambda, or a constant, we can prduce just E. - Otherwise, convert to (begin0 E #f) to preserve non-tailness of E. */ - if (!(SCHEME_LET_FLAGS(head) & SCHEME_LET_RECURSIVE) && (head->count == 1) && (head->num_clauses == 1)) { + is_rec = (SCHEME_LET_FLAGS(head) & SCHEME_LET_RECURSIVE); + + /* Special case: (let ([x E]) x) => E or (values E) */ + if (!is_rec + && (head->count == 1) + && (head->num_clauses == 1)) { irlv = (Scheme_IR_Let_Value *)head->body; if (SAME_OBJ((Scheme_Object *)irlv->vars[0], irlv->body)) { - if (can_unwrap(irlv->value)) { - /* Drop the let */ - return scheme_optimize_expr(irlv->value, info, context); - } else { - /* Use `begin0`: */ - Scheme_Sequence *seq; - - seq = scheme_malloc_sequence(2); - seq->so.type = scheme_begin0_sequence_type; - seq->count = 2; - - value = irlv->value; - if (!single_valued_expression(value, 5, 0)) - value = ensure_single_value(value); - - seq->array[0] = value; - seq->array[1] = scheme_false; - - return scheme_optimize_expr((Scheme_Object *)seq, info, context); - } + body = irlv->value; + if (!single_valued_noncm_expression(body, 5)) + body = ensure_single_value(body); + return scheme_optimize_expr(body, info, context); } } - is_rec = (SCHEME_LET_FLAGS(head) & SCHEME_LET_RECURSIVE); - if (!is_rec) { int try_again; do { @@ -7001,12 +6972,8 @@ static Scheme_Object *optimize_lets(Scheme_Object *form, Optimize_Info *info, in body = pre_body->body; } - /* Optimized away all clauses? */ - if (!head->num_clauses) { - optimize_info_done(body_info, NULL); - merge_types(body_info, info, merge_skip_vars); - return body; - } + optimize_info_done(body_info, NULL); + merge_types(body_info, info, merge_skip_vars); if (is_rec && !not_simply_let_star) { /* We can simplify letrec to let* */ @@ -7014,15 +6981,45 @@ static Scheme_Object *optimize_lets(Scheme_Object *form, Optimize_Info *info, in is_rec = 0; } - optimize_info_done(body_info, NULL); - merge_types(body_info, info, merge_skip_vars); + /* Optimized away all clauses? */ + if (!head->num_clauses) { + return body; + } - /* Check again for (let ([x ]) x). */ - if (!is_rec && (head->count == 1) && (head->num_clauses == 1)) { - irlv = (Scheme_IR_Let_Value *)head->body; - if (SAME_OBJ(irlv->body, (Scheme_Object *)irlv->vars[0])) { - if (can_unwrap(irlv->value)) - return irlv->value; + if (!is_rec + && ((SCHEME_TYPE(body) > _scheme_ir_values_types_) + || SAME_TYPE(SCHEME_TYPE(body), scheme_ir_toplevel_type) + || SAME_TYPE(SCHEME_TYPE(body), scheme_ir_local_type))) { + /* If the body is a constant, toplevel or another local, the last binding + is unused, so reduce (let ([x ]) K) => (begin K). + As a special case, include a second check for (let ([x E]) x) => E or (values E). */ + Scheme_Object *inside; + + inside = (Scheme_Object *)head; + pre_body = (Scheme_IR_Let_Value *)head->body; + for (i = head->num_clauses - 1; i--; ) { + inside = (Scheme_Object *)pre_body; + pre_body = (Scheme_IR_Let_Value *)pre_body->body; + } + + if (pre_body->count == 1) { + if (!SAME_OBJ((Scheme_Object *)pre_body->vars[0], body) + && !found_escapes) { + body = make_discarding_sequence(pre_body->value, body, info); + } else { + /* Special case for (let ([x E]) x) and (let ([x ]) #f) */ + found_escapes = 0; /* Perhaps the error is moved to the body. */ + body = pre_body->value; + if (!single_valued_noncm_expression(body, 5)) + body = ensure_single_value(body); + } + + if (head->num_clauses == 1) + return body; + + (void)replace_tail_inside(body, inside, NULL); + head->count--; + head->num_clauses--; } }