diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2015-09-29 19:46:42 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2015-09-29 19:46:42 -0700 |
| commit | 111650e235ab2e529fa1529b1c9a23688a11cd1f (patch) | |
| tree | b9b6aa775fdb38bef83458d5822c9ba27d31a152 /tests | |
| parent | c84defd9b6484dff60e513ad79e361c44aadcc0e (diff) | |
| download | txr-111650e235ab2e529fa1529b1c9a23688a11cd1f.tar.gz txr-111650e235ab2e529fa1529b1c9a23688a11cd1f.tar.bz2 txr-111650e235ab2e529fa1529b1c9a23688a11cd1f.zip | |
Implementation of static slots for structures.
* share/txr/stdlib/struct.tl (sys:bad-slot-syntax): New helper function.
(defstruct): Macro revamped with new slot specifier syntax for
writing static slots as well as methods.
* struct.c (STATIC_SLOT_BASE): New preprocessor symbol.
(struct struct_type): New members, nstslots, stinitfun, stslot.
(make_struct_type_compat): New static function.
(struct_init): Register make-struct-type to make_struct_type_compat
if compatibility is 117 or lower.
Register new intrinsics static-slot, static-slot-set, call-super-method,
call-super-fun, slot-p and static-slot-p.
(call_stinitfun_chain): New static function.
(make_struct_type): Two new arguments for specifying static slots and
an initialization function for them. Logic added for setting
up static slots and handling inheritance.
(struct_type_destroy): New static function.
(struct_type_mark): Mark the new stinitfun member of struct type.
Also iterate over the static slots in the new stslot array and
mark them.
(lookup_slot): Altered to return a loc instead of a raw pointer,
and also to accept the instance object as a member.
Now resolves static slots: it can return a loc which references
a static slot in the structure type, or an instance slot in
the structure.
(lookup_static_slot): New static function.
(slot, slotset): Implementation adjusted due to new lookup_slot interface.
(static_slot, static_slot_set, slot_p, static_slot_p): New functions.
(call_super_method, call_super_fun): New static functions.
(struct_inst_print): This function can no longer assume that the slots
list lines up with the array of slots, since it contains a mixture of
static and instance slots. Earnest slot lookup has to be performed.
(struct_type_ops): Point the destroy function to struct_type_destroy
instead of cobj_destroy_free_op. A structure type now has an array
of static slots to free.
* struct.h (make_struct_type): Declaration updated.
(static_slot, static_slot_set, slot_p, static_slot_p): Declared.
* lib.c (time_init): Update call to make_struct_type with new
arguments.
* sysif.c (sysif_init): Likewise.
* tests/012/struct.tl: Update defstruct macro expansion test.
* txr.1: Documented static slots and new functions.
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/012/struct.tl | 29 |
1 files changed, 17 insertions, 12 deletions
diff --git a/tests/012/struct.tl b/tests/012/struct.tl index 5be89cab..3eb5563c 100644 --- a/tests/012/struct.tl +++ b/tests/012/struct.tl @@ -70,18 +70,23 @@ (set *gensym-counter* 0) (stest (sys:expand '(defstruct (boa x y) nil (x 0) (y 0))) - "(make-struct-type 'boa '() '(x y)\n \ - \ (lambda (#:g0004)\n \ - \ (slotset #:g0004 'x\n \ - \ 0)\n \ - \ (slotset #:g0004 'y\n \ - \ 0))\n \ - \ (lambda (#:g0004 #:g0005\n \ - \ #:g0006)\n \ - \ (slotset #:g0004 'x\n \ - \ #:g0005)\n \ - \ (slotset #:g0004 'y\n \ - \ #:g0006)))") + "(sys:make-struct-type 'boa '() '()\n \ + \ '(x y) (lambda (#:g0004))\n \ + \ (lambda (#:g0004)\n \ + \ (let ((#:g0005 (struct-type #:g0004)))\n\ + \ (if (static-slot-p #:g0005 'x)\n \ + \ () (progn (slotset #:g0004 'x\n \ + \ 0)))\n \ + \ (if (static-slot-p #:g0005 'y)\n \ + \ () (progn (slotset #:g0004 'y\n \ + \ 0)))))\n \ + \ (lambda (#:g0004 #:g0006\n \ + \ #:g0007)\n \ + \ (slotset #:g0004 'x\n \ + \ #:g0006)\n \ + \ (slotset #:g0004 'y\n \ + \ #:g0007)))") + (defstruct (boa x y) nil (x 0) (y 0)) |