made debugger handle errors in printing *DEBUG-CONDITION*

[sbcl.git] / src / compiler / macros.lisp

diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp
index ac826c1..72f9278 100644 (file)
--- a/src/compiler/macros.lisp
+++ b/src/compiler/macros.lisp
@@ -11,9 +11,6 @@
 
 (in-package "SB!C")
 
 
 (in-package "SB!C")
 

-(file-comment
-  "$Header$")
-

 (declaim (special *wild-type* *universal-type* *compiler-error-context*))
 
 ;;; An INLINEP value describes how a function is called. The values have these
 (declaim (special *wild-type* *universal-type* *compiler-error-context*))
 
 ;;; An INLINEP value describes how a function is called. The values have these

@@ -131,8 +128,8 @@
             `((setf (symbol-function ',name)
                     (lambda (&rest rest)
                       (declare (ignore rest))
             `((setf (symbol-function ',name)
                     (lambda (&rest rest)
                       (declare (ignore rest))

-                      (error "Can't FUNCALL the SYMBOL-FUNCTION of ~
-                              special forms.")))))))))
+                      (error "can't FUNCALL the SYMBOL-FUNCTION of ~
+                              special forms")))))))))

 
 ;;; Similar to DEF-IR1-TRANSLATOR, except that we pass if the syntax is
 ;;; invalid.
 
 ;;; Similar to DEF-IR1-TRANSLATOR, except that we pass if the syntax is
 ;;; invalid.

@@ -212,7 +209,7 @@
     (dolist (name names)
       (let ((mask (cdr (assoc name alist))))
        (unless mask
     (dolist (name names)
       (let ((mask (cdr (assoc name alist))))
        (unless mask

-         (error "Unknown attribute name: ~S." name))
+         (error "unknown attribute name: ~S" name))

        (res mask)))
     (res)))
 
        (res mask)))
     (res)))
 

@@ -572,7 +569,7 @@
   for various optimizers that the function might have."
   (when (and (intersection attributes '(any call unwind))
             (intersection attributes '(movable)))
   for various optimizers that the function might have."
   (when (and (intersection attributes '(any call unwind))
             (intersection attributes '(movable)))

-    (error "Function cannot have both good and bad attributes: ~S" attributes))
+    (error "function cannot have both good and bad attributes: ~S" attributes))

 
   `(%defknown ',(if (and (consp name)
                         (not (eq (car name) 'setf)))
 
   `(%defknown ',(if (and (consp name)
                         (not (eq (car name) 'setf)))

@@ -638,7 +635,7 @@
 
   If supplied, Result-Form is the value to return."
   (unless (member ends '(nil :head :tail :both))
 
   If supplied, Result-Form is the value to return."
   (unless (member ends '(nil :head :tail :both))

-    (error "Losing Ends value: ~S." ends))
+    (error "losing ENDS value: ~S" ends))

   (let ((n-component (gensym))
        (n-tail (gensym)))
     `(let* ((,n-component ,component)
   (let ((n-component (gensym))
        (n-tail (gensym)))
     `(let* ((,n-component ,component)

@@ -656,7 +653,7 @@
   "Do-Blocks-Backwards (Block-Var Component [Ends] [Result-Form]) {Declaration}* {Form}*
   Like Do-Blocks, only iterate over the blocks in reverse order."
   (unless (member ends '(nil :head :tail :both))
   "Do-Blocks-Backwards (Block-Var Component [Ends] [Result-Form]) {Declaration}* {Form}*
   Like Do-Blocks, only iterate over the blocks in reverse order."
   (unless (member ends '(nil :head :tail :both))

-    (error "Losing Ends value: ~S." ends))
+    (error "losing ENDS value: ~S" ends))

   (let ((n-component (gensym))
        (n-head (gensym)))
     `(let* ((,n-component ,component)
   (let ((n-component (gensym))
        (n-head (gensym)))
     `(let* ((,n-component ,component)

@@ -1014,7 +1011,7 @@
   Next. Key, Test and Test-Not are the same as for generic sequence
   functions."
   (when (and test-p not-p)
   Next. Key, Test and Test-Not are the same as for generic sequence
   functions."
   (when (and test-p not-p)

-    (error "It's silly to supply both :Test and :Test-Not."))
+    (error "It's silly to supply both :TEST and :TEST-NOT arguments."))

   (if not-p
       (do ((current list (funcall next current)))
          ((null current) nil)
   (if not-p
       (do ((current list (funcall next current)))
          ((null current) nil)

@@ -1037,7 +1034,7 @@
   linked by the accessor function Next. Key, Test and Test-Not are the same as
   for generic sequence functions."
   (when (and test-p not-p)
   linked by the accessor function Next. Key, Test and Test-Not are the same as
   for generic sequence functions."
   (when (and test-p not-p)

-    (error "Silly to supply both :Test and :Test-Not."))
+    (error "It's silly to supply both :TEST and :TEST-NOT arguments."))

   (if not-p
       (do ((current list (funcall next current))
           (i 0 (1+ i)))
   (if not-p
       (do ((current list (funcall next current))
           (i 0 (1+ i)))