Prev: Lispers in the silicon valley?
Next: Online survey jobs & data entry jobs
From: Tim Bradshaw on 2 May 2010 14:36
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

From: Norbert_Paul on 3 May 2010 09:02
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.
From: Pillsy on 3 May 2010 10:51
On Apr 30, 12:08 pm, Trastabuga <lisper...(a)gmail.com> wrote:

> Given a class, I need a function that can add elements to one of the
> fields of the class.

> It's easy to do if the function knows the name of the field, but what
> if the function doesn't know it and we need to pass it as an input
> parameter to the function.

> Let's say

> (defclass test1 ()
>   ((fld1 :accessor test1-fld1 :initarg :fld1 :type list)))

> (setq o (make-instance 'test1 :fld1 nil))
> (defun append-element (o el)
>   (with-slots (fld1) o
>     (setf fld1 (append fld1 (list el)))))

If I wanted to stick with a function-based (as opposed to macro-based)
solution, I would do it like this:

(defun append-element (object element getter setter)
(let ((current (funcall getter object)))
(funcall setter (append fldl (list element)) object)))

This will be pretty easy to use with your class as written. You use

(append-element o 'foo #'test-fld1 #'(setf test-fld1))

It's also a fairly general solution. Consider:

(defparameter *table* (make-hash-table))

(append-element *table* 'baz
(lambda (ht) (gethash 'bar ht))
(lambda (val ht) (setf (gethash 'bar ht) val))

You can build more convenient functions on top of this one, like

(append-element-to-slot (object element slot)
(append-element object element
(lambda (o) (slot-value o slot))
(lambda (v o) (setf (slot-value o slot))))

(append-element-to-table-value (table element key)
(append-element table element
(lambda (ht) (gethash key ht))
(lambda (v ht) (setf (gethash key ht) v)))

I doubt it will ever be as syntactically clean as a macro-based
solution, but it's hard to beat its ease of implementation.

Cheers,
Pillsy
From: Pascal J. Bourguignon on 3 May 2010 11:03
Norbert_Paul <norbertpauls_spambin(a)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
From: Tamas K Papp on 3 May 2010 11:33
On Mon, 03 May 2010 17:03:36 +0200, Pascal J. Bourguignon wrote:

> ;;; 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)

This is really neat, thanks.

Tamas
First  |  Prev  |  Next  |  Last
Pages: 1 2 3 4
Prev: Lispers in the silicon valley?
Next: Online survey jobs & data entry jobs