diff options
| -rw-r--r-- | autoload.c | 1 | ||||
| -rw-r--r-- | stdlib/doc-syms.tl | 5 | ||||
| -rw-r--r-- | stdlib/struct.tl | 18 | ||||
| -rw-r--r-- | tests/012/oop-prelude.expected | 5 | ||||
| -rw-r--r-- | tests/012/oop-prelude.tl | 13 | ||||
| -rw-r--r-- | txr.1 | 112 |
6 files changed, 150 insertions, 4 deletions
@@ -220,6 +220,7 @@ static val struct_set_entries(val fun) lit("defstruct"), lit("qref"), lit("uref"), lit("new"), lit("lnew"), lit("new*"), lit("lnew*"), lit("meth"), lit("umeth"), lit("usl"), lit("defmeth"), lit("rslot"), + lit("define-struct-prelude"), lit("define-struct-clause"), lit("macroexpand-struct-clause"), nil }; val vname[] = { diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl index 08dcc8e2..947e327a 100644 --- a/stdlib/doc-syms.tl +++ b/stdlib/doc-syms.tl @@ -9,6 +9,7 @@ ("*args-eff*" "N-03DEE18A") ("*args-full*" "N-03DEE18A") ("*child-env*" "N-01BB2097") + ("*define-struct-prelude*" "N-0083D695") ("*doc-url*" "N-0003D10B") ("*filters*" "N-00E6A902") ("*gensym-counter*" "N-0387B1B1") @@ -728,7 +729,7 @@ ("file-get-string" "N-02238370") ("file-put" "N-0041C2E5") ("file-put-buf" "N-02AE3A31") - ("file-put-json" "D-002A") + ("file-put-json" "D-0029") ("file-put-jsons" "D-007E") ("file-put-lines" "N-0041C2E5") ("file-put-string" "N-0041C2E5") @@ -783,7 +784,7 @@ ("float" "N-03237030") ("floatp" "N-03E9D6E1") ("flock" "N-004E5B3E") - ("floor" "D-0029") + ("floor" "D-002A") ("floor-rem" "N-02DE978F") ("floor1" "N-01ED20D1") ("flow" "N-02B2153E") 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"))) diff --git a/tests/012/oop-prelude.expected b/tests/012/oop-prelude.expected new file mode 100644 index 00000000..daf379e0 --- /dev/null +++ b/tests/012/oop-prelude.expected @@ -0,0 +1,5 @@ +#S(fox) created +#S(bear) created +inside with-object +#S(bear) finalized +#S(fox) finalized diff --git a/tests/012/oop-prelude.tl b/tests/012/oop-prelude.tl new file mode 100644 index 00000000..bb0b3d44 --- /dev/null +++ b/tests/012/oop-prelude.tl @@ -0,0 +1,13 @@ +(load "../common") + +(define-struct-prelude init-fini-log (fox bear) + (:init (me) (put-line `@me created`)) + (:fini (me) (put-line `@me finalized`))) + +(defstruct fox ()) + +(defstruct bear ()) + +(with-objects ((f (new fox)) + (b (new bear))) + (put-line "inside with-object")) @@ -29240,6 +29240,22 @@ is in fact implemented externally to using .codn define-struct-clause . +.NP* Custom Preludes + +The +.code defstruct +macro has a provision for implicit inclusion of application-defined +clauses called preludes, which are previously defined via the +.code define-struct-prelude +macro. +During macro-expansion, +.code defstruct +checks whether the structure being defined is the target of one +or more preludes. If so, it includes the clauses from those preludes +as if they were written directly in the +.code defstruct +syntax. + .coNP Macro @ defstruct .synb .mets (defstruct >> { name | >> ( name << arg *)} < super @@ -29278,8 +29294,18 @@ used to call the function. Some remarks in the description of only apply to structure types defined using that macro. Slots are specified using zero or more -.IR "slot specifiers" . -Slot specifiers come in the following variety: +.meta slot-specifier +clauses. + +Application-defined clauses are possible via +.codn define-struct-clause . +The +.code defstruct +macro may bring in prelude clauses which are not specified in its syntax, +but that have been specified using +.codn define-struct-prelude . + +The following built-in clauses are supported: .RS .meIP < name The simplest slot specifier is just a name, which must be a bindable @@ -32417,6 +32443,88 @@ empty mixture of primary clauses accepted by .code defstruct and clause macros. +.coNP Macro @ *define-struct-prelude* +.synb +.mets (define-struct-prelude < name < struct-name-or-list << clause *) +.syne +.desc +The +.code define-struct-prelude +macro defines a +.IR prelude . +A prelude is a named entity which implicitly provides clauses to +.code defstruct +macro invocations. Preludes are processed during the macroexpansion of +.codn defstruct ; +prelude definitions have no effect on previously compiled +.code defstruct +forms loaded from a file. + +A prelude has a +.meta name +which must be a bindable symbol. The purpose of this name is that +if multiple +.code define-struct-prelude +forms are evaluated which specify the same +.metn name , +they replace each others' definition. Only the most recent prelude of +a given +.meta name +is retained; the previous definitions are overwritten. + +The +.meta struct-name-or-list +argument is either a symbol or a list of symbols, which are valid +for use as structure names. The prelude being defined shall be +applicable to each of the structures whose names are given by +this argument. + +The zero or more +.meta clause +arguments give the clauses which comprise the prelude. In the future, when a +.code defstruct +form is macroexpanded which targets any of the structures given by the +.meta struct-name-or-list +argument, the specified clauses will be inserted into that definition, as +if they appeared in the +.code defstruct +form literally. + +Multiple preludes may be defined with different names, which each target +the same structure. When the structure is defined, or redefined, it will +receive all those preludes, in the order in which they were defined. + +.TP* Example: + +.verb + ;; define init-fini-log prelude which targets fox and bear structs + + (define-struct-prelude init-fini-log (fox bear) + (:init (me) (put-line `@me created`)) + (:fini (me) (put-line `@me finalized`))) + + ;; The behavior is as if the following defstruct forms included + ;; the above :init and :fini clauses + + (defstruct fox ()) + + (defstruct bear ()) + + (with-object ((f (new fox)) + (b (new bear))) + (put-line "inside with-object")) +.brev + +Output: + +.verb + #S(fox) created + #S(bear) created + inside with-object + #S(bear) finalized + #S(fox) finalized +.brev + .SS* Special Structure Functions Special structure functions are user-defined methods or structure functions |