From 7cd7b23c6930e88e2185d76524dc56b789193d51 Mon Sep 17 00:00:00 2001
From: Stas Boukarev <stassats@gmail.com>
Date: Fri, 8 Nov 2013 02:45:12 +0400
Subject: [PATCH] Optimize RESTART-BIND.

Change MAKE-RESTART lambda-list to
(name function
 &optional report-function interactive-function test-function)
instead of using the default structure constructor with keywords.
MAKE-RESTART is only used in RESTART-BIND, and this allows for more
compact calls and not having to parse keyword parameters should
make the code slightly faster.
---
 src/code/defboot.lisp      |   11 ++++++++---
 src/code/target-error.lisp |   11 ++++++++++-
 2 files changed, 18 insertions(+), 4 deletions(-)

diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp
index c3bb341..c9fca38 100644
--- a/src/code/defboot.lisp
+++ b/src/code/defboot.lisp
@@ -440,13 +440,18 @@ evaluated as a PROGN."
            (unless (>= (length binding) 2)
              (error "ill-formed restart binding: ~S" binding))
            (destructuring-bind (name function
-                                &rest args
-                                &key report-function &allow-other-keys)
+                                &key interactive-function
+                                     test-function
+                                     report-function)
                binding
              (unless (or name report-function)
                (warn "Unnamed restart does not have a report function: ~
                       ~S" binding))
-             `(make-restart :name ',name :function ,function ,@args))))
+             `(make-restart ',name ,function
+                            ,report-function
+                            ,interactive-function
+                            ,@(and test-function
+                                   `(,test-function))))))
     `(let ((*restart-clusters*
              (cons (list ,@(mapcar #'parse-binding bindings))
                    *restart-clusters*)))
diff --git a/src/code/target-error.lisp b/src/code/target-error.lisp
index 9a7aa8f..d92a978 100644
--- a/src/code/target-error.lisp
+++ b/src/code/target-error.lisp
@@ -37,7 +37,14 @@
 (declaim (inline restart-test-function
                  restart-associated-conditions
                  (setf restart-associated-conditions)))
-(defstruct (restart (:copier nil) (:predicate nil))
+(defstruct (restart (:constructor make-restart
+                        ;; Having TEST-FUNCTION at the end allows
+                        ;; to not replicate its default value in RESTART-BIND.
+                        (name function
+                         &optional report-function
+                                   interactive-function
+                                   test-function))
+                    (:copier nil) (:predicate nil))
   (name (missing-arg) :type symbol :read-only t)
   (function (missing-arg) :type function :read-only t)
   (report-function nil :type (or null function) :read-only t)
@@ -50,6 +57,8 @@
   ;; extent.
   (associated-conditions '() :type list))
 
+#!-sb-fluid (declaim (freeze-type restart))
+
 (def!method print-object ((restart restart) stream)
   (if *print-escape*
       (print-unreadable-object (restart stream :type t :identity t)
-- 
1.7.10.4