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?