Useful feature: object post-initialization.

Structs can now have code which executes after an object is
initialized, which is useful for doing work like registering
objects in global lists and whatever, when those actions need
access to the initialized slots of the object.

* share/txr/stdlib/struct.tl (defstruct): Handle :posinit
syntax, by generating lambda as eighth argument of sys:make-struct
call.

* struct.c (struct struct_type): New member, postinitfun.
(struct_init): Adjust registrations of make_struct_type
to account for new parameter.  The user visible
make-struct-type is registered as having one optional
argument, for backward compat.
(make_struct_type): New argument, postinitfun. Store this
in the structure. For backward compatibility, the argument
is defaulted.
(struct_type_mark): Mark the new postinitfun member.
(call_postinitfun_chain): New static function.
(make_struct, lazy_struct_init): Call call_postinitfun_chain
after slots are initialized, and after the boa function is
called.

* struct.h (make_struct_type): Declaration updated.

* lib.c (time_init): Pass eighth argument to make_struct type.

* sysif.c (sysif_init): Likewise.

* unwind.c (uw_late_init): Likewise.

* tests/012/struct.tl: Update defstruct expansion test case.

* txr.1: Document new argument of make-struct-type,
and clarify ordering of initfun with regard to
other actions.  Likewise, document :postinit, and clarify
ordering of :init actions with regard to other actions.

1 files changed, 19 insertions, 2 deletions

diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl
index 189785fc..c9d19e91 100644
--- a/share/txr/stdlib/struct.tl
+++ b/share/txr/stdlib/struct.tl
@@ -43,7 +43,9 @@
       (throwf 'eval-error "~s: ~s isn't a bindable symbol" 'defstruct name))
     (unless (proper-listp slot-specs)
       (throwf 'eval-error "~s: bad slot syntax" 'defstruct))
-    (let* ((instance-init-form nil) (instance-fini-form nil)
+    (let* ((instance-init-form nil)
+           (instance-postinit-form nil)
+           (instance-fini-form nil)
            (slot-init-forms (collect-each ((slot slot-specs))
                               (tree-case slot
                                 ((word name args . body)
@@ -78,6 +80,16 @@
                                      (set instance-init-form
                                           (cons arg body))
                                      ^(,word nil nil))
+                                   (:postinit
+                                     (unless (bindable arg)
+                                       (sys:bad-slot-syntax slot))
+                                     (when instance-postinit-form
+                                       (throw 'eval-error
+                                              "~s: duplicate :postinit"
+                                              'defstruct))
+                                     (set instance-postinit-form
+                                          (cons arg body))
+                                     ^(,word nil nil))
                                    (:fini
                                      (unless (bindable arg)
                                        (sys:bad-slot-syntax slot))
@@ -153,7 +165,12 @@
                                  req-args r-gens)
                        ,*(mapcar (ret ^(if ,@3
                                          (slotset ,arg-sym ',@1 ,@2)))
-                                 opt-args o-gens p-gens)))))))))))
+                                 opt-args o-gens p-gens))))))
+           ,(if instance-postinit-form
+              ^(lambda (,arg-sym)
+                 ,*(if (cdr instance-postinit-form)
+                     ^((let ((,(car instance-postinit-form) ,arg-sym))
+                         ,*(cdr instance-postinit-form)))))))))))
 
 (defmacro sys:struct-lit (name . plist)
   ^(make-struct ',name ',plist))