Re: MAKE-INSTANCE and STRUCTURE-CLASS
"David McClain (as dbm at refined-audiometrics dot com)" <[email protected]> Sun, 5 Jul 2026 08:42:00 -0700
| Newsgroups | gmane.lisp.lispworks.general,gmane.lisp.cl-pro |
|---|---|
| Message-ID | <[email protected]> |
--Apple-Mail=_A9CA9DEE-1BEC-47AC-8D89-A85A9BBD171B
Content-Transfer-Encoding: quoted-printable
Content-Type: text/plain;
charset=utf-8
=E2=80=A6taken from my Serialization system:
;; --------------------------------------------
;; General Structs
#+:LISPWORKS
(defmethod make-serializable ((obj structure-object))
(values :STRUCT
(let* ((obj-class (class-of obj))
(class-name (class-name obj-class))
(slot-names (structure:structure-class-slot-names =
obj-class)))
(list class-name
slot-names
(mapcar (um:curry #'slot-value obj) slot-names))
)))
#+:LISPWORKS
(defmethod deserialize-type ((type (eql :STRUCT)) data)
(destructuring-bind (class-name slot-names slot-values) data
(let ((class (sdle-store::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)))
(loop for slot-name in slot-names
for val in slot-values
do
(let ((slot-sym (find slot-name allowed-slots
:test #'string-equal)))
(when slot-sym
(setf (slot-value new-instance slot-sym) 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)))
(loop for slot-name in slot-names
for val in slot-values
do
(setf (slot-value new-instance slot-name) val))
new-instance))
))))
#+:SBCL
(defmethod make-serializable ((obj structure-object))
(values :STRUCT
(gather-instance-data obj)))
#+:SBCL
(defmethod deserialize-type ((type (eql :STRUCT)) data)
(restore-type-object 'structure-object 'structure-class data))
> On Jul 5, 2026, at 05:23, Marco Antoniotti (as marco dot antoniotti at =
unimib dot it) <[email protected]> wrote:
>=20
> Hi
>=20
> I am sure this has come up a godzillion times before, but how do you =
write methods for MAKE-INSTANCE with structure classes?
>=20
> Just writing a method on the class name then hits a MISSING-METHOD on =
MAKE-INSTANCE and STRUCTURE-CLASS (at least on LW).
>=20
> Thanks
>=20
> MA
>=20
--Apple-Mail=_A9CA9DEE-1BEC-47AC-8D89-A85A9BBD171B
Content-Transfer-Encoding: quoted-printable
Content-Type: text/html;
charset=utf-8
<html aria-label=3D"message body"><head><meta http-equiv=3D"content-type" =
content=3D"text/html; charset=3Dutf-8"></head><body =
style=3D"overflow-wrap: break-word; -webkit-nbsp-mode: space; =
line-break: after-white-space;">=E2=80=A6taken from my Serialization =
system:<div><br></div><div><div>;; =
--------------------------------------------</div><div>;; General =
Structs</div><div><br></div><div><font =
face=3D"Monaco">#+:LISPWORKS</font></div><div><font =
face=3D"Monaco">(defmethod make-serializable ((obj =
structure-object))</font></div><div><font face=3D"Monaco"> (values =
:STRUCT</font></div><div><font face=3D"Monaco"> =
(let* ((obj-class (class-of =
obj))</font></div><div><font face=3D"Monaco"> =
(class-name (class-name =
obj-class))</font></div><div><font face=3D"Monaco"> =
(slot-names =
(structure:structure-class-slot-names =
obj-class)))</font></div><div><font face=3D"Monaco"> =
(list class-name</font></div><div><font =
face=3D"Monaco"> =
slot-names</font></div><div><font face=3D"Monaco"> =
(mapcar (um:curry =
#'slot-value obj) slot-names))</font></div><div><font =
face=3D"Monaco"> =
)))</font></div><div><font face=3D"Monaco"><br></font></div><div><font =
face=3D"Monaco">#+:LISPWORKS</font></div><div><font =
face=3D"Monaco">(defmethod deserialize-type ((type (eql :STRUCT)) =
data)</font></div><div><font face=3D"Monaco"> (destructuring-bind =
(class-name slot-names slot-values) data</font></div><div><font =
face=3D"Monaco"> (let ((class =
(sdle-store::find-or-create-class =
class-name</font></div><div><font face=3D"Monaco"> =
=
=
'standard-object</font></div><div><font =
face=3D"Monaco"> =
=
=
slot-names</font></div><div><font face=3D"Monaco"> =
=
=
'standard-class)))</font></div><div><font =
face=3D"Monaco"> (cond ((eq (type-of class) =
'structure-class)</font></div><div><font face=3D"Monaco"> =
;; we apparently found the class and =
it was a struture</font></div><div><font face=3D"Monaco"> =
(let* ((new-instance =
(structure::allocate-instance class))</font></div><div><font =
face=3D"Monaco"> =
(allowed-slots (structure:structure-class-slot-names =
class)))</font></div><div><font face=3D"Monaco"> =
(loop for slot-name in =
slot-names</font></div><div><font face=3D"Monaco"> =
for val =
in slot-values</font></div><div><font face=3D"Monaco"> =
=
do</font></div><div><font face=3D"Monaco"> =
(let =
((slot-sym (find slot-name allowed-slots</font></div><div><font =
face=3D"Monaco"> =
=
:test #'string-equal)))</font></div><div><font =
face=3D"Monaco"> =
(when slot-sym</font></div><div><font =
face=3D"Monaco"> =
(setf (slot-value new-instance =
slot-sym) val)</font></div><div><font face=3D"Monaco"> =
=
)))</font></div><div><font face=3D"Monaco"> =
=
new-instance))</font></div><div><font =
face=3D"Monaco"><br></font></div><div><font face=3D"Monaco"> =
(t ;; else -- no such struture known =
to mankind</font></div><div><font face=3D"Monaco"> =
;; dummy up as a new standard-object =
instead of a struct</font></div><div><font face=3D"Monaco"> =
;; (to avoid non-portability =
issues regarding internals of struct =
implementation)</font></div><div><font face=3D"Monaco"> =
(let ((new-instance =
(allocate-instance class)))</font></div><div><font face=3D"Monaco"> =
(loop for =
slot-name in slot-names</font></div><div><font face=3D"Monaco"> =
=
for val in slot-values</font></div><div><font =
face=3D"Monaco"> =
do</font></div><div><font =
face=3D"Monaco"> =
(setf (slot-value new-instance =
slot-name) val))</font></div><div><font face=3D"Monaco"> =
=
new-instance))</font></div><div><font face=3D"Monaco"> =
))))</font></div><div><font =
face=3D"Monaco"><br></font></div><div><div><font =
face=3D"Monaco">#+:SBCL</font></div><div><font face=3D"Monaco">(defmethod =
make-serializable ((obj structure-object))</font></div><div><font =
face=3D"Monaco"> (values :STRUCT</font></div><div><font =
face=3D"Monaco"> (gather-instance-data =
obj)))</font></div><div><font =
face=3D"Monaco"><br></font></div><div><div><font =
face=3D"Monaco">#+:SBCL</font></div><div><font face=3D"Monaco">(defmethod =
deserialize-type ((type (eql :STRUCT)) data)</font></div><div><font =
face=3D"Monaco"> (restore-type-object 'structure-object =
'structure-class data))</font></div><div><font =
face=3D"Monaco"><br></font></div></div><div><br></div><div><br></div></div=
><div><br></div><div><br><blockquote type=3D"cite"><div>On Jul 5, 2026, =
at 05:23, Marco Antoniotti (as marco dot antoniotti at unimib dot it) =
<[email protected]> wrote:</div><br =
class=3D"Apple-interchange-newline"><div><div =
dir=3D"ltr"><div>Hi</div><div><br></div><div>I am sure this has come up =
a godzillion times before, but how do you write methods for =
MAKE-INSTANCE with structure classes?</div><div><br></div><div>Just =
writing a method on the class name then hits a MISSING-METHOD on =
MAKE-INSTANCE and STRUCTURE-CLASS (at least on =
LW).</div><div><br></div><div>Thanks</div><div><br></div><div>MA</div><br>=
</div>
</div></blockquote></div><br></div></body></html>=
--Apple-Mail=_A9CA9DEE-1BEC-47AC-8D89-A85A9BBD171B--
_______________________________________________
Lisp Hug - the mailing list for LispWorks users
[email protected]
http://www.lispworks.com/support/lisp-hug.html