Sunday, 16 December 2007

Python decorators in Lisp, Part 2

So in this earlier post, I suggested that I was envious of Python's decorator syntax and wondered if it was possible to do in Lisp. The answer was most undoubtedly yes, and it took the following form:

CL-USER> #@(lambda (fn) (lambda (&rest args) (print "in-lambda")(apply fn args)))
#@(synchronized "with-this-lock")
(defun this-function () (print "this-function"))
CL-USER> (this-function)
"Obtaining lock with-this-lock"
"Releasing lock with-this-lock"

The Lisp solution is more flexible, although that flexibility (being able to use lambda functions) is probably unwarranted.

The fundamental component of program compilation or interpretation is the Lisp reader. It is responsible for parsing representations of objects producing objects. So when an object has a non-readable representation, that means it cannot be reconstructed in this manner. For more information on the algorithm, see the relevant ultra hyperlinked hyperspec.

The Lisp reader reads one character at a time from the input stream. Big surprise. The interesting part that makes the above possible is that you can redefine what the reader does when it encounters certain characters. This dispatch information is stored in what is known as a readtable. The current readtable, the readtable being used for dispatch when reading, is stored in the dynamic variable *readtable*. So, to modify the readtable for a subset of code, all you need to do is rebind this variable within that block of code.

The hook into the Lisp reader that I used is set-dispatch-macro-character. Among other parameters, this function takes in two characters and a function to call when the reader encounters these characters. For some reason, I decided that I wanted #@ to be the dispatch pair for the decorator implementation. I suppose I could just as easily have used set-macro-character and dispatched on @. I leave that as an exercise to the reader (if you are still reading!)

So just like when dealing with macros, it helps to write out what code you want generated. In this case, given the input:

#@(another-decorator 5)
#@(lambda (fn) (lambda (&rest args) (apply fn args)))
(defun some-function (x)
(print x))

For better or worse, I would like to generate something close to the following:

(let ((some-function
(funcall (another-decorator 5)
((lambda (fn)
(lambda (&rest args) (apply fn args)))
(lambda (x) (print x)))))))
(defun some-function (x)
(funcall some-function x)))

That is, essentially just keep creating decorator functions and call them in the order they are listed until you get to the decorated function.

To get going, I wrote a small function that rebound the readtable to a local copy and set the dispatch function to use:

(defun test-readtable-thing ()
(let ((*readtable* (copy-readtable nil)))
(set-dispatch-macro-character #\# #\@

What this will do is set the read function to call |#@-reader| when #@ is encountered. So now it might help to come up with some algorithm for how the |#@-reader| reader would do it's work:

  1. Parse all the decorator representations (symbol, lambda, function call)

  2. Parse the decorated function

  3. Generate a new function that is created by successive application of each decorator function

Simple enough eh? Except when you have more than one decorator, the reader will call your dispatch function recursively. So we must disable that by temporarily rebinding the dispatch character to a simpler function. After this little tricksy bit, the rest is pretty mechanical. So without further ado, the actual code:

(defun |#@-reader-aux| (s c n)
(declare (ignore c n))
"Reads the function and returns a list with the
first element being hash-at and the second element being
the actual object following #@"
(list 'hash-at (read s t (values) t)))

(defun |#@-reader| (s c n)
(declare (ignore c n))
(let* ((first-decorator (read s t (values) t))
(decorators (list first-decorator))
(*readtable* (copy-readtable nil)))
;; On the first #@ encountered, reset the readtable to use the
;; aux function which does not recur.
(set-dispatch-macro-character #\# #\@
(let* ((decorated-function
(loop do
;; it is a decorator if it is a list
;; form with the first element being
;; hash-at
(let ((x (read s t (values) t)))
(if (and (listp x)
(equal (first x) 'hash-at))
(if (symbolp (second x))
(push `(lambda (fn) (,(second x) fn))
(push (second x) decorators))
(return x)))))
(function-name (second decorated-function))
(function-args (third decorated-function))
(function-body (cdddr decorated-function))
`(lambda ,function-args ,@function-body)))
,(reduce #'(lambda (a b)
`(funcall ,a ,b))
(reverse decorators) :from-end t :initial-value lambda-function)))
(defun ,function-name ,function-args
(funcall the-function ,@function-args))))))

(defun test-readtable-thing ()
(let ((*readtable* (copy-readtable nil)))
(set-dispatch-macro-character #\# #\@

Cut and paste into your REPL and have fun with it! If you don't have a REPL, install SBCL for your platform and give it a run. Let me know if it actually works for you, if you try it! :-)

Edit: If you want to play with this as is, the easiest way is to type (test-readtable-thing) into the REPL and use (eval *) to evaluate the output once you take a look at what it generated. You can also use (eval (test-readtable-thing)). I will write a post that shows how to enable it for normal source code soon.

Edit: The code for enabling the syntax in source files is here

No comments: