[Sbcl-commits] CVS: sbcl/src/code cold-error.lisp,1.16,1.17 error.lisp,1.14,1.15

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1:/tmp/cvs-serv7058/src/code

Modified Files:
	cold-error.lisp error.lisp 
Log Message:
0.8.2.10:
	Implement SB-EXT:CODE-DELETION-NOTE, at least partly for 
	pfdietz' benefit
	... I'm too nice, really I am;
	... we're going to need COERCE-TO-CONDITION in the 
		cross-compiler;
	... extract (somewhat bogusly) format control and arguments from 
		the condition in the SIMPLE-CONDITION case, so that warm
		init doesn't print every compiler note in long form.


Index: cold-error.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/cold-error.lisp,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -d -r1.16 -r1.17
--- cold-error.lisp	22 Apr 2003 21:39:20 -0000	1.16
+++ cold-error.lisp	30 Jul 2003 16:07:45 -0000	1.17
@@ -50,33 +50,6 @@
     (/noshow0 "returning from SIGNAL")
     nil))
 
-;;; a utility for SIGNAL, ERROR, CERROR, WARN, and INVOKE-DEBUGGER:
-;;; Parse the hairy argument conventions into a single argument that's
-;;; directly usable by all the other routines.
-(defun coerce-to-condition (datum arguments default-type fun-name)
-  (cond ((typep datum 'condition)
-	 (if arguments
-	     (cerror "Ignore the additional arguments."
-		     'simple-type-error
-		     :datum arguments
-		     :expected-type 'null
-		     :format-control "You may not supply additional arguments ~
-				     when giving ~S to ~S."
-		     :format-arguments (list datum fun-name)))
-	 datum)
-	((symbolp datum) ; roughly, (SUBTYPEP DATUM 'CONDITION)
-	 (apply #'make-condition datum arguments))
-	((or (stringp datum) (functionp datum))
-	 (make-condition default-type
-			 :format-control datum
-			 :format-arguments arguments))
-	(t
-	 (error 'simple-type-error
-		:datum datum
-		:expected-type '(or symbol string)
-		:format-control "bad argument to ~S: ~S"
-		:format-arguments (list fun-name datum)))))
-
 ;;; a shared idiom in ERROR, CERROR, and BREAK: The user probably
 ;;; doesn't want to hear that the error "occurred in" one of these
 ;;; functions, so we try to point the top of the stack to our caller

Index: error.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/error.lisp,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- error.lisp	30 Jun 2003 04:24:14 -0000	1.14
+++ error.lisp	30 Jul 2003 16:07:45 -0000	1.15
@@ -23,6 +23,33 @@
 	:format-control format-control
 	:format-arguments format-arguments))
 
+;;; a utility for SIGNAL, ERROR, CERROR, WARN, COMPILER-NOTIFY and
+;;; INVOKE-DEBUGGER: Parse the hairy argument conventions into a
+;;; single argument that's directly usable by all the other routines.
+(defun coerce-to-condition (datum arguments default-type fun-name)
+  (cond ((typep datum 'condition)
+	 (if arguments
+	     (cerror "Ignore the additional arguments."
+		     'simple-type-error
+		     :datum arguments
+		     :expected-type 'null
+		     :format-control "You may not supply additional arguments ~
+				     when giving ~S to ~S."
+		     :format-arguments (list datum fun-name)))
+	 datum)
+	((symbolp datum) ; roughly, (SUBTYPEP DATUM 'CONDITION)
+	 (apply #'make-condition datum arguments))
+	((or (stringp datum) (functionp datum))
+	 (make-condition default-type
+			 :format-control datum
+			 :format-arguments arguments))
+	(t
+	 (error 'simple-type-error
+		:datum datum
+		:expected-type '(or symbol string)
+		:format-control "bad argument to ~S: ~S"
+		:format-arguments (list fun-name datum)))))
+
 (define-condition layout-invalid (type-error)
   ()
   (:report