suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

optimizer: propagate info for super struct from requires

Browse Source 
Allows a struct declaration to be recognized when it inherits
from an imported struct.
This commit is contained in:
Matthew Flatt 2016-07-13 09:48:26 -06:00
parent 95f6a2342b
commit 9c94e5a8df
6 changed files with 28 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
pkgs/racket-test-core/tests/racket/optimize.rktl
View File

@ -4091,6 +4091,19 @@
(define (f v) (define (f v)
(list (b-z v) #t)))) (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) (test-comp `(lambda (b)
(let ([v (unbox b)]) (let ([v (unbox b)])
(with-continuation-mark 'x 'y (unbox v)))) (with-continuation-mark 'x 'y (unbox v))))

2
racket/src/racket/src/eval.c
View File

@ -2033,7 +2033,7 @@ define_execute_with_dynamic_state(Scheme_Object *vec, int delta, int defmacro,
is_st = 0; is_st = 0;
else else
is_st = !!scheme_is_simple_make_struct_type(vals_expr, g, 1, 0, 1, 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, MZ_RUNSTACK, 0,
NULL, NULL, NULL, 5); NULL, NULL, NULL, 5);

6
racket/src/racket/src/module.c
View File

@ -4598,7 +4598,7 @@ static void setup_accessible_table(Scheme_Module *m)
if (scheme_is_simple_make_struct_type(SCHEME_VEC_ELS(form)[0], if (scheme_is_simple_make_struct_type(SCHEME_VEC_ELS(form)[0],
SCHEME_VEC_SIZE(form)-1, SCHEME_VEC_SIZE(form)-1,
1, 0, 1, NULL, &stinfo, &parent_identity, 1, 0, 1, NULL, &stinfo, &parent_identity,
NULL, NULL, NULL, 0, NULL, NULL, NULL, NULL, 0,
m->prefix->toplevels, ht, m->prefix->toplevels, ht,
&is_st, &is_st,
5)) { 5)) {
@ -4610,7 +4610,7 @@ static void setup_accessible_table(Scheme_Module *m)
if (is_st) { if (is_st) {
intptr_t shape; intptr_t shape;
shape = scheme_get_struct_proc_shape(k-1, &stinfo); 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); v = scheme_make_vector(3, v);
SCHEME_VEC_ELS(v)[1] = scheme_make_integer(shape); SCHEME_VEC_ELS(v)[1] = scheme_make_integer(shape);
SCHEME_VEC_ELS(v)[2] = is_st; 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 */ /* vector of size 3 => struct proc */
if (_is_constant) { if (_is_constant) {
Scheme_Object *ps; Scheme_Object *ps;
ps = scheme_make_struct_proc_shape(SCHEME_INT_VAL(SCHEME_VEC_ELS(pos)[1]), ps = scheme_make_struct_proc_shape(SCHEME_INT_VAL(SCHEME_VEC_ELS(pos)[1]),
SCHEME_VEC_ELS(pos)[2]); SCHEME_VEC_ELS(pos)[2]);

12
racket/src/racket/src/optimize.c
View File

@ -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, auto_e = scheme_is_simple_make_struct_type(o, vals, flags, 1, 0, &auto_e_depth,
NULL, NULL, NULL, NULL,
(opt_info ? opt_info->top_level_consts : 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, NULL, NULL, 0, NULL, NULL, NULL,
5); 5);
if (auto_e) { if (auto_e) {
@ -1123,6 +1124,7 @@ static Scheme_Object *skip_clears(Scheme_Object *body)
static int is_constant_super(Scheme_Object *arg, static int is_constant_super(Scheme_Object *arg,
Scheme_Hash_Table *top_level_consts, Scheme_Hash_Table *top_level_consts,
Scheme_Hash_Table *inline_variants,
Scheme_Hash_Table *top_level_table, Scheme_Hash_Table *top_level_table,
Scheme_Object **runstack, int rs_delta, Scheme_Object **runstack, int rs_delta,
Scheme_Object **symbols, Scheme_Hash_Table *symbol_table, Scheme_Object **symbols, Scheme_Hash_Table *symbol_table,
@ -1137,6 +1139,8 @@ static int is_constant_super(Scheme_Object *arg,
if (top_level_consts) { if (top_level_consts) {
/* This is optimize mode */ /* This is optimize mode */
v = scheme_hash_get(top_level_consts, scheme_make_integer(pos)); 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)) { if (v && SAME_TYPE(SCHEME_TYPE(v), scheme_struct_proc_shape_type)) {
int mode = (SCHEME_PROC_SHAPE_MODE(v) & STRUCT_PROC_SHAPE_MASK); int mode = (SCHEME_PROC_SHAPE_MODE(v) & STRUCT_PROC_SHAPE_MASK);
int field_count = (SCHEME_PROC_SHAPE_MODE(v) >> STRUCT_PROC_SHAPE_SHIFT); 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, Simple_Stuct_Type_Info *_stinfo,
Scheme_Object **_parent_identity, Scheme_Object **_parent_identity,
Scheme_Hash_Table *top_level_consts, Scheme_Hash_Table *top_level_consts,
Scheme_Hash_Table *inline_variants,
Scheme_Hash_Table *top_level_table, Scheme_Hash_Table *top_level_table,
Scheme_Object **runstack, int rs_delta, Scheme_Object **runstack, int rs_delta,
Scheme_Object **symbols, Scheme_Hash_Table *symbol_table, 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; *_parent_identity = scheme_null;
if (!SCHEME_FALSEP(app->args[2])) if (!SCHEME_FALSEP(app->args[2]))
super_count_plus_one = is_constant_super(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, rs_delta + app->num_args,
symbols, symbol_table, _parent_identity); symbols, symbol_table, _parent_identity);
else 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, auto_e = scheme_is_simple_make_struct_type(lv->value, 5, resolved,
must_always_succeed, check_auto, must_always_succeed, check_auto,
_auto_e_depth, _stinfo, _parent_identity, _auto_e_depth, _stinfo, _parent_identity,
top_level_consts, top_level_table, top_level_consts, inline_variants, top_level_table,
runstack, rs_delta, runstack, rs_delta,
symbols, symbol_table, symbols, symbol_table,
_name, _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, auto_e = scheme_is_simple_make_struct_type(e2, 5, resolved,
must_always_succeed, check_auto, must_always_succeed, check_auto,
_auto_e_depth, _stinfo, _parent_identity, _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, runstack, rs_delta + lvd->count,
symbols, symbol_table, symbols, symbol_table,
_name, _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, } else if (scheme_is_simple_make_struct_type(e, n, 0, 0, 1, NULL,
&stinfo, &parent_identity, &stinfo, &parent_identity,
info->top_level_consts, info->top_level_consts,
info->cp->inline_variants,
NULL, NULL, 0, NULL, NULL, NULL, NULL, 0, NULL, NULL,
&sstruct, &sstruct,
5)) { 5)) {

1
racket/src/racket/src/schpriv.h
View File

@ -3500,6 +3500,7 @@ Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *app, int vals, i
Simple_Stuct_Type_Info *_stinfo, Simple_Stuct_Type_Info *_stinfo,
Scheme_Object **_parent_identity, Scheme_Object **_parent_identity,
Scheme_Hash_Table *top_level_consts, Scheme_Hash_Table *top_level_consts,
Scheme_Hash_Table *inline_variants,
Scheme_Hash_Table *top_level_table, Scheme_Hash_Table *top_level_table,
Scheme_Object **runstack, int rs_delta, Scheme_Object **runstack, int rs_delta,
Scheme_Object **symbols, Scheme_Hash_Table *symbol_table, Scheme_Object **symbols, Scheme_Hash_Table *symbol_table,

2
racket/src/racket/src/validate.c
View File

@ -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, if (scheme_is_simple_make_struct_type(val, size-1, 1, 0, 1, NULL,
&stinfo, NULL, &stinfo, NULL,
NULL, (_st_ht ? *_st_ht : NULL), NULL, NULL, (_st_ht ? *_st_ht : NULL),
NULL, 0, NULL, NULL, NULL, 5)) { NULL, 0, NULL, NULL, NULL, 5)) {
/* This set of bindings is constant across invocations, but /* This set of bindings is constant across invocations, but
if `uses_super', we need to increment tl_timestamp for if `uses_super', we need to increment tl_timestamp for