Merge branch 'master' of /home/mdw/public-git/lisp

* 'master' of /home/mdw/public-git/lisp:
  base: with-parsed-body, different interface.
  collect: Provide functional interface for collectors.

diff --combined mdw-base.lisp
index 88ef8ba,23bb4ef..ffda8c0
--- 1/mdw-base.lisp
--- 2/mdw-base.lisp
+++ b/mdw-base.lisp
@@@ -31,7 -31,8 +31,8 @@@
    (:export #:unsigned-fixnum
           #:compile-time-defun
           #:show
-          #:stringify #:mappend #:listify #:fix-pair #:pairify #:parse-body
+          #:stringify #:mappend #:listify #:fix-pair #:pairify
+          #:parse-body #:with-parsed-body
           #:whitespace-char-p
           #:slot-uninitialized
           #:nlet #:while #:until #:case2 #:ecase2 #:setf-default
@@@ -80,7 -81,8 +81,7 @@@
    (typecase str
      (string str)
      (symbol (symbol-name str))
 -    (t (with-output-to-string (s)
 -       (princ str s)))))
 +    (t (princ-to-string str))))
  
  (defun mappend (function list &rest more-lists)
    "Apply FUNCTION to corresponding elements of LIST and MORE-LISTS, yielding
@@@ -118,12 -120,9 +119,12 @@@
  (defun whitespace-char-p (ch)
    "Return whether CH is a whitespace character or not."
    (case ch
 -    ((#\space #\tab #\newline #\return #\vt
 -            #+cmu #\formfeed
 -            #+clisp #\page) t)
 +    (#.(loop for i below char-code-limit
 +           for ch = (code-char i)
 +           unless (with-input-from-string (in (string ch))
 +                    (peek-char t in nil))
 +           collect ch)
 +       t)
      (t nil)))
  
  (declaim (ftype (function nil ()) slot-unitialized))
@@@ -151,6 -150,17 +152,17 @@@
                                 (and decls (list (cons 'declare decls)))
                                 forms))))))))
  
+ (defmacro with-parsed-body
+     ((bodyvar declvar &optional (docvar (gensym) docp)) form &body body)
+   "Parse FORM into a body, declarations and (maybe) a docstring; bind BODYVAR
+    to the body, DECLVAR to the declarations, and DOCVAR to (a list
+    containing) the docstring, and evaluate BODY."
+   `(multiple-value-bind
+        (,docvar ,declvar ,bodyvar)
+        (parse-body ,form :allow-docstring-p ,docp)
+      ,@(if docp nil `((declare (ignore ,docvar))))
+      ,@body))
+ 
  #-cmu
  (progn
    (declaim (inline fixnump))