0.6.11.30:

[sbcl.git] / src / code / early-target-error.lisp

diff --git a/src/code/early-target-error.lisp b/src/code/early-target-error.lisp
index 8ea1f03..216a9fe 100644 (file)
--- a/src/code/early-target-error.lisp
+++ b/src/code/early-target-error.lisp
@@ -10,10 +10,7 @@
 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
 ;;;; files for more information.
 
-(in-package "SB!CONDITIONS")
-
-(sb!int:file-comment
-  "$Header$")
+(in-package "SB!KERNEL")
 \f
 ;;;; restarts
 
@@ -46,7 +43,7 @@
            (res restart))))
       (res))))
 
-(defstruct restart
+(defstruct (restart (:copier nil))
   name
   function
   report-function
@@ -317,9 +314,10 @@
                                bindings))
                *handler-clusters*)))
      (multiple-value-prog1
-      ,@forms
-      ;; Wait for any float exceptions
-      #!+x86 (float-wait))))
+        (progn
+          ,@forms)
+       ;; Wait for any float exceptions.
+       #!+x86 (float-wait))))
 \f
 ;;;; HANDLER-CASE and IGNORE-ERRORS
 
@@ -379,65 +377,6 @@
                                         body))))
                           annotated-cases))))))))
 
-;;; FIXME: Delete this when the system is stable.
-#|
-This macro doesn't work in our system due to lossage in closing over tags.
-The previous version sets up unique run-time tags.
-
-(defmacro handler-case (form &rest cases)
-  #!+sb-doc
-  "(HANDLER-CASE form
-   { (type ([var]) body) }* )
-   Executes form in a context with handlers established for the condition
-   types. A peculiar property allows type to be :no-error. If such a clause
-   occurs, and form returns normally, all its values are passed to this clause
-   as if by MULTIPLE-VALUE-CALL. The :no-error clause accepts more than one
-   var specification."
-  (let ((no-error-clause (assoc ':no-error cases)))
-    (if no-error-clause
-       (let ((normal-return (make-symbol "normal-return"))
-             (error-return  (make-symbol "error-return")))
-         `(block ,error-return
-            (multiple-value-call #'(lambda ,@(cdr no-error-clause))
-              (block ,normal-return
-                (return-from ,error-return
-                  (handler-case (return-from ,normal-return ,form)
-                    ,@(remove no-error-clause cases)))))))
-       (let ((tag (gensym))
-             (var (gensym))
-             (annotated-cases (mapcar #'(lambda (case) (cons (gensym) case))
-                                      cases)))
-         `(block ,tag
-            (let ((,var nil))
-              ,var                             ;ignorable
-              (tagbody
-                (handler-bind
-                 ,(mapcar #'(lambda (annotated-case)
-                              (list (cadr annotated-case)
-                                    `#'(lambda (temp)
-                                         ,(if (caddr annotated-case)
-                                              `(setq ,var temp)
-                                              '(declare (ignore temp)))
-                                         (go ,(car annotated-case)))))
-                          annotated-cases)
-                              (return-from ,tag ,form))
-                ,@(mapcan
-                   #'(lambda (annotated-case)
-                       (list (car annotated-case)
-                             (let ((body (cdddr annotated-case)))
-                               `(return-from
-                                 ,tag
-                                 ,(cond ((caddr annotated-case)
-                                         `(let ((,(caaddr annotated-case)
-                                                 ,var))
-                                            ,@body))
-                                        ((not (cdr body))
-                                         (car body))
-                                        (t
-                                         `(progn ,@body)))))))
-                          annotated-cases))))))))
-|#
-
 (defmacro ignore-errors (&rest forms)
   #!+sb-doc
   "Executes forms after establishing a handler for all error conditions that
@@ -450,7 +389,7 @@ The previous version sets up unique run-time tags.
 
 (defun assert-error (assertion places datum &rest arguments)
   (let ((cond (if datum
-               (sb!conditions::coerce-to-condition datum
+               (coerce-to-condition datum
                                                    arguments
                                                    'simple-error
                                                    'error)
@@ -504,7 +443,7 @@ The previous version sets up unique run-time tags.
 
 (defun case-body-error (name keyform keyform-value expected-type keys)
   (restart-case
-      (error 'sb!conditions::case-failure
+      (error 'case-failure
             :name name
             :datum keyform-value
             :expected-type expected-type