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)))))))))))))
