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

Question

语境：

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

观察者：

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

以及合并OBSERVER和OBSERVABLE的SUBJECT：

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

我实现的下一件事是主题模块。该模块的职责是将许多OBSERVER聚合为一个。当然，它们应该处理相同的事件类型，这就是我将“ Subject ”（Subject.Make）实现为仿函数的原因。

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作为键（即subscr）。

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

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

...
    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在新状态和旧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

测试主题并查看模块在没有更改的情况下通过观察扩展的外观 - 我创建了一些模块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）；

- : 整数 = 90

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

例如，我有以下“ 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 将逃脱其范围

问题一：

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

---

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

我将PACK模块类型添加到OBSERVABLE 中，并将取消订阅签名更改为以下内容。

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

将PACK添加到OAcc实现中，因为它的签名包括OBSERVABLE。另外，我重新实现了取消订阅OAcc。

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，所以不需要添加它。只有取消订阅被重新实现。

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：

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

---

我更改了取消订阅的签名

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

并尝试在主题中重新实现取消订阅

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）
，但表达式应为类型
（模块 PACK，类型为 Observer.t = t）

看起来 OCaml 有 3 个级别的类型抽象
1. 具体module A : sig type t = int end = struct ...
2. 抽象module A : sig type t end = struct ...
3. 打包到一流模块

问题 3：

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

---

标题中的问题：

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

---

评论：

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

最初的可编译源代码在这里。

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是纯抽象的，而存在类型确实是抽象类型，例如，

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将处理与类型x相同的类型值y。有时，当您确实确定强制转换必须成功时，您可以使用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 -> ()

您可以在此处阅读有关动态类型的更多信息。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在第一类模块中是存在量化的：通过将初始实现打包在 a(module PACK)中，我忘记了我对初始模块的所有了解，除了模块内的类型相等性。这意味着对于(module M)type的值(module PACK)，我唯一可用的操作是调用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