问题描述：

我正在尝试使用一流的模块在OCaml中实现类似OOP的可观察模式.我有一个包含模块列表的项目，并希望通过观察扩展它们而无需更改.为了最大程度地减少代码重复，我创建了 Subject 模块，并计划将其用作此扩展的通用方式的一部分(在项目上下文中).我声明了三种模块类型:

I am trying to implement something like OOP observable pattern in OCaml with using first-class modules. I have a project with a list of modules and want to extend them with observation without changing. To minimize code duplication I created Subject module and plan to use it as a part of the common way (in the project context) for this extending. I declared three module types:

观察者:

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 聚合为一个. 当然，他们应该处理相同的事件类型，这就是为什么我将" Subject "( Subject.Make )用作函子的原因.>

The next thing that I implemented is Subject module. The responsibility of this module is to aggregate many OBSERVERs into one. Of course, they should process the same event type and that's why I implemented "Subject" (Subject.Make) as a functor.

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 ).

To store instances of OBSERVER's first-class modules with the ability to add and remove (in any order) them I use Map with int as key (which is subscr).

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

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

As we can see from send signature in OBSERVER (val send : event -> t -> t) it isn't only necessary to store instances of OBSERVER's first-class modules but also states of them (instances of "OBSERVER.t"). I can't store all states in one collection because of different types. So I declared module type PACK to pack instance of OBSERVER's first-class module and instance of its state together in the instance of 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 
      }
...

主题的

功能发送在新的状态和旧的观察者中重新包装每个 pack strong>模块.

Function send of Subject repacks each pack within new state and within old Observer module.

...
    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

To test Subject and to see how module extending with observation without changes will look - I created some module 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

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

And extended it with observation functionality in module OAcc with the following signature that is merging of OBSERVABLE and module type of original 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 ，将观察职责委托给主题，而将主要职责委托给原始的 Acc .

I implemented OAcc with the delegation of observation responsibility to Subject and main responsibility to original 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 模块"，仅将操作打印到控制台中.

Created some "OBSERVER module" that just prints operations into the console

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 ，并测试了所有功能均按预期工作

Finally, I created function print_operations and tested that all works as expected

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 ();;后，我得到以下输出

After calling print_operations ();; I have the following output

#print_operations();;

# print_operations ();;

1.Add(1);
2.添加(1);
3.添加(1);
1.乘法(2);
2.乘法(2);
3.乘法(2);
1.乘法(3);
3.乘(3);
1.添加(4);
3.添加(4);
1.添加(5);

1.Add(1);
2.Add(1);
3.Add(1);
1.Multiply(2);
2.Multiply(2);
3.Multiply(2);
1.Multiply(3);
3.Multiply(3);
1.Add(4);
3.Add(4);
1.Add(5);

-:int = 90

- : int = 90

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

All works fine in the case when the logic of our first-class module observer is totally based on side effects and we don't need state of it outside Subject. But for the opposite situation, I didn't found any solution on how to extract the state of subscribed observer from Subject.

例如，我有以下" OBSERVER " (在这种情况下，访问者多于观察者)

For example, I have the following "OBSERVER" (In this case it more visitor then 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

我可以将历史记录的一流实例及其某些初始状态订阅到 OAcc ，但是我不知道如何将其提取回来.

I can subscribe the first-class instance of History and some initial state of it to OAcc but I don't know how to extract it back.

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

我试图做的.我在可观察的中更改了退订的签名.在返回"可观察"的状态而没有与提供的订阅相关联的" OBSERVER "之前，现在返回该状态的三倍，未订阅的一流模块和状态取消订阅的模块.

What I tried to do. I changed the signature of unsubscribe in OBSERVABLE. Before it returns the state of "OBSERVABLE" without "OBSERVER" associated with the provided subscription and now it returns triple of this state, unsubscribed first-class module, and state of the unsubscribed module.

之前:

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 is compilable but I can't implement it. The following example shows one of my tries.

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会逃避其作用域

Error: This expression has type Pack.Observer.t
but an expression was expected of type 'a
The type constructor Pack.Observer.t would escape its scope

问题1:

是否可以使用此签名实现退订?

它不起作用.我尝试了另一种解决方案. 它基于这样的想法，即退订可以返回 PACK 的一流模块的实例. 我更喜欢前面的想法，因为它在 Subject 中将 PACK 的声明保留为私有.但是，当前的解决方案在解决方案查找方面提供了更好的进展.

It doesn't work. I tried another solution. It based on the idea that unsubscribe can return an instance of PACK's first-class module. I like the previous idea better because it keeps the declaration of PACK as private in Subject. But the current one provides better progress in solution-finding.

我在可观察中添加了 PACK 模块类型，并将退订签名更改为以下内容.

I added PACK module type into OBSERVABLE and changed unsubscribe signature to the following.

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 的退订.

Added PACK into OAcc implementation because its signature includes OBSERVABLE. Also, I reimplemented unsubscribe of 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

主题的实现已包含 PACK ，因此无需添加. 仅重新实现退订.

Implementation of Subject already contains PACK, so no need to add it. Only unsubscribe was reimplemented.

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 以测试解决方案

Finally, I created I changed history_of_operations to test solution

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 ();;之后，我出现了错误

After calling history_of_operations ();; I have the error

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

错误:此表达式的类型为Pack.Observer.t
但是应该使用'a
类型的表达式类型构造函数Pack.Observer.t会逃避其作用域

Error: This expression has type Pack.Observer.t
but an expression was expected of type 'a
The type constructor Pack.Observer.t would escape its scope

我也尝试过

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

但是

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

错误:此表达式的类型为Pack.Observer.t
但是期望使用History.t

Error: This expression has type Pack.Observer.t
but an expression was expected of type History.t

问题2:

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

Question 2:

How to extract the state from Pack with type List.t?

我更改了退订

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)
但应使用类型为
的表达式 (类型为Observer.t = t的模块PACK)

