diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2015-10-03 15:34:59 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2015-10-03 15:34:59 -0700 |
| commit | 38a2d429dfdc271ded13b3e446d75285fc875511 (patch) | |
| tree | acbabcaa7959ec9c535d7e5af6dd437bd96a5232 | |
| parent | 139fae50e175a067ccd34c276f662e8abc14bec3 (diff) | |
| download | txr-38a2d429dfdc271ded13b3e446d75285fc875511.tar.gz txr-38a2d429dfdc271ded13b3e446d75285fc875511.tar.bz2 txr-38a2d429dfdc271ded13b3e446d75285fc875511.zip | |
Optimization: elide some nil slot initializations.
If a defstruct slot specifier calls for a slot to
be initialized to nil, that doesn't have to be done
explicitly if the slot isn't inherited.
* share/txr/stdlib/struct.tl (sys:prune-nil-inits): New
function.
(defstruct): Use prune-nil-inits to try to reduce the
lists of static and instance slot specifiers.
| -rw-r--r-- | share/txr/stdlib/struct.tl | 15 |
1 files changed, 13 insertions, 2 deletions
diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl index 3958692c..ce3f156e 100644 --- a/share/txr/stdlib/struct.tl +++ b/share/txr/stdlib/struct.tl @@ -25,7 +25,15 @@ (macro-time (defun sys:bad-slot-syntax (arg) - (throwf 'eval-error "~s: bad slot syntax: ~s" 'defstruct arg))) + (throwf 'eval-error "~s: bad slot syntax: ~s" 'defstruct arg)) + + (defun sys:prune-nil-inits (slot-init-forms super-type) + (remove-if (tb ((kind name init-form)) + (and (member kind '(:static :instance)) + (null init-form) + (or (not super-type) + (not (slot-p super-type name))))) + slot-init-forms))) (defmacro defstruct (name-spec super . slot-specs) (tree-bind (name args) (tree-case name-spec @@ -95,11 +103,14 @@ (stat-si-forms [keep-if (op eq :static) slot-init-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])) + (inst-slots [mapcar second inst-si-forms]) + (super-type (find-struct-type super))) (whenlet ((bad [find-if [notf bindable] (append stat-slots inst-slots)])) (throwf 'eval-error "~s: slot name ~s isn't a bindable symbol" '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 |