src/code/parse-body.lisp

   1 ;;;; functions used to parse function/macro bodies
   2 ;;;;
   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.
   7
   8 ;;;; This software is part of the SBCL system. See the README file for
   9 ;;;; more information.
  10 ;;;;
  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.
  16
  17 (in-package "SB!INT")
  18
  19 (file-comment
  20  "$Header$")
  21
  22 (/show0 "entering parse-body.lisp")
  23
  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.
  29 ;;;
  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)
  34         (forms body)
  35         (doc 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)
  40              (if (stringp x)
  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:
  45                  (if remaining-forms
  46                    (if doc
  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)
  53                      t)))))
  54            (declaration-p (x)
  55              (if (consp x)
  56                (eq (car x) 'declare))))
  57       (tagbody
  58         :again
  59         (if forms
  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))
  64               (setq doc form1)
  65               (if (declaration-p form1)
  66                 (setq reversed-decls
  67                       (cons form1 reversed-decls))
  68                 (go :done)))
  69             (setq forms (rest forms))
  70             (go :again)))
  71         :done)
  72       (values forms
  73               (nreverse reversed-decls)
  74               doc))))
  75
  76 (/show0 "leaving parse-body.lisp")