From: Dr. E. Handelman
Subject: Re: defstruct
Date: 
Message-ID: <eliot-0511952052340001@a-02.das.mcgill.ca>
In article <··········@cogsci.ed.ac.uk>, ····@cogsci.ed.ac.uk (Jeff
Dalton) wrote:

> ·····@lia.di.epfl.ch (Simon Leinen) writes:
> 
> >Jean-Marc> 1) Who could tell me how to access the slot names of a
> >Jean-Marc> structure in common-lisp ?
> 
> >You certainly cannot do this without resorting to the Meta-Object
> >Protocol.
> 
> But many people have wanted to do it.  Someone could do the world
> a favor by writing a macro that's just like defstruct except that
> it records slot information, and posting the macro to comp.lang.lisp.
> 
> I'll do it if I can find time, but that's hard for me to do 
> right now.
> 
> -- jeff

Here's one way, among the countless other possibilities:

(defmacro (defstruct* opts . slots)
   (let ((struct-name (if (consp opts) (car opts) opts)))
     `(progn
       (setf (get ',struct-name 'original-defstruct-slots) ',slots)
       (defstruct ,opts ,@slots))))

=> (defstruct* foo
     bar 
    (baz 1))

FOO

=> (get 'foo 'original-defstruct-slots)
 
 (bar (baz 1))

Parsing this list for the slot names is trivial. A word of caution,
however -- KCL, possibly AKCL too, stores information in the
plist of the structure name. But knowing that you wouldn't need
this function, unless you need portability.

-- eliot

-- 
Neurodildonic home Garret: http://www.music.princeton.edu:80/~eliot/

From: Dr. E. Handelman
Subject: Re: defstruct
Date: 
Message-ID: <eliot-0611950140470001@i-15.das.mcgill.ca>
In article <······················@a-02.das.mcgill.ca>,
·····@phoenix.princeton.edu (Dr. E. Handelman) wrote:


> (defmacro (defstruct* opts . slots)
>    (let ((struct-name (if (consp opts) (car opts) opts)))
>      `(progn
>        (setf (get ',struct-name 'original-defstruct-slots) ',slots)
>        (defstruct ,opts ,@slots))))


Oops! I forgot about :INCLUDE. Here's a revised version:

;;; DEFSTRUCT* saves slotnames for STRUCTURE-SLOTS, following the
;;; :INCLUDE link if necessary 

(define (structure-slots s)
  (get s 'original-defstruct-slots))


(defmacro defstruct* (opts . slots)
   (let ((slot-list (mapcar #'(lambda (s) 
                                (if (consp s) (car s) s))
                            slots))
         (struct-name opts))
     (when (consp opts)
         (setq struct-name (car opts))
         (dolist (option (cdr opts))
            (when (eq (car option) :include)
              (setq slot-list 
                    (append (structure-slots (second option))
                            slot-list)))))
     
     `(progn
        (setf (get ',struct-name 'original-defstruct-slots) ',slot-list)
        (defstruct ,opts ,@slots))))

;;; examples:

=> (defstruct* (foo)
     bar 
    (baz 1))

FOO

=> (structure-slots 'foo)

(BAR BAZ)

=> (defstruct* (phew (:include foo))
      bear
      bahs)

PHEW

=>  (structure-slots 'phew)
(BAR BAZ BEAR BAHS)

-- 
Neurodildonic home Garret: http://www.music.princeton.edu:80/~eliot/
From: Jeff Dalton
Subject: Re: defstruct
Date: 
Message-ID: <DHMrvs.924@cogsci.ed.ac.uk>
·····@phoenix.princeton.edu (Dr. E. Handelman) writes:

>In article <······················@a-02.das.mcgill.ca>,
>·····@phoenix.princeton.edu (Dr. E. Handelman) wrote:


>> (defmacro (defstruct* opts . slots)
>>    (let ((struct-name (if (consp opts) (car opts) opts)))
>>      `(progn
>>        (setf (get ',struct-name 'original-defstruct-slots) ',slots)
>>        (defstruct ,opts ,@slots))))


>Oops! I forgot about :INCLUDE. Here's a revised version:

That's excellent, and simpler than I expected, largely because
it leaves slot-psrsing to the user, which is ok: someone can
just provide some utility functions.

>;;; DEFSTRUCT* saves slotnames for STRUCTURE-SLOTS, following the
>;;; :INCLUDE link if necessary 

Remember that :include can override slot specs from the parent.
The full :include syntax is (:INCLUDE name slot-description*).

It would also be useful to save the parent name as well as the
slot specs.

Another complication: to _access_ the slots, you need to know
that names of the access functions, and for that you need to
look at the :conc-name option.

-- jeff
From: E. Handelman
Subject: Re: defstruct
Date: 
Message-ID: <eliot-0811952053340001@f-16.das.mcgill.ca>
In article <··········@cogsci.ed.ac.uk>, ····@cogsci.ed.ac.uk (Jeff
Dalton) wrote:

> ·····@phoenix.princeton.edu (Dr. E. Handelman) writes:
> 
> >In article <······················@a-02.das.mcgill.ca>,
> >·····@phoenix.princeton.edu (Dr. E. Handelman) wrote:

> >;;; DEFSTRUCT* saves slotnames for STRUCTURE-SLOTS, following the
> >;;; :INCLUDE link if necessary 
 
> Remember that :include can override slot specs from the parent.
> The full :include syntax is (:INCLUDE name slot-description*).

Right, but that doesn't bother us because the slot name
must still be the same as some slot in the included structure. 

> It would also be useful to save the parent name as well as the
> slot specs.

> Another complication: to _access_ the slots, you need to know
> that names of the access functions, and for that you need to
> look at the :conc-name option.


An alternative to this approach is to reinstate MacLisp's
defstruct-description structures, which could be :INCLUDED
with every structure; write the information there,
and then there would be for each structure an accessor
(DEFSTRUCT-DESCRIPTION-SLOTS <your structure>), since,
if I remember, the offset of all included structures is arranged 
so that the accessors of the included structure work on the new
structure (or is that the other way around?) -- that would however
take more code grinding than I'm prepared to face just now. In any
case the basic strategy would remain the same -- preparse DEFSTRUCT
to pick at any information you need, then send it on. 

Here's a revised version of DEFSTRUCT* that will probably suit
almost everyone's needs. Actually the original code I proposed
would probably serve as well, since how often do you really need
to include the structures? At this point in LISP programming
I think most people would rely on CLOS if they need inheritance at all.
Of course then they have to deal with the tricky MOPS.  


(defun structure-slot-alist (structure-name )
  (get structure-name 'original-defstruct-slots))

(defun structure-slot-names (structure-name)
   "Given the name of structure, return the names of all the slots."
  (mapcar #'car (structure-slot-alist structure-name)))

(defun structure-slot-accessors (structure-name)
   "Given the name of structure, return the names of all the accessors."
   (mapcar #'cdr (structure-slot-alist structure-name)))

(defun structure-slot-accessor (structure-name slot-name)
   "Given the name of a structure and a slot, return the accessor."
  (cdr (assoc slot-name (structure-slot-alist structure-name))))

(defmacro defstruct* (opts . slots)
   (let ((slot-list (mapcar #'(lambda (s) 
                                (if (consp s) (car s) s))
                            slots))
         (struct-name opts)
         (conc-name nil)
         (include nil))
     (cond ((consp opts)
            (setq struct-name (car opts))
            (setq include (second (assoc :INCLUDE (cdr opts))))
            (setq conc-name (second (assoc :CONC-NAME (cdr opts))))
            (if conc-name
              (setq conc-name (format nil "~S" conc-name))
              (setq conc-name (format nil "~S-" struct-name)))
            (when include
               (setq slot-list 
                     (append (structure-slot-names include)
                             slot-list))))
           (t
            (setq conc-name (setq conc-name (format nil "~S-" struct-name)))))
     `(progn
        (setf (get ',struct-name 'original-defstruct-slots)
              ',(mapcar #'(lambda (s)
                           (cons s (intern (format nil "~A~S" conc-name s))))
                        slot-list))
        (defstruct ,opts ,@slots))))


;;; Now you can do things like this:

(defun list-all-structure-slots (struct name)
   (mapcar #'(lambda (accessor)
               (funcall accessor struct))
           (structure-slot-accessors name)))

(defstruct* (foo (:conc-name blam-))
     bar 
    (baz 1))

(defstruct* (phew (:include foo))
      bear
      bahs)

;;; And then:

> (setq xxx (make-phew))
#S(PHEW BAR NIL BAZ 1 BEAR NIL BAHS NIL)
> (list-all-structure-slots xxx 'phew)
(NIL 1 NIL NIL)



-- eliot