Custom nodes hold their inputs strongly while up-to-date

src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs

@@ -1280,10 +1280,7 @@ module AMap =
     /// Creates an amap using the given compute function
     let custom (compute : AdaptiveToken -> HashMap<'Key, 'Value> -> HashMapDelta<'Key, 'Value>) : amap<'Key, 'Value> = 
         ofReader (fun () -> 
-            { new AbstractReader<HashMap<'Key, 'Value>,HashMapDelta<'Key, 'Value>>(HashMap.trace) with
-                override x.Compute(t) = 
-                    compute t x.State
-            }
+            CustomReader<HashMap<'Key, 'Value>,HashMapDelta<'Key, 'Value>>(HashMap.trace, compute) :> IOpReader<_>
         )
 
     /// Creates an aval providing access to the current content of the map.

src/FSharp.Data.Adaptive/AdaptiveHashSet/AdaptiveHashSet.fs

@@ -1277,10 +1277,7 @@ module ASet =
     /// Creates an aset using the given compute function
     let custom (compute : AdaptiveToken -> CountingHashSet<'a> -> HashSetDelta<'a>) : aset<'a> = 
         ofReader (fun () -> 
-            { new AbstractReader<CountingHashSet<'a>,HashSetDelta<'a>>(CountingHashSet.trace) with
-                override x.Compute(t) = 
-                    compute t x.State
-            }
+            CustomReader<CountingHashSet<'a>,HashSetDelta<'a>>(CountingHashSet.trace, compute) :> IOpReader<_>
         )
 
     /// The empty aset.

src/FSharp.Data.Adaptive/AdaptiveIndexList/AdaptiveIndexList.fs

@@ -1343,10 +1343,7 @@ module AList =
     /// Creates an alist using the given compute function
     let custom (compute : AdaptiveToken -> IndexList<'a> -> IndexListDelta<'a>) : alist<'a> = 
         ofReader (fun () -> 
-            { new AbstractReader<IndexList<'a>,IndexListDelta<'a>>(IndexList.trace) with
-                override x.Compute(t) = 
-                    compute t x.State
-            }
+            CustomReader<IndexList<'a>,IndexListDelta<'a>>(IndexList.trace, compute) :> IOpReader<_>
         )
 
 

src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fs

@@ -404,9 +404,19 @@ module AVal =
     type CustomVal<'T>(compute: AdaptiveToken -> 'T) =
         inherit AbstractVal<'T>()
 
+        // inputs read by the last evaluation, held strongly until we are marked again.
+        let inputs = System.Collections.Generic.List<IAdaptiveObject>()
+
         override x.Compute(token: AdaptiveToken) =
             compute token
 
+        override x.MarkObject() =
+            inputs.Clear()
+            true
+
+        interface IInputHoldingObject with
+            member x.AddInput i = inputs.Add i
+
     let inline force (value: aval<'T>) =
         value.GetValue AdaptiveToken.Top
 

src/FSharp.Data.Adaptive/Core/AdaptiveObject.fs

@@ -174,6 +174,9 @@ module AdadptiveObjectExtensions =
                 if not (Unchecked.isNull caller) then
                     x.Outputs.Add caller |> ignore
                     caller.Level <- max caller.Level (x.Level + 1)
+                    match caller with
+                    | :? IInputHoldingObject as r -> r.AddInput x
+                    | _ -> ()
 
             with _ ->
                 AdaptiveObject.UnsafeEvaluationDepth <- depth

src/FSharp.Data.Adaptive/Core/Core.fs

@@ -75,6 +75,15 @@ and IWeakOutputSet =
     /// Clears the set.
     abstract member Clear : unit -> unit
 
+/// Implemented by adaptive objects that strongly retain the inputs they read while
+/// they are up-to-date. Dependency edges are weak (Outputs only), so a node that reads
+/// something it created during its own evaluation (e.g. inside AVal.custom) would
+/// otherwise lose that input to the GC and silently stop being marked.
+/// AddInput is called by the input from within EvaluateAlways; the caller's monitor
+/// is held there by convention, so implementations need no locking.
+and IInputHoldingObject =
+    abstract member AddInput : IAdaptiveObject -> unit
+
 #if FABLE_COMPILER
 
 /// Represents a set of outputs for an AdaptiveObject. The references to all

src/FSharp.Data.Adaptive/Traceable/History.fs

@@ -67,6 +67,24 @@ type AbstractReader<'State, 'Delta>(trace: Traceable<'State, 'Delta>) =
         member x.Trace = trace
         member x.State = state
 
+/// Reader for user-supplied compute functions (ASet/AMap/AList.custom): strongly retains
+/// the inputs read by the last Compute until the reader is marked again (see IInputHoldingObject).
+[<Sealed>]
+type internal CustomReader<'State, 'Delta>(trace: Traceable<'State, 'Delta>, compute : AdaptiveToken -> 'State -> 'Delta) =
+    inherit AbstractReader<'State, 'Delta>(trace)
+
+    let inputs = System.Collections.Generic.List<IAdaptiveObject>()
+
+    override x.Compute(token) =
+        compute token x.State
+
+    override x.MarkObject() =
+        inputs.Clear()
+        true
+
+    interface IInputHoldingObject with
+        member x.AddInput i = inputs.Add i
+
 /// Abstract base class for implementing IOpReader<_> when dirty inputs are needed on evaluation.
 [<AbstractClass>]
 type AbstractDirtyReader<'T, 'Delta when 'T :> IAdaptiveObject>(t: Monoid<'Delta>, take : obj -> bool) =

