Browse files 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. 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.
  • Loading branch information...
1 parent ea6c9e2 commit 4fa1c71c7dfa5c6d361304321cc67069a6410694 @nikodemus nikodemus committed Nov 16, 2010
@@ -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 "" 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,
@@ -670,6 +670,7 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
@@ -961,6 +962,14 @@ possibly temporariliy, because it might be used internally."
+ ;; Deprecating stuff
;; miscellaneous non-standard but handy user-level functions..
@@ -977,7 +986,6 @@ possibly temporariliy, because it might be used internally."
@@ -81,8 +81,7 @@
;; become COMPILE instead of EVAL, which seems nicer to me.
(eval `(function ,object)))
- (deprecation-warning 'instance-lambda 'lambda)
- (eval `(function ,object)))
+ (deprecation-error "" 'instance-lambda 'lambda))
(error 'simple-type-error
:datum object
@@ -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) ()
@@ -1126,10 +1126,54 @@
(translate-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)
@@ -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 "" 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
@@ -59,17 +59,9 @@ offending thread using THREAD-ERROR-THREAD."))
to be joined. The offending thread can be accessed using
-(defun join-thread-error-thread (condition)
+(define-deprecated-function :late "" 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))
- (fdocumentation 'join-thread-error-thread 'function)
- "The thread that we failed to join. Deprecated, use THREAD-ERROR-THREAD
(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 "" 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))
- (fdocumentation 'interrupt-thread-error-thread 'function)
- "The thread that was not interrupted. Deprecated, use THREAD-ERROR-THREAD
;;; Of the WITH-PINNED-OBJECTS in this file, not every single one is
;;; necessary because threads are only supported with the conservative
@@ -1007,8 +1007,10 @@
:source-name source-name
:debug-name debug-name))
- (deprecation-warning 'instance-lambda 'lambda)
- (ir1-convert-lambda `(lambda ,@(cdr thing))
+ (deprecation-warning :final "" 'instance-lambda 'lambda)
+ (ir1-convert-lambda `(lambda (&rest args)
+ (declare (ignore args))
+ (deprecation-error "" 'instance-lambda 'lambda))
:source-name source-name
:debug-name debug-name))
@@ -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
- (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 "" 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.
@@ -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))
@@ -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".)

0 comments on commit 4fa1c71

Please sign in to comment.