home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / bsd_srcs / usr.bin / lisp / lispnews / text0198.txt < prev    next >
Encoding:
Text File  |  1985-11-10  |  3.5 KB  |  94 lines
  1. As FranzFriends readers will know, my message several days ago
  2. generated a number of comments.  The clear consensus was that setf
  3. should be fixed, not the documentation.  This was obvious.  The reason
  4. I didn't suggest the fix myself was that I felt it was far more
  5. important to preserve compatibility between Franz and the various other
  6. more-or-less-source-compatible Lisps (aka Common Lisps).  It was my
  7. impression that code relying on the value returned by setf would not
  8. be portable.
  9.  
  10. I have since learned that Common Lisp does indeed define setf to return
  11. the new value (its second argument), and that other implementations
  12. (i.e. MIT and Symbolics Lisp Machines) indeed work this way.  (Mind
  13. you, I haven't checked this myself -- the information is second hand.)
  14. The fixes to setf are quite straightforward and are brief enough that I
  15. am including them below.  For each case that the setf macro evaluates
  16. to a {rplaca, rplacd, rplacx} the corresponding {car, cdr, cxr} is now
  17. wrapped around it.  The Liszt compiler seems smart enough to remove the
  18. extra reference if the value is ignored.
  19.  
  20. The new setf functions follow.  The starting version is the Opus 38.69
  21. common2 identified by:
  22. ;; common2.l                -[Fri Jul  8 17:46:13 1983 by layer]-
  23. (Although only two lines of setf-check-car+d were changed, the entire
  24. function is included because the change is difficult to locate by
  25. context.)  I suggest these changes be made in the official sources.
  26. Whoever wants to install them should edit common2.l and remake the
  27. Franz interpreter.  The Liszt compiler does not need to be changed.
  28. ====================
  29.  
  30. ; modified 27Mar84 SMH@MIT-EMS@MT-MC (see comment below)
  31. ;
  32. (defun setf-check-cad+r (name)
  33.  (if (eq (getcharn name 1) #/c)
  34.      then (let
  35.        ((letters (nreverse (cdr (exploden name)))))
  36.        (if (eq (car letters) #/r)
  37.            then (do ((xx (cdr letters) (cdr xx)))
  38.             ((null xx)
  39.              ;; form is c{ad}+r, setf form is
  40.              ;; (rplac<first a or d> (c<rest of a's + d's>r x))
  41.              (setq letters (nreverse letters))
  42.              (eval
  43.               `(defsetf ,name (e v)
  44.                     ; SMH@MIT-EMS@MIT-MC    
  45.                     ; added next line and matching rparen.
  46.                     (list ',(implode `(#/c ,(car letters) #/r))
  47.                      (list
  48.                       ',(concat "rplac" (ascii (car letters)))
  49.                       (list
  50.                        ',(implode `(#/c ,@(cdr letters)))
  51.                        (cadr e))
  52.                       v))))    ; SMH@MIT-EMS@MIT-MC
  53.              t)
  54.             (if (not (memq (car xx) '(#/a #/d)))
  55.                 then (return nil)))))))
  56.  
  57. . . .
  58.  
  59. ;--- other setf's for car's and cdr's are generated automatically
  60. ;
  61. ; modified 27Mar84 SMH@MIT-EMS@MIT-MC
  62. ; Now whenever setf macro expands to a rplac[adx], the corresponding c[adx]r
  63. ; is now wrapped around it so that setf consistently returns its second arg.
  64. ; The compiler is smart enough to remove the extra operation if the value
  65. ; is not used.
  66. ;
  67. (defsetf car (e v) `(car (rplaca ,(cadr e) ,v)))
  68. (defsetf caar (e v) `(car (rplaca (car ,(cadr e)) ,v)))
  69. (defsetf cadr (e v) `(car (rplaca (cdr ,(cadr e)) ,v)))
  70. (defsetf cdr (e v) `(cdr (rplacd ,(cadr e) ,v)))
  71. (defsetf cdar (e v) `(cdr (rplacd (car ,(cadr e)) ,v)))
  72. (defsetf cddr (e v) `(cdr (rplacd (cdr ,(cadr e)) ,v)))
  73. (defsetf cxr (e v) `(cxr ,(cadr e) (rplacx ,(cadr e) ,(caddr e) ,v)))
  74.  
  75. . . .
  76.  
  77. (defsetf nth (e v) `(car (rplaca (nthcdr ,(cadr e) ,(caddr e)) ,v)))
  78. (defsetf nthelem (e v) `(car (rplaca (nthcdr (1- ,(cadr e)) ,(caddr e)) ,v)))
  79. (defsetf nthcdr (e v) `(cdr (rplacd (nthcdr (1- ,(cadr e)) ,(caddr e)) ,v)))
  80.  
  81. . . .
  82.  
  83. ; (defsetf args (e v) `(args ,(cadr e) ,v))    ; no longer implemented?
  84.  
  85. ====================
  86.  
  87. Steven Haflich
  88. MIT Experimental Music Studio
  89. (617)253-7441
  90. smh@mit-ems@mit-mc
  91. decvax!genrad!mit-ems!smh
  92.  
  93.  
  94.