- 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)))))
+ using `@,'. If ALLOW-DOCSTRING-P is nil, docstrings aren't allowed at
+ all."
+ (let ((doc nil) (decls nil))
+ (do ((forms body (cdr forms))) (nil)
+ (let ((form (and forms (car forms))))
+ (cond ((and allow-docstring-p (not doc) (stringp form) (cdr forms))
+ (setf doc form))
+ ((and (consp form)
+ (eq (car form) 'declare))
+ (setf decls (append decls (cdr form))))
+ (t (return (values (and doc (list doc))
+ (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))
+ (defun fixnump (object)
+ "Answer non-nil if OBJECT is a fixnum, or nil if it isn't."
+ (typep object 'fixnum)))