home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #18 / NN_1992_18.iso / spool / comp / lang / lisp / mcl / 1232 < prev    next >
Encoding:
Text File  |  1992-08-14  |  1.7 KB  |  57 lines
  1. Path: sparky!uunet!portal!apple!cambridge.apple.com!bill@cambridge.apple.com
  2. From: bill@cambridge.apple.com (Bill St. Clair)
  3. Newsgroups: comp.lang.lisp.mcl
  4. Subject: Re: SET method not defined automatically...
  5. Message-ID: <9208141945.AA23755@cambridge.apple.com>
  6. Date: 14 Aug 92 20:50:26 GMT
  7. Sender: info-mcl-request@cambridge.apple.com
  8. Lines: 43
  9. Approved: comp.lang.lisp.mcl@Cambridge.Apple.C0M
  10. Full-Name: Bill St. Clair
  11. Original-To: frege@eecs.umich.edu
  12. Original-Cc: info-mcl
  13.  
  14. >   
  15. >   I meant SETF not SET.
  16. >
  17. >   In the following file, a customized version of defstruct is defined
  18. >but when I use it with MCL 2.0 the SETF methods for each of its slots
  19. >seems not to be defined automatically. This was not the case in MACL 1.3.2.
  20. >
  21. > [Code omitted]
  22.  
  23. Works fine for me. Please send example forms that illustrate the omission
  24. of the SETF methods.
  25.  
  26. I have assumed the following definitions for the functions that you did
  27. not include:
  28.  
  29. -----------------------------------------------------------------------
  30.  
  31. (defun string-concatenate (&rest strings)
  32.   (apply 'concatenate 'string strings))
  33.  
  34. (defun mapc-condcons (function list)
  35.   (let ((res nil))
  36.     (dolist (element list)
  37.       (let ((res-el (funcall function element)))
  38.         (when res-el (push element res))))
  39.     (nreverse res)))
  40.  
  41. (eval-when (:compile-toplevel :execute)
  42.  
  43. (defmacro sd-slots (sd) `(%svref ,sd 1))
  44.  
  45. )
  46.  
  47. (defun structure-slot-names (structure-type)
  48.   (let ((sd (gethash structure-type ccl::%defstructs%))
  49.         res)
  50.     (unless sd
  51.       (error "There is no structure named ~s" structure-type))
  52.     (dolist (slotd (sd-slots sd))
  53.       (let ((slot-name (car slotd)))
  54.         (when (symbolp slot-name)
  55.           (push slot-name res))))
  56.     (nreverse res)))
  57.