CMUCL commit: intl-branch src/code (8 files)
Raymond Toy
rtoy at common-lisp.net
Sat Feb 13 18:10:09 CET 2010
Date: Saturday, February 13, 2010 @ 12:10:09
Author: rtoy
Path: /project/cmucl/cvsroot/src/code
Tag: intl-branch
Modified: class.lisp defstruct.lisp irrat.lisp lispinit.lisp load.lisp
macros.lisp package.lisp serve-event.lisp
Oops. The restart-case :reports only have a stream parameter.
------------------+
class.lisp | 11 ++++-------
defstruct.lisp | 11 ++++-------
irrat.lisp | 10 ++++------
lispinit.lisp | 5 ++---
load.lisp | 14 +++++---------
macros.lisp | 20 +++++++-------------
package.lisp | 35 ++++++++++++-----------------------
serve-event.lisp | 11 ++++-------
8 files changed, 42 insertions(+), 75 deletions(-)
Index: src/code/class.lisp
diff -u src/code/class.lisp:1.62.12.3 src/code/class.lisp:1.62.12.4
--- src/code/class.lisp:1.62.12.3 Wed Feb 10 09:07:36 2010
+++ src/code/class.lisp Sat Feb 13 12:10:08 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/class.lisp,v 1.62.12.3 2010-02-10 14:07:36 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/class.lisp,v 1.62.12.4 2010-02-13 17:10:08 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -1211,15 +1211,13 @@
one."
name)
(continue ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Invalidate current definition." stream))
(warn _"New definition of ~S must be loaded eventually." name)
(invalidate-layout old)
(setf (gethash name *forward-referenced-layouts*) res))
(clobber-it ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Smash current layout, preserving old code." stream))
(warn _"Any old ~S instances will be in a bad way.~@
I hope you know what you're doing..."
@@ -1229,8 +1227,7 @@
(setf (layout-length old) length)
old)
(use-current ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Ignore the incompatibility, leave class alone." stream))
(warn _"Assuming the current definition of ~S is correct, and~@
that the loaded code doesn't care about the ~
Index: src/code/defstruct.lisp
diff -u src/code/defstruct.lisp:1.98.12.3 src/code/defstruct.lisp:1.98.12.4
--- src/code/defstruct.lisp:1.98.12.3 Wed Feb 10 09:07:36 2010
+++ src/code/defstruct.lisp Sat Feb 13 12:10:08 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/defstruct.lisp,v 1.98.12.3 2010-02-10 14:07:36 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/defstruct.lisp,v 1.98.12.4 2010-02-13 17:10:08 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -461,17 +461,14 @@
:format-control _"defining structure ~A"
:format-arguments (list name))
(continue ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Ignore the lock and continue" stream)))
(unlock-package ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Disable package's definition lock then continue" stream))
(setf (ext:package-definition-lock pkg) nil))
(unlock-all ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Unlock all packages, then continue" stream))
(lisp::unlock-all-packages))))
(when (info declaration recognized name)
Index: src/code/irrat.lisp
diff -u src/code/irrat.lisp:1.60.2.4 src/code/irrat.lisp:1.60.2.5
--- src/code/irrat.lisp:1.60.2.4 Wed Feb 10 09:07:36 2010
+++ src/code/irrat.lisp Sat Feb 13 12:10:09 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/irrat.lisp,v 1.60.2.4 2010-02-10 14:07:36 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/irrat.lisp,v 1.60.2.5 2010-02-13 17:10:09 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -307,7 +307,7 @@
(define-condition intexp-limit-error (error)
((base :initarg :base :reader intexp-base)
(power :initarg :power :reader intexp-power))
- (:report (lambda (condition stream)
+ (:report (lambda (stream)
(format stream _"The absolute value of ~S exceeds limit ~S."
(intexp-power condition)
*intexp-maximum-exponent*))))
@@ -332,12 +332,10 @@
:base base
:power power)
(continue ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Continue with calculation" stream)))
(new-limit ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Continue with calculation, update limit" stream))
(setq *intexp-maximum-exponent* (abs power)))))
(cond ((minusp power)
Index: src/code/lispinit.lisp
diff -u src/code/lispinit.lisp:1.79.12.5 src/code/lispinit.lisp:1.79.12.6
--- src/code/lispinit.lisp:1.79.12.5 Fri Feb 12 00:52:24 2010
+++ src/code/lispinit.lisp Sat Feb 13 12:10:09 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/lispinit.lisp,v 1.79.12.5 2010-02-12 05:52:24 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/lispinit.lisp,v 1.79.12.6 2010-02-13 17:10:09 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -262,8 +262,7 @@
(check-type condition warning _"a warning condition")
(restart-case (signal condition)
(muffle-warning ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Skip warning." stream))
(return-from warn nil)))
(format *error-output* _"~&~@<Warning: ~3i~:_~A~:>~%" condition)))
Index: src/code/load.lisp
diff -u src/code/load.lisp:1.93.12.3 src/code/load.lisp:1.93.12.4
--- src/code/load.lisp:1.93.12.3 Wed Feb 10 09:08:50 2010
+++ src/code/load.lisp Sat Feb 13 12:10:09 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/load.lisp,v 1.93.12.3 2010-02-10 14:08:50 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/load.lisp,v 1.93.12.4 2010-02-13 17:10:09 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -589,13 +589,11 @@
:format-control _"~S does not exist."
:format-arguments (list (namestring pathname)))
(check-again ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"See if it exists now." stream))
(load pathname))
(use-value ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Prompt for a new name."))
(write-string _"New name: " *query-io*)
(force-output *query-io*)
@@ -686,14 +684,12 @@
older than the presumed source:~% ~A."
(namestring obj-tn) (namestring src-tn))
(continue ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"load source file" stream))
(internal-load src-pn src-tn if-does-not-exist :source
external-format))
(load-object ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"load object file" stream))
(internal-load src-pn obj-tn if-does-not-exist :binary
:void))))))
Index: src/code/macros.lisp
diff -u src/code/macros.lisp:1.113.10.5 src/code/macros.lisp:1.113.10.6
--- src/code/macros.lisp:1.113.10.5 Wed Feb 10 09:07:36 2010
+++ src/code/macros.lisp Sat Feb 13 12:10:09 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/macros.lisp,v 1.113.10.5 2010-02-10 14:07:36 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/macros.lisp,v 1.113.10.6 2010-02-13 17:10:09 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -90,17 +90,14 @@
:format-control _"defining macro ~A"
:format-arguments (list name))
(continue ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Ignore the lock and continue" stream)))
(unlock-package ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Disable the package's definition-lock then continue" stream))
(setf (ext:package-definition-lock package) nil))
(unlock-all ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Unlock all packages, then continue" stream))
(lisp::unlock-all-packages))))))))
(let ((whole (gensym "WHOLE-"))
@@ -224,17 +221,14 @@
:format-control _"defining type ~A"
:format-arguments (list name))
(continue ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Ignore the lock and continue" stream)))
(unlock-package ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Disable package's definition-lock then continue" stream))
(setf (ext:package-definition-lock (symbol-package name)) nil))
(unlock-all ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Unlock all packages, then continue" stream))
(lisp::unlock-all-packages))))
(let ((whole (gensym "WHOLE-")))
Index: src/code/package.lisp
diff -u src/code/package.lisp:1.77.10.3 src/code/package.lisp:1.77.10.4
--- src/code/package.lisp:1.77.10.3 Wed Feb 10 09:07:36 2010
+++ src/code/package.lisp Sat Feb 13 12:10:09 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/package.lisp,v 1.77.10.3 2010-02-10 14:07:36 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/package.lisp,v 1.77.10.4 2010-02-13 17:10:09 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -209,17 +209,14 @@
:format-control _"redefining function ~A"
:format-arguments (list function))
(continue ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Ignore the lock and continue" stream)))
(unlock-package ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Disable package's definition-lock, then continue" stream))
(setf (ext:package-definition-lock package) nil))
(unlock-all ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Disable all package locks, then continue" stream))
(unlock-all-packages)))))))))
@@ -1404,17 +1401,14 @@
:format-control _"uninterning symbol ~A"
:format-arguments (list name))
(continue ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Ignore the lock and continue" stream)))
(unlock-package ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Disable package's lock then continue" stream))
(setf (ext:package-lock package) nil))
(unlock-all ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Unlock all packages, then continue" stream))
(unlock-all-packages)))))
;;
@@ -1534,15 +1528,13 @@
(list (package-%name package) cset
(mapcar #'package-%name cpackages)))
(unintern-conflicting-symbols ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Unintern conflicting symbols." stream))
(dolist (p cpackages)
(dolist (sym cset)
(moby-unintern sym p))))
(skip-exporting-these-symbols ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Skip exporting conflicting symbols." stream))
(setq syms (nset-difference syms cset))))))
;;
@@ -1591,17 +1583,14 @@
:format-control _"unexporting symbols ~A"
:format-arguments (list symbols))
(continue ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Ignore the lock and continue" stream)))
(unlock-package ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Disable package's lock then continue" stream))
(setf (ext:package-lock package) nil))
(unlock-all ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Unlock all packages, then continue" stream))
(unlock-all-packages)))))
(dolist (sym (symbol-listify symbols))
Index: src/code/serve-event.lisp
diff -u src/code/serve-event.lisp:1.28.12.3 src/code/serve-event.lisp:1.28.12.4
--- src/code/serve-event.lisp:1.28.12.3 Wed Feb 10 09:07:36 2010
+++ src/code/serve-event.lisp Sat Feb 13 12:10:09 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/serve-event.lisp,v 1.28.12.3 2010-02-10 14:07:36 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/serve-event.lisp,v 1.28.12.4 2010-02-13 17:10:09 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -241,20 +241,17 @@
(restart-case (error "~S ~[have~;has a~:;have~] bad file descriptor~:P."
bogus-handlers (length bogus-handlers))
(remove-them ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Remove bogus handlers." stream))
(setf *descriptor-handlers*
(delete-if #'handler-bogus *descriptor-handlers*)))
(retry-them ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Retry bogus handlers." stream))
(dolist (handler bogus-handlers)
(setf (handler-bogus handler) nil)))
(continue ()
- :report (lambda (condition stream)
- (declare (ignore condition))
+ :report (lambda (stream)
(write-string _"Go on, leaving handlers marked as bogus." stream))))))
More information about the cmucl-commit
mailing list