From e887fa56d1f4c37b18901ff916055ce21e270f3c Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 15 Jun 2016 17:07:34 -0700 Subject: [PATCH] optimizer: allow some properties in recognized struct declarations 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. --- .../tests/racket/optimize.rktl | 26 +++++++ racket/src/racket/src/eval.c | 2 +- racket/src/racket/src/module.c | 2 +- racket/src/racket/src/optimize.c | 72 ++++++++++++++++--- racket/src/racket/src/schpriv.h | 3 +- racket/src/racket/src/validate.c | 2 +- 6 files changed, 94 insertions(+), 13 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/optimize.rktl b/pkgs/racket-test-core/tests/racket/optimize.rktl index 5d6328f154..6fd217f627 100644 --- a/pkgs/racket-test-core/tests/racket/optimize.rktl +++ b/pkgs/racket-test-core/tests/racket/optimize.rktl @@ -3841,6 +3841,32 @@ (b? (b-z (b 1 2 3)))) 5))) +(test-comp '(module m racket/base + (struct a (x y) #:omit-define-syntaxes + #:property prop:custom-write (lambda (v port mode) + (write-string "#" 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 "#" 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 (provide (struct-out a) (struct-out b)) diff --git a/racket/src/racket/src/eval.c b/racket/src/racket/src/eval.c index c5bca9ee4a..64adfb3cfd 100644 --- a/racket/src/racket/src/eval.c +++ b/racket/src/racket/src/eval.c @@ -2032,7 +2032,7 @@ define_execute_with_dynamic_state(Scheme_Object *vec, int delta, int defmacro, if (dm_env) is_st = 0; 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, MZ_RUNSTACK, 0, NULL, NULL, 5); diff --git a/racket/src/racket/src/module.c b/racket/src/racket/src/module.c index 8f38ac53fe..52bc579e03 100644 --- a/racket/src/racket/src/module.c +++ b/racket/src/racket/src/module.c @@ -4512,7 +4512,7 @@ static void setup_accessible_table(Scheme_Module *m) if (!checked_st) { is_st = !!scheme_is_simple_make_struct_type(SCHEME_VEC_ELS(form)[0], SCHEME_VEC_SIZE(form)-1, - 1, 1, NULL, &stinfo, + 1, 0, 1, NULL, &stinfo, NULL, NULL, NULL, 0, m->prefix->toplevels, ht, 5); diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c index 80771ee6eb..7d31410d94 100644 --- a/racket/src/racket/src/optimize.c +++ b/racket/src/racket/src/optimize.c @@ -623,7 +623,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int flags, { Scheme_Object *auto_e; 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, (opt_info ? opt_info->top_level_consts : NULL), NULL, NULL, 0, NULL, NULL, @@ -1170,8 +1170,55 @@ static int is_constant_super(Scheme_Object *arg, 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, - int check_auto, + int must_always_succeed, int check_auto, GC_CAN_IGNORE int *_auto_e_depth, Simple_Stuct_Type_Info *_stinfo, 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 **symbols, Scheme_Hash_Table *symbol_table, int fuel) -/* Checks whether it's a `make-struct-type' call that certainly succeeds - (i.e., no exception) --- pending a check of the auto-value argument if !check_auto. +/* Checks whether it's a `make-struct-type' call --- that, if `must_always_succeed` is + 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 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. */ @@ -1215,8 +1264,11 @@ Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *e, int vals, int || !check_auto || scheme_omittable_expr(app->args[5], 1, 3, (resolved ? OMITTABLE_RESOLVED : 0), NULL, NULL)) && ((app->num_args < 6) - /* no properties: */ - || SCHEME_NULLP(app->args[6])) + /* no properties... */ + || 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) /* inspector: */ || 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; Simple_Stuct_Type_Info 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, top_level_consts, top_level_table, 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; Simple_Stuct_Type_Info 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, top_level_consts, top_level_table, runstack, rs_delta + lvd->count, @@ -7835,7 +7889,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context) cnst = 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, info->top_level_consts, NULL, NULL, 0, NULL, NULL, diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 0183ba6762..91ee6122f5 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -3485,7 +3485,8 @@ typedef struct { int normal_ops, indexed_ops, num_gets, num_sets; } 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, Simple_Stuct_Type_Info *_stinfo, Scheme_Hash_Table *top_level_consts, diff --git a/racket/src/racket/src/validate.c b/racket/src/racket/src/validate.c index afd64e6ae9..e25aac6e1d 100644 --- a/racket/src/racket/src/validate.c +++ b/racket/src/racket/src/validate.c @@ -398,7 +398,7 @@ static int define_values_validate(Scheme_Object *data, Mz_CPort *port, 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, NULL, (_st_ht ? *_st_ht : NULL), NULL, 0, NULL, NULL, 5)) {