is using WITH-SLOTS with structs portable?

[Dave Bakhash]

hey,

I want to use WITH-SLOTS with structs. Is that portable? It was hard
to tell when reading the CLHS. Of course, it works in LW, but I want
to use it only if it's portable.

thanks,
dave

[Thomas F. Burdick]

ca...@alum.mit.edu (Dave Bakhash) writes:

Nope, it's not. WITH-SLOTS uses SLOT-VALUE, which is unspecified for
objects with metaclass STRUCTURE-CLASS.

--
/|_ .-----------------------.
,' .\ / | No to Imperialist war |
,--' _,' | Wage class war! |
/ / `-----------------------'
( -. |
| ) |
(`-. '--.)
`. )----'

[Tim Bradshaw]

No, it's not. You can generally get most of the way (`variables'
which are actually accessors) using something based on SYMBOL-MACROLET
though.

--tim

[Dave Bakhash]

hey,

thanks for the info, guys.

I think I'll use it anyway...I guess at this point I'm (hapily)
married to LW anyway.

dave

[Pascal Bourguignon]

Tim Bradshaw <t...@cley.com> writes:

Either that:

(DEFMACRO DEFINE-WITH-STRUCTURE (NAME-AND-OPTIONS SLOTS)
"
NAME-AND-OPTIONS: Either a structure name or a list (name . options).
Valid options are: (:conc-name prefix).
DO: Define a macro: (WITH-{NAME} object &body body)
expanding to a symbol-macrolet embedding body where
symbol macros are defined to access the slots.
"
(LET* ((NAME (IF (SYMBOLP NAME-AND-OPTIONS)
NAME-AND-OPTIONS (CAR NAME-AND-OPTIONS)))
(CONC-NAME (IF (SYMBOLP NAME-AND-OPTIONS)
(CONCATENATE 'STRING (STRING NAME) "-")
(LET ((CONC-OPT (CAR (MEMBER :CONC-NAME
(CDR NAME-AND-OPTIONS)
:KEY (FUNCTION CAR)))))
(IF CONC-OPT
(SECOND CONC-OPT)
(CONCATENATE 'STRING (STRING NAME) "-"))))))
`(DEFMACRO
,(WITH-STANDARD-IO-SYNTAX (INTERN (FORMAT NIL "WITH-~A" NAME)))
(OBJECT &BODY BODY)
(IF (SYMBOLP OBJECT)
`(SYMBOL-MACROLET
,(MAPCAR
(LAMBDA (SLOT)
(LIST SLOT
(LIST
(WITH-STANDARD-IO-SYNTAX
(INTERN (CONCATENATE 'STRING
(STRING ',CONC-NAME) (STRING SLOT))))
OBJECT))) ',SLOTS)
,@BODY)
(LET ((OBJV (GENSYM)))
`(LET ((,OBJV ,OBJECT))
(SYMBOL-MACROLET
,(MAPCAR
(LAMBDA (SLOT)
(LIST SLOT
(LIST
(WITH-STANDARD-IO-SYNTAX
(INTERN (CONCATENATE 'STRING
(STRING ',CONC-NAME) (STRING SLOT))))
OBJV))) ',SLOTS)
,@BODY)))))))

or don't use DEFSTRUCT.
The following macros could be used to migrate DEFSTRUCT to DEFCLASS:

(DEFUN GET-OPTION (KEY OPTIONS &OPTIONAL LIST)
(LET ((OPT (REMOVE-IF (LAMBDA (X) (NOT (EQ KEY (IF (SYMBOLP X) X (CAR X)))))
OPTIONS)))
(COND
(LIST OPT)
((NULL OPT) NIL)
((NULL (CDR OPT))
(IF (SYMBOLP (CAR OPT)) T (CDAR OPT)))
(T (ERROR "Expected only one ~A option."
(IF (SYMBOLP (CAR OPT)) (CAR OPT) (CAAR OPT)))))));;get-option

(DEFUN MAKE-NAME (OPTION PREFIX NAME SUFFIX)
(COND
((OR (NULL OPTION) (AND OPTION (NOT (LISTP OPTION))))
(WITH-STANDARD-IO-SYNTAX (INTERN (FORMAT NIL "~A~A~A" PREFIX NAME SUFFIX))))
((AND OPTION (LISTP OPTION) (CAR OPTION))
(CAR OPTION))
(T NIL)));;make-name

(DEFUN GET-NAME (OPTION)
(IF (AND OPTION (LISTP OPTION))
(CAR OPTION)
NIL))

(DEFUN MAKE-KEYWORD (SYM) (INTERN (STRING SYM) (FIND-PACKAGE "KEYWORD")))

(DEFMACRO DEFINE-STRUCTURE-CLASS (NAME-AND-OPTIONS &REST DOC-AND-SLOTS)
"
DO: Define a class implementing the structure API.
This macro presents the same API as DEFSTRUCT, but instead of
defining a structure, it defines a class, and the same functions
as would be defined by DEFSTRUCT.
The DEFSTRUCT options: :TYPE and :INITIAL-OFFSET are not supported.
"
(LET (NAME OPTIONS DOCUMENTATION SLOTS SLOT-NAMES ACCESSORS
CONC-NAME CONSTRUCTORS CONSTRUCTORS-K COPIER
INCLUDE INITIAL-OFFSET PREDICATE
PRINT-FUNCTION PRINT-OBJECT)
(IF (SYMBOLP NAME-AND-OPTIONS)
(SETF NAME NAME-AND-OPTIONS
OPTIONS NIL)
(SETF NAME (CAR NAME-AND-OPTIONS)
OPTIONS (CDR NAME-AND-OPTIONS)))
(IF (STRINGP (CAR DOC-AND-SLOTS))
(SETF DOCUMENTATION (CAR DOC-AND-SLOTS)
SLOTS (CDR DOC-AND-SLOTS))
(SETF DOCUMENTATION NIL
SLOTS DOC-AND-SLOTS))
(SETF CONC-NAME (GET-OPTION :CONC-NAME OPTIONS)
CONSTRUCTORS (GET-OPTION :CONSTRUCTOR OPTIONS :LIST)
COPIER (GET-OPTION :COPIER OPTIONS)
PREDICATE (GET-OPTION :PREDICATE OPTIONS)
INCLUDE (GET-OPTION :INCLUDE OPTIONS)
INITIAL-OFFSET (GET-OPTION :INITIAL-OFFSET OPTIONS)
PRINT-FUNCTION (GET-OPTION :PRINT-FUNCTION OPTIONS)
PRINT-OBJECT (GET-OPTION :PRINT-OBJECT OPTIONS))
(WHEN (AND PRINT-OBJECT PRINT-FUNCTION)
(ERROR "Cannot have :print-object and :print-function options."))
(WHEN (CDR INCLUDE)
(SETF SLOTS (APPEND (CDDR INCLUDE) SLOTS)
INCLUDE (LIST (CAR INCLUDE))))
(SETF CONC-NAME (MAKE-NAME CONC-NAME "" NAME "-")
COPIER (MAKE-NAME COPIER "COPY-" NAME "")
PREDICATE (MAKE-NAME PREDICATE "" NAME "-P")
PRINT-FUNCTION (GET-NAME PRINT-FUNCTION)
PRINT-OBJECT (GET-NAME PRINT-OBJECT))
(SETF SLOT-NAMES (MAPCAR (LAMBDA (S) (IF (SYMBOLP S) S (CAR S))) SLOTS))
(SETF ACCESSORS (MAPCAR
(LAMBDA (S) (MAKE-NAME NIL (OR CONC-NAME "")
(IF (SYMBOLP S) S (CAR S)) "")) SLOTS))
(IF (NULL CONSTRUCTORS)
(SETF CONSTRUCTORS (LIST (MAKE-NAME NIL "MAKE-" NAME "")))
(SETF CONSTRUCTORS
(MAPCAN (LAMBDA (X)
(COND
((OR (SYMBOLP X) (= 1 (LENGTH X)))
(LIST (MAKE-NAME NIL "MAKE-" NAME "")))
((NULL (SECOND X))
NIL)
((= 2 (LENGTH X))
(LIST (SECOND X)))
(T
(LIST (LIST (SECOND X) (THIRD X)))))) CONSTRUCTORS)))
`(PROGN
(DEFCLASS ,NAME ,INCLUDE
,(MAPCAR
(LAMBDA (SLOT ACCESSOR)
(IF (SYMBOLP SLOT)
`(,SLOT :ACCESSOR ,ACCESSOR)
(LET* ((NAME (FIRST SLOT))
(INITFORM-P (CDR SLOT))
(INITFORM (CAR INITFORM-P))
(TYPE-P (MEMBER :TYPE (CDDR SLOT)))
(TYPE (CADR TYPE-P))
(READ-ONLY-P (MEMBER :READ-ONLY (CDDR SLOT)))
(READ-ONLY (CADR READ-ONLY-P)))
`(,NAME
,(IF (AND READ-ONLY-P READ-ONLY) :READER :ACCESSOR)
,ACCESSOR
,@(WHEN INITFORM-P (LIST :INITFORM INITFORM))
,@(WHEN TYPE-P (LIST :TYPE TYPE))))))
SLOTS ACCESSORS)
,@(WHEN DOCUMENTATION (LIST `(:DOCUMENTATION ,DOCUMENTATION))))
,@(MAPCAR
(LAMBDA (CONSTRUCTOR)
;; generate a constructor.
(IF (SYMBOLP CONSTRUCTOR)
(LET ((PREDS (MAPCAR (LAMBDA (X) (GENSYM)) SLOT-NAMES)))
`(DEFUN ,CONSTRUCTOR
(&KEY ,@(MAPCAR (LAMBDA (S P) (LIST S NIL P))
SLOT-NAMES PREDS))
(LET ((ARGS NIL))
,@(MAPCAR
(LAMBDA (S P)
`(WHEN ,P
(PUSH ,S ARGS)
(PUSH ,(MAKE-KEYWORD S) ARGS)))
SLOT-NAMES PREDS)
(APPLY (FUNCTION MAKE-INSTANCE) ',NAME ARGS))))
(LET ((CNAME (FIRST CONSTRUCTOR))
(POSPAR (SECOND CONSTRUCTOR)))
`(DEFUN ,CNAME
))))
CONSTRUCTORS)
,@(WHEN COPIER
(LIST `(DEFMETHOD ,COPIER ((SELF ,NAME))
(MAKE-INSTANCE ',NAME
,@(MAPCAN
(LAMBDA (SLOT ACCESSOR)
(LIST (MAKE-KEYWORD SLOT) (LIST ACCESSOR 'SELF)))
SLOT-NAMES ACCESSORS)))))
,@(WHEN PREDICATE
(LIST `(DEFMETHOD ,PREDICATE (OBJECT)
(EQ (TYPE-OF OBJECT) ',NAME))))

,@(WHEN PRINT-FUNCTION
(LIST `(DEFMETHOD PRINT-OBJECT ((SELF ,NAME) STREAM)
(,PRINT-FUNCTION SELF STREAM 0))))
,@(WHEN PRINT-OBJECT
(LIST `(DEFMETHOD PRINT-OBJECT ((SELF ,NAME) STREAM)
(,PRINT-OBJECT SELF STREAM))))
)));;define-structure-class

Replacing DEFINE-WITH-STRUCTURE with this:

(DEFMACRO DEFINE-WITH-OBJECT (CLASS-NAME SLOTS)
"
DO: Define a macro: (WITH-{CLASS-NAME} object &body body)
expanding to: (with-slots ({slots}) object @body)
"
`(DEFMACRO
,(WITH-STANDARD-IO-SYNTAX (INTERN (FORMAT NIL "WITH-~A" CLASS-NAME)))
(OBJECT &BODY BODY)
`(WITH-SLOTS (quote ,,(MAPCAR (LAMBDA (SLOT) (LIST SLOT SLOT)) SLOTS))
,OBJECT ,@BODY))
);;DEFINE-WITH-OBJECT

--
__Pascal_Bourguignon__ http://www.informatimago.com/
There is no worse tyranny than to force a man to pay for what he doesn't
want merely because you think it would be good for him.--Robert Heinlein
http://www.theadvocates.org/

[Alain Picard]

ca...@alum.mit.edu (Dave Bakhash) writes:

You could write a macro WITH-STRUCTURE-SLOTS which, for LW,
just expands into WITH-SLOTS. That way, on some other implementation,
you could write a groovy macro which expands into the
required symbol-macrolet forms.

At the very least, it shows the reader that this is non-standard code.
Just a thought.

[Luke Gorrie]

Alain Picard <Alain....@memetrics.com> writes:

> You could write a macro WITH-STRUCTURE-SLOTS which, for LW,
> just expands into WITH-SLOTS. That way, on some other implementation,
> you could write a groovy macro which expands into the
> required symbol-macrolet forms.

Probably a stupid question, but could you just write a new defstruct
in terms of defclass instead?

-Luke (CLOS ignoramus)

[John Thingstad]

Yes. But you would take a performance hit.

(defclass struct ()
((slot1 :accessor slot1 :initarg :slot1)
...))

is roughly the same as defstruct.

--
Using M2, Opera's revolutionary e-mail client: http://www.opera.com/m2/

[Alain Picard]

Luke Gorrie <lu...@bluetail.com> writes:

You certainly could, but the OP wanted to use structs, and I
imagine he had his reasons. Since I know the OP, I even imagine
his reasons were probably reasonable. ;-)

[Thomas F. Burdick]

ca...@alum.mit.edu (Dave Bakhash) writes:

Not to try to break up your happy marriage, but although it's not
specified by the standard, it's a very common extension. Certainly
CMUCL/SBCL and MCL/OpenMCL let you use WITH-SLOTS on structures.

[Steven M. Haflich]

Alain Picard wrote:

> You certainly could, but the OP wanted to use structs, and I
> imagine he had his reasons. Since I know the OP, I even imagine
> his reasons were probably reasonable. ;-)

I find the thread that progressed from the original question to be
rather blind to ab obvious issue.

It is true that in most implementations slot-value works on a
structure-object, but aside from back compatiblity, the usual reason
for using structure-class rather than standard-class is considerations
of execution efficiency. As typically implemented, a structure-class
achieves slight slot reference efficiency ove stadnard-class at the
cost of redefinition flexibility (and sometimes debuggability). I
won't here express an opinion about the losers who insist on exploiting
this negligible efficiency without ever having measured its actual
impact, because there remain very occasional circumstances where
structure-objects are warranted over standard-object.

But aside from portability, programmers tempted to use with-slots on
a structure-object shiould consider the efficiency issue. If, as is
likely, with-slots symbol macroexpands insto slot-value, the efficiency
of slot-value on a structure-object must be considered. with-slots
on a structure object (in implementations that support it) might be
quite useful in a high-level introspection tool, but might be
entirely inappropriate in some inner computational loop. with-slots
was designed to be cleverly optimizable, at least inside a specialized
mathod body, so the programmer doesn't need to be concerned too much
about its use. Not so with-slots on a structure-object, which
performance probably hasn't been carefully considered either by the
language designers not the language implementors, and whose performance
might have a very different impedance that regular structure slot
accessors.