From 9d3ccec7414eecee223bf9aa045924f2416ff609 Mon Sep 17 00:00:00 2001 Message-Id: <9d3ccec7414eecee223bf9aa045924f2416ff609.1716923321.git.mdw@distorted.org.uk> From: Mark Wooding Date: Sun, 23 Apr 2006 01:19:04 +0100 Subject: [PATCH] base: New macro for parsing function bodies. Organization: Straylight/Edgeware From: Mark Wooding --- mdw-base.lisp | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) 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 @@ (defpackage #:mdw.base (: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 @@ (defun slot-uninitialized () 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. -- [mdw]