X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmacros.lisp;h=59de9b077e173b698d7e3d54180fe93dbe8f9ffa;hb=d306e2d23b38487488eb93881dad836e439e0c77;hp=99ca9dc49708c3349401b53108fec0a7b584ce22;hpb=c017b878e30a0bc9a175d3f5a1a4d3537804160c;p=sbcl.git

diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp
index 99ca9dc..59de9b0 100644
--- a/src/compiler/macros.lisp
+++ b/src/compiler/macros.lisp
@@ -514,21 +514,28 @@
 (defmacro defoptimizer (what (lambda-list &optional (n-node (sb!xc:gensym))
                                           &rest vars)
                              &body body)
-  (let ((name (if (symbolp what) what
-                  (symbolicate (first what) "-" (second what) "-OPTIMIZER"))))
-
-    (let ((n-args (gensym)))
-      `(progn
-        (defun ,name (,n-node ,@vars)
-          (declare (ignorable ,@vars))
-          (let ((,n-args (basic-combination-args ,n-node)))
-            ,(parse-deftransform lambda-list body n-args
-                                 `(return-from ,name nil))))
-        ,@(when (consp what)
-            `((setf (,(let ((*package* (symbol-package 'sb!c::fun-info)))
-                        (symbolicate "FUN-INFO-" (second what)))
-                     (fun-info-or-lose ',(first what)))
-                    #',name)))))))
+  (flet ((function-name (name)
+           (etypecase name
+             (symbol name)
+             ((cons (eql setf) (cons symbol null))
+              (symbolicate (car name) "-" (cadr name))))))
+   (let ((name (if (symbolp what)
+                   what
+                   (symbolicate (function-name (first what))
+                                "-" (second what) "-OPTIMIZER"))))
+
+     (let ((n-args (gensym)))
+       `(progn
+          (defun ,name (,n-node ,@vars)
+            (declare (ignorable ,@vars))
+            (let ((,n-args (basic-combination-args ,n-node)))
+              ,(parse-deftransform lambda-list body n-args
+                                   `(return-from ,name nil))))
+          ,@(when (consp what)
+              `((setf (,(let ((*package* (symbol-package 'sb!c::fun-info)))
+                          (symbolicate "FUN-INFO-" (second what)))
+                       (fun-info-or-lose ',(first what)))
+                      #',name))))))))
 
 ;;;; IR groveling macros