Итерация по строкам

Итак, для работы с файлами в CL существует макрос with-open-file о котором подробнее можно почитать в PCL, в нашем случае у нас будет два файла - исходный файл и генерируемый. Поэтому сразу делаем макрос "с-двумя-файлами-делай-то-то":

(defmacro with-two-files ((input input-file &optional keys-for-input)
                          (output output-file
                           &optional (keys-for-output '(:direction :output :if-exists :overwrite :if-does-not-exist :create)))
                          &body body)
  `(with-open-file (,input ,input-file ,@keys-for-input)
     (with-open-file (,output ,output-file ,@keys-for-output)
       ,@body)))

Тут всё так же как и с with-open-file - мы называем два файлы, и объявляем потоки которыми будем пользоваться в теле макроса:

(with-two-files (i #p"my-file") (o #p"my-new-file")
  ;; работаем с потоками i и o - читаем из одного, пишем в другой
)

Теперь, когда у нас есть общий макрос для работы с двумя файлами, можно написать функцию конвертации одного файла в другой:

(defun convert-file (input-file output-file &key (filter #'(lambda (line) line)))
  (with-two-files (input input-file) (output output-file)
    (loop for line = (read-line input nil)
          while line do (write-line (funcall filter line) output))))

Тут мы используем макрос with-two-files и итерируем поток первого файла по линиям используя стандартный макрос loop; для каждой линии вызываем функцию фильтр, которая передаётся в конвертер в качестве аргумента. По-умолчанию функция фильтр - прямое отображение, она ничего не меняет, поэтому

(convert-file #p"my-file" #p"my-new-file")

работает как простое копирование.

Задачка 1 - перевод объявлений #define из .h файлов

Попробуем применить convert-file для трансляции .h файлов с простыми объявлениями #define в .lisp файлы (простейший groveling). Для этого нужно всего лишь отдать convert-file подходящую функцию filter, которая преобразует соответствующий шаблон - её проще всего сделать на основе регулярных выражений.

(asdf:oos 'asdf:load-op :cl-ppcre)
(use-package :cl-ppcre)

(defun h->lisp (input-file output-file)
  (flet ((convert-templates (line)
           (let ((define
                  (register-groups-bind
                      (name value description)
                      ("^#define\\s+(\\S+)\\s+(\\S+)\\s*(?:/\\*\\s*(.*?)\\s*\\*/)?" line)
                    (format nil "(defconstant +~A+ ~A \"~A\")~&" name value (or description name)))))
             (if define
                 define
                 (let ((constant
                        (register-groups-bind
                            (name value description)
                            ("^\\s*(\\S+)\\s*=\\s*(\\S+?(?:,)?)\\s*(?:/\\*\\s*(.*?)\\s*\\*/)?" line)
                          (format nil "(defconstant +~A+ ~A \"~A\")~&" name value (or description name)))))
                   (if constant
                       constant
                       (format nil ";;; ~A~&" line)))))))
    (convert-file input-file output-file :filter #'convert-templates)))

Мы определили три фильтра для трёх шаблонов строк - #define-cтрок, строк с константами и неопределённых строк. Теперь

(h->lisp #p"foo.h" #p"foo.lisp")

Сконвертирует файл foo.h:

#define A 1
C = 3
foo ();

В файл foo.lisp:

(defconstant +A+ 1 "A")
(defconstant +C+ 3 "C")
;;; foo ();

Задачка 2 - примешивание лисп-форм в какой-либо текст

Следуем той же стратегии что и в предыдущем варианте:

(defun text+lisp->text (input-file output-file)
  (flet ((convert (line)
           (let ((converted
                  (register-groups-bind
                      (pre sexpr post)
                      ("^(.*)##lisp##(.+)##(.*)?" line)
                    (format nil "~A~A~A~&" pre (eval (read-from-string sexpr)) post))))
             (if converted
                 converted
                 line))))
    (convert-file input-file output-file :filter #'convert)))

После выполнения

(text+lisp->text #p"text" #p"text+")

Из текста text вида

Define ##lisp##(defvar *a* 2)##
Define ##lisp##(defvar *b* 3)##
Result - ##lisp##(+ *a* *b*)##

Будет сгенерирован текст text+:

Define *A*
Define *B*
Result - 5

Задачка 3 - удаление комментариев в начале файла

Первая версия convert-file совершенно ничего не знает о состоянии итератора в данный момент - в начале он, или в конце, были уже замены или нет. Тут удобно сделать макро-аналог для функции convert-file с анафорическими переменные в нём, с помощью них функции или макросы использующие macro-convert-file будут иметь доступ к ряду предикатов - своего рода способ задавать вопросы вышележащему макросу о состоянии итератора.

(defmacro macro-convert-file (input-file output-file &key (at-begining-p t)
                                                           (write-line-p t)
                                                           (filter #'(lambda (line) line)))
  `(with-two-files (input ,input-file) (output ,output-file)
     (let ((^at-begining-p^ ,at-begining-p)
           (^write-line-p^  ,write-line-p))
           ;; etc.
       (loop for line = (read-line input nil)
                 while line do (let ((filtered (funcall ,filter line)))
                                 (if ^write-line-p^
                                     (write-line filtered output)))))))

И пример использования - функция delete-disclaimer удаляющая начальный комментарий в файле:

(defun delete-disclaimer (input-file output-file &key (is-comment-p #'(lambda (string)
                                                                        (if (< 0 (length string))
                                                                            (string= (subseq string 0 1) ";")))))
  (macro-convert-file input-file
                      output-file
                      ;; Определяем начальное состояние КА
                      :at-begining-p t
                      :write-line-p  nil
                      :filter (lambda (line)
                                ;; Функция КА смотрит вокруг:
                                (if ^at-begining-p^
                                    (unless (funcall is-comment-p line)
                                      ;; Функция КА меняет состояние транслятора:
                                      (setq ^write-line-p^ t
                                            ^at-begining-p^ nil)
                                      line)
                                  line))))