Skip to content

Commit 99682f4

Browse files
krauthaufenkrauthaufen
committed
* improved ABag sketch
1 parent c0da2ef commit 99682f4

1 file changed

Lines changed: 117 additions & 37 deletions

File tree

‎src/Demo/Scratch/ABag.fs‎

Lines changed: 117 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -4,32 +4,56 @@ open System.Collections.Generic
44
open FSharp.Data.Adaptive
55
open FSharp.Data.Traceable
66

7-
module Unique =
8-
let mutable private currentId = 0L
7+
[<Struct; CustomEquality; CustomComparison>]
8+
type Unique private(value : int64) =
9+
static let mutable currentId = 0L
10+
member private x.Value = value
911

10-
let newId() =
11-
System.Threading.Interlocked.Increment(&currentId)
12+
override x.GetHashCode() = hash value
13+
override x.Equals o =
14+
match o with
15+
| :? Unique as o -> value = o.Value
16+
| _ -> false
17+
18+
override x.ToString() = sprintf "U%04X" value
19+
20+
member x.CompareTo (o : Unique) =
21+
compare value o.Value
22+
23+
interface System.IComparable with
24+
member x.CompareTo o = x.CompareTo (o :?> Unique)
25+
26+
member x.Equals (o : Unique) =
27+
value = o.Value
28+
29+
static member Invalid = Unique(0L)
30+
31+
member x.IsValid = value <> 0L
32+
member x.IsInvalid = value = 0L
33+
34+
static member New() =
35+
Unique(System.Threading.Interlocked.Increment(&currentId))
1236

1337
type IAdaptiveBag<'T> =
1438
/// Is the list constant?
1539
abstract member IsConstant : bool
1640

1741
/// The current content of the list as aval.
18-
abstract member Content : aval<HashMap<int64, 'T>>
42+
abstract member Content : aval<HashMap<Unique, 'T>>
1943

2044
/// Gets a new reader to the list.
2145
abstract member GetReader : unit -> IAdaptiveBagReader<'T>
2246

2347
/// Gets the underlying History instance for the alist (if any)
24-
abstract member History : option<History<HashMap<int64, 'T>, HashMapDelta<int64, 'T>>>
48+
abstract member History : option<History<HashMap<Unique, 'T>, HashMapDelta<Unique, 'T>>>
2549

26-
and IAdaptiveBagReader<'T> = IOpReader<HashMap<int64, 'T>, HashMapDelta<int64, 'T>>
50+
and IAdaptiveBagReader<'T> = IOpReader<HashMap<Unique, 'T>, HashMapDelta<Unique, 'T>>
2751

2852
and abag<'T> = IAdaptiveBag<'T>
2953

3054
module ABag =
3155

32-
type AdaptiveBag<'T>(getReader : unit -> IOpReader<HashMapDelta<int64, 'T>>) =
56+
type AdaptiveBag<'T>(getReader : unit -> IOpReader<HashMapDelta<Unique, 'T>>) =
3357

3458
let history = new History<_,_>(getReader, HashMap.trace, ignore)
3559

@@ -46,7 +70,7 @@ module ABag =
4670
member x.Content =
4771
history :> aval<_>
4872

49-
type ConstantBag<'T>(content : Lazy<HashMap<int64, 'T>>) =
73+
type ConstantBag<'T>(content : Lazy<HashMap<Unique, 'T>>) =
5074

5175
let initialDelta =
5276
lazy (
@@ -68,19 +92,19 @@ module ABag =
6892
ConstantBag<'T>(
6993
lazy (
7094
content
71-
|> Seq.map (fun e -> Unique.newId(), e)
95+
|> Seq.map (fun e -> Unique.New(), e)
7296
|> HashMap.ofSeq
7397
)
7498
)
7599

76100
type private IdCache<'a>() =
77-
let table = DefaultDictionary.create<'a, int64>()
101+
let table = DefaultDictionary.create<'a, Unique>()
78102

