[i/items] reentrant input transfer

hyperfiddle · Aug 28, 2024 · 29b45ec · 29b45ec
1 parent d811cc4
commit 29b45ec
Show file tree

Hide file tree

Showing 2 changed files with 34 additions and 19 deletions.
diff --git 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
@@ -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