X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefboot.lisp;h=33b265018b33443035d8a37aead29d3faa7729d6;hb=7dfa54273d2ebc6c2be9a39ab5cd6df639d340c9;hp=d636685da0bf2ffefe45d8df3402b8ed6154dfdc;hpb=1fa1730414b6c914e502d339945d0ad7a4a7f5d9;p=sbcl.git

diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp
index d636685..33b2650 100644
--- a/src/code/defboot.lisp
+++ b/src/code/defboot.lisp
@@ -426,25 +426,26 @@ evaluated as a PROGN."
 
 (defmacro-mundanely restart-bind (bindings &body forms)
   #!+sb-doc
-  "Executes forms in a dynamic context where the given restart bindings are
-   in effect. Users probably want to use RESTART-CASE. When clauses contain
-   the same restart name, FIND-RESTART will find the first such clause."
-  `(let ((*restart-clusters*
-          (cons (list
-                 ,@(mapcar (lambda (binding)
-                             (unless (or (car binding)
-                                         (member :report-function
-                                                 binding
-                                                 :test #'eq))
-                               (warn "Unnamed restart does not have a ~
-                                      report function: ~S"
-                                     binding))
-                             `(make-restart :name ',(car binding)
-                                            :function ,(cadr binding)
-                                            ,@(cddr binding)))
-                           bindings))
-                *restart-clusters*)))
-     ,@forms))
+  "(RESTART-BIND ({(case-name function {keyword value}*)}*) forms)
+   Executes forms in a dynamic context where the given bindings are in
+   effect. Users probably want to use RESTART-CASE. A case-name of NIL
+   indicates an anonymous restart. When bindings contain the same
+   restart name, FIND-RESTART will find the first such binding."
+  (flet ((parse-binding (binding)
+           (unless (>= (length binding) 2)
+             (error "ill-formed restart binding: ~S" binding))
+           (destructuring-bind (name function
+                                &rest args
+                                &key report-function &allow-other-keys)
+               binding
+             (unless (or name report-function)
+               (warn "Unnamed restart does not have a report function: ~
+                      ~S" binding))
+             `(make-restart :name ',name :function ,function ,@args))))
+    `(let ((*restart-clusters*
+             (cons (list ,@(mapcar #'parse-binding bindings))
+                   *restart-clusters*)))
+       ,@forms)))
 
 ;;; Wrap the RESTART-CASE expression in a WITH-CONDITION-RESTARTS if
 ;;; appropriate. Gross, but it's what the book seems to say...
@@ -529,7 +530,8 @@ evaluated as a PROGN."
                  (declare (ignore rest))
                  `(,name #'(lambda (&rest temp)
                              (setq ,temp-var temp)
-                             (go ,tag))
+                             (locally (declare (optimize (safety 0)))
+                               (go ,tag)))
                          ,@keywords)))
              (make-apply-and-return (clause-data)
                (destructuring-bind (name tag keywords lambda-list body) clause-data