Here is how ClozureCL does the same thing. I'm not at all suggesting that it's better than with-collector, just that it is another example of this useful wheel being invented.
My opinion is that something along these lines would be grand.
;;; Copyright (C) 2009 Clozure Associates ;;; Copyright (C) 1994-2001 Digitool, Inc ;;; Clozure CL is licensed under the terms of the Lisp Lesser GNU Public ;;; License
;;; ;;; The ultimate collection macro... ;;;
(defmacro collect (collections &body body) "Collect ({(Name [Initial-Value] [Function])}*) {Form}* Collect some values somehow. Each of the collections specifies a bunch of things which collected during the evaluation of the body of the form. The name of the collection is used to define a local macro, a la MACROLET. Within the body, this macro will evaluate each of its arguments and collect the result, returning the current value after the collection is done. The body is evaluated as a PROGN; to get the final values when you are done, just call the collection macro with no arguments.
Initial-Value is the value that the collection starts out with, which defaults to NIL. Function is the function which does the collection. It is a function which will accept two arguments: the value to be collected and the current collection. The result of the function is made the new value for the collection. As a totally magical special-case, the Function may be Collect, which tells us to build a list in forward order; this is the default. If an Initial-Value is supplied for Collect, the stuff will be rplacd'd onto the end. Note that Function may be anything that can appear in the functional position, including macros and lambdas."
(let ((macros ()) (binds ())) (dolist (spec collections) (unless (<= 1 (length spec) 3) (signal-program-error "Malformed collection specifier: ~S." spec)) (let ((n-value (gensym)) (name (first spec)) (default (second spec)) (kind (or (third spec) 'collect)))
(push `(,n-value ,default) binds) (if (eq kind 'collect) (let ((n-tail (gensym))) (if default (push `(,n-tail (last ,n-value)) binds) (push n-tail binds)) (push `(,name (&rest args) (collect-list-expander ',n-value ',n-tail args)) macros)) (push `(,name (&rest args) (collect-normal-expander ',n-value ',kind args)) macros)))) `(macrolet ,macros (let* ,(nreverse binds) (declare (ignorable ,@binds)) ,@body))))
;;; Collect-List-Expander -- Internal ;;; ;;; This function deals with the list collection case. N-Tail is the pointer ;;; to the current tail of the list, which is NIL if the list is empty. ;;; (defun collect-list-expander (n-value n-tail forms) (let ((n-res (gensym))) `(progn ,@(mapcar #'(lambda (form) `(let ((,n-res (cons ,form nil))) (cond (,n-tail (setf (cdr ,n-tail) ,n-res) (setq ,n-tail ,n-res)) (t (setq ,n-tail ,n-res ,n-value ,n-res))))) forms) ,n-value)))