[prev in list] [next in list] [prev in thread] [next in thread]
List: sbcl-commits
Subject: [Sbcl-commits] CVS: sbcl/src/code coerce.lisp, 1.22,
From: "Nikodemus Siivola" <demoss () users ! sourceforge ! net>
Date: 2010-11-16 18:18:05
Message-ID: E1PIQ6X-0004qu-Ct () sfp-cvsdas-3 ! v30 ! ch3 ! sourceforge ! com
[Download RAW message or body]
Update of /cvsroot/sbcl/sbcl/src/code
In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv18564/src/code
Modified Files:
coerce.lisp condition.lisp early-extensions.lisp
fd-stream.lisp target-thread.lisp
Log Message:
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.
Index: coerce.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/coerce.lisp,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -d -r1.22 -r1.23
--- coerce.lisp 23 Apr 2009 13:28:55 -0000 1.22
+++ coerce.lisp 16 Nov 2010 18:18:03 -0000 1.23
@@ -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
Index: condition.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/condition.lisp,v
retrieving revision 1.109
retrieving revision 1.110
diff -u -d -r1.109 -r1.110
--- condition.lisp 11 Oct 2010 14:29:14 -0000 1.109
+++ condition.lisp 16 Nov 2010 18:18:03 -0000 1.110
@@ -1639,6 +1639,60 @@
(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) ()
Index: early-extensions.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/early-extensions.lisp,v
retrieving revision 1.106
retrieving revision 1.107
diff -u -d -r1.106 -r1.107
--- early-extensions.lisp 21 Jun 2009 16:30:33 -0000 1.106
+++ early-extensions.lisp 16 Nov 2010 18:18:03 -0000 1.107
@@ -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)
Index: fd-stream.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/fd-stream.lisp,v
retrieving revision 1.151
retrieving revision 1.152
diff -u -d -r1.151 -r1.152
--- fd-stream.lisp 13 Oct 2010 15:07:30 -0000 1.151
+++ fd-stream.lisp 16 Nov 2010 18:18:03 -0000 1.152
@@ -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
Index: target-thread.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-thread.lisp,v
retrieving revision 1.136
retrieving revision 1.137
diff -u -d -r1.136 -r1.137
--- target-thread.lisp 8 Nov 2010 10:00:54 -0000 1.136
+++ target-thread.lisp 16 Nov 2010 18:18:03 -0000 1.137
@@ -59,17 +59,9 @@
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 @@
"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
------------------------------------------------------------------------------
Beautiful is writing same markup. Internet Explorer 9 supports
standards for HTML5, CSS3, SVG 1.1, ECMAScript5, and DOM L2 & L3.
Spend less time writing and rewriting code and more time creating great
experiences on the web. Be a part of the beta today
http://p.sf.net/sfu/msIE9-sfdev2dev
_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic