Path: g2news2.google.com!news3.google.com!feeder.news-service.com!border1.nntp.ams.giganews.com!nntp.giganews.com!fu-berlin.de!uni-berlin.de!individual.net!not-for-mail
From: p...@informatimago.com (Pascal J. Bourguignon)
Newsgroups: comp.lang.lisp
Subject: Re: passing setf-able place to a function?
Date: Mon, 03 May 2010 17:03:36 +0200
Organization: Informatimago
Lines: 99
Message-ID: <lz8w81auyf.fsf@informatimago.com>
References: <5adb5b25-b026-4f00-a885-6f0910775dd7@u30g2000prd.googlegroups.com> <hrjtvh$kp2$1@news.eternal-september.org> <hrk3nh$3vj$1@news.eternal-september.org> <hrk4mh$3v2$1@news.eternal-september.org> <hrkgng$9qd$1@news.eternal-september.org> <hrmhd0$ch5$1@news.eternal-september.org>
Mime-Version: 1.0
Content-Type: text/plain; charset=us-ascii
X-Trace: individual.net I4huLT7DBFGhQZO6QFmRDwHSi1enz3YG1bZ8Fy9uyFJTv+5KzB
Cancel-Lock: sha1:N2E5NmRhMGFkNjBmYjZlMDJkM2Q1M2M0ODZiZjA2NTg4NTU1ZGM3YQ== sha1:HifA0FMQ8GUphepOGaUJ0FWCSPo=
Face: iVBORw0KGgoAAAANSUhEUgAAADAAAAAwAQMAAABtzGvEAAAABlBMVEUAAAD///+l2Z/dAAAA
      oElEQVR4nK3OsRHCMAwF0O8YQufUNIQRGIAja9CxSA55AxZgFO4coMgYrEDDQZWPIlNAjwq9
      033pbOBPtbXuB6PKNBn5gZkhGa86Z4x2wE67O+06WxGD/HCOGR0deY3f9Ijwwt7rNGNf6Oac
      l/GuZTF1wFGKiYYHKSFAkjIo1b6sCYS1sVmFhhhahKQssRjRT90ITWUk6vvK3RsPGs+M1RuR
      mV+hO/VvFAAAAABJRU5ErkJggg==
X-Accept-Language:         fr, es, en
X-Disabled: X-No-Archive: no
User-Agent: Gnus/5.101 (Gnus v5.10.10) Emacs/23.1 (darwin)

Norbert_Paul <norbertpauls_spam...@yahoo.com> writes:

> Tim Bradshaw wrote:
>> On 2010-05-02 16:13:51 +0100, Norbert_Paul said:
>>> Did you mean
>>>
>>> (defun append-element (o el accessor)
>>> (let ((getter (fdefinition accessor))
>>> (setter (fdefinition `(setf ,accessor))))
>>> (funcall setter (append (funcall getter o) (list el)) o)))
>>
>> something like that
>>
> Does that always work?
>
> I searched the HS a lot but couldn'd find any guarantee that
> an accessor foo always has an (fdefinition `(setf ,foo)),
> neither could I find the contrary.

Indeed not.  It's not because you can write (setf (foo x) v) that you
can recover a (function (setf foo)) or a (fdefinition '(setf foo)).

SETF can implement the "standard" place in its own way, without having
a (setf foo) function defined.

The correct way to "reify" a random place in general, is to wrap it in
a closure, or a pair of closures.

See for example:
http://groups.google.com/group/comp.lang.lisp/msg/1799d5db9267c523
which is wrong, since it doesn't use get-setf-expansion to avoid
duplicate evaluation of the arguments to the place, but gives you the
closure side (it answered on a question on variables, not places).


So a full solution would be:

;;; Locatives with multiple-value places.

(defmacro & (place &environment env)
   (multiple-value-bind (vars vals store-vars writer-form reader-form) 
                            (get-setf-expansion place env)
       `(let* (,@(mapcar (function list) vars vals)
               ,@store-vars)
             (lambda (m &rest values)
                (ecase m 
                  ((set)
                      (psetf ,@(loop :for v :in store-vars :nconc (list v '(pop values))))
                      ,writer-form)
                   ((get)
                      ,reader-form))))))


(defun deref (locative) (funcall locative 'get))

;; Notice that using (defun (setf deref) ...) would prevent to store
;; multiple values, if the place accepted them.  So we must use
;; defsetf with a macro setter.

(defmacro set-deref (locative value-expression)
  `(multiple-value-call ,locative 'set ,value-expression))

(defsetf deref set-deref)


;; So that:

(let* ((a 1) (b 2) (c 3) (l (& (values a b c))))
       (print (multiple-value-list (deref l)))
       (setf (deref l) (values 4 5 6))
       (list a b c))

prints:  (1 2 3) 
returns: (4 5 6)

;; and

(let* ((a 1)
             (b 2)
             (c 3)
             (ls (vector (& (values a b c))
                         (& a)
                         (& b)
                         (& c)))
             (i -1))
       (print (multiple-value-list (deref (aref ls (incf i)))))
       (print (multiple-value-list (deref (aref ls (incf i)))))
       (decf i)
       (incf (deref (aref ls (incf i))) 10)
       (list (list i) a b c))

prints:  (1 2 3) 
         (1) 
returns: ((1) 11 2 3)


-- 
__Pascal Bourguignon__
http://www.informatimago.com