I don’t often have this kind of fun.

(defmacro defun-with-cache (name args &body body)
  (multiple-value-bind (binding call apply?)
      (rip-apart-arglist args)
    `(let ((#1=#:cache (make-hash-table :test #'equal)))
      (setf (cache-of-function ',name) #1#)
      (defun ,name ,args
	(flet ((,name ,args ,@body))
	  (let ((#2=#:key (list ,@binding)))
	    (values-list
	     (or (gethash #2# #1#)
		 (setf (gethash #2# #1#)
		       (multiple-value-list
			   ,@(if apply?
				 `((apply #',name ,@call))
				 `((,name ,@call)))))))))))))

As I like to say: “Lisp has plenty of syntax, it just spends it’s syntax dollars to buy different things.”

Just look at the nesting: defmacro, multiple-value-bind, let, setf, defun, flet, let, values-list, or, multiple-value-list, if, and apply; it’s like the parade of the wild and crazy programming constructs. Then you have the the fun going on with punctuation characters: #=:,@’ … and people complain about Perl.

Update:

Ah, the power of many eyes. It’s got a bug. Lambda lists in Common Lisp include the not unusual feature that you can write something like this pattern (x y &optional z) and then the caller can do (f 1 2) or (f 1 2 3). And of course you can specify an default value for the optional arguements i.e. (x y &optional (z -1)). There is an unusual feature in this vicinity though; you can write (x y &optional (z -1 z-provided?)) and then your function will actually have four arguments. The fourth one, z-provided? is bound by the language as a flag telling you if z was defaulted or not.

I like that the code above used an flet to create a version of the function which as it would have been without the caching wrapped around it. But I don’t see a straight forward way to do that if I’m going to handle things like z-provided?. So I got rid of the flet.

(defmacro defun-with-cache (name args &body body)
  "Like defun, but this memoizes the function into a cache that maybe
   latter cleared."
  (multiple-value-bind (binding call)
      (rip-apart-lambda-list args)
    `(let ((#1=#:cache (make-hash-table :test #'equal)))
      (setf (cache-of-function ',name) #1#)
      (defun ,name ,args
	(let ((#2=#:key (list ,@binding)))
	  (values-list
	   (or (gethash #2# #1#)
	       (setf (gethash #2# #1#)
		     (multiple-value-list
			 (progn
			   ,@body))))))))))

That I can’t use an flet in a straight forward way is an unusual breakdown of language symmetry. The need for the apply? flag in the original is analogous, but different.