Memory management benchmark - shedding Eddys

Eddy.fs

(*
This benchmark maintains an array of roots and randomly either pushes
onto them and relinks them or empties them. If I designed it correctly
then this should rapidly create unreachable subgraphs, some of which
are cyclic.

This is a torture test for any kind of reference counting.
*)

type Vertex = { mutable Dst: Vertex }

let search (xs: seq<Vertex>) =
  let s = HashSet HashIdentity.Reference
  let stack = Stack xs
  while stack.Count > 0 do
    let x = stack.Pop()
    if not(s.Contains x) then
      let _ = s.Add x
      stack.Push x.Dst
  s.Count

do
  let make _ =
    let t = { Dst = Unchecked.defaultof<_> }
    t.Dst <- t
    t
  let rand = System.Random 3
  let roots = Array.init 2000 make
  for n in 1..1000000000 do
    let i = rand.Next roots.Length
    let j = rand.Next roots.Length
    if i=j then
      roots.[i] <- make()
    else
      let oi, oj = roots.[i], roots.[j]
      roots.[i] <- { Dst = oj }
      roots.[j] <- { Dst = oi }
    if n % 1000000 = 0 then
      let count = search roots
      printfn "%d %d" (System.GC.GetTotalMemory false) count