Here’s a screenshot of the GUI I presented in an earlier post, so you can take a look at it without installing LTK:

Screenshot of CL-Sudoku

CL-Sudoku's LTK GUI, displaying its solutions to an empty puzzle

(This is from the latest version that you can find at Bitbucket, not from the one posted here.)

This is just a little follow-up to my last post. As another exercise in continuations, I transformed tree->generator to explicit continuation-passing style. I guess I could also have looked at the expansions of the cl-cont macros, but this is the result of a manual transformation:

(defun tree->generator (tree)
  (let (generate-leaves)
    (setf generate-leaves
	  (lambda ()
	    (labels ((recur (tree cont)
		       (cond ((null tree) ; empty leaf: continue.
			      (funcall cont))
			     ((consp tree) ; recurse into branches:
			      (recur (car tree)
				     (lambda ()
				       (recur (cdr tree) cont))))
			     ('otherwise ; leaf with a value:
			      (setf generate-leaves ; update generator
				    cont)
			      tree))))	      ; and return the value.
	      (recur tree
		     (lambda () nil))))) ; return nil after exhaustion.
    (lambda ()
      (funcall generate-leaves))))

[EDIT: I realized the potential for further simplification right after publishing the post. So now the call to and return from generate-leaves in the above code aren’t in CPS anymore, only recur has to be in CPS.]

I’ve decided to try Slava Akhmechet’s cl-cont, a continuations library for Common Lisp. My little example for this purpose was to port the tree->generator function from Teach Yourself Scheme in Fixnum Days to Common Lisp. This function takes a tree and returns a function that will successively yield the leaves of the tree.

Here’s the code:

(defun/cc tree->generator (tree)
  (let (generate-leaves)
    (setf generate-leaves
	  (lambda (caller)
	    (labels ((recur (tree)
		       (cond ((null tree))  ; empty leaf: continue
			     ((consp tree)  ; recurse into branches
			      (recur (car tree))
			      (recur (cdr tree)))
			     ('otherwise ; leaf with a value:
			      (call/cc
			       (lambda (rest-of-tree)
				 ;; update generator
				 (setf generate-leaves
				       (lambda (new-caller)
					 (setf caller new-caller)
					 (funcall rest-of-tree)))
				 ;; return the value
				 (funcall caller tree)))))))
	      (recur tree))
	    (funcall caller nil)))     ; return value after exhaustion
    (lambda ()
      (call/cc generate-leaves))))

The comments are my own, so I could understand how this function works. I did also add the explicit caller argument to generate-leaves, keeping variables as local as possible is generally a good thing (and I didn’t like those dummy values). These changes aren’t specific to CL, I did a Scheme version with those too.

There was one problem that took me quite some time to solve: (SETF SYMBOL-FUNCTION) will always operate on the global binding, so I couldn’t use LABELS to define generate-leaves. Therefore, I had to use this trick of splitting the definition into a LET and a SETF to get a local function definition that could modify its own binding. In contrast, porting the continuations stuff was easy: that worked just like in Scheme.

Here’s a little usage example:

CL-USER> (defparameter *g* (tree->generator '((1 2) (3 (4 5)))))
*G*
CL-USER> (funcall *g*)
1
CL-USER> (funcall *g*)
2
CL-USER> (funcall *g*)
3
CL-USER> (funcall *g*)
4
CL-USER> (funcall *g*)
5
CL-USER> (funcall *g*)
NIL