https://github.com/scalajp/javaone-tokyo-2012-jvm-bof/blob/master/src/main/scala/org/scala_users/jp/bench/immutable.scala のコードをF#にほとんどそのまま書き写してみた

gistfile1.fs

type Color = Red | Black

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module internal Color =
  let height = function Red -> 0 | Black -> 1

type Entry = { Key: string; Value: string }

type RBTree =
  | Empty
  | Node of Color * RBTree * Entry * RBTree

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module RBTree =
  let rec get key = function
  | Empty -> failwith "oops!"
  | Node (_, left, entry, _) when key < entry.Key -> get key left
  | Node (_, _, entry, right) when entry.Key < key -> get key right
  | Node (_, _, entry, _) -> entry.Value

  let private balance = function
  | Black, Node (Red, Node (Red, a, x, b), y, c), z, d
  | Black, Node (Red, a, x, Node (Red, b, y, c)), z, d
  | Black, a, x, Node (Red, Node (Red, b, y, c), z, d)
  | Black, a, x, Node (Red, b, y, Node (Red, c, z, d)) ->
      Node (Red, Node (Black, a, x, b), y, Node (Black, c, z, d))
  | c, l, e, r -> Node (c, l, e, r)

  let rec private ins key value = function
  | Empty -> Node (Red, Empty, { Key = key; Value = value }, Empty)
  | Node (color, left, entry, right) when key < entry.Key ->
      balance(color, ins key value left, entry, right)
  | Node (color, left, entry, right) when entry.Key < key ->
      balance(color, left, entry, ins key value right)
  | Node (color, left, entry, right) ->
      Node (color, left, { Key = key; Value = value }, right)

  let put (key, value) tree =
    match ins key value tree with Node (_, l, e, r) -> Node (Black, l, e, r) | _ -> failwith "oops!"

  let rec height = function
  | Empty -> 0
  | Node (color, left, _, right) -> Color.height color + (max (height left) (height right))

type RBTreeMap = { mutable Root: RBTree }
with
  static member NewInstance () = { Root = Empty }
  static member Create xs = { Root = List.fold (fun tree x -> tree |> RBTree.put x) Empty xs }
  member this.Get(key) = this.Root |> RBTree.get key
  member this.Put(key, value) = this.Root <- this.Root |> RBTree.put (key, value); this
  member this.Height = this.Root |> RBTree.height
  override this.ToString() = sprintf "%A" this