Рекурсия по списку s-выражений в Clojure

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

однако, и я должен предварить это предупреждением спойлера, есть способ сохранить тот же рекурсивный алгоритм, не подвергаясь капризам стека 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))))))))

вместо стека, создаваемого неявно нашими вызовами функции non-tail, мы связываем "то, что осталось сделать" после каждого вызова 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-* и ожидая, что он даст ответ, мы можем пусть он немедленно ответит ударом. Когда мы вызываем этот удар, он срабатывает и выполняет некоторую работу вплоть до рекурсивного вызова, который, в свою очередь, возвращает другой удар. Это батутный стиль, и функция, которая "отскакивает" от наших ударов, -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-настоящая звезда здесь. Он позволяет определить ваш алгоритм с ясностью естественной рекурсии и с помощью преобразований, сохраняющих корректность, эффективно выразить его на любом хосте, который имеет один цикл и кучу.