X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/blobdiff_plain/bf0a8c394bdf34895ad53771665f70c3b80e272e..9d3ccec7414eecee223bf9aa045924f2416ff609:/mdw-base.lisp

diff --git a/mdw-base.lisp b/mdw-base.lisp
index bbe7662..1f5a3eb 100644
--- a/mdw-base.lisp
+++ b/mdw-base.lisp
@@ -30,7 +30,7 @@
   (:use #:common-lisp)
   (:export #:compile-time-defun
 	   #:show
-	   #:stringify #:listify #:fix-pair #:pairify
+	   #:stringify #:listify #:fix-pair #:pairify #:parse-body
 	   #:whitespace-char-p
 	   #:slot-uninitialized
 	   #:nlet #:while #:case2 #:ecase2
@@ -105,6 +105,24 @@ where Y defaults to A if not specified."
 structure definitions without doom ensuing."
   (error "No initializer for slot."))
 
+(compile-time-defun parse-body (body)
+  "Given a BODY (a list of forms), parses it into three sections: a
+docstring, a list of declarations (forms beginning with the symbol `declare')
+and the body forms.  The result is returned as three lists (even the
+docstring), suitable for interpolation into a backquoted list using `@,'."
+  (multiple-value-bind
+      (doc body)
+      (if (and (consp body)
+	       (stringp (car body)))
+	  (values (list (car body)) (cdr body))
+	  (values nil body))
+    (loop for forms on body
+	  for form = (car forms)
+	  while (and (consp form)
+		     (eq (car form) 'declare))
+	  collect form into decls
+	  finally (return (values doc decls forms)))))
+
 ;;;--------------------------------------------------------------------------
 ;;; Generating symbols.