Цитирование в макросе, определяющем макрос

Я пытаюсь написать макрос, который определяет некоторые помощники для структуры данных struct-of-arrays (на основе этого фрагмент). Внутри этого макроса я определяю другой макрос, который помогает обойти все значения слотов в структуре. Дело в том, что я не могу заставить работать двойное удаление кавычек должным образом. Вот код:

(defmacro defcomponent (name-and-options &body slots)
  (setf name-and-options (ensure-list name-and-options))
  (let ((struct (first name-and-options))
        (slot-names (iter (for s in slots)
                          (collecting
                           (ematch s
                             ((or (and name (symbol)
                                       (<> _ '*)
                                       (<> _ nil))
                                  (list* name _ (plist :type _ :read-only _)))
                              name))))))
    `(progn (defstruct ,name-and-options
              ;; some task-specific stuff omitted here
              )
            (defmacro ,(symbolicate 'with- struct) (components &rest body)
              `(loop
                 ,@',(iter (for s in slot-names)
                          (appending `(for ,s across (,(symbolicate struct '- s) components))))
                 do ,@body)))))

Так, например, макрос (defcomponent buzz x y) расширяется до

(PROGN
 (DEFSTRUCT (BUZZ)
   X Y)  ;; details omitted
 (DEFMACRO WITH-BUZZ (COMPONENTS &REST BODY)
   `(LOOP ,@'(FOR X ACROSS (BUZZ-X COMPONENTS) FOR Y ACROSS (BUZZ-Y COMPONENTS))
          DO ,@BODY))

что-то вроде работает, но я хочу получить доступ к параметру components внутреннего макроса with-buzz, т.е. что-то вроде этого

(DEFMACRO WITH-BUZZ (COMPONENTS &REST BODY)
   `(LOOP FOR X ACROSS (BUZZ-X ,COMPONENTS) FOR Y ACROSS (BUZZ-Y ,COMPONENTS)
          DO ,@BODY))

Как мне этого добиться? Я пробовал много комбинаций , и ,@ безрезультатно.


common-lisp lisp-macros backquote
person Andrew Kravchuk    schedule 08.11.2019    source источник

Ответы (2)


arrow_upward
4
arrow_downward

Иногда помогает не работать с обратными кавычками. Тогда проблемы с областью видимости можно будет легче понять с помощью компилятора, который предупредит об обычных проблемах с переменной областью видимости.

В качестве слегка упрощенного упражнения напишем функцию, которая генерирует код. Сгенерированный код представляет собой макроопределение, которое само генерирует код.

(defun makeit (name slots)
  (labels ((symbolicate (pattern &rest things)
             (intern (apply #'format nil pattern things)))
           (compute-for-clauses (slots)
             (loop for s in slots
                   append (list ''for (list 'quote s)
                                ''across (list 'list
                                               (list 'quote
                                                     (symbolicate "~a-~a" name s))
                                               'components)))))

    (list 'progn
          (list 'defmacro
                (symbolicate "WITH-~a" name)
                '(components &rest body)
                (append '(list* 'loop)
                        (compute-for-clauses slots)
                        (list ''do 'body))))))

Пример

CL-USER 51 > (pprint (makeit 'buzz '(x y)))

(PROGN
  (DEFMACRO WITH-BUZZ (COMPONENTS &REST BODY)
    (LIST* 'LOOP
           'FOR
           'X
           'ACROSS
           (LIST 'BUZZ-X COMPONENTS)
           'FOR
           'Y
           'ACROSS
           (LIST 'BUZZ-Y COMPONENTS)
           'DO
           BODY)))

CL-USER 52 > (eval *)
NIL

CL-USER 53 > (macroexpand-1 '(with-buzz a (+ 12) (+ 30)))
(LOOP FOR X ACROSS (BUZZ-X A) FOR Y ACROSS (BUZZ-Y A) DO (+ 12) (+ 30))
T
person Rainer Joswig    schedule 09.11.2019

arrow_upward
0
arrow_downward

Хорошо, мне удалось сделать это, прибегнув к ручному построению списка + eval вместо квазицитирования, но милая божья мать, это выглядит так хаки.

;; skip
(defmacro ,(symbolicate 'with- struct) (components &rest body)
    (append
    '(loop)
    (eval
    `(iter (for s in ',',slot-names)
            (appending `(for ,s across (,(symbolicate ',',struct '- ,'s) ,,components)))))
    '(do)
    body))

Я с радостью приму любой другой ответ, решающий проблему более идиоматически.

person Andrew Kravchuk    schedule 08.11.2019