Error: This expression has type (module PACK)
but an expression was expected of type
(module PACK with type Observer.t = t)

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

It looks like OCaml has 3 levels of types abstraction
1. Concrete module A : sig type t = int end = struct ...
2. Abstract module A : sig type t end = struct ...
3. Packed to first-class module

是否可以使用(2) 抽象级别存储一流模块实例的嵌套类型，或者可以将其还原为 (2) 抽象级别?

Is it possible to store nested type of instance of the first-class module with (2) level of abstraction or with the ability to restore it to (2) level of abstraction?

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

How to return the instance of first-class module's nested type from a function?

当然，可以通过使用可变状态来解决此问题，但问题不关乎.

Of course, it is possible to solve this problem by mutable state using but the question isn't about.

可编译的初始源代码此处.

The initial compilable source code here.

答

免责声明:我不会假装我完全理解您的问题，这是我迄今为止在OCaml相关的最大问题.但是我的直觉告诉我，您正在寻找存在性.

Disclaimer: I won't pretend that I fully understand your question, this is by far the largest OCaml-related question I have seen on SO. But my intuition tells me that you're looking for existentials.

在这种方法中，我们可以将对象接口及其状态打包在单个存在的GADT中.只要状态不逃避其定义范围，我们就可以使用该状态，该状态将解开我们的生存状态.有时，这是我们想要的，但是我们将在下一部分中扩展此方法.

In this approach we can pack an object interface together with its state in a single existential GADT. We will be able to use the state as long as it doesn't escape the scope of its definition, which will be the function that unpacks our existential. Sometimes, it is what we want, but we will extend this approach in the next section.

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

Let's start with some preliminary definitions, let's define the interface of the object that we would like to pack, e.g., something like this:

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的值)一起打包存在

Now, we can pack this interface together with the state (a value of type t) in an existential

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

然后，我们可以轻松地打开接口和状态的包装，并将接口中的任何功能应用于状态.因此，我们的类型t纯粹是抽象的，实际上存在类型是抽象类型，例如

We can then easily unpack the interface and the state and apply any function from the interface to the state. Therefore, our type t is purely abstract, and indeed existential types are abstract types, e.g.,

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

Recoverable Existentials (aka Dynamic types)

But what if would like to recover the original type of the abstract type so that we can apply other functions that are applicable to values of this type. For that we need to store a witness that the type x belongs to the desired type y, which we can do, employing extensible GADT,

 type 'a witness = ..

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

To create new witnesses, we will employ first-class modules,

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及其打包类型为

where module type Witness and its packed types are,

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

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

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

Every time newtype is called it adds a new constructor to the witness type that is guaranteed not to be equal to any other constructor. To prove that two witness are actually created with the same constructor we will use the following function,

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函数

In the environments in which we can construct an object of type (x,y) eq the typechecker will treat values of type x having the same type as y. Sometimes, when you are really sure that the cast must success, you can use, the cast function,

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 *)

好吧，现在有了动态类型时，我们可以使用它们来使我们的对象类型可恢复且可逃避状态.我们需要的只是将运行时信息添加到我们的对象表示中，

Ok, now when we have the dynamic types, we can employ them to make our object types recoverable and state escapable. What we need, is just to add runtime information to our object representation,

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

现在让我们定义类型int的运行时表示形式(请注意，通常我们可以在rtti中放置更多信息，而不仅仅是见证者，我们还可以使其成为经整理的类型，并在运行时通过新操作扩展动态类型，并实施临时多态性)，

Now let's define the runtime representation for type int (note that in general we can put more information in rtti, other just the witness, we can also make it an oredered type and extend dynamic types in runtime with new operations, and implement ad hoc polymorphism),

let int : int typeid = newtype ()

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

So now our zero object is defined as,

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

incr函数仍然相同(在对象表示形式中对附加字段进行模运算)，因为它不需要转义.但是现在我们可以编写cast_object函数，该函数将采用所需的类型并将对象转换为它，

The incr function is still the same (modulo an extra field in the object representation), since it doesn't require escaping. But now we can write the cast_object function that will take the desired type and cast object to it,

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 -> ()

您可以阅读有关动态类型的更多信息

You can read more about dynamic types here. There are also many libraries in OCaml that provide dynamic types and heterogeneous dictionaries, and so on.