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

不羁的心 提交于 2020-06-16 18:36:07

问题


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

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!