People have often told me I could use some advice. I say “but I use it all the time”. Ba da bing.
Humor aside, the Common Lisp Advice Facility lets you wrap (and unwrap) new code around old code dynamically even if you don’t have the source for the old code. This is an incredible feature for doing all kinds of useful things. (It’s also an amazing feature for tying yourself up in a maze of little passages, all alike. In other words, “with great power comes great power, so be careful.”
It can be nice to know how many times a function has been called, that’s why profilers usually allow you to get call counts! Sometimes, however, going through the trouble of messing with a profiler and getting its information back out in a useful fashion is more trouble that seems necessary. Enter with-call-counts. The complete code is below (though it relies on Franz’s (excellent) fwrapper machinery, the idea is the same).
;; a bizarre hack in search of a dream
;; It's a lot of machinery to count a single functions calls... but it's cool!
(defvar *call-counter* (make-hash-table))
(excl:def-fwrapper call-counter (&rest args)
(declare (ignorable args)
(dynamic-extent args))
(%count-call (%find-call-counting-spot excl::primary-function))
(excl:call-next-fwrapper))
(defun start-call-counting (function &optional (reset? nil))
(bind ((spot (%find-call-counting-spot function)))
(setf (second spot) t)
(when reset? (reset-call-counting function))
(excl:fwrap function :call-counter 'call-counter)))
(defun reset-call-counting (function)
(setf (first (%find-call-counting-spot function)) 0))
(defun stop-call-counting (function)
(setf (second (%find-call-counting-spot function)) nil)
(excl:funwrap function :call-counter))
(defun call-counts (function)
(values-list (%find-call-counting-spot function)))
(defun %find-call-counting-spot (function)
(setf function (coerce function 'function))
(bind (((values spot found?) (gethash function *call-counter*)))
(if found?
spot
(setf (gethash function *call-counter*) (list 0 nil)))))
(defun %count-call (spot)
(incf (car spot)))
(defmacro with-call-count ((function &key (resetp t)) &body body)
(with-gensyms (gfunction gresetp)
`(let ((,gfunction ,function)
(,gresetp ,resetp))
(unwind-protect
(progn
(start-call-counting ,gfunction ,gresetp)
(progn ,@body)
(list (intern ,gfunction :keyword) (call-counts ,gfunction)))
(stop-call-counting ,gfunction)))))
(defmacro with-call-counts (((&rest functions) &key (resetp t)) &body body)
(with-gensyms (gresetp)
(cond ((null functions) `(list :result (progn ,@body)))
(t `(let ((,gresetp ,resetp)
(this nil)
(rest nil))
(setf this
(with-call-count (,(first functions) :resetp ,gresetp)
(setf rest
(with-call-counts (,(rest functions)
:resetp ,gresetp)
,@body))))
(nconc this rest))))))
The with-call-count macro is the heart of the above. Like most macros of this sort, it expands into an unwind-protect and some function calls to turn call counting on and off. The start-call-counting function adds an fwrapper and stop-call-counting removes it. The wrapper itself (created with the excl:def-fwrapper) is simple: it run before the wrapped function and just increments a counter. Finally, the with-call-counts macro expands into multiple applications of with-call-count.
I’m not completely happen with the syntax of the machinery above but I’m happy enough that I’ve used it many times in debugging and testing. It’s nice to be able to:
- ensure that a cache is actually working by counting the number of calls to some inner function with the cache off and on.
- check that some function isn’t being called or that it is!
- check that a binary search is really calling its comparison function the expected number of times.
Because advice makes writing macros like the above easy and because macro like the above make it easy to measure whats happening in your code (without, notice, modifying your code), it’s a big win!