Добавляем генераторы в Common Lisp

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

Что есть генератор?

Что представляет из себя генератор? По факту это функция, вызвав которую мы можем получить следующий элемент последовательности. В наших функциях мы будем возвращать следующий элемент и флаг прекращения итераций (если поднят — прекращаем, иначе — продолжаем). Можно было бы возвращать одно значение и прекращать итерации при помощи throw, но тогда придётся работать с ними более осторожно и оборачивать любой вызов в блок catch. Для себя я выбрал первый способ, так как мне он показался проще. Перейдём к написанию кода

Определяем свой генератор

Определим класс для последовательности

(defclass lazy-seq ()
  ((next-fn :accessor seq-next-fn
            :initarg :next-fn)))

И сразу добавим пару утилит для удобной работы. В будущем мы будем ими пользоваться постоянно

(defun make-lazy-seq(&optional next-fn)
  (make-instance 'lazy-seq :next-fn next-fn))

(defun next(seq)
  (funcall (seq-next-fn seq)))

make-lazy-seq упрощает создание генераторов, избавляя от необходимости прописывать много параметров вручную

next упрощает вызов функции получения следующего элемента

Простейший генератор

Попробуем создать генератор, бесконечно возвращающий десятки

(defparameter *x*
  (make-lazy-seq (lambda () (values 10 nil))))

Проверим его работоспособность:

CL-USER> (next *x*)
10
NIL
CL-USER> (next *x*)
10
NIL
CL-USER> (next *x*)
10
NIL

Действительно, возвращает десятки. Вряд ли такой генератор будет нам чем-то полезен, поэтому напишем что-то более пригодное для работы

Создаём range

Функция range уже опирается на замыкания, но в целом она не особо сложнее

(defun range(n)
  (let ((iter -1)) ; инициализируем переменную
    (make-lazy-seq
     (lambda ()    ; захватываем внутрь замыкания
       (incf iter) ; увеличиваем на 1 при каждом вызове
       (if (< iter n) 
           (values iter nil) ; если меньше n, итерации продолжаются
           (values nil t)))))) ; иначе - прекращаем итерации 

Проверим и её

CL-USER> (setf *x* (range 3))
#<LAZY-SEQ {10019D4803}>
CL-USER> (next *x*)
0
NIL
CL-USER> (next *x*)
1
NIL
CL-USER> (next *x*)
2
NIL
CL-USER> (next *x*)
NIL
T

Каждый раз вручную вызывать next выглядит как какое-то извращение, поэтому прервёмся от написания генераторов и напишем макрос для итерации по ним

Макрос doseq

Алгоритм doseq довольно прост:

1. Достали из генератора пару (elem stop?).
2. Проверили stop? если t, прекращаем итерации иначе — переходим к следующему шагу
3. Исполняем тело цикла
4. Переходим к шагу 1

К сожалению, детальнее объяснить код, не погружая читателя в макросы, я не могу. Поэтому просто оставлю код doseq. Прочитать про макросы можно в книгах "ANSI Common Lisp", "Practical Common Lisp" и для тех, кто хочет чёрный пояс по макросам, "Let Over Lambda"

Хабр отказывается правильно красить код макроса, поэтому тут скриншот

(defmacro doseq((var seq) &body body)
  (let ((seq-name (gensym))   ; Генерируем имя переменной хранящей seq
        (stop-name (gensym))) ; Генерируем имя для флага

    `(let ((,seq-name ,seq)) ; Сохраняем seq в переменную
       ;; Бесконечный цикл
       (do () (nil) 
         ;; Получаем новый элемент и флаг
         (multiple-value-bind (,var ,stop-name) (next ,seq-name)
           (when ,stop-name ; Если флаг поднят, выходим из цикла
             (return))
           ,@body))))) ; Исполняем тело цикла

И теперь для итераций мы можем писать вот так:

CL-USER> (doseq (x (range 3))
           (print x))

0 
1 
2 
NIL

Продвинутые функции для работы с последовательностями

Добавим в наш код немного функциональщины. Начнём с ленивого map. Чтобы код не конфликтовал со встроенными в CL функциями, будем добавлять букву l (lazy) в имени

(defun lmap(fn seq)
  (make-lazy-seq
   (lambda ()
     (multiple-value-bind (elem stop?) (next seq)
       (if stop?
           (values nil t)
           (values (funcall fn elem) nil))))))

Пока в начальной последовательности есть значения — извлекаем их, пропускаем через функцию и возвращаем. Если значений нет, заканчиваем последовательность.

Функция lfilter получает предикат и последовательность и оставляет в последовательности только то, что удовлетворяет предикату

(defun lfilter(fn seq)
  (make-lazy-seq
   (lambda ()
     (do () (nil)
       (multiple-value-bind (elem stop?) (next seq)
         (when stop?
           (return (values nil t)))
         (when (funcall fn elem)
           (return (values elem nil))))))))

Тут при вызове функции next, мы тянем значения из начальной последовательности пока они не закончатся или пока фильтрующая функция не вернёт истину.

Можно также определить функцию для склейки последовательностей

(defun lappend(&rest seqs)
  (let ((index 0))
    (make-lazy-seq
     (lambda ()
       (do () (nil)
         (unless (< index (length seqs))
           (return (values nil t)))

         (multiple-value-bind (elem stop?) (next (nth index seqs))
           (unless stop?
             (return (values elem nil)))
           (incf index)))))))

Она последовательно достаёт все элементы из текущей последовательности и переходит к следующей. Повторяет, пока последовательности не закончатся.

Теперь можно писать более сложные генераторы, например:

(lappend (lfilter #'oddp (range 10)) 
         (lfilter #'evenp (range 10)))

Это генератор, который проходит сначала по всем нечётным числам от 0 до 10, а потом по всем чётным (не включительно)

Бесконечные последовательности

Удивительно, но иногда создание бесконечных последовательностей проще, чем конечных. Генератор всех неотрицательных целых чисел получается из range убиранием if

(defun numbers()
  (let ((iter -1))
    (make-lazy-seq
     (lambda ()
       (incf iter)))))

Генератор всех простых чисел тоже довольно забавный. Нужно определить функцию проверки на простоту и с помощью ленивого фильтра просеять все натуральные числа через неё.

(defun is-prime(n)
  (do ((i 2 (+ 1 i)))
      ((> i (sqrt n)) t)
    (when (= 0 (mod n i))
      (return-from is-prime nil))))

(defun primes()
  (let ((base-seq (numbers)))
    (next base-seq) ; пропускаем 0 и 1
    (next base-seq) 
    (lfilter #'is-prime base-seq)))

На этом у меня пока всё. Очень рекомендую читателям попробовать написать бесконечные рекуррентные генераторы (типа ones = 1 : ones из хаскеля). Тема интересная, но пока моя реализация хромает, так что для статьи не годится.
Спасибо за внимание

(defclass lazy-seq ()
  ((next-fn :accessor seq-next-fn
            :initarg :next-fn)))

(defun make-lazy-seq(&optional next-fn)
  (make-instance 'lazy-seq :next-fn next-fn))

(defun next(seq)
  (funcall (seq-next-fn seq)))

(defun range(n)
  (let ((iter -1))
    (make-lazy-seq
     (lambda ()
       (incf iter)
       (if (< iter n)
           (values iter nil)
           (values nil t))))))

(defun numbers()
  (let ((iter -1))
    (make-lazy-seq
     (lambda ()
       (incf iter)))))

(defun is-prime(n)
  (do ((i 2 (+ 1 i)))
      ((> i (sqrt n)) t)
    (when (= 0 (mod n i))
      (return-from is-prime nil))))

(defmacro doseq((var seq) &body body)
  (let ((seq-name (gensym))   ; Генерируем имя переменной хранящей seq
        (stop-name (gensym))) ; Генерируем имя для флага

    `(let ((,seq-name ,seq)) ; Сохраняем seq в переменную
       ;; Бесконечный цикл
       (do () (nil) 
         ;; Получаем новый элемент и флаг
         (multiple-value-bind (,var ,stop-name) (next ,seq-name)
           (when ,stop-name ; Если флаг поднят, выходим из цикла
             (return))
           ,@body))))) ; Исполняем тело цикла

(defun lmap(fn seq)
  (make-lazy-seq
   (lambda ()
     ;; Извлекаем значение из исходной последовательности
     (multiple-value-bind (elem stop?) (next seq)
       (if stop?
           (values nil t) 
           (values (funcall fn elem) nil))))))

(defun lfilter(fn seq)
  (make-lazy-seq
   (lambda ()
     (do () (nil)
       (multiple-value-bind (elem stop?) (next seq)
         (when stop?
           (return (values nil t)))
         (when (funcall fn elem)
           (return (values elem nil))))))))

(defun lappend(&rest seqs)
  (let ((index 0))
    (make-lazy-seq
     (lambda ()
       (do () (nil)
         (unless (< index (length seqs))
           (return (values nil t)))

         (multiple-value-bind (elem stop?) (next (nth index seqs))
           (unless stop?
             (return (values elem nil)))
           (incf index)))))))

(defun primes()
  (let ((base-seq (numbers)))
    (next base-seq)
    (next base-seq)
    (lfilter #'is-prime base-seq)))