mutabots.clj

(ns mutabots)

(defn map [f]
  (fn [p1]
    (fn
      ([] (p1))
      ([x] (p1 (f x))))))

(defn filter [pred]
  (fn [p1]
    (fn
      ([] (p1))
      ([x] (and (pred x) (p1 x))))))

(defn take [n]
  (fn [p1]
    (let [vn (volatile! (dec n))]   
      (fn
        ([] (p1))
        ([x] (or (neg? @vn) (p1 x) (neg? (vswap! vn dec))))))))

(defn partition-by [f]
  (fn [p]
    (let [a (java.util.ArrayList.)
          pv (volatile! ::none)]
      (fn
        ([]
          (when-not (.isEmpty a)
            (let [v (vec (.toArray a))]
              ;;clear first!
              (.clear a)
              (p v)))
          (p))
        ([input]
          (let [pval @pv
                val (f input)]
            (vreset! pv val)
            (if (or (identical? pval ::none)
                  (= val pval))
              (do (.add a input) false) ; .add returns true
              (let [v (vec (.toArray a))]
                (.clear a)
                (or (p v)
                  (do (.add a input) false))))))))))

(defn transduce [xform f init coll]
  (let [vres (volatile! init)
        p (fn 
            ([] (vswap! vres f))
            ([x] (let [res (f @vres x)
                       done (reduced? res)]
                   (vreset! vres (if done @res res))
                   done)))
        p (xform p)]
    (reduce (fn [_ x] (when (p x) (reduced nil))) coll)
    @vres))

;; bleh :-(
(defn- promised-seq-proc! [pstep! p]
  (let [vp (volatile! p)]
    (fn 
      ([]
        (deliver @vp nil))
      ([x]
        (deliver @vp (cons x (let [p (vreset! vp (promise))]
                               (lazy-seq (@pstep! p) @p))))
        false))))

(defn sequence [xform coll]
  (let [vcoll (volatile! coll)
        p (promise)
        promised-seq (lazy-seq p)
        pstep! (promise)
        proc! (xform (promised-seq-proc! pstep! p))
        step! (fn [p]
                (loop [coll @vcoll]
                  (if (realized? p)
                    (vreset! vcoll coll)
                    (if-let [[x :as s] (seq coll)]
                      (recur (if (proc! x) nil (rest s)))
                      (proc!)))))]
    (deliver pstep! step!) ; tying the knot
    (lazy-seq (step! p) @p)))