В общем-то опять задался вопросом - как сделать множественную рекурсию наиболее простым образом. Подтолкнула на это меня монада Async из F#. Я, даже не разбираясь как толком она работает, вполне успешно её применяю, что не могу сказать о продолжениях. Однажды поняв их, написав пару алгоритвом в CPS, реализовав свои продолжения, изучив сторонние библиотеки их реализующие, через некоторое время обычного кодинга мозг опять мучается при привыкании к написанию в стиле продолжений. 
Отсюда вопросы - 
1) как написать множественную рекурсию в наиболее простом и понятном виде
2) при большой вложенности итераций полезно было бы очищать локальные окружения внешних итераций  и стек вызовов. Другого способа(на том же уровне абстракций) - кроме как прекратить выполнение, вернув продолжение, нет?
Я попробовал наименее незаметно для пользователя ввести продолжения, но получил огромный оферхед(с учётом сохранения порядка итераций), вот пример - 
Хвостовая рекурсия - 
(defparameter *steps* 1000000)
(defun rec-fun ()
  (let ((counter 0))  
    (labels ((iter (i)
               (incf counter)
               (cond ((> i 0)
                      (iter (1- i)))
                     (t nil))))
      (values (iter *steps*)
              counter))))
Множественная -
(defun multi-recursive ()
  (let ((counter 0))  
    (labels ((iter (i)
               (incf counter)
               (cond ((> i 0)
                      (loop :repeat 1
                            :do (iter (1- i))))
                     (t nil))))
      (iter *steps*))
    counter))
То же с единственным отличием - вместо вызовов возращаются продолжения
(defun multi-recursive-2 ()
  (let ((counter 0))  
    (labels ((iter (i)
               (incf counter)
               (cond ((> i 0)
                      (loop :repeat 1
                            :collect (lambda () (iter (1- i)))))
                     (t nil))))
      (values (iter *steps*)
              counter))))
Пример работы - 
CL-USER> (time (rec-fun))
Evaluation took:
 0.036 seconds of real time
 0.034995 seconds of total run time (0.034995 user, 0.000000 system)
 97.22% CPU
 35,576,084 processor cycles
 0 bytes consed
 
NIL
1000001
CL-USER> (multi-recursive)
Control stack guard page temporarily disabled: proceed with caution
; Evaluation aborted on #<SB-KERNEL::CONTROL-STACK-EXHAUSTED {BF67F51}>.


CL-USER> (time (flat-rec (multi-recursive-2)))
Evaluation took:
 0.140 seconds of real time
 0.140979 seconds of total run time (0.139979 user, 0.001000 system)
 [ Run times consist of 0.016 seconds GC time, and 0.125 seconds non-GC time. ]
 100.71% CPU
 246,373,031 processor cycles
 40,000,736 bytes consed
 
NIL
 По сути вводится 2 новых требования к написанию рекурсивных ф-ций - 
1) в случае продолжения итераций - возвращать продолжение/я
2) при завершении итераций - возвращать какой-то флаг конца(в примере NIL, что не подходит если нужно протащить результат)
  

Краткий ответ: это возможно через CL-CONT.
Наконец-то я созрел для ответа. Прежде это я помог тебе с F# на другом форуме. Идея здесь точно такая же. Все вычисления идут фактически через продолжения. Отсюда все интересующие нас вызовы хвостовые. Запускаем все вычисление через with-call/cc, а вложенные функции определяем через defun/cc. О последних я узнал только сегодня :)
Ниже показано, как это работает. Первый пример использует стек. Запускается как (RUN). Он обрывается из-за StackOverflow. Второй пример уходит из стека в память. Запускается как (RUN/CC). Отрабатывает как должно.
(in-package :cl-cont) (defun test (x) (cond ((zerop x) 0) (t (+ (test (1- x)) 1)))) (defun run () (test 10000000)) ;; Stack Overflow (defun/cc test/cc (x) (cond ((zerop x) 0) (t (+ (test/cc (1- x)) 1)))) (defun run/cc () (with-call/cc (test/cc 10000000))) ;; Consuming memory!

