X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsetf-funs.lisp;h=5899a243cbd85b5fa6239ae4ef33b415307df49a;hb=970dd272dc84f7420252eadb4829cc193f795716;hp=3e18ea60b37c19546dc98bee9461229d5aaac713;hpb=581e3d62de8cb37e13ad9db63e5537c0f962be28;p=sbcl.git diff --git a/src/code/setf-funs.lisp b/src/code/setf-funs.lisp index 3e18ea6..5899a24 100644 --- a/src/code/setf-funs.lisp +++ b/src/code/setf-funs.lisp @@ -16,18 +16,18 @@ (defun compute-one-setter (name type) (let* ((args (second type)) - (res (type-specifier - (single-value-type - (values-specifier-type (third type))))) - (arglist (make-gensym-list (1+ (length args))))) + (res (type-specifier + (single-value-type + (values-specifier-type (third type))))) + (arglist (make-gensym-list (1+ (length args))))) (cond ((null (intersection args sb!xc:lambda-list-keywords)) `(defun (setf ,name) ,arglist - (declare ,@(mapcar (lambda (arg type) - `(type ,type ,arg)) - arglist - (cons res args))) - (setf (,name ,@(rest arglist)) ,(first arglist)))) + (declare ,@(mapcar (lambda (arg type) + `(type ,type ,arg)) + arglist + (cons res args))) + (setf (,name ,@(rest arglist)) ,(first arglist)))) (t (warn "hairy SETF expander for function ~S" name) nil)))) @@ -37,15 +37,15 @@ (collect ((res)) (dolist (pkg packages) (do-external-symbols (sym pkg) - (when (and (fboundp sym) - (eq (info :function :kind sym) :function) - (or (info :setf :inverse sym) - (info :setf :expander sym)) - (not (member sym ignore))) - (let ((type (type-specifier (info :function :type sym)))) - (aver (consp type)) - #!-sb-fluid (res `(declaim (inline (setf ,sym)))) - (res (compute-one-setter sym type)))))) + (when (and (fboundp sym) + (eq (info :function :kind sym) :function) + (or (info :setf :inverse sym) + (info :setf :expander sym)) + (not (member sym ignore))) + (let ((type (type-specifier (info :function :type sym)))) + (aver (consp type)) + #!-sb-fluid (res `(declaim (inline (setf ,sym)))) + (res (compute-one-setter sym type)))))) `(progn ,@(res)))) ) ; EVAL-WHEN