代数数据类型的模式匹配

Question

这是一个悬而未决的问题,但我从未设法找到令我高兴的解决方案.

假设我有这种代数数据类型:

type t = A of int | B of float | C of string

现在,假设我想写一个compare函数 - 因为我想把我的值放在一个Map例子中 - 我会像这样写:

let compare t1 t2 =
  match t1, t2 with
    | A x, A y -> compare x y
    | A _, _ -> -1
    | _, A _ -> 1
    | B x, B y -> compare x y
    | B _, _ -> -1
    | _, B _ -> 1
    | C x, C y (* or _ *) -> compare x y

或者我可以这样写:

let compare t1 t2 = 
  match t1, t2 with
    | A x, A y -> compare x y
    | B y, B x -> compare x y
    | C x, C y -> compare x y
    | A _, _
    | B _, C _ -> -1
    | _ -> 1

如果我没有错,那n就是构造函数的数量,第一个compare将有3 * (n - 1) + 1案例,第二个将有n + ((n - 2) * (n - 1)) / 2 + 2案例.

这是非常不满意的,因为:

• n = 3 (我们的案例):7或6例
• n = 4 :10或8例
• n = 5 :13或13例

它变得非常快.

所以,我想知道,你这样做,或者你使用其他方法吗？

或者,更好的是,是否有可能做类似的事情

let compare t1 t2 =
  match t1, t2 with
    | c1 x, c2 y -> 
      let c = compare c1 c2 in
      if c = 0 then compare x y else c

要么,

let compare (c1 x) (c2 y) = 
  let c = compare c1 c2 in
  if c = 0 then compare x y else c

编辑:添加一个比较,如果两个构造函数相同的señorDrup(来自Guadalup ;-P)

Answer 1

您可以使用ppx_deriving生成此功能.

以下将创建一个compare : t -> t -> int正确的功能:

type t = A of int | B of float | C of string [@@deriving ord]

如果您感到好奇或无法使用ppx_deriving,这里是生成的代码,它使用与Reimer解决方案类似的策略.

% utop -require ppx_deriving.std -dsource
utop # type t = A of int | B of float | C of string [@@deriving ord];;
type t = | A of int | B of float | C of string [@@deriving ord]
let rec (compare : t -> t -> Ppx_deriving_runtime.int) =
  ((let open! Ppx_deriving_runtime in
      fun lhs  ->
        fun rhs  ->
          match (lhs, rhs) with
          | (A lhs0,A rhs0) -> Pervasives.compare lhs0 rhs0
          | (B lhs0,B rhs0) -> Pervasives.compare lhs0 rhs0
          | (C lhs0,C rhs0) -> Pervasives.compare lhs0 rhs0
          | _ ->
              let to_int = function
              | A _ -> 0
              | B _ -> 1
              | C _ -> 2
              in
              Pervasives.compare (to_int lhs) (to_int rhs))
  [@ocaml.warning "-A"]) ;;
type t = A of int | B of float | C of string
val compare : t -> t -> int = <fun>