chiark / gitweb /
optparse: Make enum opthandler take an evaluated list.
[lisp] / collect.lisp
... / ...
CommitLineData
1;;; -*-lisp-*-
2;;;
3;;; $Id$
4;;;
5;;; Collecting things into lists
6;;;
7;;; (c) 2005 Straylight/Edgeware
8;;;
9
10;;;----- Licensing notice ---------------------------------------------------
11;;;
12;;; This program is free software; you can redistribute it and/or modify
13;;; it under the terms of the GNU General Public License as published by
14;;; the Free Software Foundation; either version 2 of the License, or
15;;; (at your option) any later version.
16;;;
17;;; This program is distributed in the hope that it will be useful,
18;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;;; GNU General Public License for more details.
21;;;
22;;; You should have received a copy of the GNU General Public License
23;;; along with this program; if not, write to the Free Software Foundation,
24;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
25
26(defpackage #:collect
27 (:use #:common-lisp #:mdw.base)
28 (:export #:collecting #:with-collection #:collect #:collect-tail))
29(in-package collect)
30
31(eval-when (:compile-toplevel :load-toplevel)
32 (defvar *collecting-anon-list-name* (gensym)
33 "The default name for anonymous `collecting' lists.")
34 (defun make-collector ()
35 (let ((head (cons nil nil)))
36 (setf (car head) head))))
37
38(defmacro collecting (vars &body body)
39 "Collect items into lists. The VARS are a list of collection variables --
40 their values are unspecified, except that they may be passed to `collect'
41 and `collect-tail' If VARS is empty then *collecting-anon-list-name* is
42 used. VARS may be an atom instead of a singleton list. The form produces
43 multiple values, one for each list constructed."
44 (cond ((null vars) (setf vars (list *collecting-anon-list-name*)))
45 ((atom vars) (setf vars (list vars))))
46 `(let ,(mapcar (lambda (v) `(,v (make-collector))) vars)
47 ,@body
48 (values ,@(mapcar (lambda (v) `(the list (cdr ,v))) vars))))
49
50(defmacro with-collection (vars collection &body body)
51 "Collect items into lists VARS according to the form COLLECTION; then
52 evaluate BODY with VARS bound to those lists."
53 `(multiple-value-bind
54 ,(listify vars)
55 (collecting ,vars ,collection)
56 ,@body))
57
58(defmacro collect (x &optional (name *collecting-anon-list-name*))
59 "Add item X to the `collecting' list NAME (or *collecting-anon-list-name*
60 by default)."
61 (with-gensyms new
62 `(let ((,new (cons ,x nil)))
63 (setf (cdar ,name) ,new)
64 (setf (car ,name) ,new))))
65
66(defmacro collect-tail (x &optional (name *collecting-anon-list-name*))
67 "Make item X be the tail of `collecting' list NAME (or
68 *collecting-anon-list-name* by default). It is an error to continue
69 trying to add stuff to the list."
70 `(progn
71 (setf (cdar ,name) ,x)
72 (setf (car ,name) nil)))
73
74;;;----- That's all, folks --------------------------------------------------