понедельник, 16 января 2012 г.

Глубоко-вложенные вычисления


Тема возникла из моих ответов на вопросы, заданные другим человеком на форумах. Речь пойдет о рекурсивных вычислениях, когда глубина вложенности выше предельно допустимой для стека вызовов. Я покажу, как такая задача может быть решена на Common Lisp. Сразу отмечу, что это возможно не всегда, но в большинстве случаев работает.

В основе лежит та же самая идея, что используется в F# Async. Мы просто переводим наши рекурсивные функции на язык продолжений.  Пугаться здесь не стоит, сами мы этого делать не станем. За нас все самое сложное и рутинное сделают WITH-CALL/CC и его специальная версия для функций DEFUN/CC из пакета CL-CONT. Ниже везде предполагается, что пакет CL-CONT импортирован.

Но прежде определимся с исходной задачей. Ниже приведены функции, которые вылетают со Stack Overflow.

(defun compute (x)
  (cond ((zerop x) 0)
        (t (+ (compute (1- x))
              1))))


(defun run ()
  (compute 10000000)) ;; Stack Overflow

Функции намерено взяты такими. Сами по себе эти функции ничего не представляют. Нам интересно то, что функция COMPUTE рекурсивная, с большой глубиной, вызов - не хвостовой. В общем случае, рекурсивных вызовов может быть несколько.

Перепишем функции через продолжения. Функцию COMPUTE определим через DEFUN/CC. Т.е. она будет возвращать не обычное значение, а вычисление, которое еще нужно запустить. В F# это примерно означало бы то, что функция COMPUTE возвращала бы некоторое значение типа Async<'a>.

(defun/cc compute/cc (x)
  (cond ((zerop x) 0)
        (t (+ (compute/cc (1- x))
              1))))

Таким образом мы должны преобразовать всякую функцию, вложенность которой может быть огромной. Вызывать их можно из DEFUN/CC и WITH-CALL/CC:

(defun run/cc ()
  (with-call/cc (compute/cc 10000000)))

Если у вас SBCL, то на этом можно остановиться. У этой лисп-машины превосходный оптимизатор хвостового вызова. У нас фактически все операции COMPUTE превращаются в цепочку хвостовых вызовов. Поэтому все работает. Стек как бы уходит в память.

Увы, не все лисп-машины хорошо оптимизируют хвостовые вызовы. Для CLozure CL и LispWorks Personal мы по-прежнему получим Stack Overflow. К счастью есть выход - использовать трамплин.

Внутри вычисления DEFUN/CC нам доступно продолжение. Если глубина стека вызовов стала большой, то мы можем запомнить продолжение и раскрутить в обратную сторону стек, возвращая управление некоторому внешнему циклу. Внутри этого цикла мы будем проверять, а нет ли у нас очередного продолжения для, так сказать, продления вычисления. Если есть, то запускаем это продолжение. Фокус состоит в том, что при запуске продолжения стек вызовов уже очищен, что нам и требуется.

Сначала определим утилиты трамплина:

(defparameter *cont* nil)


(defun/cc trampoline-push/cc ()
  (call/cc 
   (lambda (k)
     (push k *cont*))))


(defmacro trampoline/cc (expr)
  (let ((result (gensym)))
    `(progn
       (trampoline-push/cc)
       (let ((,result ,expr))
         (trampoline-push/cc)
         ,result))))


(defmacro with-trampoline/cc (&body body)
  (let ((result (gensym)))
    `(let ((,result nil))
       (with-call/cc
         (trampoline-push/cc)
         ,@body)
       (loop while *cont*
          do (let ((cont (pop *cont*)))
               (setf ,result (funcall cont))))
       ,result)))

Утилита TRAMPOLINE-PUSH/CC кладет продолжение вычисления в ячейку *CONT* и возвращает управление внешнему циклу из WITH-TRAMPOLINE/CC, откуда все должно быть запущено. Макрос TRAMPOLINE/СС оборачивает заданное выражение, где трамплин вызывается до и после вычисления выражения.

Мы можем использовать трамплин часто, но это неэффективно. Пусть он вызывается на каждой сотой итерации:

(defun/cc smart-compute/cc (x)
  (cond ((zerop x) 0)
        ((zerop (mod x 100))  
         ;; on every 100th iteration use the trampoline
         (+ (trampoline/cc (smart-compute/cc (1- x)))
            1))
        (t 
         (+ (smart-compute/cc (1- x))
            1))))


 ;; No Stack Overflow
 (defun smart-run/cc ()
  (with-trampoline/cc (smart-compute/cc 10000000)))

Это работает даже для CLISP, где нет никакой оптимизации хвостового вызова. Мы успешно имитирует рекурсивный вызов с глубиной вложенности десять миллионов!

6 комментариев:

  1. Очень интересно. А где еще можно почитать о продолжениях в лиспе?

    ОтветитьУдалить
  2. Наверное, в литературе по Схеме. На я основывался на своем опыте работы с F# Async. Там тоже продолжения используются.

    ОтветитьУдалить
  3. Чтож вы на CLISP клевещете?!

    > (defun fact (n acc)
    (if (> n 1)
    (fact (- n 1) (* n acc))
    acc))

    > (disassemble 'fact)
    Дизассемблирование функции FACT
    (CONST 0) = 1
    2 обязательных аргументов
    0 необязательныx аргументов
    Нет параметра rest
    Нет ключевых параметров
    12 инструкций байт-кода:
    0 L0
    0 (LOAD&PUSH 2)
    1 (CONST&PUSH 0) ; 1
    2 (CALLSR&JMPIF 1 50 L9) ; >
    6 (LOAD 1)
    7 (SKIP&RET 3)
    9 L9
    9 (LOAD&DEC&PUSH 2)
    11 (LOAD&PUSH 3)
    12 (LOAD&PUSH 3)
    13 (CALLSR&PUSH 2 57) ; *
    16 (JMPTAIL 2 5 L0)
    NIL


    JMPTAIL!!!

    ОтветитьУдалить
    Ответы
    1. [1]> (defun f (x) (if (zerop x) 0 (g (1- x))))
      F

      [2]> (defun g (x) (if (zerop x) 0 (f (1- x))))
      G

      [3]> (f 10000)

      *** - Program stack overflow. RESET

      Удалить
  4. Наверное, погорячился на счет CLISP :) Да, что-то там есть, но там точно нет оптимизации таких хвостовых вызовов, которые возникают при использовании продолжений. Вероятно, еще хромает взаимная рекурсия.

    А такую оптимизацию даже Скала умеет, у которой подавно нет полноценного TCO из-за ограничений JVM (@tailrec - не в счет).

    ОтветитьУдалить
    Ответы
    1. Кстати, в Scala хотели использовать трамплин для TCO, но что-то пока решили не делать.

      Удалить