New feature: struct preludes.

A struct prelude definition associates one or more
future defstruct (by struct name) with clauses which
are implicitly inserted into the defstruct.

It is purely a macro-time construct, customizing the
expansion behavior of defstruct.

* stdlib/struct.tl (*struct-prelude, *struct-prelude-alists*):
New special variables holding hash tables.
(defstruct): Before processing slot-specs, augment it with
the contents of the prelude definitions associated with
this struct name.
(define-struct-prelude): New macro.

* autoload.c (struct_set_entries): define-struct-prelude
is interned and triggers autoload of struct module.

* tests/012/oop-prelude.tl: New file.

* tests/012/oop-prelude.expected: Likewise.

* txr.1: Documented.

* stdlib/doc-syms.tl: Updated.

1 files changed, 18 insertions, 0 deletions

diff --git a/stdlib/struct.tl b/stdlib/struct.tl
index d05b75fc..3f9330a2 100644
--- a/stdlib/struct.tl
+++ b/stdlib/struct.tl
@@ -27,6 +27,9 @@
 
 (defvar *struct-clause-expander* (hash))
 
+(defvar *struct-prelude* (hash))
+(defvar *struct-prelude-alists* (hash))
+
 (defun sys:bad-slot-syntax (form arg)
   (compile-error form "bad slot syntax ~s" arg))
 
@@ -50,6 +53,7 @@
       (compile-warning form "~s is a built-in type" name))
     (unless (proper-listp slot-specs)
       (compile-error form "bad syntax: dotted form"))
+    (set slot-specs (append [*struct-prelude* name] slot-specs))
     (let ((instance-init-forms nil)
           (instance-postinit-forms nil)
           (instance-fini-forms nil)
@@ -429,6 +433,20 @@
     [xfun clause form]
     (cons clause nil)))
 
+(defmacro define-struct-prelude (:form form prelude-name struct-names . clauses)
+  (unless (bindable prelude-name)
+    (compile-error form "~s isn't a valid prelude name" prelude-name))
+  (when (bindable struct-names)
+    (set struct-names (list struct-names)))
+  (each ((sname struct-names))
+    (unless (bindable sname)
+      (compile-error form "~s isn't a valid struct name" sname))
+    (let* ((cell (inhash *struct-prelude-alists* sname nil))
+           (alist (aconsql-new prelude-name clauses (cdr cell))))
+      (rplacd cell alist)
+      (set [*struct-prelude* sname] [mappend cdr (reverse alist)]))
+    nil))
+
 (compile-only
   (load-for (struct sys:param-parser-base "param")))