Skip to content

Commit

Permalink
[i/items] shrink, cancellation
Browse files Browse the repository at this point in the history
  • Loading branch information
@xificurC
xificurC committed Aug 27, 2024
1 parent 581c1db commit cd015ca
Show file tree
Hide file tree
Showing 3 changed files with 179 additions and 35 deletions.
2 changes: 1 addition & 1 deletion src/hyperfiddle/electric/impl/array_fields.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@
(defmacro fswap [O k f & args] `(swap (.-state- ~O) ~k ~f ~@args))
(defmacro fget [O k] `(get (.-state- ~O) ~k))
(defmacro fset [O & kvs] `(set (.-state- ~O) ~@kvs))
(defn getset [^objects a k v] (let [ret (get a k)] (set a k v) ret))
(defn getset [^objects a k v] (let [ret (get a k)] (when (not= ret v) (set a k v)) ret))
(defmacro fgetset [O k v] `(getset (.-state- ~O) ~k ~v))
(defn getswap [^objects a k f] (let [ret (get a k)] (swap a k f) ret))

Expand Down
83 changes: 58 additions & 25 deletions src/hyperfiddle/incseq/items_eager_impl.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,61 +2,94 @@
(:require [contrib.data :refer [->box]]
[hyperfiddle.electric.impl.array-fields :as a]
[hyperfiddle.incseq.perm-impl :as p])
#?(:clj (:import [clojure.lang IDeref IFn])))
(:import #?(:clj [clojure.lang IDeref IFn])
[missionary Cancelled]))

