From 9b81111025d01fb7a708e1ab114646e7807d1b46 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Fri, 8 Nov 2013 02:26:47 +0400 Subject: [PATCH] Optimize RESTART-CASE. Optimize a case when restart handlers have zero or one arguments: instead of saving a &rest list and then applying a function, don't save anything, or save one argument and use FUNCALL. Based on a patch by Jan Moringen. Closes lp#1249055. --- NEWS | 2 ++ src/code/defboot.lisp | 33 ++++++++++++++++++++++++--------- 2 files changed, 26 insertions(+), 9 deletions(-) diff --git a/NEWS b/NEWS index 9ec0f85..0605d50 100644 --- a/NEWS +++ b/NEWS @@ -5,6 +5,8 @@ changes relative to sbcl-1.1.13: * optimization: [N]BUTLAST perform a single pass over the list. (lp#1245697) * optimization: EQUALP on structures with raw slots (double-float/complex) no longer conses and is faster. + * optimization: RESTART-CASE expands to more compact code. + Thanks to Jan Moringen. (lp#1249055) * enhancement: Top-level defmethod without defgeneric no longer causes undefined-function warnings in subsequent forms. (lp#503095) * bug fix: EQUALP now compares correctly structures with raw slots larger diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp index 3ce3db4..c3bb341 100644 --- a/src/code/defboot.lisp +++ b/src/code/defboot.lisp @@ -522,7 +522,7 @@ evaluated as a PROGN." (return (values result form)))) result))))) (parse-clause (clause) - (unless (and (listp clause ) (>= (length clause) 2) + (unless (and (listp clause) (>= (length clause) 2) (listp (second clause))) (error "ill-formed ~S clause, no lambda-list:~% ~S" 'restart-case clause)) @@ -531,18 +531,33 @@ evaluated as a PROGN." (parse-keywords-and-body body) (list name (sb!xc:gensym "TAG") keywords lambda-list body)))) (make-binding (clause-data) - (destructuring-bind (name tag keywords &rest rest) clause-data - (declare (ignore rest)) - `(,name #'(lambda (&rest temp) - (setq ,temp-var temp) - (locally (declare (optimize (safety 0))) - (go ,tag))) - ,@keywords))) + (destructuring-bind (name tag keywords lambda-list body) clause-data + (declare (ignore body)) + `(,name + (lambda ,(cond ((null lambda-list) + ()) + ((and (null (cdr lambda-list)) + (not (member (car lambda-list) + '(&optional &key &aux)))) + '(temp)) + (t + '(&rest temp))) + ,@(when lambda-list `((setq ,temp-var temp))) + (locally (declare (optimize (safety 0))) + (go ,tag))) + ,@keywords))) (make-apply-and-return (clause-data) (destructuring-bind (name tag keywords lambda-list body) clause-data (declare (ignore name keywords)) `(,tag (return-from ,block-tag - (apply (lambda ,lambda-list ,@body) ,temp-var)))))) + ,(cond ((null lambda-list) + `(progn ,@body)) + ((and (null (cdr lambda-list)) + (not (member (car lambda-list) + '(&optional &key &aux)))) + `(funcall (lambda ,lambda-list ,@body) ,temp-var)) + (t + `(apply (lambda ,lambda-list ,@body) ,temp-var)))))))) (let ((clauses-data (mapcar #'parse-clause clauses))) `(block ,block-tag (let ((,temp-var nil)) -- 1.7.10.4