X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/blobdiff_plain/67cb6748a3e277c0a6bab682aa31249850445226..67b41ed338b6050f40bf9de24804502e96f84104:/mdw-base.lisp

diff --git a/mdw-base.lisp b/mdw-base.lisp
index 072c8d6..ffda8c0 100644
--- a/mdw-base.lisp
+++ b/mdw-base.lisp
@@ -31,7 +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,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
@@ -152,6 +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))