diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2016-01-03 11:16:48 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2016-01-03 11:16:48 -0800 |
| commit | 11ac283d7eda2bac2f19d62d014043f66c8de84c (patch) | |
| tree | 2b0289573ae6c8337c94734aa58b46b282e916e9 /share | |
| parent | 629c448f272fe23cefe6eb2b2b90dc8dfb3bbf86 (diff) | |
| download | txr-11ac283d7eda2bac2f19d62d014043f66c8de84c.tar.gz txr-11ac283d7eda2bac2f19d62d014043f66c8de84c.tar.bz2 txr-11ac283d7eda2bac2f19d62d014043f66c8de84c.zip | |
defstruct: order function slots before other static slots.
This allows the initializer expressions for static slots
to instantiate objects, and those instances can rely on
methods being set up.
* share/txr/stdlib/struct.tl (sys:prune-nil-inits): Recognize
:function keyword as denoting a static slot.
(defstruct): Represent methods and functions as (:function
...) items rather than (:static ...) so they can be
distinguished. Function slots appear before other static
slots in the static slot list, and their initializing
code is placed into the the static-initfun lambda of the
sys:make-struct-type call in this order.
* txr.1: Documented.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/struct.tl | 32 |
1 files changed, 17 insertions, 15 deletions
diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl index 7e0d2af1..ee4bfd18 100644 --- a/share/txr/stdlib/struct.tl +++ b/share/txr/stdlib/struct.tl @@ -29,7 +29,7 @@ (defun sys:prune-nil-inits (slot-init-forms super-type) (remove-if (tb ((kind name init-form)) - (and (member kind '(:static :instance)) + (and (member kind '(:static :instance :function)) (null init-form) (or (not super-type) (not (slotp super-type name))))) @@ -56,13 +56,13 @@ "~s: method ~s needs \ \ at least one parameter" 'defstruct name)) - ^(:static ,name - (lambda ,args - (block ,name ,*body)))) - (:function ^(:static ,name - (lambda ,args - (block ,name - ,*body)))) + ^(:function ,name + (lambda ,args + (block ,name ,*body)))) + (:function ^(,word ,name + (lambda ,args + (block ,name + ,*body)))) ((:static :instance) (when body (sys:bad-slot-syntax slot)) @@ -112,11 +112,15 @@ ^(:instance ,name nil)) (name ^(:instance ,name nil))))) - (stat-si-forms [keep-if (op eq :static) slot-init-forms car]) + (super-type (find-struct-type super)) + (stat-si-forms [keep-if (op member @1 '(:static :function)) + slot-init-forms car]) + (pruned-si-forms (sys:prune-nil-inits stat-si-forms super-type)) + (func-si-forms [keep-if (op eq :function) pruned-si-forms car]) + (val-si-forms [keep-if (op eq :static) pruned-si-forms car]) (inst-si-forms [keep-if (op eq :instance) slot-init-forms car]) (stat-slots [mapcar second stat-si-forms]) - (inst-slots [mapcar second inst-si-forms]) - (super-type (find-struct-type super))) + (inst-slots [mapcar second inst-si-forms])) (whenlet ((bad [find-if [notf bindable] (append stat-slots inst-slots)])) (throwf 'eval-error @@ -124,17 +128,15 @@ "~s: slot name ~s isn't a bindable symbol" "~s: invalid slot specifier syntax: ~s") 'defstruct bad)) - (set stat-si-forms (sys:prune-nil-inits stat-si-forms super-type)) - (set inst-si-forms (sys:prune-nil-inits inst-si-forms super-type)) (let ((arg-sym (gensym)) (type-sym (gensym))) ^(sys:make-struct-type ',name ',super ',stat-slots ',inst-slots - ,(if stat-si-forms + ,(if (or func-si-forms val-si-forms) ^(lambda (,arg-sym) ,*(mapcar (aret ^(when (static-slot-p ,arg-sym ',@2) (static-slot-set ,arg-sym ',@2 ,@3))) - stat-si-forms))) + (append func-si-forms val-si-forms)))) ,(if (or inst-si-forms instance-init-form instance-fini-form) ^(lambda (,arg-sym) ,*(if (cdr instance-fini-form) |