X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffunction-names.lisp;h=029b795a8b924aaabda26297290aca99dae09a61;hb=ba7ca928e3a3bee761f717daaed689dab977c61c;hp=405916db5b77c05194c948f4689c8ed81f99d6f3;hpb=bd0ba0f214518e8d72ff2d44de5a1e3e4b02af2c;p=sbcl.git diff --git a/src/code/function-names.lisp b/src/code/function-names.lisp index 405916d..029b795 100644 --- a/src/code/function-names.lisp +++ b/src/code/function-names.lisp @@ -6,9 +6,9 @@ (defun %define-fun-name-syntax (symbol checker) (let ((found (assoc symbol *valid-fun-names-alist* :test #'eq))) (if found - (setf (cdr found) checker) - (setq *valid-fun-names-alist* - (acons symbol checker *valid-fun-names-alist*))))) + (setf (cdr found) checker) + (setq *valid-fun-names-alist* + (acons symbol checker *valid-fun-names-alist*))))) (defmacro define-function-name-syntax (symbol (var) &body body) #!+sb-doc @@ -44,16 +44,17 @@ use as a BLOCK name in the function in question." (otherwise nil))) (define-function-name-syntax setf (name) - (when (cdr name) + (when (and (cdr name) + (consp (cdr name))) (destructuring-bind (fun &rest rest) (cdr name) (when (null rest) - (typecase fun - ;; ordinary (SETF FOO) case - (symbol (values t fun)) - ;; reasonable (SETF (QUUX BAZ)) case [but not (SETF (SETF - ;; FOO))] - (cons (unless (eq (car fun) 'setf) - (valid-function-name-p fun)))))))) + (typecase fun + ;; ordinary (SETF FOO) case + (symbol (values t fun)) + ;; reasonable (SETF (QUUX BAZ)) case [but not (SETF (SETF + ;; FOO))] + (cons (unless (eq (car fun) 'setf) + (valid-function-name-p fun)))))))) #-sb-xc-host (defun !function-names-cold-init ()