如何基于OCaml标准库Set实现Archive数据结构并保留原有接口

我正在用函数式编程方法学习OCaml，写了一个图相关的示例代码。目前用列表实现了一个archive数据结构，代码如下：

type comparison = Smaller | Equiv | Greater
type 'a archive = {archlist:'a list; comp:'a->'a->comparison}

let add_to_archive arch elem =
  if List.exists (fun t -> arch.comp t elem == Equiv) arch.archlist then
    arch
  else
    { archlist = elem::arch.archlist; comp = arch.comp }

let add_list_to_archive:'a archive -> 'a list -> 'a archive = fun arch elemlst ->
  List.fold_left (fun a t -> add_to_archive a t) arch elemlst

let make_archive comp lst =
  let arch = {archlist = []; comp = comp} in
  add_list_to_archive arch lst

let archive_member elem arch =
  List.exists (fun t -> arch.comp t elem = Equiv) arch.archlist

let archive_map arch_part f (arch,l) =
  let rec arch_map arch ll = function
    [] -> (arch,ll)
  | (c::cl) ->
      let ll' = select
                  (fun c -> not (archive_member (arch_part c) arch)) (f c) in
      arch_map (add_list_to_archive arch (List.map arch_part ll')) (ll'@ll) cl in
  arch_map arch [] l

我觉得这个实现存在性能瓶颈，想改用OCaml标准库的Set来实现archive数据结构，但Set需要指定数据类型。请问能不能在保留原有archive数据结构接口的前提下，改用OCaml标准库Set实现？请给出部分实现代码，剩余部分我自行完成。原有接口定义如下：

type comparison = Smaller | Equiv | Greater
type 'a archive = { archlist : 'a list; comp : 'a -> 'a -> comparison; }
val add_to_archive : 'a archive -> 'a -> 'a archive = <fun>
val add_list_to_archive : 'a archive -> 'a list -> 'a archive = <fun>
val make_archive : ('a -> 'a -> comparison) -> 'a list -> 'a archive = <fun>
val archive_member : 'a -> 'a archive -> bool = <fun>
val archive_map :
  ('a -> 'b) -> ('c -> 'a list) -> 'b archive * 'c list -> 'b archive * 'a list =
  <fun>

完全可以在保留原有接口的前提下改用Set实现，核心是将自定义的comparison类型转换为Set所需的OrderedType模块，同时修改archive的内部存储结构为Set.t，对外仍保持原有接口的字段和函数签名。

关键转换与核心实现 #

首先，将comparison函数转换为Set.OrderedType要求的compare函数（返回int：负数表示小于，0表示等于，正数表示大于）：

let comp_to_ordered (comp : 'a -> 'a -> comparison) : (module Set.OrderedType with type t = 'a) =
  (module struct
    type t = 'a
    let compare a b =
      match comp a b with
      | Smaller -> -1
      | Equiv -> 0
      | Greater -> 1
  end)

然后修改archive类型定义，用Set.t替代列表存储元素，同时保留原有接口的comp和archlist字段（若原有代码依赖archlist，可同步维护或按需从Set转换）：

type comparison = Smaller | Equiv | Greater
type 'a archive = {
  comp : 'a -> 'a -> comparison;
  set : 'a Set.t;
  archlist : 'a list;  (* 兼容原有接口，可按需维护 *)
}

以下是make_archive和add_to_archive的实现示例：

let make_archive comp lst =
  let module Ord = (val comp_to_ordered comp) in
  let module S = Set.Make(Ord) in
  let initial_set = List.fold_left (fun s elem -> S.add elem s) S.empty lst in
  {
    comp;
    set = (initial_set :> 'a Set.t);
    archlist = S.elements initial_set;
  }

let add_to_archive arch elem =
  let module Ord = (val comp_to_ordered arch.comp) in
  let module S = Set.Make(Ord) in
  let s = (arch.set :> 'a S.t) in
  if S.mem elem s then
    arch
  else
    let new_set = S.add elem s in
    {
      comp = arch.comp;
      set = (new_set :> 'a Set.t);
      archlist = elem :: arch.archlist;  (* 直接在头部添加，比重新生成列表高效 *)
    }

说明 #

• 通过comp_to_ordered将用户提供的比较函数动态转换为Set所需的有序类型模块，实现了对原有接口的兼容。
• Set.mem和Set.add的时间复杂度均为O(log n)，远优于原列表实现的O(n)，能有效解决性能瓶颈。
• 剩余的add_list_to_archive、archive_member等函数可基于此结构实现，比如archive_member直接调用Set.mem即可。

内容的提问来源于stack exchange，提问作者hmsjwzb