Re: Structures as literals
"David McClain (as dbm at refined-audiometrics dot com)" <[email protected]>
| Newsgroups | gmane.lisp.lispworks.general |
|---|---|
| Message-ID | <[email protected]> |
Sorry, I meant to reply-to-all, and did not…
There is mention below, in restore-type-object of a function/macro named resolving-object. Its purpose is to ensure that references to shared objects become resolved to the same object on reconstruction. Details available if requested.
This code evolved from a system originally produced by Sean Ross, dating back to 2007. I simply extended his code to cover more object types, and provide a degree of store/restore flexibility. For example, for any user defined class instances you can perform some mapping from non-serializable data slots to serializable and back again, using methods defined on the class named BEFORE-STORE and AFTER-RESTORE.
;; DM/RAL 07/09
;; store slots names then slot values to help the restorer when
;; the class is not recognized...
(defun store-type-object (obj stream)
;; (declare (xoptimize speed))
(let ((all-slots (remove-if
(complement (lambda (slot)
(let ((slot-name (slot-definition-name slot)))
(and (slot-boundp obj slot-name)
(or *store-class-slots*
(not (eql (slot-definition-allocation slot)
:class)))))))
(serializable-slots obj)) ))
(store-object (class-name (class-of obj)) stream)
(store-count (length all-slots) stream)
(dolist (slot all-slots)
(let ((slot-name (slot-definition-name slot)))
(store-object slot-name stream)))
(dolist (slot all-slots)
(let ((slot-name (slot-definition-name slot)))
(store-object (slot-value obj slot-name) stream) )) ))
;; DM/RAL 07/09
;; if we try to restore an object of an unknown class
;; then just dummy up a new class defintion containing the
;; indicated slots.
;; -----------------------------------------------------------
(defun restore-type-object (stream obj-type metaclass)
;; (declare (xoptimize speed))
(let* ((class-name (restore-object stream))
(count (read-count stream))
(slot-names (loop repeat count
collect (restore-object stream)))
(class (find-or-create-class class-name obj-type slot-names metaclass))
(new-instance (allocate-instance class)))
(resolving-object (obj new-instance)
(loop for slot-name in slot-names
do
;; slot-names are always symbols so we don't
;; have to worry about circularities
(let ((val (restore-object stream)))
(when #+:LISPWORKS (clos:slot-exists-p new-instance slot-name)
#-:LISPWORKS (slot-exists-p new-instance slot-name)
(setting (slot-value obj slot-name) val))) ))
new-instance))
(defun find-or-create-class (class-name obj-type slot-names metaclass)
(or (find-class class-name nil)
(ensure-class class-name
:direct-slots (mapcar (lambda (slot-name)
`(:name ,slot-name
:allocation :instance
:initargs nil
:readers nil
:type t
:writers nil))
slot-names)
:direct-superclasses (list obj-type)
;; :metaclass 'standard-class
:metaclass metaclass
) ))
Example: An ACTOR is a simple 1-slot structure containing a pointer to a functional closure. As such, these are not serializable across a network to a foreign computer, nor storable in disk files.
So on encountering a serialization request of an ACTOR structure, the BEFORE-STORE produces an ACTOR-PROXY object containing a UUID as a stand-in for the ACTOR on the sending system. On reception at the foreign host, the AFTER-RESTORE of an ACTOR-PROXY object produces a local ACTOR that refers back to the sending host system.
So ACTOR -> BEFORE-STORE -> ACTOR-PROXY
and ACTOR-PROXY -> AFTER-RESTORE -> ACTOR
BEFORE-STORE and AFTER-RESTORE are called by the serializer, and may be called from some deeply nested level of an outer object being serialized. This also means I don’t need a code walker to pull this off.
> On Mar 2, 2026, at 12:03, Martin Simmons <[email protected]> wrote:
>
> It would be useful to know what store-type-object and restore-type-object do,
> so we might be able make LW support the portable code.
>
> --
> Martin Simmons
> LispWorks Ltd
> http://www.lispworks.com/
>
>
>
>>>>>> On Mon, 2 Mar 2026 11:56:20 -0700, David McClain (as dbm at refined-audiometrics dot com) said:
>>
>> Here are the SBCL equivalents:
>>
>>
>> ;; Custom structure storing
>>
>> (defstore-sdle-store (obj structure-object stream)
>> (output-type-code +structure-object-code+ stream)
>> (store-type-object obj stream))
>>
>> (defrestore-sdle-store (structure-object stream)
>> (restore-type-object stream 'structure-object 'structure-class))
>>
>>
>>
>>
>>> On Mar 2, 2026, at 11:50, David McClain (as dbm at refined-audiometrics dot com) <[email protected]> wrote:
>>>
>>> I should also state that SBCL does not need these non-portable features, and yet manages to produce serializations that interchange just fine with LW.
>>>
>>>
>>>
>>>> On Mar 2, 2026, at 11:48, David McClain <[email protected]> wrote:
>>>>
>>>> Instead of MAKE-LOAD-FORM, I use a binary interchange format for my serialization across the network and to file storage. So long as another Lisp reads them back, they are portable.
>>>>
>>>> I can confirm that structure instances are binary externalizable, as long as the slots don’t contain functional closures, or point to some object that does.
>>>>
>>>> But you have to work with nonportable LW-specific features.
>>>>
>>>> ;; ——————————————
>>>> ;; DM/RAL 07/09 -- better accommodation of unkown structure classes on restore
>>>>
>>>> (defstore-sdle-store (obj structure-object stream)
>>>> (output-type-code +structure-object-code+ stream)
>>>> (let* ((obj-class (class-of obj))
>>>> (class-name (class-name obj-class))
>>>> (slot-names (structure:structure-class-slot-names obj-class)))
>>>> (store-object class-name stream)
>>>> (store-count (length slot-names) stream)
>>>> (dolist (slot-name slot-names)
>>>> (store-object slot-name stream))
>>>> (dolist (slot-name slot-names)
>>>> (store-object (slot-value obj slot-name) stream))))
>>>>
>>>> (defrestore-sdle-store (structure-object stream)
>>>> (let* ((class-name (restore-object stream))
>>>> (count (read-count stream))
>>>> (slot-names (loop repeat count
>>>> collect (restore-object stream)))
>>>> (class (find-or-create-class class-name 'standard-object slot-names 'standard-class)))
>>>> (cond ((eq (type-of class) 'structure-class)
>>>> ;; we apparently found the class and it was a struture
>>>> (let* ((new-instance (structure::allocate-instance class))
>>>> (allowed-slots (structure:structure-class-slot-names class)))
>>>> (resolving-object (obj new-instance)
>>>> (dolist (slot-name slot-names)
>>>> (let ((val (restore-object stream))
>>>> the-slot)
>>>> (when (setf the-slot (car (member slot-name allowed-slots :test #'string-equal)))
>>>> ;; slot-names are always symbols so we don't
>>>> ;; have to worry about circularities
>>>> (setting (slot-value obj the-slot) val))) ))
>>>> new-instance))
>>>>
>>>> (t ;; else -- no such struture known to mankind
>>>> ;; dummy up as a new standard-object instead of a struct
>>>> ;; (to avoid non-portability issues regarding internals of struct implementation)
>>>> (let ((new-instance (allocate-instance class)))
>>>> (resolving-object (obj new-instance)
>>>> (dolist (slot-name slot-names)
>>>> (let ((val (restore-object stream)))
>>>> (when (clos:slot-exists-p new-instance slot-name)
>>>> (setting (slot-value obj slot-name) val)) )))
>>>> new-instance))
>>>> )))
>>>>
>>>>
>>>>
>>>>> On Mar 2, 2026, at 10:28, Tim Bradshaw (as tfb at tfeb dot org) <[email protected]> wrote:
>>>>>
>>>>> Can anyone confirm that it's the case that structure instances are by default externalizable (assuming their slots' values are of course) in LW?
>>>>>
>>>>> Reason for asking is that I was checking that my make-load-form method was right by excising it and compiling some code (in a cold LW) which would write structure instances as literals ... which I expected to fail but which worked (and loading the compiled file, again in a cold LW, does what it should).
>>>>>
>>>>> --tim
>>>>>
>>>>> _______________________________________________
>>>>> Lisp Hug - the mailing list for LispWorks users
>>>>> [email protected]
>>>>> http://www.lispworks.com/support/lisp-hug.html
>>>>
>>>
>>
>>