diff options
| -rw-r--r-- | stdlib/struct.tl | 19 | ||||
| -rw-r--r-- | tests/012/oop-dsc.tl | 15 | ||||
| -rw-r--r-- | txr.1 | 24 |
3 files changed, 53 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)) diff --git a/tests/012/oop-dsc.tl b/tests/012/oop-dsc.tl index c0b6068b..7885f386 100644 --- a/tests/012/oop-dsc.tl +++ b/tests/012/oop-dsc.tl @@ -63,3 +63,18 @@ [s3.b-hash 3].a "three") (call-finalizers s3) (test [s3.a-hash "one"] nil)) + +(define-struct-clause :s3 () + '((:inherit s3) + (:inherit passwd group))) + +(defstruct s4 (time) + (:s3)) + +(let ((s4 (new s4 a "x" b 999))) + (mtest + [s4.a-hash "two"].a "two" + [s4.a-hash "x"].a "x" + [s4.b-hash 999].a "x" + s4.uid nil + s4.gid nil)) @@ -29602,6 +29602,30 @@ form, all the finalizers execute after all the .code :fini finalizers regardless of the order in which they appear. + +.meIP (:inherit << super *) +The +.code :inherit +clause specifies zero or more types to be inherited. Each +.meta super +argument must be a symbol which is the name of an existing struct type. +These symbols are appended to the list of supertypes coming from the +.meta super +argument +.codn defstruct . +Note: the motivation behind +.code :inherit +is to make it possible for struct clauses defined by +.code define-struct-clause +to inject supertypes. Developers are encouraged to use the regular +.meta super +argument of +.code defstruct +to declare inheritance of supertypes, rather than writing visible +.code :inherit +clauses that can be moved into the +.meta super +argument. .RE .IP The slot names given in a |