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

optimizer: allow some properties in recognized struct declarations

Browse Source 
When the properties argument for `make-struct-type` is non-empty,
then we cant; guarantee that `make-struct-type` succeeds, but
if it does, then we can still know that the result is a structure
type and (as long as `prop:chaperone-unsafe-undefined` is not
involved) the properties don't affect the constructor, predicate,
selector, or mutators.
This commit is contained in:
Matthew Flatt 2016-06-15 17:07:34 -07:00
parent ed3e5d3e7d
commit e887fa56d1
6 changed files with 94 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3841,6 +3841,32 @@
(b? (b-z (b 1 2 3)))) (b? (b-z (b 1 2 3))))
5))) 5)))
(test-comp '(module m racket/base
(struct a (x y) #:omit-define-syntaxes
#:property prop:custom-write (lambda (v port mode)
(write-string "#<a>" port))
#:property prop:equal+hash (list (lambda (a b eql?) (eq? a b))
(lambda (a hash-code) 0)
(lambda (a hash-code) 1)))
(begin0
(a? (a-x (a 1 2)))
a?
a
a-x
(a? 7)
(a 1 2)
5))
'(module m racket/base
(struct a (x y) #:omit-define-syntaxes
#:property prop:custom-write (lambda (v port mode)
(write-string "#<a>" port))
#:property prop:equal+hash (list (lambda (a b eql?) (eq? a b))
(lambda (a hash-code) 0)
(lambda (a hash-code) 1)))
(begin0
(a? (a-x (a 1 2)))
5)))
(module struct-a-for-optimize racket/base (module struct-a-for-optimize racket/base
(provide (struct-out a) (provide (struct-out a)
(struct-out b)) (struct-out b))

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

@ -2032,7 +2032,7 @@ define_execute_with_dynamic_state(Scheme_Object *vec, int delta, int defmacro,
if (dm_env) if (dm_env)
is_st = 0; is_st = 0;
else else
is_st = !!scheme_is_simple_make_struct_type(vals_expr, g, 1, 1, is_st = !!scheme_is_simple_make_struct_type(vals_expr, g, 1, 0, 1,
NULL, NULL, NULL, NULL,
NULL, NULL, MZ_RUNSTACK, 0, NULL, NULL, MZ_RUNSTACK, 0,
NULL, NULL, 5); NULL, NULL, 5);

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

@ -4512,7 +4512,7 @@ static void setup_accessible_table(Scheme_Module *m)
if (!checked_st) { if (!checked_st) {
is_st = !!scheme_is_simple_make_struct_type(SCHEME_VEC_ELS(form)[0], is_st = !!scheme_is_simple_make_struct_type(SCHEME_VEC_ELS(form)[0],
SCHEME_VEC_SIZE(form)-1, SCHEME_VEC_SIZE(form)-1,
1, 1, NULL, &stinfo, 1, 0, 1, NULL, &stinfo,
NULL, NULL, NULL, 0, NULL, NULL, NULL, 0,
m->prefix->toplevels, ht, m->prefix->toplevels, ht,
5); 5);

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

@ -623,7 +623,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int flags,
{ {
Scheme_Object *auto_e; Scheme_Object *auto_e;
int auto_e_depth; int auto_e_depth;
auto_e = scheme_is_simple_make_struct_type(o, vals, flags, 0, &auto_e_depth, 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->top_level_consts : NULL),
NULL, NULL, 0, NULL, NULL, NULL, NULL, 0, NULL, NULL,
@ -1170,8 +1170,55 @@ static int is_constant_super(Scheme_Object *arg,
return 0; return 0;
} }
static int is_simple_property_list(Scheme_Object *a, int resolved)
/* Does `a` produce a property list with no effect on the constructor? */
{
Scheme_Object *arg;
int i, count;
if (SAME_TYPE(SCHEME_TYPE(a), scheme_application_type))
count = ((Scheme_App_Rec *)a)->num_args;
else if (SAME_TYPE(SCHEME_TYPE(a), scheme_application2_type))
count = 1;
else if (SAME_TYPE(SCHEME_TYPE(a), scheme_application3_type))
count = 2;
else
return 0;
for (i = 0; i < count; i++) {
if (SAME_TYPE(SCHEME_TYPE(a), scheme_application_type))
arg = ((Scheme_App_Rec *)a)->args[i+1];
else if (SAME_TYPE(SCHEME_TYPE(a), scheme_application2_type))
arg = ((Scheme_App2_Rec *)a)->rator;
else {
if (i == 0)
arg = ((Scheme_App3_Rec *)a)->rand1;
else
arg = ((Scheme_App3_Rec *)a)->rand2;
}
if (SAME_TYPE(SCHEME_TYPE(arg), scheme_application3_type)) {
Scheme_App3_Rec *a3 = (Scheme_App3_Rec *)arg;
if (!SAME_OBJ(a3->rator, scheme_cons_proc))
return 0;
if (SAME_TYPE(SCHEME_TYPE(a3->rand1), scheme_struct_property_type)
/* `prop:chaperone-unsafe-undefined` affects the constructor */
&& !SAME_OBJ(a3->rand1, scheme_chaperone_undefined_property)) {
if (!scheme_omittable_expr(a3->rand2, 1, 3, (resolved ? OMITTABLE_RESOLVED : 0), NULL, NULL))
return 0;
} else
return 0;
} else
return 0;
}
return 1;
}
Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *e, int vals, int resolved, Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *e, int vals, int resolved,
int check_auto, int must_always_succeed, int check_auto,
GC_CAN_IGNORE int *_auto_e_depth, GC_CAN_IGNORE int *_auto_e_depth,
Simple_Stuct_Type_Info *_stinfo, Simple_Stuct_Type_Info *_stinfo,
Scheme_Hash_Table *top_level_consts, Scheme_Hash_Table *top_level_consts,
@ -1179,8 +1226,10 @@ Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *e, int vals, int
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,
int fuel) int fuel)
/* Checks whether it's a `make-struct-type' call that certainly succeeds /* Checks whether it's a `make-struct-type' call --- that, if `must_always_succeed` is
(i.e., no exception) --- pending a check of the auto-value argument if !check_auto. true, certainly succeeds (i.e., no exception) --- pending a check of the auto-value
argument if !check_auto. The resulting constructor must always succeed (i.e., no
guards) and not involve chaperones (i.e., no `prop:chaperone-unsafe-undefined`).
The result is the auto-value argument or scheme_true if it's simple, NULL if not. The result is the auto-value argument or scheme_true if it's simple, NULL if not.
The first result is a struct type, the second a constructor, and the thrd a predicate; The first result is a struct type, the second a constructor, and the thrd a predicate;
the rest are an unspecified mixture of selectors and mutators. */ the rest are an unspecified mixture of selectors and mutators. */
@ -1215,8 +1264,11 @@ Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *e, int vals, int
|| !check_auto || !check_auto
|| scheme_omittable_expr(app->args[5], 1, 3, (resolved ? OMITTABLE_RESOLVED : 0), NULL, NULL)) || scheme_omittable_expr(app->args[5], 1, 3, (resolved ? OMITTABLE_RESOLVED : 0), NULL, NULL))
&& ((app->num_args < 6) && ((app->num_args < 6)
/* no properties: */ /* no properties... */
|| SCHEME_NULLP(app->args[6])) || SCHEME_NULLP(app->args[6])
/* ... or properties that don't affect the constructor ... */
|| (!must_always_succeed
&& is_simple_property_list(app->args[6], resolved)))
&& ((app->num_args < 7) && ((app->num_args < 7)
/* inspector: */ /* inspector: */
|| SCHEME_FALSEP(app->args[7]) || SCHEME_FALSEP(app->args[7])
@ -1272,7 +1324,8 @@ Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *e, int vals, int
Scheme_Object *auto_e; Scheme_Object *auto_e;
Simple_Stuct_Type_Info stinfo; Simple_Stuct_Type_Info stinfo;
if (!_stinfo) _stinfo = &stinfo; if (!_stinfo) _stinfo = &stinfo;
auto_e = scheme_is_simple_make_struct_type(lv->value, 5, resolved, check_auto, auto_e = scheme_is_simple_make_struct_type(lv->value, 5, resolved,
must_always_succeed, check_auto,
_auto_e_depth, _stinfo, _auto_e_depth, _stinfo,
top_level_consts, top_level_table, top_level_consts, top_level_table,
runstack, rs_delta, runstack, rs_delta,
@ -1303,7 +1356,8 @@ Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *e, int vals, int
Scheme_Object *auto_e; Scheme_Object *auto_e;
Simple_Stuct_Type_Info stinfo; Simple_Stuct_Type_Info stinfo;
if (!_stinfo) _stinfo = &stinfo; if (!_stinfo) _stinfo = &stinfo;
auto_e = scheme_is_simple_make_struct_type(e2, 5, resolved, check_auto, auto_e = scheme_is_simple_make_struct_type(e2, 5, resolved,
must_always_succeed, check_auto,
_auto_e_depth, _stinfo, _auto_e_depth, _stinfo,
top_level_consts, top_level_table, top_level_consts, top_level_table,
runstack, rs_delta + lvd->count, runstack, rs_delta + lvd->count,
@ -7835,7 +7889,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
cnst = 1; cnst = 1;
sproc = 1; sproc = 1;
} }
} else if (scheme_is_simple_make_struct_type(e, n, 0, 1, NULL, } else if (scheme_is_simple_make_struct_type(e, n, 0, 0, 1, NULL,
&stinfo, &stinfo,
info->top_level_consts, info->top_level_consts,
NULL, NULL, 0, NULL, NULL, NULL, NULL, 0, NULL, NULL,

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

@ -3486,6 +3486,7 @@ typedef struct {
} Simple_Stuct_Type_Info; } Simple_Stuct_Type_Info;
Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *app, int vals, int resolved, Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *app, int vals, int resolved,
int must_always_succeed,
int check_auto, int *_auto_e_depth, int check_auto, int *_auto_e_depth,
Simple_Stuct_Type_Info *_stinfo, Simple_Stuct_Type_Info *_stinfo,
Scheme_Hash_Table *top_level_consts, Scheme_Hash_Table *top_level_consts,

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

@ -398,7 +398,7 @@ static int define_values_validate(Scheme_Object *data, Mz_CPort *port,
only_var = NULL; only_var = NULL;
} }
if (scheme_is_simple_make_struct_type(val, size-1, 1, 1, NULL, if (scheme_is_simple_make_struct_type(val, size-1, 1, 0, 1, NULL,
&stinfo, &stinfo,
NULL, (_st_ht ? *_st_ht : NULL), NULL, (_st_ht ? *_st_ht : NULL),
NULL, 0, NULL, NULL, 5)) { NULL, 0, NULL, NULL, 5)) {