From d055eb59d501dbcb78c0f5b800e20c270cc801bc Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Wed, 29 Jul 2009 16:15:42 +0000
Subject: [PATCH] 1.0.30.15: more complete SB-CLTL2:DECLARATION-INFORMATION

 * (DECLARATION-INFORMATION 'DECLARATION) returns a list of
   declaration names that have been proclaimed as valid.

   Patch by Larry D'Anna.
---
 NEWS                        |  7 +++++--
 contrib/sb-cltl2/env.lisp   | 18 +++++++++++++++---
 contrib/sb-cltl2/tests.lisp |  7 +++++++
 version.lisp-expr           |  2 +-
 4 files changed, 28 insertions(+), 6 deletions(-)

diff --git a/NEWS b/NEWS
index 9fdeeccb3..7852683d4 100644
--- a/NEWS
+++ b/NEWS
@@ -19,8 +19,11 @@ changes relative to sbcl-1.0.30:
     but assumed or declared function as well.
   * improvement: recompilation of systems using SB-GROVEL now works
     (thanks to Leslie Polzer)
-  * improvement: SB-CLTL2 functions DECLARATION-INFORMATION, PARSE-MACRO,
-    and ENCLOSE have been documented (thanks to Larry D'Anna)
+  * improvements to SB-CLTL2 (thanks to Larry D'Anna):
+    ** functions DECLARATION-INFORMATION, PARSE-MACRO, and ENCLOSE have been
+       documented.
+    ** DECLARATION-INFORMATION now supports declaration name DECLARATION as
+       well.
   * bug fix: the low-level debugger had 32-bit assumptions and was missing
     information about some array types. (thanks to Luis Oliveira)
   * bug fix: moderately complex combinations of inline expansions could
diff --git a/contrib/sb-cltl2/env.lisp b/contrib/sb-cltl2/env.lisp
index 8c35440da..3ab4eb785 100644
--- a/contrib/sb-cltl2/env.lisp
+++ b/contrib/sb-cltl2/env.lisp
@@ -8,7 +8,6 @@
 (in-package :sb-cltl2)
 
 #| TODO:
-declaration-information
 augment-environment
 define-declaration
 (map-environment)
@@ -225,8 +224,11 @@ appear with CDR as T if the variable has been declared always bound."
 (defun declaration-information (declaration-name &optional env)
   "Return information about declarations named by DECLARATION-NAME.
 
-If DECLARATION-NAME is optimize return a list who's entries are of the
-form (quality value).
+If DECLARATION-NAME is OPTIMIZE return a list who's entries are of the
+form \(QUALITY VALUE).
+
+If DECLARATION-NAME is DECLARATION return a list of declaration names that
+have been proclaimed as valid.
 
 If DECLARATION-NAME is SB-EXT:MUFFLE-CONDITIONS return a type specifier for
 the condition types that have been muffled."
@@ -243,6 +245,16 @@ the condition types that have been muffled."
       (sb-ext:muffle-conditions
        (car (rassoc 'muffle-warning
                     (sb-c::lexenv-handled-conditions env))))
+      (declaration
+       ;; FIXME: This is a bit too deep in the guts of INFO for comfort...
+       (let ((type (sb-c::type-info-number
+                    (sb-c::type-info-or-lose :declaration :recognized)))
+             (ret nil))
+         (dolist (env *info-environment*)
+           (do-info (env :name name :type-number num :value value)
+             (when (and (= num type) value)
+               (push name ret))))
+         ret))
       (t (error "Unsupported declaration ~S." declaration-name)))))
 
 (defun parse-macro (name lambda-list body &optional env)
diff --git a/contrib/sb-cltl2/tests.lisp b/contrib/sb-cltl2/tests.lisp
index a314d8da6..01b69744e 100644
--- a/contrib/sb-cltl2/tests.lisp
+++ b/contrib/sb-cltl2/tests.lisp
@@ -109,6 +109,13 @@
                (subtypep '(and warning (not style-warning)) dinfo)))))))
   t)
 
+
+(declaim (declaration fubar))
+
+(deftest declaration-information.declaration
+    (if (member 'fubar (declaration-information 'declaration)) 'yay)
+  yay)
+
 ;;;; VARIABLE-INFORMATION
 
 (defvar *foo*)
diff --git a/version.lisp-expr b/version.lisp-expr
index fe9428711..9d41cd939 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.30.14"
+"1.0.30.15"
-- 
2.11.4.GIT