Re: Structures as literals
"David McClain (as dbm at refined-audiometrics dot com)" <[email protected]>
| Newsgroups | gmane.lisp.lispworks.general |
|---|---|
| Message-ID | <[email protected]> |
More….
(defgeneric serializable-slots (object)
(declare (optimize speed))
(:documentation
"Return a list of slot-definitions to serialize. The default
is to call serializable-slots-using-class with the object
and the objects class")
(:method ((object standard-object))
(serializable-slots-using-class object (class-of object)))
#+(or sbcl cmu openmcl allegro)
(:method ((object structure-object))
(serializable-slots-using-class object (class-of object)))
(:method ((object condition))
(serializable-slots-using-class object (class-of object))))
; unfortunately the metaclass of conditions in sbcl and cmu
; are not standard-class
(defgeneric serializable-slots-using-class (object class)
(declare (optimize speed))
(:documentation "Return a list of slot-definitions to serialize.
The default calls compute slots with class")
(:method ((object t) (class standard-class))
(class-slots class))
#+(or sbcl cmu openmcl)
(:method ((object t) (class structure-class))
(class-slots class))
#+allegro
(:method ((object t) (class clos::structure-class))
(class-slots class))
#+sbcl
(:method ((object t) (class sb-pcl::condition-class))
(class-slots class))
#+cmu
(:method ((object t) (class pcl::condition-class))
(class-slots class)))
> On Mar 2, 2026, at 13:42, David McClain (as dbm at refined-audiometrics dot com) <[email protected]> wrote:
>
> 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
>>>>>
>>>>
>>>
>>>
>