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

[lisp] / mdw-base.lisp

diff --git a/mdw-base.lisp b/mdw-base.lisp
index 88ef8bae5f45cec84e646609dbb0fa9f7e350a9f..ffda8c0e4770bed3dea8df86580c3f33fc9e56ab 100644 (file)
--- a/mdw-base.lisp
+++ b/mdw-base.lisp
@@ -31,7 +31,8 @@ (defpackage #:mdw.base
   (:export #:unsigned-fixnum
           #:compile-time-defun
           #:show
   (: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
           #:whitespace-char-p
           #:slot-uninitialized
           #:nlet #:while #:until #:case2 #:ecase2 #:setf-default


@@ -151,6 +152,17 @@ (compile-time-defun parse-body (body &key (allow-docstring-p t))
                                 (and decls (list (cons 'declare decls)))
                                 forms))))))))
 
                                 (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))
 #-cmu
 (progn
   (declaim (inline fixnump))