
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)))))))))))))
participants (1)
-
Ben Hyde