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

expose custom-{write,print-quotable}-accessor as accessor

Browse Source 
Revert the part of 39a96dd699 that hides the provenance of these
accessors. Although exposing the fact that the predicates are for
structure properties constrains some internal representations, that
constraint seems unlikely to matter, and exposing the procedures as
property predicates is more consistent with the documentation and the
implementation (especially for Racket CS).

Closes #2904
This commit is contained in:
Matthew Flatt 2019-11-12 08:52:43 -07:00
parent b6627956b6
commit 46a73b3d36
2 changed files with 9 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
pkgs/racket-test-core/tests/racket/struct.rktl
View File

@ -14,6 +14,8 @@
(arity-test struct-type-property? 1 1)
(test #t struct-type-property? prop:p)
(test #f struct-type-property? 5)
(test #t struct-type-property-accessor-procedure? p-ref)
(test #t struct-type-property-accessor-procedure? p2-ref)
(let-values ([(type make pred sel set) (make-struct-type 'a #f 2 1 'un (list (cons prop:p 87)) (make-inspector insp1))]
[(typex makex predx selx setx) (make-struct-type 'ax #f 0 5 #f null (make-inspector insp2))])
(arity-test make-struct-type 4 11)
@ -1337,4 +1339,9 @@
;; ----------------------------------------
(test #t struct-type-property-accessor-procedure? custom-write-accessor)
(test #t struct-type-property-accessor-procedure? custom-print-quotable-accessor)
;; ----------------------------------------
(report-errs)

25
racket/src/racket/src/struct.c
View File

@ -96,8 +96,6 @@ static Scheme_Object *check_output_port_property_value_ok(int argc, Scheme_Objec
static Scheme_Object *check_cpointer_property_value_ok(int argc, Scheme_Object *argv[]);
static Scheme_Object *check_checked_proc_property_value_ok(int argc, Scheme_Object *argv[]);
static Scheme_Object *unary_acc(int argc, Scheme_Object **argv, Scheme_Object *self);
static Scheme_Object *make_struct_type(int argc, Scheme_Object *argv[]);
static Scheme_Object *make_struct_field_accessor(int argc, Scheme_Object *argv[]);
@ -322,13 +320,7 @@ scheme_init_struct (Scheme_Startup_Env *env)
scheme_struct_property_type);
scheme_addto_prim_instance("prop:custom-write", write_property, env);
scheme_addto_prim_instance("custom-write?", pred, env);
a[0] = access;
scheme_addto_prim_instance("custom-write-accessor",
scheme_make_prim_closure_w_arity(unary_acc, 1, a,
"custom-write-accessor",
1, 1),
env);
scheme_addto_prim_instance("custom-write-accessor", access, env);
}
REGISTER_SO(print_attribute_property);
@ -344,13 +336,7 @@ scheme_init_struct (Scheme_Startup_Env *env)
scheme_struct_property_type);
scheme_addto_prim_instance("prop:custom-print-quotable", print_attribute_property, env);
scheme_addto_prim_instance("custom-print-quotable?", pred, env);
a[0] = access;
scheme_addto_prim_instance("custom-print-quotable-accessor",
scheme_make_prim_closure_w_arity(unary_acc, 1, a,
"custom-print-quotable-accessor",
1, 1),
env);
scheme_addto_prim_instance("custom-print-quotable-accessor", access, env);
}
REGISTER_SO(evt_property);
@ -1872,13 +1858,6 @@ Scheme_Object *scheme_print_attribute_ref(Scheme_Object *s)
return scheme_struct_type_property_ref(print_attribute_property, s);
}
static Scheme_Object *unary_acc(int argc, Scheme_Object **argv, Scheme_Object *self)
{
Scheme_Object *acc = SCHEME_PRIM_CLOSURE_ELS(self)[0];
return _scheme_apply(acc, argc, argv);
}
/*========================================================================*/
/* checked-proc property */
/*========================================================================*/