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)) {