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!IMPL")
  18
  19 (/show0 "entering parse-body.lisp")
  20
  21 ;;; Given a sequence of declarations (and possibly a documentation
  22 ;;; string) followed by other forms (as occurs in the bodies of DEFUN,
  23 ;;; DEFMACRO, etc.) return (VALUES FORMS DECLS DOC), where DECLS holds
  24 ;;; declarations, DOC holds a doc string (or NIL if none), and FORMS
  25 ;;; holds the other forms.
  26 ;;;
  27 ;;; If DOC-STRING-ALLOWED is NIL, then no forms will be treated as
  28 ;;; documentation strings.
  29 (defun parse-body (body &key (doc-string-allowed t) (toplevel nil))
  30   (let ((reversed-decls nil)
  31         (forms body)
  32         (doc nil))
  33     (flet ((doc-string-p (x remaining-forms)
  34              (and (stringp x) doc-string-allowed
  35                   ;; ANSI 3.4.11 explicitly requires that a doc string
  36                   ;; be followed by another form (either an ordinary form
  37                   ;; or a declaration). Hence:
  38                   remaining-forms
  39                   (if doc
  40                       ;; .. and says that the consequences of multiple
  41                       ;; doc strings are unspecified.
  42                       ;; That's probably not something the programmer intends.
  43                       ;; We raise an error so that this won't pass unnoticed.
  44                       (error "duplicate doc string ~S" x)
  45                       t)))
  46            (declaration-p (x)
  47              (if (consp x)
  48                  (let ((name (car x)))
  49                    (case name
  50                      ((declare) t)
  51                      ((declaim)
  52                       (unless toplevel
  53                         ;; technically legal, but rather unlikely to
  54                         ;; be what the user meant to do...
  55                         (style-warn
  56                          "DECLAIM where DECLARE was probably intended")
  57                         nil))
  58                      (t nil))))))
  59       (tagbody
  60         :again
  61         (if forms
  62             (let ((form1 (first forms)))
  63               ;; Note: The (IF (IF ..) ..) stuff is because we don't
  64               ;; have the macro AND yet.:-|
  65               (if (doc-string-p form1 (rest forms))
  66                   (setq doc form1)
  67                   (if (declaration-p form1)
  68                       (setq reversed-decls
  69                             (cons form1 reversed-decls))
  70                       (go :done)))
  71               (setq forms (rest forms))
  72               (go :again)))
  73         :done)
  74       (values forms
  75               (nreverse reversed-decls)
  76               doc))))
  77
  78 (/show0 "leaving parse-body.lisp")