Re: MAKE-INSTANCE and STRUCTURE-CLASS
"David McClain (as dbm at refined-audiometrics dot com)" <[email protected]> Sun, 5 Jul 2026 08:43:49 -0700
| Newsgroups | gmane.lisp.lispworks.general,gmane.lisp.cl-pro |
|---|---|
| Message-ID | <[email protected]> |
--Apple-Mail=_A048CA56-1A1B-47B8-8451-55AFFA7BCA59
Content-Transfer-Encoding: quoted-printable
Content-Type: text/plain;
charset=utf-8
(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
) ))
> On Jul 5, 2026, at 08:42, David McClain <[email protected]> =
wrote:
>=20
> =E2=80=A6taken from my Serialization system:
>=20
> ;; --------------------------------------------
> ;; General Structs
>=20
> #+: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))
> )))
>=20
> #+: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))
>=20
> (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))
> ))))
>=20
> #+:SBCL
> (defmethod make-serializable ((obj structure-object))
> (values :STRUCT
> (gather-instance-data obj)))
>=20
> #+:SBCL
> (defmethod deserialize-type ((type (eql :STRUCT)) data)
> (restore-type-object 'structure-object 'structure-class data))
>=20
>=20
>=20
>=20
>=20
>> 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
>=20
--Apple-Mail=_A048CA56-1A1B-47B8-8451-55AFFA7BCA59
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;"><div><font face=3D"Monaco">(defun =
find-or-create-class (class-name obj-type slot-names =
metaclass)</font></div><div><font face=3D"Monaco"> (or (find-class =
class-name nil)</font></div><div><font face=3D"Monaco"> =
(ensure-class class-name</font></div><div><font =
face=3D"Monaco"> =
:direct-slots (mapcar (lambda =
(slot-name)</font></div><div><font face=3D"Monaco"> =
=
`(:name =
,slot-name</font></div><div><font =
face=3D"Monaco"> =
=
:allocation =
:instance</font></div><div><font face=3D"Monaco"> =
=
=
:initargs nil</font></div><div><font face=3D"Monaco"> =
=
=
:readers nil</font></div><div><font =
face=3D"Monaco"> =
=
:type =
t</font></div><div><font face=3D"Monaco"> =
=
:writers =
nil))</font></div><div><font face=3D"Monaco"> =
=
=
slot-names)</font></div><div><font face=3D"Monaco"> =
:direct-superclasses =
(list obj-type)</font></div><div><font face=3D"Monaco"> =
;; :metaclass =
'standard-class</font></div><div><font face=3D"Monaco"> =
:metaclass =
metaclass</font></div><div><font face=3D"Monaco"> =
) =
))</font></div><div><br></div><div><br><blockquote type=3D"cite"><div>On =
Jul 5, 2026, at 08:42, David McClain =
<[email protected]> wrote:</div><br =
class=3D"Apple-interchange-newline"><div><meta http-equiv=3D"content-type"=
content=3D"text/html; charset=3Dutf-8"><div 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></div></div></blockquote></div><br></bo=
dy></html>=
--Apple-Mail=_A048CA56-1A1B-47B8-8451-55AFFA7BCA59--
_______________________________________________
Lisp Hug - the mailing list for LispWorks users
[email protected]
http://www.lispworks.com/support/lisp-hug.html