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.