From d16068a938fda83b68e408c5d24cbfecccdfb937 Mon Sep 17 00:00:00 2001 From: xificurC Date: Mon, 26 Aug 2024 09:06:15 +0200 Subject: [PATCH 01/46] [i/items] eager scaffold --- src/hyperfiddle/incseq/items_eager_impl.cljc | 13 ++++++ .../incseq/items_eager_impl_test.cljc | 44 +++++++++++++++++++ 2 files changed, 57 insertions(+) create mode 100644 src/hyperfiddle/incseq/items_eager_impl.cljc create mode 100644 test/hyperfiddle/incseq/items_eager_impl_test.cljc diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc new file mode 100644 index 000000000..c1aa0d8fd --- /dev/null +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -0,0 +1,13 @@ +(ns hyperfiddle.incseq.items-eager-impl + (:require [hyperfiddle.incseq.diff-impl :as d]) + #?(:clj (:import [clojure.lang IFn IDeref]))) + +(defn flow [incseq] + (fn [step done] + (let [input-ps (incseq #() #()) + input-diff @input-ps] + (step) + (reify + IFn (#?(:clj invoke :cljs -invoke) [_] (input-ps) (done)) + IDeref (#?(:clj deref :cljs -deref) [_] input-diff)) + ))) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc new file mode 100644 index 000000000..67ed91e28 --- /dev/null +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -0,0 +1,44 @@ +(ns hyperfiddle.incseq.items-eager-impl-test + (:require + [clojure.test :as t] + [contrib.assert :as ca] + [hyperfiddle.incseq.diff-impl :as d] + [hyperfiddle.incseq.items-eager-impl :as items]) + #?(:clj (:import + [clojure.lang ExceptionInfo IDeref IFn]))) + +(defn ->queue + ([] #?(:clj clojure.lang.PersistentQueue/EMPTY :cljs #queue [])) + ([& args] (into (->queue) args))) + +(defn ->box + ([] (->box nil)) + ([init] (let [o (doto (object-array 1) (aset (int 0) init))] + (fn ([] (aget o (int 0))) ([v] (aset o (int 0) v)))))) + +(defn ->mq [] + (let [box (->box (->queue))] + (fn + ([] (let [q (box)] (ca/is q seq "empty test queue") (box (pop q)) (peek q))) + ([v] (box (conj (box) v)))))) + +(t/deftest queue-test + (let [q (->mq)] + (q 1) (t/is (= 1 (q))) + (q 2) (q 3) (t/is (= 2 (q))) (t/is (= 3 (q))) + (t/is (thrown? ExceptionInfo (q))))) + +(t/deftest spawn + (let [q (->mq) + _ (q (d/empty-diff 0)) ; what input will return on transfer + ps ((items/flow (fn [step done] + (q [step done]) + (step) + (reify + IFn (#?(:clj invoke :cljs -invoke) [_] (q :input-cancel)) + IDeref (#?(:clj deref :cljs -deref) [_] (q))))) + #(q :items-step) #(q :items-done)) + ;; transfer (fn transfer [diff] (q diff) @ps) + [_input-step _input-done] (q) + _ (t/is (= :items-step (q))) + _ (t/is (= @ps (d/empty-diff 0)))])) From e575dcaf177340187e25057eeaea55b8dcadd5ed Mon Sep 17 00:00:00 2001 From: xificurC Date: Mon, 26 Aug 2024 14:16:07 +0200 Subject: [PATCH 02/46] wip --- .../electric/impl/array_fields.cljc | 3 +- src/hyperfiddle/incseq/items_eager_impl.cljc | 38 +++++++++++---- .../incseq/items_eager_impl_test.cljc | 48 +++++++++++++++---- 3 files changed, 70 insertions(+), 19 deletions(-) diff --git a/src/hyperfiddle/electric/impl/array_fields.cljc b/src/hyperfiddle/electric/impl/array_fields.cljc index 4e35ed8a1..8a00e171a 100644 --- a/src/hyperfiddle/electric/impl/array_fields.cljc +++ b/src/hyperfiddle/electric/impl/array_fields.cljc @@ -5,7 +5,8 @@ ;; #?(:clj (set! *warn-on-reflection* true)) (defmacro deffields [& fields] `(do ~@(for [[fld idx] (mapv vector fields (range))] - `(def ~fld (int ~idx))))) + `(def ~fld (int ~idx))) + ~(count fields))) (defn swap ([^objects a k f] (aset a k (f (aget a k)))) ([^objects a k f x] (aset a k (f (aget a k) x))) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index c1aa0d8fd..7362fb3c1 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -1,13 +1,31 @@ (ns hyperfiddle.incseq.items-eager-impl - (:require [hyperfiddle.incseq.diff-impl :as d]) - #?(:clj (:import [clojure.lang IFn IDeref]))) + (:require [hyperfiddle.electric.impl.array-fields :as a]) + #?(:clj (:import [clojure.lang IDeref IFn]))) -(defn flow [incseq] +(def ps-field-count (a/deffields input-ps input-stepper input-doner diff v* flow*)) +(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))) + +(defn transfer-input [^Ps ps] + (let [diff @(a/fget ps input-ps)] + (reduce (fn [diff k] + (let [v (get (:change diff) k) flow* (a/fget ps flow*) v* (a/fget ps v*)] + (a/set v* k v) + (->> (a/set flow* k (fn [step done] + (step) + (reify + IFn (#?(:clj invoke :cljs -invoke) [_] (done)) + IDeref (#?(:clj deref :cljs -deref) [_] (a/get v* k))))) + (update diff :change assoc k)))) + diff (range (- (:degree diff) (:grow diff)) (:degree diff))))) +(defn consume-input-step [^Ps ps] (fn [] (a/fset ps diff (transfer-input ps)) ((.-step ps)))) +(defn consume-input-done [^Ps ps] (fn [])) + +(defn flow [input] (fn [step done] - (let [input-ps (incseq #() #()) - input-diff @input-ps] - (step) - (reify - IFn (#?(:clj invoke :cljs -invoke) [_] (input-ps) (done)) - IDeref (#?(:clj deref :cljs -deref) [_] input-diff)) - ))) + (let [ps (->Ps step done (object-array ps-field-count))] + (a/fset ps input-stepper #() input-doner #(), flow* (object-array 8), v* (object-array 8)) + (a/fset ps input-ps (input (fn [] ((a/fget ps input-stepper))) (fn [] ((a/fget ps input-doner))))) + (a/fset ps input-stepper (consume-input-step ps), input-doner (consume-input-done ps)) + (a/fset ps diff (transfer-input ps)) (step) ps))) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 67ed91e28..aba4e8dc5 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -28,17 +28,49 @@ (q 2) (q 3) (t/is (= 2 (q))) (t/is (= 3 (q))) (t/is (thrown? ExceptionInfo (q))))) +(defn spawn-ps [q] + ((items/flow (fn [step done] + (q [step done]) + (step) + (reify + IFn (#?(:clj invoke :cljs -invoke) [_] (q :input-cancel)) + IDeref (#?(:clj deref :cljs -deref) [_] (q))))) + #(q :items-step) #(q :items-done))) + (t/deftest spawn (let [q (->mq) _ (q (d/empty-diff 0)) ; what input will return on transfer - ps ((items/flow (fn [step done] - (q [step done]) - (step) - (reify - IFn (#?(:clj invoke :cljs -invoke) [_] (q :input-cancel)) - IDeref (#?(:clj deref :cljs -deref) [_] (q))))) - #(q :items-step) #(q :items-done)) + ps (spawn-ps q) ;; transfer (fn transfer [diff] (q diff) @ps) [_input-step _input-done] (q) _ (t/is (= :items-step (q))) - _ (t/is (= @ps (d/empty-diff 0)))])) + _ (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 _input-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))])) + +(t/deftest one-item-change + (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 _input-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)) + _ (q (assoc (d/empty-diff 1) :change {0 :bar})) + _ (input-step) + _ (t/is (= :item0-step (q))) + _ (t/is (= :bar @item0)) + ])) From f971cc3bcf23dfd7c03216b6657184c00f8034a9 Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 27 Aug 2024 10:00:08 +0200 Subject: [PATCH 03/46] [contrib.triple-store] cljs support --- src/contrib/data.cljc | 5 +++ .../{triple_store.clj => triple_store.cljc} | 45 +++++++------------ ..._store_test.clj => triple_store_test.cljc} | 6 +-- 3 files changed, 23 insertions(+), 33 deletions(-) rename src/contrib/{triple_store.clj => triple_store.cljc} (59%) rename test/contrib/{triple_store_test.clj => triple_store_test.cljc} (80%) diff --git a/src/contrib/data.cljc b/src/contrib/data.cljc index f1bec6f7e..4af032e15 100644 --- a/src/contrib/data.cljc +++ b/src/contrib/data.cljc @@ -353,3 +353,8 @@ ([f a b c d e] (fn [o] (f o a b c d e)))) (defn keep-if [v pred] (when (pred v) v)) + +(defn ->box + ([] (->box nil)) + ([init] (let [o (doto (object-array 1) (aset (int 0) init))] + (fn ([] (aget o (int 0))) ([v] (aset o (int 0) v)))))) diff --git a/src/contrib/triple_store.clj b/src/contrib/triple_store.cljc similarity index 59% rename from src/contrib/triple_store.clj rename to src/contrib/triple_store.cljc index 1c92e776d..a790fdd87 100644 --- a/src/contrib/triple_store.clj +++ b/src/contrib/triple_store.cljc @@ -1,8 +1,8 @@ (ns contrib.triple-store (:refer-clojure :exclude [find]) - (:require [dom-top.core :refer [loopr]] - [clojure.set :as set] - [contrib.assert :as ca])) + (:require [clojure.set :as set] + [contrib.assert :as ca] + [contrib.data :refer [->box]])) ;; ts - triple store ;; e - entity (id of entity) @@ -18,27 +18,25 @@ ;; ave :foo 1 -> (sorted-set 1 2) <- sorted so e.g. :parent e is well ordered ;; vea 1 1 -> #{:foo :bar} CURRENTLY NOT USED/FILLED -(defrecord TripleStore [o eav ave vea]) +(defrecord TripleStore [o eav ave]) -(defn ->ts ([] (->ts {})) ([o] (->TripleStore o {} {} {}))) +(defn ->ts ([] (->ts {})) ([o] (->TripleStore o {} {}))) (defn add [ts nd] (let [e (get nd :db/id) - [eav ave vea] - (loopr [eav (:eav ts), ave (:ave ts), vea (:vea ts)] - [[a v] nd] - (recur (update eav e assoc a v) - (update ave a update v (fnil conj (sorted-set)) e) - vea - #_(update vea v update e (fnil conj #{}) a)))] - (->TripleStore (:o ts) eav ave vea))) + -eav (->box (:eav ts)), -ave (->box (:ave ts))] + (reduce-kv (fn [_ a v] + (-eav (update (-eav) e assoc a v)) + (-ave (update (-ave) a update v (fnil conj (sorted-set)) e))) + nil nd) + (->TripleStore (:o ts) (-eav) (-ave)))) (defn del [ts e] (let [nd (-> ts :eav (get e)) - {:keys [o eav ave vea]} ts + {:keys [o eav ave]} ts eav (dissoc eav e) ave (reduce-kv (fn [ave a v] (update ave a update v disj e)) ave nd)] - (->TripleStore o eav ave vea))) + (->TripleStore o eav ave))) (defn upd [ts e a f] (let [v0 (-> ts :eav (get e) (get a)) @@ -48,26 +46,13 @@ (:ave ts) (let [ave (update (:ave ts) a update v1 (fnil conj (sorted-set)) e) ave (cond-> ave (contains? (get ave a) v0) (update a update v0 disj e))] - (cond-> ave (not (seq (-> ave (get a) (get v0)))) (update a dissoc v0)))) - vea (:vea ts) - ;; vea (update (:vea ts) v1 update e (fnil conj #{}) a) - ;; vea (cond-> vea (contains? (get vea v0) e) (update v0 update e disj a)) - ] - (->TripleStore (:o ts) eav ave vea))) + (cond-> ave (not (seq (-> ave (get a) (get v0)))) (update a dissoc v0))))] + (->TripleStore (:o ts) eav ave))) (defn asc ([ts e a v] (upd ts e a (fn [_] v))) ([ts e a v & avs] (apply asc (asc ts e a v) e avs))) -(defn get-entity [ts e] (get (:eav ts) e)) - -(defn ->datoms [ts] - (loopr [datoms (transient [])] - [[e av] (:eav ts) - [a v] av] - (recur (conj! datoms [e a v])) - (persistent! datoms))) - ;;;;;;;;;;;;;;; ;;; HELPERS ;;; ;;;;;;;;;;;;;;; diff --git a/test/contrib/triple_store_test.clj b/test/contrib/triple_store_test.cljc similarity index 80% rename from test/contrib/triple_store_test.clj rename to test/contrib/triple_store_test.cljc index 7e31bc7c1..9548a29f5 100644 --- a/test/contrib/triple_store_test.clj +++ b/test/contrib/triple_store_test.cljc @@ -3,12 +3,12 @@ [hyperfiddle.rcf :as rcf :refer [tests]])) (tests - (-> (ts/->ts) (ts/add {:db/id 1, :foo 2}) (ts/get-entity 1) :foo) := 2 + (-> (ts/->ts) (ts/add {:db/id 1, :foo 2}) (ts/->node 1) :foo) := 2 (-> (ts/->ts) (ts/add {:db/id 1, :foo 1}) (ts/add {:db/id 2, :foo 1}) :ave :foo (get 1)) := #{1 2} ;; (-> (ts/->ts) (ts/add {:db/id 1, :foo 2, :bar 2}) :vea (get 2) (get 1)) := #{:foo :bar} - (-> (ts/->ts) (ts/add {:db/id 1, :foo 2, :bar 2}) (ts/get-entity 1) (select-keys [:foo :bar :baz])) := {:foo 2, :bar 2} + (-> (ts/->ts) (ts/add {:db/id 1, :foo 2, :bar 2}) (ts/->node 1) (select-keys [:foo :bar :baz])) := {:foo 2, :bar 2} - (-> (ts/->ts) (ts/add {:db/id '_}) (ts/upd '_ :x (fnil inc 0)) (ts/upd '_ :x (fnil inc 0)) (ts/get-entity '_) :x) := 2 + (-> (ts/->ts) (ts/add {:db/id '_}) (ts/upd '_ :x (fnil inc 0)) (ts/upd '_ :x (fnil inc 0)) (ts/->node '_) :x) := 2 (-> (ts/->ts) (ts/add {:db/id 1}) (ts/asc 1 :x 2) (ts/asc 1 :x 2) :ave :x (get 2)) := #{1} (-> (ts/->ts) (ts/add {:db/id 1}) (ts/asc 1 :x 2 :y 3) :eav (get 1)) := {:db/id 1, :x 2, :y 3} From 75f6a8a2bb2446409291347eb707b12d1059038e Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 27 Aug 2024 10:00:32 +0200 Subject: [PATCH 04/46] [i/items] two items, dedupe --- src/hyperfiddle/incseq/items_eager_impl.cljc | 78 ++++++++++++++----- .../incseq/items_eager_impl_test.cljc | 49 +++++++++++- 2 files changed, 106 insertions(+), 21 deletions(-) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index 7362fb3c1..638227266 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -1,31 +1,69 @@ (ns hyperfiddle.incseq.items-eager-impl - (:require [hyperfiddle.electric.impl.array-fields :as a]) + (:require [contrib.data :refer [->box]] + [hyperfiddle.electric.impl.array-fields :as a]) #?(:clj (:import [clojure.lang IDeref IFn]))) -(def ps-field-count (a/deffields input-ps input-stepper input-doner diff v* flow*)) +(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))) + 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*)) +(deftype Item [state-]) + +(def item-ps-field-count (a/deffields -step -done -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 grow-input! [^Ps ps diff] + (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)))) + +(defn ->item ^Item [^Ps ps i] (a/get (a/fget ps -item*) i)) + +(defn change-input! [^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))) (defn transfer-input [^Ps ps] - (let [diff @(a/fget ps input-ps)] - (reduce (fn [diff k] - (let [v (get (:change diff) k) flow* (a/fget ps flow*) v* (a/fget ps v*)] - (a/set v* k v) - (->> (a/set flow* k (fn [step done] - (step) - (reify - IFn (#?(:clj invoke :cljs -invoke) [_] (done)) - IDeref (#?(:clj deref :cljs -deref) [_] (a/get v* k))))) - (update diff :change assoc k)))) - diff (range (- (:degree diff) (:grow diff)) (:degree diff))))) -(defn consume-input-step [^Ps ps] (fn [] (a/fset ps diff (transfer-input ps)) ((.-step ps)))) + (let [diff @(a/fget ps -input-ps)] + (a/fset ps -diff {:change {}}) + (grow-input! ps diff) + (change-input! ps diff) + (dissoc diff :change))) + +(defn needed-diff? [d] + (or (seq (:permutation d)) (seq (:change d)) (pos? (:grow d)) (pos? (:shrink d)) (seq (:freeze d)))) + +(defn consume-input-step [^Ps ps] + (fn [] (when (needed-diff? (a/fswap ps -diff merge (transfer-input ps))) ((.-step ps))))) (defn consume-input-done [^Ps ps] (fn [])) (defn flow [input] (fn [step done] (let [ps (->Ps step done (object-array ps-field-count))] - (a/fset ps input-stepper #() input-doner #(), flow* (object-array 8), v* (object-array 8)) - (a/fset ps input-ps (input (fn [] ((a/fget ps input-stepper))) (fn [] ((a/fget ps input-doner))))) - (a/fset ps input-stepper (consume-input-step ps), input-doner (consume-input-done ps)) - (a/fset ps diff (transfer-input ps)) (step) ps))) + (a/fset ps -input-stepper #() -input-doner #(), -item* (object-array 8)) + (a/fset ps -input-ps (input (fn [] ((a/fget ps -input-stepper))) (fn [] ((a/fget ps -input-doner))))) + (a/fset ps -input-stepper (consume-input-step ps), -input-doner (consume-input-done ps)) + (a/fswap ps -diff merge (transfer-input ps)) (step) ps))) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index aba4e8dc5..95d75d629 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -72,5 +72,52 @@ _ (q (assoc (d/empty-diff 1) :change {0 :bar})) _ (input-step) _ (t/is (= :item0-step (q))) - _ (t/is (= :bar @item0)) + _ (t/is (= :bar @item0))])) + +(t/deftest one-item-dedupes + (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 _input-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)) + _ (q (assoc (d/empty-diff 1) :change {0 :foo})) + _ (input-step) + _ (q ::none) ; :foo = :foo, so we skipped + _ (t/is (= ::none (q)))])) + +(t/deftest two-items + (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 _input-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)) + _ (q {:grow 1, :degree 2, :shrink 0, :permutation {}, :freeze #{}, :change {1 :bar}}) + _ (input-step) + _ (t/is (= :items-step (q))) + diff @items + _ (t/is (= {:grow 1, :degree 2, :shrink 0, :permutation {}, :freeze #{}} (dissoc diff :change))) + item1 ((-> diff :change (get 1)) #(q :item1-step) #(q :item1-done)) + _ (t/is (= :item1-step (q))) + _ (t/is (= :bar @item1)) ])) +;; missing tests +;; - 2+ items +;; - item-ps cancellation +;; - 2+ item-ps +;; - input permutation +;; - input shrink +;; - all item-ps want to terminate +;; - new ps transfers last value and terminates +;; - input terminate +;; - failures +;; - thread safety From 5221025a7e5e8e71edabbed42fce1fd3916d6f0b Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 27 Aug 2024 10:08:57 +0200 Subject: [PATCH 05/46] [i/items] [test] items transfer latest value --- .../incseq/items_eager_impl_test.cljc | 37 +++++++++++++------ 1 file changed, 26 insertions(+), 11 deletions(-) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 95d75d629..cc1ee26a8 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -42,7 +42,7 @@ _ (q (d/empty-diff 0)) ; what input will return on transfer ps (spawn-ps q) ;; transfer (fn transfer [diff] (q diff) @ps) - [_input-step _input-done] (q) + [_input-step _in-done] (q) _ (t/is (= :items-step (q))) _ (t/is (= (d/empty-diff 0) @ps))])) @@ -50,7 +50,7 @@ (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 _input-done] (q) + [_input-step _in-done] (q) _ (t/is (= :items-step (q))) diff @items _ (t/is (= (assoc (d/empty-diff 1) :grow 1) (assoc diff :change {}))) @@ -62,7 +62,7 @@ (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 _input-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 {}))) @@ -70,7 +70,7 @@ _ (t/is (= :item0-step (q))) _ (t/is (= :foo @item0)) _ (q (assoc (d/empty-diff 1) :change {0 :bar})) - _ (input-step) + _ (in-step) _ (t/is (= :item0-step (q))) _ (t/is (= :bar @item0))])) @@ -78,7 +78,7 @@ (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 _input-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 {}))) @@ -86,7 +86,7 @@ _ (t/is (= :item0-step (q))) _ (t/is (= :foo @item0)) _ (q (assoc (d/empty-diff 1) :change {0 :foo})) - _ (input-step) + _ (in-step) _ (q ::none) ; :foo = :foo, so we skipped _ (t/is (= ::none (q)))])) @@ -94,7 +94,7 @@ (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 _input-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 {}))) @@ -102,16 +102,31 @@ _ (t/is (= :item0-step (q))) _ (t/is (= :foo @item0)) _ (q {:grow 1, :degree 2, :shrink 0, :permutation {}, :freeze #{}, :change {1 :bar}}) - _ (input-step) + _ (in-step) _ (t/is (= :items-step (q))) diff @items _ (t/is (= {:grow 1, :degree 2, :shrink 0, :permutation {}, :freeze #{}} (dissoc diff :change))) item1 ((-> diff :change (get 1)) #(q :item1-step) #(q :item1-done)) _ (t/is (= :item1-step (q))) - _ (t/is (= :bar @item1)) - ])) + _ (t/is (= :bar @item1))])) + +(t/deftest item-is-latest + (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))) + _ (q (assoc (d/empty-diff 1) :change {0 :bar})) + _ (in-step) + _ (t/is (= :bar @item0)) + _ (q ::none) + _ (t/is (= ::none (q)))])) + ;; missing tests -;; - 2+ items ;; - item-ps cancellation ;; - 2+ item-ps ;; - input permutation From d6b68c64350fb5df7dd95c5e2b2f89c7daa2f63e Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 27 Aug 2024 10:13:18 +0200 Subject: [PATCH 06/46] [i/items] [test] 1 item can have 2 processes --- .../incseq/items_eager_impl_test.cljc | 21 +++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index cc1ee26a8..2d9787142 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -126,6 +126,27 @@ _ (q ::none) _ (t/is (= ::none (q)))])) +(t/deftest two-item-processes + (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-ps0 ((-> diff :change (get 0)) #(q :item0-ps0-step) #(q :item0-ps0-done)) + _ (t/is (= :item0-ps0-step (q))) + item0-ps1 ((-> diff :change (get 0)) #(q :item0-ps1-step) #(q :item0-ps1-done)) + _ (t/is (= :item0-ps1-step (q))) + _ (t/is (= :foo @item0-ps1)) ; ps1 reads, ps0 didn't + _ (q (assoc (d/empty-diff 1) :change {0 :bar})) + _ (in-step) + _ (t/is (= :item0-ps1-step (q))) ; ps1 steps because it already transferred + _ (t/is (= :bar @item0-ps0)) ; ps0 transfers latest + _ (t/is (= :bar @item0-ps1)) ; ps1 transfers + _ (q ::none) + _ (t/is (= ::none (q)))])) + ;; missing tests ;; - item-ps cancellation ;; - 2+ item-ps From b9540b84706b3ed51be6230f02f5debc6264f3f5 Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 27 Aug 2024 12:13:54 +0200 Subject: [PATCH 07/46] [i/items] permutations --- .../electric/impl/array_fields.cljc | 57 ++++++++++++++----- src/hyperfiddle/incseq/items_eager_impl.cljc | 19 +++++-- .../incseq/items_eager_impl_test.cljc | 29 +++++++++- 3 files changed, 82 insertions(+), 23 deletions(-) diff --git a/src/hyperfiddle/electric/impl/array_fields.cljc b/src/hyperfiddle/electric/impl/array_fields.cljc index 8a00e171a..19c44abb8 100644 --- a/src/hyperfiddle/electric/impl/array_fields.cljc +++ b/src/hyperfiddle/electric/impl/array_fields.cljc @@ -2,30 +2,43 @@ (:refer-clojure :exclude [get set]) #?(:cljs (:require-macros hyperfiddle.electric.impl.array-fields)) (:require [hyperfiddle.rcf :as rcf :refer [tests]])) -;; #?(:clj (set! *warn-on-reflection* true)) +#?(:clj (set! *warn-on-reflection* true)) (defmacro deffields [& fields] `(do ~@(for [[fld idx] (mapv vector fields (range))] `(def ~fld (int ~idx))) ~(count fields))) +(defn get [^objects a k] (aget a (int k))) +(defn set + ([^objects a i v] (aset a (int i) v)) + ([^objects a i v i2 v2] (aset a (int i) v) (aset a (int i2) v2)) + ([^objects a i v i2 v2 i3 v3] (aset a (int i) v) (aset a (int i2) v2) (aset a (int i3) v3)) + ([^objects a i v i2 v2 i3 v3 i4 v4] (aset a (int i) v) (aset a (int i2) v2) (aset a (int i3) v3) (aset a (int i4) v4)) + ([^objects a i v i2 v2 i3 v3 i4 v4 & more] (set a i v i2 v2 i3 v3 i4 v4) (apply set a more))) (defn swap - ([^objects a k f] (aset a k (f (aget a k)))) - ([^objects a k f x] (aset a k (f (aget a k) x))) - ([^objects a k f x y] (aset a k (f (aget a k) x y))) - ([^objects a k f x y z] (aset a k (f (aget a k) x y z))) - ([^objects a k f x y z & more] (aset a k (apply f (aget a k) x y z more)))) + ([^objects a k f] (set a k (f (get a k)))) + ([^objects a k f x] (set a k (f (get a k) x))) + ([^objects a k f x y] (set a k (f (get a k) x y))) + ([^objects a k f x y z] (set a k (f (get a k) x y z))) + ([^objects a k f x y z & more] (set a k (apply f (get a k) x y z more)))) (defmacro fswap [O k f & args] `(swap (.-state- ~O) ~k ~f ~@args)) -(defn get [^objects a k] (aget a k)) (defmacro fget [O k] `(get (.-state- ~O) ~k)) -(defmacro set [arr & kvs] - (let [ar (with-meta (gensym "arr") {:tag 'objects})] - `(let [~ar ~arr] - ~@(for [[k v] (partition 2 kvs)] - ;; FIXME better way to fix reflection warning than call `identity`? - `(aset ~ar ~k (identity ~v)))))) (defmacro fset [O & kvs] `(set (.-state- ~O) ~@kvs)) -(defn getset [^objects a k v] (let [ret (aget a k)] (aset a k v) ret)) +(defn getset [^objects a k v] (let [ret (get a k)] (set a k v) ret)) (defmacro fgetset [O k v] `(getset (.-state- ~O) ~k ~v)) -(defn getswap [^objects a k f] (let [ret (aget a k)] (swap a k f) ret)) +(defn getswap [^objects a k f] (let [ret (get a k)] (swap a k f) ret)) + +(defn rot + ([^objects a i j] (let [tmp (get a i)] (set a i (get a j) j tmp))) + ([^objects a i j k] (let [tmp (get a i)] (set a i (get a j) j (get a k) k tmp))) + ([^objects a i j k l] (let [tmp (get a i)] (set a i (get a j) j (get a k) k (get a l) l tmp))) + ([^objects a i j k l & more] + (let [tmp (get a i)] + (rot a i j k l) + (loop [[i j :as more] (seq (cons l more))] + (if j + (do (set a i (get a j)) (recur (next more))) + (set a i tmp)))))) + ;;; TESTS ;;; (deftype P [state-]) @@ -43,3 +56,17 @@ (getswap (.-state- aP) x inc) := 100 (fget aP x) := 101 )) + +(tests + (let [a (object-array [:a :b])] + (rot a 0 1) + (vec a) := [:b :a]) + (let [a (object-array [:a :b :c])] + (rot a 0 2 1) + (vec a) := [:c :a :b]) + (let [a (object-array [:a :b :c :d])] + (rot a 0 2 1 3) + (vec a) := [:c :d :b :a]) + (let [a (object-array [:a :b :c :d :e :f :g])] + (apply rot a (range 7)) + (vec a) := [:b :c :d :e :f :g :a])) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index 638227266..20f443577 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -1,6 +1,7 @@ (ns hyperfiddle.incseq.items-eager-impl (:require [contrib.data :refer [->box]] - [hyperfiddle.electric.impl.array-fields :as a]) + [hyperfiddle.electric.impl.array-fields :as a] + [hyperfiddle.incseq.perm-impl :as p]) #?(:clj (:import [clojure.lang IDeref IFn]))) (def ps-field-count (a/deffields -input-ps -input-stepper -input-doner -diff -item*)) @@ -24,7 +25,7 @@ (#?(: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 grow-input! [^Ps ps diff] +(defn grow! [^Ps ps diff] (run! (fn [i] (let [^Item item (->Item (object-array item-field-count))] (a/fset item -ps* (->box #{})) @@ -37,9 +38,14 @@ item-ps)))))) (range (- (:degree diff) (:grow diff)) (:degree diff)))) +(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 change-input! [^Ps ps diff] +(defn change! [^Ps ps diff] (reduce-kv (fn [_ i v] (let [^Item item (->item ps i)] (a/fset item -v v) @@ -49,12 +55,13 @@ (defn transfer-input [^Ps ps] (let [diff @(a/fget ps -input-ps)] (a/fset ps -diff {:change {}}) - (grow-input! ps diff) - (change-input! ps diff) + (grow! ps diff) + (permute! ps diff) + (change! ps diff) (dissoc diff :change))) (defn needed-diff? [d] - (or (seq (:permutation d)) (seq (:change d)) (pos? (:grow d)) (pos? (:shrink d)) (seq (:freeze d)))) + (or (seq (:permutation d)) (pos? (:grow d)) (pos? (:shrink d)) (seq (:freeze d)))) (defn consume-input-step [^Ps ps] (fn [] (when (needed-diff? (a/fswap ps -diff merge (transfer-input ps))) ((.-step ps))))) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 2d9787142..e556c5359 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -147,10 +147,35 @@ _ (q ::none) _ (t/is (= ::none (q)))])) +(t/deftest input-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) + [in-step _in-done] (q) + _ (t/is (= :items-step (q))) + diff @items + _ (t/is (= (assoc (d/empty-diff 2) :grow 2) (assoc diff :change {}))) + item0 ((-> diff :change (get 0)) #(q :item0-step) #(q :item0-done)) + _ (t/is (= :item0-step (q))) + _ (t/is (= :foo @item0)) + item1 ((-> diff :change (get 1)) #(q :item1-step) #(q :item1-done)) + _ (t/is (= :item1-step (q))) + _ (t/is (= :bar @item1)) + perm (assoc (d/empty-diff 2) :permutation {0 1, 1 0}) + _ (q perm) + _ (in-step) + _ (t/is (= :items-step (q))) + diff @items + _ (t/is (= perm diff)) + _ (q (assoc (d/empty-diff 2) :change {0 :baz})) + _ (in-step) + _ (t/is (= :item1-step (q))) ; change on 0 means item1 after permutation + _ (t/is (= :baz @item1)) + _ (q ::none) + _ (t/is (= ::none (q)))])) + ;; missing tests ;; - item-ps cancellation -;; - 2+ item-ps -;; - input permutation ;; - input shrink ;; - all item-ps want to terminate ;; - new ps transfers last value and terminates From 496180b9c263c97bc4cc8a084180aa96a361493f Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 27 Aug 2024 17:46:20 +0200 Subject: [PATCH 08/46] [i/items] shrink, cancellation --- .../electric/impl/array_fields.cljc | 2 +- src/hyperfiddle/incseq/items_eager_impl.cljc | 83 +++++++---- .../incseq/items_eager_impl_test.cljc | 129 ++++++++++++++++-- 3 files changed, 179 insertions(+), 35 deletions(-) diff --git a/src/hyperfiddle/electric/impl/array_fields.cljc b/src/hyperfiddle/electric/impl/array_fields.cljc index 19c44abb8..24a3170b0 100644 --- a/src/hyperfiddle/electric/impl/array_fields.cljc +++ b/src/hyperfiddle/electric/impl/array_fields.cljc @@ -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)) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index 20f443577..f5cb61cd4 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -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 [ (->box -v)] + (reify + IFn (#?(:clj invoke :cljs -invoke) [_] ( nul)) + IDeref (#?(:clj deref :cljs -deref) [this] + (done) + (if (identical? nul ()) (throw (Cancelled.)) (let [v ()] ( 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))) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index e556c5359..5dd7d68e5 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -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 [])) @@ -42,7 +42,7 @@ _ (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))])) @@ -50,7 +50,7 @@ (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 {}))) @@ -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) @@ -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 From 458338bd7fb1b8648745557ed04588f9215b99c6 Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 27 Aug 2024 17:47:12 +0200 Subject: [PATCH 09/46] formatting --- .../incseq/items_eager_impl_test.cljc | 115 +++++++++--------- 1 file changed, 57 insertions(+), 58 deletions(-) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 5dd7d68e5..c421ee807 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -38,77 +38,76 @@ #(q :items-step) #(q :items-done))) (t/deftest spawn - (let [q (->mq) - _ (q (d/empty-diff 0)) ; what input will return on transfer - ps (spawn-ps q) - ;; transfer (fn transfer [diff] (q diff) @ps) + (let [q (->mq) + _ (q (d/empty-diff 0)) ; what input will return on transfer + ps (spawn-ps q) [_in-step _in-done] (q) - _ (t/is (= :items-step (q))) - _ (t/is (= (d/empty-diff 0) @ps))])) + _ (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) + (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))])) + _ (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))])) (t/deftest one-item-change - (let [q (->mq) - _ (q (assoc (d/empty-diff 1) :grow 1 :change {0 :foo})) ; what input will return on transfer - items (spawn-ps q) + (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)) - _ (q (assoc (d/empty-diff 1) :change {0 :bar})) - _ (in-step) - _ (t/is (= :item0-step (q))) - _ (t/is (= :bar @item0))])) + _ (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)) + _ (q (assoc (d/empty-diff 1) :change {0 :bar})) + _ (in-step) + _ (t/is (= :item0-step (q))) + _ (t/is (= :bar @item0))])) (t/deftest one-item-dedupes - (let [q (->mq) - _ (q (assoc (d/empty-diff 1) :grow 1 :change {0 :foo})) ; what input will return on transfer - items (spawn-ps q) + (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)) - _ (q (assoc (d/empty-diff 1) :change {0 :foo})) - _ (in-step) - _ (q ::none) ; :foo = :foo, so we skipped - _ (t/is (= ::none (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)) + _ (q (assoc (d/empty-diff 1) :change {0 :foo})) + _ (in-step) + _ (q ::none) ; :foo = :foo, so we skipped + _ (t/is (= ::none (q)))])) (t/deftest two-items - (let [q (->mq) - _ (q (assoc (d/empty-diff 1) :grow 1 :change {0 :foo})) ; what input will return on transfer - items (spawn-ps q) + (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)) - _ (q {:grow 1, :degree 2, :shrink 0, :permutation {}, :freeze #{}, :change {1 :bar}}) - _ (in-step) - _ (t/is (= :items-step (q))) - diff @items - _ (t/is (= {:grow 1, :degree 2, :shrink 0, :permutation {}, :freeze #{}} (dissoc diff :change))) - item1 ((-> diff :change (get 1)) #(q :item1-step) #(q :item1-done)) - _ (t/is (= :item1-step (q))) - _ (t/is (= :bar @item1))])) + _ (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)) + _ (q {:grow 1, :degree 2, :shrink 0, :permutation {}, :freeze #{}, :change {1 :bar}}) + _ (in-step) + _ (t/is (= :items-step (q))) + diff @items + _ (t/is (= {:grow 1, :degree 2, :shrink 0, :permutation {}, :freeze #{}} (dissoc diff :change))) + item1 ((-> diff :change (get 1)) #(q :item1-step) #(q :item1-done)) + _ (t/is (= :item1-step (q))) + _ (t/is (= :bar @item1))])) (t/deftest item-is-latest (let [q (->mq) From 5995ae1387bcfe06ff086cc80664fa68fcae52b4 Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 27 Aug 2024 21:59:55 +0200 Subject: [PATCH 10/46] [i/items] cancellation --- src/hyperfiddle/incseq/items_eager_impl.cljc | 27 +++++++--- .../incseq/items_eager_impl_test.cljc | 50 ++++++++++++++++++- 2 files changed, 69 insertions(+), 8 deletions(-) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index f5cb61cd4..c8cea21c9 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -5,15 +5,27 @@ (:import #?(:clj [clojure.lang IDeref IFn]) [missionary Cancelled])) -(def ps-field-count (a/deffields -input-ps -input-stepper -input-doner -diff -item*)) +(def ps-field-count (a/deffields -stepped -cancelled -input-ps -input-stepper -input-doner -diff -item*)) +(declare cleanup-ps) (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))) + IFn (#?(:clj invoke :cljs -invoke) [^Ps this] + ((a/get state- -input-ps)) + (let [cancelled? (a/fgetset this -cancelled true)] + (when (not (or (a/fgetset this -stepped true) cancelled?)) (step)))) + IDeref (#?(:clj deref :cljs -deref) [^Ps this] + (a/fset this -stepped false) + (if (a/fget this -cancelled) + (do (cleanup-ps this done) (throw (Cancelled.))) + (a/get state- -diff)))) +(defn cleanup-ps [^Ps ps done] + (when-not (identical? ps (a/fgetset ps -diff ps)) + (a/fset ps -input-ps nil, -input-stepper nil, -input-doner nil, -diff nil, -item* nil) + (done))) (def item-field-count (a/deffields -v -flow -ps* -dead)) (deftype Item [state-]) -(def item-ps-field-count (a/deffields -stepped -cache -cancelled)) +(def item-ps-field-count (a/deffields -stepped -cancelled -cache)) (defn remove-item-ps [^Item item ps] (let [ps* (a/fget item -ps*)] (ps* (disj (ps*) ps)))) @@ -97,7 +109,10 @@ (or (seq (:permutation d)) (pos? (:grow d)) (pos? (:shrink d)) (seq (:freeze d)))) (defn consume-input-step [^Ps ps] - (fn [] (when (needed-diff? (a/fswap ps -diff merge (transfer-input ps))) ((.-step ps))))) + (fn [] + (when (needed-diff? (a/fswap ps -diff merge (transfer-input ps))) + (when-not (a/fgetset ps -stepped true) + ((.-step ps)))))) (defn consume-input-done [^Ps ps] (fn [])) (defn flow [input] @@ -106,4 +121,4 @@ (a/fset ps -input-stepper #() -input-doner #(), -item* (object-array 8)) (a/fset ps -input-ps (input (fn [] ((a/fget ps -input-stepper))) (fn [] ((a/fget ps -input-doner))))) (a/fset ps -input-stepper (consume-input-step ps), -input-doner (consume-input-done ps)) - (a/fswap ps -diff merge (transfer-input ps)) (step) ps))) + (a/fswap ps -diff merge (transfer-input ps)) (a/fset ps -stepped true) (step) ps))) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index c421ee807..bd3a268aa 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -272,7 +272,9 @@ _ (item0) _ (t/is (= :item0-step (q))) _ (t/is (thrown? Cancelled @item0)) - _ (t/is (= :item0-done (q)))])) + _ (t/is (= :item0-done (q))) + _ (q ::none) + _ (t/is (= ::none (q)))])) (t/deftest item-ps-cancellation-stepped (let [q (->mq) @@ -286,9 +288,53 @@ _ (t/is (= :item0-step (q))) _ (item0) _ (t/is (thrown? Cancelled @item0)) - _ (t/is (= :item0-done (q)))])) + _ (t/is (= :item0-done (q))) + _ (q ::none) + _ (t/is (= ::none (q)))])) + +(t/deftest 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 {}))) + _ (items) + _ (t/is (= :input-cancel (q))) + _ (t/is (= :items-step (q))) + _ (t/is (thrown? Cancelled @items)) + _ (t/is (= :items-done (q))) + _ (q ::none) + _ (t/is (= ::none (q)))])) + +(t/deftest 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))) + _ (items) + _ (t/is (= :input-cancel (q))) + _ (t/is (thrown? Cancelled @items)) + _ (t/is (= :items-done (q))) + _ (q ::none) + _ (t/is (= ::none (q)))])) ;; missing tests +;; - items reentrant transfer ;; - input terminate ;; - failures +;; - double cancel before termination +;; - item-ps +;; - dead-item-ps +;; - items +;; - double cancel after termination +;; - item-ps +;; - dead-item-ps +;; - items +;; - double transfer +;; - item-ps +;; - dead-item-ps +;; - items ;; - thread safety From 8f1a3139e21754a0fe11e05529c814fa91d17d92 Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 27 Aug 2024 22:01:32 +0200 Subject: [PATCH 11/46] test cleanup --- .../incseq/items_eager_impl_test.cljc | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index bd3a268aa..05536164a 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -39,11 +39,13 @@ (t/deftest spawn (let [q (->mq) - _ (q (d/empty-diff 0)) ; what input will return on transfer + _ (q (d/empty-diff 0)) ; what input will return on transfer ps (spawn-ps q) [_in-step _in-done] (q) _ (t/is (= :items-step (q))) - _ (t/is (= (d/empty-diff 0) @ps))])) + _ (t/is (= (d/empty-diff 0) @ps)) + _ (q ::none) + _ (t/is (= ::none (q)))])) (t/deftest one-item (let [q (->mq) @@ -55,7 +57,9 @@ _ (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))])) + _ (t/is (= :foo @item0)) + _ (q ::none) + _ (t/is (= ::none (q)))])) (t/deftest one-item-change (let [q (->mq) @@ -71,7 +75,9 @@ _ (q (assoc (d/empty-diff 1) :change {0 :bar})) _ (in-step) _ (t/is (= :item0-step (q))) - _ (t/is (= :bar @item0))])) + _ (t/is (= :bar @item0)) + _ (q ::none) + _ (t/is (= ::none (q)))])) (t/deftest one-item-dedupes (let [q (->mq) @@ -107,7 +113,9 @@ _ (t/is (= {:grow 1, :degree 2, :shrink 0, :permutation {}, :freeze #{}} (dissoc diff :change))) item1 ((-> diff :change (get 1)) #(q :item1-step) #(q :item1-done)) _ (t/is (= :item1-step (q))) - _ (t/is (= :bar @item1))])) + _ (t/is (= :bar @item1)) + _ (q ::none) + _ (t/is (= ::none (q)))])) (t/deftest item-is-latest (let [q (->mq) From a3b95475e59c5f539f879a5f66852a869e375813 Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 27 Aug 2024 22:38:14 +0200 Subject: [PATCH 12/46] [i/items] double input step --- src/hyperfiddle/incseq/items_eager_impl.cljc | 36 ++++++++++--------- .../incseq/items_eager_impl_test.cljc | 15 ++++++++ 2 files changed, 35 insertions(+), 16 deletions(-) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index c8cea21c9..11a8a9f89 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -1,6 +1,7 @@ (ns hyperfiddle.incseq.items-eager-impl (:require [contrib.data :refer [->box]] [hyperfiddle.electric.impl.array-fields :as a] + [hyperfiddle.incseq.diff-impl :as d] [hyperfiddle.incseq.perm-impl :as p]) (:import #?(:clj [clojure.lang IDeref IFn]) [missionary Cancelled])) @@ -96,29 +97,32 @@ (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))) - (defn needed-diff? [d] (or (seq (:permutation d)) (pos? (:grow d)) (pos? (:shrink d)) (seq (:freeze d)))) -(defn consume-input-step [^Ps ps] - (fn [] - (when (needed-diff? (a/fswap ps -diff merge (transfer-input ps))) - (when-not (a/fgetset ps -stepped true) - ((.-step ps)))))) +(defn transfer-input [^Ps ps] + (let [prev-diff (case (a/fget ps -stepped) true (a/fget ps -diff) #_else nil) + in-diff @(a/fget ps -input-ps)] + (a/fset ps -diff {:change {}}) + (grow! ps in-diff) + (permute! ps in-diff) + (shrink! ps in-diff) + (change! ps in-diff) + (let [diff (assoc in-diff :change (:change (a/fget ps -diff))) + diff (if prev-diff (d/combine prev-diff diff) diff)] + (a/fset ps -diff diff) + (case (a/fget ps -stepped) + ::never (do (a/fset ps -stepped true) ((.-step ps))) + true nil + false (when (needed-diff? diff) (a/fset ps -stepped true) ((.-step ps))))))) + +(defn consume-input-step [^Ps ps] (fn [] (transfer-input ps))) (defn consume-input-done [^Ps ps] (fn [])) (defn flow [input] (fn [step done] (let [ps (->Ps step done (object-array ps-field-count))] - (a/fset ps -input-stepper #() -input-doner #(), -item* (object-array 8)) + (a/fset ps -input-stepper #() -input-doner #(), -item* (object-array 8), -stepped ::never) (a/fset ps -input-ps (input (fn [] ((a/fget ps -input-stepper))) (fn [] ((a/fget ps -input-doner))))) (a/fset ps -input-stepper (consume-input-step ps), -input-doner (consume-input-done ps)) - (a/fswap ps -diff merge (transfer-input ps)) (a/fset ps -stepped true) (step) ps))) + (transfer-input ps) ps))) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 05536164a..d62a4734a 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -329,6 +329,20 @@ _ (q ::none) _ (t/is (= ::none (q)))])) +(t/deftest double-input-step + (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))) + _ (q (assoc (d/empty-diff 2) :grow 1 :change {1 :bar})) + _ (in-step) + diff @items + _ (t/is (= (assoc (d/empty-diff 2) :grow 2) (assoc diff :change {}))) + _ (t/is (= 2 (count (:change diff)))) + _ (q ::none) + _ (t/is (= ::none (q)))])) + ;; missing tests ;; - items reentrant transfer ;; - input terminate @@ -345,4 +359,5 @@ ;; - item-ps ;; - dead-item-ps ;; - items +;; - item* grow ;; - thread safety From 0069dbcdda5b605a5067f65275e2687d83ad682b Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 10:17:14 +0200 Subject: [PATCH 13/46] [i/items] reentrant input transfer --- src/hyperfiddle/incseq/items_eager_impl.cljc | 37 ++++++++++--------- .../incseq/items_eager_impl_test.cljc | 16 +++++++- 2 files changed, 34 insertions(+), 19 deletions(-) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index 11a8a9f89..920127c87 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -6,7 +6,7 @@ (:import #?(:clj [clojure.lang IDeref IFn]) [missionary Cancelled])) -(def ps-field-count (a/deffields -stepped -cancelled -input-ps -input-stepper -input-doner -diff -item*)) +(def ps-field-count (a/deffields -stepped -cancelled -go -input-ps -input-stepper -input-doner -diff -item*)) (declare cleanup-ps) (deftype Ps [step done state-] IFn (#?(:clj invoke :cljs -invoke) [^Ps this] @@ -17,7 +17,7 @@ (a/fset this -stepped false) (if (a/fget this -cancelled) (do (cleanup-ps this done) (throw (Cancelled.))) - (a/get state- -diff)))) + (a/getset state- -diff nil)))) (defn cleanup-ps [^Ps ps done] (when-not (identical? ps (a/fgetset ps -diff ps)) (a/fset ps -input-ps nil, -input-stepper nil, -input-doner nil, -diff nil, -item* nil) @@ -101,28 +101,29 @@ (or (seq (:permutation d)) (pos? (:grow d)) (pos? (:shrink d)) (seq (:freeze d)))) (defn transfer-input [^Ps ps] - (let [prev-diff (case (a/fget ps -stepped) true (a/fget ps -diff) #_else nil) - in-diff @(a/fget ps -input-ps)] - (a/fset ps -diff {:change {}}) - (grow! ps in-diff) - (permute! ps in-diff) - (shrink! ps in-diff) - (change! ps in-diff) - (let [diff (assoc in-diff :change (:change (a/fget ps -diff))) - diff (if prev-diff (d/combine prev-diff diff) diff)] - (a/fset ps -diff diff) - (case (a/fget ps -stepped) - ::never (do (a/fset ps -stepped true) ((.-step ps))) - true nil - false (when (needed-diff? diff) (a/fset ps -stepped true) ((.-step ps))))))) + (loop [diff (a/fgetset ps -diff {:change {}})] + (a/fset ps -go true) + (let [in-diff @(a/fget ps -input-ps)] + (grow! ps in-diff) + (permute! ps in-diff) + (shrink! ps in-diff) + (change! ps in-diff) + (let [newdiff (a/fset ps -diff (cond->> (assoc in-diff :change (:change (a/fget ps -diff))) + diff (d/combine diff)))] + (if (a/fgetset ps -go false) + (case (a/fget ps -stepped) + ::never (do (a/fset ps -stepped true) ((.-step ps))) + true nil + false (when (needed-diff? newdiff) (a/fset ps -stepped true) ((.-step ps)))) + (recur newdiff)))))) -(defn consume-input-step [^Ps ps] (fn [] (transfer-input ps))) +(defn consume-input-step [^Ps ps] (fn [] (when-not (a/fgetset ps -go false) (transfer-input ps)))) (defn consume-input-done [^Ps ps] (fn [])) (defn flow [input] (fn [step done] (let [ps (->Ps step done (object-array ps-field-count))] - (a/fset ps -input-stepper #() -input-doner #(), -item* (object-array 8), -stepped ::never) + (a/fset ps -input-stepper #() -input-doner #(), -item* (object-array 8), -stepped ::never, -go false) (a/fset ps -input-ps (input (fn [] ((a/fget ps -input-stepper))) (fn [] ((a/fget ps -input-doner))))) (a/fset ps -input-stepper (consume-input-step ps), -input-doner (consume-input-done ps)) (transfer-input ps) ps))) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index d62a4734a..6e69bbb5c 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -3,7 +3,8 @@ [clojure.test :as t] [contrib.assert :as ca] [hyperfiddle.incseq.diff-impl :as d] - [hyperfiddle.incseq.items-eager-impl :as items]) + [hyperfiddle.incseq.items-eager-impl :as items] + [missionary.core :as m]) (:import #?(:clj [clojure.lang ExceptionInfo IDeref IFn]) [missionary Cancelled])) @@ -343,6 +344,19 @@ _ (q ::none) _ (t/is (= ::none (q)))])) +(t/deftest reentrant-transfer + (let [q (->mq) + items ((items/flow (m/seed [{:grow 1, :degree 1, :shrink 0, :change {0 :foo}, :permutation {}, :freeze #{}} + {:grow 1, :degree 2, :shrink 0, :change {1 :bar}, :permutation {}, :freeze #{}}])) + #(q :items-step) #(q :items-done)) + _ (t/is (= :items-step (q))) + diff @items + _ (t/is (= {:grow 2, :degree 2, :shrink 0, :change {}, :permutation {}, :freeze #{}} + (assoc diff :change {}))) + _ (t/is (= 2 (count (:change diff)))) + _ (q ::none) + _ (t/is (= ::none (q)))])) + ;; missing tests ;; - items reentrant transfer ;; - input terminate From 044b8659385aab0538b52b6a129a0364a0b8de92 Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 10:21:02 +0200 Subject: [PATCH 14/46] refactor --- src/hyperfiddle/incseq/items_eager_impl.cljc | 12 ++++-------- test/hyperfiddle/incseq/items_eager_impl_test.cljc | 1 - 2 files changed, 4 insertions(+), 9 deletions(-) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index 920127c87..eea118630 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -6,7 +6,7 @@ (:import #?(:clj [clojure.lang IDeref IFn]) [missionary Cancelled])) -(def ps-field-count (a/deffields -stepped -cancelled -go -input-ps -input-stepper -input-doner -diff -item*)) +(def ps-field-count (a/deffields -stepped -cancelled -go -input-ps -diff -item*)) (declare cleanup-ps) (deftype Ps [step done state-] IFn (#?(:clj invoke :cljs -invoke) [^Ps this] @@ -20,7 +20,7 @@ (a/getset state- -diff nil)))) (defn cleanup-ps [^Ps ps done] (when-not (identical? ps (a/fgetset ps -diff ps)) - (a/fset ps -input-ps nil, -input-stepper nil, -input-doner nil, -diff nil, -item* nil) + (a/fset ps -input-ps nil, -diff nil, -item* nil) (done))) (def item-field-count (a/deffields -v -flow -ps* -dead)) @@ -117,13 +117,9 @@ false (when (needed-diff? newdiff) (a/fset ps -stepped true) ((.-step ps)))) (recur newdiff)))))) -(defn consume-input-step [^Ps ps] (fn [] (when-not (a/fgetset ps -go false) (transfer-input ps)))) -(defn consume-input-done [^Ps ps] (fn [])) - (defn flow [input] (fn [step done] (let [ps (->Ps step done (object-array ps-field-count))] - (a/fset ps -input-stepper #() -input-doner #(), -item* (object-array 8), -stepped ::never, -go false) - (a/fset ps -input-ps (input (fn [] ((a/fget ps -input-stepper))) (fn [] ((a/fget ps -input-doner))))) - (a/fset ps -input-stepper (consume-input-step ps), -input-doner (consume-input-done ps)) + (a/fset ps -item* (object-array 8), -stepped ::never, -go true) + (a/fset ps -input-ps (input #(when-not (a/fgetset ps -go false) (transfer-input ps)) #())) (transfer-input ps) ps))) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 6e69bbb5c..316992624 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -358,7 +358,6 @@ _ (t/is (= ::none (q)))])) ;; missing tests -;; - items reentrant transfer ;; - input terminate ;; - failures ;; - double cancel before termination From 5d5cba4fe49c6c800133152b901390e72c35b669 Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 10:40:12 +0200 Subject: [PATCH 15/46] refactor --- src/hyperfiddle/incseq/items_eager_impl.cljc | 14 ++++++----- .../incseq/items_eager_impl_test.cljc | 23 +++++++++++++++---- 2 files changed, 27 insertions(+), 10 deletions(-) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index eea118630..d1708617a 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -9,13 +9,13 @@ (def ps-field-count (a/deffields -stepped -cancelled -go -input-ps -diff -item*)) (declare cleanup-ps) (deftype Ps [step done state-] - IFn (#?(:clj invoke :cljs -invoke) [^Ps this] + IFn (#?(:clj invoke :cljs -invoke) [_] ((a/get state- -input-ps)) - (let [cancelled? (a/fgetset this -cancelled true)] - (when (not (or (a/fgetset this -stepped true) cancelled?)) (step)))) + (let [cancelled? (a/getset state- -cancelled true)] + (when (not (or (a/getset state- -stepped true) cancelled?)) (step)))) IDeref (#?(:clj deref :cljs -deref) [^Ps this] - (a/fset this -stepped false) - (if (a/fget this -cancelled) + (a/set state- -stepped false) + (if (a/get state- -cancelled) (do (cleanup-ps this done) (throw (Cancelled.))) (a/getset state- -diff nil)))) (defn cleanup-ps [^Ps ps done] @@ -121,5 +121,7 @@ (fn [step done] (let [ps (->Ps step done (object-array ps-field-count))] (a/fset ps -item* (object-array 8), -stepped ::never, -go true) - (a/fset ps -input-ps (input #(when-not (a/fgetset ps -go false) (transfer-input ps)) #())) + (a/fset ps -input-ps (input + #(when-not (a/fgetset ps -go false) (transfer-input ps)) + #())) (transfer-input ps) ps))) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 316992624..05c193e2b 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -351,15 +351,30 @@ #(q :items-step) #(q :items-done)) _ (t/is (= :items-step (q))) diff @items - _ (t/is (= {:grow 2, :degree 2, :shrink 0, :change {}, :permutation {}, :freeze #{}} - (assoc diff :change {}))) + _ (t/is (= (assoc (d/empty-diff 2) :grow 2) (assoc diff :change {}))) _ (t/is (= 2 (count (:change diff)))) _ (q ::none) _ (t/is (= ::none (q)))])) +(t/deftest input-terminate-during-transfer + (let [q (->mq) + items ((items/flow (m/seed [{:grow 1, :degree 1, :shrink 0, :change {0 :foo}, :permutation {}, :freeze #{}}])) + #(q :items-step) #(q :items-done)) + _ (t/is (= :items-step (q))) + diff @items + _ (t/is (= (assoc (d/empty-diff 1) :grow 1) (assoc diff :change {}))) + _ (t/is (= 1 (count (:change diff)))) + ;; _ (t/is (= :items-done (q))) + _ (q ::none) + _ (t/is (= ::none (q)))])) + ;; missing tests ;; - input terminate +;; - during transfer +;; - when idle +;; - when stepped ;; - failures +;; - item* grow ;; - double cancel before termination ;; - item-ps ;; - dead-item-ps @@ -368,9 +383,9 @@ ;; - item-ps ;; - dead-item-ps ;; - items -;; - double transfer +;; - double transfer (optional) ;; - item-ps ;; - dead-item-ps ;; - items -;; - item* grow ;; - thread safety +;; - freeze From 3d74fea474c867fd0e002ef48aa21d501c51d77a Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 10:43:55 +0200 Subject: [PATCH 16/46] [i/items] input terminates during transfer --- src/hyperfiddle/incseq/items_eager_impl.cljc | 5 +++-- test/hyperfiddle/incseq/items_eager_impl_test.cljc | 4 ++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index d1708617a..3bf7e1c53 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -6,7 +6,7 @@ (:import #?(:clj [clojure.lang IDeref IFn]) [missionary Cancelled])) -(def ps-field-count (a/deffields -stepped -cancelled -go -input-ps -diff -item*)) +(def ps-field-count (a/deffields -stepped -cancelled -go -input-ps -input-done -diff -item*)) (declare cleanup-ps) (deftype Ps [step done state-] IFn (#?(:clj invoke :cljs -invoke) [_] @@ -15,6 +15,7 @@ (when (not (or (a/getset state- -stepped true) cancelled?)) (step)))) IDeref (#?(:clj deref :cljs -deref) [^Ps this] (a/set state- -stepped false) + (when (a/get state- -input-done) (done)) (if (a/get state- -cancelled) (do (cleanup-ps this done) (throw (Cancelled.))) (a/getset state- -diff nil)))) @@ -123,5 +124,5 @@ (a/fset ps -item* (object-array 8), -stepped ::never, -go true) (a/fset ps -input-ps (input #(when-not (a/fgetset ps -go false) (transfer-input ps)) - #())) + #(a/fset ps -input-done true))) (transfer-input ps) ps))) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 05c193e2b..589809e61 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -353,6 +353,7 @@ diff @items _ (t/is (= (assoc (d/empty-diff 2) :grow 2) (assoc diff :change {}))) _ (t/is (= 2 (count (:change diff)))) + _ (t/is (= :items-done (q))) _ (q ::none) _ (t/is (= ::none (q)))])) @@ -364,13 +365,12 @@ diff @items _ (t/is (= (assoc (d/empty-diff 1) :grow 1) (assoc diff :change {}))) _ (t/is (= 1 (count (:change diff)))) - ;; _ (t/is (= :items-done (q))) + _ (t/is (= :items-done (q))) _ (q ::none) _ (t/is (= ::none (q)))])) ;; missing tests ;; - input terminate -;; - during transfer ;; - when idle ;; - when stepped ;; - failures From fd2e420f0ee80965a8444f6f775f68816e38c820 Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 10:47:28 +0200 Subject: [PATCH 17/46] [i/items] input terminates when idle --- src/hyperfiddle/incseq/items_eager_impl.cljc | 3 ++- .../hyperfiddle/incseq/items_eager_impl_test.cljc | 15 ++++++++++++++- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index 3bf7e1c53..52165b95f 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -124,5 +124,6 @@ (a/fset ps -item* (object-array 8), -stepped ::never, -go true) (a/fset ps -input-ps (input #(when-not (a/fgetset ps -go false) (transfer-input ps)) - #(a/fset ps -input-done true))) + #(do (a/fset ps -input-done true) + (when-not (a/fget ps -stepped) (done))))) (transfer-input ps) ps))) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 589809e61..977a08b6e 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -369,9 +369,22 @@ _ (q ::none) _ (t/is (= ::none (q)))])) +(t/deftest input-terminate-when-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 {}))) + _ (t/is (= 1 (count (:change diff)))) + _ (in-done) + _ (t/is (= :items-done (q))) + _ (q ::none) + _ (t/is (= ::none (q)))])) + ;; missing tests ;; - input terminate -;; - when idle ;; - when stepped ;; - failures ;; - item* grow From 97541a0583e18612ca32f626d76f4526bc990f42 Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 15:39:37 +0200 Subject: [PATCH 18/46] [i/items] input terminates when stepped --- .../electric/impl/array_fields.cljc | 2 ++ src/hyperfiddle/incseq/items_eager_impl.cljc | 34 ++++++++++--------- .../incseq/items_eager_impl_test.cljc | 22 ++++++++++-- 3 files changed, 40 insertions(+), 18 deletions(-) diff --git a/src/hyperfiddle/electric/impl/array_fields.cljc b/src/hyperfiddle/electric/impl/array_fields.cljc index 24a3170b0..182cd936c 100644 --- a/src/hyperfiddle/electric/impl/array_fields.cljc +++ b/src/hyperfiddle/electric/impl/array_fields.cljc @@ -26,6 +26,8 @@ (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)) +(defn cas [^objects a i oldv newv] (if (= oldv (get a i)) (do (set a i newv) true) false)) +(defn ncas [^objects a i oldv newv] (if (not= oldv (get a i)) (do (set a i newv) true) false)) (defn rot ([^objects a i j] (let [tmp (get a i)] (set a i (get a j) j tmp))) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index 52165b95f..8430c1598 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -6,23 +6,24 @@ (:import #?(:clj [clojure.lang IDeref IFn]) [missionary Cancelled])) -(def ps-field-count (a/deffields -stepped -cancelled -go -input-ps -input-done -diff -item*)) -(declare cleanup-ps) +(def ps-field-count (a/deffields -stepped -cancelled -go -input-ps -done -diff -item*)) + +(declare cleanup-then-done) +(defn call [f] (f)) (deftype Ps [step done state-] IFn (#?(:clj invoke :cljs -invoke) [_] - ((a/get state- -input-ps)) + (some-> (a/get state- -input-ps) call) + (a/ncas state- -done ::yes ::requested) (let [cancelled? (a/getset state- -cancelled true)] (when (not (or (a/getset state- -stepped true) cancelled?)) (step)))) - IDeref (#?(:clj deref :cljs -deref) [^Ps this] + IDeref (#?(:clj deref :cljs -deref) [this] (a/set state- -stepped false) - (when (a/get state- -input-done) (done)) - (if (a/get state- -cancelled) - (do (cleanup-ps this done) (throw (Cancelled.))) - (a/getset state- -diff nil)))) -(defn cleanup-ps [^Ps ps done] - (when-not (identical? ps (a/fgetset ps -diff ps)) - (a/fset ps -input-ps nil, -diff nil, -item* nil) - (done))) + (when (identical? ::requested (a/get state- -done)) (cleanup-then-done this)) + (let [diff (a/getset state- -diff nil)] + (if (a/get state- -cancelled) (throw (Cancelled.)) diff)))) +(defn cleanup-then-done [^Ps ps] + (a/fset ps -input-ps nil, -done ::yes, -item* nil) + ((.-done ps))) (def item-field-count (a/deffields -v -flow -ps* -dead)) (deftype Item [state-]) @@ -113,7 +114,7 @@ diff (d/combine diff)))] (if (a/fgetset ps -go false) (case (a/fget ps -stepped) - ::never (do (a/fset ps -stepped true) ((.-step ps))) + nil (do (a/fset ps -stepped true) ((.-step ps))) true nil false (when (needed-diff? newdiff) (a/fset ps -stepped true) ((.-step ps)))) (recur newdiff)))))) @@ -121,9 +122,10 @@ (defn flow [input] (fn [step done] (let [ps (->Ps step done (object-array ps-field-count))] - (a/fset ps -item* (object-array 8), -stepped ::never, -go true) + (a/fset ps -item* (object-array 8), -stepped nil, -go true, -done ::no) (a/fset ps -input-ps (input #(when-not (a/fgetset ps -go false) (transfer-input ps)) - #(do (a/fset ps -input-done true) - (when-not (a/fget ps -stepped) (done))))) + #(if (or (a/fget ps -stepped) (a/fget ps -go)) + (a/fset ps -done ::requested) + (cleanup-then-done ps)))) (transfer-input ps) ps))) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 977a08b6e..ce1baeccf 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -383,9 +383,27 @@ _ (q ::none) _ (t/is (= ::none (q)))])) +(t/deftest input-terminate-when-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 {}))) + _ (t/is (= 1 (count (:change diff)))) + _ (q (assoc (d/empty-diff 1) :grow 1 :change {0 :bar})) + _ (in-step) + _ (t/is (= :items-step (q))) + _ (in-done) + _ (q ::none) + _ (t/is (= ::none (q))) + _diff @items + _ (t/is (= :items-done (q))) + _ (q ::none) + _ (t/is (= ::none (q)))])) + ;; missing tests -;; - input terminate -;; - when stepped ;; - failures ;; - item* grow ;; - double cancel before termination From 3dba767338fcb663f6dc242a4d0e5ec173ae532f Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 15:45:15 +0200 Subject: [PATCH 19/46] refactor --- src/hyperfiddle/incseq/items_eager_impl.cljc | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index 8430c1598..d69f92f26 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -53,15 +53,15 @@ (do (cleanup-item-ps this a done) (throw (Cancelled.))) (a/get a -cache)))))) -(let [nul #?(:clj (Object.) :cljs (js/Object.))] +(let [cancelled #?(:clj (Object.) :cljs (js/Object.))] (defn ->dead-item-ps [step done -v] (step) (let [ (->box -v)] (reify - IFn (#?(:clj invoke :cljs -invoke) [_] ( nul)) + IFn (#?(:clj invoke :cljs -invoke) [_] ( cancelled)) IDeref (#?(:clj deref :cljs -deref) [this] (done) - (if (identical? nul ()) (throw (Cancelled.)) (let [v ()] ( this) v))))))) + (if (identical? cancelled ()) (throw (Cancelled.)) (let [v ()] ( this) v))))))) (defn grow! [^Ps ps {d :degree, n :grow}] (run! (fn [i] From 05ae234c01884e88a965550b2d1810824fa8261e Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 16:15:17 +0200 Subject: [PATCH 20/46] refactor --- src/hyperfiddle/incseq/items_eager_impl.cljc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index d69f92f26..fb67fd309 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -114,9 +114,9 @@ diff (d/combine diff)))] (if (a/fgetset ps -go false) (case (a/fget ps -stepped) - nil (do (a/fset ps -stepped true) ((.-step ps))) + false (when (needed-diff? newdiff) (a/fset ps -stepped true) ((.-step ps))) true nil - false (when (needed-diff? newdiff) (a/fset ps -stepped true) ((.-step ps)))) + nil (do (a/fset ps -stepped true) ((.-step ps)))) (recur newdiff)))))) (defn flow [input] From 16944a9a163076d12104e95f1af450c4c8d2b65b Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 17:13:00 +0200 Subject: [PATCH 21/46] [i/items] failure on first transfer --- .../electric/impl/array_fields.cljc | 2 + src/hyperfiddle/incseq/items_eager_impl.cljc | 37 ++++++++++-------- .../incseq/items_eager_impl_test.cljc | 38 ++++++++++++------- 3 files changed, 49 insertions(+), 28 deletions(-) diff --git a/src/hyperfiddle/electric/impl/array_fields.cljc b/src/hyperfiddle/electric/impl/array_fields.cljc index 182cd936c..1842c789b 100644 --- a/src/hyperfiddle/electric/impl/array_fields.cljc +++ b/src/hyperfiddle/electric/impl/array_fields.cljc @@ -27,7 +27,9 @@ (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)) (defn cas [^objects a i oldv newv] (if (= oldv (get a i)) (do (set a i newv) true) false)) +(defmacro fcas [O i oldv newv] `(cas (.-state- ~O) ~i ~oldv ~newv)) (defn ncas [^objects a i oldv newv] (if (not= oldv (get a i)) (do (set a i newv) true) false)) +(defmacro fncas [O i oldv newv] `(ncas (.-state- ~O) ~i ~oldv ~newv)) (defn rot ([^objects a i j] (let [tmp (get a i)] (set a i (get a j) j tmp))) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index fb67fd309..68a4c1f8d 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -19,8 +19,10 @@ IDeref (#?(:clj deref :cljs -deref) [this] (a/set state- -stepped false) (when (identical? ::requested (a/get state- -done)) (cleanup-then-done this)) - (let [diff (a/getset state- -diff nil)] - (if (a/get state- -cancelled) (throw (Cancelled.)) diff)))) + (let [?diff (a/getset state- -diff nil)] + (cond (a/get state- -cancelled) (throw (Cancelled.)) + (map? ?diff) ?diff + :else (throw ?diff))))) (defn cleanup-then-done [^Ps ps] (a/fset ps -input-ps nil, -done ::yes, -item* nil) ((.-done ps))) @@ -105,19 +107,24 @@ (defn transfer-input [^Ps ps] (loop [diff (a/fgetset ps -diff {:change {}})] (a/fset ps -go true) - (let [in-diff @(a/fget ps -input-ps)] - (grow! ps in-diff) - (permute! ps in-diff) - (shrink! ps in-diff) - (change! ps in-diff) - (let [newdiff (a/fset ps -diff (cond->> (assoc in-diff :change (:change (a/fget ps -diff))) - diff (d/combine diff)))] - (if (a/fgetset ps -go false) - (case (a/fget ps -stepped) - false (when (needed-diff? newdiff) (a/fset ps -stepped true) ((.-step ps))) - true nil - nil (do (a/fset ps -stepped true) ((.-step ps)))) - (recur newdiff)))))) + (let [?in-diff (try @(a/fget ps -input-ps) (catch #?(:clj Throwable :cljs :default) e e))] + (if (map? ?in-diff) + (do (grow! ps ?in-diff) + (permute! ps ?in-diff) + (shrink! ps ?in-diff) + (change! ps ?in-diff) + (let [newdiff (a/fset ps -diff (cond->> (assoc ?in-diff :change (:change (a/fget ps -diff))) + diff (d/combine diff)))] + (if (a/fgetset ps -go false) + (case (a/fget ps -stepped) + false (when (needed-diff? newdiff) (a/fset ps -stepped true) ((.-step ps))) + true nil + nil (do (a/fset ps -stepped true) ((.-step ps)))) + (recur newdiff)))) + (do (some-> (a/fget ps -input-ps) call) + (a/fncas ps -done ::yes ::requested) + (a/fset ps -diff ?in-diff) + (when-not (a/fgetset ps -stepped true) ((.-step ps)))))))) (defn flow [input] (fn [step done] diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index ce1baeccf..4261afec8 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -2,6 +2,7 @@ (:require [clojure.test :as t] [contrib.assert :as ca] + [contrib.data :refer [->box]] [hyperfiddle.incseq.diff-impl :as d] [hyperfiddle.incseq.items-eager-impl :as items] [missionary.core :as m]) @@ -12,11 +13,6 @@ ([] #?(:clj clojure.lang.PersistentQueue/EMPTY :cljs #queue [])) ([& args] (into (->queue) args))) -(defn ->box - ([] (->box nil)) - ([init] (let [o (doto (object-array 1) (aset (int 0) init))] - (fn ([] (aget o (int 0))) ([v] (aset o (int 0) v)))))) - (defn ->mq [] (let [box (->box (->queue))] (fn @@ -29,14 +25,16 @@ (q 2) (q 3) (t/is (= 2 (q))) (t/is (= 3 (q))) (t/is (thrown? ExceptionInfo (q))))) -(defn spawn-ps [q] - ((items/flow (fn [step done] - (q [step done]) - (step) - (reify - IFn (#?(:clj invoke :cljs -invoke) [_] (q :input-cancel)) - IDeref (#?(:clj deref :cljs -deref) [_] (q))))) - #(q :items-step) #(q :items-done))) +(defn spawn-ps + ([q] (spawn-ps q (->box (fn [_step _done] (q))))) + ([q ] + ((items/flow (fn [step done] + (q [step done]) + (step) + (reify + IFn (#?(:clj invoke :cljs -invoke) [_] (q :input-cancel)) + IDeref (#?(:clj deref :cljs -deref) [_] (() step done))))) + #(q :items-step) #(q :items-done)))) (t/deftest spawn (let [q (->mq) @@ -403,8 +401,22 @@ _ (q ::none) _ (t/is (= ::none (q)))])) +(t/deftest failure-on-first-transfer + (let [q (->mq) + items (spawn-ps q (->box (fn [_step done] (done) (throw (ex-info "boom" {}))))) + [_in-step _in-done] (q) + _ (t/is (= :input-cancel (q))) + _ (t/is (= :items-step (q))) + _ (t/is (thrown? ExceptionInfo (doto @items prn))) + _ (t/is (= :items-done (q))) + _ (q ::none) + _ (t/is (= ::none (q)))])) + ;; missing tests ;; - failures +;; - second immediate transfer +;; - reentrant transfer +;; - after cancellation ;; - item* grow ;; - double cancel before termination ;; - item-ps From bc23d14edfa9205d654468b8407573a47c8eaa38 Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 17:16:54 +0200 Subject: [PATCH 22/46] [i/items] failure on non-first transfer --- .../incseq/items_eager_impl_test.cljc | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 4261afec8..c5efacb76 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -407,14 +407,29 @@ [_in-step _in-done] (q) _ (t/is (= :input-cancel (q))) _ (t/is (= :items-step (q))) - _ (t/is (thrown? ExceptionInfo (doto @items prn))) + _ (t/is (thrown? ExceptionInfo @items)) _ (t/is (= :items-done (q))) _ (q ::none) _ (t/is (= ::none (q)))])) +(t/deftest failure-on-non-first-transfer + (let [q (->mq) + (->box (fn [_step _done] (d/empty-diff 0))) + items (spawn-ps q ) + [in-step _in-done] (q) + _ (t/is (= :items-step (q))) + _ (t/is (= (d/empty-diff 0) @items)) + _ ( (fn [_step done] (done) (throw (ex-info "boom" {})))) + _ (in-step) + _ (t/is (= :input-cancel (q))) + _ (t/is (= :items-step (q))) + _ (t/is (thrown? ExceptionInfo @items)) + _ (t/is (= :items-done (q))) + _ (q ::none) + _ (t/is (= ::none (q)))])) + ;; missing tests ;; - failures -;; - second immediate transfer ;; - reentrant transfer ;; - after cancellation ;; - item* grow From f9b21bd584e3721e40cce49893be44cc64fd08d8 Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 17:23:20 +0200 Subject: [PATCH 23/46] [i/items] failure on reentrant transfer --- .../incseq/items_eager_impl_test.cljc | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index c5efacb76..672621e56 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -428,9 +428,24 @@ _ (q ::none) _ (t/is (= ::none (q)))])) +(t/deftest failure-on-reentrant-transfer + (let [q (->mq) + (->box (let [ (->box true)] + (fn [step done] + (if () + (do ( false) (step) (d/empty-diff 0)) + (do (done) (throw (ex-info "boom" {}))))))) + items (spawn-ps q ) + [_in-step _in-done] (q) + _ (t/is (= :input-cancel (q))) + _ (t/is (= :items-step (q))) + _ (t/is (thrown? ExceptionInfo @items)) + _ (t/is (= :items-done (q))) + _ (q ::none) + _ (t/is (= ::none (q)))])) + ;; missing tests ;; - failures -;; - reentrant transfer ;; - after cancellation ;; - item* grow ;; - double cancel before termination From be1f8ce6da7f01a19c46c35f19b5bfae484e50cc Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 17:29:59 +0200 Subject: [PATCH 24/46] refactor --- src/hyperfiddle/electric/impl/array_fields.cljc | 8 ++++---- src/hyperfiddle/incseq/items_eager_impl.cljc | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/hyperfiddle/electric/impl/array_fields.cljc b/src/hyperfiddle/electric/impl/array_fields.cljc index 1842c789b..1726d4be7 100644 --- a/src/hyperfiddle/electric/impl/array_fields.cljc +++ b/src/hyperfiddle/electric/impl/array_fields.cljc @@ -26,10 +26,10 @@ (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)) -(defn cas [^objects a i oldv newv] (if (= oldv (get a i)) (do (set a i newv) true) false)) -(defmacro fcas [O i oldv newv] `(cas (.-state- ~O) ~i ~oldv ~newv)) -(defn ncas [^objects a i oldv newv] (if (not= oldv (get a i)) (do (set a i newv) true) false)) -(defmacro fncas [O i oldv newv] `(ncas (.-state- ~O) ~i ~oldv ~newv)) +(defn set= [^objects a i oldv newv] (if (= oldv (get a i)) (do (set a i newv) true) false)) +(defmacro fset= [O i oldv newv] `(set= (.-state- ~O) ~i ~oldv ~newv)) +(defn set-not= [^objects a i oldv newv] (if (not= oldv (get a i)) (do (set a i newv) true) false)) +(defmacro fset-not= [O i oldv newv] `(set-not= (.-state- ~O) ~i ~oldv ~newv)) (defn rot ([^objects a i j] (let [tmp (get a i)] (set a i (get a j) j tmp))) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index 68a4c1f8d..761a62ac2 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -13,7 +13,7 @@ (deftype Ps [step done state-] IFn (#?(:clj invoke :cljs -invoke) [_] (some-> (a/get state- -input-ps) call) - (a/ncas state- -done ::yes ::requested) + (a/set-not= state- -done ::yes ::requested) (let [cancelled? (a/getset state- -cancelled true)] (when (not (or (a/getset state- -stepped true) cancelled?)) (step)))) IDeref (#?(:clj deref :cljs -deref) [this] @@ -122,7 +122,7 @@ nil (do (a/fset ps -stepped true) ((.-step ps)))) (recur newdiff)))) (do (some-> (a/fget ps -input-ps) call) - (a/fncas ps -done ::yes ::requested) + (a/fset-not= ps -done ::yes ::requested) (a/fset ps -diff ?in-diff) (when-not (a/fgetset ps -stepped true) ((.-step ps)))))))) From f2f5affe26e3257713bab421ee17ea3ef0132a4d Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 21:37:23 +0200 Subject: [PATCH 25/46] refactor --- src/contrib/data.cljc | 5 ++++- test/hyperfiddle/incseq/items_eager_impl_test.cljc | 12 +++++++----- 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/src/contrib/data.cljc b/src/contrib/data.cljc index 4af032e15..2528a6a9c 100644 --- a/src/contrib/data.cljc +++ b/src/contrib/data.cljc @@ -357,4 +357,7 @@ (defn ->box ([] (->box nil)) ([init] (let [o (doto (object-array 1) (aset (int 0) init))] - (fn ([] (aget o (int 0))) ([v] (aset o (int 0) v)))))) + (fn box + ([] (aget o (int 0))) + ([v] (aset o (int 0) v)) + ([retf swapf] (let [v (box), ret (retf v)] (box (swapf v)) ret)))))) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 672621e56..a47c33761 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -428,13 +428,15 @@ _ (q ::none) _ (t/is (= ::none (q)))])) +(defn consume-calling [f*] + (let [ (->box (seq f*))] + (fn [step done] + ((ca/is ( first next) some? "overconsumed") step done)))) + (t/deftest failure-on-reentrant-transfer (let [q (->mq) - (->box (let [ (->box true)] - (fn [step done] - (if () - (do ( false) (step) (d/empty-diff 0)) - (do (done) (throw (ex-info "boom" {}))))))) + (->box (consume-calling [(fn [step _] (step) (d/empty-diff 0)) + (fn [_ done] (done) (throw (ex-info "boom" {})))])) items (spawn-ps q ) [_in-step _in-done] (q) _ (t/is (= :input-cancel (q))) From c1295d92412ad9375c237ab652bc16a0533e09d5 Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 21:45:41 +0200 Subject: [PATCH 26/46] [i/items] failure after cancellation --- .../incseq/items_eager_impl_test.cljc | 23 +++++++++++++++---- 1 file changed, 19 insertions(+), 4 deletions(-) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index a47c33761..dec51f7b1 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -27,12 +27,13 @@ (defn spawn-ps ([q] (spawn-ps q (->box (fn [_step _done] (q))))) - ([q ] + ([q ] (spawn-ps q (->box (fn [_step _done] (q :input-cancel))))) + ([q ] ((items/flow (fn [step done] (q [step done]) (step) (reify - IFn (#?(:clj invoke :cljs -invoke) [_] (q :input-cancel)) + IFn (#?(:clj invoke :cljs -invoke) [_] (() step done)) IDeref (#?(:clj deref :cljs -deref) [_] (() step done))))) #(q :items-step) #(q :items-done)))) @@ -446,9 +447,23 @@ _ (q ::none) _ (t/is (= ::none (q)))])) +(t/deftest failure-after-cancellation + (let [q (->mq) + (->box (consume-calling [(fn [_ _] (d/empty-diff 0)) + (fn [_ done] (done) (throw (ex-info "boom" {})))])) + (->box (fn [step _done] (step))) + items (spawn-ps q ) + [_in-step _in-done] (q) + _ (t/is (= :items-step (q))) + _ (t/is (= (d/empty-diff 0) @items)) + _ (items) + _ (t/is (= :items-step (q))) + _ (t/is (thrown? Cancelled @items)) ; is this OK or should the ExInfo come out + _ (t/is (= :items-done (q))) + _ (q ::none) + _ (t/is (= ::none (q)))])) + ;; missing tests -;; - failures -;; - after cancellation ;; - item* grow ;; - double cancel before termination ;; - item-ps From d29df382e298a238641fd01d8951040aa3079d49 Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 22:11:10 +0200 Subject: [PATCH 27/46] [i/items] grow item array --- src/hyperfiddle/electric/impl/array_fields.cljc | 3 +++ src/hyperfiddle/incseq/items_eager_impl.cljc | 4 +++- test/hyperfiddle/incseq/items_eager_impl_test.cljc | 13 ++++++++++++- 3 files changed, 18 insertions(+), 2 deletions(-) diff --git a/src/hyperfiddle/electric/impl/array_fields.cljc b/src/hyperfiddle/electric/impl/array_fields.cljc index 1726d4be7..14cea1262 100644 --- a/src/hyperfiddle/electric/impl/array_fields.cljc +++ b/src/hyperfiddle/electric/impl/array_fields.cljc @@ -31,6 +31,9 @@ (defn set-not= [^objects a i oldv newv] (if (not= oldv (get a i)) (do (set a i newv) true) false)) (defmacro fset-not= [O i oldv newv] `(set-not= (.-state- ~O) ~i ~oldv ~newv)) +(defn copy [x y n] #?(:clj (System/arraycopy x 0 y 0 n) :cljs (dotimes [i n] (aset y i (aget x i)))) y) +(defn ensure-fits [^objects a n] (let [l (alength a)] (cond-> a (< l n) (copy (object-array (* 2 l)) l)))) + (defn rot ([^objects a i j] (let [tmp (get a i)] (set a i (get a j) j tmp))) ([^objects a i j k] (let [tmp (get a i)] (set a i (get a j) j (get a k) k tmp))) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index 761a62ac2..18b36fa50 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -66,6 +66,7 @@ (if (identical? cancelled ()) (throw (Cancelled.)) (let [v ()] ( this) v))))))) (defn grow! [^Ps ps {d :degree, n :grow}] + (a/fgetset ps -item* (a/ensure-fits (a/fget ps -item*) d)) (run! (fn [i] (let [^Item item (->Item (object-array item-field-count))] (a/fset item -ps* (->box #{})) @@ -126,10 +127,11 @@ (a/fset ps -diff ?in-diff) (when-not (a/fgetset ps -stepped true) ((.-step ps)))))))) +(def ^:const +initial-item-size+ 8) (defn flow [input] (fn [step done] (let [ps (->Ps step done (object-array ps-field-count))] - (a/fset ps -item* (object-array 8), -stepped nil, -go true, -done ::no) + (a/fset ps -item* (object-array +initial-item-size+), -stepped nil, -go true, -done ::no) (a/fset ps -input-ps (input #(when-not (a/fgetset ps -go false) (transfer-input ps)) #(if (or (a/fget ps -stepped) (a/fget ps -go)) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index dec51f7b1..0619ee742 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -463,8 +463,19 @@ _ (q ::none) _ (t/is (= ::none (q)))])) +(t/deftest grow + (let [q (->mq) + n (inc items/+initial-item-size+) + _ (q (assoc (d/empty-diff n) :grow n :change (zipmap (range n) (repeat :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 (= 9 (count (:change diff)))) + _ (q ::none) + _ (t/is (= ::none (q)))])) + ;; missing tests -;; - item* grow ;; - double cancel before termination ;; - item-ps ;; - dead-item-ps From 96b3e0eea1ac3090103e1e00a942c3187ec28f47 Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 10:06:09 +0200 Subject: [PATCH 28/46] [i/items] fix cljs Apparently keywords in cljs are not guaranteed to be identical --- src/hyperfiddle/incseq/items_eager_impl.cljc | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index 18b36fa50..67a74c562 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -1,5 +1,6 @@ (ns hyperfiddle.incseq.items-eager-impl (:require [contrib.data :refer [->box]] + [contrib.debug :as dbg] [hyperfiddle.electric.impl.array-fields :as a] [hyperfiddle.incseq.diff-impl :as d] [hyperfiddle.incseq.perm-impl :as p]) @@ -18,7 +19,7 @@ (when (not (or (a/getset state- -stepped true) cancelled?)) (step)))) IDeref (#?(:clj deref :cljs -deref) [this] (a/set state- -stepped false) - (when (identical? ::requested (a/get state- -done)) (cleanup-then-done this)) + (when (= ::requested (a/get state- -done)) (cleanup-then-done this)) (let [?diff (a/getset state- -diff nil)] (cond (a/get state- -cancelled) (throw (Cancelled.)) (map? ?diff) ?diff @@ -34,7 +35,7 @@ (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 cleanup-item-ps [ps a done] (when-not (= ps (a/getset a -cache ps)) (done))) (defn ->item-ps [^Item item step done] (let [a (object-array item-ps-field-count)] @@ -127,7 +128,7 @@ (a/fset ps -diff ?in-diff) (when-not (a/fgetset ps -stepped true) ((.-step ps)))))))) -(def ^:const +initial-item-size+ 8) +(def +initial-item-size+ 8) (defn flow [input] (fn [step done] (let [ps (->Ps step done (object-array ps-field-count))] From 82590b866c41c70d2379fd0a5277ff4930bc27af Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 10:29:13 +0200 Subject: [PATCH 29/46] [i/items] double cancellation --- .../incseq/items_eager_impl_test.cljc | 33 +++++++++++++++++-- 1 file changed, 31 insertions(+), 2 deletions(-) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 0619ee742..c1d3d86a7 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -475,15 +475,44 @@ _ (q ::none) _ (t/is (= ::none (q)))])) +(t/deftest double-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))) + _ (items) + _ (t/is (= :input-cancel (q))) + _ (items) + _ (t/is (= :input-cancel (q))) + _ (t/is (thrown? Cancelled @items)) + _ (t/is (= :items-done (q))) + _ (q ::none) + _ (t/is (= ::none (q)))])) + +(t/deftest double-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 + _ (items) + _ (t/is (= :input-cancel (q))) + _ (t/is (= :items-step (q))) + _ (items) + _ (t/is (= :input-cancel (q))) + _ (t/is (thrown? Cancelled @items)) + _ (t/is (= :items-done (q))) + _ (q ::none) + _ (t/is (= ::none (q)))])) ;; missing tests ;; - double cancel before termination ;; - item-ps ;; - dead-item-ps -;; - items ;; - double cancel after termination ;; - item-ps ;; - dead-item-ps -;; - items ;; - double transfer (optional) ;; - item-ps ;; - dead-item-ps From 26ce0f68127105aede6875975f4fbf49d7ac5fd5 Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 10:33:44 +0200 Subject: [PATCH 30/46] [i/items] item-ps double cancellation --- .../incseq/items_eager_impl_test.cljc | 39 ++++++++++++++++++- 1 file changed, 37 insertions(+), 2 deletions(-) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index c1d3d86a7..649175d7b 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -506,12 +506,47 @@ _ (t/is (= :items-done (q))) _ (q ::none) _ (t/is (= ::none (q)))])) + +(t/deftest item-ps-double-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))) + _ (item0) + _ (t/is (thrown? Cancelled @item0)) + _ (t/is (= :item0-done (q))) + _ (q ::none) + _ (t/is (= ::none (q)))])) + +(t/deftest item-ps-double-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) + _ (item0) + _ (t/is (thrown? Cancelled @item0)) + _ (t/is (= :item0-done (q))) + _ (q ::none) + _ (t/is (= ::none (q)))])) + ;; missing tests ;; - double cancel before termination -;; - item-ps ;; - dead-item-ps ;; - double cancel after termination -;; - item-ps ;; - dead-item-ps ;; - double transfer (optional) ;; - item-ps From 3abf66a1747f6b70dfe5f1914c27239ebc53cf3c Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 10:35:15 +0200 Subject: [PATCH 31/46] [i/items] items & item-ps cancel after done --- .../incseq/items_eager_impl_test.cljc | 35 +++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 649175d7b..e16e9a02b 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -507,6 +507,22 @@ _ (q ::none) _ (t/is (= ::none (q)))])) +(t/deftest cancel-after-done + (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 + _ (items) + _ (t/is (= :input-cancel (q))) + _ (t/is (= :items-step (q))) + _ (t/is (thrown? Cancelled @items)) + _ (t/is (= :items-done (q))) + _ (items) + _ (q ::none) + _ (t/is (= ::none (q)))])) + (t/deftest item-ps-double-cancellation-idle (let [q (->mq) _ (q (assoc (d/empty-diff 1) :grow 1 :change {0 :foo})) ; what input will return on transfer @@ -543,6 +559,25 @@ _ (q ::none) _ (t/is (= ::none (q)))])) +(t/deftest item-ps-cancel-after-done + (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))) + _ (item0) + _ (q ::none) + _ (t/is (= ::none (q)))])) + ;; missing tests ;; - double cancel before termination ;; - dead-item-ps From 0e725df9d4b02ec8e149b37a2e484a0c9deb7e84 Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 10:39:59 +0200 Subject: [PATCH 32/46] [i/items] dead-item-ps cancel after done --- .../incseq/items_eager_impl_test.cljc | 52 ++++++++++++++++--- 1 file changed, 46 insertions(+), 6 deletions(-) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index e16e9a02b..59b89ae72 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -223,7 +223,7 @@ _ (q ::none) _ (t/is (= ::none (q)))])) -(t/deftest item-spawned-after-shrink-returns-last-value-and-terminates +(t/deftest dead-item-ps-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) @@ -244,7 +244,7 @@ _ (q ::none) _ (t/is (= ::none (q)))])) -(t/deftest item-spawned-after-shrink-and-cancelled-throws-and-terminates +(t/deftest dead-item-ps-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) @@ -578,11 +578,51 @@ _ (q ::none) _ (t/is (= ::none (q)))])) +(t/deftest dead-item-ps-cancel-after-done + (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))) + _ (item0) + _ (q ::none) + _ (t/is (= ::none (q)))])) + +(t/deftest dead-item-ps-cancel-after-throw + (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))) + _ (item0) + _ (q ::none) + _ (t/is (= ::none (q)))])) ;; missing tests -;; - double cancel before termination -;; - dead-item-ps -;; - double cancel after termination -;; - dead-item-ps ;; - double transfer (optional) ;; - item-ps ;; - dead-item-ps From 3e2849abc0d214abdb55e3c64b3f4c2bf51964b5 Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 11:43:30 +0200 Subject: [PATCH 33/46] [i/items] fix: change idx respects permutations --- src/hyperfiddle/incseq/items_eager_impl.cljc | 32 ++++++++++--------- .../incseq/items_eager_impl_test.cljc | 17 ++++++++++ 2 files changed, 34 insertions(+), 15 deletions(-) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index 67a74c562..77bc3817a 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -1,6 +1,7 @@ (ns hyperfiddle.incseq.items-eager-impl (:require [contrib.data :refer [->box]] [contrib.debug :as dbg] + [clojure.set :as set] [hyperfiddle.electric.impl.array-fields :as a] [hyperfiddle.incseq.diff-impl :as d] [hyperfiddle.incseq.perm-impl :as p]) @@ -66,21 +67,22 @@ (done) (if (identical? cancelled ()) (throw (Cancelled.)) (let [v ()] ( this) v))))))) -(defn grow! [^Ps ps {d :degree, n :grow}] - (a/fgetset ps -item* (a/ensure-fits (a/fget ps -item*) d)) - (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] - (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 grow! [^Ps ps {d :degree, n :grow, p :permutation}] + (let [idx (set/map-invert p)] + (a/fgetset ps -item* (a/ensure-fits (a/fget ps -item*) d)) + (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 (idx i i) + (a/fset item -flow (fn [step done] + (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) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 59b89ae72..962f8cab2 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -622,6 +622,23 @@ _ (item0) _ (q ::none) _ (t/is (= ::none (q)))])) + +(t/deftest change-index-respects-permutation + (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 {}))) + _ (q {:grow 1, :degree 2, :shrink 1, :permutation {0 1, 1 0}, :change {0 :bar}}) + _ (in-step) + _ (t/is (= :items-step (q))) + diff @items + _ (t/is (= 0 (-> diff :change keys first))) + _ (q ::none) + _ (t/is (= ::none (q)))])) + ;; missing tests ;; - double transfer (optional) ;; - item-ps From f73d10ef7c9eb374c0c5cc80d1d2053b4ead42d3 Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 13:06:58 +0200 Subject: [PATCH 34/46] [i/items] fix buffer growth when 2*l < n --- src/hyperfiddle/electric/impl/array_fields.cljc | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/hyperfiddle/electric/impl/array_fields.cljc b/src/hyperfiddle/electric/impl/array_fields.cljc index 14cea1262..88c8e6d38 100644 --- a/src/hyperfiddle/electric/impl/array_fields.cljc +++ b/src/hyperfiddle/electric/impl/array_fields.cljc @@ -32,7 +32,8 @@ (defmacro fset-not= [O i oldv newv] `(set-not= (.-state- ~O) ~i ~oldv ~newv)) (defn copy [x y n] #?(:clj (System/arraycopy x 0 y 0 n) :cljs (dotimes [i n] (aset y i (aget x i)))) y) -(defn ensure-fits [^objects a n] (let [l (alength a)] (cond-> a (< l n) (copy (object-array (* 2 l)) l)))) +(defn overfit [k n] (loop [k (* 2 k)] (if (>= k n) k (recur (* 2 k))))) +(defn ensure-fits [^objects a n] (let [l (alength a)] (cond-> a (< l n) (copy (object-array (overfit l n)) l)))) (defn rot ([^objects a i j] (let [tmp (get a i)] (set a i (get a j) j tmp))) @@ -77,3 +78,7 @@ (let [a (object-array [:a :b :c :d :e :f :g])] (apply rot a (range 7)) (vec a) := [:b :c :d :e :f :g :a])) + +(tests + (alength (ensure-fits (object-array 2) 9)) := 16 + ) From 6a599aaadf610e8c04549a16dcf6e09f37d8259d Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 13:07:37 +0200 Subject: [PATCH 35/46] move to eager i/items --- src/hyperfiddle/incseq.cljc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/hyperfiddle/incseq.cljc b/src/hyperfiddle/incseq.cljc index 1a53602db..9a75c487d 100644 --- a/src/hyperfiddle/incseq.cljc +++ b/src/hyperfiddle/incseq.cljc @@ -40,7 +40,7 @@ successive sequence diffs. Incremental sequences are applicative functors with ` (:require [hyperfiddle.incseq.fixed-impl :as f] [hyperfiddle.incseq.perm-impl :as p] [hyperfiddle.incseq.diff-impl :as d] - [hyperfiddle.incseq.items-impl :as i] + [hyperfiddle.incseq.items-eager-impl :as i] [hyperfiddle.incseq.latest-product-impl :as lp] [hyperfiddle.incseq.latest-concat-impl :as lc] [hyperfiddle.rcf :refer [tests]] From 5c04d12bd178f69041f3241e8d0b20aafb708a19 Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 14:21:02 +0200 Subject: [PATCH 36/46] [i/items] fix cljs warnings --- src/hyperfiddle/incseq/items_eager_impl.cljc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index 77bc3817a..7cc5c78b6 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -32,7 +32,7 @@ (def item-field-count (a/deffields -v -flow -ps* -dead)) (deftype Item [state-]) -(def item-ps-field-count (a/deffields -stepped -cancelled -cache)) +(def item-ps-field-count (a/deffields _stepped _cancelled -cache)) ; -stepped would warn of redefinition (defn remove-item-ps [^Item item ps] (let [ps* (a/fget item -ps*)] (ps* (disj (ps*) ps)))) From 33341851e3d6e370543523c6f1a498bf705f020c Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 14:26:34 +0200 Subject: [PATCH 37/46] fix reflection warning --- src/hyperfiddle/electric/impl/array_fields.cljc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/hyperfiddle/electric/impl/array_fields.cljc b/src/hyperfiddle/electric/impl/array_fields.cljc index 88c8e6d38..693cddf1a 100644 --- a/src/hyperfiddle/electric/impl/array_fields.cljc +++ b/src/hyperfiddle/electric/impl/array_fields.cljc @@ -33,7 +33,7 @@ (defn copy [x y n] #?(:clj (System/arraycopy x 0 y 0 n) :cljs (dotimes [i n] (aset y i (aget x i)))) y) (defn overfit [k n] (loop [k (* 2 k)] (if (>= k n) k (recur (* 2 k))))) -(defn ensure-fits [^objects a n] (let [l (alength a)] (cond-> a (< l n) (copy (object-array (overfit l n)) l)))) +(defn ensure-fits ^objects [^objects a n] (let [l (alength a)] (cond-> a (< l n) (copy (object-array (overfit l n)) l)))) (defn rot ([^objects a i j] (let [tmp (get a i)] (set a i (get a j) j tmp))) From af14a1095efbaa1876deacc30fc3cb99731fa477 Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 15:45:33 +0200 Subject: [PATCH 38/46] [i/items] don't cancel shrank item-ps children --- src/hyperfiddle/incseq/items_eager_impl.cljc | 2 +- test/hyperfiddle/incseq/items_eager_impl_test.cljc | 11 +++-------- 2 files changed, 4 insertions(+), 9 deletions(-) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index 7cc5c78b6..77a4877b3 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -94,7 +94,7 @@ (run! (fn [i] (let [^Item item (a/get item* i)] (a/fset item -dead true) - (run! #(%) ((a/fget item -ps*))))) + (a/set item* i nil))) (range (- d n) d)))) (defn change! [^Ps ps diff] diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 962f8cab2..73e5e9d8f 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -181,7 +181,7 @@ _ (q ::none) _ (t/is (= ::none (q)))])) -(t/deftest shrink-terminates-idle-item-ps +(t/deftest shrink-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) @@ -195,15 +195,12 @@ 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 +(t/deftest shrink-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) @@ -211,15 +208,13 @@ _ (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)) + _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)))])) From e2a2ed75889383687c5a1e18433da6197e39a27b Mon Sep 17 00:00:00 2001 From: xificurC Date: Fri, 30 Aug 2024 09:47:25 +0200 Subject: [PATCH 39/46] [i/items] terminate orphaned item processes --- src/hyperfiddle/incseq/items_eager_impl.cljc | 19 +++++++++++++------ .../incseq/items_eager_impl_test.cljc | 5 ++++- 2 files changed, 17 insertions(+), 7 deletions(-) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index 77a4877b3..b84f64662 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -32,15 +32,17 @@ (def item-field-count (a/deffields -v -flow -ps* -dead)) (deftype Item [state-]) -(def item-ps-field-count (a/deffields _stepped _cancelled -cache)) ; -stepped would warn of redefinition +(def item-ps-field-count (a/deffields _stepped _cancelled -cache -orphaned)) ; -stepped would warn of redefinition (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 (= ps (a/getset a -cache ps)) (done))) +(defprotocol Orphanable (orphan [_])) + (defn ->item-ps [^Item item step done] (let [a (object-array item-ps-field-count)] - (a/set a -cache a, -cancelled false) + (a/set a -cache a, -cancelled false, -orphaned false) (reify IFn (#?(:clj invoke :cljs -invoke) [this] @@ -50,12 +52,15 @@ (#?(:clj invoke :cljs -invoke) [_ v] (when-not (or (= v (a/getset a -cache v)) (a/getset a -stepped true)) (step))) + Orphanable (orphan [this] (a/set a -orphaned true) (when-not (a/get a -stepped) (cleanup-item-ps this a done))) 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 [v (a/get a -cache)] + (when (a/get a -orphaned) (cleanup-item-ps this a done)) + (if (a/get a -cancelled) + (do (cleanup-item-ps this a done) (throw (Cancelled.))) + v)))))) (let [cancelled #?(:clj (Object.) :cljs (js/Object.))] (defn ->dead-item-ps [step done -v] @@ -63,6 +68,7 @@ (let [ (->box -v)] (reify IFn (#?(:clj invoke :cljs -invoke) [_] ( cancelled)) + Orphanable (orphan [_]) IDeref (#?(:clj deref :cljs -deref) [this] (done) (if (identical? cancelled ()) (throw (Cancelled.)) (let [v ()] ( this) v))))))) @@ -94,7 +100,8 @@ (run! (fn [i] (let [^Item item (a/get item* i)] (a/fset item -dead true) - (a/set item* i nil))) + (a/set item* i nil) + (run! orphan ((a/fget item -ps*))))) (range (- d n) d)))) (defn change! [^Ps ps diff] diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 73e5e9d8f..e89e542d2 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -195,6 +195,7 @@ shrink1 (assoc (d/empty-diff 1) :shrink 1) _ (q shrink1) _ (in-step) + _ (t/is (= :item0-done (q))) _ (t/is (= :items-step (q))) _ (t/is (= shrink1 @items)) _ (q ::none) @@ -208,13 +209,15 @@ _ (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)) + 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 (= :foo @item0)) + _ (t/is (= :item0-done (q))) _ (q ::none) _ (t/is (= ::none (q)))])) From 10901d653c951914924cfe25a352b0932bc992e0 Mon Sep 17 00:00:00 2001 From: xificurC Date: Fri, 30 Aug 2024 10:27:24 +0200 Subject: [PATCH 40/46] [i/items] cacnel after done normally --- src/hyperfiddle/incseq/items_eager_impl.cljc | 2 +- test/hyperfiddle/incseq/items_eager_impl_test.cljc | 13 +++++++++++++ 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index b84f64662..485af0c7b 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -17,7 +17,7 @@ (some-> (a/get state- -input-ps) call) (a/set-not= state- -done ::yes ::requested) (let [cancelled? (a/getset state- -cancelled true)] - (when (not (or (a/getset state- -stepped true) cancelled?)) (step)))) + (when (not (or (a/getset state- -stepped true) cancelled? (= ::yes (a/get state- -done)))) (step)))) IDeref (#?(:clj deref :cljs -deref) [this] (a/set state- -stepped false) (when (= ::requested (a/get state- -done)) (cleanup-then-done this)) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index e89e542d2..3ba10d425 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -521,6 +521,19 @@ _ (q ::none) _ (t/is (= ::none (q)))])) +(t/deftest cancel-after-done-normally + (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 + _ (in-done) + _ (t/is (= :items-done (q))) + _ (items) + _ (q ::none) + _ (t/is (= ::none (q)))])) + (t/deftest item-ps-double-cancellation-idle (let [q (->mq) _ (q (assoc (d/empty-diff 1) :grow 1 :change {0 :foo})) ; what input will return on transfer From 353db91bda1ad654a824a57f26eceae3180d16e6 Mon Sep 17 00:00:00 2001 From: xificurC Date: Fri, 30 Aug 2024 20:37:46 +0200 Subject: [PATCH 41/46] [i/items] check if input is initialized --- src/hyperfiddle/incseq/items_eager_impl.cljc | 18 +++++++++--------- .../incseq/items_eager_impl_test.cljc | 11 +++++++++++ 2 files changed, 20 insertions(+), 9 deletions(-) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index 485af0c7b..081299c0f 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -8,7 +8,7 @@ (:import #?(:clj [clojure.lang IDeref IFn]) [missionary Cancelled])) -(def ps-field-count (a/deffields -stepped -cancelled -go -input-ps -done -diff -item*)) +(def ps-field-count (a/deffields -stepped -cancelled -going -input-ps -done -diff -item*)) (declare cleanup-then-done) (defn call [f] (f)) @@ -117,16 +117,16 @@ (defn transfer-input [^Ps ps] (loop [diff (a/fgetset ps -diff {:change {}})] - (a/fset ps -go true) - (let [?in-diff (try @(a/fget ps -input-ps) (catch #?(:clj Throwable :cljs :default) e e))] - (if (map? ?in-diff) + (let [going (a/fgetset ps -going true) + ?in-diff (try @(a/fget ps -input-ps) (catch #?(:clj Throwable :cljs :default) e e))] + (if (and (map? ?in-diff) (not going)) (do (grow! ps ?in-diff) (permute! ps ?in-diff) (shrink! ps ?in-diff) (change! ps ?in-diff) (let [newdiff (a/fset ps -diff (cond->> (assoc ?in-diff :change (:change (a/fget ps -diff))) diff (d/combine diff)))] - (if (a/fgetset ps -go false) + (if (a/fgetset ps -going false) (case (a/fget ps -stepped) false (when (needed-diff? newdiff) (a/fset ps -stepped true) ((.-step ps))) true nil @@ -134,17 +134,17 @@ (recur newdiff)))) (do (some-> (a/fget ps -input-ps) call) (a/fset-not= ps -done ::yes ::requested) - (a/fset ps -diff ?in-diff) + (a/fset ps -diff (if going (ex-info "uninitialized input process" {}) ?in-diff)) (when-not (a/fgetset ps -stepped true) ((.-step ps)))))))) (def +initial-item-size+ 8) (defn flow [input] (fn [step done] (let [ps (->Ps step done (object-array ps-field-count))] - (a/fset ps -item* (object-array +initial-item-size+), -stepped nil, -go true, -done ::no) + (a/fset ps -item* (object-array +initial-item-size+), -stepped nil, -going true, -done ::no) (a/fset ps -input-ps (input - #(when-not (a/fgetset ps -go false) (transfer-input ps)) - #(if (or (a/fget ps -stepped) (a/fget ps -go)) + #(when-not (a/fgetset ps -going false) (transfer-input ps)) + #(if (or (a/fget ps -stepped) (a/fget ps -going)) (a/fset ps -done ::requested) (cleanup-then-done ps)))) (transfer-input ps) ps))) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 3ba10d425..0ab3c762b 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -650,6 +650,17 @@ _ (q ::none) _ (t/is (= ::none (q)))])) +(t/deftest input-must-be-initialized + (let [q (->mq) + items ((items/flow (fn [step done] + (q [step done]) + (reify + IFn (#?(:clj invoke :cljs -invoke) [_] (q :input-cancel)) + IDeref (#?(:clj deref :cljs -deref) [_] (q))))) + #(q :items-step) #(q :items-done)) + _ (t/is (= :input-cancel (q))) + _ (t/is (thrown? ExceptionInfo @items))])) + ;; missing tests ;; - double transfer (optional) ;; - item-ps From 5571b9011b0dac5dc9f0de251ea213522ba17785 Mon Sep 17 00:00:00 2001 From: xificurC Date: Fri, 30 Aug 2024 20:38:23 +0200 Subject: [PATCH 42/46] add experimental flow protocol enforcer --- .../incseq/flow_protocol_enforcer.cljc | 33 +++++++++++++++++++ .../incseq/items_eager_impl_test.cljc | 13 ++++---- 2 files changed, 40 insertions(+), 6 deletions(-) create mode 100644 src/hyperfiddle/incseq/flow_protocol_enforcer.cljc diff --git a/src/hyperfiddle/incseq/flow_protocol_enforcer.cljc b/src/hyperfiddle/incseq/flow_protocol_enforcer.cljc new file mode 100644 index 000000000..5a9b186fa --- /dev/null +++ b/src/hyperfiddle/incseq/flow_protocol_enforcer.cljc @@ -0,0 +1,33 @@ +(ns hyperfiddle.incseq.flow-protocol-enforcer + (:require [hyperfiddle.electric.impl.array-fields :as a]) + #?(:clj (:import [clojure.lang IDeref IFn])) + #?(:cljs (:require-macros [hyperfiddle.incseq.flow-protocol-enforcer :refer [cannot-throw]]))) + +(defn violated + ([nm msg] (println nm "flow protocol violation:" msg) #?(:cljs (.error js/console) :clj (prn (Throwable.)))) + ([nm msg e] + (println nm "flow protocol violation:" msg) + (#?(:clj prn :cljs js/console.error) e))) + +(defmacro cannot-throw [nm f] `(try (~f) (catch ~(if (:js-globals &env) :default 'Throwable) e# + (violated ~nm ~(str f " cannot throw") e#)))) + +(def field-count (a/deffields -should-step -is-done)) +(defn flow + ([input-flow] (flow "" input-flow)) + ([nm input-flow] + (fn [step done] + (let [o (object-array field-count) + _ (a/set o -should-step ::init, -is-done false) + step (fn [] + (when (a/get o -is-done) (violated nm "step after done")) + (if (a/getswap o -should-step not) (cannot-throw nm step) (violated nm "double step"))) + done (fn [] (if (a/getset o -is-done true) (violated nm "done called twice") (cannot-throw nm done))) + cancel (try (input-flow step done) + (catch #?(:clj Throwable :cljs :default) e (violated "flow process creation threw" e)))] + (reify + IFn (#?(:clj invoke :cljs -invoke) [_] (cannot-throw nm cancel)) + IDeref (#?(:clj deref :cljs -deref) [_] + (if-let [should-step (a/getswap o -should-step not)] + (violated nm (if (= ::init should-step) "transfer without initial step" "double transfer")) + @cancel))))))) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 0ab3c762b..751f0da36 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -5,6 +5,7 @@ [contrib.data :refer [->box]] [hyperfiddle.incseq.diff-impl :as d] [hyperfiddle.incseq.items-eager-impl :as items] + [hyperfiddle.incseq.flow-protocol-enforcer :as fpe] [missionary.core :as m]) (:import #?(:clj [clojure.lang ExceptionInfo IDeref IFn]) [missionary Cancelled])) @@ -29,12 +30,12 @@ ([q] (spawn-ps q (->box (fn [_step _done] (q))))) ([q ] (spawn-ps q (->box (fn [_step _done] (q :input-cancel))))) ([q ] - ((items/flow (fn [step done] - (q [step done]) - (step) - (reify - IFn (#?(:clj invoke :cljs -invoke) [_] (() step done)) - IDeref (#?(:clj deref :cljs -deref) [_] (() step done))))) + ((fpe/flow "i/items" (items/flow (fn [step done] + (q [step done]) + (step) + (reify + IFn (#?(:clj invoke :cljs -invoke) [_] (() step done)) + IDeref (#?(:clj deref :cljs -deref) [_] (() step done)))))) #(q :items-step) #(q :items-done)))) (t/deftest spawn From 19eb8ef058dd0fe1e53527fd28187e38e532c388 Mon Sep 17 00:00:00 2001 From: xificurC Date: Mon, 2 Sep 2024 09:35:28 +0200 Subject: [PATCH 43/46] [i/items] item processes are thread safe --- src/hyperfiddle/incseq/items_eager_impl.cljc | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index 081299c0f..37f5b201d 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -34,7 +34,7 @@ (def item-ps-field-count (a/deffields _stepped _cancelled -cache -orphaned)) ; -stepped would warn of redefinition -(defn remove-item-ps [^Item item ps] (let [ps* (a/fget item -ps*)] (ps* (disj (ps*) ps)))) +(defn remove-item-ps [^Item item ps] (swap! (a/fget item -ps*) disj ps)) (defn cleanup-item-ps [ps a done] (when-not (= ps (a/getset a -cache ps)) (done))) @@ -78,14 +78,14 @@ (a/fgetset ps -item* (a/ensure-fits (a/fget ps -item*) d)) (run! (fn [i] (let [^Item item (->Item (object-array item-field-count))] - (a/fset item -ps* (->box #{})) + (a/fset item -ps* (atom #{})) (a/set (a/fget ps -item*) i item) (a/fswap ps -diff update :change assoc (idx i i) (a/fset item -flow (fn [step done] (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)) + (let [item-ps (->item-ps item step done)] + (swap! (a/fget item -ps*) conj item-ps) (item-ps (a/fget item -v)) item-ps))))))) (range (- d n) d)))) @@ -101,7 +101,7 @@ (let [^Item item (a/get item* i)] (a/fset item -dead true) (a/set item* i nil) - (run! orphan ((a/fget item -ps*))))) + (run! orphan @(a/fget item -ps*)))) (range (- d n) d)))) (defn change! [^Ps ps diff] @@ -109,7 +109,7 @@ (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*))))) + (run! (fn [item-ps] (item-ps v)) @(a/fget item -ps*)))) nil (:change diff)))) (defn needed-diff? [d] From 71b05cca05bf34d550b0e96588f25f6efc8e3b60 Mon Sep 17 00:00:00 2001 From: xificurC Date: Mon, 2 Sep 2024 15:40:01 +0200 Subject: [PATCH 44/46] [i/items] thread safe counter --- src/hyperfiddle/incseq/items_eager_impl.cljc | 31 ++++++++++++------- .../incseq/items_eager_impl_test.cljc | 2 +- 2 files changed, 20 insertions(+), 13 deletions(-) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index 37f5b201d..abdef6f8b 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -6,13 +6,14 @@ [hyperfiddle.incseq.diff-impl :as d] [hyperfiddle.incseq.perm-impl :as p]) (:import #?(:clj [clojure.lang IDeref IFn]) + #?(:clj [java.util.concurrent.atomic AtomicInteger AtomicBoolean]) [missionary Cancelled])) -(def ps-field-count (a/deffields -stepped -cancelled -going -input-ps -done -diff -item*)) +(def ps-field-count (a/deffields -stepped -cancelled -input-ps -done -diff -item*)) (declare cleanup-then-done) (defn call [f] (f)) -(deftype Ps [step done state-] +(deftype Ps [step done going state-] IFn (#?(:clj invoke :cljs -invoke) [_] (some-> (a/get state- -input-ps) call) (a/set-not= state- -done ::yes ::requested) @@ -28,6 +29,12 @@ (defn cleanup-then-done [^Ps ps] (a/fset ps -input-ps nil, -done ::yes, -item* nil) ((.-done ps))) +(defn going [^Ps ps] #?(:clj (let [^AtomicInteger i (.-going ps)] (.longValue i)) + :cljs (.-going ps))) +(defn ++going [^Ps ps] #?(:clj (let [^AtomicInteger i (.-going ps)] (.incrementAndGet i)) + :cljs (set! (.-going ps) (inc (.-going ps))))) +(defn --going [^Ps ps] #?(:clj (let [^AtomicInteger i (.-going ps)] (.getAndDecrement i)) + :cljs (set! (.-going ps) (dec (.-going ps))))) (def item-field-count (a/deffields -v -flow -ps* -dead)) (deftype Item [state-]) @@ -117,16 +124,16 @@ (defn transfer-input [^Ps ps] (loop [diff (a/fgetset ps -diff {:change {}})] - (let [going (a/fgetset ps -going true) - ?in-diff (try @(a/fget ps -input-ps) (catch #?(:clj Throwable :cljs :default) e e))] - (if (and (map? ?in-diff) (not going)) + (let [?in-diff (try @(a/fget ps -input-ps) (catch #?(:clj Throwable :cljs :default) e e))] + (--going ps) + (if (map? ?in-diff) (do (grow! ps ?in-diff) (permute! ps ?in-diff) (shrink! ps ?in-diff) (change! ps ?in-diff) (let [newdiff (a/fset ps -diff (cond->> (assoc ?in-diff :change (:change (a/fget ps -diff))) diff (d/combine diff)))] - (if (a/fgetset ps -going false) + (if (zero? (going ps)) (case (a/fget ps -stepped) false (when (needed-diff? newdiff) (a/fset ps -stepped true) ((.-step ps))) true nil @@ -134,17 +141,17 @@ (recur newdiff)))) (do (some-> (a/fget ps -input-ps) call) (a/fset-not= ps -done ::yes ::requested) - (a/fset ps -diff (if going (ex-info "uninitialized input process" {}) ?in-diff)) + (a/fset ps -diff (if (neg? (going ps)) (ex-info "uninitialized input process" {}) ?in-diff)) (when-not (a/fgetset ps -stepped true) ((.-step ps)))))))) (def +initial-item-size+ 8) (defn flow [input] (fn [step done] - (let [ps (->Ps step done (object-array ps-field-count))] - (a/fset ps -item* (object-array +initial-item-size+), -stepped nil, -going true, -done ::no) + (let [ps (->Ps step done #?(:clj (AtomicInteger. -1) :cljs -1) (object-array ps-field-count))] + (a/fset ps -item* (object-array +initial-item-size+), -stepped nil, -done ::no) (a/fset ps -input-ps (input - #(when-not (a/fgetset ps -going false) (transfer-input ps)) - #(if (or (a/fget ps -stepped) (a/fget ps -going)) + #(when (= 1 (++going ps)) (transfer-input ps)) + #(if (or (pos? (going ps)) (a/fget ps -stepped)) (a/fset ps -done ::requested) (cleanup-then-done ps)))) - (transfer-input ps) ps))) + (++going ps) (transfer-input ps) ps))) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 751f0da36..63fb63d1a 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -450,7 +450,7 @@ (let [q (->mq) (->box (consume-calling [(fn [_ _] (d/empty-diff 0)) (fn [_ done] (done) (throw (ex-info "boom" {})))])) - (->box (fn [step _done] (step))) + (->box (fn [_step _done])) items (spawn-ps q ) [_in-step _in-done] (q) _ (t/is (= :items-step (q))) From 8b7ab2581d12c27033b2ce64a5fc4d45406e3b48 Mon Sep 17 00:00:00 2001 From: xificurC Date: Mon, 2 Sep 2024 15:57:50 +0200 Subject: [PATCH 45/46] [i/items] refactor, prep stepped --- src/hyperfiddle/incseq/items_eager_impl.cljc | 23 ++++++++++---------- 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index abdef6f8b..13bea5612 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -6,14 +6,14 @@ [hyperfiddle.incseq.diff-impl :as d] [hyperfiddle.incseq.perm-impl :as p]) (:import #?(:clj [clojure.lang IDeref IFn]) - #?(:clj [java.util.concurrent.atomic AtomicInteger AtomicBoolean]) + #?(:clj [java.util.concurrent.atomic AtomicLong AtomicBoolean]) [missionary Cancelled])) (def ps-field-count (a/deffields -stepped -cancelled -input-ps -done -diff -item*)) (declare cleanup-then-done) (defn call [f] (f)) -(deftype Ps [step done going state-] +(deftype Ps [step done going stepped state-] IFn (#?(:clj invoke :cljs -invoke) [_] (some-> (a/get state- -input-ps) call) (a/set-not= state- -done ::yes ::requested) @@ -29,11 +29,11 @@ (defn cleanup-then-done [^Ps ps] (a/fset ps -input-ps nil, -done ::yes, -item* nil) ((.-done ps))) -(defn going [^Ps ps] #?(:clj (let [^AtomicInteger i (.-going ps)] (.longValue i)) +(defn going [^Ps ps] #?(:clj (let [^AtomicLong i (.-going ps)] (.longValue i)) :cljs (.-going ps))) -(defn ++going [^Ps ps] #?(:clj (let [^AtomicInteger i (.-going ps)] (.incrementAndGet i)) +(defn ++going [^Ps ps] #?(:clj (let [^AtomicLong i (.-going ps)] (.incrementAndGet i)) :cljs (set! (.-going ps) (inc (.-going ps))))) -(defn --going [^Ps ps] #?(:clj (let [^AtomicInteger i (.-going ps)] (.getAndDecrement i)) +(defn --going [^Ps ps] #?(:clj (let [^AtomicLong i (.-going ps)] (.getAndDecrement i)) :cljs (set! (.-going ps) (dec (.-going ps))))) (def item-field-count (a/deffields -v -flow -ps* -dead)) @@ -120,7 +120,7 @@ nil (:change diff)))) (defn needed-diff? [d] - (or (seq (:permutation d)) (pos? (:grow d)) (pos? (:shrink d)) (seq (:freeze d)))) + (or (= (d/empty-diff 0) d) (seq (:permutation d)) (pos? (:grow d)) (pos? (:shrink d)) (seq (:freeze d)))) (defn transfer-input [^Ps ps] (loop [diff (a/fgetset ps -diff {:change {}})] @@ -134,10 +134,8 @@ (let [newdiff (a/fset ps -diff (cond->> (assoc ?in-diff :change (:change (a/fget ps -diff))) diff (d/combine diff)))] (if (zero? (going ps)) - (case (a/fget ps -stepped) - false (when (needed-diff? newdiff) (a/fset ps -stepped true) ((.-step ps))) - true nil - nil (do (a/fset ps -stepped true) ((.-step ps)))) + (when (and (not (a/fget ps -stepped)) (needed-diff? newdiff)) + (a/fset ps -stepped true) ((.-step ps))) (recur newdiff)))) (do (some-> (a/fget ps -input-ps) call) (a/fset-not= ps -done ::yes ::requested) @@ -147,8 +145,9 @@ (def +initial-item-size+ 8) (defn flow [input] (fn [step done] - (let [ps (->Ps step done #?(:clj (AtomicInteger. -1) :cljs -1) (object-array ps-field-count))] - (a/fset ps -item* (object-array +initial-item-size+), -stepped nil, -done ::no) + (let [ps (->Ps step done #?(:clj (new AtomicLong -1) :cljs -1) #?(:clj (new AtomicBoolean false) :cljs false) + (object-array ps-field-count))] + (a/fset ps -item* (object-array +initial-item-size+), -stepped false, -done ::no) (a/fset ps -input-ps (input #(when (= 1 (++going ps)) (transfer-input ps)) #(if (or (pos? (going ps)) (a/fget ps -stepped)) From abb6d692af9644b884677e01c408827369397621 Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 3 Sep 2024 11:11:19 +0200 Subject: [PATCH 46/46] [i/items] thread safety --- .../incseq/flow_protocol_enforcer.cljc | 13 +-- src/hyperfiddle/incseq/items_eager_impl.cljc | 100 +++++++++++------- .../incseq/items_eager_impl_test.cljc | 18 ++++ 3 files changed, 83 insertions(+), 48 deletions(-) diff --git a/src/hyperfiddle/incseq/flow_protocol_enforcer.cljc b/src/hyperfiddle/incseq/flow_protocol_enforcer.cljc index 5a9b186fa..f8e91bfe8 100644 --- a/src/hyperfiddle/incseq/flow_protocol_enforcer.cljc +++ b/src/hyperfiddle/incseq/flow_protocol_enforcer.cljc @@ -1,5 +1,4 @@ (ns hyperfiddle.incseq.flow-protocol-enforcer - (:require [hyperfiddle.electric.impl.array-fields :as a]) #?(:clj (:import [clojure.lang IDeref IFn])) #?(:cljs (:require-macros [hyperfiddle.incseq.flow-protocol-enforcer :refer [cannot-throw]]))) @@ -12,22 +11,20 @@ (defmacro cannot-throw [nm f] `(try (~f) (catch ~(if (:js-globals &env) :default 'Throwable) e# (violated ~nm ~(str f " cannot throw") e#)))) -(def field-count (a/deffields -should-step -is-done)) (defn flow ([input-flow] (flow "" input-flow)) ([nm input-flow] (fn [step done] - (let [o (object-array field-count) - _ (a/set o -should-step ::init, -is-done false) + (let [!should-step? (atom ::init), !done? (atom false) step (fn [] - (when (a/get o -is-done) (violated nm "step after done")) - (if (a/getswap o -should-step not) (cannot-throw nm step) (violated nm "double step"))) - done (fn [] (if (a/getset o -is-done true) (violated nm "done called twice") (cannot-throw nm done))) + (when @!done? (violated nm "step after done")) + (if (first (swap-vals! !should-step? not)) (cannot-throw nm step) (violated nm "double step"))) + done (fn [] (if (first (reset-vals! !done? true)) (violated nm "done called twice") (cannot-throw nm done))) cancel (try (input-flow step done) (catch #?(:clj Throwable :cljs :default) e (violated "flow process creation threw" e)))] (reify IFn (#?(:clj invoke :cljs -invoke) [_] (cannot-throw nm cancel)) IDeref (#?(:clj deref :cljs -deref) [_] - (if-let [should-step (a/getswap o -should-step not)] + (if-let [should-step (first (swap-vals! !should-step? not))] (violated nm (if (= ::init should-step) "transfer without initial step" "double transfer")) @cancel))))))) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index 13bea5612..9648bec39 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -6,34 +6,49 @@ [hyperfiddle.incseq.diff-impl :as d] [hyperfiddle.incseq.perm-impl :as p]) (:import #?(:clj [clojure.lang IDeref IFn]) - #?(:clj [java.util.concurrent.atomic AtomicLong AtomicBoolean]) - [missionary Cancelled])) + #?(:clj [java.util.concurrent.atomic AtomicLong]) + #?(:clj [java.util.concurrent.locks ReentrantLock]) + [missionary Cancelled]) + #?(:cljs (:require-macros [hyperfiddle.incseq.items-eager-impl :refer [locked]]))) -(def ps-field-count (a/deffields -stepped -cancelled -input-ps -done -diff -item*)) +#?(:clj (set! *warn-on-reflection* true)) + +(def ps-field-count (a/deffields -stepped -cancelled -input-ps -diff -item*)) + +(defmacro locked [on & body] + (if (:js-globals &env) + `(do ~@body) + (let [l (with-meta (gensym "lock") {:tag `ReentrantLock})] + `(let [~l ~on] (.lock ~l) (let [v# (do ~@body)] (.unlock ~l) v#))))) (declare cleanup-then-done) (defn call [f] (f)) -(deftype Ps [step done going stepped state-] - IFn (#?(:clj invoke :cljs -invoke) [_] - (some-> (a/get state- -input-ps) call) - (a/set-not= state- -done ::yes ::requested) - (let [cancelled? (a/getset state- -cancelled true)] - (when (not (or (a/getset state- -stepped true) cancelled? (= ::yes (a/get state- -done)))) (step)))) +(deftype Ps [step done going indone state- #?(:clj lock)] + IFn (#?(:clj invoke :cljs -invoke) [this] + (let [step? (locked (.-lock this) + (swap! indone (fn [v] (if (= v ::yes) ::yes ::requested))) + (let [cancelled? (a/getset state- -cancelled true)] + (not (or (a/getset state- -stepped true) cancelled? (= ::yes @indone)))))] + (some-> (a/get state- -input-ps) call) + (when step? (step)))) IDeref (#?(:clj deref :cljs -deref) [this] - (a/set state- -stepped false) - (when (= ::requested (a/get state- -done)) (cleanup-then-done this)) - (let [?diff (a/getset state- -diff nil)] + (let [[cleanup? ?diff] (locked (.-lock this) + (a/set state- -stepped false) + [(= ::requested @indone) (a/getset state- -diff nil)])] + (when cleanup? (cleanup-then-done this)) (cond (a/get state- -cancelled) (throw (Cancelled.)) - (map? ?diff) ?diff - :else (throw ?diff))))) + (map? ?diff) ?diff + :else (throw ?diff))))) + (defn cleanup-then-done [^Ps ps] - (a/fset ps -input-ps nil, -done ::yes, -item* nil) + (locked (.-lock ps) (a/fset ps -input-ps nil, -item* nil)) + (reset! (.-indone ps) ::yes) ((.-done ps))) (defn going [^Ps ps] #?(:clj (let [^AtomicLong i (.-going ps)] (.longValue i)) :cljs (.-going ps))) (defn ++going [^Ps ps] #?(:clj (let [^AtomicLong i (.-going ps)] (.incrementAndGet i)) :cljs (set! (.-going ps) (inc (.-going ps))))) -(defn --going [^Ps ps] #?(:clj (let [^AtomicLong i (.-going ps)] (.getAndDecrement i)) +(defn --going [^Ps ps] #?(:clj (let [^AtomicLong i (.-going ps)] (.decrementAndGet i)) :cljs (set! (.-going ps) (dec (.-going ps))))) (def item-field-count (a/deffields -v -flow -ps* -dead)) @@ -59,7 +74,10 @@ (#?(:clj invoke :cljs -invoke) [_ v] (when-not (or (= v (a/getset a -cache v)) (a/getset a -stepped true)) (step))) - Orphanable (orphan [this] (a/set a -orphaned true) (when-not (a/get a -stepped) (cleanup-item-ps this a done))) + Orphanable (orphan [this] + (a/set a -orphaned true) + (remove-item-ps item this) + (when-not (a/get a -stepped) (cleanup-item-ps this a done))) IDeref (#?(:clj deref :cljs -deref) [this] (a/set a -stepped false) @@ -120,37 +138,39 @@ nil (:change diff)))) (defn needed-diff? [d] - (or (= (d/empty-diff 0) d) (seq (:permutation d)) (pos? (:grow d)) (pos? (:shrink d)) (seq (:freeze d)))) + (or (seq (:permutation d)) (pos? (:grow d)) (pos? (:shrink d)) (seq (:freeze d)))) (defn transfer-input [^Ps ps] - (loop [diff (a/fgetset ps -diff {:change {}})] - (let [?in-diff (try @(a/fget ps -input-ps) (catch #?(:clj Throwable :cljs :default) e e))] - (--going ps) - (if (map? ?in-diff) - (do (grow! ps ?in-diff) - (permute! ps ?in-diff) - (shrink! ps ?in-diff) - (change! ps ?in-diff) - (let [newdiff (a/fset ps -diff (cond->> (assoc ?in-diff :change (:change (a/fget ps -diff))) - diff (d/combine diff)))] - (if (zero? (going ps)) - (when (and (not (a/fget ps -stepped)) (needed-diff? newdiff)) - (a/fset ps -stepped true) ((.-step ps))) - (recur newdiff)))) - (do (some-> (a/fget ps -input-ps) call) - (a/fset-not= ps -done ::yes ::requested) - (a/fset ps -diff (if (neg? (going ps)) (ex-info "uninitialized input process" {}) ?in-diff)) - (when-not (a/fgetset ps -stepped true) ((.-step ps)))))))) + (let [step? + (locked (.-lock ps) + (loop [diff (a/fgetset ps -diff {:change {}})] + (let [?in-diff (try @(a/fget ps -input-ps) (catch #?(:clj Throwable :cljs :default) e e))] + (if (map? ?in-diff) + (do (grow! ps ?in-diff) (permute! ps ?in-diff) (shrink! ps ?in-diff) (change! ps ?in-diff) + (let [newdiff (a/fset ps -diff (cond->> (assoc ?in-diff :change (:change (a/fget ps -diff))) + diff (d/combine diff)))] + (if (= 1 (going ps)) + (case (a/fget ps -stepped) + false (when (needed-diff? newdiff) (a/fset ps -stepped true)) + true nil + nil (a/fset ps -stepped true)) + (do (--going ps) (recur newdiff))))) + (do (some-> (a/fget ps -input-ps) call) + (swap! (.-indone ps) (fn [v] (if (= ::yes v) ::yes ::requested))) + (a/fset ps -diff (if (zero? (going ps)) (ex-info "uninitialized input process" {}) ?in-diff)) + (not (a/fgetset ps -stepped true)))))))] + (--going ps) + (when step? ((.-step ps))))) (def +initial-item-size+ 8) (defn flow [input] (fn [step done] - (let [ps (->Ps step done #?(:clj (new AtomicLong -1) :cljs -1) #?(:clj (new AtomicBoolean false) :cljs false) - (object-array ps-field-count))] - (a/fset ps -item* (object-array +initial-item-size+), -stepped false, -done ::no) + (let [^Ps ps (->Ps step done #?(:clj (new AtomicLong -1) :cljs -1) (atom ::no) (object-array ps-field-count) + #?(:clj (new ReentrantLock)))] + (a/fset ps -item* (object-array +initial-item-size+), -stepped nil) (a/fset ps -input-ps (input #(when (= 1 (++going ps)) (transfer-input ps)) #(if (or (pos? (going ps)) (a/fget ps -stepped)) - (a/fset ps -done ::requested) + (reset! (.-indone ps) ::requested) (cleanup-then-done ps)))) (++going ps) (transfer-input ps) ps))) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 63fb63d1a..0005c0be6 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -662,6 +662,24 @@ _ (t/is (= :input-cancel (q))) _ (t/is (thrown? ExceptionInfo @items))])) +(t/deftest input-transfer-decrements-on-non-needed-diff + (let [q (->mq) + _ (q (d/empty-diff 0)) ; what input will return on transfer + items (spawn-ps q) + [in-step _in-done] (q) + _ (t/is (= :items-step (q))) + _ (t/is (= (d/empty-diff 0) @items)) + _ (q (d/empty-diff 0)) + _ (in-step) + _ (q ::none) + _ (t/is (= ::none (q))) + _ (q (assoc (d/empty-diff 1) :grow 1 :change {0 :foo})) + _ (in-step) + _ (t/is (= (-> (d/empty-diff 1) (assoc :grow 1) (dissoc :change)) (dissoc @items :change))) + _ (t/is (= :items-step (q))) + _ (q ::none) + _ (t/is (= ::none (q)))])) + ;; missing tests ;; - double transfer (optional) ;; - item-ps