Создайте имя класса доступа из строки внутри макроса CL

Question

Я пытаюсь написать следующий код, чтобы написать макрос, который, учитывая имя класса, автоматически создает класс с переменной экземпляра name и аксессуар для него в форме от classname-name.

(defmacro def-named-class (class-name) 
    `(defclass ,class-name() 
    ((name :accessor ,(intern (format nil "~A-~A" class-name "name")) 
      :initarg :name 
      :initform "")))) 

Проблема здесь заключается в том, что, когда макрос работает, скажем, с аргументом foo, имя функции аксессора приходит как |FOO-name|, но я хотел бы, чтобы это было просто foo-name. Причина в том, (intern "foo-name") возвращает символ |foo-name|. Однако, если я пытаюсь сделать то же самое с нормальной функцией, например:

(defmacro def-hyp (name1 name2 arg-list &body body) 
    `(defun ,(intern (format nil "~A-~A" name1 name2)) 
      ,arg-list 
      ,@body)) 

А потом называют это как (def-hyp foo name() 'foo-name) он правильно производит функцию с именем foo-name. Поэтому мне интересно, есть ли какой-либо метод для получения одного и того же символа из строкового представления внутри первого макроса. Я использую Clozure CL.

Answer 1

Вы должны преобразовать имя в верхнем регистре:

(defmacro def-named-class (class-name) 
    `(defclass ,class-name() 
    ((name :accessor ,(intern (format nil "~A-~A" (string-upcase class-name) "NAME")) 
      :initarg :name 
      :initform "")))) 

Другая возможность, как это было предложено в комментарии по jkiiski, чтобы изменить только формат строки:

... 
((name :accessor ,(intern (format nil "~:@(~A-~A~)" class-name "name")) 
... 

Причина заключается в том, что Поведение Common Lisp по умолчанию - преобразование любого символа в верхнем регистре при его чтении. Итак, когда вы пишете foo-name, он автоматически преобразуется в FOO-NAME. Чтобы получить его, вы должны использовать (intern "FOO-NAME"). Однако, если вы хотите, вы можете изменить поведение читателя по умолчанию (см. manual).

Answer 2

Обратите внимание, что класс уже имеет имя.

CL-USER 19 > (defclass foo()()) 
#<STANDARD-CLASS FOO 415040BE6B> 

CL-USER 20 > (class-name *) 
FOO 

Answer 3

Не лучше ли это решение наследованием? Вот ваш Mixin:

(defclass named() 
    ((name :initarg :name :accessor name-of))) 

... и вы можете использовать его для всех других классов, которые определяют объекты, которые имеют название:

(defclass this (named) ...) 
(defclass that (named) ...)