Hi!!!
I was playing with a way to implement a bubble-sort. I did this:
(defun ordenar (vector)
(let ((largo (length vector))
(vector-ordenado (copy-seq vector)))
(do ((posición 0 (1+ posición)))
((= posición (1- largo)) vector-ordenado)
(do ((i (1+ posición) (1+ i)))
((= i largo))
(when (< (elt vector-ordenado i) (elt vector-ordenado posición))
(rotatef (elt vector-ordenado posición)
(elt vector-ordenado i)))))))
And I didn't like the last part:
(when (< (elt vector-ordenado i) (elt vector-ordenado posición))
(rotatef (elt vector-ordenado posición)
(elt vector-ordenado i)))))))
I thought that there should be a way to say something like:
(rotatef-if #'< (elt vector-ordenado i) (elt vector-ordenado
posición))
First I did this:
(defmacro rotatef-elt-if-< ((elt e1 p1) (etl e2 p2))
(let ((pg1 (gensym)) (pg2 (gensym)))
`(let ((,pg1 ,p1) (,pg2 ,p2))
(when (< (elt ,e1 ,pg1) (elt ,e2 ,pg2))
(rotatef (elt ,e1 ,pg1) (elt ,e2 ,pg2))))))
that worked; but then tried to get something more 'general'.
And after reading pag.172-173 from Graham's On Lisp I wrote this:
(defmacro rotatef-if (predicate place1 place2)
(multiple-value-bind (vars1 forms1 var1 set1 access1)
(get-setf-method place1)
(multiple-value-bind (vars2 forms2 var2 set2 access2)
(get-setf-method place2)
`(let* (,@(mapcar #'list vars1 forms1)
,@(mapcar #'list vars2 forms2)
(,(car var1) ,access1)
(,(car var2) ,access2))
(when (funcall ,predicate ,(car var1) ,(car var2))
(rotatef ,place1 ,place2))))))
All I can say is... it just works. What do you think? How can it be
improved/corrected?
Thank you!!!!
Luis.
P.D.: I hope this *will* be my first macro, after all.... :)
LuisGLopez wrote:
> I tried it with other setfable places:
>
> CL-USER> (setf *a* (cons 1 2))
> Warning: Declaring *A* special.
> (1 . 2)
> CL-USER> (setf *b* (cons 3 4))
> Warning: Declaring *B* special.
> (3 . 4)
> CL-USER> (rotatef-if #'< (car a) (car b))
> T
> CL-USER> *a*
> (1 . 2)
> CL-USER> *b*
> (3 . 4)
>
Did you figure out the problem here? First, you really should create a
variable before using SETF on it:
(defvar *x* (cons 1 2))
(defvar *y* (cons 3 4))
Then you should use the name of the variable rather than someone else's
name :)
(rotate-if #'< (car *x*) (car *y*))
Then you should get what you expect.
One other note, Some of _On Lisp_ is out of date. If you have Graham's
other book _ANSI Common Lisp_, he discusses changes made since 1990 in
Appendix C (Although _On Lisp_ was published in 1994, so I don't know
why the following wasn't updated in the book). In particular,
GET-SETF-METHOD has been deleted. You should use GET-SETF-EXPANSION instead:
http://www.lispworks.com/documentation/HyperSpec/Body/f_get_se.htm
Aloha,
David Sletten
David Sletten wrote:
> LuisGLopez wrote:
>
> > I tried it with other setfable places:
> >
> > CL-USER> (setf *a* (cons 1 2))
> > Warning: Declaring *A* special.
> > (1 . 2)
> > CL-USER> (setf *b* (cons 3 4))
> > Warning: Declaring *B* special.
> > (3 . 4)
> > CL-USER> (rotatef-if #'< (car a) (car b))
> > T
> > CL-USER> *a*
> > (1 . 2)
> > CL-USER> *b*
> > (3 . 4)
> >
>
> Did you figure out the problem here? First, you really should create a
> variable before using SETF on it:
> (defvar *x* (cons 1 2))
> (defvar *y* (cons 3 4))
>
> Then you should use the name of the variable rather than someone else's
> name :)
> (rotate-if #'< (car *x*) (car *y*))
>
> Then you should get what you expect.
>
Dear David,
Thank you very much!!! So my macro *actually* works? :)
> One other note, Some of _On Lisp_ is out of date. If you have Graham's
> other book _ANSI Common Lisp_, he discusses changes made since 1990 in
> Appendix C (Although _On Lisp_ was published in 1994, so I don't know
> why the following wasn't updated in the book). In particular,
> GET-SETF-METHOD has been deleted. You should use GET-SETF-EXPANSION instead:
> http://www.lispworks.com/documentation/HyperSpec/Body/f_get_se.htm
>
Unfortunately, I can't afford getting the great _ANSI Common Lisp_ (In
fact, I laser-printed the _On Lisp_ pdf version). So, thank you *so*
much for pointing me to the hyperspec; I'm going there now!
By the way; I'll see if I can change the definition so it can take
several 'places', instead of just two, like the 'plain' rotatef. :)
Luis.
On 9383 day of my life ············@gmail.com wrote:
> Excuse me for the 'double-post', but I thougth it would be a 'nice
> touch' to return 't' if the rotatef took place, and 'nil' otherwise:
>
> (defmacro rotatef-if (predicate place1 place2)
> ...)
This is well-written macro! Congratulations! :)
--
Ivan Boldyrev
Your bytes are bitten.
Hi Ivan!!!
Ivan Boldyrev wrote:
> On 9383 day of my life ············@gmail.com wrote:
> > Excuse me for the 'double-post', but I thougth it would be a 'nice
> > touch' to return 't' if the rotatef took place, and 'nil' otherwise:
> >
> > (defmacro rotatef-if (predicate place1 place2)
> > ...)
>
> This is well-written macro! Congratulations! :)
>
Thank you very much!!! :) I'm very excited; this is my first macro..!
Now I'm trying to get it more general; I would like it to be able to
rotate n places (like rotatef). But it's tough...
I'm trying to get this part first:
(multiple-value-bind (vars1 form1 var1 set1 acc1)
(get-setf-expansion place1)
(multiple-value-bind (vars2 form2 var2 set2 acc2)
(get-setf-expansion place2)
...and so on for place3...placen.
All I could get is this:
(defmacro rotatef-if (predicate &rest places)
(let ((vars-form-var-set-acc
(loop repeat (length places) collect
(list (gensym) (gensym) (gensym) (gensym) (gensym)))))
`(progn
,@(loop for vals in vars-form-var-set-acc
for p in places collect
`(multiple-value-bind ,vals
(get-setf-expansion ,p))))))
But of course it doesn't work:
CL-USER> (macroexpand-1 '(rotatef-if #'< (elt t 1) (elt t 2) (elt t
3)))
(PROGN
(MULTIPLE-VALUE-BIND (#:G1647 #:G1648 #:G1649 #:G1650 #:G1651)
(GET-SETF-EXPANSION (ELT T 1)))
(MULTIPLE-VALUE-BIND (#:G1652 #:G1653 #:G1654 #:G1655 #:G1656)
(GET-SETF-EXPANSION (ELT T 2)))
(MULTIPLE-VALUE-BIND (#:G1657 #:G1658 #:G1659 #:G1660 #:G1661)
(GET-SETF-EXPANSION (ELT T 3))))
because of the extra ')' after each place... how can I fix it?
I *think* that if I can solve this, the rest should be easy... I think
:)
Thank you,
Luis.
LuisGLopez wrote:
>
> Now I'm trying to get it more general; I would like it to be able to
> rotate n places (like rotatef). But it's tough...
>
> I'm trying to get this part first:
>
> (multiple-value-bind (vars1 form1 var1 set1 acc1)
> (get-setf-expansion place1)
> (multiple-value-bind (vars2 form2 var2 set2 acc2)
> (get-setf-expansion place2)
> ...and so on for place3...placen.
>
Hi!!!
I'm *very* excited! I think I found a way!!!
(defmacro rotatef-if (predicate &rest places)
(let ((vals (loop repeat (length places) collect (gensym))))
`(let (,@(loop for v in vals
for p in places collect `(,v ,p)))
(when (funcall ,predicate ,@vals)
(rotatef ,@places)
t))))
I think that the *get-setf-expansion* stuff was too much for the
problem I had; after being stuck with it all this time i just *saw*
this other solution. :-)
Luis.
LuisGLopez wrote:
> Hi!!!
>
> I'm *very* excited! I think I found a way!!!
>
> (defmacro rotatef-if (predicate &rest places)
> (let ((vals (loop repeat (length places) collect (gensym))))
> `(let (,@(loop for v in vals
> for p in places collect `(,v ,p)))
> (when (funcall ,predicate ,@vals)
> (rotatef ,@places)
> t))))
Never mind; it's an obvious case of leaky-macro:
CL-USER> (macroexpand-1 '(rotatef-if #'< (elt t (incf i)) (elt t (decf
j))))
(LET ((#:G1725 (ELT T (INCF I))) (#:G1726 (ELT T (DECF J))))
(WHEN (FUNCALL #'< #:G1725 #:G1726)
(ROTATEF (ELT T (INCF I)) (ELT T (DECF J)))
T))
:(
I'll keep trying with *get-setf-expansion*... :)
One question: Where can I find info about how 'standard' macros like
*rotatef* are written? Examples? Thank you!!!
Luis.
LuisGLopez wrote:
>>I'm *very* excited! I think I found a way!!!
>>
>>(defmacro rotatef-if (predicate &rest places)
>> (let ((vals (loop repeat (length places) collect (gensym))))
>> `(let (,@(loop for v in vals
>> for p in places collect `(,v ,p)))
>> (when (funcall ,predicate ,@vals)
>> (rotatef ,@places)
>> t))))
>
>
> Never mind; it's an obvious case of leaky-macro:
>
> CL-USER> (macroexpand-1 '(rotatef-if #'< (elt t (incf i)) (elt t (decf
> j))))
> (LET ((#:G1725 (ELT T (INCF I))) (#:G1726 (ELT T (DECF J))))
> (WHEN (FUNCALL #'< #:G1725 #:G1726)
> (ROTATEF (ELT T (INCF I)) (ELT T (DECF J)))
> T))
>
> :(
>
> I'll keep trying with *get-setf-expansion*... :)
You already discovered that your macro suffers from multiple evaluation.
(By the way, you can't use T as the name of a variable!)
I wound up with the same problem basing my version on the CLHS note
about ROTATEF:
http://www.lispworks.com/documentation/HyperSpec/Body/m_rotate.htm
I came up with this:
(defmacro rotatef-if (predicate &rest places)
`(when (funcall ,predicate ,@places)
(psetf ,@(mapcan #'list places (append (rest places) (list (first
places)))) )))
(macroexpand '(rotatef-if #'< (first l) (second l) (third l))) =>
(WHEN (FUNCALL #'< (FIRST L) (SECOND L) (THIRD L))
(PSETF (FIRST L) (SECOND L) (SECOND L) (THIRD L) (THIRD L) (FIRST L)))
Mine's broken too...
>
> One question: Where can I find info about how 'standard' macros like
> *rotatef* are written? Examples? Thank you!!!
>
As you can see from CLHS, there are certain equivalences presented on
some pages. You can also learn quite a bit from MACROEXPAND(-1).
Aloha,
David Sletten
"LuisGLopez" <············@gmail.com> wrote in message
····························@f14g2000cwb.googlegroups.com...
>
> All I could get is this:
>
> (defmacro rotatef-if (predicate &rest places)
> (let ((vars-form-var-set-acc
> (loop repeat (length places) collect
> (list (gensym) (gensym) (gensym) (gensym) (gensym)))))
> `(progn
> ,@(loop for vals in vars-form-var-set-acc
> for p in places collect
> `(multiple-value-bind ,vals
> (get-setf-expansion ,p))))))
>
> But of course it doesn't work:
>
> CL-USER> (macroexpand-1 '(rotatef-if #'< (elt t 1) (elt t 2) (elt t
> 3)))
> (PROGN
> (MULTIPLE-VALUE-BIND (#:G1647 #:G1648 #:G1649 #:G1650 #:G1651)
> (GET-SETF-EXPANSION (ELT T 1)))
> (MULTIPLE-VALUE-BIND (#:G1652 #:G1653 #:G1654 #:G1655 #:G1656)
> (GET-SETF-EXPANSION (ELT T 2)))
> (MULTIPLE-VALUE-BIND (#:G1657 #:G1658 #:G1659 #:G1660 #:G1661)
> (GET-SETF-EXPANSION (ELT T 3))))
>
> because of the extra ')' after each place... how can I fix it?
>
The recursion is not necessary in this case, something like:
(defmacro rotatef-if(predicate &rest places)
(let ((expansions
(loop for x in places collect
(multiple-value-bind (vars vals store writer reader)
(get-setf-expansion x)
(list vars vals reader (gensym))))))
`(let* ,(mapcan (lambda (expansion)
`(,@(mapcar #'list (first expansion) (second
expansion))
(,(fourth expansion) ,(third expansion))))
expansions)
(when (apply ,predicate ,(mapcar #'fourth expansions))
(rotatef ,@places)))))
Untested and it can probably be cleaned up a bit, though. :-)
---
Geoff
Geoffrey Summerhayes wrote:
> The recursion is not necessary in this case, something like:
>
> (defmacro rotatef-if(predicate &rest places)
> (let ((expansions
> (loop for x in places collect
> (multiple-value-bind (vars vals store writer reader)
> (get-setf-expansion x)
> (list vars vals reader (gensym))))))
> `(let* ,(mapcan (lambda (expansion)
> `(,@(mapcar #'list (first expansion) (second
> expansion))
> (,(fourth expansion) ,(third expansion))))
> expansions)
> (when (apply ,predicate ,(mapcar #'fourth expansions))
> (rotatef ,@places)))))
>
Dear Geoffrey,
It works *great*! You are absolutely right: there was *no* need for
'nesting' all those *multiple-value-bind* ; now I see it. :)
Thank you very much!!!
Luis.
"LuisGLopez" <············@gmail.com> wrote in message ····························@g44g2000cwa.googlegroups.com...
>
> Geoffrey Summerhayes wrote:
>> The recursion is not necessary in this case, something like:
>>
>> (defmacro rotatef-if(predicate &rest places)
>> (let ((expansions
>> (loop for x in places collect
>> (multiple-value-bind (vars vals store writer reader)
>> (get-setf-expansion x)
>> (list vars vals reader (gensym))))))
>> `(let* ,(mapcan (lambda (expansion)
>> `(,@(mapcar #'list (first expansion) (second
>> expansion))
>> (,(fourth expansion) ,(third expansion))))
>> expansions)
>> (when (apply ,predicate ,(mapcar #'fourth expansions))
>> (rotatef ,@places)))))
>>
>
> Dear Geoffrey,
>
> It works *great*! You are absolutely right: there was *no* need for
> 'nesting' all those *multiple-value-bind* ; now I see it. :)
>
Actually it doesn't work quite right yet.
The problem is that each reader and writer is used twice,
once in the ROTATEF-IF expansion and then inside the ROTATEF
expansion. Think of (ELT X (INC I)) as a place.
I can't think of a cleaner way to build it, so...
(defun rotatef-if-helper(place-list)
(let ((forms (list nil nil nil nil))) ;let temps write-vals writers
(dolist (place place-list)
(multiple-value-bind (vars vals store-vars writer reader)
(get-setf-expansion place)
(mapc (lambda (var val)
(push (list var val) (first forms)))
vars vals)
(let ((test (gensym)))
(push test (second forms))
(push (list test reader) (first forms))
(push writer (fourth forms))
(push (car store-vars) (third forms)))))
(apply #'values (mapcar #'nreverse forms))))
(defmacro rotatef-if(predicate &rest places)
(multiple-value-bind (let temps write-vals writers)
(rotatef-if-helper places)
`(let* ,let
(when (,predicate ,@temps)
(setf ,@(mapcan #'list write-vals
(append (rest temps)
(list (first temps)))))
,@writers))))
*PHEW!*
Which leaves the problem of multiple-value setfs...
----
Geoff