From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Tue, 16 Nov 2010 18:18:03 +0000 (+0000)
Subject: 1.0.44.26: more nuanced deprecation framework
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=4fa1c71c7dfa5c6d361304321cc67069a6410694;p=sbcl.git

1.0.44.26: more nuanced deprecation framework

 DEFINE-DEPRECATED-FUNCTION is the new one-stop shop for the "common"
 case of deprecating a function in favor of another one.

 ...in cases where it is not sufficient, call DEPRECATION-WARNING or
 DEPRECATION-ERROR directly from the compiler or other place.

 Three stages: :EARLY signals a compile-time style-warning, :LATE
 signals a compile-time full warning, :FINAL a compile-time full
 warning and a run-time error.

 (This is based on the assumption that this is both a sufficient and
 desirably nuanced taxonomy -- if more or less is wanted, changing
 this later is easy enough.)

 SB-EXT:DEPRECATION-CONDITION is the base class of all deprecation
 warnings and errors, but it isn't yet documented: once we have a
 concensus of sorts on a deprecation protocol/schedule, I will write
 the appropriate bits in the manual.

 Everything that previously had a deprecation warning is now in :LATE
 stage, except for INSTANCE-LAMBDA which is now in :FINAL stage.
---

diff --git a/contrib/sb-introspect/introspect.lisp b/contrib/sb-introspect/introspect.lisp
index c5d80af..bc406b3 100644
--- a/contrib/sb-introspect/introspect.lisp
+++ b/contrib/sb-introspect/introspect.lisp
@@ -424,14 +424,10 @@ If an unsupported TYPE is requested, the function will return NIL.
     ;; FIXME there may be other structure predicate functions
     (member self (list *struct-predicate*))))
 
