1. Dmitry Grebeniuk
  2. parvel

Commits

Dmitry Grebeniuk  committed 6eb63c6

.

  • Participants
  • Parent commits 008a9a7
  • Branches default

Comments (0)

Files changed (3)

File _tags

View file
+<*.ml> | <*.mli> : camlp4r

File parvel.ml

View file
+module type COUNTER
+ =
+  sig
+    type ref_t;
+    type t;
+    value create : unit -> ref_t;
+    value next : ref_t -> t;
+    value compare : t -> t -> int;
+  end
+;
+
+
+module Counter : COUNTER =
+  struct
+    type t = int;
+    type ref_t = ref int;
+    value create () = ref (-1);
+    value next r = ( incr r; r.contents );
+    value compare a b = Pervasives.compare (a : int) (b : int);
+  end
+;
+
+
+value p_counter = Counter.create ()
+  and g_counter = Counter.create ()
+;
+
+
+type process 'i 'o = Counter.t
+;
+
+
+type group 'i 'o =
+  { gid : Counter.t
+  ; children : mutable list (process 'i 'o)
+  }
+;
+
+
+
+(* Всё, что зависит от конкретной реализации ввода-вывода,
+   закатываем в функтор: *)
+
+module Make (IO : Types.MonadIO)
+ =
+  struct
+
+    type context 'i 'o =
+      < send : ! 'i2 'o2 . process 'i2 'o2 -> 'i2 -> IO.m unit
+      ; send_group : ! 'i2 'o2 . group 'i2 'o2 -> 'i2 -> IO.m unit
+       (* в send и send_group полиморфность по 'o2 достигается тем,
+          что он не должен использоваться в теле send.
+          полиморфность по 'i2 -- факт того, что можно слать сообщения
+          кому угодно, если знаешь тип и можешь сформировать сообщение.
+        *)
+      ; exit : unit -> IO.m unit
+
+      ; me : process 'i 'o
+      ; my_group : group 'i 'o
+      >
+    ;
+
+    (* диспетчер сообщений -- то, что содержит пользовательский код,
+       но обёрнуто в абстрактный тип. *)
+
+    type dispatcher 'i 'o = context 'i 'o -> ('i -> IO.m unit);
+
+    (* обеспечить мономорфность получающегося типа, чтобы в случае top-level
+       значений были конкретные типы. *)
+
+    value create_process_group () =
+      { gid = Counter.next g_counter
+      ; children = []
+      }
+    ;
+
+    value create_process group _disp =
+      let pid = Counter.next p_counter in
+      ( group.children := [pid :: group.children ]
+      ; () (* зарегистрировать disp *)
+      ; pid
+      )
+    ;
+
+(*
+    (* нужно конкретно для частной задачи, поэтому не уверен в ценности:
+       функция шлёт сообщения группе и дожидается ответа каждого из процессов
+       этой группы, затем возвращает массив ответов *)
+    value call_group
+      : process_group 'i 'o -> 'i -> res (list 'o);
+    (* если будет call, то можно будет выразить это как отсылку call-запросов
+      и приём call-ответов *)
+
+    (* ответы на сообщения будут производиться через передаваемый
+      в функцию контекст, где будут функции send для простых процессов
+      и reply для call-подобных. *)
+*)
+
+
+  end
+;

File parvel.mli

View file
 *)
 
 
+(* Есть большие сомнения, что всё заведётся с нижеуказанными типами,
+   поэтому, очень вероятно, типы будут меняться.
+ *)
+
+
 (* Принятые обозначения:
    'i -- тип принимаемых сообщений,
-   'o -- тип отправляемых сообщений. *)
-
-type process_group 'i 'o;
+   'o -- тип отправляемых сообщений.
+ *)
 
 type process 'i 'o;
 
-(* диспетчер сообщений -- то, что содержит пользовательский код,
-   но обёрнуто в абстрактный тип. *)
+(* группа процессов *)
+type group 'i 'o;
 