79103
member x.Invoke(value : 'a) =
80104
match table.TryGetValue value with
81105
| (true, id) -> id
82106
| _ ->
83-
let id = Unique.newId()
107+
let id = Unique.New()
84108
table.[value] <- id
85109
id
86110

@@ -97,15 +121,24 @@ module ABag =
97121
table.Remove value |> ignore
98122
id
99123

100-
let ofReader (create : unit -> #IOpReader<HashMapDelta<int64, 'T>>) =
101-
AdaptiveBag(fun () -> create() :> IOpReader<_>) :> abag<_>
102-
103124
let private constantSeq (seq : unit -> seq<'T>) =
104125
ConstantBag(Seq.delay seq) :> abag<_>
105126

106-
let private constantMap (seq : unit -> HashMap<int64, 'T>) =
127+
let private constantMap (seq : unit -> HashMap<Unique, 'T>) =
107128
ConstantBag(lazy(seq())) :> abag<_>
108129

130+
let ofReader (create : unit -> #IOpReader<HashMapDelta<Unique, 'T>>) =
131+
AdaptiveBag(fun () -> create() :> IOpReader<_>) :> abag<_>
132+
133+
let ofSeq (seq : seq<'T>) =
134+
constantSeq (fun () -> seq)
135+
136+
let ofList (list : list<'T>) =
137+
constantSeq (fun () -> list)
138+
139+
let ofArray (arr : 'T[]) =
140+
constantSeq (fun () -> arr)
141+
109142
let ofASet (set : aset<'T>) =
110143
if set.IsConstant then
111144
constantSeq <| fun () -> set.Content |> AVal.force :> seq<_>
@@ -128,7 +161,7 @@ module ABag =
128161
) :> IOpReader<_>
129162
| None ->
130163
let r = set.GetReader()
131-
{ new AbstractReader<HashMapDelta<int64, 'T>>(HashMapDelta.empty) with
164+
{ new AbstractReader<HashMapDelta<Unique, 'T>>(HashMapDelta.empty) with
132165
member x.Compute(token : AdaptiveToken) =
133166
let ops = r.GetChanges token
134167
let mutable delta = HashMap.empty
@@ -167,7 +200,7 @@ module ABag =
167200
) :> IOpReader<_>
168201
| None ->
169202
let r = list.GetReader()
170-
{ new AbstractReader<HashMapDelta<int64, 'T>>(HashMapDelta.empty) with
203+
{ new AbstractReader<HashMapDelta<Unique, 'T>>(HashMapDelta.empty) with
171204
member x.Compute(token : AdaptiveToken) =
172205
let ops = r.GetChanges token
173206
let mutable delta = HashMap.empty
@@ -184,7 +217,6 @@ module ABag =
184217
HashMapDelta delta
185218
} :> IOpReader<_>
186219

187-
188220
let mapAMap (mapping : 'K -> 'V -> 'T) (map : amap<'K, 'V>) =
189221
if map.IsConstant then
190222
constantSeq <| fun () -> map.Content |> AVal.force |> Seq.map (fun (k,v) -> mapping k v) :> seq<_>
@@ -211,7 +243,7 @@ module ABag =
211243
history.NewReader(HashMap.trace, mapDelta) :> IOpReader<_>
212244
| None ->
213245
let r = map.GetReader()
214-
{ new AbstractReader<HashMapDelta<int64, 'T>>(HashMapDelta.empty) with
246+
{ new AbstractReader<HashMapDelta<Unique, 'T>>(HashMapDelta.empty) with
215247
member x.Compute(token : AdaptiveToken) =
216248
r.GetChanges token
217249
|> mapDelta
@@ -230,7 +262,7 @@ module ABag =
230262
if bag.IsConstant then
231263
constantMap <| fun () -> bag.Content |> AVal.force |> HashMap.map (fun _ v -> mapping v)
232264
else
233-
let inline mapDelta (ops : HashMapDelta<int64, 'T>) =
265+
let inline mapDelta (ops : HashMapDelta<Unique, 'T>) =
234266
ops
235267
|> HashMapDelta.toHashMap
236268
|> HashMap.map (fun k op ->
@@ -246,7 +278,7 @@ module ABag =
246278
history.NewReader(HashMap.trace, mapDelta) :> IOpReader<_>
247279
| None ->
248280
let r = bag.GetReader()
249-
{ new AbstractReader<HashMapDelta<int64, 'U>>(HashMapDelta.empty) with
281+
{ new AbstractReader<HashMapDelta<Unique, 'U>>(HashMapDelta.empty) with
250282
member x.Compute(token : AdaptiveToken) =
251283
r.GetChanges token
252284
|> mapDelta
@@ -259,7 +291,7 @@ module ABag =
259291
ofReader <| fun () ->
260292
let mutable existing = HashSet.empty
261293

262-
let inline mapDelta (ops : HashMapDelta<int64, 'T>) =
294+
let inline mapDelta (ops : HashMapDelta<Unique, 'T>) =
263295
ops
264296
|> HashMapDelta.toHashMap
265297
|> HashMap.choose (fun k op ->
@@ -291,12 +323,57 @@ module ABag =
291323
history.NewReader(HashMap.trace, mapDelta) :> IOpReader<_>
292324
| None ->
293325
let r = bag.GetReader()
294-
{ new AbstractReader<HashMapDelta<int64, 'U>>(HashMapDelta.empty) with
326+
{ new AbstractReader<HashMapDelta<Unique, 'U>>(HashMapDelta.empty) with
295327
member x.Compute(token : AdaptiveToken) =
296328
r.GetChanges token
297329
|> mapDelta
298330
} :> IOpReader<_>
299-
331+
332+
let filter (predicate : 'T -> bool) (bag : abag<'T>) =
333+
if bag.IsConstant then
334+
constantMap <| fun () -> bag.Content |> AVal.force |> HashMap.filter (fun _ v -> predicate v)
335+
else
336+
ofReader <| fun () ->
337+
let mutable existing = HashSet.empty
338+
339+
let inline mapDelta (ops : HashMapDelta<Unique, 'T>) =
340+
ops
341+
|> HashMapDelta.toHashMap
342+
|> HashMap.choose (fun k op ->
343+
match op with
344+
| Set v ->
345+
match predicate v with
346+
| true ->
347+
existing <- HashSet.add k existing
348+
Some (Set v)
349+
| false ->
350+
match HashSet.tryRemove k existing with
351+
| Some n ->
352+
existing <- n
353+
Some Remove
354+
| None ->
355+
None
356+
| Remove ->
357+
match HashSet.tryRemove k existing with
358+
| Some n ->
359+
existing <- n
360+
Some Remove
361+
| None ->
362+
None
363+
)
364+
|> HashMapDelta.ofHashMap
365+
366+
match bag.History with
367+
| Some history ->
368+
history.NewReader(HashMap.trace, mapDelta) :> IOpReader<_>
369+
| None ->
370+
let r = bag.GetReader()
371+
{ new AbstractReader<HashMapDelta<Unique, 'T>>(HashMapDelta.empty) with
372+
member x.Compute(token : AdaptiveToken) =
373+
r.GetChanges token
374+
|> mapDelta
375+
} :> IOpReader<_>
376+
300377
let unionMany' (bags : #seq<abag<'a>>) =
301378
let bags =
302379
match bags :> seq<_> with
@@ -312,8 +389,8 @@ module ABag =
312389
else
313390
ofReader <| fun () ->
314391
let readers = bags |> Array.map (fun b -> b.GetReader())
315-
let caches = Array.init bags.Length (fun _ -> IdCache<int64>())
316-
{ new AbstractReader<HashMapDelta<int64, 'a>>(HashMapDelta.empty) with
392+
let caches = Array.init bags.Length (fun _ -> IdCache<Unique>())
393+
{ new AbstractReader<HashMapDelta<Unique, 'a>>(HashMapDelta.empty) with
317394
member x.Compute(token : AdaptiveToken) =
318395
let mutable res = HashMap.empty
319396

@@ -346,13 +423,13 @@ module ABag =
346423
else
347424
ofReader <| fun () ->
348425
let reader = bag.GetReader()
349-
let mutable readers = HashMap.empty<int64, abag<'b> * IOpReader<HashMap<int64, 'b>, HashMapDelta<int64, 'b>>>
426+
let mutable readers = HashMap.empty<Unique, abag<'b> * IOpReader<HashMap<Unique, 'b>, HashMapDelta<Unique, 'b>>>
350427
let dirty = ref <| System.Collections.Generic.HashSet()
351428

352-
{ new AbstractReader<HashMapDelta<int64, 'b>>(HashMapDelta.empty) with
429+
{ new AbstractReader<HashMapDelta<Unique, 'b>>(HashMapDelta.empty) with
353430
member x.InputChangedObject(_, o) =
354431
match o with
355-
| :? IOpReader<HashMap<int64, 'b>, HashMapDelta<int64, 'b>> as r when not (System.Object.ReferenceEquals(r, reader)) ->
432+
| :? IOpReader<HashMap<Unique, 'b>, HashMapDelta<Unique, 'b>> as r when not (System.Object.ReferenceEquals(r, reader)) ->
356433
lock dirty (fun () -> dirty.Value.Add r |> ignore)
357434
| _ ->
358435
()
@@ -372,7 +449,7 @@ module ABag =
372449

373450
let inline newReader() =
374451
let newReader = newbag.GetReader()
375-
let newCache = IdCache<int64>()
452+
let newCache = IdCache<Unique>()
376453
newReader.Tag <- newCache
377454
dirty.Add newReader |> ignore
378455
readers <- HashMap.add lid (newbag, newReader) readers
@@ -387,7 +464,7 @@ module ABag =
387464
// 1. remove the old reader
388465
// 2. add a new reader
389466
readers <- rest
390-
let oldCache = oldReader.Tag :?> IdCache<int64>
467+
let oldCache = oldReader.Tag :?> IdCache<Unique>
391468
dirty.Remove oldReader |> ignore
392469
oldReader.Outputs.Remove x |> ignore
393470
for oid, _ in oldReader.State do
@@ -404,7 +481,7 @@ module ABag =
404481
| Remove ->
405482
match HashMap.tryRemove lid readers with
406483
| Some((_, oldReader), rest) ->
407-
let oldCache = oldReader.Tag :?> IdCache<int64>
484+
let oldCache = oldReader.Tag :?> IdCache<Unique>
408485
readers <- rest
409486
dirty.Remove oldReader |> ignore
410487
oldReader.Outputs.Remove x |> ignore
@@ -416,7 +493,7 @@ module ABag =
416493
()
417494

418495
for d in dirty do
419-
let cache = d.Tag :?> IdCache<int64>
496+
let cache = d.Tag :?> IdCache<Unique>
420497
let ops = d.GetChanges token
421498
for oid, op in ops do
422499
match op with
@@ -432,6 +509,9 @@ module ABag =
432509
HashMapDelta.ofHashMap delta
433510
}
434511

512+
let unionMany (bags : abag<abag<'T>>) =
513+
bags |> collect id
514+
435515
let toASet (bag : abag<'a>) =
436516
if bag.IsConstant then
437517
ASet.delay (fun () -> bag.Content |> AVal.force |> HashMap.toValueSeq |> HashSet.ofSeq)
@@ -484,8 +564,8 @@ module ABag =
484564
)
485565
AList.ofReader <| fun () ->
486566
let r = bag.GetReader()
487-
let indices = CustomIndexMapping<struct(int64 * 'b)>(cmpt)
488-
let mutable cache = HashMap.empty<int64, 'b>
567+
let indices = CustomIndexMapping<struct(Unique * 'b)>(cmpt)
568+
let mutable cache = HashMap.empty<Unique, 'b>
489569
{ new AbstractReader<IndexListDelta<'a>>(IndexListDelta.empty) with
490570
member x.Compute(token : AdaptiveToken) =
491571
let ops = r.GetChanges token
@@ -532,7 +612,7 @@ module ABag =
532612

533613
AList.ofReader <| fun () ->
534614
let r = bag.GetReader()
535-
let indices = CustomIndexMapping<struct(int64 * 'a)>(cmpt)
615+
let indices = CustomIndexMapping<struct(Unique * 'a)>(cmpt)
536616
{ new AbstractReader<IndexListDelta<'a>>(IndexListDelta.empty) with
537617
member x.Compute(token : AdaptiveToken) =
538618
let old = r.State

0 commit comments

Comments
 (0)