[Openmcl-cvs-notifications] r10408 - /trunk/source/lib/defstruct-macros.lisp

[gb at clozure.com]

Author: gb
Date: Sat Aug  9 09:52:51 2008
New Revision: 10408

Log:
Try to handle the (forthcoming) new scheme and the old in STRUCT-NAME,
STRUCT-DEF.

New images soon.

Modified:
    trunk/source/lib/defstruct-macros.lisp

Modified: trunk/source/lib/defstruct-macros.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/defstruct-macros.lisp (original)
+++ trunk/source/lib/defstruct-macros.lisp Sat Aug  9 09:52:51 2008
@@ -80,8 +80,14 @@
 (defmacro sd-set-print-function (sd value) `(svset ,sd 5 ,value))
 (defmacro sd-refnames (sd) `(svref ,sd 6))
 =

-(defmacro struct-name (struct) `(car (uvref ,struct 0)))
-(defmacro struct-def (struct) `(gethash (car (uvref ,struct 0)) %defstruct=
s%))
+(defmacro struct-name (struct)
+  (let* ((temp (gensym)))
+    `(let* ((,temp (car (uvref ,struct 0))))
+      (if (istruct-typep ,temp 'class-cell)
+        (class-cell-name ,temp)
+        ,temp))))
+
+(defmacro struct-def (struct) `(gethash (struct-name ,struct) %defstructs%=
))
 =

 ;Can use this to let the printer print with print-function, reader read wi=
th
 ;constructor and slot-names, inspector inspect with slot-names.