LINUX.ORG.RU

[common lisp] Макрос: перевести 'index' в ':index'

 


0

1

Я пишу макрос, который являет собой обертку над defclass.

Он принимает в качестве параметров имя класса и список слотов в формате

(slot-name slot-initform) ==>> (slot1 555) (slot2 "aaa")

(defclass common-core-object ()
  ())

;;; Generic functions to converting from/to xml and validating.
;;; All common-core-object children must define method from this generic.
(defgeneric to-xml (object))
(defgeneric from-xml (object))
(defgeneric validity-info (object))
(defgeneric validity-info-with (object object2))

(defmacro define-common-core-object (class-name &rest args)
  (let ((slots nil)
	(current-slot nil)
	(class-name-str (format nil "~(~a~)" class-name))
	(xml-attributes nil)
	(xml-nodes nil))

    ; Calculate class slots.
    (dolist (arg args)
      (let ((slot-name (nth 0 arg))
	    (slot-initform (nth 1 arg)))
	(setf current-slot `(,slot-name
			      :initarg ,slot-name
			      :initform ,slot-initform
			      :accessor ,slot-name)))
      (push current-slot slots))

    ; Calculate xml attributes.
    (dolist (slot args)
      (let ((slot-name (nth 0 slot)))
	(push `(list (format nil "~(~a~)" ',slot-name)
		     (format nil "~(~a~)" (slot-value obj ',slot-name)))
	      xml-attributes)))

    `(progn
       (defclass ,class-name (common-core-object)
	 (,@(reverse slots)))
       (defmethod to-xml ((obj ,class-name))
	 (list ,class-name-str 
	       (list ,@(reverse xml-attributes))
;	       (list ,@(reverse xml-nodes))
)))))

Проблема здесь:

    (dolist (arg args)
      (let ((slot-name (nth 0 arg))
	    (slot-initform (nth 1 arg)))
	(setf current-slot `(,slot-name
trouble>>>>>>>>>>>            :initarg ,slot-name
			      :initform ,slot-initform
			      :accessor ,slot-name)))
      (push current-slot slots))

Поскольку :initarg должен быть не slot-name, а :slot-name (ДВОЕТОЧИЕ В НАЧАЛЕ), возникает ошибка.

Вопрос: можно ли как-то в макросе перевести выражение в его эквивалент с двоеточием в начале?

★★

clhs://symbol-string, string-upcase, concatenate, intern

anonymous
()
(defun symbol->keyword (symbol)
  (intern (symbol-name symbol) :keyword))

...
     :initarg ,(symbol->keyword slot-name)
...
tarc
()
Ответ на: комментарий от yoghurt

Не ткнете пальцем в нормальный ман по прикрутке xml-backend'a?

bk_ ★★
() автор топика
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.