From 7e918ab24b9d85edcfc567135384404d421688b2 Mon Sep 17 00:00:00 2001
From: Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
Date: Wed, 18 Mar 2015 11:17:06 +0100
Subject: [PATCH 2/2] sb-cltl2: make variable and function deprecation
 information available

---
 contrib/sb-cltl2/env.lisp | 95 +++++++++++++++++++++++++++++++++++++----------
 1 file changed, 76 insertions(+), 19 deletions(-)

diff --git a/contrib/sb-cltl2/env.lisp b/contrib/sb-cltl2/env.lisp
index 3f49e89..408d780 100644
--- a/contrib/sb-cltl2/env.lisp
+++ b/contrib/sb-cltl2/env.lisp
@@ -144,6 +144,14 @@
             (push entry-cons ret))))
       (nreverse ret))))
 
+(defun maybe-deprecation-entry (info)
+  (when info
+    (destructuring-bind (state since replacements) info
+      (list (cons :deprecated
+                  (list :state state
+                        :since since
+                        :replacements replacements))))))
+
 ;;; Retrieve the user-supplied (from define-declaration) value for
 ;;; the declaration with the given NAME
 (defun extra-decl-info (name env)
@@ -201,6 +209,28 @@ CARS of the alist include:
     associated with NAME. If the CDR is FUNCTION the alist element may
     be omitted.
 
+  :DEPRECATED
+    The CDR is a plist containing the following properties
+
+      :STATE ( :EARLY | :LATE | :FINAL )
+        Use of :EARLY deprecated functions signals a STYLE-WARNING at
+        compile-time.
+
+        Use of :LATE deprecated functions signals a full WARNING at
+        compile-time.
+
+        Use of :FINAL deprecated functions signals a full WARNING at
+        compile-time and an error at runtime.
+
+      :SINCE VERSION
+        VERSION is a string designating the version since which the
+        function has been deprecated.
+
+      :REPLACEMENTS REPLACEMENTS
+        When this property is present, REPLACEMENTS is a list of
+        symbols naming functions that should be used instead of the
+        deprecated function.
+
 In addition to these declarations defined using DEFINE-DECLARATION may
 appear."
   (let* ((*lexenv* (or env (make-null-lexenv)))
@@ -240,17 +270,19 @@ appear."
                 inlinep (info :function :inlinep name))))))
     (values binding
             localp
-            (let (alist)
-              (when (and ftype (neq *universal-fun-type* ftype))
-                (push (cons 'ftype (type-specifier ftype)) alist))
-              (ecase inlinep
-                ((:inline :maybe-inline) (push (cons 'inline 'inline) alist))
-                (:notinline (push (cons 'inline 'notinline) alist))
-                ((nil)))
-              (when dx (push (cons 'dynamic-extent t) alist))
-              (append alist (extra-pairs :function name fun *lexenv*))))))
-
-
+            (append (ecase inlinep
+                      ((:inline :maybe-inline)
+                       (list (cons 'inline 'inline)))
+                      (:notinline
+                       (list (cons 'inline 'notinline)))
+                      ((nil)))
+                    (when (and ftype (neq *universal-fun-type* ftype))
+                      (list (cons 'ftype (type-specifier ftype))))
+                    (when dx
+                      (list (cons 'dynamic-extent t)))
+                    (maybe-deprecation-entry
+                     (info :function :deprecated name))
+                    (extra-pairs :function name fun *lexenv*)))))
 
 (declaim (ftype (sfunction
                  (symbol &optional (or null lexenv))
@@ -314,6 +346,28 @@ CARS of the alist include:
     If CDR is T, NAME has been declared as SB-EXT:ALWAYS-BOUND \(SBCL
     specific.)
 
+  :DEPRECATED
+    The CDR is a plist containing the following properties
+
+      :STATE ( :EARLY | :LATE | :FINAL )
+        Use of :EARLY deprecated variables signals a STYLE-WARNING at
+        compile-time.
+
+        Use of :LATE deprecated variables signals a full WARNING at
+        compile-time.
+
+        Use of :FINAL deprecated variables signals a full WARNING at
+        compile-time and an error at runtime.
+
+      :SINCE VERSION
+        VERSION is a string designating the version since which the
+        variable has been deprecated.
+
+      :REPLACEMENTS REPLACEMENTS
+        When this property is present, REPLACEMENTS is a list of
+        symbols naming variables that should be used instead of the
+        deprecated variable.
+
 In addition to these declarations defined using DEFINE-DECLARATION may
 appear."
   (let* ((*lexenv* (or env (make-null-lexenv)))
@@ -358,14 +412,17 @@ appear."
                 localp nil))))
     (values binding
             localp
-            (let (alist)
-              (when ignorep (push (cons 'ignore t) alist))
-              (when (and type (neq *universal-type* type))
-                (push (cons 'type (type-specifier type)) alist))
-              (when dx (push (cons 'dynamic-extent t) alist))
-              (when (info :variable :always-bound name)
-                (push (cons 'sb-ext:always-bound t) alist))
-              (append alist (extra-pairs :variable name var *lexenv*))))))
+            (append (when ignorep
+                      (list (cons 'ignore t)))
+                    (when (and type (neq *universal-type* type))
+                      (list (cons 'type (type-specifier type))))
+                    (when dx
+                      (list (cons 'dynamic-extent t)))
+                    (when (info :variable :always-bound name)
+                      (list (cons 'sb-ext:always-bound t)))
+                    (maybe-deprecation-entry
+                     (info :variable :deprecated name))
+                    (extra-pairs :variable name var *lexenv*)))))
 
 (declaim (ftype (sfunction (symbol &optional (or null lexenv)) t)
                 declaration-information))
-- 
2.1.4