-(defun function-arglist (function)
-  "Deprecated alias for FUNCTION-LAMBDA-LIST."
+(sb-int:define-deprecated-function :late "1.0.24.5" function-arglist function-lambda-list
+    (function)
   (function-lambda-list function))
 
-(define-compiler-macro function-arglist (function)
-  (sb-int:deprecation-warning 'function-arglist 'function-lambda-list)
-  `(function-lambda-list ,function))
-
 (defun function-lambda-list (function)
   "Describe the lambda list for the extended function designator FUNCTION.
 Works for special-operators, macros, simple functions, interpreted functions,
diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 43b7dec..161165b 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -670,6 +670,7 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
                "IMPLICIT-GENERIC-FUNCTION-NAME"
                "IMPLICIT-GENERIC-FUNCTION-WARNING"
                "INVALID-FASL"
+               "DEPRECATION-CONDITION"
 
                "NAME-CONFLICT" "NAME-CONFLICT-FUNCTION"
                "NAME-CONFLICT-DATUM" "NAME-CONFLICT-SYMBOLS"
@@ -961,6 +962,14 @@ possibly temporariliy, because it might be used internally."
 
                "*N-BYTES-FREED-OR-PURIFIED*"
 
+               ;; Deprecating stuff
+               "DEFINE-DEPRECATED-FUNCTION"
+               "EARLY-DEPRECATION-WARNING"
+               "LATE-DEPRECATION-WARNING"
+               "FINAL-DEPRECATION-WARNING"
+               "DEPRECATION-WARNING"
+               "DEPRECATION-ERROR"
+
                ;; miscellaneous non-standard but handy user-level functions..
                "ASSQ" "DELQ" "MEMQ" "POSQ" "NEQ"
                "ADJUST-LIST"
@@ -977,7 +986,6 @@ possibly temporariliy, because it might be used internally."
                "PSXHASH"
                "%BREAK"
                "NTH-BUT-WITH-SANE-ARG-ORDER"
-               "DEPRECATION-WARNING"
                "BIT-VECTOR-="
                "READ-EVALUATED-FORM"
                "MAKE-UNPRINTABLE-OBJECT"
diff --git a/src/code/coerce.lisp b/src/code/coerce.lisp
index a4a93f0..928f24b 100644
--- a/src/code/coerce.lisp
+++ b/src/code/coerce.lisp
@@ -81,8 +81,7 @@
         ;; become COMPILE instead of EVAL, which seems nicer to me.
         (eval `(function ,object)))
        ((instance-lambda)
-        (deprecation-warning 'instance-lambda 'lambda)
-        (eval `(function ,object)))
+        (deprecation-error "0.9.3.32" 'instance-lambda 'lambda))
        (t
         (error 'simple-type-error
                :datum object
diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 541ab58..53f6b18 100644
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -1639,6 +1639,60 @@ the usual naming convention (names like *FOO*) for special variables"
                      (proclamation-mismatch-name warning)
                      (proclamation-mismatch-old warning)))))
 
+;;;; deprecation conditions
+
+(define-condition deprecation-condition ()
+  ((name :initarg :name :reader deprecated-name)
+   (replacement :initarg :replacement :reader deprecated-name-replacement)
+   (since :initarg :since :reader deprecated-since)
+   (runtime-error :initarg :runtime-error :reader deprecated-name-runtime-error)))
+
+(def!method print-object ((condition deprecation-condition) stream)
+  (let ((*package* (find-package :keyword)))
+    (if *print-escape*
+        (print-unreadable-object (condition stream :type t)
+          (format stream "~S is deprecated~@[, use ~S~]"
+                  (deprecated-name condition)
+                  (deprecated-name-replacement condition)))
+        (format stream "~@<~S has been deprecated as of SBCL ~A~
+                        ~@[, use ~S instead~].~:@>"
+                (deprecated-name condition)
+                (deprecated-since condition)
+                (deprecated-name-replacement condition)))))
+
+(define-condition early-deprecation-warning (style-warning deprecation-condition)
+  ())
+
+(def!method print-object :after ((warning early-deprecation-warning) stream)
+  (unless *print-escape*
+    (let ((*package* (find-package :keyword)))
+      (format stream "~%~@<~:@_In future SBCL versions ~S will signal a full warning ~
+                      at compile-time.~:@>"
+              (deprecated-name warning)))))
+
+(define-condition late-deprecation-warning (warning deprecation-condition)
+  ())
+
+(def!method print-object :after ((warning late-deprecation-warning) stream)
+  (unless *print-escape*
+    (when (deprecated-name-runtime-error warning)
+      (let ((*package* (find-package :keyword)))
+        (format stream "~%~@<~:@_In future SBCL versions ~S will signal a runtime error.~:@>"
+                (deprecated-name warning))))))
+
+(define-condition final-deprecation-warning (warning deprecation-condition)
+  ())
+
+(def!method print-object :after ((warning final-deprecation-warning) stream)
+  (unless *print-escape*
+    (when (deprecated-name-runtime-error warning)
+      (let ((*package* (find-package :keyword)))
+        (format stream "~%~@<~:@_An error will be signaled at runtime for ~S.~:@>"
+                (deprecated-name warning))))))
+
+(define-condition deprecation-error (error deprecation-condition)
+  ())
+
 ;;;; restart definitions
 
 (define-condition abort-failure (control-error) ()
diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index 46bc505..d6bdf7b 100644
--- a/src/code/early-extensions.lisp
+++ b/src/code/early-extensions.lisp
@@ -1126,10 +1126,54 @@
       (translate-logical-pathname possibly-logical-pathname)
       possibly-logical-pathname))
 
-(defun deprecation-warning (bad-name &optional good-name)
-  (warn "using deprecated ~S~@[, should use ~S instead~]"
-        bad-name
-        good-name))
+;;;; Deprecating stuff
+
+(defun deprecation-error (since name replacement)
+  (error 'deprecation-error
+          :name name
+          :replacement replacement
+          :since since))
+
+(defun deprecation-warning (state since name replacement
+                            &key (runtime-error (neq :early state)))
+  (warn (ecase state
+          (:early 'early-deprecation-warning)
+          (:late 'late-deprecation-warning)
+          (:final 'final-deprecation-warning))
+        :name name
+        :replacement replacement
+        :since since
+        :runtime-error runtime-error))
+
+(defun deprecated-function (since name replacement)
+  (lambda (&rest deprecated-function-args)
+    (declare (ignore deprecated-function-args))
+    (deprecation-error since name replacement)))
+
+(defun deprecation-compiler-macro (state since name replacement)
+  (lambda (form env)
+    (declare (ignore env))
+    (deprecation-warning state since name replacement)
+    form))
+
+(defmacro define-deprecated-function (state since name replacement lambda-list &body body)
+  (let ((doc (let ((*package* (find-package :keyword)))
+               (format nil "~@<~S has been deprecated as of SBCL ~A~@[, use ~S instead~].~:>"
+                       name since replacement))))
+    `(progn
+       ,(ecase state
+               ((:early :late)
+                `(defun ,name ,lambda-list
+                   ,doc
+                   ,@body))
+               ((:final)
+                `(progn
+                   (declaim (ftype (function * nil) ,name))
+                   (setf (fdefinition ',name)
+                         (deprecated-function ',name ',replacement ,since))
+                   (setf (documentation ',name 'function) ,doc))))
+       (setf (compiler-macro-function ',name)
+             (deprecation-compiler-macro ,state ,since ',name ',replacement)))))
 
 ;;; Anaphoric macros
 (defmacro awhen (test &body body)
diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index a2940e1..54c7c51 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -407,14 +407,10 @@
 ;;; this is not something we want to export. Nikodemus thinks the
 ;;; right thing is to support a low-level non-stream like IO layer,
 ;;; akin to java.nio.
-(defun output-raw-bytes (stream thing &optional start end)
+(declaim (inline output-raw-bytes))
+(define-deprecated-function :late "1.0.8.16" output-raw-bytes write-sequence
+    (stream thing &optional start end)
   (write-or-buffer-output stream thing (or start 0) (or end (length thing))))
-
-(define-compiler-macro output-raw-bytes (stream thing &optional start end)
-  (deprecation-warning 'output-raw-bytes)
-  (let ((x (gensym "THING")))
-    `(let ((,x ,thing))
-       (write-or-buffer-output ,stream ,x (or ,start 0) (or ,end (length ,x))))))
 
 ;;;; output routines and related noise
 
diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 25a6c17..111f92b 100644
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -59,17 +59,9 @@ offending thread using THREAD-ERROR-THREAD."))
 to be joined. The offending thread can be accessed using
 THREAD-ERROR-THREAD."))
 
-(defun join-thread-error-thread (condition)
+(define-deprecated-function :late "1.0.29.17" join-thread-error-thread thread-error-thread
+    (condition)
   (thread-error-thread condition))
-(define-compiler-macro join-thread-error-thread (condition)
-  (deprecation-warning 'join-thread-error-thread 'thread-error-thread)
-  `(thread-error-thread ,condition))
-
-#!+sb-doc
-(setf
- (fdocumentation 'join-thread-error-thread 'function)
- "The thread that we failed to join. Deprecated, use THREAD-ERROR-THREAD
-instead.")
 
 (define-condition interrupt-thread-error (thread-error) ()
   (:report (lambda (c s)
@@ -80,17 +72,9 @@ instead.")
    "Signalled when interrupting a thread fails because the thread has already
 exited. The offending thread can be accessed using THREAD-ERROR-THREAD."))
 
-(defun interrupt-thread-error-thread (condition)
+(define-deprecated-function :late "1.0.29.17" interrupt-thread-error-thread thread-error-thread
+    (condition)
   (thread-error-thread condition))
-(define-compiler-macro interrupt-thread-error-thread (condition)
-  (deprecation-warning 'join-thread-error-thread 'thread-error-thread)
-  `(thread-error-thread ,condition))
-
-#!+sb-doc
-(setf
- (fdocumentation 'interrupt-thread-error-thread 'function)
- "The thread that was not interrupted. Deprecated, use THREAD-ERROR-THREAD
-instead.")
 
 ;;; Of the WITH-PINNED-OBJECTS in this file, not every single one is
 ;;; necessary because threads are only supported with the conservative
diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp
index 100c895..6bf1843 100644
--- a/src/compiler/ir1tran-lambda.lisp
+++ b/src/compiler/ir1tran-lambda.lisp
@@ -1007,8 +1007,10 @@
                          :source-name source-name
                          :debug-name debug-name))
     ((instance-lambda)
-     (deprecation-warning 'instance-lambda 'lambda)
-     (ir1-convert-lambda `(lambda ,@(cdr thing))
+     (deprecation-warning :final "0.9.3.32" 'instance-lambda 'lambda)
+     (ir1-convert-lambda `(lambda (&rest args)
+                            (declare (ignore args))
+                            (deprecation-error "0.9.3.32" 'instance-lambda 'lambda))
                          :source-name source-name
                          :debug-name debug-name))
     ((named-lambda)
diff --git a/src/compiler/policy.lisp b/src/compiler/policy.lisp
index 34b027d..413e425 100644
--- a/src/compiler/policy.lisp
+++ b/src/compiler/policy.lisp
@@ -75,14 +75,12 @@ EXPERIMENTAL INTERFACE: Subject to change."
       (assq x *policy-dependent-qualities*)))
 
 ;;; Is it deprecated?
-(defun policy-quality-deprecation-warning (quality spec)
+(defun policy-quality-deprecation-warning (quality)
   (when (member quality '(stack-allocate-dynamic-extent stack-allocate-vector
                           stack-allocate-value-cells))
-    (make-instance 'simple-reference-warning
-                   :format-control "~@<Ignoring deprecated optimization quality ~S in:~_ ~S~:>"
-                   :format-arguments (list quality spec)
-                   :references (list '(:sbcl :variable *stack-allocate-dynamic-extent*)
-                                     '(:sbcl :node "Dynamic-extent allocation")))))
+    (deprecation-warning :late "1.0.19.7" quality '*stack-allocate-dynamic-extent*
+                         :runtime-error nil)
+    t))
 
 ;;; *POLICY* holds the current global compiler policy information, as
 ;;; an alist mapping from optimization quality name to quality value.
diff --git a/src/compiler/proclaim.lisp b/src/compiler/proclaim.lisp
index 6e7fc38..d0231ce 100644
--- a/src/compiler/proclaim.lisp
+++ b/src/compiler/proclaim.lisp
@@ -45,11 +45,10 @@
               (destructuring-bind (quality raw-value) q-and-v-or-just-q
                 (values quality raw-value)))
         (cond ((not (policy-quality-name-p quality))
-               (let ((deprecation-warning (policy-quality-deprecation-warning quality spec)))
-                 (if deprecation-warning
-                     (compiler-warn deprecation-warning)
-                     (compiler-warn "~@<Ignoring unknown optimization quality ~S in:~_ ~S~:>"
-                                    quality spec))))
+               (or (policy-quality-deprecation-warning quality)
+                   (compiler-warn
+                    "~@<Ignoring unknown optimization quality ~S in:~_ ~S~:>"
+                    quality spec)))
               ((not (typep raw-value 'policy-quality))
                (compiler-warn "~@<Ignoring bad optimization value ~S in:~_ ~S~:>"
                               raw-value spec))
diff --git a/version.lisp-expr b/version.lisp-expr
index 7d8990c..73e250e 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.44.25"
+"1.0.44.26"