From 09e432754f222cb33b2cc6b464c749477089d6ce Mon Sep 17 00:00:00 2001 From: krauthaufen Date: Wed, 23 Sep 2026 07:33:45 +0200 Subject: [PATCH 1/2] custom nodes hold their inputs strongly while up-to-date (#122) Edges are weak, so a node created and read inside a custom compute function was collectable, silently dropping the dependency. IInputHoldingObject lets EvaluateAlways hand each read input to the caller; AVal/ASet/AMap/AList.custom keep them until marked. --- .../AdaptiveHashMap/AdaptiveHashMap.fs | 5 +-- .../AdaptiveHashSet/AdaptiveHashSet.fs | 5 +-- .../AdaptiveIndexList/AdaptiveIndexList.fs | 5 +-- .../AdaptiveValue/AdaptiveValue.fs | 11 +++++ .../Core/AdaptiveObject.fs | 3 ++ src/FSharp.Data.Adaptive/Core/Core.fs | 9 ++++ src/FSharp.Data.Adaptive/Traceable/History.fs | 19 ++++++++ src/Test/FSharp.Data.Adaptive.Tests/AVal.fs | 44 +++++++++++++++++++ 8 files changed, 89 insertions(+), 12 deletions(-) diff --git a/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs b/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs index 8f678a3..a6d5eaa 100644 --- a/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs +++ b/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,HashMapDelta<'Key, 'Value>>(HashMap.trace) with - override x.Compute(t) = - compute t x.State - } + CustomReader,HashMapDelta<'Key, 'Value>>(HashMap.trace, compute) :> IOpReader<_> ) /// Creates an aval providing access to the current content of the map. diff --git a/src/FSharp.Data.Adaptive/AdaptiveHashSet/AdaptiveHashSet.fs b/src/FSharp.Data.Adaptive/AdaptiveHashSet/AdaptiveHashSet.fs index 0d23a23..002f038 100644 --- a/src/FSharp.Data.Adaptive/AdaptiveHashSet/AdaptiveHashSet.fs +++ b/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,HashSetDelta<'a>>(CountingHashSet.trace) with - override x.Compute(t) = - compute t x.State - } + CustomReader,HashSetDelta<'a>>(CountingHashSet.trace, compute) :> IOpReader<_> ) /// The empty aset. diff --git a/src/FSharp.Data.Adaptive/AdaptiveIndexList/AdaptiveIndexList.fs b/src/FSharp.Data.Adaptive/AdaptiveIndexList/AdaptiveIndexList.fs index 62c6515..1b45bf5 100644 --- a/src/FSharp.Data.Adaptive/AdaptiveIndexList/AdaptiveIndexList.fs +++ b/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,IndexListDelta<'a>>(IndexList.trace) with - override x.Compute(t) = - compute t x.State - } + CustomReader,IndexListDelta<'a>>(IndexList.trace, compute) :> IOpReader<_> ) diff --git a/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fs b/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fs index 61dceff..09d912d 100644 --- a/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fs +++ b/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fs @@ -404,9 +404,20 @@ 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() + override x.Compute(token: AdaptiveToken) = + inputs.Clear() 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 diff --git a/src/FSharp.Data.Adaptive/Core/AdaptiveObject.fs b/src/FSharp.Data.Adaptive/Core/AdaptiveObject.fs index e146e36..60e0f36 100644 --- a/src/FSharp.Data.Adaptive/Core/AdaptiveObject.fs +++ b/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 diff --git a/src/FSharp.Data.Adaptive/Core/Core.fs b/src/FSharp.Data.Adaptive/Core/Core.fs index 1a4cae9..9a4b00f 100644 --- a/src/FSharp.Data.Adaptive/Core/Core.fs +++ b/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 diff --git a/src/FSharp.Data.Adaptive/Traceable/History.fs b/src/FSharp.Data.Adaptive/Traceable/History.fs index 63670dc..1fbee53 100644 --- a/src/FSharp.Data.Adaptive/Traceable/History.fs +++ b/src/FSharp.Data.Adaptive/Traceable/History.fs @@ -67,6 +67,25 @@ 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). +[] +type internal CustomReader<'State, 'Delta>(trace: Traceable<'State, 'Delta>, compute : AdaptiveToken -> 'State -> 'Delta) = + inherit AbstractReader<'State, 'Delta>(trace) + + let inputs = System.Collections.Generic.List() + + override x.Compute(token) = + inputs.Clear() + 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. [] type AbstractDirtyReader<'T, 'Delta when 'T :> IAdaptiveObject>(t: Monoid<'Delta>, take : obj -> bool) = diff --git a/src/Test/FSharp.Data.Adaptive.Tests/AVal.fs b/src/Test/FSharp.Data.Adaptive.Tests/AVal.fs index 8e5314e..31cb37a 100644 --- a/src/Test/FSharp.Data.Adaptive.Tests/AVal.fs +++ b/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) + +[] +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) -> + 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) -> + 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) From f5afa7b6a6fd5f8b35410f375527b3040147a61f Mon Sep 17 00:00:00 2001 From: krauthaufen Date: Wed, 23 Sep 2026 14:11:31 +0200 Subject: [PATCH 2/2] inputs are cleared on Mark only --- src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fs | 1 - src/FSharp.Data.Adaptive/Traceable/History.fs | 1 - 2 files changed, 2 deletions(-) diff --git a/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fs b/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fs index 09d912d..4aa3d0a 100644 --- a/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fs +++ b/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fs @@ -408,7 +408,6 @@ module AVal = let inputs = System.Collections.Generic.List() override x.Compute(token: AdaptiveToken) = - inputs.Clear() compute token override x.MarkObject() = diff --git a/src/FSharp.Data.Adaptive/Traceable/History.fs b/src/FSharp.Data.Adaptive/Traceable/History.fs index 1fbee53..d517e1d 100644 --- a/src/FSharp.Data.Adaptive/Traceable/History.fs +++ b/src/FSharp.Data.Adaptive/Traceable/History.fs @@ -76,7 +76,6 @@ type internal CustomReader<'State, 'Delta>(trace: Traceable<'State, 'Delta>, com let inputs = System.Collections.Generic.List() override x.Compute(token) = - inputs.Clear() compute token x.State override x.MarkObject() =