В 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)))

Комментарии (7)


  1. Hemml
    00.00.0000 00:00
    +5

    Мне всегда казалось, что смысл генераторов именно в функции yield, когда код генератора непрерывен и может возвращать данные из любой точки, продолжая выполнение с того же места по вызову next. В CL есть некоторые проблемы с таким подходом, так как для его реализации нужен call/cc, а он конфликтует с unwind-protect и простого решения тут нет. Именно по этой причине генераторов нет в CL.


    1. orenty7 Автор
      00.00.0000 00:00

      Я с рестартами пока не разобрался, но из того, что слышал: они, вроде, позволяют продолжить исполнение там, где оно прервалось. На их основе нельзя что-то типа yield сделать?

      Или на каком-то хитром замыкании, которое позволит извне вернуться и продолжить исполнять там, где закончили


      1. Hemml
        00.00.0000 00:00
        +1

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


  1. qw1
    00.00.0000 00:00
    +1

    CL-USER> (next *x*)
    1
    NIL
    CL-USER> (next *x*)
    2
    NIL
    Вроде как анти-паттерн в ФП, когда одно и то же выражение вычисляется по-разному?


    1. orenty7 Автор
      00.00.0000 00:00

      Common Lisp мультипарадигменный. В нём нет нет необходимых вещей, чтобы называться сильным функциональным ЯПом (контроль эффектов, иммутабельность, сильная система типов). А слабыми фунциональными (есть функции как объекты первого порядка) являются почти все современные языки


      1. qw1
        00.00.0000 00:00
        +2

        Просто можно это было бы сделать чисто, например

        (setq mygen (create-gen))
        (setq next (next-gen mygen))
        (setq val (car next)) ; --> 1
        (setq mygen (cdr next))
        (setq next (next-gen mygen))
        (setq val (car next)) ; --> 2
        ...
        


        1. orenty7 Автор
          00.00.0000 00:00

          О, вместе со значением возвращать новое состояние генератора. Встречал такое в хаскеле, но тут не додумался использовать. Изящное решение, надо будет попробовать

          Возможно, так даже проще будет добавить рекуррентные генераторы