From bfa269982f44f0f2db6e2a84f3a1f531747f83d5 Mon Sep 17 00:00:00 2001 From: Gustavo Massaccesi Date: Sat, 30 Jul 2016 13:11:14 -0300 Subject: [PATCH] optimizer: don't move APPN_FLAG_OMITTABLE inside lambdas Some expressions are omittable only when the arguments have certain types. In this case the application is marked with APPN_FLAG_OMITTABLE instead of relaying on the flags of the primitive. The optimizer can't use this flag to move the expression inside a lamba or across a potential continuation capture, unlike other omittable expressions. They can be moved only in more restricted conditions. For example, in this program #lang racket/base (define n 10000) (define m 10000) (time (define xs (build-list n (lambda (x) 0))) (length xs) (define ws (list->vector xs)) ; <-- omittable (for ([i (in-range m)]) (vector-ref ws 0))) ; <-- ws is used once If the optimizer moves the expression in the definition of ws inside the recursive lambda that is created by the for, then the code is equivalent to: #lang racket/base (define n 10000) (define m 10000) (time (define xs (build-list n (lambda (x) 0))) (length xs) (for ([i (in-range m)]) (vector-ref (list->vector xs) 0))) ; <-- moved here And the new code is O(n*m) instead of O(n+m). This example is a minimized version of the function kde from the plot package, where n=m and the bug changed the run time from linear to quadratic. --- .../tests/racket/optimize.rktl | 12 ++++++++++++ racket/src/racket/src/optimize.c | 18 ++++++++++++------ 2 files changed, 24 insertions(+), 6 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/optimize.rktl b/pkgs/racket-test-core/tests/racket/optimize.rktl index 0af03d685e..dece1e3213 100644 --- a/pkgs/racket-test-core/tests/racket/optimize.rktl +++ b/pkgs/racket-test-core/tests/racket/optimize.rktl @@ -2111,6 +2111,18 @@ '(lambda (z) (lambda () (lambda () z))) #f) +;; Don't move omittable expressions that keep a reference: +(test-comp '(lambda (z) (let ([r (pair? z)]) + (lambda () r))) + '(lambda (z) (lambda () + (lambda () (pair? z)))) + #f) +(test-comp '(lambda (z) (when (list? z) + (let ([r (list->vector z)]) + (lambda () r)))) + '(lambda (z) (when (list? z) + (lambda () (list->vector z)))) + #f) (test-comp '(if (let ([z (random)]) null) 1 2) diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c index 11887408bd..11635cc351 100644 --- a/racket/src/racket/src/optimize.c +++ b/racket/src/racket/src/optimize.c @@ -1616,8 +1616,10 @@ static int movable_expression(Scheme_Object *expr, Optimize_Info *info, } break; case scheme_application_type: - if (SCHEME_APPN_FLAGS((Scheme_App_Rec *)expr) & APPN_FLAG_OMITTABLE) - can_move = 1; + if (!cross_lambda + && !cross_k + && (SCHEME_APPN_FLAGS((Scheme_App_Rec *)expr) & APPN_FLAG_OMITTABLE)) + can_move = -1; else can_move = is_movable_prim(((Scheme_App_Rec *)expr)->args[0], ((Scheme_App_Rec *)expr)->num_args, cross_lambda, cross_k, info); @@ -1633,8 +1635,10 @@ static int movable_expression(Scheme_Object *expr, Optimize_Info *info, } break; case scheme_application2_type: - if (SCHEME_APPN_FLAGS((Scheme_App2_Rec *)expr) & APPN_FLAG_OMITTABLE) - can_move = 1; + if (!cross_lambda + && !cross_k + && (SCHEME_APPN_FLAGS((Scheme_App2_Rec *)expr) & APPN_FLAG_OMITTABLE)) + can_move = -1; else can_move = is_movable_prim(((Scheme_App2_Rec *)expr)->rator, 1, cross_lambda, cross_k, info); if (can_move) { @@ -1645,8 +1649,10 @@ static int movable_expression(Scheme_Object *expr, Optimize_Info *info, } break; case scheme_application3_type: - if (SCHEME_APPN_FLAGS((Scheme_App3_Rec *)expr) & APPN_FLAG_OMITTABLE) - can_move = 1; + if (!cross_lambda + && !cross_k + && (SCHEME_APPN_FLAGS((Scheme_App3_Rec *)expr) & APPN_FLAG_OMITTABLE)) + can_move = -1; else can_move = is_movable_prim(((Scheme_App3_Rec *)expr)->rator, 2, cross_lambda, cross_k, info); if (can_move) {