diff --git a/pkgs/racket-test-core/tests/racket/optimize.rktl b/pkgs/racket-test-core/tests/racket/optimize.rktl index b0c524c0ed..cc9a66c94c 100644 --- a/pkgs/racket-test-core/tests/racket/optimize.rktl +++ b/pkgs/racket-test-core/tests/racket/optimize.rktl @@ -4091,6 +4091,19 @@ (define (f v) (list (b-z v) #t)))) +(test-comp '(module m racket/base + (require 'struct-a-for-optimize + racket/unsafe/ops) + (struct c b (m)) + (define (f v) + (and (c? v) (c-m v)))) + '(module m racket/base + (require 'struct-a-for-optimize + racket/unsafe/ops) + (struct c b (m)) + (define (f v) + (and (c? v) (unsafe-struct-ref v 3))))) + (test-comp `(lambda (b) (let ([v (unbox b)]) (with-continuation-mark 'x 'y (unbox v)))) diff --git a/racket/src/racket/src/eval.c b/racket/src/racket/src/eval.c index 95ed8ca56c..56e17e6e47 100644 --- a/racket/src/racket/src/eval.c +++ b/racket/src/racket/src/eval.c @@ -2033,7 +2033,7 @@ define_execute_with_dynamic_state(Scheme_Object *vec, int delta, int defmacro, is_st = 0; else is_st = !!scheme_is_simple_make_struct_type(vals_expr, g, 1, 0, 1, - NULL, NULL, NULL, + NULL, NULL, NULL, NULL, NULL, NULL, MZ_RUNSTACK, 0, NULL, NULL, NULL, 5); diff --git a/racket/src/racket/src/module.c b/racket/src/racket/src/module.c index 5f015730a0..ccc06a4bca 100644 --- a/racket/src/racket/src/module.c +++ b/racket/src/racket/src/module.c @@ -4598,7 +4598,7 @@ static void setup_accessible_table(Scheme_Module *m) if (scheme_is_simple_make_struct_type(SCHEME_VEC_ELS(form)[0], SCHEME_VEC_SIZE(form)-1, 1, 0, 1, NULL, &stinfo, &parent_identity, - NULL, NULL, NULL, 0, + NULL, NULL, NULL, NULL, 0, m->prefix->toplevels, ht, &is_st, 5)) { @@ -4610,7 +4610,7 @@ static void setup_accessible_table(Scheme_Module *m) if (is_st) { intptr_t shape; shape = scheme_get_struct_proc_shape(k-1, &stinfo); - /* Vector of size 3 => struct procedure */ + /* Vector of size 3 => struct shape */ v = scheme_make_vector(3, v); SCHEME_VEC_ELS(v)[1] = scheme_make_integer(shape); SCHEME_VEC_ELS(v)[2] = is_st; @@ -4847,7 +4847,7 @@ static Scheme_Object *check_accessible_in_module(Scheme_Module *module, intptr_t /* vector of size 3 => struct proc */ if (_is_constant) { Scheme_Object *ps; - + ps = scheme_make_struct_proc_shape(SCHEME_INT_VAL(SCHEME_VEC_ELS(pos)[1]), SCHEME_VEC_ELS(pos)[2]); diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c index 213196a402..b0c2c2ff8d 100644 --- a/racket/src/racket/src/optimize.c +++ b/racket/src/racket/src/optimize.c @@ -626,6 +626,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int flags, auto_e = scheme_is_simple_make_struct_type(o, vals, flags, 1, 0, &auto_e_depth, NULL, NULL, (opt_info ? opt_info->top_level_consts : NULL), + ((opt_info && opt_info->cp) ? opt_info->cp->inline_variants : NULL), NULL, NULL, 0, NULL, NULL, NULL, 5); if (auto_e) { @@ -1123,6 +1124,7 @@ static Scheme_Object *skip_clears(Scheme_Object *body) static int is_constant_super(Scheme_Object *arg, Scheme_Hash_Table *top_level_consts, + Scheme_Hash_Table *inline_variants, Scheme_Hash_Table *top_level_table, Scheme_Object **runstack, int rs_delta, Scheme_Object **symbols, Scheme_Hash_Table *symbol_table, @@ -1137,6 +1139,8 @@ static int is_constant_super(Scheme_Object *arg, if (top_level_consts) { /* This is optimize mode */ v = scheme_hash_get(top_level_consts, scheme_make_integer(pos)); + if (!v && inline_variants) + v = scheme_hash_get(inline_variants, scheme_make_integer(pos)); if (v && SAME_TYPE(SCHEME_TYPE(v), scheme_struct_proc_shape_type)) { int mode = (SCHEME_PROC_SHAPE_MODE(v) & STRUCT_PROC_SHAPE_MASK); int field_count = (SCHEME_PROC_SHAPE_MODE(v) >> STRUCT_PROC_SHAPE_SHIFT); @@ -1212,6 +1216,7 @@ Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *e, int vals, int Simple_Stuct_Type_Info *_stinfo, Scheme_Object **_parent_identity, Scheme_Hash_Table *top_level_consts, + Scheme_Hash_Table *inline_variants, Scheme_Hash_Table *top_level_table, Scheme_Object **runstack, int rs_delta, Scheme_Object **symbols, Scheme_Hash_Table *symbol_table, @@ -1238,7 +1243,7 @@ Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *e, int vals, int *_parent_identity = scheme_null; if (!SCHEME_FALSEP(app->args[2])) super_count_plus_one = is_constant_super(app->args[2], - top_level_consts, top_level_table, runstack, + top_level_consts, inline_variants, top_level_table, runstack, rs_delta + app->num_args, symbols, symbol_table, _parent_identity); else @@ -1326,7 +1331,7 @@ Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *e, int vals, int auto_e = scheme_is_simple_make_struct_type(lv->value, 5, resolved, must_always_succeed, check_auto, _auto_e_depth, _stinfo, _parent_identity, - top_level_consts, top_level_table, + top_level_consts, inline_variants, top_level_table, runstack, rs_delta, symbols, symbol_table, _name, @@ -1359,7 +1364,7 @@ Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *e, int vals, int auto_e = scheme_is_simple_make_struct_type(e2, 5, resolved, must_always_succeed, check_auto, _auto_e_depth, _stinfo, _parent_identity, - top_level_consts, top_level_table, + top_level_consts, inline_variants, top_level_table, runstack, rs_delta + lvd->count, symbols, symbol_table, _name, @@ -8009,6 +8014,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context) } else if (scheme_is_simple_make_struct_type(e, n, 0, 0, 1, NULL, &stinfo, &parent_identity, info->top_level_consts, + info->cp->inline_variants, NULL, NULL, 0, NULL, NULL, &sstruct, 5)) { diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 084ac01c42..96c63e29c0 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -3500,6 +3500,7 @@ Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *app, int vals, i Simple_Stuct_Type_Info *_stinfo, Scheme_Object **_parent_identity, Scheme_Hash_Table *top_level_consts, + Scheme_Hash_Table *inline_variants, Scheme_Hash_Table *top_level_table, Scheme_Object **runstack, int rs_delta, Scheme_Object **symbols, Scheme_Hash_Table *symbol_table, diff --git a/racket/src/racket/src/validate.c b/racket/src/racket/src/validate.c index 558cfedb4f..692b238ea2 100644 --- a/racket/src/racket/src/validate.c +++ b/racket/src/racket/src/validate.c @@ -400,7 +400,7 @@ static int define_values_validate(Scheme_Object *data, Mz_CPort *port, if (scheme_is_simple_make_struct_type(val, size-1, 1, 0, 1, NULL, &stinfo, NULL, - NULL, (_st_ht ? *_st_ht : NULL), + NULL, NULL, (_st_ht ? *_st_ht : NULL), NULL, 0, NULL, NULL, NULL, 5)) { /* This set of bindings is constant across invocations, but if `uses_super', we need to increment tl_timestamp for