-type dispatcher 'i 'o;
-(*   = ~context 'i 'o ->  ('i -> IO unit)  ?
-     where context 'i 'o =
-        < ! ’o2 . send : process 'o2 'i -> 'i -> IO unit
-              (* полиморфность по 'o2 достигается тем, что он не должен
-                 использоваться в теле send *)
-        ; me : process 'i 'o
-        ; my_group : process_group 'i 'o
-        >   *)
 
-(* IO 'a читать как Lwt.t 'a. *)
+(* Всё, что зависит от конкретной реализации ввода-вывода,
+   закатываем в функтор: *)
 
-(*
-для синхронных серверов предусмотреть что-то похожее на
-gen_server:handler_call, по прикидкам упрощающее дело:
+module Make (IO : Types.MonadIO)
+ :
+  sig
 
-value gen_server : (gen_server_context 'i 'o -> ('i * caller) -> IO unit)
-   -> process_server 'i 'o
+    type context 'i 'o =
+      < send : ! 'i2 'o2 . process 'i2 'o2 -> 'i2 -> IO.m unit
+      ; send_group : ! 'i2 'o2 . group 'i2 'o2 -> 'i2 -> IO.m unit
+       (* в send и send_group полиморфность по 'o2 достигается тем,
+          что он не должен использоваться в теле send.
+          полиморфность по 'i2 -- факт того, что можно слать сообщения
+          кому угодно, если знаешь тип и можешь сформировать сообщение.
+        *)
+      ; exit : unit -> IO.m unit
 
-     where gen_server_context 'i 'o =
-        < ! i2 . reply: caller 'o 'i2 -> 'o -> IO unit
-        ; me : process 'i 'o
-        ; ..   (* возможно send тоже надо, т.е. сделать это
-                  подтипом основного context;
-                  вроде бы, в эрланге это таки есть -- можно отвечать
-                  на сообщения не по порядку.  Или reply_to,
-                  оборачивающую ответ как надо. *)
-        >
-     and caller 'o 'i = (process 'o 'i * tag)
+      ; me : process 'i 'o
+      ; my_group : group 'i 'o
+      >
+    ;
 
-  возможно стоит возвращать не process 'i 'o, а его подтип,
-  к которому будет позволено применять
+    (* диспетчер сообщений -- то, что содержит пользовательский код,
+       но обёрнуто в абстрактный тип. *)
 
-value call : process_server 'i 'o -> 'i -> IO 'o;
-*)
+    type dispatcher 'i 'o = context 'i 'o -> ('i -> IO.m unit);
 
+    (*
+    для синхронных серверов предусмотреть что-то похожее на
+    gen_server:handler_call, по прикидкам упрощающее дело:
 
-(* обеспечить мономорфность получающегося типа, чтобы в случае top-level
-   значений были конкретные типы. *)
-value create_process_group : unit -> process_group 'i 'o;
-value create_process : process_group 'i 'o -> dispatcher 'i 'o
-  -> process 'i 'o;
+    value gen_server : (gen_server_context 'i 'o -> ('i * caller) -> IO unit)
+       -> process_server 'i 'o
 
-(* нужно конкретно для частной задачи, поэтому не уверен в ценности:
-   функция шлёт сообщения группе и дожидается ответа каждого из процессов
-   этой группы, затем возвращает массив ответов *)
+         where gen_server_context 'i 'o =
+            < ! i2 . reply: caller 'o 'i2 -> 'o -> IO unit
+            ; me : process 'i 'o
+            ; ..   (* возможно send тоже надо, т.е. сделать это
+                      подтипом основного context;
+                      вроде бы, в эрланге это таки есть -- можно отвечать
+                      на сообщения не по порядку.  Или reply_to,
+                      оборачивающую ответ как надо. *)
+            >
+         and caller 'o 'i = (process 'o 'i * tag)
 
-value send_msg_group_gather_all : process_group 'i 'o -> 'i -> res (array 'o);
+      возможно стоит возвращать не process 'i 'o, а его подтип,
+      к которому будет позволено применять
 
-(* если будет call, то можно будет выразить это как отсылку call-запросов
-  и приём call-ответов *)
+    value call : process_server 'i 'o -> 'i -> IO 'o;
+    *)
 
-(* ответы на сообщения будут производиться через передаваемый
-  в функцию контекст, где будут функции send для простых процессов
-  и reply для call-подобных. *)
+
+    (* обеспечить мономорфность получающегося типа, чтобы в случае top-level
+       значений были конкретные типы. *)
+    value create_process_group : unit -> group 'i 'o;
+    value create_process : group 'i 'o -> dispatcher 'i 'o
+      -> process 'i 'o;
+
+    (* нужно конкретно для частной задачи, поэтому не уверен в ценности:
+       функция шлёт сообщения группе и дожидается ответа каждого из процессов
+       этой группы, затем возвращает массив ответов *)
+
+    value send_msg_group_gather_all
+      : group 'i 'o -> 'i -> IO.m (array 'o);
+    (* если будет call, то можно будет выразить это как отсылку call-запросов
+      и приём call-ответов *)
+
+    (* ответы на сообщения будут производиться через передаваемый
+      в функцию контекст, где будут функции send для простых процессов
+      и reply для call-подобных. *)
+
+  end
+;