Как хорошо известно, макро в Лиспе — это особая функция, которая вычисляется в два этапа: на первом этапе происходит генерация некоей промежуточной формы, а на втором этапе эта форма выполняется в текущем контексте.

Важно отметить, что на первом этапе ядро Лиспа не вычисляет значения аргументов вызова.

Использование макро в гомоиконном Лиспе позволяет добавлять в Лисп новые «операторы» (именно поэтому знаменитый лиспер Пол Грэм назвал Лисп программируемым языком программирования).

Однако, у медали имеется и обратная сторона: если код содержит большое количество макро, то при интерпретации Лиспа будет тратиться значительное время на макрогенерацию.

Цель этой небольшой заметки состоит в том, чтобы указать вполне очевидный способ снизить отмеченный недостаток использования макро. Этот способ состоит в том, что весь исполняемый код предварительно обрабатывается, в нём отыскиваются макровызовы и «раскрываются» (заменяются на результат макрогенерации).

Поскольку большая часть Лисп‑кода содержится в функциях, то достаточно разработать функцию, которая будет получать на вход имя обрабатываемой функции. Обработка будет состоять в том, что каждый макровызов будет заменяться результатом его раскрытия.

Выкладки мы будем выполнять в HomeLisp. Перечислим основные средства, которыми мы будем пользоваться:

мacroexpand (функция, которая строит макрорасширение);
proplist (получение списка свойств символа для того, чтобы отличить макровызов от вызова функции);
stat (функция, которая включает режим статистики);
getd и putd (функции доступа к телу EXPR‑функции).

Таким образом, наша задача состоит в том, чтобы взять произвольное выражение, найти все макровызовы, построить макрорасширение и заменить макровызов макрорасширением.

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

