X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fproclaim.lisp;h=acaa660b7b7bbf51d003b0e48720e1e85286ac3e;hb=c0578d9893429c9c0da80ea5920360e4621fddab;hp=7ebf66646ab4284078cfdfe09d79cdbc74794caa;hpb=7c406887c08477181e869b1b98142d99b52990ac;p=sbcl.git

diff --git a/src/compiler/proclaim.lisp b/src/compiler/proclaim.lisp
index 7ebf666..acaa660 100644
--- a/src/compiler/proclaim.lisp
+++ b/src/compiler/proclaim.lisp
@@ -170,14 +170,35 @@
          (kind (first form))
          (args (rest form)))
     (case kind
-      (special
+      ((special global)
+       (flet ((make-special (name old)
+                (unless (member old '(:special :unknown))
+                  (error "Cannot proclaim a ~(~A~) variable special: ~S" old name))
+                (with-single-package-locked-error
+                    (:symbol name "globally declaring ~A special")
+                  (setf (info :variable :kind name) :special)))
+              (make-global (name old)
+                (unless (member old '(:global :unknown))
+                  (error "Cannot proclaim a ~(~A~) variable global: ~S" old name))
+                (with-single-package-locked-error
+                    (:symbol name "globally declaring ~A global")
+                  (setf (info :variable :kind name) :global))))
+         (let ((fun (if (eq 'special kind) #'make-special #'make-global)))
+           (dolist (name args)
+            (unless (symbolp name)
+              (error "Can't declare a non-symbol as ~S: ~S" kind name))
+            (funcall fun name (info :variable :kind name))))))
+      (always-bound
        (dolist (name args)
          (unless (symbolp name)
-           (error "can't declare a non-symbol as SPECIAL: ~S" name))
+           (error "Can't proclaim a non-symbol as ~S: ~S" kind name))
+         (unless (boundp name)
+           (error "Can't proclaim an unbound symbol as ~S: ~S" kind name))
+         (when (eq :constant (info :variable :kind name))
+           (error "Can't proclaim a constant variable as ~S: ~S" kind name))
          (with-single-package-locked-error
-             (:symbol name "globally declaring ~A special")
-           (about-to-modify-symbol-value name "proclaim ~S as SPECIAL")
-           (setf (info :variable :kind name) :special))))
+             (:symbol name "globally declaring ~A always bound")
+           (setf (info :variable :always-bound name) t))))
       (type
        (if *type-system-initialized*
            (let ((type (specifier-type (first args))))