Ocaml vs .NET Performance

General
1

I became interested functor module of ocaml and wrote small program within:

module type ORDERED = sig
  type t
  val compare : t -> t -> int
end

module MakeSet (Elt : ORDERED) = struct
  type elt = Elt.t
  type t = elt list      (* упорядоченный список без дублей *)

  let empty = []

  let rec add x = function
    | [] -> [x]
    | y :: rest as s ->
      let c = Elt.compare x y in
      if c = 0 then s                  (* уже есть *)
      else if c < 0 then x :: s        (* вставка перед y *)
      else y :: add x rest

  let mem x s = List.exists (fun y -> Elt.compare x y = 0) s
end

module IntOrd = struct
  type t = int
  let compare = compare    (* стандартное сравнение *)
end

module IntSet = MakeSet (IntOrd)

let rec loop n xs =
  if n < 1 then xs else loop (n - 1) (IntSet.add n xs)

let n = 10_000_000
let x = loop n IntSet.empty
let b = IntSet.mem n x
let () = Printf.printf "%b\ndone\n" b


let empty = []

let inline compare<'t when 't :> System.IComparable> (a: 't, b: 't) = a.CompareTo(b)

let rec add x =
    function
    | [] -> [ x ]
    | y :: rest as s ->
        let c = compare (x, y) in

        if c = 0 then
            s (* уже есть *)
        else if c < 0 then
            x :: s (* вставка перед y *)
        else
            y :: add x rest

let mem x s =
    List.exists (fun y -> compare (x, y) = 0) s

let rec loop n xs =
    if n < 1 then
        xs
    else
        loop (n - 1) (add n xs)

let n = 10_000_000

let x = loop n empty
let b = mem n x
do printf "%b\ndone\n" b

Measure-Command { & .\Test.exe } - 4-6 sec (target mscorlib)

Measure-Command { & .\camlprog.exe } - 2 sec

Why? Can I something change to reach ocaml performance?

2

I’m guessing the main contributor to the performance difference is the F# version currently boxing arguments passed to CompareTo():

let inline compare<'t when 't :> System.IComparable> (a: 't, b: 't) = a.CompareTo(b)

IComparable.CompareTo() takes an object. The argument passed (in this case an int) needs to be boxed before the comparison is done.

Looking at the IL confirms this:

ldarg.1
box !!T
constrained. !!T
callvirt instance int32 System.IComparable::CompareTo(object)

If you change the compare line to…

let inline compare<'t when 't :> IComparable<'t>> (a: 't, b: 't) = a.CompareTo(b)

… then you can avoid the boxing penalty in this case.

IL confirmation (note the absent box !!T):

ldarga.s a
ldarg.1
constrained. !!T
callvirt instance int32 System.IComparable`1<!!T>::CompareTo(!0)

I ran a quick benchmark using .NET 10, and here’s what I got comparing the boxed vs non-boxed versions:

Method Mean Error StdDev Ratio RatioSD Gen0 Gen1 Gen2 Allocated Alloc Ratio
Original 2,057.2 ms 62.33 ms 32.60 ms 1.00 0.02 150000.0000 49000.0000 5000.0000 762.9 MB 1.00
GenericComparable 757.2 ms 15.63 ms 8.18 ms 0.37 0.01 54000.0000 28000.0000 3000.0000 305.18 MB 0.40
Full benchmarking code 
open System
open BenchmarkDotNet.Attributes
open BenchmarkDotNet.Running

module Original =

    let empty: int list = []

    let inline compare<'T when 'T :> IComparable> (a: 'T, b: 'T) = a.CompareTo(b)

    let rec add x =
        function
        | [] -> [ x ]
        | y :: rest as s ->
            let c = compare (x, y)

            if c = 0 then s
            elif c < 0 then x :: s
            else y :: add x rest

    let mem x s =
        List.exists (fun y -> compare (x, y) = 0) s

    let rec loop n xs =
        if n < 1 then xs else loop (n - 1) (add n xs)

    let run n =
        let x = loop n empty
        mem n x

module GenericComparable =

    let empty: int list = []

    // Generic IComparable<T>; CompareTo takes T rather than obj.
    let inline compare<'T when 'T :> IComparable<'T>> (a: 'T, b: 'T) = a.CompareTo(b)

    let rec add x =
        function
        | [] -> [ x ]
        | y :: rest as s ->
            let c = compare (x, y)

            if c = 0 then s
            elif c < 0 then x :: s
            else y :: add x rest

    let mem x s =
        List.exists (fun y -> compare (x, y) = 0) s

    let rec loop n xs =
        if n < 1 then xs else loop (n - 1) (add n xs)

    let run n =
        let x = loop n empty
        mem n x

[<MemoryDiagnoser>]
[<SimpleJob (launchCount = 1, warmupCount = 3, iterationCount = 10, invocationCount = 1)>]
type CompareBenchmarks () =

    let n = 10_000_000

    [<Benchmark(Baseline = true)>]
    member _.Original() = Original.run n

    [<Benchmark>]
    member _.GenericComparable() = GenericComparable.run n

[<EntryPoint>]
let main _ =
    BenchmarkRunner.Run<CompareBenchmarks>() |> ignore

    0
3

OMG! Thank you very much. Very small detail but very important!