From 6a5483b7c4880ee8962e91a2142f9e0514a54864 Mon Sep 17 00:00:00 2001 From: xificurC Date: Mon, 26 Aug 2024 09:06:15 +0200 Subject: [PATCH 01/57] [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 74dbb8ffd5653a93673d29148f49ffdf6dc31138 Mon Sep 17 00:00:00 2001 From: xificurC Date: Mon, 26 Aug 2024 14:16:07 +0200 Subject: [PATCH 02/57] 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 c9888ebe1753ae70b6b338dcceaef882da003b02 Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 27 Aug 2024 10:00:08 +0200 Subject: [PATCH 03/57] [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 0fc7c7012f81b2e7184e1dd16de64773f353635e Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 27 Aug 2024 10:00:32 +0200 Subject: [PATCH 04/57] [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 460102e9b5d4a1eaecce8f5a80aaece3f434acb6 Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 27 Aug 2024 10:08:57 +0200 Subject: [PATCH 05/57] [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 58248d443ba0294d420fdc37068d9ecc1fa6c442 Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 27 Aug 2024 10:13:18 +0200 Subject: [PATCH 06/57] [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 7b6f489f0a71e9699be950472e9c51ca0687f095 Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 27 Aug 2024 12:13:54 +0200 Subject: [PATCH 07/57] [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 2dff61be55520b7da3675566424957780083f129 Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 27 Aug 2024 17:46:20 +0200 Subject: [PATCH 08/57] [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 b5231d4421621cab6dd312f27060ca5026b3561c Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 27 Aug 2024 17:47:12 +0200 Subject: [PATCH 09/57] 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 435e2e193a87f1b643e270f2bc6b0cf5d5e8d081 Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 27 Aug 2024 21:59:55 +0200 Subject: [PATCH 10/57] [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 9e382d88d3ba18c749c45d27e8084d4cfe4882d2 Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 27 Aug 2024 22:01:32 +0200 Subject: [PATCH 11/57] 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 f28047448ab44d53adeeaf4dd1607bc5530bf430 Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 27 Aug 2024 22:38:14 +0200 Subject: [PATCH 12/57] [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 62c98bb7d38d58c166f37e228ed45f944f5bf238 Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 10:17:14 +0200 Subject: [PATCH 13/57] [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 1528c8102414d1930d76170fe5efefb166b3b230 Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 10:21:02 +0200 Subject: [PATCH 14/57] 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 d88fb4acbf95944714612311948e4cebfb4da6a9 Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 10:40:12 +0200 Subject: [PATCH 15/57] 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 8541c4ee8b73f7d5c937dea712420e88298fd187 Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 10:43:55 +0200 Subject: [PATCH 16/57] [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 4bc3bce81696a6b99bfdbc9f94ec0bdacb9d7450 Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 10:47:28 +0200 Subject: [PATCH 17/57] [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 20f19dd2579fd0f5baa328bc260bf8947ff49164 Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 15:39:37 +0200 Subject: [PATCH 18/57] [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 ea4e245b273a64b5c97bf22bd37c5dcf964326cc Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 15:45:15 +0200 Subject: [PATCH 19/57] 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 23d13bf9e60d3a58711a3f71b111c8bd35fa92bf Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 16:15:17 +0200 Subject: [PATCH 20/57] 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 293e91f31e6fe5dc71913e2081381339df28a940 Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 17:13:00 +0200 Subject: [PATCH 21/57] [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 5583969207a86c4755f352a388861daf71822882 Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 17:16:54 +0200 Subject: [PATCH 22/57] [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 4054e95a418e5454b809510e0d0a2d31f3272ec1 Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 17:23:20 +0200 Subject: [PATCH 23/57] [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 1275c7a3925309b87f69dc2d84d5cfc6ba61e18c Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 17:29:59 +0200 Subject: [PATCH 24/57] 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 955f092d430269cf0bfd5e264ccaa7eb23f24aa8 Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 21:37:23 +0200 Subject: [PATCH 25/57] 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 04b9f077f9ea341865985cd8c269a1b46cfc551d Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 21:45:41 +0200 Subject: [PATCH 26/57] [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 56b34773d2d3cefce34767ceb171b6cd1e760706 Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 28 Aug 2024 22:11:10 +0200 Subject: [PATCH 27/57] [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 d482e02efd0d9c282be81e3d96ac28c322a49f78 Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 10:06:09 +0200 Subject: [PATCH 28/57] [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 7d3fccab71234be049b52f079d41467ed02b9284 Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 10:29:13 +0200 Subject: [PATCH 29/57] [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 a5389bdb0a1f8b5e3f36583b72e307a5e31c4611 Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 10:33:44 +0200 Subject: [PATCH 30/57] [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 8cee789297759fda741bfa0180eba5b3246743dd Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 10:35:15 +0200 Subject: [PATCH 31/57] [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 4004f41a79bbd7cba1c0e78ceda0049078b45203 Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 10:39:59 +0200 Subject: [PATCH 32/57] [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 d18d3f7fa02ee727f0323891570afcd38a117c0b Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 11:43:30 +0200 Subject: [PATCH 33/57] [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 ffa09900b3a0ef2f34842a24e7d2cfb3c5945466 Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 13:06:58 +0200 Subject: [PATCH 34/57] [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 bf5343c2bd6423e63b4cfe2abc47bb0dbe96468f Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 13:07:37 +0200 Subject: [PATCH 35/57] 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 04b86b2b55dbf975787b5ad3b9bbc436983edc58 Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 14:21:02 +0200 Subject: [PATCH 36/57] [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 c376b0b1e92f87b8fce722733547b44bdb4e075f Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 14:26:34 +0200 Subject: [PATCH 37/57] 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 4c0cf7a0aa2d59d733867f69dde6cca62d3d4919 Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 29 Aug 2024 15:45:33 +0200 Subject: [PATCH 38/57] [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 d806894280f5af77c6dd487a403773a4ac58512c Mon Sep 17 00:00:00 2001 From: xificurC Date: Fri, 30 Aug 2024 09:47:25 +0200 Subject: [PATCH 39/57] [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 68a7893a3c0bf30511c787c9f371998979c59989 Mon Sep 17 00:00:00 2001 From: xificurC Date: Fri, 30 Aug 2024 10:27:24 +0200 Subject: [PATCH 40/57] [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 f5722cb99fb0784c785f3227a0c211b0b6ac6018 Mon Sep 17 00:00:00 2001 From: xificurC Date: Fri, 30 Aug 2024 20:37:46 +0200 Subject: [PATCH 41/57] [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 43bf2e8b9dbea5431d3038ebf6b5de9927bdbf9d Mon Sep 17 00:00:00 2001 From: xificurC Date: Fri, 30 Aug 2024 20:38:23 +0200 Subject: [PATCH 42/57] 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 6d88339e6937b36d2ba53f38735004e43ffa1f44 Mon Sep 17 00:00:00 2001 From: xificurC Date: Mon, 2 Sep 2024 09:35:28 +0200 Subject: [PATCH 43/57] [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 1292b85ee8d15cc9c76eeef51e518b7fd9e7fb84 Mon Sep 17 00:00:00 2001 From: xificurC Date: Mon, 2 Sep 2024 15:40:01 +0200 Subject: [PATCH 44/57] [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 29cd4f3d9c3f0f3e37ed4ad479b7a56371674eda Mon Sep 17 00:00:00 2001 From: xificurC Date: Mon, 2 Sep 2024 15:57:50 +0200 Subject: [PATCH 45/57] [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 c5e3d87085d4115febc7cd8f72765a05f9386280 Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 3 Sep 2024 11:11:19 +0200 Subject: [PATCH 46/57] [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 From 4434786bae82b148b782b0ca6fcd558a29ac197a Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 3 Sep 2024 16:49:09 +0200 Subject: [PATCH 47/57] [cljs-analyzer2] don't self-require for macros If the namespace has :require-macros on itself, ClojureScript or Shadow-cljs will load the Clojure namespace automatically. If not, we don't need to look for macros in this namespace. --- src/hyperfiddle/electric/impl/cljs_analyzer2.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/hyperfiddle/electric/impl/cljs_analyzer2.clj b/src/hyperfiddle/electric/impl/cljs_analyzer2.clj index 314a42448..6d2f00b4b 100644 --- a/src/hyperfiddle/electric/impl/cljs_analyzer2.clj +++ b/src/hyperfiddle/electric/impl/cljs_analyzer2.clj @@ -249,7 +249,7 @@ (when-not (find-var a sym ns$) (-> (cond (simple-symbol? sym) - (or (do (safe-require ns$) (some-> (find-ns ns$) (find-ns-var sym))) + (or (some-> (find-ns ns$) (find-ns-var sym)) (when-some [ref (-> a ::nses (get ns$) ::refers (get sym))] (safe-requiring-resolve ref)) (when-some [ref (-> a ::nses (get ns$) ::refer-macros (get sym))] (safe-requiring-resolve ref)) (when-not (get (-> a ::nses (get ns$) ::excludes) sym) (find-ns-var (find-ns 'clojure.core) sym))) From fcd0af9a72d61e9ae42362e89614e31894eb67e9 Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 3 Sep 2024 16:58:17 +0200 Subject: [PATCH 48/57] [lang] treat all js/* symbols as non-electric --- src/hyperfiddle/electric/impl/lang3.clj | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/hyperfiddle/electric/impl/lang3.clj b/src/hyperfiddle/electric/impl/lang3.clj index 2b0b166f3..53f846f21 100644 --- a/src/hyperfiddle/electric/impl/lang3.clj +++ b/src/hyperfiddle/electric/impl/lang3.clj @@ -110,14 +110,12 @@ (let [ns (-> env :ns :name), {:keys [line column]} (meta o)] (str ns ":" line ":" column " " o))) -(defn js-uppercase-sym? [sym] (re-matches #"^js/(Math|String).*$" (str sym))) - (defn electric-sym? [sym] (let [s (name sym)] (and (pos? (.length s)) (Character/isUpperCase (.charAt s 0)) (not (re-matches #"G__\d+" s)) ; default gensym generated symbols - (not (js-uppercase-sym? sym)) + (not= "js" (namespace sym)) (not= 'RCF__tap sym)))) (defn ?expand-macro [o env caller] From ca8a567376079a4846fe61664e2add77ffeb5cfa Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 4 Sep 2024 15:26:12 +0200 Subject: [PATCH 49/57] [lang] remove dependency --- deps.edn | 1 - src/hyperfiddle/electric/impl/lang3.clj | 85 +++++++++++++------------ 2 files changed, 44 insertions(+), 42 deletions(-) diff --git a/deps.edn b/deps.edn index 9635c37bf..e3536c7d9 100644 --- a/deps.edn +++ b/deps.edn @@ -3,7 +3,6 @@ com.cognitect/transit-cljs {:mvn/version "0.8.280"} com.hyperfiddle/rcf {:mvn/version "20220926-202227"} missionary/missionary {:mvn/version "b.35"} - dom-top/dom-top {:mvn/version "1.0.9"} ; for loopr macro fipp/fipp {:mvn/version "0.6.26"} org.clojure/clojure {:mvn/version "1.12.0-alpha11"} org.clojure/clojurescript {:mvn/version "1.11.121"} diff --git a/src/hyperfiddle/electric/impl/lang3.clj b/src/hyperfiddle/electric/impl/lang3.clj index 53f846f21..e0c6eeeb8 100644 --- a/src/hyperfiddle/electric/impl/lang3.clj +++ b/src/hyperfiddle/electric/impl/lang3.clj @@ -4,10 +4,9 @@ [cljs.env] [clojure.string :as str] [contrib.assert :as ca] - [contrib.data :refer [keep-if]] + [contrib.data :refer [keep-if ->box]] [clojure.set :as set] [contrib.triple-store :as ts] - [dom-top.core :refer [loopr]] [fipp.edn] [hyperfiddle.electric3 :as-alias e] [hyperfiddle.electric.impl.cljs-analyzer2 :as cljs-ana] @@ -134,9 +133,10 @@ `(::call ((::static-vars r/dispatch) '~F ~F ~@(map (fn [arg] `(::pure ~arg)) args)))) (defn -expand-let-bindings [bs env] - (loopr [bs2 [], env2 env] - [[sym v] (eduction (partition-all 2) bs)] - (recur (conj bs2 sym (-expand-all-foreign v env2)) (add-local env2 sym)))) + (let [ (->box env) + f (fn [bs [sym v]] (let [env ()] ( (add-local env sym)) (conj bs sym (-expand-all-foreign v env)))) + bs (transduce (partition-all 2) (completing f) [] bs)] + [bs ()])) (defn jvm-type? [sym] (try (.getJavaClass (clojure.lang.Compiler$VarExpr. nil sym)) (catch Throwable _))) @@ -243,11 +243,11 @@ (let [[_ bs & body] o] (recur (?meta o (list* 'let* (dst/destructure* bs) body)) env)) (let*) (let [[_ bs & body] o - [bs2 env2] (loopr [bs2 [] , env2 env] - [[sym v] (eduction (partition-all 2) bs)] - (let [sym (?untag sym env2)] - (recur (conj bs2 sym (-expand-all v env2)) (add-local env2 sym))))] - (?meta o (list 'let* bs2 (-expand-all (?meta body (cons 'do body)) env2)))) + (->box env) + f (fn [bs [sym v]] + (let [env ()] ( (add-local env sym)) (conj bs sym (-expand-all v env)))) + bs2 (transduce (partition-all 2) (completing f) [] bs)] + (?meta o (list 'let* bs2 (-expand-all (?meta body (cons 'do body)) ())))) (loop*) (let [[_ bs & body] o [bs2 env2] (reduce @@ -562,13 +562,14 @@ ts (analyze v e env ts)] (recur bform e env ts)) (case) (let [[_ test & brs] form - [default brs2] (if (odd? (count brs)) [(last brs) (butlast brs)] [:TODO brs])] - (loopr [bs [], mp {}] - [[v br] (partition 2 brs2)] - (let [b (gensym "case-val")] - (recur (conj bs b `(::ctor ~br)) - (reduce (fn [ac nx] (assoc ac (list 'quote nx) b)) mp (if (seq? v) v [v])))) - (recur (?meta form `(let* ~bs (::call (~mp ~test (::ctor ~default))))) pe env ts))) + [default brs2] (if (odd? (count brs)) [(last brs) (butlast brs)] [:TODO brs]) + (->box {}) + f (fn [bs [v br]] + (let [b (gensym "case-val")] + ( (reduce (fn [ac nx] (assoc ac (list 'quote nx) b)) () (if (seq? v) v [v]))) + (conj bs b `(::ctor ~br)))) + bs (transduce (partition-all 2) (completing f) [] brs2)] + (recur (?meta form `(let* ~bs (::call (~() ~test (::ctor ~default))))) pe env ts)) (quote) (let [e (->id)] (-> ts (ts/add {:db/id e, ::parent pe, ::type ::pure}) (ts/add {:db/id (->id), ::parent e, ::type ::literal, ::v form}))) @@ -759,14 +760,15 @@ (let [[l bs & body] form, let*-u (->u) ts (addf ts let*-u p ->i {::t (case l (let*) ::let* (loop*) ::loop*)}) ->sym-i (->->id) - [ts2 env2] (loopr [ts2 ts, env2 env] - [[sym v] (eduction (partition-all 2) bs)] - (let [sym-u (->u)] - (recur (-> ts2 (addf sym-u let*-u ->sym-i {::t ::let*-sym, ::sym sym}) - (analyze-foreign v env2 sym-u (->->id))) - (add-foreign-local env2 sym)))) + (->box env) + f (fn [ts2 [sym v]] + (let [sym-u (->u), env ()] + ( (add-foreign-local env sym)) + (-> ts2 (addf sym-u let*-u ->sym-i {::t ::let*-sym, ::sym sym}) + (analyze-foreign v env sym-u (->->id))))) + ts2 (transduce (partition-all 2) (completing f) ts bs) body-u (->u), ->body-i (->->id)] - (reduce (fn [ts nx] (analyze-foreign ts nx env2 body-u ->body-i)) + (reduce (fn [ts nx] (analyze-foreign ts nx () body-u ->body-i)) (addf ts2 body-u let*-u (->->id) {::t ::body}) body)) (binding clojure.core/binding) @@ -989,23 +991,24 @@ (order [u*] (sort-by (comp ::i ->node) u*)) (find [& kvs] (order (eduction (map e->u) (apply ts/find ts kvs)))) (? [u k] (get (->node u) k))] - (let [[ts arg* val* dyn*] - (loopr [ts ts, arg* [], val* [], dyn* [], seen {}] - [u (remove #(let [nd (->node %)] (and (zero? (::i nd)) - (not= -1 (::p nd)) - (= ::set! (? (::p nd) ::t)))) - (find ::t ::var))] - (let [nd (->node u), r (::resolved nd), s (::sym nd)] - (if (:dynamic (::meta nd)) - (if (seen r) - (recur ts arg* val* dyn* seen) - (let [lex (gen (name r))] - (recur ts (conj arg* lex) (conj val* r) (into dyn* [s lex]) (assoc seen r true)))) - (if-some [lex (seen r)] - (recur (ts/asc ts (:db/id nd) ::sym lex) arg* val* dyn* seen) - (let [lex (gen (name s))] - (recur (ts/asc ts (:db/id nd) ::sym lex) - (conj arg* lex) (conj val* r) dyn* (assoc seen r lex))))))) + (let [ (->box []), (->box []), (->box []), (->box {}) + f (fn [ts u] + (let [nd (->node u), r (::resolved nd), s (::sym nd), seen ()] + (if (:dynamic (::meta nd)) + (if (seen r) + ts + (let [lex (gen (name r))] + ( (conj () lex)) ( (conj () r)) + ( (into () [s lex])) ( (assoc seen r true)) + ts)) + (if-some [lex (seen r)] + (ts/asc ts (:db/id nd) ::sym lex) + (let [lex (gen (name s))] + ( (conj () lex)) ( (conj () r)) ( (assoc seen r lex)) + (ts/asc ts (:db/id nd) ::sym lex)))))) + xf (remove #(let [nd (->node %)] (and (zero? (::i nd)) (not= -1 (::p nd)) (= ::set! (? (::p nd) ::t))))) + ts (transduce xf (completing f) ts (find ::t ::var)) + arg* (), val* (), dyn* () code (cond->> (emit-foreign ts) (seq dyn*) (list 'binding dyn*)) e-local* (into [] (comp (map #(? % ::sym)) (distinct)) (find ::t ::electric-local))] (when (or (seq arg*) (seq e-local*)) From 19cf43b80e1764966bc4aa9a68e20fd48e988b4b Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 5 Sep 2024 16:01:13 +0200 Subject: [PATCH 50/57] [clj-kondo] add back array-fields lint rule --- .clj-kondo/config.edn | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.clj-kondo/config.edn b/.clj-kondo/config.edn index 8bb9eff7e..57f11e035 100644 --- a/.clj-kondo/config.edn +++ b/.clj-kondo/config.edn @@ -2,5 +2,6 @@ hyperfiddle.electric3/for clojure.core/let hyperfiddle.electric3/cursor clojure.core/let hyperfiddle.electric3/with-cycle clojure.core/let - hyperfiddle.electric3/fn clojure.core/fn} + hyperfiddle.electric3/fn clojure.core/fn + hyperfiddle.electric.impl.array-fields/deffields clojure.core/declare} :linters {:redundant-expression {:level :off}}} From cd93b3e5579da4a41562f862a9fd5eed63dca2ba Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 5 Sep 2024 16:01:31 +0200 Subject: [PATCH 51/57] [fpe] check flow initialization Strictly speaking this is not correct, since uninitialized flows are valid flows. But for the purpose of electric we work with initialized ones. We can remove or make this check optional in the future if need be. --- src/hyperfiddle/incseq/flow_protocol_enforcer.cljc | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/hyperfiddle/incseq/flow_protocol_enforcer.cljc b/src/hyperfiddle/incseq/flow_protocol_enforcer.cljc index f8e91bfe8..0b181e80c 100644 --- a/src/hyperfiddle/incseq/flow_protocol_enforcer.cljc +++ b/src/hyperfiddle/incseq/flow_protocol_enforcer.cljc @@ -21,7 +21,8 @@ (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)))] + (catch #?(:clj Throwable :cljs :default) e (violated nm "flow process creation threw" e)))] + (when (= ::init @!should-step?) (violated nm "missing initial step")) (reify IFn (#?(:clj invoke :cljs -invoke) [_] (cannot-throw nm cancel)) IDeref (#?(:clj deref :cljs -deref) [_] From b554893875e9f63d3e33bc9eea1852afa18215ad Mon Sep 17 00:00:00 2001 From: xificurC Date: Thu, 5 Sep 2024 16:42:20 +0200 Subject: [PATCH 52/57] [lang] fix foreign gensym for clojure.core// --- src/hyperfiddle/electric/impl/lang3.clj | 2 +- .../electric/impl/compiler_test.cljc | 24 ++++++++++++++----- 2 files changed, 19 insertions(+), 7 deletions(-) diff --git a/src/hyperfiddle/electric/impl/lang3.clj b/src/hyperfiddle/electric/impl/lang3.clj index e0c6eeeb8..fe1a1fa74 100644 --- a/src/hyperfiddle/electric/impl/lang3.clj +++ b/src/hyperfiddle/electric/impl/lang3.clj @@ -984,7 +984,7 @@ (emit u)))) (defn wrap-foreign-for-electric - ([ts] (wrap-foreign-for-electric ts gensym)) + ([ts] (wrap-foreign-for-electric ts #(gensym (str/replace % #"/" "_")))) ([ts gen] (letfn [(->node [u] (ts/->node ts (ts/find1 ts ::u u))) (e->u [e] (::u (ts/->node ts e))) diff --git a/test/hyperfiddle/electric/impl/compiler_test.cljc b/test/hyperfiddle/electric/impl/compiler_test.cljc index 9e33b78cf..cc20cdcb6 100644 --- a/test/hyperfiddle/electric/impl/compiler_test.cljc +++ b/test/hyperfiddle/electric/impl/compiler_test.cljc @@ -603,18 +603,24 @@ (-> (lang/analyze-foreign (lang/-expand-all-foreign o fenv) fenv) (lang/emit-foreign))) -(defn foreign-electrified [gen o] - (-> (lang/analyze-foreign (lang/-expand-all-foreign o fenv) fenv) - (lang/wrap-foreign-for-electric gen))) +(defn foreign-electrified + ([o] (-> (lang/analyze-foreign (lang/-expand-all-foreign o fenv) fenv) + (lang/wrap-foreign-for-electric))) + ([gen o] + (-> (lang/analyze-foreign (lang/-expand-all-foreign o fenv) fenv) + (lang/wrap-foreign-for-electric gen)))) (def fenv-js (merge (cljs-ana/->cljs-env) fenv {::lang/peers {:client :cljs} ::lang/curent :client})) (defn foreign-js [o] (-> (lang/analyze-foreign (lang/-expand-all-foreign o fenv-js) fenv-js) (lang/emit-foreign))) -(defn foreign-electrified-js [gen o] - (-> (lang/analyze-foreign (lang/-expand-all-foreign o fenv-js) fenv-js) - (lang/wrap-foreign-for-electric gen))) +(defn foreign-electrified-js + ([o] (-> (lang/analyze-foreign (lang/-expand-all-foreign o fenv-js) fenv-js) + (lang/wrap-foreign-for-electric))) + ([gen o] + (-> (lang/analyze-foreign (lang/-expand-all-foreign o fenv-js) fenv-js) + (lang/wrap-foreign-for-electric gen)))) (tests "foreign" @@ -719,6 +725,9 @@ (foreign-electrified (consuming '[a]) '(foo bar baz)) := '((fn* [a] (a a a)) hyperfiddle.electric.impl.runtime3/cannot-resolve) + ;; gensym of name of clojure.core// creates an invalid symbol + (-> (foreign-electrified '(fn [x] (/ x 2))) first second first name first) := \_ + (foreign-electrified nil '(fn [x] [x x])) := nil ; nothing to wrap, signaled as `nil` @@ -775,6 +784,9 @@ (foreign-electrified-js (consuming '[a]) '(set! consuming e1)) := '((fn* [e1] (set! consuming e1)) e1) + ;; gensym of name of clojure.core// creates an invalid symbol + (-> (foreign-electrified-js '(fn [x] (/ x 2))) first second first name first) := \_ + (foreign-electrified-js nil '(fn [x] [x x])) := nil ; nothing to wrap, signaled as `nil` From 66fa8f48f077c13ab64925ddd7db554c3dad24c6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9o=20NOEL?= Date: Mon, 9 Sep 2024 13:22:30 +0200 Subject: [PATCH 53/57] input subs notify on spawn --- src/hyperfiddle/electric/impl/runtime3.cljc | 68 +++++++-------------- 1 file changed, 23 insertions(+), 45 deletions(-) diff --git a/src/hyperfiddle/electric/impl/runtime3.cljc b/src/hyperfiddle/electric/impl/runtime3.cljc index 4f40614f0..204f3b315 100644 --- a/src/hyperfiddle/electric/impl/runtime3.cljc +++ b/src/hyperfiddle/electric/impl/runtime3.cljc @@ -26,9 +26,8 @@ (def peer-slot-site 2) (def peer-slot-defs 3) (def peer-slot-remote 4) -(def peer-slot-sub-ready 5) -(def peer-slot-channel-ready 6) -(def peer-slots 7) +(def peer-slot-channel-ready 5) +(def peer-slots 6) (def remote-slot-peer 0) (def remote-slot-events 1) @@ -95,8 +94,7 @@ (def input-sub-slot-prev 3) (def input-sub-slot-next 4) (def input-sub-slot-diff 5) -(def input-sub-slot-ready 6) -(def input-sub-slots 7) +(def input-sub-slots 6) (def call-slot-port 0) (def call-slot-rank 1) @@ -427,19 +425,10 @@ T T T -> (EXPR T) (defn exit [^objects peer busy] (when-not busy - (let [s (aget peer peer-slot-sub-ready) - c (aget peer peer-slot-channel-ready)] - (aset peer peer-slot-sub-ready nil) + (let [c (aget peer peer-slot-channel-ready)] (aset peer peer-slot-channel-ready nil) #?(:clj (.unlock ^ReentrantLock (aget peer peer-slot-busy)) :cljs (aset peer peer-slot-busy false)) - (loop [^objects sub s] - (when-not (nil? sub) - (let [s (aget sub input-sub-slot-ready)] - (aset sub input-sub-slot-ready nil) - ((if-some [step (aget sub input-sub-slot-step)] - step (aget sub input-sub-slot-done))) - (recur s)))) (loop [^objects chan c] (when-not (nil? chan) (let [c (aget chan channel-slot-ready)] @@ -482,10 +471,10 @@ T T T -> (EXPR T) (aset sub input-sub-slot-prev nil) (aset sub input-sub-slot-next nil) (if (nil? (aget sub input-sub-slot-diff)) - (do (aset sub input-sub-slot-ready (aget peer peer-slot-sub-ready)) - (aset peer peer-slot-sub-ready sub)) - (aset sub input-sub-slot-diff nil))) - (exit peer busy))) + (let [step (aget sub input-sub-slot-step)] + (exit peer busy) (step)) + (do (aset sub input-sub-slot-diff nil) + (exit peer busy)))))) (defn input-sub-transfer [^objects sub] (let [^objects input (aget sub input-sub-slot-input) @@ -495,16 +484,14 @@ T T T -> (EXPR T) (if-some [diff (aget sub input-sub-slot-diff)] (do (aset sub input-sub-slot-diff nil) (if (nil? (aget sub input-sub-slot-prev)) - (do (aset sub input-sub-slot-step nil) - (aset sub input-sub-slot-ready (aget peer peer-slot-sub-ready)) - (aset peer peer-slot-sub-ready sub)) - (aset sub input-sub-slot-ready sub)) - (exit peer busy) diff) - (do (aset sub input-sub-slot-step nil) - (aset sub input-sub-slot-ready (aget peer peer-slot-sub-ready)) - (aset peer peer-slot-sub-ready sub) - (exit peer busy) - (throw (Cancelled. "Remote port cancelled.")))))) + (let [done (aget sub input-sub-slot-done)] + (aset sub input-sub-slot-step nil) + (exit peer busy) (done)) + (exit peer busy)) diff) + (let [done (aget sub input-sub-slot-done)] + (aset sub input-sub-slot-step nil) + (exit peer busy) (done) + (throw (Cancelled. "Remote port cancelled.")))))) (deftype InputSub [sub] IFn @@ -595,10 +582,7 @@ T T T -> (EXPR T) (do (aset input input-slot-subs sub) (aset sub input-sub-slot-prev sub) (aset sub input-sub-slot-next sub)))) - (aset sub input-sub-slot-ready (aget peer peer-slot-sub-ready)) - (aset peer peer-slot-sub-ready sub) - (exit peer busy) - (->InputSub sub)))) + (exit peer busy) (step) (->InputSub sub)))) (defn make-port [^Slot slot site deps flow] (let [port (object-array port-slots) @@ -740,12 +724,9 @@ T T T -> (EXPR T) (loop [^objects s sub] (if-some [{:keys [grow degree]} (aget s input-sub-slot-diff)] (aset s input-sub-slot-diff (reset-diff (- degree grow))) - (let [^objects remote (aget input input-slot-remote) - ^objects peer (aget remote remote-slot-peer)] + (let [step (aget s input-sub-slot-step)] (aset s input-sub-slot-diff (reset-diff (:degree (aget input input-slot-diff)))) - (when (identical? s (aget s input-sub-slot-ready)) - (aset s input-sub-slot-ready (aget peer peer-slot-sub-ready)) - (aset peer peer-slot-sub-ready s)))) + (step))) (let [n (aget s input-sub-slot-next)] (when-not (identical? n sub) (recur n))))) (aset input input-slot-diff (i/empty-diff 0))) @@ -819,10 +800,8 @@ T T T -> (EXPR T) (loop [^objects s sub] (if-some [prev (aget s input-sub-slot-diff)] (aset s input-sub-slot-diff (i/combine prev diff)) - (do (aset s input-sub-slot-diff diff) - (when (identical? s (aget s input-sub-slot-ready)) - (aset s input-sub-slot-ready (aget peer peer-slot-sub-ready)) - (aset peer peer-slot-sub-ready s)))) + (let [step (aget s input-sub-slot-step)] + (aset s input-sub-slot-diff diff) (step))) (let [n (aget s input-sub-slot-next)] (when-not (identical? n sub) (recur n)))))) remote) @@ -836,9 +815,8 @@ T T T -> (EXPR T) (aset input input-slot-subs nil) (loop [^objects s sub] (when (nil? (aget s input-sub-slot-diff)) - (aset s input-sub-slot-step nil) - (aset s input-sub-slot-ready (aget peer peer-slot-sub-ready)) - (aset peer peer-slot-sub-ready s)) + (let [done (aget s input-sub-slot-done)] + (aset s input-sub-slot-step nil) (done))) (let [n (aget s input-sub-slot-next)] (aset s input-sub-slot-next nil) (aset s input-sub-slot-prev nil) From 711a7244ce4bd6ec505e864489abf882debad6e5 Mon Sep 17 00:00:00 2001 From: xificurC Date: Tue, 10 Sep 2024 17:52:44 +0200 Subject: [PATCH 54/57] [i/items] orphaned item-ps doesn't step on cancel --- src/hyperfiddle/incseq/items_eager_impl.cljc | 2 +- .../incseq/items_eager_impl_test.cljc | 20 +++++++++++++++++++ 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/src/hyperfiddle/incseq/items_eager_impl.cljc b/src/hyperfiddle/incseq/items_eager_impl.cljc index 9648bec39..8a1447ea8 100644 --- a/src/hyperfiddle/incseq/items_eager_impl.cljc +++ b/src/hyperfiddle/incseq/items_eager_impl.cljc @@ -70,7 +70,7 @@ (#?(: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)))) + (when-not (or (a/getset a -stepped true) cancelled? (= this (a/get a -cache))) (step)))) (#?(:clj invoke :cljs -invoke) [_ v] (when-not (or (= v (a/getset a -cache v)) (a/getset a -stepped true)) (step))) diff --git a/test/hyperfiddle/incseq/items_eager_impl_test.cljc b/test/hyperfiddle/incseq/items_eager_impl_test.cljc index 0005c0be6..5b6b19c61 100644 --- a/test/hyperfiddle/incseq/items_eager_impl_test.cljc +++ b/test/hyperfiddle/incseq/items_eager_impl_test.cljc @@ -680,6 +680,26 @@ _ (q ::none) _ (t/is (= ::none (q)))])) +(t/deftest orphaned-item-ps-doesnt-step-on-cancel + (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) :shrink 1)) + _ (in-step) + _ (t/is (= :item0-done (q))) + _ (t/is (= :items-step (q))) + _ (t/is (= (assoc (d/empty-diff 1) :shrink 1) @items)) + _ (item0) + _ (q ::none) + _ (t/is (= ::none (q)))])) + ;; missing tests ;; - double transfer (optional) ;; - item-ps From f8ec90a4f5fb118653d6222cf36ea354ba3746ac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9o=20NOEL?= Date: Wed, 11 Sep 2024 10:11:06 +0200 Subject: [PATCH 55/57] fix latest-concat protocol violation --- .../incseq/latest_concat_impl.cljc | 3 +- .../incseq/latest_concat_impl_test.cljc | 39 ++++++++++++++++++- 2 files changed, 40 insertions(+), 2 deletions(-) diff --git a/src/hyperfiddle/incseq/latest_concat_impl.cljc b/src/hyperfiddle/incseq/latest_concat_impl.cljc index 20fe00edb..e386ee1fc 100644 --- a/src/hyperfiddle/incseq/latest_concat_impl.cljc +++ b/src/hyperfiddle/incseq/latest_concat_impl.cljc @@ -44,7 +44,8 @@ (do (aset state slot-pending true) (unlock state held) (step)) (if (zero? (aget state slot-alive)) - (do (unlock state held) (done)) + (do (aset state slot-pending true) + (unlock state held) (done)) (unlock state held)))))) (defn outer-ready [^objects state] diff --git a/test/hyperfiddle/incseq/latest_concat_impl_test.cljc b/test/hyperfiddle/incseq/latest_concat_impl_test.cljc index d08d1fe1a..4d7649c35 100644 --- a/test/hyperfiddle/incseq/latest_concat_impl_test.cljc +++ b/test/hyperfiddle/incseq/latest_concat_impl_test.cljc @@ -261,4 +261,41 @@ (is (= (q) :cancel0)) (q false) (step0) - (is (q) :done)))) \ No newline at end of file + (is (q) :done)))) + +(deftest cancel-after-termination + (let [q (queue) + ps ((flow (fn [step done] + (step) + (->Ps #(q :cancel) + (fn [] + (done) + {:grow 1 + :degree 1 + :shrink 0 + :permutation {} + :change {0 (fn [step done] + (step) + (->Ps #(q :cancel0) + (fn [] + (done) + {:grow 1 + :degree 1 + :shrink 0 + :permutation {} + :change {0 :foo} + :freeze #{0}})))} + :freeze #{0}})))) + #(q :step) #(q :done))] + (is (= (q) :step)) + (is (= @ps {:grow 1 + :degree 1 + :shrink 0 + :permutation {} + :change {0 :foo} + :freeze #{0}})) + (is (= (q) :done)) + (ps) + (is (= :cancel (q))) + (is (= :cancel0 (q))) + (is (= (doto :over q) (q))))) \ No newline at end of file From 9f3aa317f1ff662c3cb8e94498b1b20e84f043e2 Mon Sep 17 00:00:00 2001 From: xificurC Date: Wed, 11 Sep 2024 10:19:05 +0200 Subject: [PATCH 56/57] [clj-kondo] updated config --- .clj-kondo/hyperfiddle/electric/config.edn | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.clj-kondo/hyperfiddle/electric/config.edn b/.clj-kondo/hyperfiddle/electric/config.edn index 48b7f0d20..f60547854 100644 --- a/.clj-kondo/hyperfiddle/electric/config.edn +++ b/.clj-kondo/hyperfiddle/electric/config.edn @@ -1,7 +1,7 @@ {:lint-as {hyperfiddle.electric/def clojure.core/def hyperfiddle.electric/defn clojure.core/defn - hyperfiddle.electric-de/defn clojure.core/defn - hyperfiddle.electric-de/cursor clojure.core/for + hyperfiddle.electric3/defn clojure.core/defn + hyperfiddle.electric3/cursor clojure.core/for hyperfiddle.electric/for clojure.core/for hyperfiddle.electric/with-cycle clojure.core/let hyperfiddle.electric/fn clojure.core/fn} From 227deb9c73499c210618bb57b36feb3f9e29c9ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9o=20NOEL?= Date: Thu, 12 Sep 2024 16:58:33 +0200 Subject: [PATCH 57/57] fix unbalanced enter/exit on input unsub --- src/hyperfiddle/electric/impl/runtime3.cljc | 27 +++++++++++---------- test/hyperfiddle/electric3_test.cljc | 10 ++++++++ 2 files changed, 24 insertions(+), 13 deletions(-) diff --git a/src/hyperfiddle/electric/impl/runtime3.cljc b/src/hyperfiddle/electric/impl/runtime3.cljc index 204f3b315..8195fcb62 100644 --- a/src/hyperfiddle/electric/impl/runtime3.cljc +++ b/src/hyperfiddle/electric/impl/runtime3.cljc @@ -462,19 +462,20 @@ T T T -> (EXPR T) ^objects remote (aget input input-slot-remote) ^objects peer (aget remote remote-slot-peer) busy (enter peer)] - (when-some [^objects prv (aget sub input-sub-slot-prev)] - (aset input input-slot-subs - (when-not (identical? prv sub) - (let [^objects nxt (aget sub input-sub-slot-next)] - (aset prv input-sub-slot-next nxt) - (aset nxt input-sub-slot-prev prv)))) - (aset sub input-sub-slot-prev nil) - (aset sub input-sub-slot-next nil) - (if (nil? (aget sub input-sub-slot-diff)) - (let [step (aget sub input-sub-slot-step)] - (exit peer busy) (step)) - (do (aset sub input-sub-slot-diff nil) - (exit peer busy)))))) + (if-some [^objects prv (aget sub input-sub-slot-prev)] + (do (aset input input-slot-subs + (when-not (identical? prv sub) + (let [^objects nxt (aget sub input-sub-slot-next)] + (aset prv input-sub-slot-next nxt) + (aset nxt input-sub-slot-prev prv)))) + (aset sub input-sub-slot-prev nil) + (aset sub input-sub-slot-next nil) + (if (nil? (aget sub input-sub-slot-diff)) + (let [step (aget sub input-sub-slot-step)] + (exit peer busy) (step)) + (do (aset sub input-sub-slot-diff nil) + (exit peer busy)))) + (exit peer busy)))) (defn input-sub-transfer [^objects sub] (let [^objects input (aget sub input-sub-slot-input) diff --git a/test/hyperfiddle/electric3_test.cljc b/test/hyperfiddle/electric3_test.cljc index ba8a9d201..889993bc0 100644 --- a/test/hyperfiddle/electric3_test.cljc +++ b/test/hyperfiddle/electric3_test.cljc @@ -2278,3 +2278,13 @@ (tests "uppercase call convention on locals" (with ((l/single {} (let [X (e/fn [] 1)] (tap (X)))) tap tap) % := 1)) + +(tests + (let [!x (atom true)] + (with ((l/local {} (if (e/watch !x) + (e/server (tap :branch)) + (tap :unmount))) tap tap) + #_init % := :branch + (swap! !x not) % := :unmount + (swap! !x not) % := :branch + (swap! !x not) % := :unmount))) \ No newline at end of file