From: Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
Date: Tue, 16 Jul 2013 21:15:02 +0000 (+0200)
Subject: Simplify RESTART-BIND and improve documentation string
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=0337d730355489f27cb3e1527d45c27fd2243ddf;p=sbcl.git

Simplify RESTART-BIND and improve documentation string

* Mention syntax in documentation string.

* Simplify implementation using a location function PARSE-BINDING and
  DESTRUCTURING-BIND.
---

diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp
index d636685..046006b 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...