RE: macros vs. blocks

[Guy Steele - Sun Microsystems Labs <address@hidden>]

Here's another macro that would be hard to do with just
closures and reference parameters.  It's also reeeeally
hard to do in C, because C doesn't have a very good
representation for program fragments (just strings)
and doesn't even have good ways for a macro to pick
apart that representation.  So I'll have to conduct the
example in Lisp only.

The goal is to have something that looks like a function
that takes a (numerical) function as an argument and finds
its roots, or a root.  Something like this:

 (findroots (lambda (a) (* (sin a) (+ a (* 3 a)))))

There are various ways this can be done.  But for our purposes,
we wish to implement this in terms of a function "newton"
that takes two arguments, both of which are numerical functions,
where the second argument implements the derivative of the
first argument.  So, for example,

  (newton (lambda (x) (* 3 x)) (lambda (x) 3))

would return the root of the linear equation y = 3*x, and

  (newton #'sin #'cos)

would return a root (or all the roots :-) of the function "sin".

To save the programmer the trouble of writing out, or even
figuring out, the derivative of the function in question,
we will code "findroots" as a macro and require that it be given
an actual lambda expression, not just the name of a function.

(defmacro findroots (lx)
  (let ((var (first (second lx)))
	(body (third lx)))
    (labels ((diff (e v)
		   (cond ((atom e)
			  (if (eq e v) 1 0))
			 ((eq (first e) '+)
			  `(+ ,(diff (second e) v) ,(diff (third e) v)))
			 ((eq (first e) '-)
			  (if (null (rest (rest e)))
			      `(- ,(diff (second e) v))
			    `(- ,(diff (second e) v) ,(diff (third e) v))))
			 ((eq (first e) '*)
			  `(+ (* ,(diff (third e) v) ,(second e))
			      (* ,(diff (second e) v) ,(third e))))
			 ((eq (first e) 'sin)
			  `(* (cos ,(second e)) ,(diff (second e) v)))
			 ((eq (first e) 'cos)
			  `(* (- (sin ,(second e))) ,(diff (second e) v))))))
      `(newton ,lx (lambda (,var) ,(diff body var))))))

What this is doing is tearing apart the lambda expression
symbolically, computing a symbolic derivative, blindly using
all the usual rules one learns in first-semester calculus.
Note that the "labels" construct allows one to locally define
one or more recursive procedures within an expression.

(To clarify the exposition, I have omitted all the error-checking code
that an expert macro programmer would have inserted in the definition
of "findroots" to ensure that the argument to the macro is well-formed.)

The expansion of the macro invocation

  (findroots (lambda (a) (* (sin a) (+ a (* 3 a)))))

is

  (NEWTON (LAMBDA (A) (* (SIN A) (+ A (* 3 A))))
	  (LAMBDA (A) (+ (* (+ 1 (+ (* 1 3) (* 0 A))) (SIN A))
		         (* (* (COS A) 1) (+ A (* 3 A))))))

(as actually computed by "Liquid Common Lisp" version 5.0.3)
and you can see that the second argument to "newton" is indeed
the (completely unsimplified) symbolic derivative of the first
argument.  It is not too difficult to have the macro make some
simplifications as it goes, by using two utility functions
"make-sum" and "make-prod" that check for certain special cases,
such as x+0 = x and x*0 = 0:

(defmacro findroots (lx)
  (let ((var (first (second lx)))
	(body (third lx)))
    (labels ((make-sum (p q)
	       (cond ((and (numberp p) (numberp q)) (+ p q))
		     ((equal p 0) q)
		     ((equal q 0) p)
		     (t `(+ ,p ,q))))
	     (make-prod (p q)
	       (cond ((and (numberp p) (numberp q)) (* p q))
		     ((equal p 0) 0)
		     ((equal q 0) 0)
		     ((equal p 1) q)
		     ((equal q 1) p)
		     (t `(* ,p ,q))))
	     (diff (e v)
		   (cond ((atom e)
			  (if (eq e v) 1 0))
			 ((eq (first e) '+)
			  (make-sum (diff (second e) v) (diff (third e) v)))
			 ((eq (first e) '-)
			  (if (null (rest (rest e)))
			      `(- ,(diff (second e) v))
			    `(- ,(diff (second e) v) ,(diff (third e) v))))
			 ((eq (first e) '*)
			  (make-sum (make-prod (diff (third e) v) (second e))
			      (make-prod (diff (second e) v) (third e))))
			 ((eq (first e) 'sin)
			  (make-prod `(cos ,(second e)) (diff (second e) v)))
			 ((eq (first e) 'cos)
			  (make-prod `(- (sin ,(second e))) (diff (second e) v))))))
      `(newton ,lx (lambda (,var) ,(diff body var))))))

Then expansion of that same macro invocation

  (findroots (lambda (a) (* (sin a) (+ a (* 3 a)))))

is

  (NEWTON (LAMBDA (A) (* (SIN A) (+ A (* 3 A))))
	  (LAMBDA (A) (+ (* 4 (SIN A)) (* (COS A) (+ A (* 3 A))))))

Note that this particular implementation of "findroots" does not
attempt any simplification of the given function itself, nor
any simplification of fragments of that given function in the
derivative; that's why we still see "(+ A (* 3 A))" rather than
"(* 4 A)" in the code.  But it's still a bit prettier (and more
efficient) than before.  It has simplified "(+ 1 (+ (* 1 3) (* 0 A)))"
to "4" and has simplified "(* (COS A) 1)" to "(COS A)".

By the way: to fans of Lisp macros, any macro facility incapable
of this particular application is not the true macro facility.

--Guy