This is a lark.
Given a function: (defun f (...) ...)
You can rewrite that into: (defun-with-cache f (...) ...)
at which point a second call upon f with the same arguments will return the values returned the first time. You can clear the cache by calling. (clear-cache-of-function 'f)
If I was to guess where this is likely to have a bug I'd pick rip- apart-arglist; who's job is to handle &optional, &rest, &keys, etc. If I was to pick the part likely to make the casual reader's brain hurt it would be body of defun-with-cache, which was pure fun to write.
It's fine if F returns multiple values.
This does what I need in the code where I'm using it, so "I think I'm happy."
- ben
(defun rip-apart-arglist (arglist) (loop with binds = nil with call = nil with apply? = nil with keys? = nil finally (return (values (nreverse binds) (if apply? (nreverse (cons apply? call)) (nreverse call)) apply?)) for arg in arglist do (flet ((accumulate (var) (push var binds) (when (eq t apply?) (setf apply? var) (return-from accumulate)) (when keys? (push (intern (symbol-name var) *keywork-package*) call)) (push var call))) (cond ((consp arg) (accumulate (first arg))) ((eq arg '&aux) (finish)) ((eq arg '&rest) (setf apply? t)) ((eq arg '&optional) (setf apply? t)) ((eq arg '&allow-other-keys) (setf apply? t)) ((eq arg '&key) (setf keys? t)) ((symbolp arg) (accumulate arg))))))
(defmacro cache-of-function (function-name) `(get ,function-name :cache-of-function))
(defun clear-cache-of-function (function-name) (clrhash (cache-of-function function-name)))
(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)))))))))))))