struct :init :fini specifiers.

* share/txr/stdlib/struct.tl (defstruct): New (:init ...) and
(:fini ...) syntax can be used in the slot list to specify
an initialization function and a gc-finalization function.

* txr.1: Documented.

2 files changed, 93 insertions, 3 deletions

diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl
index 6bef4919..d1e42d2a 100644
--- a/share/txr/stdlib/struct.tl
+++ b/share/txr/stdlib/struct.tl
@@ -35,7 +35,8 @@
       (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* ((slot-init-forms (collect-each ((slot slot-specs))
+    (let* ((instance-init-form nil) (instance-fini-form nil)
+           (slot-init-forms (collect-each ((slot slot-specs))
                               (tree-case slot
                                 ((word name args . body)
                                  (caseq word
@@ -52,7 +53,32 @@
                                      (when body
                                        (sys:bad-slot-syntax slot))
                                      ^(,word ,name ,args))
-                                   (t (sys:bad-slot-syntax slot))))
+                                   (t :)))
+                                ((word (arg) . body)
+                                 (caseq word
+                                   (:init
+                                     (unless (bindable arg)
+                                       (sys:bad-slot-syntax slot))
+                                     (when instance-init-form
+                                       (uw-throwf 'eval-error
+                                                  "~s: duplicate :init"
+                                                  'defstruct))
+                                     (set instance-init-form
+                                          (cons arg body))
+                                     ^(,word nil nil))
+                                   (:fini
+                                     (unless (bindable arg)
+                                       (sys:bad-slot-syntax slot))
+                                     (when instance-fini-form
+                                       (uw-throwf 'eval-error
+                                                  "~s: duplicate :fini"
+                                                  'defstruct))
+                                     (set instance-fini-form
+                                          (cons arg body))
+                                     ^(,word nil nil))
+                                   (t (when body
+                                        (sys:bad-slot-syntax slot))
+                                      :)))
                                 ((word name)
                                    (caseq word
                                      ((:static :instance)
@@ -82,7 +108,13 @@
              (let ((,type-sym (struct-type ,arg-sym)))
                ,*(mapcar (aret ^(unless (static-slot-p ,type-sym ',@2)
                                   (slotset ,arg-sym ',@2 ,@3)))
-                         inst-si-forms)))
+                         inst-si-forms))
+             ,*(if (cdr instance-init-form)
+                 ^((let ((,(car instance-init-form) ,arg-sym))
+                     ,*(cdr instance-init-form))))
+             ,*(if (cdr instance-fini-form)
+                 ^((finalize ,arg-sym (lambda (,(car instance-fini-form))
+                                        ,*(cdr instance-fini-form))))))
            ,(if args
               (let ((gens (mapcar (ret (gensym)) args)))
                 ^(lambda (,arg-sym ,*gens)
diff --git a/txr.1 b/txr.1
index 02598449..b4bdacb4 100644
--- a/txr.1
+++ b/txr.1
@@ -17835,6 +17835,64 @@ Such functions are called using the
 syntax which doesn't insert the instance name into
 the argument list.
 
+.meIP (:init <> ( param ) << body-form *)
+The
+.code :init
+descriptor doesn't describe a slot. Rather, it specifies code
+which is executed when a structure is instantiated, after
+the slot initializations specific to the structure type
+are performed. The code consists of
+.metn body-form -s
+which are evaluated in order in a lexical scope in
+which the variable
+.meta param
+is bound to the structure object.
+
+The
+.code :init
+specifier may not appear more than once in a given
+.code defstruct
+form.
+
+When an object with one or more levels of inheritance
+is instantiated, the
+.code :init
+code of a base structure type, if any, is executed
+before any initializations specific to a derived
+structure type.
+
+Initializers in base structures must be careful about assumptions about slot
+kinds, because derived structures can alter static slots to instance slots or
+vice versa. To avoid an unwanted initialization being applied to the
+wrong kind of slot, initialization code can be made conditional on the
+outcome of
+.code static-slot-p
+applied to the slot.
+(Code generated by
+.code defstruct
+for initializing instance slots performs this kind of check).
+
+.meIP (:fini <> ( param ) << body-form *)
+The
+.code :fini
+descriptor doesn't describe a slot. Rather, it specifies
+a finalization function which is associated with the
+structure instance, as if by use of the
+.code finalize
+function. This finalization registration takes place
+as the last step when an instance of the structure
+is created, after the slots are initialized and
+the
+.code :init
+code, if any, has been executed. The registration
+takes place as if by the evaluation of the form
+.cblk
+.meti (finalize << obj (lambda <> (param) << body-form ...))
+.cble
+where
+.meta obj
+denotes the structure instance.
+
 .RE
 .PP