April 9, 2009

Closure-oriented metaprogramming via dynamically-scoped functions

Today I came across this post from the ll1 mailing list (almost 7 years old now, via Patrick Collison's blog) from Avi Bryant explaining how Smalltalk's message-based dispatch permits a type of metaprogramming with closures, as an alternative to macros.

Of course if you've read Pascal Costanza's Dynamically Scoped Functions as the Essence of AOP (and if you haven't, click the link and do it now; it's one of my favorite CS papers), you will realize that there is no need for message-based dispatch or any kind of object-oriented programming to do that. All we need are dynamically-scoped functions.

Here is how I approached the problem:

(defpackage "BAR"
(:use "COMMON-LISP")
(:shadow #:=))

(in-package "BAR")

(defmacro dflet1 ((fname &rest def) &body body)
(let ((old-f-def (gensym)))
`(let ((,old-f-def (symbol-function ',fname)))
(unwind-protect (progn (setf (symbol-function ',fname) (lambda ,@def))
(setf (symbol-function ',fname) ,old-f-def)))))

(defmacro dflet* ((&rest decls) &body body)
(if decls
`(dflet1 ,(car decls)
(dflet* ,(cdr decls)
`(progn ,@body)))

(defun first-name (x) (gnarly-accessor1 x))
(defun address-city (x) (gnarly-accessor2 x))
(defun = (&rest args) (apply 'common-lisp:= args))
(defmacro & (a b) `(block-and (lambda () ,a) (lambda () ,b)))
(defun block-and (a b) (when (funcall a) (funcall b)))

(defun some-predicate (x)
(& (= (first-name x) "John") (= (address-city x) "Austin")))

(defun make-parse-tree-from-predicate (predicate-thunk)
(dflet* ((first-name (x) '#:|firstName|)
(address-city (x) '#:|addressCity|)
(= (a b) `(= ,a ,b))
(block-and (a b) `(& ,(funcall a) ,(funcall b))))
(funcall predicate-thunk nil)))

Then (make-parse-tree-from-predicate #'some-predicate) yields (& (= #:|firstName| "John") (= #:|addressCity| "Austin")), which we can manipulate and then pass to a SQL query printer.

Here I implemented dynamically-scoped functions using unwind-protect, which is not as powerful (or, possibly, efficient) as the implementation presented in Costanza's paper, but is simpler (I also used the same trick to implement dynamically-scoped variables in Parenscript).

The property of the same Lisp code to mean different things in different contexts is called duality of syntax by Doug Hoyte in his excellent book Let Over Lambda (almost finished reading, promise to write a review soon). Lisp offers this property both at run-time (via late-binding and closures) and at macro-expansion time (via homoiconicity and the macro-expansion process itself).

Another technique from Let Over Lambda illustrated in the above code is the recursive macro. This one is a personal favorite of mine; I find that the iterative simplification that recursive macros express provides very clean and maintainable code.

This code also provides examples of the two problems that the closure-oriented metaprogramming approach encounters in Common Lisp:

The first is the fact that we had to shadow = in our package. Common Lisp forbids the redefinition of the functions, macros and special forms defined in the standard, so we have to go out of our way if we want to achieve that effect. Barry Margolin provided a rationale for this in comp.lang.lisp post.

The second is the fact that Common Lisp has so many special forms and macros - and just happens to be one of them. Smalltalk avoids this problem by doing virtually everything via message passing and closures. In Common Lisp we don't have this straightjacket, but we also don't have this luxury of assuming that everything is an object or a closure.

Another Common Lisp feature that might break this example is function inlining (then again, I did just write about the benefits of late-binding...).


Vsevolod said...

Incidentally I happened to use exactly this approach in unit testing (not think about it being AOP). Here it's a poor man's (or a rich one's -- depends on how you look at it :) stub/mock-machinery. Works fine. Generally, I view it as an obvious example of Peter Norvig's design patterns in programming languages.

Here's the sample code, which I think very clearly illustrates the layered system structure possible with macros:

(defmacro using-dao ((&rest view-classes) &body body)
(w/uniqs (conn-spec old-def)
`(let ((,conn-spec '("localhost" "test2" "test1" "test")))
(w/db-context (,conn-spec ,@view-classes)
(let ((,old-def (fdefinition 'back::std-db-connect)))
(progn (setf (fdefinition 'back::std-db-connect)
(lambda () (clsql:connect ,conn-spec :database-type test::*test-db-type* :if-exists :old :make-default nil)))
(setf (fdefinition 'back::std-db-connect) ,old-def)))))))

(I'm afraid the Blogger's comment formating will spoil all the beauty :)

Vladimir Sedach said...

What is really funny is that the AOP community started getting exactly the same idea about unit testing a few years ago.

You example also illustrates something that I've been saying for a long time now: dynamic scoping completely solves and subsumes the problems that dependency injection (IMO, the dumbest fad in object-oriented programming) and service locator patterns are trying to address. It is nice to know that such a simple idea can make pages and pages of crap such as the following completely irrelevant:


Akopa said...

I realize this is a bit orthogonal to dynamic dispatch that is going on, but one thing that this implementation doesn't do, and most implementations written in Lisp wouldn't do is perform the dispatch with no functions at all.

In the smalltalk version there are no explicit accessor methods; it's all handled by #doesNotUnderstand:.

This is not generally possible* in Lisp because you need at least the (generic) function to be defined.

*Unless your implementation provides a use-value or store-value restart for the 'undefined-function condition.

Vladimir Sedach said...

Dealing with undefined functions programmatically in CL is hairy; I remember Geoff Wozniak did some work on it:


But the problem runs deeper than that - you'd have to know which functions might be defined and which ones aren't.

In the Smalltalk example the object receiving all those messages acts as the environment in which they're looked up, which is why you can do the #doesNotUnderstand: trick.

The real Lisp equivalent would be to dynamically bind apply to do the same thing as #DoesNotUnderstand: in the Smalltalk example (that is, build the parse tree from the message [arguments to apply]).

Unfortunately Common Lisp is not late-bound enough to let you do this.

gruseom said...

I had a need for this behavior while doing some unit testing today and happened to remember this post. It's exactly what I needed.

The case where this came up is relatively rare. I have some rather complex code (an R*-tree implementation, for the curious) the core of which is a set of four functions (call them A,B,C,D) that are mutually recursive. Because the pieces are complex, it's desirable to test them in isolation, but this is hard to do because they all depend on each other. The solution is, in the tests that focus on A, to swap out B,C,D for simple stubs, and similarly for the rest. This is much better than other strategies, such as passing in functions as arguments or defining generic functions, that would further complicate the production code just in order to test it.

Normally I avoid this kind of thing but when it's truly needed it's super useful.