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