问题
Context:
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:
OBSERVER:
module type OBSERVER = sig
type event
type t
val send : event -> t -> t
end
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
and SUBJECT that is merging of OBSERVER and OBSERVABLE:
module type SUBJECT = sig
include OBSERVER
include OBSERVABLE
with type event := event
and type t := t
end
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
...
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)
...
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
}
...
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
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
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 =
...
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
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
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
After calling print_operations ();; I have the following output
# print_operations ();;
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
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.
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
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
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.
before:
module type OBSERVABLE = sig
...
val unsubscribe : subscr -> t -> t
end
after:
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
As a result, I have:
Pack.state ^^^^^^^^^^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
Question 1:
Is it possible to implement unsubscribe with this signature?
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.
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
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
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
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 ;;
After calling history_of_operations ();; I have the error
Pack.state ^^^^^^^^^^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
Also, I tried
let history_of_operations () =
...
History.to_list Pack.state
But
History.to_list Pack.state ^^^^^^^^^^Error: This expression has type Pack.Observer.t
but an expression was expected of type History.t
Question 2:
How to extract the state from Pack with type List.t?
I changed the signature of unsubscribe
module type OBSERVABLE = sig
...
val unsubscribe : subscr -> t -> (t * (module PACK with type Observer.t = 't))
end
And tried to reimplement unsubscribe in Subject
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
But
o.observers |> SMap.find subscription ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^Error: This expression has type (module PACK)
but an expression was expected of type
(module PACK with type Observer.t = t)
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
Question 3:
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?
The question from the title:
How to return the instance of first-class module's nested type from a function?
Remark:
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.
回答1:
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.
Simple existentials with no type equality
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
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
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
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)
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)
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
which returns the equality proof that is defined as,
type ('a,'b) eq = Equal : ('a,'a) eq
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
as,
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
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 ()
So now our zero object is defined as,
let zero = Object {
intf = (module Int);
self = 0;
rtti = int;
}
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
and
# cast_object int zero;;
- : int option = Some 0
# cast_object int (incr zero);;
- : int option = Some 1
Another example,
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.
回答2:
Regarding your question 1, you expect a function with signature:
val unsubscribe : subscr -> t -> (t * (module OBSERVER with type t = 't) * 't))
The presence of a module is a red herring here. Your signature is no different from
val unsubscribe : subscr -> t -> 'a
In other words, it is a function that magically returns a value of any type that the caller might desire. If the caller wants an integer, the function returns an integer. If the caller wants a string, the function returns a string. And so on. Thus, there is only one kind of safe function with this kind of signature, it is a function that never returns anything.
So, you need to move the quantification over types elsewhere, for example under a constructor:
type 'u unsubscribe_result = UResult: 'u * (module OBSERVER with type t = 't) * 't -> 'u unsubscribe_result
val unsubscribe : subscr -> t -> t unsubscribe_result
回答3:
The short answer is that the inner types of packed modules can never be lifted outside of their first-class modules.
When you define a packed observer as:
module type PACK = sig
module Observer: sig
type t
val send: event -> t -> t
end
val state: Observer.t
end
the type Observer.t is existentially quantified within the first-class module: by packing the initial implementation inside a (module PACK), I am forgetting all that I know about the initial module, except for the type equalities inside the modules.
This means that for a value (module M) of type (module PACK), the only action that is available to me is to call M.Observer.send event M.state.
In other words, (module PACK) is in fact equivalent to the following type
type send = { send: event -> send }
where the state of Observer is more visibly inaccessible.
Thus, your problem started when you packed your observers in
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
)
}
Here, when you pack the module Obs, you are in fact forgetting the type of Obs and forgoing any further use of this type.
If you want to get back the state of the observer, you must keep the type information. A good starting point is to look at the OBSERVABLE signature:
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
and notice that we start losing type information in subscribe because I cannot associate a specific subscr with an observable type. One solution is thus to keep this information by parameterizing subscr with the type of the subscribed observer:
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
Then, with this change, unsubscribe can return the current state of the observer, because we know the type of this state: it is the type stored by the subscription:
val unsubscribe : 't subscr -> t -> t * 't
The remaining issue is thus storing observers in a map whose type depends on the type of the key that inserted them. This constraint points to a heterogeneous map. Using the hmap library, this can be done with:
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
来源：https://stackoverflow.com/questions/62206703/how-to-return-the-instance-of-first-class-modules-nested-type-from-a-function