4 files changed, 87 insertions, 55 deletions
diff --git a/stdlib/struct.tl b/stdlib/struct.tl
index 3a89ee3a..97a7d9ed 100644
--- a/stdlib/struct.tl
+++ b/stdlib/struct.tl
@@ -50,10 +50,10 @@
       (compile-warning form "~s is a built-in type" name))
     (unless (proper-listp slot-specs)
       (compile-error form "bad syntax: dotted form"))
-    (let ((instance-init-form nil)
-          (instance-postinit-form nil)
-          (instance-fini-form nil)
-          (instance-postfini-form nil))
+    (let ((instance-init-forms nil)
+          (instance-postinit-forms nil)
+          (instance-fini-forms nil)
+          (instance-postfini-forms nil))
       (labels ((expand-slot (form slot)
                  (tree-case slot
                    ((op . args)
@@ -83,38 +83,22 @@
                       (:init
                         (unless (bindable arg)
                           (sys:bad-slot-syntax form slot))
-                        (when instance-init-form
-                          (compile-error form
-                                         "duplicate :init"))
-                        (set instance-init-form
-                             (cons arg body))
+                        (push (cons arg body) instance-init-forms)
                         ^((,word nil nil)))
                       (:postinit
                         (unless (bindable arg)
                           (sys:bad-slot-syntax form slot))
-                        (when instance-postinit-form
-                          (compile-error form
-                                         "duplicate :postinit"))
-                        (set instance-postinit-form
-                             (cons arg body))
+                        (push (cons arg body) instance-postinit-forms)
                         ^((,word nil nil)))
                       (:fini
                         (unless (bindable arg)
                           (sys:bad-slot-syntax form slot))
-                        (when instance-fini-form
-                          (compile-error form
-                                         "duplicate :fini"))
-                        (set instance-fini-form
-                             (cons arg body))
+                        (push (cons arg body) instance-fini-forms)
                         ^((,word nil nil)))
                       (:postfini
                         (unless (bindable arg)
                           (sys:bad-slot-syntax form slot))
-                        (when instance-postfini-form
-                          (compile-error form
-                                         "duplicate :postfini"))
-                        (set instance-postfini-form
-                             (cons arg body))
+                        (push (cons arg body) instance-postfini-forms)
                         ^((,word nil nil)))
                       (t (when body
                            (sys:bad-slot-syntax form slot))
@@ -172,27 +156,28 @@
                       ,*(mapcar (aret ^(when (static-slot-p ,arg-sym ',@2)
                                          (static-slot-set ,arg-sym ',@2 ,@3)))
                                 (append func-si-forms val-si-forms))))
-               ,(if (or inst-si-forms instance-init-form
-                        instance-fini-form instance-postfini-form)
+               ,(if (or inst-si-forms instance-init-forms
+                        instance-fini-forms instance-postfini-forms)
                   ^(lambda (,arg-sym)
-                     ,*(if (cdr instance-fini-form)
-                         ^((finalize ,arg-sym (sys:meth-lambda ,name :fini
-                                                               (,(car instance-fini-form))
-                                                ,*(cdr instance-fini-form))
-                                     t)))
-                     ,*(if (cdr instance-postfini-form)
-                         ^((finalize ,arg-sym (sys:meth-lambda ,name :postfini
-                                                               (,(car instance-postfini-form))
-                                                ,*(cdr instance-postfini-form)))))
+                     ,*(append-each ((iff (nreverse instance-fini-forms)))
+                         (if (cdr iff)
+                           ^((finalize ,arg-sym (sys:meth-lambda ,name :fini (,(car iff))
+                                                  ,*(cdr iff))
+                                       t))))
+                     ,*(append-each ((ipf (nreverse instance-postfini-forms)))
+                         (if (cdr ipf)
+                           ^((finalize ,arg-sym (sys:meth-lambda ,name :postfini (,(car ipf))
+                                                ,*(cdr ipf))))))
                      ,*(if inst-si-forms
                          ^((let ((,type-sym (struct-type ,arg-sym)))
                              ,*(mapcar (aret ^(unless (static-slot-p ,type-sym ',@2)
                                                 (slotset ,arg-sym ',@2 ,@3)))
                                        inst-si-forms))))
-                     ,*(if (cdr instance-init-form)
-                         ^((symacrolet ((%fun% '(,name :init)))
-                             (let ((,(car instance-init-form) ,arg-sym))
-                               ,*(cdr instance-init-form)))))))
+                     ,*(append-each ((iif (nreverse instance-init-forms)))
+                         (if (cdr iif)
+                           ^((symacrolet ((%fun% '(,name :init)))
+                               (let ((,(car iif) ,arg-sym))
+                                 ,*(cdr iif))))))))
                ,(when args
                   (when (> (countql : args) 1)
                     (compile-error form
@@ -213,11 +198,12 @@
                            ,*(mapcar (ret ^(if ,@3
                                              (slotset ,arg-sym ',@1 ,@2)))
                                      opt-args o-gens p-gens))))))
-               ,(if instance-postinit-form
+               ,(if instance-postinit-forms
                   ^(sys:meth-lambda ,name :postinit (,arg-sym)
-                     ,*(if (cdr instance-postinit-form)
-                         ^((let ((,(car instance-postinit-form) ,arg-sym))
-                             ,*(cdr instance-postinit-form)))))))))))))
+                     ,*(append-each ((ipf (nreverse instance-postinit-forms)))
+                         (if (cdr ipf)
+                           ^((let ((,(car ipf) ,arg-sym))
+                               ,*(cdr ipf))))))))))))))
 
 (defmacro sys:struct-lit (name . plist)
   ^(sys:make-struct-lit ',name ',plist))
diff --git a/tests/012/fini.expected b/tests/012/fini.expected
index a733802b..72fdc948 100644
--- a/tests/012/fini.expected
+++ b/tests/012/fini.expected
@@ -121,3 +121,11 @@ derived:38 derived postfini
 derived:39 derived postfini
 derived:40 derived postfini
 derived:41 derived postfini
+multi :init: 1
+multi :init: 2
+multi :postinit: 1
+multi :postinit: 2
+multi :fini: 2
+multi :fini: 1
+multi :postfini: 1
+multi :postfini: 2
diff --git a/tests/012/fini.tl b/tests/012/fini.tl
index 775f210f..4036b5d4 100644
--- a/tests/012/fini.tl
+++ b/tests/012/fini.tl
@@ -22,3 +22,23 @@
 
 (mapcar (ret (new derived)) (range 1 20))
 (sys:gc)
+
+(defstruct multi ()
+  (:init (me)
+    (put-line `@{%fun%}: 1`))
+  (:init (me)
+    (put-line `@{%fun%}: 2`))
+  (:postinit (me)
+    (put-line `@{%fun%}: 1`))
+  (:postinit (me)
+    (put-line `@{%fun%}: 2`))
+  (:fini (me)
+    (put-line `@{%fun%}: 1`))
+  (:fini (me)
+    (put-line `@{%fun%}: 2`))
+  (:postfini (me)
+    (put-line `@{%fun%}: 1`))
+  (:postfini (me)
+    (put-line `@{%fun%}: 2`)))
+
+(with-objects ((m (new multi))))
diff --git a/txr.1 b/txr.1
index 275391e4..7f7ac353 100644
--- a/txr.1
+++ b/txr.1
@@ -29342,11 +29342,12 @@ which the variable
 .meta param
 is bound to the structure object.
 
-The
+Multiple
 .code :init
-specifier may not appear more than once in a given
+specifiers may appear in the same
 .code defstruct
-form.
+form. They are executed in their order of appearance,
+left to right.
 
 When an object with one or more levels of inheritance
 is instantiated, the
@@ -29391,6 +29392,7 @@ of an
 .code :init
 specifier are not surrounded by an implicit
 .codn block .
+
 .meIP (:postinit <> ( param ) << body-form *)
 The
 .code :postinit
@@ -29419,8 +29421,13 @@ actions,
 .code :postinit
 actions registered at different levels of the type's
 inheritance hierarchy are invoked in the base-to-derived
-order, and in right-to-left order among multiple bases
-at the same level.
+order, in right-to-left order among multiple bases
+at the same level. Multiple
+.code :postinit
+form in the same
+.code defstruct
+are invoked in left-to-right order.
+
 .meIP (:fini <> ( param ) << body-form *)
 The
 .code :fini
@@ -29454,9 +29461,11 @@ of a
 specifier are not surrounded by an implicit
 .codn block .
 
-At most one
+Multiple
 .code :fini
-may be specified.
+clauses may be specified in the same
+.codn defstruct ,
+in which case they are invoked in reverse, right-to-left order.
 
 Note that an object's finalizers can be called explicitly with
 .codn call-finalizers .
@@ -29464,6 +29473,7 @@ Note: the
 .code with-objects
 macro arranges for finalizers to be called on objects when the execution
 of a scope terminates by any means.
+
 .meIP (:postfini <> ( param ) << body-form *)
 Like
 .codn :fini ,
@@ -29493,17 +29503,25 @@ this omits the
 parameter, which means that
 .code :postfini
 finalizers of derived structures execute after the execution of inherited
-finalizers. When both
+finalizers.  It also means that multiple
+.code :postfini
+finalizers appearing in the same
+.code defstruct
+execute in left-to-right order unlike the reverse right-to-left order of
+.code :fini
+finalizers.
+
+When both
 .code :fini
 and
 .code :postfini
-are specified in the same
+clauses are specified in the same
 .code defstruct
-form, the
+form, all the
 .code :postfini
-finalizer executes after the
+finalizers execute after all the
 .code :fini
-finalizer regardless of the order in which they appear.
+finalizers regardless of the order in which they appear.
 .RE
 .IP
 The slot names given in a