From 26d28a28fec576434c91dffb4b0cdecb95b3ae24 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 8 Mar 2016 15:44:25 -0700 Subject: [PATCH] fix mismatch between optimizer snd run-time on "constant" detection Cross-module inlining that pulls a variable reference across a module boundary imposes a more struct requirement that run-time "constant" detection is consistent with the optimizer's view of "constant" within a module. So, make sure they're the same. --- .../tests/racket/optimize.rktl | 29 ++++++++++++ racket/src/racket/src/eval.c | 5 +-- racket/src/racket/src/optimize.c | 45 +++++++++++++++---- racket/src/racket/src/schpriv.h | 2 +- 4 files changed, 68 insertions(+), 13 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/optimize.rktl b/pkgs/racket-test-core/tests/racket/optimize.rktl index 716227891f..babc049208 100644 --- a/pkgs/racket-test-core/tests/racket/optimize.rktl +++ b/pkgs/racket-test-core/tests/racket/optimize.rktl @@ -3345,6 +3345,35 @@ (require (submod ".." a)) (list b c (c))))) +(test-comp `(module m racket/base + (module a racket/base + (provide b c) + (define c + (let ([x 0]) + (lambda (y) + (begin0 + x + (set! x y))))) + (define (b z) + (c z))) + (module d racket/base + (require (submod ".." a)) + (list b c (b 1)))) + `(module m racket/base + (module a racket/base + (provide b c) + (define c + (let ([x 0]) + (lambda (y) + (begin0 + x + (set! x y))))) + (define (b z) + (c z))) + (module d racket/base + (require (submod ".." a)) + (list b c (c 1))))) + (module check-inline-request racket/base (require racket/performance-hint) (provide loop) diff --git a/racket/src/racket/src/eval.c b/racket/src/racket/src/eval.c index 795bd93101..c2a7ca8035 100644 --- a/racket/src/racket/src/eval.c +++ b/racket/src/racket/src/eval.c @@ -2093,10 +2093,7 @@ define_execute_with_dynamic_state(Scheme_Object *vec, int delta, int defmacro, if (SCHEME_TOPLEVEL_FLAGS(var) & SCHEME_TOPLEVEL_SEAL) { int flags = GLOB_IS_IMMUTATED; - if (SCHEME_PROCP(vals_expr) - || SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_lambda_type) - || SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_case_lambda_sequence_type) - || SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_inline_variant_type)) + if (scheme_is_statically_proc(vals_expr, NULL, OMITTABLE_RESOLVED)) flags |= GLOB_IS_CONSISTENT; ((Scheme_Bucket_With_Flags *)b)->flags |= flags; } diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c index d59d6ce598..1155ba594a 100644 --- a/racket/src/racket/src/optimize.c +++ b/racket/src/racket/src/optimize.c @@ -5736,24 +5736,53 @@ int scheme_ir_propagate_ok(Scheme_Object *value, Optimize_Info *info) return 0; } -int scheme_is_statically_proc(Scheme_Object *value, Optimize_Info *info) -/* Does `value` definitely produce a procedure of a specific shape? */ +int scheme_is_statically_proc(Scheme_Object *value, Optimize_Info *info, int flags) +/* Does `value` definitely produce a procedure of a specific shape? + This function can be used on resolved (and SFS) forms, too, and it + must be consistent with (i.e., as least as accepting as) + optimization-time decisions. The `flags` argument is for + scheme_omittable_expr(). */ { while (1) { - if (SCHEME_LAMBDAP(value)) { + if (SCHEME_LAMBDAP(value) + || SCHEME_PROCP(value) + || SAME_TYPE(SCHEME_TYPE(value), scheme_lambda_type) + || SAME_TYPE(SCHEME_TYPE(value), scheme_case_lambda_sequence_type) + || SAME_TYPE(SCHEME_TYPE(value), scheme_inline_variant_type)) return 1; - } else if (SAME_TYPE(SCHEME_TYPE(value), scheme_ir_let_header_type)) { + else if (SAME_TYPE(SCHEME_TYPE(value), scheme_ir_let_header_type)) { /* Look for (let ([x ]) ), which is generated for optional arguments. */ Scheme_IR_Let_Header *lh = (Scheme_IR_Let_Header *)value; if (lh->num_clauses == 1) { Scheme_IR_Let_Value *lv = (Scheme_IR_Let_Value *)lh->body; - if (scheme_omittable_expr(lv->value, lv->count, 20, 0, info, NULL)) { + if (scheme_omittable_expr(lv->value, lv->count, 20, flags, info, NULL)) { value = lv->body; - info = NULL; } else break; } else break; + } else if (SAME_TYPE(SCHEME_TYPE(value), scheme_let_one_type)) { + Scheme_Let_One *lo = (Scheme_Let_One *)value; + if (scheme_omittable_expr(lo->value, 1, 20, flags, info, NULL)) { + value = lo->body; + } else + break; + } else if (SAME_TYPE(SCHEME_TYPE(value), scheme_boxenv_type)) { + value = SCHEME_PTR2_VAL(value); + } else if (SAME_TYPE(SCHEME_TYPE(value), scheme_sequence_type) + /* Handle a sequence for resolved mode, because it might + be for safe-for-space clears around a procedure */ + && (flags & OMITTABLE_RESOLVED)) { + Scheme_Sequence *seq = (Scheme_Sequence *)value; + int i; + for (i = 0; i < seq->count-1; i++) { + if (!scheme_omittable_expr(seq->array[i], 1, 5, flags, info, NULL)) + break; + } + if (i == seq->count-1) { + value = seq->array[i]; + } else + break; } else break; } @@ -7709,7 +7738,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context) if (n == 1) { if (scheme_ir_propagate_ok(e, info)) cnst = 1; - else if (scheme_is_statically_proc(e, info)) { + else if (scheme_is_statically_proc(e, info, 0)) { cnst = 1; sproc = 1; } @@ -7864,7 +7893,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context) } if (!scheme_ir_propagate_ok(e, info) - && scheme_is_statically_proc(e, info)) { + && scheme_is_statically_proc(e, info, 0)) { /* If we previously installed a procedure for inlining, don't replace that with a worse approximation. */ if (SCHEME_LAMBDAP(old_e)) diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index f83b17dd11..bb1334e980 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -3267,7 +3267,7 @@ Scheme_Object *scheme_optimize_apply_values(Scheme_Object *f, Scheme_Object *e, int scheme_ir_duplicate_ok(Scheme_Object *o, int cross_mod); int scheme_ir_propagate_ok(Scheme_Object *o, Optimize_Info *info); -int scheme_is_statically_proc(Scheme_Object *value, Optimize_Info *info); +int scheme_is_statically_proc(Scheme_Object *value, Optimize_Info *info, int flags); XFORM_NONGCING int scheme_predicate_to_local_type(Scheme_Object *pred); Scheme_Object *scheme_make_noninline_proc(Scheme_Object *e); Scheme_Object *scheme_optimize_extract_tail_inside(Scheme_Object *t2);