diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2022-10-17 08:12:10 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2022-10-17 08:12:10 -0700 |
| commit | 8357dd0ce75b5cace504acfcef2c31ee83a35e9c (patch) | |
| tree | 4487382d7fd86c7132bccf80ba26b3fab8af8db3 /stdlib | |
| parent | 74ea4ee2f89457adbe5cf6facadd8e8b389517ab (diff) | |
| download | txr-8357dd0ce75b5cace504acfcef2c31ee83a35e9c.tar.gz txr-8357dd0ce75b5cace504acfcef2c31ee83a35e9c.tar.bz2 txr-8357dd0ce75b5cace504acfcef2c31ee83a35e9c.zip | |
defstruct: new :inherit clause.
The :inherit clause allows custom struct clauses to
inject inherited bases.
* stdlib/struct.tl (defstruct): Recognize :inherit clause,
adding symbol arguments to extra list of supers that
get appended to the list coming from defstruct's
seconda rgument.
(define-struct-clause): Disallow :inherit clause name.
* tests/012/oop-dsc.tl: New tests.
* txr.1: Documented.
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/struct.tl | 19 |
1 files changed, 14 insertions, 5 deletions
diff --git a/stdlib/struct.tl b/stdlib/struct.tl index 855ac6e1..d05b75fc 100644 --- a/stdlib/struct.tl +++ b/stdlib/struct.tl @@ -53,7 +53,8 @@ (let ((instance-init-forms nil) (instance-postinit-forms nil) (instance-fini-forms nil) - (instance-postfini-forms nil)) + (instance-postfini-forms nil) + (additional-supers nil)) (labels ((expand-slot (form slot) (tree-case slot ((op . args) @@ -61,6 +62,12 @@ (append-each ((exslot [expander slot form])) [expand-slot form exslot]) :)) + ((word . args) + (cond + ((eq word :inherit) + (set additional-supers (revappend args additional-supers)) + nil) + (t :))) ((word slname args . body) (caseq word (:method @@ -122,9 +129,10 @@ ^((:instance ,name nil)))))) (let* ((slot-init-forms (append-each ((slot slot-specs)) (expand-slot form slot))) - (supers (if (and super-spec (atom super-spec)) - (list super-spec) - super-spec)) + (supers (append (if (and super-spec (atom super-spec)) + (list super-spec) + super-spec) + additional-supers)) (stat-si-forms [keep-if (op member @1 '(:static :function)) slot-init-forms car]) (pruned-si-forms (sys:prune-missing-inits stat-si-forms)) @@ -404,7 +412,8 @@ ,body))) (defmacro define-struct-clause (:form form keyword (. params) . body) - (if (meq keyword :static :instance :function :method :init :postinit :fini :postfini) + (if (meq keyword :static :instance :function :method + :init :postinit :fini :postfini :inherit) (compile-error form "~s is a reserved defstruct clause keyword" keyword)) (unless (keywordp keyword) (compile-error form "~s: clauses must be named by keyword symbols" keyword)) |