src/Test/FSharp.Data.Adaptive.Tests/AVal.fs

@@ -315,3 +315,47 @@ let ``[AVal] multi map non-adaptive and bind``() =
 
     transact (fun () -> v.Value <- false)
     output |> AVal.force |> should equal 1
+
+
+// https://github.com/fsprojects/FSharp.Data.Adaptive/issues/122
+// a custom node reading a node it created during its own evaluation must keep
+// that node alive (inputs are only referenced weakly via Outputs).
+let private collect() =
+    System.GC.Collect(3)
+    System.GC.WaitForFullGCComplete() |> ignore
+    System.GC.WaitForPendingFinalizers()
+    System.GC.Collect(3)
+
+[<Test>]
+let ``[AVal] custom retains nodes created during evaluation``() =
+    let source = cval 1
+    let nestedMap = AVal.custom (fun t -> (source |> AVal.map (fun v -> v * 10)).GetValue t)
+    let nestedCustom = AVal.custom (fun t -> (AVal.custom (fun t -> source.GetValue t * 10)).GetValue t)
+    let nestedSet = AVal.custom (fun t -> (source |> AVal.map (fun v -> v * 10) |> ASet.bind ASet.single).Content.GetValue t |> HashSet.toList |> List.head)
+    let nestedList = AVal.custom (fun t -> (source |> AVal.map (fun v -> v * 10) |> AList.bind AList.single).Content.GetValue t |> IndexList.toList |> List.head)
+    let nestedMapCustom =
+        AMap.custom (fun t _ -> (source |> AVal.map (fun v -> v * 10)).GetValue t |> fun v -> HashMapDelta.ofList [1, Set v])
+        |> AMap.tryFind 1 |> AVal.map Option.get
+    let nestedSetCustom =
+        ASet.custom (fun t (s : CountingHashSet<int>) ->
+            let v = (source |> AVal.map (fun v -> v * 10)).GetValue t
+            HashSetDelta.combine (CountingHashSet.removeAll s) (HashSetDelta.single (Add v)))
+        |> ASet.toAVal |> AVal.map (HashSet.toList >> List.head)
+    let nestedListCustom =
+        AList.custom (fun t (l : IndexList<int>) ->
+            let v = (source |> AVal.map (fun v -> v * 10)).GetValue t
+            IndexListDelta.combine (IndexList.computeDelta l IndexList.empty) (IndexListDelta.single Index.zero (Set v)))
+        |> AList.toAVal |> AVal.map (IndexList.toList >> List.head)
+
+    let all = [ "map in custom", nestedMap; "custom in custom", nestedCustom; "aset in custom", nestedSet; "alist in custom", nestedList
+                "aval in AMap.custom", nestedMapCustom; "aval in ASet.custom", nestedSetCustom; "aval in AList.custom", nestedListCustom ]
+
+    for (_, a) in all do AVal.force a |> should equal 10
+    collect()
+    transact (fun () -> source.Value <- 2)
+    for (name, a) in all do
+        a.OutOfDate |> should be True
+        (name, AVal.force a) |> should equal (name, 20)
+    collect()
+    transact (fun () -> source.Value <- 3)
+    for (name, a) in all do (name, AVal.force a) |> should equal (name, 30)