This has particularly useful when dealing with mapping functions for variously libraries. Not sure whether this falls into the scope of Alexandria or not, but I find myself reaching for it often enough that it would be nice to have.
The other question is whether the plural version is really necessary or whether the singular version could be left out in favour of the plural version. Personally, I've only had use for the singular version.
I've attached a patch that includes docstrings and some tests, but I've placed the implementations inline for easy perusal/discussion.
(defmacro with-collector ((name) &body forms) (with-unique-names (list-head list-tail) `(let* ((,list-head (list nil)) (,list-tail ,list-head)) (flet ((,name (object) (rplacd ,list-tail (setq ,list-tail (list object))) object)) ,@forms (cdr ,list-head)))))
(defmacro with-collectors ((&rest names) &body forms) (let ((name-gensyms (make-gensym-list (length names)))) (labels ((%expand-collectors (names name-gensyms) (if names `(setf ,(car name-gensyms) (with-collector (,(car names)) ,(%expand-collectors (cdr names) (cdr name-gensyms)))) `(progn ,@forms)))) `(let ,name-gensyms ,(%expand-collectors names name-gensyms) (values ,@name-gensyms)))))
Basic usage is simply:
(with-collector (collect) (dotimes (x 4) (collect x)))
=> '(0 1 2 3)
Regards,
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)))
CLISP has the similar EXT:WITH-COLLECT. ASDF 1.630 has a similar WHILE-COLLECTING (taken from FARE-UTILS) with identical specification:
(defmacro while-collecting ((&rest collectors) &body body) (let ((vars (mapcar #'(lambda (x) (gensym (symbol-name x))) collectors)) (initial-values (mapcar (constantly nil) collectors))) `(let ,(mapcar #'list vars initial-values) (flet ,(mapcar #'(lambda (c v) `(,c (x) (push x ,v))) collectors vars) ,@body (values ,@(mapcar #'(lambda (v) `(nreverse ,v)) vars))))))
At ITA, we use a slightly more elaborate variant that allows to peek at the list being created (which is admittedly seldom used). I copied the relevant section of our quux/macros.lisp below.
[ François-René ÐVB Rideau | Reflection&Cybernethics | http://fare.tunes.org ] Resentment is like taking poison and waiting for the other person to die. — Malachy McCourt
(defmacro with-collectors ((&rest collection-descriptions) &body body)
"COLLECTION-DESCRIPTIONS is a list of clauses, each of which is (VARIABLE FUNCTION). The body can call FUNCTION on an argument to add that value to the end of a list kept in the value of VARIABLE. FUNCTION runs in constant time, regardless of the length of the list. Alternatively, a clause can be (PLACE FUNCTION :FREE T), in which case no variable is bound, and FUNCTION (destructively) adds the value to the list already stored in PLACE."
(let ((let-bindings nil) (flet-bindings nil) (object '#:OBJECT) (dynamic-extent-fns nil)) (dolist (collection-description collection-descriptions) (destructuring-bind (collection-place collector-name &key free elem-type) collection-description (let ((tail-name (make-symbol (format nil "~A-TAIL" collection-place)))) (unless free (assert (not (listp collection-place)) () "Unless it is free, the collection name must be a symbol, not ~A~%" collection-place) (push collector-name dynamic-extent-fns)) (setq let-bindings (nconc let-bindings `(,@(unless free `((,collection-place nil))) (,tail-name ,@(if free `((last ,collection-place)) `(())))))) (setq flet-bindings (nconc flet-bindings `((,collector-name (,object) ,@(when elem-type `((check-type ,object ,elem-type))) (setq ,tail-name (if ,tail-name (setf (cdr ,tail-name) (list ,object)) (setf ,collection-place (list ,object))))))))))) `(let (,@let-bindings) (flet (,@flet-bindings) ,@(if dynamic-extent-fns `((declare (dynamic-extent ,@(nreverse (loop for fn in dynamic-extent-fns collect `#',fn)))))) ,@body))))
(defmacro with-unique-collectors ((&key (test '#'eql)) (&rest collection-descriptions) &body body)
"COLLECTION-DESCRIPTIONS is a list of clauses, each of which is (VARIABLE FUNCTION). The body can call FUNCTION on one argument to add that value to the end of a list kept in the value of VARIABLE. FUNCTION runs in constant time, regardless of the length of the list. Alternatively, a clause can be (PLACE FUNCTION :FREE T), in which case no variable is bound, and FUNCTION adds the value to the list already stored in PLACE.
This collects only a single occurrence of each object, using TEST to test the equality."
(let ((let-bindings nil) (flet-bindings nil) (object '#:OBJECT) (dynamic-extent-fns nil)) (dolist (collection-description collection-descriptions) (destructuring-bind (collection-place collector-name &key free elem-type) collection-description (let ((tail-name (make-symbol (format nil "~A-TAIL" collection-place)))) (unless free (assert (not (listp collection-place)) () "Unless it is free, the collection name must be a symbol, not ~A~%" collection-place) (push collector-name dynamic-extent-fns)) (setq let-bindings (nconc let-bindings `(,@(unless free `((,collection-place nil))) (,tail-name ,@(if free `((last ,collection-place)) `(())))))) (setq flet-bindings (nconc flet-bindings `((,collector-name (,object) ,@(when elem-type `((check-type ,object ,elem-type))) (unless (member ,object ,collection-place :test ,test) (setq ,tail-name (if ,tail-name (setf (cdr ,tail-name) (list ,object)) (setf ,collection-place (list ,object)))))))))))) `(let (,@let-bindings) (flet (,@flet-bindings) ,@(if dynamic-extent-fns `((declare (dynamic-extent ,@(nreverse (loop for fn in dynamic-extent-fns collect `#',fn)))))) ,@body))))
;; provides the same semantics as the macro WITH-COLLECT from GNU clisp. ;; See also with-collectors above if you need more control. (defmacro with-collected-results ((&rest collectors) &body body) (loop for c in collectors for l = (gensym "LIST") collect l into collections collect (list l c) into collection-descriptions finally (return `(with-collectors ,collection-descriptions ,@body (values ,@collections)))))
(defmacro collected-values (&rest collect-descriptions) "Each collect-description is (a b). For each collect-description, if a is non-null collect b." (with-gensyms (coll) `(with-collected-results (,coll) ,@(mapcar #'(lambda (c) `(when ,(first c) (,coll ,(second c)))) collect-descriptions))))
On 7 March 2010 13:58, Nikodemus Siivola nikodemus@random-state.net wrote:
I copied the relevant section of our quux/macros.lisp below.
...which means it is not in public domain most likely, and hence not eligible for Alexandria.
Please: do not post code under non-Alexandria compatible license on the list, it confuses things.
This code and more has been published under a MIT style license, and if Alexandria needs it under public domain, I'm sure an official statement from ITA can be obtained in due time (if it matters at all for such trivial code snippets). Besides, I was offering the code more as food for thought in terms of API and implementation than as a proposal for inclusion as is. So indeed, it might be a bad idea to copy/paste carelessly it into Alexandria, but I don't believe it is off-topic either.
Regards,
[ François-René ÐVB Rideau | Reflection&Cybernethics | http://fare.tunes.org ] "As an adolescent I aspired to lasting fame, I craved factual certainty, and I thirsted for a meaningful vision of human life — so I became a scientist. This is like becoming an archbishop so you can meet girls." — Matt Cartmill
On Mon, Mar 8, 2010 at 3:25 AM, John Fremlin john@fremlin.org wrote:
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.
Ah, haven't seen this particular version. It is definitely a lot more flexible. Although, it is telling that the ClozureCL code base doesn't actually uses the extra features (which are actually broken, too). But given the target of inclusion in Alexandria, flexibility is probably a good thing.
The only thing that irks me is the lack of an implicit return value, although both features could be provided for by providing a NIL block so that explicit returns could be used where required.
If folks are more interested in a more general version, I'll put together a working implementation.
On 7 March 2010 18:25, John Fremlin john@fremlin.org wrote:
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)
Heh, that's the same CMUCL heritage COLLECT that SBCL has as well. (At least the docstring is identical, and CMUCL has had COLLECT in it's tree since 1990 at least.)
I'm not strongly opposed to COLLECT, but neither am I a great fan of it.
Cheers,
-- Nikodemus
Nikodemus Siivola nikodemus@random-state.net writes:
On 7 March 2010 18:25, John Fremlin john@fremlin.org wrote:
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)
Heh, that's the same CMUCL heritage COLLECT that SBCL has as well. (At least the docstring is identical, and CMUCL has had COLLECT in it's tree since 1990 at least.)
I'm not strongly opposed to COLLECT, but neither am I a great fan of it.
I have a WITH-BUCKETS pending for inclusion into SBCL because it also provides a :SYNCHRONIZED parameter which would rule it out from inclusion into alexandria. It's not yet lock-free which is the reason I haven't proposed it on the SBCL lists yet. I use WITH-BUCKETS+synchronized for writing test cases involving multiple threads.
Syntax is:
(with-buckets collect-into ((foo :name "foo bucket" :synchronized t)) (dotimes (i N) (make-thread #'(lambda () (sleep (random 1.0)) (collect-into foo i)))) foo)
-T.
alexandria-devel@common-lisp.net
-
Daniel White -
Faré -
John Fremlin -
Nikodemus Siivola -
Tobias C. Rittweiler