1900-2100.lisp

(defun btrees-of-size (n)
  (cond ((= n 1) (list 'leaf))
	((= n 2) (list (cons 'leaf 'leaf)))
	(t (loop for i from 1 to (- n 1)
	      append (loop for j in (btrees-of-size i)
			append  (loop for k in (btrees-of-size (- n i))
				   collect (cons j k)))))))

(defun gen-combos (items n callback &optional accum)
  (cond ((= n 0) (funcall callback accum))
	(t (loop for item in items
	      do (gen-combos items (1- n) callback (cons item accum))))))

(defun tree-reduce (f g null tree)
  (cond ((null tree) null)
	((atom tree) (funcall g tree))
	(t (funcall f
		    (tree-reduce f g null (car tree))
		    (tree-reduce f g null (cdr tree))))))

(defun evaluate (tree ops args)
  (tree-reduce #'(lambda (a b) (funcall (pop ops) a b))
	       #'(lambda (e) (pop args)) nil tree))

(defun pretty-print-tree (tree ops args)
  (tree-reduce #'(lambda (a b) (list (pop ops) a b))
	       #'(lambda (e) (pop args)) nil tree))

(let ((results (make-hash-table)) (ops '(+ - * /)) (trees (btrees-of-size 9)))
  (loop named search for tree in trees
     do (gen-combos ops 8
		    (lambda (combo)
		      (let ((res (handler-case
				     (evaluate tree combo '(1 2 3 4 5 6 7 8 9))
				   (division-by-zero (c) 0))))
			(cond ((and (integerp res) (>= 2100 res 1900))
			       (setf (gethash res results) (cons tree combo))
			       (when (= (hash-table-count results) 201)
				 (return-from search))))))))
  (loop for key being the hash-keys in results using (hash-value value)
     do (format t "~a: ~a~%"
		key
		(pretty-print-tree (car value) (cdr value) '(1 2 3 4 5 6 7 8 9)))))