Saturday, June 18

Lisp, the language that does your coding for you..

Well, not quite - but almost. After reading Rogue Malcontents nifty post where he uses macros to wrap simple-arrays with structure - like syntax (very handy for interacting with APIs like OpenGL), I went back and looked at my code with a fresh eye. I found I was writing lots of forms like this :-




(red (get-red p0) (funcall red-interpolator))
(blue (get-blue p0) (funcall blue-interpolator))
(green (get-green p0) (funcall green-interpolator))
(alpha (get-alpha p0) (funcall alpha-interpolator))


..where the same form was wrapped around each colour channel of a pixel. So I thought "Hmm, time for a macro". My first attempt was something like this:



(defmacro with-pixel-colour-list (body)
(list
`list
(replace-symbol 'get-pixel 'get-red body)
(replace-symbol 'get-pixel 'get-blue body)
(replace-symbol 'get-pixel 'get-green body)
(replace-symbol 'get-pixel 'get-alpha body)))


Where replace-symbol was a utility function of my own devising which car'd its way through a form, replacing a matching symbol as it went - given here for completeness. So the form fed to with-pixel-colour list gets replicated four times - the first time with the get-pixel call replaced with a get-red call, the second time get-pixel replaced by a get-green call, and so forth. So I only have to write one form once, rathte than four times, and the compiler does the rest of the work for me, macro-expanding the code before compiling it.



(eval-when (:compile-toplevel :load-toplevel :execute)
(defun replace-symbol (sym1 sym2 list)
(cond
((null list)
nil)
((null (car list))
(replace-symbol sym1 sym2 (cdr list)))
((symbolp (car list))
(if (string= (symbol-name sym1) (symbol-name (car list)))
(cons sym2 (replace-symbol sym1 sym2 (cdr list)))
(cons (car list) (replace-symbol sym1 sym2 (cdr list)))))
((listp (car list))
(cons (replace-symbol sym1 sym2 (car list))
(replace-symbol sym1 sym2 (cdr list))))
(t (cons
(car list)
(replace-symbol sym1 sym2 (cdr list)))))))


So, (with-pixel-colours *my-pixel*) expands nicely to (LIST (GET-RED *MY-PIXEL*) (GET-BLUE *MY-PIXEL*) (GET-GREEN *MY-PIXEL*) (GET-ALPHA *MY-PIXEL*)) and I can write things like:



(defun sum-colours (pixel)
(apply #'+ (with-pixel-colours (get-pixel pixel))))

(setf *my-pixel* (make-pixel 1 1 1 0))


(sum-colours *my-pixel*)


3



Fantastic - but there has to be a wider application than this - so my next task was to generalise it a bit. More in the next post. :)



I do get the feeling I'm re-inventing a well known technique, as I'm a newbie, and this kind of thing is just too useful. Any experienced Lisp coders care to comment?