X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fparse-body.lisp;h=7966c85e7e9db4987278c289ef5adfa319d38ebd;hb=cee8ef591040db9a79cdd19297867672a9529051;hp=1dfb055629cff0be6ddfdeac2c500a077428f479;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/code/parse-body.lisp b/src/code/parse-body.lisp
index 1dfb055..7966c85 100644
--- a/src/code/parse-body.lisp
+++ b/src/code/parse-body.lisp
@@ -16,9 +16,6 @@
 
 (in-package "SB!INT")
 
-(file-comment
- "$Header$")
-
 (/show0 "entering parse-body.lisp")
 
 ;;; Given a sequence of declarations (and possibly a documentation
@@ -29,45 +26,55 @@
 ;;;
 ;;; If DOC-STRING-ALLOWED is NIL, then no forms will be treated as
 ;;; documentation strings.
-(defun sb!sys:parse-body (body &optional (doc-string-allowed t))
+(defun parse-body (body &key (doc-string-allowed t) (toplevel nil))
   (let ((reversed-decls nil)
         (forms body)
         (doc nil))
-    ;; Since we don't have macros like AND, OR, and NOT yet, it's
-    ;; hard to express these tests clearly. Giving them names
-    ;; seems to help a little bit.
+    ;; Since we don't have macros like AND, OR, and NOT yet, it's hard
+    ;; to express these tests clearly. Giving them names seems to help
+    ;; a little bit.
     (flet ((doc-string-p (x remaining-forms)
              (if (stringp x)
-               (if doc-string-allowed
-                 ;; ANSI 3.4.11 explicitly requires that a doc
-                 ;; string be followed by another form (either an
-                 ;; ordinary form or a declaration). Hence:
-                 (if remaining-forms
-                   (if doc
-                     ;; ANSI 3.4.11 says that the consequences of
-                     ;; duplicate doc strings are unspecified.
-                     ;; That's probably not something the
-                     ;; programmer intends. We raise an error so
-                     ;; that this won't pass unnoticed.
-                     (error "duplicate doc string ~S" x)
-                     t)))))
+                 (if doc-string-allowed
+                     ;; ANSI 3.4.11 explicitly requires that a doc
+                     ;; string be followed by another form (either an
+                     ;; ordinary form or a declaration). Hence:
+                     (if remaining-forms
+                         (if doc
+                             ;; ANSI 3.4.11 says that the consequences of
+                             ;; duplicate doc strings are unspecified.
+                             ;; That's probably not something the
+                             ;; programmer intends. We raise an error so
+                             ;; that this won't pass unnoticed.
+                             (error "duplicate doc string ~S" x)
+                             t)))))
            (declaration-p (x)
              (if (consp x)
-               (eq (car x) 'declare))))
+                 (let ((name (car x)))
+                   (case name
+                     ((declare) t)
+                     ((declaim)
+                      (unless toplevel
+                        ;; technically legal, but rather unlikely to
+                        ;; be what the user meant to do...
+                        (style-warn
+                         "DECLAIM where DECLARE was probably intended")
+                        nil))
+                     (t nil))))))
       (tagbody
         :again
         (if forms
-          (let ((form1 (first forms)))
-            ;; Note: The (IF (IF ..) ..) stuff is because we don't
-            ;; have the macro AND yet.:-|
-            (if (doc-string-p form1 (rest forms))
-              (setq doc form1)
-              (if (declaration-p form1)
-                (setq reversed-decls
-                      (cons form1 reversed-decls))
-                (go :done)))
-            (setq forms (rest forms))
-            (go :again)))
+            (let ((form1 (first forms)))
+              ;; Note: The (IF (IF ..) ..) stuff is because we don't
+              ;; have the macro AND yet.:-|
+              (if (doc-string-p form1 (rest forms))
+                  (setq doc form1)
+                  (if (declaration-p form1)
+                      (setq reversed-decls
+                            (cons form1 reversed-decls))
+                      (go :done)))
+              (setq forms (rest forms))
+              (go :again)))
         :done)
       (values forms
               (nreverse reversed-decls)