Fixes for setf return value problem

[<smh@mit-ems@mit-mc>]

As FranzFriends readers will know, my message several days ago
generated a number of comments.  The clear consensus was that setf
should be fixed, not the documentation.  This was obvious.  The reason
I didn't suggest the fix myself was that I felt it was far more
important to preserve compatibility between Franz and the various other
more-or-less-source-compatible Lisps (aka Common Lisps).  It was my
impression that code relying on the value returned by setf would not
be portable.

I have since learned that Common Lisp does indeed define setf to return
the new value (its second argument), and that other implementations
(i.e. MIT and Symbolics Lisp Machines) indeed work this way.  (Mind
you, I haven't checked this myself -- the information is second hand.)
The fixes to setf are quite straightforward and are brief enough that I
am including them below.  For each case that the setf macro evaluates
to a {rplaca, rplacd, rplacx} the corresponding {car, cdr, cxr} is now
wrapped around it.  The Liszt compiler seems smart enough to remove the
extra reference if the value is ignored.

The new setf functions follow.  The starting version is the Opus 38.69
common2 identified by:
;; common2.l				-[Fri Jul  8 17:46:13 1983 by layer]-
(Although only two lines of setf-check-car+d were changed, the entire
function is included because the change is difficult to locate by
context.)  I suggest these changes be made in the official sources.
Whoever wants to install them should edit common2.l and remake the
Franz interpreter.  The Liszt compiler does not need to be changed.
====================

; modified 27Mar84 SMH@MIT-EMS@MT-MC (see comment below)
;
(defun setf-check-cad+r (name)
 (if (eq (getcharn name 1) #/c)
     then (let
	   ((letters (nreverse (cdr (exploden name)))))
	   (if (eq (car letters) #/r)
	       then (do ((xx (cdr letters) (cdr xx)))
			((null xx)
			 ;; form is c{ad}+r, setf form is
			 ;; (rplac<first a or d> (c<rest of a's + d's>r x))
			 (setq letters (nreverse letters))
			 (eval
			  `(defsetf ,name (e v)
					; SMH@MIT-EMS@MIT-MC	
					; added next line and matching rparen.
				    (list ',(implode `(#/c ,(car letters) #/r))
				     (list
				      ',(concat "rplac" (ascii (car letters)))
				      (list
				       ',(implode `(#/c ,@(cdr letters)))
				       (cadr e))
				      v))))	; SMH@MIT-EMS@MIT-MC
			 t)
			(if (not (memq (car xx) '(#/a #/d)))
			    then (return nil)))))))

. . .

;--- other setf's for car's and cdr's are generated automatically
;
; modified 27Mar84 SMH@MIT-EMS@MIT-MC
; Now whenever setf macro expands to a rplac[adx], the corresponding c[adx]r
; is now wrapped around it so that setf consistently returns its second arg.
; The compiler is smart enough to remove the extra operation if the value
; is not used.
;
(defsetf car (e v) `(car (rplaca ,(cadr e) ,v)))
(defsetf caar (e v) `(car (rplaca (car ,(cadr e)) ,v)))
(defsetf cadr (e v) `(car (rplaca (cdr ,(cadr e)) ,v)))
(defsetf cdr (e v) `(cdr (rplacd ,(cadr e) ,v)))
(defsetf cdar (e v) `(cdr (rplacd (car ,(cadr e)) ,v)))
(defsetf cddr (e v) `(cdr (rplacd (cdr ,(cadr e)) ,v)))
(defsetf cxr (e v) `(cxr ,(cadr e) (rplacx ,(cadr e) ,(caddr e) ,v)))

. . .

(defsetf nth (e v) `(car (rplaca (nthcdr ,(cadr e) ,(caddr e)) ,v)))
(defsetf nthelem (e v) `(car (rplaca (nthcdr (1- ,(cadr e)) ,(caddr e)) ,v)))
(defsetf nthcdr (e v) `(cdr (rplacd (nthcdr (1- ,(cadr e)) ,(caddr e)) ,v)))

. . .

; (defsetf args (e v) `(args ,(cadr e) ,v))	; no longer implemented?

====================

Steven Haflich
MIT Experimental Music Studio
(617)253-7441
smh@mit-ems@mit-mc
decvax!genrad!mit-ems!smh