Конкретно твой пример перепишется так:
(defparameter *steps* 1000000) (defun/cc multi-recursive/cc () (let ((counter 0)) (labels ((iter (i) (incf counter) (cond ((> i 0) (loop :repeat 1 :do (iter (1- i)))) (t nil)))) (iter *steps*)) counter))
Запускается через WITH-CALL/CC:
(with-call/cc (multi-recursive/cc))
Я несколько обескуражен результатами. Раньше я думал, что F# и Haskell особенные в этом плане :)

И последнее. DEFUN/CC и WITH-CALL/СС - это очень дорогие штуки. Их нужно использовать только по необходимости. Например, там, где в F# у тебя было бы вычисление Async<'T>. Так, вложенные рекурсивные функции должны определяться через них.

Оказалось, что это не конец истории :)
Все прекрасно работает на могучем SBCL. Там превосходная оптимизация хвостовой рекурсии. Но нас ожидает облом на Clozure CL и LispWorks Personal. К счастью, есть решение и для них - использовать трамплин. 
Нам доступно продолжение, которое мы можем периодически сохранять где-то и тут же свертывать стек вызовов. Тогда где-то на внешнем уровне должен работать цикл, который периодически будет проверять, а не было ли сохранено продолжение для запуска. Фишка в том, что когда запускаем продолжение из внешнего цикла, то стек вызовов пустой, что нам и нужно.
Код приведен ниже. Мы используем трамплин через каждые 1000 итераций до входа в рекурсивную функцию и после. 
(defparameter *cont* nil) (defun/cc trampoline-push/cc () (call/cc (lambda (k) (format t "Trampoline.~%") (setf *cont* k)))) (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 *cont*)) (setf *cont* nil) (format t "Jump!~%") (setf ,result (funcall cont)))) ,result))) (defun/cc test-trampoline/cc (x) (cond ((zerop x) 0) ((zerop (mod x 1000)) (trampoline-push/cc) ;; sic! (let ((y (test-trampoline/cc (1- x)))) (trampoline-push/cc) ;; sic! (+ y 1))) (t (+ (test-trampoline/cc (1- x)) 1)))) (defun run-trampoline/cc () (with-trampoline/cc (test-trampoline/cc 100000))) ;; No Stack Overflow

спасибо за такое исследование, я уже читал это в твоём блоге) 
на самом деле вопрос был не в том как это теоретически сделать, а в том как внести минимальное кол-во изменений в код, т.е. написать/найти высокоуровневый сахар. В случае SBCL я полностью доволен, а на такой вот трамплин я разве что в крайнем случае бы пошёл, когда SBCL почему-то не устраивает.

Ну, это и есть простые практические рекомендации :) Где у тебя функция возвращала Async<'a>, там используешь DEFUN/CC. Где был запуск вычисления Async<'a>, например, через те же RunSynchronously или StartImmediate, там запускаешь через WITH-CALL/CC. Кстати, DEFUN/CC - это просто сахар WITH-CALL/CC (DEFUN ...).
Мне не совсем ясно, почему с SBCL работает хорошо, а с той же Clozure CL (CCL) - нет. Может быть, последний не умеет превращать MULTIPLE-VALUE-CALL в хвостовой вызов? Такая фукнция используется в CL-CONT. Простые тесты показывают, что вроде бы CCL поддерживает оптимизацию хвостовых вызовов, а тут возникает облом. В общем, исследовать надо.
И я не могу ручаться на 100% даже за SBCL. Все же, CL-CONT - это немного темный ящик для меня, хотя представляю что и зачем он делает. Его код немного смотрел, но не настолько глубоко.
Так что, может быть, трамплин имеет смысл использовать даже для SBCL. В любом случае, он там будет работать быстро, поскольку переход из вычислений во внешний цикл будет моментальным, поскольку стек вызовов не должен расти, когда все вызовы хвостовые.

а ты не измерял производетельность по отношению к моему примеру? под рукой компа нет, к сожалению
(defun multi-recursive-2 ()
  (let ((counter 0))  
    (labels ((iter (i)
               (incf counter)
               (cond ((> i 0)
                      (loop :repeat 1
                            :collect (lambda () (iter (1- i)))))
                     (t nil))))
      (values (iter *steps*)
              counter))))