(defun is-macro (m)
  (cond ((listp m) nil)
        (t (member 'macro (proplist m)))))

Что здесь происходит? Если входной параметр функции есть список, то возвращается значение nil. В противном случае входной параметр есть символ. У этого символа проверяется список свойств, и, если этот список содержит символ macro, то символ m есть имя макро. Проверим работоспособность is‑macro:

(is-macro 'setf)
==> (MACRO)

(is-macro 'fact)
==> NIL

А теперь напишем код, который будет заменять макровызов его макрорасширением в произвольном s‑выражении. Код оказывается не слишком сложным:

(defun translate (forma)
   (cond ((atom forma) forma)
          ((listp (car forma))                   ;; Если голова - список
           (let ((cform (car forma)))
             (if (is-macro (car cform)) 
                 (cons (translate (eval `(macroexpand ,cform))) 
                       (translate (cdr forma)))
                 (cons (translate (car forma)) 
                       (translate (cdr forma))))))
          (t  (if (is-macro (car forma))    ;; Если голова - атом
                 (translate (eval `(macroexpand ,forma)))
                 (cons (car forma) 
                       (translate (cdr forma)))))))

Разберём более подробно программную логику этого кода.

На вход функции translate подаётся произвольная форма. Если эта форма есть атом, то этот атом возвращается как результат translate. Обратите внимание, что поскольку функция atom при аргументе, равном nil, вернёт истину (t), подобный код обеспечит корректное завершение рекурсивного цикла (результат вызова функции translate при значении аргумента nil будет равно nil).

Если же входной параметр есть список, то следует рассмотреть два случая:

голова этого списка есть атом;
голова этого списка есть список.

Если голова входного выражения есть список, то нужно рекурсивно применить нашу функцию к голове и хвосту списка. При применении функции к голове списка следует отделить случай, когда голова списка есть макровызов. Для этого выделяем голову списка (локальная переменная cform) и проверяем, является ли голова cform именем макро. Если это так, то конструируем результат, голова которого есть вычисленный результат макрогенерации, к которому рекурсивно применена функция translate, а хвост есть результат применения функции translate к хвосту исходного выражения.

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

Если голова исходного выражения есть атом, то в случае, когда этот атом есть имя макро, заменяем вызов результатом макрогенерации (как уже описано выше), затем применяем translate к хвосту исходного выражения.

Давайте протестируем нашу функцию. Начнем с достаточно простого примера:

(let ((x 5) 
      (y 8))
   (printline (list x y (+ x y))) 
   (incf x)  ;; макро
   (incf y)  ;; макро
   (printline (list x y (+ x y))))

;; вывод:

(5 8 13)
(6 9 15)
==> (6 9 15)

Здесь созданы две переменные, напечатаны их значения и значения суммы. Затем значения переменных увеличены с помощью макро incf и печать повторена.

Попробуем подать эту форму на вход нашей функции translate:

(translate 
      '(let ((x 5) 
             (y 8))
         (printline (list x y (+ x y))) 
         (incf x) 
         (incf y) 
         (printline (list x y (+ x y)))))         

;; вывод:

==> (LET ((X 5) 
          (Y 8))
      (PRINTLINE (LIST X Y (+ X Y))) 
      (SETQ X (+ 1 X)) 
      (SETQ Y (+ 1 Y)) 
      (PRINTLINE (LIST X Y (+ X Y))))

Как видим, произошло именно то, чего мы и добивались: макровызов заменился результатом раскрытия макро. Легко убедиться, что результат верен.

Рассмотрим теперь более сложный пример. В качестве базы возьмём приведённое в книге П.Грэма («ANSII Common Lisp», СПб, 2012, 448c.) макро ntimes:

(defmacro ntimes (n &rest body)
  (let ((g (gensym 'g))
        (h (gensym 'h)))
       `(let ((,h ,n))
          (do ((,g 0 (+ ,g 1)))
              ((>= ,g ,h))
              ,@body))))

Этот макро обеспечивает n‑кратное повторение некоторой формы body (которая может включать несколько s‑выражений). Мы не будем здесь рассматривать детали реализации макро (отсылаем читателя к уже цитированной замечательной книге П. Грэма). Проверим работу макро:

(let ((x 10))
  (ntimes 5 (print '*) (setq x (+ x 1))) x)

Здесь тело макро содержит два выражения: печать звёздочки и увеличение значения переменной x на единицу. Результат вычисления:

*****
==> 15

Проверим работу нашей функции translate на приведённом выше коде:

(translate '(let ((x 10))
              (ntimes 5 (print '*) (setq x (+ x 1))) x))

==> (LET ((X 10))
      (LET ((H10 5))
        (DO ((G9 0 (+ G9 1))) 
            ((>= G9 H10)) 
          (PRINT (QUOTE *))
          (SETQ X (+ X 1)))) 
      X)

Чтобы убедиться в правильности работы функции translate загрузим в REPL полученное выражение:

(LET ((X 10))
  (LET ((H10 5))
    (DO ((G9 0 (+ G9 1))) 
        ((>= G9 H10)) 
        (PRINT (QUOTE *))
        (SETQ X (+ X 1)))) 
  X)

;; вывод:

*****
==> 15

Результат совершенно правильный.

Представляет интерес, как будет работать наша функция на рекурсивных макро. Рассмотрим этот вопрос подробнее. Ниже приведено рекурсивное макро копирования списка:

(defmacro copy-list (x)
  (cond ((null x) Nil)
        (t (let ((ca (car x)) 
                 (cd (cdr x)))
             `(cons (quote ,ca) (copy-list ,cd))))))

Макро работает:

(copy-list (a b c d))

;; вывод:

==> (A B C D)

Теперь посмотрим, что даст применение translate:

(translate '(printline (copy-list (a b c))))

==> (PRINTLINE (CONS (QUOTE A) 
                 (CONS (QUOTE B) 
                   (CONS (QUOTE C) NIL))))

Как видим результат верен — наша техника успешно работает и на рекурсивны макро.

Теперь, когда мы научились преобразовывать произвольное s‑выражение, осталось разработать функцию преобразования тела EXPR‑функции. Сделать это теперь совсем просто:

(defun translate-f (func)
  (if (member 'EXPR (proplist func))
      (putd func (cdr (translate (getd func))))
      (raiseerror (strCat (output func) " - не функция!"))))

Функции translate‑f передаётся на вход имя EXPR‑функции. Сначала проверяется, является ли входной параметр именем «правильной функции». Если это так, то выполняется преобразование тела функции с помощью рассмотренной выше функции translate.

Ниже приводится функция, содержащая макро (в том числе и как аргумент другого макро):

(defun foo (x y &optional (n 5))
  (let ((xx x)
        (yy y))
    (ntimes n (setf xx (+ xx x)))
    (ntimes n (printline (list xx yy)))
   ‘OK))

Вызовем эту функцию:

(foo 10 20)

;; вывод:

(60 20)
(60 20)
(60 20)
(60 20)
(60 20)

==> OK

Обработаем нашу функцию foo с помощью translate‑f:

(translate-f 'foo)

==> ((X Y &OPTIONAL (N 5)) 
         (LET ((XX X) 
               (YY Y)) 
           (LET ((H20 N))
             (DO ((G19 0 (+ G19 1))) 
                 ((>= G19 H20)) 
                 (SETQ XX (+ XX X)))) 
           (LET ((H22 N)) 
             (DO ((G21 0 (+ G21 1))) 
                 ((>= G21 H22)) 
              (PRINTLINE (LIST XX YY)))) 
        (QUOTE OK)))

Мы видим новое тело функции foo. Если вызвать эту обновлённую функцию, мы получим прежний (верный) результат.

В заключение рассмотрим, какой выигрыш во времени даёт предварительное трансляция макро. Рассмотрим вот такую простую функцию:

(defun bar (n)
  (let ((s 0))
    (ntimes n (setf s (+ 1 s))) s))

Эта функция суммированием накапливает в переменной s значение, равное n:

(bar 2000)
==> 2000

Обработаем функцию bar:

(translate-f 'bar)

==> ((N) (LET ((S 0)) 
           (LET ((H36 N)) 
             (DO ((G35 0 (+ G35 1))) 
                 ((>= G35 H36)) 
                 (SETQ S (+ 1 S)))) S))

И снова вызовем обработанную функцию:

(bar 2000)
==> 2000

Получаем прежний результат. Если замерить время выполнения, то оказывается, что оказывается, что время выполнения обработанной функции оказывается примерно в 2.5–3 раза меньше. И это неудивительно: в обработанной версии не будет выполняться раскрытие макро.

Если включить статистику, то можно более детально разобраться в причинах ускорения. Вот статистика выполнения исходной версии функции:

*** Статистика обращений ***
BAR ......................  1
BACKQUOTE ................  1
DO .......................  1
GENSYM ...................  2
LET ......................  3
COND .....................  2000
ATOM .....................  2000
LIST .....................  2000
SETQ .....................  2000
>= .......................  2001
+ ........................  4000

А после предварительной трансляции макро статистика будет следующей:

*** Статистика обращений ***
BAR ......................  1
DO .......................  1
LET ......................  2
SETQ .....................  2000
>= .......................  2001
+ ........................  4000

Комментарии уже излишни.

Спасибо, что дочитали до конца. Архив со всеми примерами можно скачать здесь. Желающие могут переработать приведенные коды для использования в Common Lisp.

Предварительная трансляция макро в HomeLisp