Playing with continuation passing style

playing-cps.clj

(defn vec-cps
    [x y k]
    (k [x y]))

(defn dec-cps
    [x k]
    (k (dec x)))

(defn *-cps
    [x y k]
    (k (* x y)))

(defn factorial-cps
  ([n] 
     (factorial-cps n identity))
  ([n k] 
    (if (zero? n)
        (k 1)
        (dec-cps n (fn [nn]
                       (factorial-cps nn
                                      (fn [ff]
                                          (*-cps n ff k))))))))

(defn factorial-tail-rec
    ([n] (factorial-tail-rec n identity))
    ([n k]
       (if (zero? n)
           (k 1)
           (recur (dec n) (fn [v] (k (* n v)))))))

;; Playing with continuations

(defn dec-cps-2 [x k]
    [(dec x) k])

(defn *-cps-2 [x y k]
    [(* x y) k])

(defn factorial-cps-2
    ([n]
       (factorial-cps-2 n identity))
    ([n k]
       (if (zero? n)
           [1 k]
           (dec-cps-2 n
                      (fn [nn]
                          (factorial-cps-2 nn
                                           (fn [ff]
                                               (*-cps-2 n ff k))))))))

(defn run-f [f n]
    (loop [[v k :as step] (f n)
           trace []]
        (if (= k identity)
            [v trace]
            (recur (k v) (conj trace step)))))

;; Playing with it

(use 'clojure.pprint)

(pprint (run-f factorial-cps-2 5))

(def steps (second (run-f factorial-cps-2 5)))

(def step-2 (second steps))

(pprint (run-f (step-2 1) (step-2 0)))

(pprint (run-f (step-2 1) 2))

;; Alternative definitions using sequence library and HOFs

(defn take-until
    [pred coll]
    (lazy-seq
     (when-let [s (seq coll)]
         (if (pred (first s))
             (list (first s))
             (cons (first s) (take-until pred (rest s)))))))

(defn run-f-2 [f n]
    (reduce (fn [trace [v k :as step]] (conj trace step))
            ()
            (take-until (fn [[v k]] (= identity k))
                        (iterate (fn [[v k]] (k v))
                                 (f n)))))

;; Fibonacci

(defn fibo
    [n]
    (if (< n 2) n (+ (fibo (- n 1)) (fibo (- n 2)))))

(defn --cps
    [x y k]
    (k (- x y)))

(defn +-cps
    [x y k]
    (k (+ x y)))

(defn fibo-cps
    ([n]
       (fibo-cps n identity))
    ([n k]
       (if (< n 2)
           (k n)
           (--cps n 1
                  (fn [n_1]
                      (fibo-cps n_1
                                (fn [f_1]
                                    (--cps n 2
                                           (fn [n_2]
                                               (fibo-cps n_2
                                                         (fn [f_2]
                                                             (+-cps f_1 f_2 k))))))))))))

;; (fibo-cps 20) blows the stack due to no TCO in Clojure
;; But we know how to trampoline !!

(defn --cps-2
    [x y k]
    #(k (- x y)))

(defn +-cps-2
    [x y k]
    #(k (+ x y)))

(defn fibo-cps-2
    ([n]
       #(fibo-cps-2 n identity))
    ([n k]
       (if (< n 2)
           #(k n)
           (--cps-2 n 1
                  (fn [n_1]
                      (fibo-cps-2 n_1
                                (fn [f_1]
                                    (--cps-2 n 2
                                           (fn [n_2]
                                               (fibo-cps-2 n_2
                                                         (fn [f_2]
                                                             (+-cps-2 f_1 f_2 k))))))))))))

;; Now we can (trampoline fibo-cps-2 20)
;; Treat it with care because it is painfully slow