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