1 ;;;; functions used to parse function/macro bodies
3 ;;;; FIXME: In an early attempt to bootstrap SBCL, this file
4 ;;;; was loaded before fundamental things like DEFUN and AND and OR
5 ;;;; were defined, and it still bears scars from the attempt to
6 ;;;; make that work. (TAGBODY, forsooth..) It should be cleaned up.
8 ;;;; This software is part of the SBCL system. See the README file for
11 ;;;; This software is derived from the CMU CL system, which was
12 ;;;; written at Carnegie Mellon University and released into the
13 ;;;; public domain. The software is in the public domain and is
14 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
15 ;;;; files for more information.
22 (/show0 "entering parse-body.lisp")
24 ;;; Given a sequence of declarations (and possibly a documentation
25 ;;; string) followed by other forms (as occurs in the bodies of DEFUN,
26 ;;; DEFMACRO, etc.) return (VALUES FORMS DECLS DOC), where DECLS holds
27 ;;; declarations, DOC holds a doc string (or NIL if none), and FORMS
28 ;;; holds the other forms.
30 ;;; If DOC-STRING-ALLOWED is NIL, then no forms will be treated as
31 ;;; documentation strings.
32 (defun sb!sys:parse-body (body &optional (doc-string-allowed t))
33 (let ((reversed-decls nil)
36 ;; Since we don't have macros like AND, OR, and NOT yet, it's
37 ;; hard to express these tests clearly. Giving them names
38 ;; seems to help a little bit.
39 (flet ((doc-string-p (x remaining-forms)
41 (if doc-string-allowed
42 ;; ANSI 3.4.11 explicitly requires that a doc
43 ;; string be followed by another form (either an
44 ;; ordinary form or a declaration). Hence:
47 ;; ANSI 3.4.11 says that the consequences of
48 ;; duplicate doc strings are unspecified.
49 ;; That's probably not something the
50 ;; programmer intends. We raise an error so
51 ;; that this won't pass unnoticed.
52 (error "duplicate doc string ~S" x)
56 (eq (car x) 'declare))))
60 (let ((form1 (first forms)))
61 ;; Note: The (IF (IF ..) ..) stuff is because we don't
62 ;; have the macro AND yet.:-|
63 (if (doc-string-p form1 (rest forms))
65 (if (declaration-p form1)
67 (cons form1 reversed-decls))
69 (setq forms (rest forms))
73 (nreverse reversed-decls)
76 (/show0 "leaving parse-body.lisp")