X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffunction-names.lisp;h=822ab8c23ec6f7f1b90134052db6fb369a08b504;hb=cd1b14acf6f548b28b8a14e554d779f0473122ec;hp=029b795a8b924aaabda26297290aca99dae09a61;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git

diff --git a/src/code/function-names.lisp b/src/code/function-names.lisp
index 029b795..822ab8c 100644
--- a/src/code/function-names.lisp
+++ b/src/code/function-names.lisp
@@ -56,6 +56,24 @@ use as a BLOCK name in the function in question."
           (cons (unless (eq (car fun) 'setf)
                   (valid-function-name-p fun))))))))
 
+(defun macro-function-name (name)
+  (when (and (cdr name)
+             (consp (cdr name)))
+    (destructuring-bind (fun &rest rest) (cdr name)
+      (when (null rest)
+        (typecase fun
+          ;; (DEFMACRO FOO)
+          (symbol (values t fun))
+          ;; (DEFMACRO (SETF FOO))
+          (cons (when (eq (car fun) 'setf)
+                  (valid-function-name-p fun))))))))
+
+(define-function-name-syntax defmacro (name)
+  (macro-function-name name))
+
+(define-function-name-syntax macrolet (name)
+  (macro-function-name name))
+
 #-sb-xc-host
 (defun !function-names-cold-init ()
   (setf *valid-fun-names-alist* '#.*valid-fun-names-alist*))