Efficient comparison chaining

chain_compare.ml

type _ compare =
| Int: int compare
| Float: float compare
| Poly: 'a compare

let[@inline always] typed_compare (type a) (w:a compare) (x:a) (y:a) =
match w with
| Int -> Stdlib.compare (x:int) (y:int)
| Float -> Stdlib.compare (x:float) (y:float)
| Poly -> Stdlib.compare x y

type 't compare_chain =
  | []
  | (::): ('a compare * ('t -> 'a)) * 't compare_chain -> 't compare_chain

let[@inline always] rec chain_compare chain x y = match chain with
| [] -> 0
| (typ, proj) :: q ->
    let r = typed_compare typ (proj x) (proj y) in
    if r = 0 then chain_compare q x y else r

type t = { a:int; b:float; c:float array }
let a r = r.a
let b r = r.b
let c r = r.c
let compare x y = chain_compare [Int, a; Float, b; Poly, c] x y