Changeset 5025

Timestamp:

Aug 25, 2006, 7:22:03 PM (18 years ago)

Author:

Gary Byers

Message:

HANDLER-CASE: the :NO-ERROR clause can appear at most once but doesn't
have to be the last clause.

File:

• trunk/ccl/lib/macros.lisp (modified) (3 diffs)

trunk/ccl/lib/macros.lisp

@@ -374 +374 @@
       
 
-(defmacro handler-case (form &rest clauses &aux last)
+(defmacro handler-case (form &rest clauses)
   "(HANDLER-CASE form
    { (type ([var]) body) }* )
@@ -382 +382 @@
    as if by MULTIPLE-VALUE-CALL.  The :NO-ERROR clause accepts more than one
    var specification."
-  (flet ((handler-case (type var &rest body)
-           (when (eq type :no-error)
-             (signal-program-error "The :no-error clause must be last."))
+  (let* ((no-error-clause (assoc :no-error clauses)))
+    (if no-error-clause
+      (let* ((normal-return (gensym))
+             (error-return (gensym)))
+        `(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 clauses)))))))
+      (flet ((handler-case (type var &rest body)
+               (when (eq type :no-error)
+                 (signal-program-error "Duplicate :no-error clause. "))
            (values type var body)))
-    (cond ((null clauses) form)
-          ((eq (car (setq last (car (last clauses)))) :no-error)
-           (let ((error (gensym))
-                 (block (gensym))
-                 (var   (cadr last)))
-             (if var
-               `(block ,error
-                  (multiple-value-call #'(lambda ,@(cdr last))
-                                       (block ,block
-                                         (return-from ,error
-                                           (handler-case (return-from ,block ,form)
-                                             ,@(butlast clauses))))))
-               `(block ,error
-                  (block ,block
-                    (return-from ,error
-                      (handler-case (return-from ,block ,form)
-                        ,@(butlast clauses))))
-                  (locally ,@(cddr last))))))
+        (cond ((null clauses) form)
           ((null (cdr clauses))
            (let ((block   (gensym))
@@ -440 +433 @@
                                 (catch ,cluster (return-from ,block ,form)))))
                     (case (pop ,val)
-                      ,@(nreverse cases)))))))))
+                      ,@(nreverse cases)))))))))))
 
 (defmacro with-simple-restart ((restart-name format-string &rest format-args)