Во-первых, я должен посоветовать вам не сильно беспокоиться о сложностях реализации, таких как переполнение стека, когда вы пробуетесь через The Little Schemer. Хорошо, когда вы программируете в гневе, не забывайте о таких проблемах, как отсутствие оптимизации хвостовых вызовов, но главная цель книги - научить вас рекурсивно мыслить. Преобразование примеров в стиль передачи аккумуляторов, безусловно, является хорошей практикой, но, по сути, это реверсия по принципу рва в пользу итерации.
Однако, и я должен предварять это предупреждением о спойлере, есть способ сохранить тот же рекурсивный алгоритм, не подчиняясь прихотям стека JVM. Мы можем использовать стиль передачи продолжения, чтобы создать свой собственный стек в виде дополнительного аргумента анонимной функции k:
(defn occurs-cps [a lst k]
(cond
(empty? lst) (k 0)
(atom? (first lst))
(cond
(= a (first lst)) (occurs-cps a (rest lst)
(fn [v] (k (inc v))))
:else (occurs-cps a (rest lst) k))
:else (occurs-cps a (first lst)
(fn [fst]
(occurs-cps a (rest lst)
(fn [rst] (k (+ fst rst))))))))
Вместо того, чтобы стек неявно создавался нашими вызовами нехвостых функций, мы связываем «то, что осталось сделать» после каждого вызова occurs, и передаем его как следующее продолжение k. Когда мы вызываем его, мы начинаем с k, который не представляет ничего, что нужно сделать, функции идентификации:
scratch.core=> (occurs-cps 'abc
'(abc (def abc) (abc (abc def) (def (((((abc))))))))
(fn [v] v))
5
Я не буду вдаваться в подробности того, как делать CPS, поскольку это будет в следующей главе TLS. Однако я отмечу, что это, конечно, еще не работает полностью:
scratch.core=> (def ls (repeat 20000 'foo))
#'scratch.core/ls
scratch.core=> (occurs-cps 'foo ls (fn [v] v))
java.lang.StackOverflowError (NO_SOURCE_FILE:0)
CPS позволяет нам переместить все наши нетривиальные вызовы построения стека в хвостовую позицию, но в Clojure нам нужно сделать дополнительный шаг, заменив их recur:
(defn occurs-cps-recur [a lst k]
(cond
(empty? lst) (k 0)
(atom? (first lst))
(cond
(= a (first lst)) (recur a (rest lst)
(fn [v] (k (inc v))))
:else (recur a (rest lst) k))
:else (recur a (first lst)
(fn [fst]
(recur a (rest lst) ;; Problem
(fn [rst] (k (+ fst rst))))))))
Увы, все идет не так: java.lang.IllegalArgumentException: Mismatched argument count to recur, expected: 1 args, got: 3 (core.clj:39). Самый последний recur на самом деле относится к fn прямо над ним, который мы используем для представления наших продолжений! Мы можем получить хорошее поведение большую часть времени, просто изменив recur на вызов occurs-cps-recur, но патологически вложенный ввод все равно будет переполнять стек:
scratch.core=> (occurs-cps-recur 'foo ls (fn [v] v))
20000
scratch.core=> (def nested (reduce (fn [onion _] (list onion))
'foo (range 20000)))
#'scratch.core/nested
scratch.core=> (occurs-cps-recur 'foo nested (fn [v] v))
Java.lang.StackOverflowError (NO_SOURCE_FILE:0)
Вместо того, чтобы позвонить на occurs-* и ожидать, что он даст ответ, мы можем заставить его немедленно вернуть thunk. Когда мы вызываем этот блок, он отключается и выполняет некоторую работу вплоть до рекурсивного вызова, который, в свою очередь, возвращает другой блок. Это батутный стиль, и функция, которая «отскакивает» от наших громов, - trampoline. При возврате thunk каждый раз, когда мы делаем рекурсивный вызов, размер нашего стека ограничивается одним вызовом за раз, поэтому единственным ограничением является куча:
(defn occurs-cps-tramp [a lst k]
(fn []
(cond
(empty? lst) (k 0)
(atom? (first lst))
(cond
(= a (first lst)) (occurs-cps-tramp a (rest lst)
(fn [v] (k (inc v))))
:else (occurs-cps-tramp a (rest lst) k))
:else (occurs-cps-tramp a (first lst)
(fn [fst]
(occurs-cps-tramp a (rest lst)
(fn [rst] (k (+ fst rst)))))))))
(declare done answer)
(defn my-trampoline [th]
(if done
answer
(recur (th))))
(defn empty-k [v]
(set! answer v)
(set! done true))
(defn run []
(binding [done false answer 'whocares]
(my-trampoline (occurs-cps-tramp 'foo nested empty-k))))
;; scratch.core=> (run)
;; 1
Обратите внимание, что Clojure имеет встроенный trampoline (с некоторыми ограничениями на тип возвращаемого значения). Используя это вместо этого, нам не нужен специализированный empty-k:
scratch.core=> (trampoline (occurs-cps-tramp 'foo nested (fn [v] v)))
1
Прыжки на батуте - это, конечно, крутая техника, но обязательным условием для прыжка на батуте является то, что она должна содержать только хвостовые вызовы; CPS - настоящая звезда здесь. Он позволяет вам определить свой алгоритм с ясностью естественной рекурсии и с помощью преобразований, сохраняющих корректность, эффективно выразить его на любом хосте, который имеет один цикл и кучу.