Как вернуть экземпляр вложенного типа первоклассного модуля из функции?

Контекст:

Я пытаюсь реализовать что-то вроде наблюдаемого шаблона ООП в OCaml с использованием первоклассных модулей. У меня есть проект со списком модулей, и я хочу дополнить его наблюдением без изменений. Чтобы минимизировать дублирование кода, я создал модуль Subject и планирую использовать его как часть общего способа (в контексте проекта) для этого расширения. Я объявил три типа модулей:

НАБЛЮДАТЕЛЬ:

moduletype OBSERVER = sig
  type event
  type t

  val send : event -> t -> t
end

НАБЛЮДАЕМЫЙ:

moduletype OBSERVABLE= sig
  type event
  type subscr
  type t

  moduletype 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, объединяющий НАБЛЮДАТЕЛЬ и НАБЛЮДАЕМЫЙ:

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

Следующее, что я реализовал, - это модуль Subject. Задача этого модуля - объединить множество 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
    moduletype OBSERVER = OBSERVER with type event = event
...

Для хранения экземпляров ОВЗЕКУЕК "S первоклассные модули с возможностью добавлять и удалять (в любом порядке), их я использую карту с междунар как ключ (который subscr).

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

Как видно из подписи отправки в OBSERVER (val send : event -> t -> t) Не только необходимо хранить экземпляры ОВЗЕКУЕК "s модулей первого класса, но и заявляет о них (случаи„ OBSERVER.t “). Я не могу хранить все состояния в одной коллекции из-за разных типов. Поэтому я объявил модуль типа ПАК для упаковки экземпляра ОВЗЕКУЕК "S первого класса модуль и экземпляр его состояния вместе в экземпляре ПАК.

...
    moduletype 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 проведет архивацию каждый пакет в рамках нового государства и в пределах старого наблюдателя модуля.

...
    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 moduletype of Acc
  include OBSERVABLE with type event := event
                      and type t := t 
end = 
...

Я реализовал OAcc с делегированием ответственности за наблюдение Субъекту и основной ответственности оригинальной Акк.

...
struct
  type event = Add of int | Multiply of int      
  module Subject = Subject.Make (struct type t = event end)
  moduletype 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

Все работает нормально в том случае, если логика нашего первоклассного наблюдателя модуля полностью основана на побочных эффектах и ​​нам не нужно его состояние вне Subject. Но для противоположной ситуации я не нашел никакого решения, как извлечь состояние подписанного наблюдателя из Subject.

Например, у меня есть следующий " НАБЛЮДАТЕЛЬ " (в данном случае это скорее посетитель, чем наблюдатель)

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 " без " OBSERVER ", связанного с предоставленной подпиской, а теперь он возвращает тройное значение этого состояния, отписавшийся первоклассный модуль и состояние отписавшегося модуля.

перед:

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

после:

moduletype 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 выйдет из своей области видимости

Вопрос 1:

Можно ли с такой подписью реализовать отписку?


Не работает. Я пробовал другое решение. Он основан на идее, что отказ от подписки может вернуть экземпляр первоклассного модуля PACK. Мне больше нравится предыдущая идея, потому что она сохраняет объявление PACK закрытым в Subject. Но нынешний обеспечивает лучший прогресс в поиске решений.

Я добавил тип модуля PACK в OBSERVABLE и изменил подписку на следующую.

moduletype OBSERVABLE= sig
...
  moduletype 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
...
  moduletype 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?


Поменял подпись отписки

moduletype 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) уровня абстракции?


Вопрос из заголовка:

Как вернуть экземпляр вложенного типа первоклассного модуля из функции?


Замечание:

Конечно, эту проблему можно решить с помощью изменяемого состояния, но вопрос не в этом.

Первоначальный компилируемый исходный код здесь.

3 ответа

Решение

Отказ от ответственности: я не буду притворяться, что полностью понимаю ваш вопрос, это, безусловно, самый большой вопрос, связанный с OCaml, который я видел на SO. Но моя интуиция подсказывает мне, что вы ищете экзистенциальное.

Простые экзистенциальные идеи без равенства типов

В этом подходе мы можем упаковать объектный интерфейс вместе с его состоянием в единый экзистенциальный 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 также есть множество библиотек, которые предоставляют динамические типы, разнородные словари и т. Д.

Что касается вашего вопроса 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

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.

Если вы хотите вернуть состояние наблюдателя, вы должны сохранить информацию о типе. Хорошей отправной точкой является просмотр подписи 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
Другие вопросы по тегам