fix rounding of floats big enough to be bignums
[sbcl.git] / 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 (/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     ;; Since we don't have macros like AND, OR, and NOT yet, it's hard
34     ;; to express these tests clearly. Giving them names seems to help
35     ;; a little bit.
36     (flet ((doc-string-p (x remaining-forms)
37              (if (stringp x)
38                  (if doc-string-allowed
39                      ;; ANSI 3.4.11 explicitly requires that a doc
40                      ;; string be followed by another form (either an
41                      ;; ordinary form or a declaration). Hence:
42                      (if remaining-forms
43                          (if doc
44                              ;; ANSI 3.4.11 says that the consequences of
45                              ;; duplicate doc strings are unspecified.
46                              ;; That's probably not something the
47                              ;; programmer intends. We raise an error so
48                              ;; that this won't pass unnoticed.
49                              (error "duplicate doc string ~S" x)
50                              t)))))
51            (declaration-p (x)
52              (if (consp x)
53                  (let ((name (car x)))
54                    (case name
55                      ((declare) t)
56                      ((declaim)
57                       (unless toplevel
58                         ;; technically legal, but rather unlikely to
59                         ;; be what the user meant to do...
60                         (style-warn
61                          "DECLAIM where DECLARE was probably intended")
62                         nil))
63                      (t nil))))))
64       (tagbody
65         :again
66         (if forms
67             (let ((form1 (first forms)))
68               ;; Note: The (IF (IF ..) ..) stuff is because we don't
69               ;; have the macro AND yet.:-|
70               (if (doc-string-p form1 (rest forms))
71                   (setq doc form1)
72                   (if (declaration-p form1)
73                       (setq reversed-decls
74                             (cons form1 reversed-decls))
75                       (go :done)))
76               (setq forms (rest forms))
77               (go :again)))
78         :done)
79       (values forms
80               (nreverse reversed-decls)
81               doc))))
82
83 (/show0 "leaving parse-body.lisp")