Path: utzoo!utgpu!news-server.csri.toronto.edu!rpi!zaphod.mps.ohio-state.edu!uwm.edu!bionet!agate!ucbvax!tut.cis.ohio-state.edu!unreplyable!garbage
From: harrisr@CS.RPI.EDU (Richard Harris)
Newsgroups: comp.lang.clos
Subject: Re: SLOT-VALUE and structures
Message-ID: <9104180243.AA06781@cs.rpi.edu>
Date: 18 Apr 91 02:43:04 GMT
Sender: welch@tut.cis.ohio-state.edu
Distribution: inet
Organization: CommonLoops
Lines: 76

The file structure.lisp implements structure-classes for PCL.
I have put it in the pcl directory on arisia.xerox.com.
I have tested it in Lucid 3.0 and akcl 530.  For other ports
of PCL, the following functions remain to be implemented:


Low level functions for structures

Functions on arbitrary objects
  structurep
  structure-instance-p ; excludes std-instance
  structure-type
Functions on symbols naming structures
  structure-type-p ; Excludes structures types created with the :type option
  structure-type-included-type-name
  structure-type-slot-description-list ; all slots, not just direct slots
Functions on slot-descriptions (returned by the function above)
  structure-slotd-name        [symbol]
  structure-slotd-reader      [symbol]
  structure-slotd-writer      [symbol or list or null]


If you implement these low level functions for your lisp,
please send me a copy.


Here is a sample session:

> (compile-file "structure")
...
> (load "structure")
...
> (in-package 'pcl)
#<Package "PCL" AB641E>
> (defstruct z a)
Z
> (setq z1 (make-z :a 1))
#S(Z A 1)
> (slot-value z1 'a)
1
> (setf (slot-value z1 'a) 2)
2
> (z-a z1)
2
> (class-of z1)
#<Structure-Class Z 67337736>
> (find-class 'z)
#<Structure-Class Z 67337736>
> (pprint (macroexpand '(defmethod x ((self z)) (slot-value self 'a))))

(COMPILER-LET
  ((SYSTEM:*COMPILER-MESSAGE-STRING*
     (OR SYSTEM:*COMPILER-MESSAGE-STRING* "Defmethod X (Z)")))
  (EVAL-WHEN (COMPILE LOAD EVAL)
             (LOAD-DEFMETHOD 'STANDARD-METHOD
                             'X
                             'NIL
                             (LIST 'Z)
                             '(SELF)
                             'NIL
                             'NIL
                             'NIL
                             #'(LAMBDA (SELF) (DECLARE (CLASS SELF Z))
                                (PROGN SELF) (BLOCK X (Z-A SELF))))))
> (defmethod x ((self z)) (slot-value self 'a))
#<Standard-Method X (Z) 74475406>
> (defmethod x (self) self)
#<Standard-Method X (T) 65775016>
> > (x 'a)
A
> (x z1)
2
>

-------
 Richard Harris