From: Stas Boukarev Date: Thu, 7 Nov 2013 22:45:12 +0000 (+0400) Subject: Optimize RESTART-BIND. X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=7cd7b23c6930e88e2185d76524dc56b789193d51;hp=9b81111025d01fb7a708e1ab114646e7807d1b46;p=sbcl.git 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. --- 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)