(def ps-field-count (a/deffields -input-ps -input-stepper -input-doner -diff -item*))
(deftype Ps [step done state-]
IFn (#?(:clj invoke :cljs -invoke) [_] ((a/get state- -input-ps)) (done))
IDeref (#?(:clj deref :cljs -deref) [_] (a/get state- -diff)))

(def item-field-count (a/deffields -v -flow -ps*))
(def item-field-count (a/deffields -v -flow -ps* -dead))
(deftype Item [state-])

(def item-ps-field-count (a/deffields -step -done -cache))
(def item-ps-field-count (a/deffields -stepped -cache -cancelled))

(defn remove-item-ps [^Item item ps] (let [ps* (a/fget item -ps*)] (ps* (disj (ps*) ps))))

(defn cleanup-item-ps [ps a done] (when-not (identical? ps (a/getset a -cache ps)) (done)))

(defn ->item-ps [^Item item step done]
(let [a (object-array item-ps-field-count)]
(a/set a -cache a, -cancelled false)
(reify
IFn
(#?(:clj invoke :cljs -invoke) [this]
(remove-item-ps item this)
(let [cancelled? (a/getset a -cancelled true)]
(when (not (or (a/getset a -stepped true) cancelled?)) (step))))
(#?(:clj invoke :cljs -invoke) [_ v]
(when-not (or (= v (a/getset a -cache v)) (a/getset a -stepped true))
(step)))
IDeref
(#?(:clj deref :cljs -deref) [this]
(a/set a -stepped false)
(if (a/get a -cancelled)
(do (cleanup-item-ps this a done) (throw (Cancelled.)))
(a/get a -cache))))))

(let [nul #?(:clj (Object.) :cljs (js/Object.))]
(defn ->item-ps [^Item item step done]
(let [a (object-array item-ps-field-count)]
(a/set a -cache nul)
(letfn [(step-idle [] (a/set a -step step-loaded) (step))
(step-loaded [])]
(a/set a -step step-idle)
(reify
IFn (#?(:clj invoke :cljs -invoke) [this] (let [ps* (a/fget item -ps*)] (ps* (disj (ps*) this))) (done))
(#?(:clj invoke :cljs -invoke) [_ v] (when (not= v (a/get a -cache)) (a/set a -cache v) ((a/get a -step))))
IDeref (#?(:clj deref :cljs -deref) [_] (a/set a -step step-idle) (a/get a -cache)))))))
(defn ->dead-item-ps [step done -v]
(step)
(let [<s> (->box -v)]
(reify
IFn (#?(:clj invoke :cljs -invoke) [_] (<s> nul))
IDeref (#?(:clj deref :cljs -deref) [this]
(done)
(if (identical? nul (<s>)) (throw (Cancelled.)) (let [v (<s>)] (<s> this) v)))))))

(defn grow! [^Ps ps diff]
(defn grow! [^Ps ps {d :degree, n :grow}]
(run! (fn [i]
(let [^Item item (->Item (object-array item-field-count))]
(a/fset item -ps* (->box #{}))
(a/set (a/fget ps -item*) i item)
(a/fswap ps -diff update :change assoc i
(a/fset item -flow (fn [step done]
(let [item-ps (->item-ps item step done), ps* (a/fget item -ps*)]
(ps* (conj (ps*) item-ps))
(item-ps (a/fget item -v))
item-ps))))))
(range (- (:degree diff) (:grow diff)) (:degree diff))))
(if (a/fget item -dead)
(->dead-item-ps step done (a/fget item -v))
(let [item-ps (->item-ps item step done), ps* (a/fget item -ps*)]
(ps* (conj (ps*) item-ps))
(item-ps (a/fget item -v))
item-ps)))))))
(range (- d n) d)))

(defn permute! [^Ps ps {p :permutation}]
(let [rot* (p/decompose conj #{} p)
item* (a/fget ps -item*)]
(run! (fn [rot] (apply a/rot item* rot)) rot*)))

(defn ->item ^Item [^Ps ps i] (a/get (a/fget ps -item*) i))
(defn shrink! [^Ps ps {d :degree, n :shrink}]
(let [item* (a/fget ps -item*)]
(run! (fn [i]
(let [^Item item (a/get item* i)]
(a/fset item -dead true)
(run! #(%) ((a/fget item -ps*)))))
(range (- d n) d))))

(defn change! [^Ps ps diff]
(reduce-kv (fn [_ i v]
(let [^Item item (->item ps i)]
(a/fset item -v v)
(run! (fn [item-ps] (item-ps v)) ((a/fget item -ps*)))))
nil (:change diff)))
(let [item* (a/fget ps -item*)]
(reduce-kv (fn [_ i v]
(let [^Item item (a/get item* i)]
(a/fset item -v v)
(run! (fn [item-ps] (item-ps v)) ((a/fget item -ps*)))))
nil (:change diff))))

(defn transfer-input [^Ps ps]
(let [diff @(a/fget ps -input-ps)]
(a/fset ps -diff {:change {}})
(grow! ps diff)
(permute! ps diff)
(shrink! ps diff)
(change! ps diff)
(dissoc diff :change)))

Expand Down
129 changes: 120 additions & 9 deletions test/hyperfiddle/incseq/items_eager_impl_test.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,8 +4,8 @@
[contrib.assert :as ca]
[hyperfiddle.incseq.diff-impl :as d]
[hyperfiddle.incseq.items-eager-impl :as items])
#?(:clj (:import
[clojure.lang ExceptionInfo IDeref IFn])))
(:import #?(:clj [clojure.lang ExceptionInfo IDeref IFn])
[missionary Cancelled]))

(defn ->queue
([] #?(:clj clojure.lang.PersistentQueue/EMPTY :cljs #queue []))
Expand Down Expand Up @@ -42,15 +42,15 @@
_ (q (d/empty-diff 0)) ; what input will return on transfer
ps (spawn-ps q)
;; transfer (fn transfer [diff] (q diff) @ps)
[_input-step _in-done] (q)
[_in-step _in-done] (q)
_ (t/is (= :items-step (q)))
_ (t/is (= (d/empty-diff 0) @ps))]))

(t/deftest one-item
(let [q (->mq)
_ (q (assoc (d/empty-diff 1) :grow 1 :change {0 :foo})) ; what input will return on transfer
items (spawn-ps q)
[_input-step _in-done] (q)
[_in-step _in-done] (q)
_ (t/is (= :items-step (q)))
diff @items
_ (t/is (= (assoc (d/empty-diff 1) :grow 1) (assoc diff :change {})))
Expand Down Expand Up @@ -147,7 +147,7 @@
_ (q ::none)
_ (t/is (= ::none (q)))]))

(t/deftest input-permutation
(t/deftest permutation
(let [q (->mq)
_ (q (assoc (d/empty-diff 2) :grow 2 :change {0 :foo, 1 :bar})) ; what input will return on transfer
items (spawn-ps q)
Expand All @@ -174,11 +174,122 @@
_ (q ::none)
_ (t/is (= ::none (q)))]))

(t/deftest shrink-terminates-idle-item-ps
(let [q (->mq)
_ (q (assoc (d/empty-diff 1) :grow 1 :change {0 :foo})) ; what input will return on transfer
items (spawn-ps q)
[in-step _in-done] (q)
_ (t/is (= :items-step (q)))
diff @items
_ (t/is (= (assoc (d/empty-diff 1) :grow 1) (assoc diff :change {})))
item0 ((-> diff :change (get 0)) #(q :item0-step) #(q :item0-done))
_ (t/is (= :item0-step (q)))
_ (t/is (= :foo @item0))
shrink1 (assoc (d/empty-diff 1) :shrink 1)
_ (q shrink1)
_ (in-step)
_ (t/is (= :item0-step (q)))
_ (t/is (= :items-step (q)))
_ (t/is (= shrink1 @items))
_ (t/is (thrown? Cancelled @item0))
_ (t/is (= :item0-done (q)))
_ (q ::none)
_ (t/is (= ::none (q)))]))

(t/deftest shrink-terminates-stepped-item-ps
(let [q (->mq)
_ (q (assoc (d/empty-diff 1) :grow 1 :change {0 :foo})) ; what input will return on transfer
items (spawn-ps q)
[in-step _in-done] (q)
_ (t/is (= :items-step (q)))
diff @items
_ (t/is (= (assoc (d/empty-diff 1) :grow 1) (assoc diff :change {})))
item0 ((-> diff :change (get 0)) #(q :item0-step) #(q :item0-done))
_ (t/is (= :item0-step (q)))
shrink1 (assoc (d/empty-diff 1) :shrink 1)
_ (q shrink1)
_ (in-step)
_ (t/is (= :items-step (q)))
_ (t/is (= shrink1 @items))
_ (t/is (thrown? Cancelled @item0))
_ (t/is (= :item0-done (q)))
_ (q ::none)
_ (t/is (= ::none (q)))]))

(t/deftest item-spawned-after-shrink-returns-last-value-and-terminates
(let [q (->mq)
_ (q (assoc (d/empty-diff 1) :grow 1 :change {0 :foo})) ; what input will return on transfer
items (spawn-ps q)
[in-step _in-done] (q)
_ (t/is (= :items-step (q)))
diff @items
_ (t/is (= (assoc (d/empty-diff 1) :grow 1) (assoc diff :change {})))
item0-flow (-> diff :change (get 0))
shrink1 (assoc (d/empty-diff 1) :shrink 1)
_ (q shrink1)
_ (in-step)
_ (t/is (= :items-step (q)))
_ (t/is (= shrink1 @items))
item0 (item0-flow #(q :item0-step) #(q :item0-done))
_ (t/is (= :item0-step (q)))
_ (t/is (= :foo @item0))
_ (t/is (= :item0-done (q)))
_ (q ::none)
_ (t/is (= ::none (q)))]))

(t/deftest item-spawned-after-shrink-and-cancelled-throws-and-terminates
(let [q (->mq)
_ (q (assoc (d/empty-diff 1) :grow 1 :change {0 :foo})) ; what input will return on transfer
items (spawn-ps q)
[in-step _in-done] (q)
_ (t/is (= :items-step (q)))
diff @items
_ (t/is (= (assoc (d/empty-diff 1) :grow 1) (assoc diff :change {})))
item0-flow (-> diff :change (get 0))
shrink1 (assoc (d/empty-diff 1) :shrink 1)
_ (q shrink1)
_ (in-step)
_ (t/is (= :items-step (q)))
_ (t/is (= shrink1 @items))
item0 (item0-flow #(q :item0-step) #(q :item0-done))
_ (t/is (= :item0-step (q)))
_ (item0)
_ (t/is (thrown? Cancelled @item0))
_ (t/is (= :item0-done (q)))
_ (q ::none)
_ (t/is (= ::none (q)))]))

(t/deftest item-ps-cancellation-idle
(let [q (->mq)
_ (q (assoc (d/empty-diff 1) :grow 1 :change {0 :foo})) ; what input will return on transfer
items (spawn-ps q)
[_in-step _in-done] (q)
_ (t/is (= :items-step (q)))
diff @items
_ (t/is (= (assoc (d/empty-diff 1) :grow 1) (assoc diff :change {})))
item0 ((-> diff :change (get 0)) #(q :item0-step) #(q :item0-done))
_ (t/is (= :item0-step (q)))
_ (t/is (= :foo @item0))
_ (item0)
_ (t/is (= :item0-step (q)))
_ (t/is (thrown? Cancelled @item0))
_ (t/is (= :item0-done (q)))]))

(t/deftest item-ps-cancellation-stepped
(let [q (->mq)
_ (q (assoc (d/empty-diff 1) :grow 1 :change {0 :foo})) ; what input will return on transfer
items (spawn-ps q)
[_in-step _in-done] (q)
_ (t/is (= :items-step (q)))
diff @items
_ (t/is (= (assoc (d/empty-diff 1) :grow 1) (assoc diff :change {})))
item0 ((-> diff :change (get 0)) #(q :item0-step) #(q :item0-done))
_ (t/is (= :item0-step (q)))
_ (item0)
_ (t/is (thrown? Cancelled @item0))
_ (t/is (= :item0-done (q)))]))

;; missing tests
;; - item-ps cancellation
;; - input shrink
;; - all item-ps want to terminate
;; - new ps transfers last value and terminates
;; - input terminate
;; - failures
;; - thread safety

0 comments on commit cd015ca

Please sign in to comment.