Есть только один хороший результат. Это то, что оно, вообще, вычисляется :)
Исходный код:
(defpackage :deep-nested-recursion (:use :cl :cl-cont)) (in-package :deep-nested-recursion) ;;; ;;; Trampoline Implementation ;;; (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))) ;;; ;;; User Code ;;; (defparameter *steps* 1000000) (defun rec-fun () (let ((counter 0)) (labels ((iter (i) (incf counter) (cond ((> i 0) (iter (1- i))) (t nil)))) (values (iter *steps*) counter)))) (defun multi-recursive-2 () (let ((counter 0)) (labels ((iter (i) (incf counter) (cond ((> i 0) (loop :repeat 1 :collect (lambda () (iter (1- i))))) (t nil)))) (values (iter *steps*) counter)))) (defun flat-rec (cont-list) (let ((k cont-list)) (loop for i from 1 while k do (setf k (funcall (pop k))) finally (return i)))) (defun/cc multi-recursive/cc () (let ((counter 0)) (labels ((iter (i) (incf counter) (cond ((> i 0) (loop :repeat 1 :do (iter (1- i)))) (t nil)))) (iter *steps*)) counter)) (defun/cc multi-recursive-trampoline/cc () (let ((counter 0)) (labels ((iter (i) (incf counter) (cond ((> i 0) (loop :repeat 1 :do (trampoline/cc (iter (1- i))))) (t nil)))) (iter *steps*)) counter))
Результаты:
CL-USER> (in-package :deep-nested-recursion) # DEEP-NESTED-RECURSION> (time (rec-fun)) Evaluation took: 0.037 seconds of real time 0.031200 seconds of total run time (0.015600 user, 0.015600 system) 83.78% CPU 85,883,592 processor cycles 0 bytes consed NIL 1000001 DEEP-NESTED-RECURSION> (time (flat-rec (multi-recursive-2))) Evaluation took: 0.573 seconds of real time 0.514803 seconds of total run time (0.405602 user, 0.109201 system) [ Run times consist of 0.250 seconds GC time, and 0.265 seconds non-GC time. ] 89.88% CPU 1,371,242,400 processor cycles 32,001,728 bytes consed 1000001 DEEP-NESTED-RECURSION> (time (with-call/cc (multi-recursive/cc))) Evaluation took: 33.401 seconds of real time 31.293801 seconds of total run time (24.039755 user, 7.254046 system) [ Run times consist of 21.811 seconds GC time, and 9.483 seconds non-GC time. ] 93.69% CPU 79,964,846,604 processor cycles 518,006,304 bytes consed 1000001 DEEP-NESTED-RECURSION> (time (with-trampoline/cc (multi-recursive-trampoline/cc))) Evaluation took: 61.301 seconds of real time 56.378762 seconds of total run time (36.675836 user, 19.702926 system) [ Run times consist of 43.521 seconds GC time, and 12.858 seconds non-GC time. ] 91.97% CPU 146,761,980,588 processor cycles 696,993,864 bytes consed 1000001

Можно взять версию трамплина, которая не создает ячейки CONS. Результаты должны быть лучше.
Еще похоже, что на последний тест сильно повлиял предыдущий. Память уже была загажена. Поэтому GC работал намного дольше. Если бы последний тест был с чистого образа, то, думаю, что время было бы гораздо меньше. Надо проверить, быть может, трамплин не так сильно и тормозит.

Увы, трамплин - тот еще тормоз, но он - чуть ли не единственная возможность на других лисп-машинах. Как альтернатива, можно еще вручную все необходимые продолжения расписать. Похоже, что cl-cont перелопачивает все на своем пути, а это часто избыточно. Особенно достается циклам. Можно было бы поступить умнее, но надо быть очень аккуратным. В общем, выбор для таких задач не так и велик :)

т.е. вариант(А) с flat-rec и сбором продолжений почти в 100 раз эффективнее чем через with-call/cc? что-то не верится) Его ещё оптимизировать пожалуй можно.
По сути тогда А куда лучше...