如何从函数中返回一流模块嵌套类型的实例？

Question

上下文：

我正在尝试使用一流的模块在 OCaml 中实现诸如 OOP 可观察模式之类的东西。我有一个包含模块列表的项目，并希望通过观察来扩展它们而不进行更改。为了最大限度地减少代码重复，我创建了 Subject 模块并计划将其用作此扩展的通用方式（在项目上下文中）的一部分。我声明了三种模块类型：

观察者：

module type OBSERVER = sig
  type event
  type t

  val send : event -> t -> t
end

可观察：

module type OBSERVABLE = sig
  type event
  type subscr
  type t

  module type OBSERVER = OBSERVER with type event = event

  val subscribe   : (module OBSERVER with type t = 't) -> 't -> t -> (subscr * t)
  val unsubscribe : subscr -> t -> t
end

和 SUBJECT 合并 OBSERVER 和 OBSERVABLE：

module type SUBJECT = sig
  include OBSERVER
  include OBSERVABLE 
     with type event := event
      and type t := t
end

接下来我实现的是 Subject 模块。 该模块的职责是将许多OBSERVER聚合为一个。 当然，它们应该处理相同的 event 类型，这就是我将“Subject”（Subject.Make）实现为函子的原因。 p>

module Subject = struct
  module Make (Event : sig type t end) : sig
    include SUBJECT with type event = Event.t 
    val empty : t
  end = struct
    type event = Event.t
    module type OBSERVER = OBSERVER with type event = event
...

为了存储 OBSERVER 的一流模块的实例，并能够添加和删除（以任何顺序）它们，我使用 Map 和 int 作为 key（即 subscr）。

...
    type subscr = int 
    module SMap = Map.Make (Int)
...

从 OBSERVER (val send : event -> t -> t) 中的 send 签名可以看出，不仅需要存储 OBSERVER' 的实例s 一流的模块，还有它们的状态（“OBSERVER.t”的实例）。由于类型不同，我无法将所有 states 存储在一个集合中。所以我声明了模块类型PACK来将OBSERVER的第一类模块的实例和它的状态实例打包到PACK的实例中。

...
    module type PACK = sig
      module Observer : OBSERVER
      val state : Observer.t    
    end

    type t =
      { next_subscr : subscr;
          observers : (module PACK) SMap.t
      }

    let empty =
      { next_subscr = 0;
        observers = SMap.empty
      }

    let subscribe (type t)
        (module Obs : OBSERVER with type t = t) init o =
      o.next_subscr,
      { next_subscr = succ o.next_subscr;
        observers = o.observers |> SMap.add 
                      o.next_subscr
                      ( module struct
                          module Observer = Obs
                          let state = init
                        end : PACK
                      ) 
      }

    let unsubscribe subscription o =
      { o with
        observers = o.observers |> SMap.remove subscription 
      }
...

Subject 的

函数 send 将每个 pack 重新打包到新的 state 和旧的 Observer 模块。

...
    let send event o =
      let send (module Pack : PACK) = 
        ( module struct
            module Observer = Pack.Observer
            let state = Observer.send event Pack.state
          end : PACK
        ) in
      { o with
        observers = SMap.map send o.observers
      }
  end
end

为了测试 Subject 并查看模块在没有变化的情况下通过观察扩展的外观 - 我创建了一些模块 Acc

module Acc : sig 
  type t
  val zero : t
  val add : int -> t -> t
  val multiply : int -> t -> t
  val value : t -> int
end = struct
  type t = int
  let zero = 0
  let add x o = o + x
  let multiply x o = o * x
  let value o = o
end

并在模块 OAcc 中使用观察功能对其进行了扩展，并使用以下签名合并了 OBSERVABLE 和原始 Acc 的模块类型

module OAcc : sig 
  type event = Add of int | Multiply of int

  include module type of Acc
  include OBSERVABLE with type event := event
                      and type t := t 
end = 
...

我实施了 OAcc，将观察职责委托给 Subject，将主要职责委托给原始 Acc。

...
struct
  type event = Add of int | Multiply of int      
  module Subject = Subject.Make (struct type t = event end)
  module type OBSERVER = Subject.OBSERVER                         
  type subscr = Subject.subscr
  type t = 
    { subject : Subject.t;
      acc : Acc.t
    }

  let zero = 
    { subject = Subject.empty;
      acc = Acc.zero
    } 
  let add x o = 
    { subject = Subject.send (Add x) o.subject;
      acc = Acc.add x o.acc
    } 
  let multiply x o = 
    { subject = Subject.send (Multiply x) o.subject;
      acc = Acc.multiply x o.acc
    }

  let value o = Acc.value o.acc

  let subscribe (type t) (module Obs : Subject.OBSERVER with type t = t) init o =
    let subscription, subject = 
      Subject.subscribe (module Obs) init o.subject in
    subscription, { o with subject }

  let unsubscribe subscription o =
    { o with subject = Subject.unsubscribe subscription o.subject
    } 
end 

创建了一些“OBSERVER 模块”，将操作打印到控制台中

module Printer : sig 
  include OAcc.OBSERVER
  val make : string -> t
end = struct
  type event = OAcc.event
  type t = string
  let make prefix = prefix
  let send event o = 
    let () = 
      [ o;
        ( match event with
          | OAcc.Add      x -> "Add("      ^ (string_of_int x) 
          | OAcc.Multiply x -> "Multiply(" ^ (string_of_int x)
        );
        ");\n"
      ] 
      |> String.concat ""
      |> print_string in
    o
end

最后，我创建了函数 print_operations 并测试了一切都按预期工作

let print_operations () =
  let p = (module Printer : OAcc.OBSERVER with type t = Printer.t) in 
  let acc = OAcc.zero in
  let s1, acc = acc |> OAcc.subscribe p (Printer.make "1.") in 
  let s2, acc = acc |> OAcc.subscribe p (Printer.make "2.") in 
  let s3, acc = acc |> OAcc.subscribe p (Printer.make "3.") in
  acc |> OAcc.add 1
      |> OAcc.multiply 2
      |> OAcc.unsubscribe s2 
      |> OAcc.multiply 3
      |> OAcc.add 4 
      |> OAcc.unsubscribe s3
      |> OAcc.add 5
      |> OAcc.unsubscribe s1
      |> OAcc.multiply 6
      |> OAcc.value

调用print_operations ();;后，我得到了以下输出

#print_operations();;

1.添加(1);
2.添加(1);
3.添加(1);
1.乘法(2);
2.乘法(2);
3.乘法(2);
1.乘法(3);
3.乘法(3);
1.添加(4);
3.添加(4);
1.添加（5）；

- : int = 90

当我们的第一类模块observer的逻辑完全基于副作用并且我们不需要在Subject之外的状态时，一切正常.但是对于相反的情况，我没有找到任何关于如何从Subject中提取订阅observer的state的解决方案。

例如，我有以下“OBSERVER” （在这种情况下，访问者多于观察者）

module History : sig 
  include OAcc.OBSERVER
  val empty : t
  val to_list : t -> event list
end = struct
  type event = OAcc.event
  type t = event list
  let empty = []
  let send event o = event :: o
  let to_list = List.rev
end

我可以将 History 的第一类实例及其一些初始状态订阅到 OAcc，但我不知道如何将其提取回来。

let history_of_operations () = 
  let h = (module History : OAcc.OBSERVER with type t = History.t) in 
  let acc = OAcc.zero in
  let s, acc = acc |> OAcc.subscribe h History.empty in
  let history : History.t = 
    acc |> OAcc.add 1
        |> OAcc.multiply 2 
        |> failwith "implement extraction of History.t from OAcc.t" in
  history

---

我想做什么。我在 OBSERVABLE 中更改了 unsubscribe 的签名。在返回没有与提供的订阅关联的“OBSERVER”的“OBSERVABLE”状态之前，现在它返回此状态的三倍，未订阅的第一类模块和状态未订阅的模块。

之前：

module type OBSERVABLE = sig
  ...
  val unsubscribe : subscr -> t -> t
end

之后：

module type OBSERVABLE = sig
  ...
  val unsubscribe : subscr -> t -> (t * (module OBSERVER with type t = 't) * 't))
end

OBSERVABLE 是可编译的，但我无法实现它。 以下示例显示了我的一项尝试。

module Subject = struct
  module Make (Event : sig type t end) : sig
...
  end = struct
...
    let unsubscribe subscription o =
      let (module Pack : PACK) =
        o.observers |> SMap.find subscription
      and observers = 
        o.observers |> SMap.remove subscription in 
      { o with observers },
      (module Pack.Observer : OBSERVER),
      Pack.state
...
  end
end

结果，我有：

    Pack.state 
    ^^^^^^^^^^

错误：此表达式的类型为 Pack.Observer.t
但是需要一个类型为 'a
的表达式 类型构造函数 Pack.Observer.t 将逃脱其范围

问题一：

是否可以使用此签名实现取消订阅？

---

它不起作用。我尝试了另一种解决方案。 它基于 unsubscribe 可以返回 PACK 的一流模块的实例的想法。 我更喜欢前面的想法，因为它在 Subject 中将 PACK 的声明保持为私有。但目前的解决方案在寻找解决方案方面取得了更好的进展。

我在 OBSERVABLE 中添加了 PACK 模块类型并将 unsubscribe 签名更改为以下内容。

module type OBSERVABLE = sig
...
  module type PACK = sig
    module Observer : OBSERVER
    val state : Observer.t    
  end
...
  val unsubscribe : subscr -> t -> (t * (module PACK))
end

在 OAcc 实现中添加了 PACK，因为它的签名包含 OBSERVABLE。另外，我重新实现了OAcc的unsubscribe。

module OAcc : sig 
...
end = struct
...
  module type PACK = Subject.PACK
...       
  let unsubscribe subscription o =
    let subject, ((module Pack : PACK) as p) = 
      Subject.unsubscribe subscription o.subject in
    { o with subject }, p 
end 

Subject的实现已经包含PACK，所以不需要添加。 只有 unsubscribe 被重新实现。

module Subject = struct
  module Make (Event : sig type t end) : sig
...
  end = struct
...
    let unsubscribe subscription o = 
      let ((module Pack : PACK) as p) =
        o.observers |> SMap.find subscription
      and observers = 
        o.observers |> SMap.remove subscription in 
      { o with observers }, p
...
  end
end 

最后，我创建了我将 history_of_operations 更改为测试解决方案

let history_of_operations () = 
  let h = (module History : OAcc.OBSERVER with type t = History.t) in 
  let acc = OAcc.zero in
  let s, acc = acc |> OAcc.subscribe h History.empty in
  let acc, (module Pack : OAcc.PACK) = 
    acc
    |> OAcc.add 1
    |> OAcc.multiply 2 
    |> OAcc.unsubscribe s in
  Pack.state ;;

调用history_of_operations ();;后出现错误

  Pack.state
  ^^^^^^^^^^

错误：此表达式的类型为 Pack.Observer.t
但是需要一个类型为 'a
的表达式 类型构造函数 Pack.Observer.t 将逃脱其范围

我也试过了

let history_of_operations () = 
...
    History.to_list Pack.state

但是

  History.to_list Pack.state
                  ^^^^^^^^^^

错误：此表达式的类型为 Pack.Observer.t
但是需要一个 History.t 类型的表达式

问题2：

如何从 Pack 中提取 List.t 类型的状态？

---

我更改了退订的签名

module type OBSERVABLE = sig
...
  val unsubscribe : subscr -> t -> (t * (module PACK with type Observer.t = 't))
end

并尝试在Subject

中重新实现unsubscribe

module Subject = struct
  module Make (Event : sig type t end) : sig
...
  end = struct
...
    let unsubscribe (type t) subscription o = 
      let ((module Pack : PACK with type Observer.t = t) as p) =
        o.observers |> SMap.find subscription
      and observers = 
        o.observers |> SMap.remove subscription in 
      { o with observers }, p
...
  end
end 

但是

      o.observers |> SMap.find subscription
      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

错误：此表达式具有类型（模块 PACK）
但是表达式应该是类型
（Observer.t = t 类型的模块 PACK）

看起来 OCaml 有 3 个类型抽象级别
1.混凝土module A : sig type t = int end = struct ...
2. 摘要module A : sig type t end = struct ...
3.打包成一流的模块

问题3：

是否可以使用 (2) 抽象级别 或将其恢复到 的能力来存储第一类模块的嵌套类型的实例(2) 抽象级别？

---

题目中的问题：

如何从函数中返回一等模块嵌套类型的实例？

---

备注：

当然，可以通过使用可变状态来解决这个问题，但问题不在于。

初始可编译源代码here。

Answer 1

免责声明：我不会假装我完全理解你的问题，这是迄今为止我在 SO 上看到的最大的 OCaml 相关问题。但我的直觉告诉我，你在寻找存在主义。

没有类型相等的简单存在

在这种方法中，我们可以将对象接口及其状态打包到一个存在的 GADT 中。只要状态不超出其定义的范围，我们就可以使用它，这将是解开我们存在的函数。有时，这正是我们想要的，但我们将在下一节中扩展这种方法。

让我们从一些初步的定义开始，让我们定义我们想要打包的对象的接口，例如，像这样：

module type T = sig
  type t
  val int : int -> t
  val add : t -> t -> t
  val sub : t -> t -> t
  val out : t -> unit
end

现在，我们可以将此接口与状态（t 类型的值）一起打包到一个存在中

type obj = Object : {
    intf : (module T with type t = 'a);
    self : 'a
  } -> obj

然后我们可以轻松地解包接口和状态，并将接口中的任何函数应用到状态。因此，我们的类型t 是纯抽象的，实际上existential types are abstract types，例如，

module Int = struct
  type t = int
  let int x = x
  let add = (+)
  let sub = (-)
  let out = print_int
end

let zero = Object {
    intf = (module Int);
    self = 0;
  }

let incr (Object {intf=(module T); self}) = Object {
    intf = (module T);
    self = T.add self (T.int 1)
  }

let out (Object {intf=(module T); self}) = T.out self

可恢复的存在（又名动态类型）

但是如果想恢复抽象类型的原始类型，以便我们可以应用适用于该类型值的其他函数，该怎么办。为此，我们需要存储 x 类型属于所需类型 y 的见证，我们可以这样做，使用可扩展的 GADT，

 type 'a witness = ..

为了创建新的见证人，我们将使用一流的模块，

let newtype (type u) () =
  let module Witness = struct
    type t = u
    type _ witness += Id : t witness
  end in
  (module Witness : Witness with type t = u)

模块类型Witness 及其打包类型在哪里，

module type Witness = sig 
     type t 
     type _ witness += Id : t witness
end

type 'a typeid = (module Witness with type t = 'a)

每次调用newtype 时，它都会向见证类型添加一个新的构造函数，该构造函数保证不等于任何其他构造函数。为了证明两个见证人实际上是使用相同的构造函数创建的，我们将使用以下函数，

let try_cast : type a b. a typeid -> b typeid -> (a,b) eq option =
  fun x y ->
  let module X : Witness with type t = a = (val x) in
  let module Y : Witness with type t = b = (val y) in
  match X.Id with
  | Y.Id -> Some Equal
  | _ -> None

返回定义为的等式证明，

type ('a,'b) eq = Equal : ('a,'a) eq

在我们可以构造(x,y) eq 类型对象的环境中，类型检查器将处理与y 具有相同类型的x 类型的值。有时，当您确实确定强制转换必须成功时，您可以使用 cast 函数，

let cast x y = match try_cast x y with
  | None -> failwith "Type error"
  | Some Equal -> Equal

作为，

let Equal = cast t1 t2 in
(* here we have proved that types witnessed by t1 and t2 are the same *)

好的，现在当我们拥有动态类型时，我们可以使用它们来使我们的对象类型可恢复和状态可转义。我们需要的只是将运行时信息添加到我们的对象表示中，

type obj = Object : {
    intf : (module T with type t = 'a);
    self : 'a;
    rtti : 'a typeid;
  } -> obj

现在让我们定义类型int 的运行时表示（注意，通常我们可以在rtti 中放入更多信息，而不仅仅是见证，我们也可以将其设为有序类型并在运行时通过新操作扩展动态类型，并实现临时多态性），

let int : int typeid = newtype ()

所以现在我们的zero 对象被定义为，

let zero = Object {
    intf = (module Int);
    self = 0;
    rtti = int;
  }

incr 函数仍然是相同的（以对象表示中的额外字段为模），因为它不需要转义。但是现在我们可以编写cast_object 函数，它会采用所需的类型并将对象转换为它，

let cast_object (type a) (t : a typeid) (Object {self; rtti}) : a option =
  match try_cast t rtti with
  | Some Equal -> Some self
  | None -> None

和

# cast_object int zero;;
- : int option = Some 0
# cast_object int (incr zero);;
- : int option = Some 1

另一个例子，

let print_if_int (Object {self; rtti}) =
  match try_cast int rtti with
  | Some Equal -> print_int self
  | None -> ()

您可以阅读有关动态类型的更多信息here。 OCaml 中还有很多库提供动态类型和异构字典等。

Answer 2

关于你的问题 1，你期望一个带有签名的函数：

val unsubscribe : subscr -> t -> (t * (module OBSERVER with type t = 't) * 't))

模块的存在在这里是一个红鲱鱼。你的签名和

没有什么不同

val unsubscribe : subscr -> t -> 'a

换句话说，它是一个函数，可以神奇地返回调用者可能需要的任何类型的值。如果调用者想要一个整数，该函数将返回一个整数。如果调用者想要一个字符串，该函数将返回一个字符串。等等。因此，只有一种具有这种签名的安全函数，它是一个从不返回任何内容的函数。

因此，您需要将量化转移到别处的类型上，例如在构造函数下：

type 'u unsubscribe_result = UResult: 'u *  (module OBSERVER with type t = 't) * 't -> 'u unsubscribe_result
val unsubscribe : subscr -> t -> t unsubscribe_result

Answer 3

简短的回答是打包模块的内部类型永远不能被提升到它们的第一类模块之外。

当你将一个打包的观察者定义为：

  module type PACK = sig
    module Observer: sig
      type t
      val send: event -> t -> t
    end
    val state: Observer.t
  end 

Observer.t 类型在第一类模块中是存在量化的：通过将初始实现打包在 (module PACK) 中，我忘记了我对初始模块的所有了解，除了模块内部的类型相等性。 这意味着对于(module PACK) 类型的值(module M)，我唯一可用的操作是调用M.Observer.send event M.state。 也就是说(module PACK)其实等价于下面的类型

type send = { send: event -> send }

Observer 的状态明显无法访问。

因此，当您将观察者放入其中时，您的问题就开始了

    let subscribe (type t)
        (module Obs : OBSERVER with type t = t) init o =
      o.next_subscr,
      { next_subscr = succ o.next_subscr;
        observers = o.observers |> SMap.add 
                      o.next_subscr
                      ( module struct
                          module Observer = Obs
                          let state = init
                        end : PACK
                      ) 
      }

在这里，当您打包模块Obs 时，实际上您忘记了Obs 的类型，并放弃了对该类型的任何进一步使用。

如果你想取回观察者的状态，你必须保留类型信息。一个好的起点是查看 OBSERVABLE 签名：

module type OBSERVABLE = sig
  type event
  type subscr
  type t

  module type OBSERVER = OBSERVER with type event = event
  val subscribe : (module OBSERVER  with type t = 't) -> 't -> t -> (subscr * t)
  val unsubscribe : subscr -> t -> t
end

并注意到我们开始丢失subscribe 中的类型信息，因为我无法将特定的subscr 与可观察类型相关联。因此，一种解决方案是通过使用订阅观察者的类型参数化 subscr 来保留此信息：

module type OBSERVABLE = sig
  type event
  type 'a subscr
  type t

  module type OBSERVER = OBSERVER with type event = event
  val subscribe : (module OBSERVER  with type t = 't) -> 't -> t -> ('t subscr * t)
  val unsubscribe : 't subscr -> t -> t
end

那么，通过这个改变，unsubscribe 可以返回观察者的当前状态，因为我们知道这个状态的类型：它是订阅存储的类型：

  val unsubscribe : 't subscr -> t -> t * 't

因此，剩下的问题是将观察者存储在映射中，其类型取决于插入它们的键的类型。该约束指向异构映射。使用hmap 库，可以通过以下方式完成：

module Subject = struct
  module Make (Event : sig type t end) : sig
    include SUBJECT with type event = Event.t
    val empty : t
  end = struct
    type event = Event.t
    module type OBSERVER =
      OBSERVER with type event = event
    (* we need to keep the module implementation with the key for map *)
    module HM = Hmap.Make(struct type 'a t = (module OBSERVER  with type t = 'a) end)
    type t = HM.t
    type 'a subscr = 'a HM.key


    let empty = HM.empty

    let subscribe (type t)
        (((module Obs) :  (module OBSERVER  with type t = t) ) as vt) (init:t) o =
      let key: t subscr = HM.Key.create vt in
      key, HM.add key init o

    let unsubscribe subscription o =
      HM.rem subscription o, HM.get subscription o

    let send event o =
      let send_and_readd (HM.B(k,s)) o =
        let module Obs = (val HM.Key.info k) in
        let s = Obs.send event s in
        HM.add k s o in
      HM.fold send_and_readd o empty
  end
end