├── dune-project ├── docs ├── distributed │ ├── Distributed │ │ ├── .dune-keep │ │ ├── Process_id │ │ │ └── index.html │ │ ├── Node_id │ │ │ └── index.html │ │ ├── Make │ │ │ ├── Local_config │ │ │ │ └── index.html │ │ │ ├── argument-2-M │ │ │ │ └── index.html │ │ │ ├── Remote_config │ │ │ │ └── index.html │ │ │ ├── argument-1-I │ │ │ │ └── index.html │ │ │ └── index.html │ │ ├── module-type-Process │ │ │ ├── Local_config │ │ │ │ └── index.html │ │ │ ├── Remote_config │ │ │ │ └── index.html │ │ │ └── index.html │ │ ├── module-type-Message_type │ │ │ └── index.html │ │ ├── index.html │ │ └── module-type-Nonblock_io │ │ │ └── index.html │ └── index.html ├── distributed-lwt │ ├── Distributed_lwt │ │ ├── .dune-keep │ │ ├── Make │ │ │ ├── argument-2-L │ │ │ │ └── index.html │ │ │ ├── Local_config │ │ │ │ └── index.html │ │ │ ├── argument-1-M │ │ │ │ └── index.html │ │ │ └── Remote_config │ │ │ │ └── index.html │ │ ├── module-type-CustomerLogger │ │ │ └── index.html │ │ └── index.html │ └── index.html ├── distributed-uwt │ ├── Distributed_uwt │ │ ├── .dune-keep │ │ ├── Make │ │ │ ├── argument-2-L │ │ │ │ └── index.html │ │ │ ├── Local_config │ │ │ │ └── index.html │ │ │ ├── argument-1-M │ │ │ │ └── index.html │ │ │ └── Remote_config │ │ │ │ └── index.html │ │ ├── module-type-CustomerLogger │ │ │ └── index.html │ │ └── index.html │ └── index.html ├── index.html ├── highlight.pack.js └── odoc.css ├── tests ├── dune ├── lwt │ ├── dune │ └── test_lwt.ml └── uwt │ ├── dune │ └── test_uwt.ml ├── examples ├── basic_example │ ├── dune │ └── basic.ml ├── ping_pong_example │ ├── dune │ ├── ping_message.ml │ ├── custom_logger.ml │ ├── ping.ml │ └── pong.ml └── name_server_example │ ├── dune │ ├── message.ml │ ├── custom_logger.ml │ ├── add_server.ml │ ├── name_server.ml │ └── add_client.ml ├── .gitignore ├── uwt ├── dune ├── distributed_uwt.mli └── distributed_uwt.ml ├── lwt ├── dune ├── distributed_lwt.mli └── distributed_lwt.ml ├── src ├── dune └── distributed.mli ├── coverage.sh ├── dune-workspace.dev ├── Makefile ├── distributed.opam ├── distributed-uwt.opam ├── distributed-lwt.opam ├── .travis.yml ├── LICENSE.md ├── README.md ├── appveyor.yml └── CHANGES.md /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.0) -------------------------------------------------------------------------------- /docs/distributed/Distributed/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/distributed-lwt/Distributed_lwt/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/distributed-uwt/Distributed_uwt/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /tests/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name test_distributed) 3 | (wrapped false) 4 | (libraries distributed)) -------------------------------------------------------------------------------- /examples/basic_example/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name basic) 3 | (modes (native exe)) 4 | (libraries distributed-lwt logs.lwt)) -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | _tests 3 | _coverage 4 | tmp 5 | *~ 6 | \.\#* 7 | \#*# 8 | *.install 9 | *.native 10 | *.byte 11 | *.merlin -------------------------------------------------------------------------------- /examples/ping_pong_example/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names ping pong) 3 | (modes (native exe) (native exe)) 4 | (libraries distributed-lwt logs.lwt)) 5 | 6 | -------------------------------------------------------------------------------- /examples/name_server_example/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names add_client add_server name_server) 3 | (modes (native exe) (native exe) (native exe)) 4 | (libraries distributed-lwt logs.lwt)) 5 | -------------------------------------------------------------------------------- /uwt/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name distributed_uwt) 3 | (public_name distributed-uwt) 4 | (synopsis "A uwt based implementation of Distributed.") 5 | (wrapped false) 6 | (libraries distributed uwt logs.lwt)) 7 | -------------------------------------------------------------------------------- /examples/ping_pong_example/ping_message.ml: -------------------------------------------------------------------------------- 1 | type t = Ping of string 2 | | Pong of string 3 | 4 | let string_of_message = function 5 | | Ping s -> Format.sprintf "Ping %s" s 6 | | Pong s -> Format.sprintf "Pong %s" s -------------------------------------------------------------------------------- /lwt/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name distributed_lwt) 3 | (public_name distributed-lwt) 4 | (synopsis "A lwt based implementation of Distributed.") 5 | (wrapped false) 6 | (libraries distributed lwt lwt.unix logs.lwt)) 7 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name distributed) 3 | (public_name distributed) 4 | (synopsis "Library to provide Erlang style distributed computations. This library is inspired by Cloud Haskell.") 5 | (libraries unix) 6 | (wrapped false)) -------------------------------------------------------------------------------- /tests/lwt/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name test_lwt) 3 | (libraries test_distributed lwt lwt.unix logs.lwt) 4 | (modes (native exe))) 5 | 6 | (alias 7 | (name runtest) 8 | (deps test_lwt.exe) 9 | (package distributed-lwt) 10 | (action (run %{exe:test_lwt.exe}))) 11 | -------------------------------------------------------------------------------- /tests/uwt/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name test_uwt) 3 | (libraries test_distributed uwt logs.lwt) 4 | (modes (native exe))) 5 | 6 | (alias 7 | (name runtest-uwt) 8 | (deps test_uwt.exe) 9 | (package distributed-uwt) 10 | (action (run %{exe:test_uwt.exe}))) 11 | 12 | 13 | -------------------------------------------------------------------------------- /coverage.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -e 4 | set -x 5 | 6 | echo "Installing bisect_ppx" 7 | #opam install bisect_ppx 8 | 9 | echo "Running test and making coverage report" 10 | #make clean 11 | #dune runtest 12 | #bisect-ppx-report -I _build/default/ --coveralls coverage.json --service-name travis-ci --service-job-id $TRAVIS_JOB_ID `find . -name 'bisect*.out'` 13 | 14 | echo "Uploading coverage report" 15 | #curl -L -F json_file=@./coverage.json https://coveralls.io/api/v1/jobs 16 | -------------------------------------------------------------------------------- /dune-workspace.dev: -------------------------------------------------------------------------------- 1 | (lang dune 1.0) 2 | 3 | ; note that because the tests use sockets, and dune runs jobs in parallel this will 4 | ; fail (Unix.EADDRINUSE) unless dune is invoked with -j 1 5 | 6 | ;(context (opam (switch 4.02.3))) 7 | ;(context (opam (switch 4.03.0))) 8 | ;(context (opam (switch 4.04.0))) 9 | ;(context (opam (switch 4.05.0))) 10 | ;(context (opam (switch 4.06.1))) 11 | ;(context (opam (switch 4.07.1))) 12 | ;(context (opam (switch 4.08.1))) 13 | ;(context (opam (switch 4.09.0))) 14 | 15 | (context default) 16 | -------------------------------------------------------------------------------- /examples/name_server_example/message.ml: -------------------------------------------------------------------------------- 1 | type t = Register of string * Distributed.Process_id.t 2 | | Register_ok 3 | | Whois of string * Distributed.Process_id.t 4 | | Whois_result of Distributed.Process_id.t 5 | | Add of int * int * Distributed.Process_id.t 6 | | Add_result of int 7 | 8 | let string_of_message = function 9 | | Register (s,_) -> Format.sprintf "Register %s" s 10 | | Register_ok -> "Register O.K." 11 | | Whois (s,_) -> Format.sprintf "Who is %s" s 12 | | Whois_result _ -> "Who is result " 13 | | Add (i,j,_) -> Format.sprintf "Add %d %d" i j 14 | | Add_result r -> Format.sprintf "Add result %d" r -------------------------------------------------------------------------------- /docs/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | index 5 | 6 | 7 | 8 | 9 | 10 |
11 |
12 |

OCaml package documentation

13 |
    14 |
  1. distributed 0.6.0
    2. 15 |
  2. distributed-lwt 0.2.0
    3. 16 |
  3. distributed-uwt 0.2.0
    4. 17 |
18 |
19 |
20 | 21 | -------------------------------------------------------------------------------- /docs/distributed/index.html: -------------------------------------------------------------------------------- 1 | 2 | index (distributed.index)

distributed index

Library distributed

The entry point of this library is the module: Distributed.

-------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY : build clean lwt_test uwt_test doc test_all_ocaml_lwt test_all_ocaml_uwt examples 2 | 3 | build : 4 | dune build --workspace dune-workspace.dev 5 | 6 | lwt_test : clean 7 | dune runtest 8 | 9 | uwt_test : clean 10 | dune build @runtest-uwt 11 | 12 | clean : 13 | dune clean 14 | rm -f `find . -name 'bisect*.out'` 15 | rm -rf _coverage/ 16 | 17 | doc : 18 | dune build @doc 19 | 20 | test_all_ocaml_lwt : clean 21 | dune runtest --workspace dune-workspace.dev -j 1 22 | 23 | test_all_ocaml_uwt : clean 24 | dune build @runtest-uwt --workspace dune-workspace.dev -j 1 25 | 26 | examples: 27 | dune build examples/basic_example/basic.exe 28 | dune build examples/name_server_example/add_client.exe 29 | dune build examples/name_server_example/add_server.exe 30 | dune build examples/name_server_example/name_server.exe 31 | dune build examples/ping_pong_example/ping.exe 32 | dune build examples/ping_pong_example/pong.exe 33 | -------------------------------------------------------------------------------- /docs/distributed-lwt/index.html: -------------------------------------------------------------------------------- 1 | 2 | index (distributed-lwt.index)

distributed-lwt index

Library distributed-lwt

The entry point of this library is the module: Distributed_lwt.

-------------------------------------------------------------------------------- /docs/distributed-uwt/index.html: -------------------------------------------------------------------------------- 1 | 2 | index (distributed-uwt.index)

distributed-uwt index

Library distributed-uwt

The entry point of this library is the module: Distributed_uwt.

-------------------------------------------------------------------------------- /docs/distributed/Distributed/Process_id/index.html: -------------------------------------------------------------------------------- 1 | 2 | Process_id (distributed.Distributed.Process_id)

Module Distributed.Process_id

This module provides a type representing a process id.

type t

The abstract type representing a process id.

-------------------------------------------------------------------------------- /examples/ping_pong_example/custom_logger.ml: -------------------------------------------------------------------------------- 1 | let log_src = Logs.Src.create "distributed" ~doc:"logs events related to the distributed library" 2 | 3 | module Log = (val Logs_lwt.src_log log_src : Logs_lwt.LOG) 4 | 5 | let msg = Log.msg 6 | 7 | (* slightly modified version of reporter defined in Logs_lwt manual : http://erratique.ch/software/logs/doc/Logs_lwt.html#report_ex*) 8 | let lwt_reporter () = 9 | let buf_fmt () = 10 | let b = Buffer.create 512 in 11 | Format.formatter_of_buffer b, fun () -> let m = Buffer.contents b in Buffer.reset b; m 12 | in 13 | let app, app_flush = buf_fmt () in 14 | let reporter = Logs.format_reporter ~app ~dst:app () in 15 | let report src level ~over k msgf = 16 | let k' () = 17 | let write () = Lwt_io.write Lwt_io.stdout (app_flush ()) in 18 | let unblock () = over (); Lwt.return_unit in 19 | Lwt.finalize write unblock |> ignore; 20 | k () 21 | in 22 | reporter.Logs.report src level ~over:(fun () -> ()) k' msgf; 23 | in 24 | { Logs.report = report } -------------------------------------------------------------------------------- /examples/name_server_example/custom_logger.ml: -------------------------------------------------------------------------------- 1 | let log_src = Logs.Src.create "distributed" ~doc:"logs events related to the distributed library" 2 | 3 | module Log = (val Logs_lwt.src_log log_src : Logs_lwt.LOG) 4 | 5 | let msg = Log.msg 6 | 7 | (* slightly modified version of reporter defined in Logs_lwt manual : http://erratique.ch/software/logs/doc/Logs_lwt.html#report_ex*) 8 | let lwt_reporter () = 9 | let buf_fmt () = 10 | let b = Buffer.create 512 in 11 | Format.formatter_of_buffer b, fun () -> let m = Buffer.contents b in Buffer.reset b; m 12 | in 13 | let app, app_flush = buf_fmt () in 14 | let reporter = Logs.format_reporter ~app ~dst:app () in 15 | let report src level ~over k msgf = 16 | let k' () = 17 | let write () = Lwt_io.write Lwt_io.stdout (app_flush ()) in 18 | let unblock () = over (); Lwt.return_unit in 19 | Lwt.finalize write unblock |> ignore; 20 | k () 21 | in 22 | reporter.Logs.report src level ~over:(fun () -> ()) k' msgf; 23 | in 24 | { Logs.report = report } -------------------------------------------------------------------------------- /distributed.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "distributed" 3 | version: "0.6.0" 4 | maintainer: "essdotteedot " 5 | authors: [ "essdotteedot " ] 6 | license: "MIT" 7 | homepage: "https://github.com/essdotteedot/distributed" 8 | dev-repo: "git+https://github.com/essdotteedot/distributed.git" 9 | bug-reports: "https://github.com/essdotteedot/distributed/issues" 10 | doc: "https://essdotteedot.github.io/distributed/" 11 | 12 | build: [ 13 | ["dune" "build" "-p" name "-j" jobs] 14 | ] 15 | 16 | depends: [ 17 | "dune" {>= "1.11.0"} 18 | "base-unix" 19 | "ocaml" {>= "4.02.3"} 20 | ] 21 | 22 | synopsis: "Library to provide Erlang style distributed computations. This library is inspired by Cloud Haskell" 23 | 24 | description: """ 25 | Primitive for spawning processes (in the Erlang sense) either remotely or locally, monitoring/unmonitoring spawned processes, sending, 26 | receiving, broadcasting messages to those processes. Unlike Erlang, the messages that are sent between processes are typed. 27 | """ -------------------------------------------------------------------------------- /distributed-uwt.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "distributed-uwt" 3 | version: "0.2.0" 4 | maintainer: "essdotteedot " 5 | authors: [ "essdotteedot " ] 6 | license: "MIT" 7 | homepage: "https://github.com/essdotteedot/distributed" 8 | dev-repo: "git+https://github.com/essdotteedot/distributed.git" 9 | bug-reports: "https://github.com/essdotteedot/distributed/issues" 10 | doc: "https://essdotteedot.github.io/distributed/" 11 | 12 | build: [ 13 | ["dune" "build" "-p" name "-j" jobs] 14 | ] 15 | 16 | depends: [ 17 | "dune" {>= "1.11.0"} 18 | "distributed" {= "0.6.0"} 19 | "logs" 20 | "uwt" 21 | "ocaml" {>= "4.02.3"} 22 | ] 23 | 24 | synopsis: "A library to probide a uwt based implementation of Distributed" 25 | 26 | description: """ 27 | Primitive for spawning processes (in the Erlang sense) either remotely or locally, monitoring/unmonitoring spawned processes, sending, 28 | receiving, broadcasting messages to those processes. Unlike Erlang, the messages that are sent between processes are typed. 29 | """ -------------------------------------------------------------------------------- /distributed-lwt.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "distributed-lwt" 3 | version: "0.2.0" 4 | maintainer: "essdotteedot " 5 | authors: [ "essdotteedot " ] 6 | license: "MIT" 7 | homepage: "https://github.com/essdotteedot/distributed" 8 | dev-repo: "git+https://github.com/essdotteedot/distributed.git" 9 | bug-reports: "https://github.com/essdotteedot/distributed/issues" 10 | doc: "https://essdotteedot.github.io/distributed/" 11 | 12 | build: [ 13 | ["dune" "build" "-p" name "-j" jobs] 14 | ] 15 | 16 | depends: [ 17 | "dune" {>= "1.11.0"} 18 | "distributed" {= "0.6.0"} 19 | "logs" 20 | "lwt" {>= "3.2.0"} 21 | "ocaml" {>= "4.02.3"} 22 | ] 23 | 24 | synopsis: "A library to probide a lwt based implementation of Distributed" 25 | 26 | description: """ 27 | Primitive for spawning processes (in the Erlang sense) either remotely or locally, monitoring/unmonitoring spawned processes, sending, 28 | receiving, broadcasting messages to those processes. Unlike Erlang, the messages that are sent between processes are typed. 29 | """ -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | sudo: required 3 | install: 4 | - wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-opam.sh 5 | script: 6 | - bash -ex .travis-opam.sh 7 | env: 8 | global: 9 | - PINS="distributed:. distributed-lwt:. lwt" 10 | matrix: 11 | - OCAML_VERSION=4.02 PACKAGE=distributed-lwt POST_INSTALL_HOOK="bash -ex ./coverage.sh" 12 | - OCAML_VERSION=4.03 PACKAGE=distributed-lwt POST_INSTALL_HOOK="bash -ex ./coverage.sh" 13 | - OCAML_VERSION=4.04 PACKAGE=distributed-lwt POST_INSTALL_HOOK="bash -ex ./coverage.sh" 14 | - OCAML_VERSION=4.05 PACKAGE=distributed-lwt POST_INSTALL_HOOK="bash -ex ./coverage.sh" 15 | - OCAML_VERSION=4.06 PACKAGE=distributed-lwt POST_INSTALL_HOOK="bash -ex ./coverage.sh" 16 | - OCAML_VERSION=4.07 PACKAGE=distributed-lwt POST_INSTALL_HOOK="bash -ex ./coverage.sh" 17 | - OCAML_VERSION=4.08 PACKAGE=distributed-lwt POST_INSTALL_HOOK="bash -ex ./coverage.sh" 18 | - OCAML_VERSION=4.09 PACKAGE=distributed-lwt POST_INSTALL_HOOK="bash -ex ./coverage.sh" 19 | os: 20 | - linux 21 | - osx 22 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2016-2019 essdotteedot 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /docs/distributed-lwt/Distributed_lwt/Make/argument-2-L/index.html: -------------------------------------------------------------------------------- 1 | 2 | 2-L (distributed-lwt.Distributed_lwt.Make.2-L)

Parameter Make.2-L

val msg : Logs.level -> 'a Logs_lwt.log

msg level logger returns a logger that can be use to log levels at the provided level. The returned thread only proceeds once the log operation is over.

-------------------------------------------------------------------------------- /docs/distributed-uwt/Distributed_uwt/Make/argument-2-L/index.html: -------------------------------------------------------------------------------- 1 | 2 | 2-L (distributed-uwt.Distributed_uwt.Make.2-L)

Parameter Make.2-L

val msg : Logs.level -> 'a Logs_lwt.log

msg level logger returns a logger that can be use to log levels at the provided level. The returned thread only proceeds once the log operation is over.

-------------------------------------------------------------------------------- /docs/distributed/Distributed/Node_id/index.html: -------------------------------------------------------------------------------- 1 | 2 | Node_id (distributed.Distributed.Node_id)

Module Distributed.Node_id

This module provides a type representing a node id.

type t

The abstract type representing a node id.

val get_name : t -> string

get_name node returns the name of the node.

-------------------------------------------------------------------------------- /docs/distributed-lwt/Distributed_lwt/module-type-CustomerLogger/index.html: -------------------------------------------------------------------------------- 1 | 2 | CustomerLogger (distributed-lwt.Distributed_lwt.CustomerLogger)

Module type Distributed_lwt.CustomerLogger

This module provides a Log_lwt based logger to use.

val msg : Logs.level -> 'a Logs_lwt.log

msg level logger returns a logger that can be use to log levels at the provided level. The returned thread only proceeds once the log operation is over.

-------------------------------------------------------------------------------- /docs/distributed-uwt/Distributed_uwt/module-type-CustomerLogger/index.html: -------------------------------------------------------------------------------- 1 | 2 | CustomerLogger (distributed-uwt.Distributed_uwt.CustomerLogger)

Module type Distributed_uwt.CustomerLogger

This module provides a Log_lwt based logger to use.

val msg : Logs.level -> 'a Logs_lwt.log

msg level logger returns a logger that can be use to log levels at the provided level. The returned thread only proceeds once the log operation is over.

-------------------------------------------------------------------------------- /lwt/distributed_lwt.mli: -------------------------------------------------------------------------------- 1 | (** A lwt based implementation of {!module:Distributed}. Note, that this lwt based implmentation depends on the [Logs_lwt] library. 2 | In keeping with the usage conventions of the [Logs] library, this implementation does not define a source, it does not set the 3 | log level, and it does not define a reporter. The application is expected to define a source, set the log level, and define 4 | a reporter (see the examples). 5 | 6 | @author essdotteedot 7 | @version 0.2.0 8 | *) 9 | 10 | (** This module provides a Log_lwt based logger to use. *) 11 | module type CustomerLogger = sig 12 | 13 | val msg : Logs.level -> 'a Logs_lwt.log 14 | (** [msg level logger] returns a logger that can be use to log levels at the provided level. The returned thread only proceeds once the log operation is over. *) 15 | end 16 | 17 | module Make (M : Distributed.Message_type) (L : CustomerLogger) : (Distributed.Process with type 'a io = 'a Lwt.t and type message_type = M.t) 18 | (** Functor to create a module of type {!module:Distributed.Process} given a message module [M] of type {!module:Distributed.Message_type} 19 | and a custom logger module [L] of type {!module:CustomerLogger}. *) -------------------------------------------------------------------------------- /uwt/distributed_uwt.mli: -------------------------------------------------------------------------------- 1 | (** A uwt based implementation of {!module:Distributed}. Note, that this lwt based implmentation depends on the [Logs_lwt] library. 2 | In keeping with the usage conventions of the [Logs] library, this implementation does not define a source, it does not set the 3 | log level, and it does not define a reporter. The application is expected to define a source, set the log level, and define 4 | a reporter (see the examples). 5 | 6 | @author essdotteedot 7 | @version 0.2.0 8 | *) 9 | 10 | (** This module provides a Log_lwt based logger to use. *) 11 | module type CustomerLogger = sig 12 | 13 | val msg : Logs.level -> 'a Logs_lwt.log 14 | (** [msg level logger] returns a logger that can be use to log levels at the provided level. The returned thread only proceeds once the log operation is over. *) 15 | end 16 | 17 | module Make (M : Distributed.Message_type) (L : CustomerLogger) : (Distributed.Process with type 'a io = 'a Lwt.t and type message_type = M.t) 18 | (** Functor to create a module of type {!module:Distributed.Process} given a message module [M] of type {!module:Distributed.Message_type} 19 | and a custom logger module [L] of type {!module:CustomerLogger}. *) -------------------------------------------------------------------------------- /docs/distributed/Distributed/Make/Local_config/index.html: -------------------------------------------------------------------------------- 1 | 2 | Local_config (distributed.Distributed.Make.Local_config)

Module Make.Local_config

The configuration of a node to be run as a local node i.e., one that can not send or receive messages with other nodes.

type t = {
node_name : string;

The name of this node.

}
-------------------------------------------------------------------------------- /docs/distributed/Distributed/Make/argument-2-M/index.html: -------------------------------------------------------------------------------- 1 | 2 | 2-M (distributed.Distributed.Make.2-M)

Parameter Make.2-M

type t

Abstract type representing the messages that will be sent between processes.

val string_of_message : t -> string

string_of_message msg returns the string representation of msg.

-------------------------------------------------------------------------------- /docs/distributed-lwt/Distributed_lwt/Make/Local_config/index.html: -------------------------------------------------------------------------------- 1 | 2 | Local_config (distributed-lwt.Distributed_lwt.Make.Local_config)

Module Make.Local_config

The configuration of a node to be run as a local node i.e., one that can not send or receive messages with other nodes.

type t = {
node_name : string;

The name of this node.

}
-------------------------------------------------------------------------------- /docs/distributed-uwt/Distributed_uwt/Make/Local_config/index.html: -------------------------------------------------------------------------------- 1 | 2 | Local_config (distributed-uwt.Distributed_uwt.Make.Local_config)

Module Make.Local_config

The configuration of a node to be run as a local node i.e., one that can not send or receive messages with other nodes.

type t = {
node_name : string;

The name of this node.

}
-------------------------------------------------------------------------------- /docs/distributed/Distributed/module-type-Process/Local_config/index.html: -------------------------------------------------------------------------------- 1 | 2 | Local_config (distributed.Distributed.Process.Local_config)

Module Process.Local_config

The configuration of a node to be run as a local node i.e., one that can not send or receive messages with other nodes.

type t = {
node_name : string;

The name of this node.

}
-------------------------------------------------------------------------------- /docs/distributed-lwt/Distributed_lwt/Make/argument-1-M/index.html: -------------------------------------------------------------------------------- 1 | 2 | 1-M (distributed-lwt.Distributed_lwt.Make.1-M)

Parameter Make.1-M

type t

Abstract type representing the messages that will be sent between processes.

val string_of_message : t -> string

string_of_message msg returns the string representation of msg.

-------------------------------------------------------------------------------- /docs/distributed-uwt/Distributed_uwt/Make/argument-1-M/index.html: -------------------------------------------------------------------------------- 1 | 2 | 1-M (distributed-uwt.Distributed_uwt.Make.1-M)

Parameter Make.1-M

type t

Abstract type representing the messages that will be sent between processes.

val string_of_message : t -> string

string_of_message msg returns the string representation of msg.

-------------------------------------------------------------------------------- /docs/distributed/Distributed/module-type-Message_type/index.html: -------------------------------------------------------------------------------- 1 | 2 | Message_type (distributed.Distributed.Message_type)

Module type Distributed.Message_type

The abstract type representing the messages that will be sent between processes.

type t

Abstract type representing the messages that will be sent between processes.

val string_of_message : t -> string

string_of_message msg returns the string representation of msg.

-------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # distributed [![Build Status](https://travis-ci.org/essdotteedot/distributed.svg?branch=master)](https://travis-ci.org/essdotteedot/distributed) [![Coverage Status](https://coveralls.io/repos/github/essdotteedot/distributed/badge.svg?branch=master)](https://coveralls.io/github/essdotteedot/distributed?branch=master) [![Docs Online](https://img.shields.io/badge/Docs-Online-brightgreen.svg)](https://essdotteedot.github.io/distributed/) [![Appveyor Status](https://ci.appveyor.com/api/projects/status/github/essdotteedot/distributed?branch=master&svg=true)](https://ci.appveyor.com/project/essdotteedot/distributed) 2 | Library to provide Erlang style distributed computations. This library is inspired by Cloud Haskell. 3 | 4 | Primitives for spawning processes (in the Erlang sense) either remotely or locally, monitoring/unmonitoring spawned processes, sending, 5 | receiving, broadcasting messages to those processes. Unlike Erlang, the messages that are sent between processes are typed. 6 | 7 | Installation 8 | ------------ 9 | 10 | The core library, lwt implementation, and uwt implementation are available via [OPAM](https://opam.ocaml.org): 11 | 12 | $ opam install distributed 13 | 14 | $ opam install distributed-lwt 15 | 16 | $ opam install distributed-uwt 17 | 18 | Documentation 19 | ------------- 20 | 21 | The API documentation is available [here](https://essdotteedot.github.io/distributed/). 22 | Example programs can be found in the [examples](examples) directory. 23 | 24 | License 25 | ------- 26 | 27 | [MIT License](LICENSE.md) 28 | -------------------------------------------------------------------------------- /examples/ping_pong_example/ping.ml: -------------------------------------------------------------------------------- 1 | module D = Distributed_lwt.Make (Ping_message) (Custom_logger) 2 | 3 | let config = D.Remote { D.Remote_config.node_name = "ping_node" ; 4 | D.Remote_config.local_port = 46000 ; 5 | D.Remote_config.connection_backlog = 10 ; 6 | D.Remote_config.node_ip = "127.0.0.1" ; 7 | D.Remote_config.remote_nodes = [("127.0.0.1",47000,"pong_node")] ; 8 | } 9 | 10 | let rec ping_loop (counter : int) () = D.( 11 | get_remote_node "pong_node" >>= function 12 | | None -> lift_io (Lwt_io.printl "Remote node pong is not up, exiting") 13 | | Some node' -> 14 | broadcast node' (Ping_message.Ping (string_of_int counter)) >>= fun () -> 15 | receive @@ 16 | case (function 17 | | Ping_message.Pong s -> Some (fun () -> lift_io (Lwt_io.printl @@ Format.sprintf "Got message Pong %s" s)) 18 | | v -> Some (fun () -> 19 | lift_io (Lwt_io.printl @@ Format.sprintf "Got unexpected message %s" (Ping_message.string_of_message v)) >>= fun () -> 20 | assert false) 21 | ) 22 | >>= fun _ -> 23 | lift_io (Lwt_unix.sleep 1.0) >>= fun () -> 24 | ping_loop (counter + 1) () 25 | ) 26 | 27 | let () = 28 | Logs.Src.set_level Custom_logger.log_src (Some Logs.App) ; 29 | Logs.set_reporter @@ Custom_logger.lwt_reporter () ; 30 | Lwt.(Lwt_main.run (D.run_node ~process:(ping_loop(0)) config >>= fun () -> fst @@ wait ())) -------------------------------------------------------------------------------- /examples/ping_pong_example/pong.ml: -------------------------------------------------------------------------------- 1 | module D = Distributed_lwt.Make (Ping_message) (Custom_logger) 2 | 3 | let config = D.Remote { D.Remote_config.node_name = "pong_node" ; 4 | D.Remote_config.local_port = 47000 ; 5 | D.Remote_config.connection_backlog = 10 ; 6 | D.Remote_config.node_ip = "127.0.0.1" ; 7 | D.Remote_config.remote_nodes = [] ; 8 | } 9 | 10 | let counter = ref 0 11 | 12 | let pong () = D.( 13 | receive_loop @@ 14 | case (function 15 | | Ping_message.Ping s -> Some (fun () -> 16 | lift_io (Lwt_io.printl @@ Format.sprintf "Got message Ping %s" s) >>= fun () -> 17 | get_remote_node "ping_node" >>= 18 | begin 19 | function 20 | | None -> 21 | lift_io (Lwt_io.printl "Remote node ping is not up, exiting") >>= fun () -> 22 | return false 23 | | Some rnode -> 24 | broadcast rnode (Ping_message.Pong (string_of_int !counter)) >>= fun () -> 25 | counter := !counter + 1 ; 26 | return true 27 | end) 28 | | v -> Some (fun () -> 29 | lift_io (Lwt_io.printl @@ Format.sprintf "Got unexpected message %s" (Ping_message.string_of_message v)) >>= fun () -> 30 | assert false) 31 | ) 32 | ) 33 | 34 | let () = 35 | Logs.Src.set_level Custom_logger.log_src (Some Logs.App) ; 36 | Logs.set_reporter @@ Custom_logger.lwt_reporter () ; 37 | Lwt.(Lwt_main.run ((D.run_node ~process:pong config) >>= fun () -> fst @@ wait ())) -------------------------------------------------------------------------------- /appveyor.yml: -------------------------------------------------------------------------------- 1 | platform: 2 | - x64 3 | 4 | environment: 5 | FORK_USER: ocaml 6 | FORK_BRANCH: master 7 | CYG_ROOT: C:\cygwin64 8 | 9 | matrix: 10 | - OPAM_SWITCH: 4.02.3+mingw64c 11 | PACKAGE: distributed-uwt 12 | PINS: "distributed:. distributed-uwt:. uwt" 13 | POST_INSTALL_HOOK: "dune build @runtest-uwt" 14 | 15 | - OPAM_SWITCH: 4.03.0+mingw64c 16 | PACKAGE: distributed-uwt 17 | PINS: "distributed:. distributed-uwt:. uwt" 18 | POST_INSTALL_HOOK: "dune build @runtest-uwt" 19 | 20 | - OPAM_SWITCH: 4.04.0+mingw64c 21 | PACKAGE: distributed-uwt 22 | PINS: "distributed:. distributed-uwt:. uwt" 23 | POST_INSTALL_HOOK: "dune build @runtest-uwt" 24 | 25 | - OPAM_SWITCH: 4.05.0+mingw64c 26 | PACKAGE: distributed-uwt 27 | PINS: "distributed:. distributed-uwt:. uwt" 28 | POST_INSTALL_HOOK: "dune build @runtest-uwt" 29 | 30 | - OPAM_SWITCH: 4.06.1+mingw64c 31 | PACKAGE: distributed-uwt 32 | PINS: "distributed:. distributed-uwt:. uwt" 33 | POST_INSTALL_HOOK: "dune build @runtest-uwt" 34 | 35 | - OPAM_SWITCH: 4.07.1+mingw64c 36 | PACKAGE: distributed-uwt 37 | PINS: "distributed:. distributed-uwt:. uwt" 38 | POST_INSTALL_HOOK: "dune build @runtest-uwt" 39 | 40 | - OPAM_SWITCH: 4.08.1+mingw64c 41 | PACKAGE: distributed-uwt 42 | PINS: "distributed:. distributed-uwt:. uwt" 43 | POST_INSTALL_HOOK: "dune build @runtest-uwt" 44 | 45 | - OPAM_SWITCH: 4.09.0+mingw64c 46 | PACKAGE: distributed-uwt 47 | PINS: "distributed:. distributed-uwt:. uwt" 48 | POST_INSTALL_HOOK: "dune build @runtest-uwt" 49 | 50 | install: 51 | - ps: iex ((new-object net.webclient).DownloadString("https://raw.githubusercontent.com/$env:FORK_USER/ocaml-ci-scripts/$env:FORK_BRANCH/appveyor-install.ps1")) 52 | 53 | build_script: 54 | - call %CYG_ROOT%\bin\bash.exe -l %APPVEYOR_BUILD_FOLDER%\appveyor-opam.sh 55 | 56 | -------------------------------------------------------------------------------- /lwt/distributed_lwt.ml: -------------------------------------------------------------------------------- 1 | module type CustomerLogger = sig 2 | 3 | val msg : Logs.level -> 'a Logs_lwt.log 4 | end 5 | 6 | module IO_LWT(L : CustomerLogger) = struct 7 | 8 | type 'a t = 'a Lwt.t 9 | 10 | type 'a stream = 'a Lwt_stream.t 11 | 12 | type input_channel = Lwt_io.input_channel 13 | 14 | type output_channel = Lwt_io.output_channel 15 | 16 | type server = Lwt_io.server 17 | 18 | type level = Debug 19 | | Info 20 | | Warning 21 | | Error 22 | 23 | exception Timeout = Lwt_unix.Timeout 24 | 25 | let lib_name = "Distributed_lwt" 26 | 27 | let lib_version = "0.2.0" 28 | 29 | let lib_description = "A Lwt based implementation." 30 | 31 | let return = Lwt.return 32 | 33 | let (>>=) = Lwt.(>>=) 34 | 35 | let fail = Lwt.fail 36 | 37 | let catch = Lwt.catch 38 | 39 | let async = Lwt.async 40 | 41 | let create_stream = Lwt_stream.create 42 | 43 | let get = Lwt_stream.get 44 | 45 | let stream_append = Lwt_stream.append 46 | 47 | let close_input = Lwt_io.close 48 | 49 | let close_output = Lwt_io.close 50 | 51 | let read_value = Lwt_io.read_value 52 | 53 | let write_value = Lwt_io.write_value 54 | 55 | let open_connection sock_addr = Lwt_io.open_connection sock_addr 56 | 57 | let establish_server ?backlog sock_addr server_fn = Lwt_io.establish_server_with_client_address ?backlog sock_addr server_fn 58 | 59 | let of_logs_lwt_level = function 60 | | Debug -> Logs.Debug 61 | | Info -> Logs.Info 62 | | Warning -> Logs.Warning 63 | | Error -> Logs.Error 64 | 65 | let log (level:level) (msg_fmtter:unit -> string) = 66 | L.msg (of_logs_lwt_level level) (fun m -> m "%s" @@ msg_fmtter ()) >>= fun _ -> return () 67 | 68 | let shutdown_server = Lwt_io.shutdown_server 69 | 70 | let sleep = Lwt_unix.sleep 71 | 72 | let timeout = Lwt_unix.timeout 73 | 74 | let pick = Lwt.pick 75 | 76 | let at_exit = Lwt_main.at_exit 77 | 78 | end 79 | 80 | module Make(M : Distributed.Message_type) (L : CustomerLogger) : (Distributed.Process with type 'a io = 'a Lwt.t and type message_type = M.t) = 81 | Distributed.Make(IO_LWT(L))(M) -------------------------------------------------------------------------------- /uwt/distributed_uwt.ml: -------------------------------------------------------------------------------- 1 | module type CustomerLogger = sig 2 | 3 | val msg : Logs.level -> 'a Logs_lwt.log 4 | end 5 | 6 | module IO_UWT(L : CustomerLogger) = struct 7 | 8 | type 'a t = 'a Lwt.t 9 | 10 | type 'a stream = 'a Lwt_stream.t 11 | 12 | type input_channel = Uwt_io.input_channel 13 | 14 | type output_channel = Uwt_io.output_channel 15 | 16 | type server = Uwt_io.server 17 | 18 | type level = Debug 19 | | Info 20 | | Warning 21 | | Error 22 | 23 | exception Timeout = Uwt_compat.Lwt_unix.Timeout 24 | 25 | let lib_name = "Distributed_uwt" 26 | 27 | let lib_version = "0.2.0" 28 | 29 | let lib_description = "A Uwt based implementation." 30 | 31 | let return = Lwt.return 32 | 33 | let (>>=) = Lwt.(>>=) 34 | 35 | let fail = Lwt.fail 36 | 37 | let catch = Lwt.catch 38 | 39 | let async = Lwt.async 40 | 41 | let create_stream = Lwt_stream.create 42 | 43 | let get = Lwt_stream.get 44 | 45 | let stream_append = Lwt_stream.append 46 | 47 | let close_input = Uwt_io.close 48 | 49 | let close_output = Uwt_io.close 50 | 51 | let read_value = Uwt_io.read_value 52 | 53 | let write_value = Uwt_io.write_value 54 | 55 | let open_connection sock_addr = Uwt_io.open_connection sock_addr 56 | 57 | let establish_server ?backlog sock_addr server_fn = Uwt_io.establish_server_with_client_address ?backlog sock_addr server_fn 58 | 59 | let of_logs_lwt_level = function 60 | | Debug -> Logs.Debug 61 | | Info -> Logs.Info 62 | | Warning -> Logs.Warning 63 | | Error -> Logs.Error 64 | 65 | let log (level:level) (msg_fmtter:unit -> string) = 66 | L.msg (of_logs_lwt_level level) (fun m -> m "%s" @@ msg_fmtter ()) >>= fun _ -> return () 67 | 68 | let shutdown_server = Uwt_io.shutdown_server 69 | 70 | let sleep = Uwt_compat.Lwt_unix.sleep 71 | 72 | let timeout = Uwt_compat.Lwt_unix.timeout 73 | 74 | let pick = Lwt.pick 75 | 76 | let at_exit = Uwt.Main.at_exit 77 | 78 | end 79 | 80 | module Make(M : Distributed.Message_type) (L : CustomerLogger) : (Distributed.Process with type 'a io = 'a Lwt.t and type message_type = M.t) = 81 | Distributed.Make(IO_UWT(L))(M) -------------------------------------------------------------------------------- /docs/distributed/Distributed/Make/Remote_config/index.html: -------------------------------------------------------------------------------- 1 | 2 | Remote_config (distributed.Distributed.Make.Remote_config)

Module Make.Remote_config

The configuration of a node to be run as a remote node i.e., one that can both send an receive messages with other nodes.

type t = {
remote_nodes : (string * int * string) list;

The initial list of remote nodes which this node can send messages to. A list of external ip address/port/node name triplets.

local_port : int;

The port that this node should run on.

connection_backlog : int;

The the argument used when listening on a socket.

node_name : string;

The name of this node.

node_ip : string;

The external ip address of this node.

}
-------------------------------------------------------------------------------- /docs/distributed-lwt/Distributed_lwt/Make/Remote_config/index.html: -------------------------------------------------------------------------------- 1 | 2 | Remote_config (distributed-lwt.Distributed_lwt.Make.Remote_config)

Module Make.Remote_config

The configuration of a node to be run as a remote node i.e., one that can both send an receive messages with other nodes.

type t = {
remote_nodes : (string * int * string) list;

The initial list of remote nodes which this node can send messages to. A list of external ip address/port/node name triplets.

local_port : int;

The port that this node should run on.

connection_backlog : int;

The the argument used when listening on a socket.

node_name : string;

The name of this node.

node_ip : string;

The external ip address of this node.

}
-------------------------------------------------------------------------------- /docs/distributed-uwt/Distributed_uwt/Make/Remote_config/index.html: -------------------------------------------------------------------------------- 1 | 2 | Remote_config (distributed-uwt.Distributed_uwt.Make.Remote_config)

Module Make.Remote_config

The configuration of a node to be run as a remote node i.e., one that can both send an receive messages with other nodes.

type t = {
remote_nodes : (string * int * string) list;

The initial list of remote nodes which this node can send messages to. A list of external ip address/port/node name triplets.

local_port : int;

The port that this node should run on.

connection_backlog : int;

The the argument used when listening on a socket.

node_name : string;

The name of this node.

node_ip : string;

The external ip address of this node.

}
-------------------------------------------------------------------------------- /docs/distributed/Distributed/module-type-Process/Remote_config/index.html: -------------------------------------------------------------------------------- 1 | 2 | Remote_config (distributed.Distributed.Process.Remote_config)

Module Process.Remote_config

The configuration of a node to be run as a remote node i.e., one that can both send an receive messages with other nodes.

type t = {
remote_nodes : (string * int * string) list;

The initial list of remote nodes which this node can send messages to. A list of external ip address/port/node name triplets.

local_port : int;

The port that this node should run on.

connection_backlog : int;

The the argument used when listening on a socket.

node_name : string;

The name of this node.

node_ip : string;

The external ip address of this node.

}
-------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## 0.6.0 (2019-11-24) 2 | 3 | - move from jbuilder to dune 4 | - move from topkg to to dune-release 5 | - Lwt 5.0.0 compatibility see #6. 6 | 7 | 8 | ## 0.5.0 (2018-03-25) 9 | 10 | - Remove dependency on lwt_log use logs_lwt instead to ensure compatibility with >= lwt 3.1.0 see #2. 11 | - Remove usage of Lwt.ignore_result see #3. 12 | - Ensure that on node start up if using a remote config then any remote nodes are connected to first before proceeding. Failure 13 | to connected to any remote node in the config will cause the node to not start. 14 | - Move to using Jbuilder (using topkg jbuilder integration as well) instead of Oasis. The library will now appear as two 15 | packages on opam : distributed (the concurrent I/O agnostic core) and distributed-lwt the lwt based implementation. 16 | - Moved to using odoc to generate documentation. 17 | - Stopped using oUnit for unit tests. 18 | - Ensure compatibility with lwt >= 4.0.0 (safe semantics) #3. 19 | - Ensure pids are unique across functor invocations. 20 | - Simplify library : remove heartbeat functionality, can be duplicated at application level using receive time-outs and spawning 21 | corresponding process on remote node. 22 | - Update case/receive API so that calling receive/receive_loop with a list of empty matchers is a compile time error. 23 | New APIs are `val case : (message_type -> (unit -> 'a t) option) -> 'a matcher_list`, `termination_case : (monitor_reason -> 'a t) -> 'a matcher_list`, `val (|.) : 'a matcher_list -> 'a matcher_list -> 'a matcher_list`, `val receive : ?timeout_duration:float -> 'a matcher_list -> 'a option t`, `val receive_loop : ?timeout_duration:float -> bool matcher_list -> unit t`. 24 | - Added appveyor CI support. 25 | - Added uwt support. 26 | 27 | ### 0.4.0 (2017-01-18) 28 | 29 | - Distributed 0.4.0 is Lwt 3.0.0 compatible see #1. 30 | - Changed the signature of `case` function from `val case : (message_type -> bool) -> (message_type -> 'a t) -> 'a matcher` to `val case : (message_type -> (unit -> 'a t) option) -> 'a matcher` to remove unnecessary asserts. 31 | - Added more unit tests to increase code coverage, integrated with coveralls in build process to get automatic coverage reports. 32 | - bug fixes related to heart beat monitoring. 33 | 34 | ### 0.3.0 (2016-11-06) 35 | 36 | - Removed dependency on batteries to allow compatibility with more versions of ocaml. 37 | - Added receive_loop auxiliary function. 38 | - Added optional monitor remote node function to run_node. 39 | - Modified signature of spawn and run node slightly to take a function (unit -> unit t) instead of unit t. 40 | - Made add_remote_node idempotent when adding a node that already exists. 41 | - Added more examples. 42 | - Added online docs. 43 | - Fix bug related to not cleaning up mailbox in case of exception in user provider message handler or recursive call in user provided handler. 44 | - Fix bug related heart beat processing. 45 | 46 | ### 0.2.0 (2016-10-25) 47 | 48 | - No functional changes over the previous release, just changes related to opam packaging. 49 | 50 | ### 0.1.0 (2016-10-23) 51 | 52 | - Initial release. -------------------------------------------------------------------------------- /docs/distributed-lwt/Distributed_lwt/index.html: -------------------------------------------------------------------------------- 1 | 2 | Distributed_lwt (distributed-lwt.Distributed_lwt)

Module Distributed_lwt

A lwt based implementation of Distributed. Note, that this lwt based implmentation depends on the Logs_lwt library. In keeping with the usage conventions of the Logs library, this implementation does not define a source, it does not set the log level, and it does not define a reporter. The application is expected to define a source, set the log level, and define a reporter (see the examples).

author
essdotteedot <essdotteedot_at_gmail_dot_com>
version
0.2.0
module type CustomerLogger = sig ... end

This module provides a Log_lwt based logger to use.

module Make : functor (M : Distributed.Message_type) -> functor (L : CustomerLogger) -> Distributed.Process with type 'a io = 'a Lwt.t and type message_type = M.t

Functor to create a module of type Distributed.Process given a message module M of type Distributed.Message_type and a custom logger module L of type CustomerLogger.

-------------------------------------------------------------------------------- /docs/distributed-uwt/Distributed_uwt/index.html: -------------------------------------------------------------------------------- 1 | 2 | Distributed_uwt (distributed-uwt.Distributed_uwt)

Module Distributed_uwt

A uwt based implementation of Distributed. Note, that this lwt based implmentation depends on the Logs_lwt library. In keeping with the usage conventions of the Logs library, this implementation does not define a source, it does not set the log level, and it does not define a reporter. The application is expected to define a source, set the log level, and define a reporter (see the examples).

author
essdotteedot <essdotteedot_at_gmail_dot_com>
version
0.2.0
module type CustomerLogger = sig ... end

This module provides a Log_lwt based logger to use.

module Make : functor (M : Distributed.Message_type) -> functor (L : CustomerLogger) -> Distributed.Process with type 'a io = 'a Lwt.t and type message_type = M.t

Functor to create a module of type Distributed.Process given a message module M of type Distributed.Message_type and a custom logger module L of type CustomerLogger.

-------------------------------------------------------------------------------- /examples/name_server_example/add_server.ml: -------------------------------------------------------------------------------- 1 | (* The add server holds the add process which will add two ints and 2 | send back the result to the requester. The goal is to make then 3 | server resilient to failures in the name_server.Arg 4 | 5 | main_proc 6 | - attempt to add the name server node, repeat until successful 7 | - spawn and monitor process_add_request, if process_add_request fails then 8 | the name server is added again an process_add_request is re-spawned 9 | 10 | process_add_request 11 | - attempt to register with the name server, if don't get okay in 0.5 raise 12 | Failed_to_register at which point main_proc which is monitoring will restart 13 | - after successful registration enter a receive loop to process add messages 14 | *) 15 | module D = Distributed_lwt.Make (Message) (Custom_logger) 16 | 17 | exception Failed_to_register 18 | 19 | let config = D.Remote { D.Remote_config.node_name = "add_server" ; 20 | D.Remote_config.local_port = 46000 ; 21 | D.Remote_config.connection_backlog = 10 ; 22 | D.Remote_config.node_ip = "127.0.0.1" ; 23 | D.Remote_config.remote_nodes = [] ; (* we will add nodes dynamically*) 24 | } 25 | 26 | let process_add_request name_server_node () = D.( 27 | get_self_pid >>= fun self_pid -> 28 | lift_io (Lwt_io.printl "Add process is registering itself with the name server.") >>= fun () -> 29 | broadcast name_server_node (Message.Register ("add_process", self_pid)) >>= fun () -> 30 | receive ~timeout_duration:0.5 @@ 31 | case (function 32 | | Message.Register_ok -> Some (fun () -> 33 | lift_io (Lwt_io.printl "Add process successfully registered with the name server.") >>= fun () -> 34 | return ()) 35 | | _ -> None 36 | ) 37 | >>= function 38 | | None -> 39 | lift_io (Lwt_io.printl "Add process failed to get ok response for registration request.") >>= fun () -> 40 | fail Failed_to_register 41 | | _ -> 42 | receive_loop @@ 43 | case (function 44 | | Message.Add (x, y, requester_pid) -> Some (fun () -> 45 | requester_pid >! (Message.Add_result (x+y)) >>= fun () -> 46 | lift_io (Lwt_io.printlf "Successfully added %d and %d and sent back result." x y) >>= fun () -> 47 | return true) 48 | | m -> Some (fun () -> 49 | lift_io (Lwt_io.printlf "Add process ignoring message %s." (Message.string_of_message m)) >>= fun () -> 50 | return true) 51 | ) 52 | ) 53 | 54 | let rec main_proc () = D.( 55 | get_self_node >>= fun self_node_id -> 56 | catch 57 | (fun () -> add_remote_node "127.0.0.1" 45000 "name_server") 58 | (fun _ -> 59 | lift_io (Lwt_io.printlf"Failed to add name server node, trying again in 1 second.") >>= fun () -> 60 | lift_io (Lwt_unix.sleep 1.0) >>= fun () -> 61 | main_proc () 62 | ) 63 | >>= fun name_server_node_id -> 64 | spawn ~monitor:true self_node_id (process_add_request name_server_node_id) >>= fun _ -> 65 | receive_loop 66 | begin 67 | termination_case (function _ -> lift_io (Lwt_io.printlf"Add process died, respawning it.") >>= fun () -> return false) 68 | |. case (fun _ -> Some (fun () -> return true)) 69 | end 70 | >>= fun _ -> 71 | main_proc () 72 | ) 73 | 74 | let () = 75 | Logs.Src.set_level Custom_logger.log_src (Some Logs.App) ; 76 | Logs.set_reporter @@ Custom_logger.lwt_reporter () ; 77 | Lwt_main.run (D.run_node ~process:(D.(fun () -> main_proc () >>= fun _ -> return ())) config) 78 | 79 | -------------------------------------------------------------------------------- /tests/lwt/test_lwt.ml: -------------------------------------------------------------------------------- 1 | let log_src = Logs.Src.create "distributed" ~doc:"logs events related to the distributed library" 2 | 3 | module Log = (val Logs_lwt.src_log log_src : Logs_lwt.LOG) 4 | 5 | module Test_io = struct 6 | 7 | type 'a t = 'a Lwt.t 8 | 9 | type 'a stream = 'a Lwt_stream.t 10 | 11 | type input_channel = Lwt_io.input_channel 12 | 13 | type output_channel = Lwt_io.output_channel 14 | 15 | type server = Lwt_io.server 16 | 17 | type level = Debug 18 | | Info 19 | | Warning 20 | | Error 21 | 22 | exception Timeout = Lwt_unix.Timeout 23 | 24 | let established_connections : int ref = ref 0 25 | 26 | let exit_fns : (unit -> unit Lwt.t) list ref = ref [] 27 | 28 | let lib_name = "Test_lwt_io" 29 | 30 | let lib_version = "0.2.0" 31 | 32 | let lib_description = "A Lwt based test implementation that uses for testing purposes" 33 | 34 | let return = Lwt.return 35 | 36 | let (>>=) = Lwt.(>>=) 37 | 38 | let fail = Lwt.fail 39 | 40 | let catch = Lwt.catch 41 | 42 | let async = Lwt.async 43 | 44 | let create_stream = Lwt_stream.create 45 | 46 | let get = Lwt_stream.get 47 | 48 | let stream_append = Lwt_stream.append 49 | 50 | let close_input = Lwt_io.close 51 | 52 | let close_output = Lwt_io.close 53 | 54 | let read_value = Lwt_io.read_value 55 | 56 | let write_value = Lwt_io.write_value 57 | 58 | let of_logs_lwt_level = function 59 | | Debug -> Logs.Debug 60 | | Info -> Logs.Info 61 | | Warning -> Logs.Warning 62 | | Error -> Logs.Error 63 | 64 | let log (level:level) (msg_fmtter:unit -> string) = 65 | Log.msg (of_logs_lwt_level level) (fun m -> m "%s" @@ msg_fmtter ()) >>= fun _ -> return () 66 | 67 | let open_connection sock_addr = Lwt_io.open_connection sock_addr 68 | 69 | let establish_server ?backlog sock_addr server_fn = 70 | Lwt_io.establish_server_with_client_address ?backlog sock_addr server_fn >>= fun server -> 71 | established_connections := !established_connections + 1 ; 72 | Lwt.return server 73 | 74 | let shutdown_server = Lwt_io.shutdown_server 75 | 76 | let sleep = Lwt_unix.sleep 77 | 78 | let timeout = Lwt_unix.timeout 79 | 80 | let pick = Lwt.pick 81 | 82 | let at_exit f = exit_fns := f::!exit_fns 83 | 84 | let run_fn = Lwt_main.run 85 | 86 | let get_established_connection_count () = !established_connections 87 | 88 | let reset_established_connection_count () = established_connections := 0 89 | 90 | let get_atexit_fns () = !exit_fns 91 | 92 | let clear_atexit_fnns () = exit_fns := [] 93 | 94 | end 95 | 96 | (* slightly modified version of reporter defined in Logs_lwt manual : http://erratique.ch/software/logs/doc/Logs_lwt.html#report_ex*) 97 | let lwt_reporter log_it = 98 | let buf_fmt () = 99 | let b = Buffer.create 512 in 100 | Format.formatter_of_buffer b, fun () -> let m = Buffer.contents b in Buffer.reset b; m 101 | in 102 | let app, app_flush = buf_fmt () in 103 | let reporter = Logs.format_reporter ~app ~dst:app () in 104 | let report src level ~over k msgf = 105 | let k' () = 106 | let write () = log_it @@ app_flush () in 107 | let unblock () = over (); Lwt.return_unit in 108 | Lwt.finalize write unblock |> Lwt.ignore_result; 109 | k () 110 | in 111 | reporter.Logs.report src level ~over:(fun () -> ()) k' msgf; 112 | in 113 | { Logs.report = report } 114 | 115 | let log_it_quiet _ = Lwt.return () 116 | 117 | let log_to_stdout = Lwt_io.write Lwt_io.stdout 118 | 119 | let () = 120 | let module Tests = Test_distributed.Make(Test_io) in 121 | let logger = log_it_quiet in 122 | Logs.Src.set_level log_src (Some Logs.Debug) ; 123 | Logs.set_reporter @@ lwt_reporter logger ; 124 | Tests.run_suite () -------------------------------------------------------------------------------- /tests/uwt/test_uwt.ml: -------------------------------------------------------------------------------- 1 | let log_src = Logs.Src.create "distributed" ~doc:"logs events related to the distributed library" 2 | 3 | module Log = (val Logs_lwt.src_log log_src : Logs_lwt.LOG) 4 | 5 | module Test_io = struct 6 | 7 | type 'a t = 'a Lwt.t 8 | 9 | type 'a stream = 'a Lwt_stream.t 10 | 11 | type input_channel = Uwt_io.input_channel 12 | 13 | type output_channel = Uwt_io.output_channel 14 | 15 | type server = Uwt_io.server 16 | 17 | type level = Debug 18 | | Info 19 | | Warning 20 | | Error 21 | 22 | exception Timeout = Uwt_compat.Lwt_unix.Timeout 23 | 24 | let established_connections : int ref = ref 0 25 | 26 | let exit_fns : (unit -> unit Lwt.t) list ref = ref [] 27 | 28 | let lib_name = "Test_uwt_io" 29 | 30 | let lib_version = "0.2.0" 31 | 32 | let lib_description = "A Uwt based test implementation that uses for testing purposes" 33 | 34 | let return = Lwt.return 35 | 36 | let (>>=) = Lwt.(>>=) 37 | 38 | let fail = Lwt.fail 39 | 40 | let catch = Lwt.catch 41 | 42 | let async = Lwt.async 43 | 44 | let create_stream = Lwt_stream.create 45 | 46 | let get = Lwt_stream.get 47 | 48 | let stream_append = Lwt_stream.append 49 | 50 | let close_input = Uwt_io.close 51 | 52 | let close_output = Uwt_io.close 53 | 54 | let read_value = Uwt_io.read_value 55 | 56 | let write_value = Uwt_io.write_value 57 | 58 | let of_logs_lwt_level = function 59 | | Debug -> Logs.Debug 60 | | Info -> Logs.Info 61 | | Warning -> Logs.Warning 62 | | Error -> Logs.Error 63 | 64 | let log (level:level) (msg_fmtter:unit -> string) = 65 | Log.msg (of_logs_lwt_level level) (fun m -> m "%s" @@ msg_fmtter ()) >>= fun _ -> return () 66 | 67 | let open_connection sock_addr = Uwt_io.open_connection sock_addr 68 | 69 | let establish_server ?backlog sock_addr server_fn = 70 | Uwt_io.establish_server_with_client_address ?backlog sock_addr server_fn >>= fun server -> 71 | established_connections := !established_connections + 1 ; 72 | Lwt.return server 73 | 74 | let shutdown_server = Uwt_io.shutdown_server 75 | 76 | let sleep = Uwt_compat.Lwt_unix.sleep 77 | 78 | let timeout = Uwt_compat.Lwt_unix.timeout 79 | 80 | let pick = Lwt.pick 81 | 82 | let at_exit f = exit_fns := f::!exit_fns 83 | 84 | let run_fn = Uwt.Main.run 85 | 86 | let get_established_connection_count () = !established_connections 87 | 88 | let reset_established_connection_count () = established_connections := 0 89 | 90 | let get_atexit_fns () = !exit_fns 91 | 92 | let clear_atexit_fnns () = exit_fns := [] 93 | 94 | end 95 | 96 | (* slightly modified version of reporter defined in Logs_lwt manual : http://erratique.ch/software/logs/doc/Logs_lwt.html#report_ex*) 97 | let lwt_reporter log_it = 98 | let buf_fmt () = 99 | let b = Buffer.create 512 in 100 | Format.formatter_of_buffer b, fun () -> let m = Buffer.contents b in Buffer.reset b; m 101 | in 102 | let app, app_flush = buf_fmt () in 103 | let reporter = Logs.format_reporter ~app ~dst:app () in 104 | let report src level ~over k msgf = 105 | let k' () = 106 | let write () = log_it @@ app_flush () in 107 | let unblock () = over (); Lwt.return_unit in 108 | Lwt.finalize write unblock |> Lwt.ignore_result; 109 | k () 110 | in 111 | reporter.Logs.report src level ~over:(fun () -> ()) k' msgf; 112 | in 113 | { Logs.report = report } 114 | 115 | let log_it_quiet _ = Lwt.return () 116 | 117 | let log_to_stdout = Uwt_io.write Uwt_io.stdout 118 | 119 | let () = 120 | let module Tests = Test_distributed.Make(Test_io) in 121 | let logger = log_it_quiet in 122 | Logs.Src.set_level log_src (Some Logs.Debug) ; 123 | Logs.set_reporter @@ lwt_reporter logger ; 124 | Tests.run_suite () -------------------------------------------------------------------------------- /examples/name_server_example/name_server.ml: -------------------------------------------------------------------------------- 1 | (* The name server provides registration of names to process ids. 2 | 3 | main_proc 4 | - spawn and monitor registra, if registra goes down it's restarted 5 | 6 | registra 7 | - listen for register and whois messages and process them in a receive loop 8 | - for a register request just update the mapping in the named_processes mutable 9 | - for a whois request 10 | 1) if the entry exists in named_processes then send response 11 | 2) if it doesn't exist then spawn a wait_for_register_proc to wait for a registration 12 | by the requested name 13 | 14 | wait_for_register_proc 15 | - just wait for a registration message for a given name then sends the pid back to then 16 | original whois requester 17 | *) 18 | module D = Distributed_lwt.Make (Message) (Custom_logger) 19 | 20 | let config = D.Remote { D.Remote_config.node_name = "name_server" ; 21 | D.Remote_config.local_port = 45000 ; 22 | D.Remote_config.connection_backlog = 10 ; 23 | D.Remote_config.node_ip = "127.0.0.1" ; 24 | D.Remote_config.remote_nodes = [] ; 25 | } 26 | 27 | let named_processes : (string, Distributed.Process_id.t) Hashtbl.t = Hashtbl.create 10 28 | 29 | let option_get = function 30 | | Some v -> v 31 | | _ -> assert false 32 | 33 | let wait_for_register_proc pid_to_send_to name_to_wait_for () = D.( 34 | let pid = ref None in 35 | receive_loop @@ 36 | case (function 37 | | Message.Register (name, registered_pid) -> Some (fun () -> 38 | if name = name_to_wait_for 39 | then (pid := Some registered_pid ; return false) 40 | else return true) 41 | | _ -> Some (fun () -> return true)) 42 | >>= fun () -> 43 | pid_to_send_to >! (Message.Whois_result (option_get !pid)) 44 | ) 45 | 46 | let registra () = D.( 47 | receive_loop 48 | begin 49 | case (function 50 | | Message.Register (name, registered_pid) -> Some (fun () -> 51 | Hashtbl.add named_processes name registered_pid ; 52 | registered_pid >! Message.Register_ok >>= fun () -> 53 | lift_io (Lwt_io.printlf "Successfully registered name %s" name) >>= fun () -> 54 | return true) 55 | | _ -> None 56 | ) 57 | |. case (function 58 | | Message.Whois (name,requester_pid) -> Some (fun () -> 59 | catch 60 | (fun () -> 61 | let pid = Hashtbl.find named_processes name in 62 | requester_pid >! Message.Whois_result pid >>= fun () -> 63 | lift_io (Lwt_io.printlf "Lookup of processes named %s succeeded" name) >>= fun () -> 64 | return true 65 | ) 66 | (fun _ -> 67 | get_self_node >>= fun self_node -> 68 | spawn self_node (wait_for_register_proc requester_pid name) >>= fun _ -> 69 | lift_io (Lwt_io.printlf "Lookup of processes named %s failed, waiting for registration" name) >>= fun () -> 70 | return true 71 | )) 72 | | _ -> None 73 | ) 74 | |. case (fun m -> Some (fun () -> 75 | lift_io (Lwt_io.printlf "Ignoring message %s" (Message.string_of_message m)) >>= fun () -> 76 | return true)) 77 | end 78 | ) 79 | 80 | let main_proc () = D.( 81 | get_self_node >>= fun self_node -> 82 | spawn ~monitor:true self_node registra >>= fun _ -> 83 | receive_loop 84 | begin 85 | termination_case (function _ -> spawn ~monitor:true self_node registra >>= fun _ -> return true) 86 | |. case (fun _ -> Some (fun () -> return true)) 87 | end 88 | ) 89 | 90 | let () = 91 | Logs.Src.set_level Custom_logger.log_src (Some Logs.App) ; 92 | Logs.set_reporter @@ Custom_logger.lwt_reporter () ; 93 | Lwt_main.run (D.run_node ~process:main_proc config) -------------------------------------------------------------------------------- /docs/distributed/Distributed/index.html: -------------------------------------------------------------------------------- 1 | 2 | Distributed (distributed.Distributed)

Module Distributed

This module provides modules to create distribtued computations. Distributed comutations are described using the Process. Process provides a monadic interface to describe distributed computations.

author
essdotteedot <essdotteedot_at_gmail_dot_com>
version
0.6.0
module Node_id : sig ... end

This module provides a type representing a node id.

module Process_id : sig ... end

This module provides a type representing a process id.

module type Nonblock_io = sig ... end

Abstract type which can perform monadic concurrent IO.

module type Message_type = sig ... end

The abstract type representing the messages that will be sent between processes.

module type Process = sig ... end

A unit of computation which can be executed on a local or remote host, is monadic.

module Make : functor (I : Nonblock_io) -> functor (M : Message_type) -> Process with type message_type = M.t and type 'a io = 'a I.t

Functor to create a module of type Process given a message module M of type Message_type.

-------------------------------------------------------------------------------- /examples/name_server_example/add_client.ml: -------------------------------------------------------------------------------- 1 | (* The add client will add the name server node dynamically at start up, 2 | then spawn and monitor a local process to add two random number between 3 | 0 and 100 infinitely. 4 | 5 | The idea is to make the add process resilient to failures of the add server 6 | and the name server. 7 | 8 | main main_proc 9 | - spawns and monitors find_remote_process, if it goes down then the main process 10 | will try to add the name server again and restart the find_remote_process again 11 | find_remote_process 12 | - looks up the add server, if it fails it raises Failed_to_lookup which 13 | causes a restart from main process which is monitoring it 14 | - attempts to add the add_server node, again a failure will result in a restart from 15 | the main process 16 | - spawns and monitors the add_forever process, if the add_forever fails then then 17 | remote add process is looked up via the node server and add_forever is restarted with 18 | a potentially new pid for the new remote add process. If the lookup fails then the main 19 | process will restart the entire process since it's monitoring find_remote_process 20 | add_forever 21 | - picks two random ints <= 100 and asks the remote add process to add them 22 | - if the result isn't received in 0.5 seconds then it exits and which point find_remote_process 23 | which is monitoring it will restart with 24 | - otherwise it loops back and adds more ints 25 | *) 26 | module D = Distributed_lwt.Make (Message) (Custom_logger) 27 | 28 | exception Failed_to_lookup 29 | 30 | let config = D.Remote { D.Remote_config.node_name = "add_client" ; 31 | D.Remote_config.local_port = 47000 ; 32 | D.Remote_config.connection_backlog = 10 ; 33 | D.Remote_config.node_ip = "127.0.0.1" ; 34 | D.Remote_config.remote_nodes = [] ; (* we will add nodes dynamically*) 35 | } 36 | 37 | let rec add_forever add_pid () = D.( 38 | get_self_pid >>= fun self_pid -> 39 | let x = Random.int 100 in 40 | let y = Random.int 100 in 41 | add_pid >! (Message.Add (x, y, self_pid)) >>= fun () -> 42 | receive ~timeout_duration:0.5 @@ 43 | case (function 44 | | Message.Add_result r -> Some (fun () -> 45 | lift_io (Lwt_io.printlf "Sucessfully added %d and %d, result of %d." x y r)) 46 | | _ -> None 47 | ) 48 | >>= function 49 | | None -> 50 | lift_io (Lwt_io.printlf "Failed to result in time for add request of %d + %d." x y) 51 | | _ -> 52 | lift_io (Lwt_unix.sleep 0.5) >>= fun () -> 53 | add_forever add_pid () 54 | ) 55 | 56 | let rec find_remote_process add_node () = D.( 57 | get_self_pid >>= fun self_pid -> 58 | broadcast add_node (Message.Whois ("add_process", self_pid)) >>= fun () -> 59 | receive ~timeout_duration:0.5 @@ 60 | case (function 61 | | Message.Whois_result add_pid -> Some (fun () -> return add_pid) 62 | | _ -> None 63 | ) 64 | >>= function 65 | | None -> 66 | lift_io (Lwt_io.printl "Failed to lookup remote add process in time.") >>= fun () -> 67 | fail Failed_to_lookup 68 | | Some add_pid -> 69 | lift_io (Lwt_io.printl "Successfully looked up remote add process.") >>= fun () -> 70 | lift_io (Lwt_io.printl "Attempting to add to remote add node.") >>= fun () -> 71 | add_remote_node "127.0.0.1" 46000 "add_server" >>= fun _ -> 72 | lift_io (Lwt_io.printl "Successfully added remote add node.") >>= fun () -> 73 | get_self_node >>= fun self_node -> 74 | spawn ~monitor:true self_node (add_forever add_pid) >>= fun _ -> 75 | receive_loop 76 | begin 77 | termination_case (function _ -> 78 | lift_io (Lwt_io.printl "Add process died, querying for remote add process id then respawning.") >>= fun () -> 79 | lift_io (Lwt_unix.sleep 1.0) >>= fun () -> 80 | return false 81 | ) 82 | |. case (fun _ -> Some (fun () -> return true)) 83 | end 84 | >>= fun _ -> 85 | find_remote_process add_node () 86 | ) 87 | 88 | let rec main_proc () = D.( 89 | get_self_node >>= fun self_node_id -> 90 | (* adding a node that already exists is a no-op, but in case the name server went down it would have been 91 | removed automatically from the list of nodes that we are connected to remotely. 92 | *) 93 | catch 94 | (fun () -> add_remote_node "127.0.0.1" 45000 "name_server") 95 | (fun _ -> 96 | lift_io (Lwt_io.printl "Failed to add name server node, trying again in 1 second.") >>= fun () -> 97 | lift_io (Lwt_unix.sleep 1.0) >>= fun () -> 98 | main_proc () 99 | ) 100 | >>= fun name_server_node_id -> 101 | spawn ~monitor:true self_node_id (find_remote_process name_server_node_id) >>= fun _ -> 102 | receive_loop 103 | begin 104 | termination_case (function _ -> lift_io (Lwt_io.printl "Add process died, respawning it") >>= fun () -> return false) 105 | |. case (fun _ -> Some (fun () -> return true)) 106 | end 107 | >>= fun _ -> 108 | main_proc () 109 | ) 110 | 111 | let () = 112 | Logs.Src.set_level Custom_logger.log_src (Some Logs.App) ; 113 | Logs.set_reporter @@ Custom_logger.lwt_reporter () ; 114 | Lwt_main.run (D.run_node ~process:(D.(fun () -> main_proc () >>= fun _ -> return ())) config) 115 | 116 | -------------------------------------------------------------------------------- /examples/basic_example/basic.ml: -------------------------------------------------------------------------------- 1 | (* An example program intended to show the basics of the API (spawn, monitor, send, receive). 2 | The program can be run on the same computer or distributed across different computers. 3 | If you want to run across different computers then tweak the node configurations below 4 | to have the correct ip addresses and ports. (in a real program the configurations 5 | would be externalized in a configuration file). To run the example start up the 6 | consumer first then start the producer. 7 | 8 | The program simply has the producer spawning a couple of process on the consumer node 9 | then sending messages to the spawned processes and finally receiving the responses from 10 | the spawned processes for the messages that were sent. It also monitors for the spawned 11 | processes for termination (normal or otherwise). 12 | *) 13 | 14 | (* Define the message type that will be used to send messages between processes. *) 15 | module M = struct 16 | 17 | type t = Ping 18 | | Pong 19 | | Var of [`End | `Noop] 20 | (* If you are going to pass around functions/closure make sure you program is not composed of multiple executables 21 | see https://caml.inria.fr/mantis/print_bug_page.php?bug_id=5942. 22 | *) 23 | | Incr of (int -> int) 24 | | Incr_res of int 25 | | Raise 26 | 27 | exception Ping_ex 28 | 29 | let string_of_message = function 30 | | Ping -> "Ping" 31 | | Pong -> "Pong" 32 | | Var `End -> "Var End" 33 | | Var `Noop -> "Var Noop" 34 | | Incr _ -> "Incr fn" 35 | | Incr_res i -> Format.sprintf "Incr result of %d" i 36 | | Raise -> "Raise" 37 | end 38 | 39 | (* The setup of the logger is left to the application, in this example the logger will 40 | simply log to stdout. We use Logs_lwt as the logging library for this example. 41 | *) 42 | module L = struct 43 | let log_src = Logs.Src.create "distributed" ~doc:"logs events related to the distributed library" 44 | 45 | module Log = (val Logs_lwt.src_log log_src : Logs_lwt.LOG) 46 | 47 | let msg = Log.msg 48 | 49 | (* slightly modified version of reporter defined in Logs_lwt manual : http://erratique.ch/software/logs/doc/Logs_lwt.html#report_ex*) 50 | let lwt_reporter () = 51 | let buf_fmt () = 52 | let b = Buffer.create 512 in 53 | Format.formatter_of_buffer b, fun () -> let m = Buffer.contents b in Buffer.reset b; m 54 | in 55 | let app, app_flush = buf_fmt () in 56 | let reporter = Logs.format_reporter ~app ~dst:app () in 57 | let report src level ~over k msgf = 58 | let k' () = 59 | let write () = Lwt_io.write Lwt_io.stdout (app_flush ()) in 60 | let unblock () = over (); Lwt.return_unit in 61 | Lwt.finalize write unblock |> ignore; 62 | k () 63 | in 64 | reporter.Logs.report src level ~over:(fun () -> ()) k' msgf; 65 | in 66 | { Logs.report = report } 67 | end 68 | 69 | (* create a Distributed_lwt implementation based on the message type defined above *) 70 | module D = Distributed_lwt.Make (M) (L) 71 | 72 | let consumer_config = D.Remote { D.Remote_config.node_name = "consumer" ; 73 | D.Remote_config.local_port = 47000 ; 74 | D.Remote_config.connection_backlog = 10 ; 75 | D.Remote_config.node_ip = "127.0.0.1" ; 76 | D.Remote_config.remote_nodes = [] ; 77 | } 78 | 79 | let producer_config = D.Remote { D.Remote_config.node_name = "producer" ; 80 | D.Remote_config.local_port = 46000 ; 81 | D.Remote_config.connection_backlog = 10 ; 82 | D.Remote_config.node_ip = "127.0.0.1" ; 83 | D.Remote_config.remote_nodes = [("127.0.0.1",47000,"consumer")] ; 84 | } 85 | 86 | let consumer_proc master_pid () = D.( 87 | (* The 'receive' function takes a list of matchers to use to process the incoming messages. 88 | A matcher can be created by using the 'case' function. The 'case' function takes 2 functions : 89 | a matching criteria function and a function to process the message if the criteria is satisfied. 90 | 91 | The other matcher creation function is 'termination_case' which is used in the producer below. 92 | *) 93 | receive_loop @@ 94 | case (function 95 | | M.Ping as v -> Some (fun () -> 96 | send master_pid M.Pong >>= fun () -> 97 | lift_io @@ Lwt_io.printlf "got message %s from remote node" @@ M.string_of_message v >>= fun () -> 98 | return true) 99 | | M.Incr incr_fn -> Some (fun () -> 100 | send master_pid (M.Incr_res (incr_fn 1)) >>= fun () -> 101 | lift_io @@ Lwt_io.printlf "got message %s from remote node" @@ M.string_of_message (M.Incr incr_fn) >>= fun () -> 102 | return true) 103 | | M.Raise as v -> Some (fun () -> 104 | lift_io @@ Lwt_io.printlf "got message %s from remote node" @@ M.string_of_message v >>= fun () -> 105 | fail M.Ping_ex) 106 | | M.Var `End -> Some (fun () -> 107 | lift_io @@ Lwt_io.printlf "got message %s from remote node" @@ M.string_of_message (M.Var `End) >>= fun () -> 108 | return false) 109 | | M.Var `Noop -> Some (fun () -> 110 | lift_io @@ Lwt_io.printlf "got message %s from remote node" @@ M.string_of_message (M.Var `Noop) >>= fun () -> 111 | return true) 112 | (*a catch all case, this is good to have otherwise the non-matching messages are just left in the order they came in the processes' mailbox *) 113 | | v -> Some (fun () -> 114 | lift_io @@ Lwt_io.printlf "got unexpected message %s from remote node" @@ M.string_of_message v >>= fun () -> 115 | return true 116 | ) 117 | ) 118 | ) 119 | 120 | let producer_proc () = D.( 121 | get_remote_nodes >>= fun nodes -> (* get a list of currently connected remote nodes *) 122 | get_self_pid >>= fun pid_to_send_to -> (* get the process id of the current process *) 123 | get_self_node >>= fun my_node -> (* get our own node *) 124 | 125 | (* Can lift operations from the underlying threading library, lwt is this case, into the process monad. *) 126 | (* spawn a process on the local node which will just print "hi.." then exit *) 127 | spawn my_node (fun () -> lift_io @@ Lwt_io.printl "hi from local process") >>= fun (_, _) -> 128 | (* spawn and monitor a process on the remote node atomically *) 129 | spawn ~monitor:true (List.hd nodes) (consumer_proc pid_to_send_to) >>= fun (remote_pid1, _) -> 130 | 131 | (* spawn and monitor a process on the remote node separately *) 132 | spawn (List.hd nodes) (consumer_proc pid_to_send_to) >>= fun (remote_pid2, _) -> 133 | monitor remote_pid2 >>= fun _ -> 134 | 135 | (* send messages to the spawned remote processes, using the infix funtion '>!' alias of send *) 136 | remote_pid1 >! M.Ping >>= fun () -> 137 | remote_pid1 >! (M.Incr (fun i -> i + 5)) >>= fun () -> 138 | remote_pid1 >! (M.Var `Noop) >>= fun () -> 139 | remote_pid1 >! (M.Var `End) >>= fun () -> 140 | 141 | remote_pid2 >! M.Ping >>= fun () -> 142 | remote_pid2 >! (M.Incr (fun i -> i + 7)) >>= fun () -> 143 | remote_pid2 >! (M.Var `Noop) >>= fun () -> 144 | remote_pid2 >! (M.Raise) >>= fun () -> 145 | 146 | let processes_terminated = ref 0 in 147 | 148 | (* process messages that are sent to us *) 149 | receive_loop 150 | begin 151 | case (function 152 | | M.Pong as v -> Some (fun () -> 153 | lift_io @@ Lwt_io.printlf "got message %s from remote node" (M.string_of_message v) >>= fun () -> 154 | return true) 155 | | M.Incr_res r -> Some (fun () -> 156 | lift_io @@ Lwt_io.printlf "got message %s from remote node" @@ M.string_of_message (M.Incr_res r) >>= fun () -> 157 | return true) 158 | | v -> Some (fun () -> 159 | lift_io @@ Lwt_io.printlf "got unexpected message %s from remote node" (M.string_of_message v) >>= fun () -> 160 | return true) 161 | ) 162 | (* use the termination_case matcher to match against messages about the termination, either normal or exception, or previously monitored processes *) 163 | |. termination_case (function 164 | | Normal _ -> 165 | processes_terminated := !processes_terminated + 1 ; 166 | lift_io (Lwt_io.printlf "remote process terminated successfully, number of remote processes terminated %d" !processes_terminated) >>= fun () -> 167 | return (!processes_terminated < 2) 168 | | Exception (_,ex) -> 169 | if (Printexc.exn_slot_name ex) = (Printexc.exn_slot_name M.Ping_ex) (* work around inability to pattern match on unmarshalled exceptions, see http://caml.inria.fr/pub/docs/manual-ocaml/libref/Marshal.html*) 170 | then 171 | begin 172 | processes_terminated := !processes_terminated + 1 ; 173 | lift_io (Lwt_io.printlf "remote process terminated with exception, number of remote processes terminated %d" !processes_terminated) >>= fun () -> 174 | return (!processes_terminated < 2) 175 | end 176 | else assert false 177 | | _ -> assert false 178 | ) 179 | end 180 | ) 181 | 182 | let () = 183 | let args = Sys.argv in 184 | (* set the log level and the reporter*) 185 | Logs.Src.set_level L.log_src (Some Logs.App) ; 186 | Logs.set_reporter @@ L.lwt_reporter () ; 187 | if Array.length args <> 2 188 | then Format.printf "Usage : %s \n" args.(0) 189 | else if args.(1) = "producer" 190 | then Lwt.(Lwt_main.run (D.run_node ~process:producer_proc producer_config >>= fun () -> fst @@ wait ())) 191 | else if args.(1) = "consumer" 192 | (* no initial process is spawned on the consumer node, it will be spawned from the producer *) 193 | then Lwt.(Lwt_main.run (D.run_node consumer_config >>= fun () -> fst @@ wait ())) 194 | else Format.printf "Usage : %s \n" args.(0) 195 | 196 | -------------------------------------------------------------------------------- /docs/highlight.pack.js: -------------------------------------------------------------------------------- 1 | /*! highlight.js v9.15.8 | BSD3 License | git.io/hljslicense */ 2 | !function(e){var n="object"==typeof window&&window||"object"==typeof self&&self;"undefined"!=typeof exports?e(exports):n&&(n.hljs=e({}),"function"==typeof define&&define.amd&&define([],function(){return n.hljs}))}(function(a){var f=[],u=Object.keys,N={},c={},n=/^(no-?highlight|plain|text)$/i,s=/\blang(?:uage)?-([\w-]+)\b/i,t=/((^(<[^>]+>|\t|)+|(?:\n)))/gm,r={case_insensitive:"cI",lexemes:"l",contains:"c",keywords:"k",subLanguage:"sL",className:"cN",begin:"b",beginKeywords:"bK",end:"e",endsWithParent:"eW",illegal:"i",excludeBegin:"eB",excludeEnd:"eE",returnBegin:"rB",returnEnd:"rE",relevance:"r",variants:"v",IDENT_RE:"IR",UNDERSCORE_IDENT_RE:"UIR",NUMBER_RE:"NR",C_NUMBER_RE:"CNR",BINARY_NUMBER_RE:"BNR",RE_STARTERS_RE:"RSR",BACKSLASH_ESCAPE:"BE",APOS_STRING_MODE:"ASM",QUOTE_STRING_MODE:"QSM",PHRASAL_WORDS_MODE:"PWM",C_LINE_COMMENT_MODE:"CLCM",C_BLOCK_COMMENT_MODE:"CBCM",HASH_COMMENT_MODE:"HCM",NUMBER_MODE:"NM",C_NUMBER_MODE:"CNM",BINARY_NUMBER_MODE:"BNM",CSS_NUMBER_MODE:"CSSNM",REGEXP_MODE:"RM",TITLE_MODE:"TM",UNDERSCORE_TITLE_MODE:"UTM",COMMENT:"C",beginRe:"bR",endRe:"eR",illegalRe:"iR",lexemesRe:"lR",terminators:"t",terminator_end:"tE"},b="",h={classPrefix:"hljs-",tabReplace:null,useBR:!1,languages:void 0};function _(e){return e.replace(/&/g,"&").replace(//g,">")}function E(e){return e.nodeName.toLowerCase()}function v(e,n){var t=e&&e.exec(n);return t&&0===t.index}function l(e){return n.test(e)}function g(e){var n,t={},r=Array.prototype.slice.call(arguments,1);for(n in e)t[n]=e[n];return r.forEach(function(e){for(n in e)t[n]=e[n]}),t}function R(e){var a=[];return function e(n,t){for(var r=n.firstChild;r;r=r.nextSibling)3===r.nodeType?t+=r.nodeValue.length:1===r.nodeType&&(a.push({event:"start",offset:t,node:r}),t=e(r,t),E(r).match(/br|hr|img|input/)||a.push({event:"stop",offset:t,node:r}));return t}(e,0),a}function i(e){if(r&&!e.langApiRestored){for(var n in e.langApiRestored=!0,r)e[n]&&(e[r[n]]=e[n]);(e.c||[]).concat(e.v||[]).forEach(i)}}function m(o){function s(e){return e&&e.source||e}function c(e,n){return new RegExp(s(e),"m"+(o.cI?"i":"")+(n?"g":""))}!function n(t,e){if(!t.compiled){if(t.compiled=!0,t.k=t.k||t.bK,t.k){function r(t,e){o.cI&&(e=e.toLowerCase()),e.split(" ").forEach(function(e){var n=e.split("|");a[n[0]]=[t,n[1]?Number(n[1]):1]})}var a={};"string"==typeof t.k?r("keyword",t.k):u(t.k).forEach(function(e){r(e,t.k[e])}),t.k=a}t.lR=c(t.l||/\w+/,!0),e&&(t.bK&&(t.b="\\b("+t.bK.split(" ").join("|")+")\\b"),t.b||(t.b=/\B|\b/),t.bR=c(t.b),t.endSameAsBegin&&(t.e=t.b),t.e||t.eW||(t.e=/\B|\b/),t.e&&(t.eR=c(t.e)),t.tE=s(t.e)||"",t.eW&&e.tE&&(t.tE+=(t.e?"|":"")+e.tE)),t.i&&(t.iR=c(t.i)),null==t.r&&(t.r=1),t.c||(t.c=[]),t.c=Array.prototype.concat.apply([],t.c.map(function(e){return function(n){return n.v&&!n.cached_variants&&(n.cached_variants=n.v.map(function(e){return g(n,{v:null},e)})),n.cached_variants||n.eW&&[g(n)]||[n]}("self"===e?t:e)})),t.c.forEach(function(e){n(e,t)}),t.starts&&n(t.starts,e);var i=t.c.map(function(e){return e.bK?"\\.?(?:"+e.b+")\\.?":e.b}).concat([t.tE,t.i]).map(s).filter(Boolean);t.t=i.length?c(function(e,n){for(var t=/\[(?:[^\\\]]|\\.)*\]|\(\??|\\([1-9][0-9]*)|\\./,r=0,a="",i=0;i')+n+(t?"":b):n}function o(){E+=null!=l.sL?function(){var e="string"==typeof l.sL;if(e&&!N[l.sL])return _(g);var n=e?C(l.sL,g,!0,f[l.sL]):O(g,l.sL.length?l.sL:void 0);return 0")+'"');return g+=n,n.length||1}var s=B(e);if(!s)throw new Error('Unknown language: "'+e+'"');m(s);var a,l=t||s,f={},E="";for(a=l;a!==s;a=a.parent)a.cN&&(E=c(a.cN,"",!0)+E);var g="",R=0;try{for(var d,p,M=0;l.t.lastIndex=M,d=l.t.exec(n);)p=r(n.substring(M,d.index),d[0]),M=d.index+p;for(r(n.substr(M)),a=l;a.parent;a=a.parent)a.cN&&(E+=b);return{r:R,value:E,language:e,top:l}}catch(e){if(e.message&&-1!==e.message.indexOf("Illegal"))return{r:0,value:_(n)};throw e}}function O(t,e){e=e||h.languages||u(N);var r={r:0,value:_(t)},a=r;return e.filter(B).filter(M).forEach(function(e){var n=C(e,t,!1);n.language=e,n.r>a.r&&(a=n),n.r>r.r&&(a=r,r=n)}),a.language&&(r.second_best=a),r}function d(e){return h.tabReplace||h.useBR?e.replace(t,function(e,n){return h.useBR&&"\n"===e?"
":h.tabReplace?n.replace(/\t/g,h.tabReplace):""}):e}function o(e){var n,t,r,a,i,o=function(e){var n,t,r,a,i=e.className+" ";if(i+=e.parentNode?e.parentNode.className:"",t=s.exec(i))return B(t[1])?t[1]:"no-highlight";for(n=0,r=(i=i.split(/\s+/)).length;n/g,"\n"):n=e,i=n.textContent,r=o?C(o,i,!0):O(i),(t=R(n)).length&&((a=document.createElementNS("http://www.w3.org/1999/xhtml","div")).innerHTML=r.value,r.value=function(e,n,t){var r=0,a="",i=[];function o(){return e.length&&n.length?e[0].offset!==n[0].offset?e[0].offset"}function u(e){a+=""}function s(e){("start"===e.event?c:u)(e.node)}for(;e.length||n.length;){var l=o();if(a+=_(t.substring(r,l[0].offset)),r=l[0].offset,l===e){for(i.reverse().forEach(u);s(l.splice(0,1)[0]),(l=o())===e&&l.length&&l[0].offset===r;);i.reverse().forEach(c)}else"start"===l[0].event?i.push(l[0].node):i.pop(),s(l.splice(0,1)[0])}return a+_(t.substr(r))}(t,R(a),i)),r.value=d(r.value),e.innerHTML=r.value,e.className=function(e,n,t){var r=n?c[n]:t,a=[e.trim()];return e.match(/\bhljs\b/)||a.push("hljs"),-1===e.indexOf(r)&&a.push(r),a.join(" ").trim()}(e.className,o,r.language),e.result={language:r.language,re:r.r},r.second_best&&(e.second_best={language:r.second_best.language,re:r.second_best.r}))}function p(){if(!p.called){p.called=!0;var e=document.querySelectorAll("pre code");f.forEach.call(e,o)}}function B(e){return e=(e||"").toLowerCase(),N[e]||N[c[e]]}function M(e){var n=B(e);return n&&!n.disableAutodetect}return a.highlight=C,a.highlightAuto=O,a.fixMarkup=d,a.highlightBlock=o,a.configure=function(e){h=g(h,e)},a.initHighlighting=p,a.initHighlightingOnLoad=function(){addEventListener("DOMContentLoaded",p,!1),addEventListener("load",p,!1)},a.registerLanguage=function(n,e){var t=N[n]=e(a);i(t),t.aliases&&t.aliases.forEach(function(e){c[e]=n})},a.listLanguages=function(){return u(N)},a.getLanguage=B,a.autoDetection=M,a.inherit=g,a.IR=a.IDENT_RE="[a-zA-Z]\\w*",a.UIR=a.UNDERSCORE_IDENT_RE="[a-zA-Z_]\\w*",a.NR=a.NUMBER_RE="\\b\\d+(\\.\\d+)?",a.CNR=a.C_NUMBER_RE="(-?)(\\b0[xX][a-fA-F0-9]+|(\\b\\d+(\\.\\d*)?|\\.\\d+)([eE][-+]?\\d+)?)",a.BNR=a.BINARY_NUMBER_RE="\\b(0b[01]+)",a.RSR=a.RE_STARTERS_RE="!|!=|!==|%|%=|&|&&|&=|\\*|\\*=|\\+|\\+=|,|-|-=|/=|/|:|;|<<|<<=|<=|<|===|==|=|>>>=|>>=|>=|>>>|>>|>|\\?|\\[|\\{|\\(|\\^|\\^=|\\||\\|=|\\|\\||~",a.BE=a.BACKSLASH_ESCAPE={b:"\\\\[\\s\\S]",r:0},a.ASM=a.APOS_STRING_MODE={cN:"string",b:"'",e:"'",i:"\\n",c:[a.BE]},a.QSM=a.QUOTE_STRING_MODE={cN:"string",b:'"',e:'"',i:"\\n",c:[a.BE]},a.PWM=a.PHRASAL_WORDS_MODE={b:/\b(a|an|the|are|I'm|isn't|don't|doesn't|won't|but|just|should|pretty|simply|enough|gonna|going|wtf|so|such|will|you|your|they|like|more)\b/},a.C=a.COMMENT=function(e,n,t){var r=a.inherit({cN:"comment",b:e,e:n,c:[]},t||{});return r.c.push(a.PWM),r.c.push({cN:"doctag",b:"(?:TODO|FIXME|NOTE|BUG|XXX):",r:0}),r},a.CLCM=a.C_LINE_COMMENT_MODE=a.C("//","$"),a.CBCM=a.C_BLOCK_COMMENT_MODE=a.C("/\\*","\\*/"),a.HCM=a.HASH_COMMENT_MODE=a.C("#","$"),a.NM=a.NUMBER_MODE={cN:"number",b:a.NR,r:0},a.CNM=a.C_NUMBER_MODE={cN:"number",b:a.CNR,r:0},a.BNM=a.BINARY_NUMBER_MODE={cN:"number",b:a.BNR,r:0},a.CSSNM=a.CSS_NUMBER_MODE={cN:"number",b:a.NR+"(%|em|ex|ch|rem|vw|vh|vmin|vmax|cm|mm|in|pt|pc|px|deg|grad|rad|turn|s|ms|Hz|kHz|dpi|dpcm|dppx)?",r:0},a.RM=a.REGEXP_MODE={cN:"regexp",b:/\//,e:/\/[gimuy]*/,i:/\n/,c:[a.BE,{b:/\[/,e:/\]/,r:0,c:[a.BE]}]},a.TM=a.TITLE_MODE={cN:"title",b:a.IR,r:0},a.UTM=a.UNDERSCORE_TITLE_MODE={cN:"title",b:a.UIR,r:0},a.METHOD_GUARD={b:"\\.\\s*"+a.UIR,r:0},a});hljs.registerLanguage("ocaml",function(e){return{aliases:["ml"],k:{keyword:"and as assert asr begin class constraint do done downto else end exception external for fun function functor if in include inherit! inherit initializer land lazy let lor lsl lsr lxor match method!|10 method mod module mutable new object of open! open or private rec sig struct then to try type val! val virtual when while with parser value",built_in:"array bool bytes char exn|5 float int int32 int64 list lazy_t|5 nativeint|5 string unit in_channel out_channel ref",literal:"true false"},i:/\/\/|>>/,l:"[a-z_]\\w*!?",c:[{cN:"literal",b:"\\[(\\|\\|)?\\]|\\(\\)",r:0},e.C("\\(\\*","\\*\\)",{c:["self"]}),{cN:"symbol",b:"'[A-Za-z_](?!')[\\w']*"},{cN:"type",b:"`[A-Z][\\w']*"},{cN:"type",b:"\\b[A-Z][\\w']*",r:0},{b:"[a-z_]\\w*'[\\w']*",r:0},e.inherit(e.ASM,{cN:"string",r:0}),e.inherit(e.QSM,{i:null}),{cN:"number",b:"\\b(0[xX][a-fA-F0-9_]+[Lln]?|0[oO][0-7_]+[Lln]?|0[bB][01_]+[Lln]?|[0-9][0-9_]*([Lln]|(\\.[0-9_]*)?([eE][-+]?[0-9_]+)?)?)",r:0},{b:/[-=]>/}]}});hljs.registerLanguage("reasonml",function(r){var e="~?[a-z$_][0-9a-zA-Z$_]*",a="`?[A-Z$_][0-9a-zA-Z$_]*",c="("+["||","&&","++","**","+.","*","/","*.","/.","...","|>"].map(function(r){return r.split("").map(function(r){return"\\"+r}).join("")}).join("|")+"|==|===)",n="\\s+"+c+"\\s+",t={keyword:"and as asr assert begin class constraint do done downto else end exception externalfor fun function functor if in include inherit initializerland lazy let lor lsl lsr lxor match method mod module mutable new nonrecobject of open or private rec sig struct then to try type val virtual when while with",built_in:"array bool bytes char exn|5 float int int32 int64 list lazy_t|5 nativeint|5 ref string unit ",literal:"true false"},i="\\b(0[xX][a-fA-F0-9_]+[Lln]?|0[oO][0-7_]+[Lln]?|0[bB][01_]+[Lln]?|[0-9][0-9_]*([Lln]|(\\.[0-9_]*)?([eE][-+]?[0-9_]+)?)?)",s={cN:"number",r:0,v:[{b:i},{b:"\\(\\-"+i+"\\)"}]},b={cN:"operator",r:0,b:c},o=[{cN:"identifier",r:0,b:e},b,s],l=[r.QSM,b,{cN:"module",b:"\\b"+a,rB:!0,e:".",c:[{cN:"identifier",b:a,r:0}]}],u=[{cN:"module",b:"\\b"+a,rB:!0,e:".",r:0,c:[{cN:"identifier",b:a,r:0}]}],_={cN:"function",r:0,k:t,v:[{b:"\\s(\\(\\.?.*?\\)|"+e+")\\s*=>",e:"\\s*=>",rB:!0,r:0,c:[{cN:"params",v:[{b:e},{b:"~?[a-z$_][0-9a-zA-Z$_]*(s*:s*[a-z$_][0-9a-z$_]*((s*('?[a-z$_][0-9a-z$_]*s*(,'?[a-z$_][0-9a-z$_]*)*)?s*))?)?(s*:s*[a-z$_][0-9a-z$_]*((s*('?[a-z$_][0-9a-z$_]*s*(,'?[a-z$_][0-9a-z$_]*)*)?s*))?)?"},{b:/\(\s*\)/}]}]},{b:"\\s\\(\\.?[^;\\|]*\\)\\s*=>",e:"\\s=>",rB:!0,r:0,c:[{cN:"params",r:0,v:[{b:e,e:"(,|\\n|\\))",r:0,c:[b,{cN:"typing",b:":",e:"(,|\\n)",rB:!0,r:0,c:u}]}]}]},{b:"\\(\\.\\s"+e+"\\)\\s*=>"}]};l.push(_);var N={cN:"constructor",b:a+"\\(",e:"\\)",i:"\\n",k:t,c:[r.QSM,b,{cN:"params",b:"\\b"+e}]},d={cN:"pattern-match",b:"\\|",rB:!0,k:t,e:"=>",r:0,c:[N,b,{r:0,cN:"constructor",b:a}]},z={cN:"module-access",k:t,rB:!0,v:[{b:"\\b("+a+"\\.)+"+e},{b:"\\b("+a+"\\.)+\\(",e:"\\)",rB:!0,c:[_,{b:"\\(",e:"\\)",skip:!0}].concat(l)},{b:"\\b("+a+"\\.)+{",e:"}"}],c:l};return u.push(z),{aliases:["re"],k:t,i:"(:\\-|:=|\\${|\\+=)",c:[r.C("/\\*","\\*/",{i:"^(\\#,\\/\\/)"}),{cN:"character",b:"'(\\\\[^']+|[^'])'",i:"\\n",r:0},r.QSM,{cN:"literal",b:"\\(\\)",r:0},{cN:"literal",b:"\\[\\|",e:"\\|\\]",r:0,c:o},{cN:"literal",b:"\\[",e:"\\]",r:0,c:o},N,{cN:"operator",b:n,i:"\\-\\->",r:0},s,r.CLCM,d,_,{cN:"module-def",b:"\\bmodule\\s+"+e+"\\s+"+a+"\\s+=\\s+{",e:"}",rB:!0,k:t,r:0,c:[{cN:"module",r:0,b:a},{b:"{",e:"}",skip:!0}].concat(l)},z]}}); -------------------------------------------------------------------------------- /docs/distributed/Distributed/Make/argument-1-I/index.html: -------------------------------------------------------------------------------- 1 | 2 | 1-I (distributed.Distributed.Make.1-I)

Parameter Make.1-I

type 'a t

The monadic light weight thread type returning value 'a.

type 'a stream

An unbounded stream holding values of 'a.

type input_channel

A type to represent a non-blocking input channel

type output_channel

A type to represent a non-blocking output channel

type server

A type to represent a server

exception Timeout
type level =
| Debug
| Info
| Warning
| Error

Type to represent levels of a log message.

val lib_name : string

The name of the implementation, for logging purposes.

val lib_version : string

The version implementation, for logging purposes.

val lib_description : string

A description of the implementation (e.g., the url of the code repository ), for logging purposes.

val return : 'a -> 'a t

return v creates a light weight thread returning v.

val (>>=) : 'a t -> ('a -> 'b t) -> 'b t

bind t f is a thread which first waits for the thread t to terminate and then, if the thread succeeds, behaves as the application of function f to the return value of t. If the thread t fails, bind t f also fails, with the same exception.

val fail : exn -> 'a t

fail e is a thread that fails with the exception e.

val catch : (unit -> 'a t) -> (exn -> 'a t) -> 'a t

catch t f is a thread that behaves as the thread t () if this thread succeeds. If the thread t () fails with some exception, catch t f behaves as the application of f to this exception.

val async : (unit -> 'a t) -> unit

async f starts a thread without waiting for the result.

val create_stream : unit -> 'a stream * ('a option -> unit)

create () returns a new stream and a push function.

val get : 'a stream -> 'a option t

get st removes and returns the first element of the stream, if any. Will block if the stream is empty.

val stream_append : 'a stream -> 'a stream -> 'a stream

stream_append s1 s2 returns a stream which returns all elements of s1, then all elements of s2.

val close_input : input_channel -> unit t

close ch closes the given channel immediately.

val close_output : output_channel -> unit t

close ch closes the given channel. It performs all pending actions, flushes it and closes it.

val read_value : input_channel -> 'a t

read_value ic reads a marshalled value from ic.

val write_value : output_channel -> ?⁠flags:Stdlib.Marshal.extern_flags list -> 'a -> unit t

write_value oc ?flags x marshals the value x to oc.

val open_connection : Unix.sockaddr -> (input_channel * output_channel) t

open_connection addr opens a connection to the given address and returns two channels for using it.

val establish_server : ?⁠backlog:int -> Unix.sockaddr -> (Unix.sockaddr -> (input_channel * output_channel) -> unit t) -> server t

establish_server ?backlog sockaddr f creates a server which will listen for incoming connections. New connections are passed to f. Note that f must not raise any exception. Backlog is the argument passed to Lwt_unix.listen.

val shutdown_server : server -> unit t

shutdown_server server will shutdown server.

val log : level -> (unit -> string) -> unit t

log level message_formatter logs a message at the specified level using the formatter provided.

val sleep : float -> unit t

sleep d is a thread that remains suspended for d seconds and then terminates.

val timeout : float -> 'a t

timeout d is a thread that remains suspended for d seconds and then fails with ​Distributed.Nonblock_io.Timeout.

val pick : 'a t list -> 'a t

pick l behaves as the first thread in l to terminate. If several threads are already terminated, one is chosen at random. Cancels all sleeping threads when one terminates.

val at_exit : (unit -> unit t) -> unit

at_exit fn will call fn on program exit.

-------------------------------------------------------------------------------- /docs/distributed/Distributed/module-type-Nonblock_io/index.html: -------------------------------------------------------------------------------- 1 | 2 | Nonblock_io (distributed.Distributed.Nonblock_io)

Module type Distributed.Nonblock_io

Abstract type which can perform monadic concurrent IO.

type 'a t

The monadic light weight thread type returning value 'a.

type 'a stream

An unbounded stream holding values of 'a.

type input_channel

A type to represent a non-blocking input channel

type output_channel

A type to represent a non-blocking output channel

type server

A type to represent a server

exception Timeout
type level =
| Debug
| Info
| Warning
| Error

Type to represent levels of a log message.

val lib_name : string

The name of the implementation, for logging purposes.

val lib_version : string

The version implementation, for logging purposes.

val lib_description : string

A description of the implementation (e.g., the url of the code repository ), for logging purposes.

val return : 'a -> 'a t

return v creates a light weight thread returning v.

val (>>=) : 'a t -> ('a -> 'b t) -> 'b t

bind t f is a thread which first waits for the thread t to terminate and then, if the thread succeeds, behaves as the application of function f to the return value of t. If the thread t fails, bind t f also fails, with the same exception.

val fail : exn -> 'a t

fail e is a thread that fails with the exception e.

val catch : (unit -> 'a t) -> (exn -> 'a t) -> 'a t

catch t f is a thread that behaves as the thread t () if this thread succeeds. If the thread t () fails with some exception, catch t f behaves as the application of f to this exception.

val async : (unit -> 'a t) -> unit

async f starts a thread without waiting for the result.

val create_stream : unit -> 'a stream * ('a option -> unit)

create () returns a new stream and a push function.

val get : 'a stream -> 'a option t

get st removes and returns the first element of the stream, if any. Will block if the stream is empty.

val stream_append : 'a stream -> 'a stream -> 'a stream

stream_append s1 s2 returns a stream which returns all elements of s1, then all elements of s2.

val close_input : input_channel -> unit t

close ch closes the given channel immediately.

val close_output : output_channel -> unit t

close ch closes the given channel. It performs all pending actions, flushes it and closes it.

val read_value : input_channel -> 'a t

read_value ic reads a marshalled value from ic.

val write_value : output_channel -> ?⁠flags:Stdlib.Marshal.extern_flags list -> 'a -> unit t

write_value oc ?flags x marshals the value x to oc.

val open_connection : Unix.sockaddr -> (input_channel * output_channel) t

open_connection addr opens a connection to the given address and returns two channels for using it.

val establish_server : ?⁠backlog:int -> Unix.sockaddr -> (Unix.sockaddr -> (input_channel * output_channel) -> unit t) -> server t

establish_server ?backlog sockaddr f creates a server which will listen for incoming connections. New connections are passed to f. Note that f must not raise any exception. Backlog is the argument passed to Lwt_unix.listen.

val shutdown_server : server -> unit t

shutdown_server server will shutdown server.

val log : level -> (unit -> string) -> unit t

log level message_formatter logs a message at the specified level using the formatter provided.

val sleep : float -> unit t

sleep d is a thread that remains suspended for d seconds and then terminates.

val timeout : float -> 'a t

timeout d is a thread that remains suspended for d seconds and then fails with ​Distributed.Nonblock_io.Timeout.

val pick : 'a t list -> 'a t

pick l behaves as the first thread in l to terminate. If several threads are already terminated, one is chosen at random. Cancels all sleeping threads when one terminates.

val at_exit : (unit -> unit t) -> unit

at_exit fn will call fn on program exit.

-------------------------------------------------------------------------------- /docs/odoc.css: -------------------------------------------------------------------------------- 1 | @charset "UTF-8"; 2 | /* Copyright (c) 2016 The odoc contributors. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | odoc 1.4.2 */ 5 | 6 | /* Fonts */ 7 | @import url('https://fonts.googleapis.com/css?family=Fira+Mono:400,500'); 8 | @import url('https://fonts.googleapis.com/css?family=Noticia+Text:400,400i,700'); 9 | @import url('https://fonts.googleapis.com/css?family=Fira+Sans:400,400i,500,500i,600,600i,700,700i'); 10 | 11 | 12 | /* Reset a few things. */ 13 | 14 | html, body, div, span, applet, object, iframe, h1, h2, h3, h4, h5, h6, p, blockquote, pre, a, abbr, acronym, address, big, cite, code, del, dfn, em, img, ins, kbd, q, s, samp, small, strike, strong, sub, sup, tt, var, b, u, i, center, dl, dt, dd, ol, ul, li, fieldset, form, label, legend, table, caption, tbody, tfoot, thead, tr, th, td, article, aside, canvas, details, embed, figure, figcaption, footer, header, hgroup, menu, nav, output, ruby, section, summary, time, mark, audio, video { 15 | margin: 0; 16 | padding: 0; 17 | border: 0; 18 | font-size: inherit; 19 | font: inherit; 20 | line-height: inherit; 21 | vertical-align: baseline; 22 | text-align: inherit; 23 | color: inherit; 24 | background: transparent; 25 | } 26 | 27 | table { 28 | border-collapse: collapse; 29 | border-spacing: 0; 30 | } 31 | 32 | *, *:before, *:after { 33 | box-sizing: border-box; 34 | } 35 | 36 | html { 37 | font-size: 15px; 38 | } 39 | 40 | body { 41 | font-family: "Fira Sans", Helvetica, Arial, sans-serif; 42 | text-align: left; 43 | color: #333; 44 | background: #FFFFFF; 45 | } 46 | 47 | .content { 48 | max-width: 90ex; 49 | margin-left: calc(10vw + 20ex); 50 | margin-right: 4ex; 51 | margin-top: 20px; 52 | margin-bottom: 50px; 53 | font-family: "Noticia Text", Georgia, serif; 54 | line-height: 1.5; 55 | } 56 | 57 | .content>header { 58 | margin-bottom: 30px; 59 | } 60 | 61 | .content>header nav { 62 | font-family: "Fira Sans", Helvetica, Arial, sans-serif; 63 | } 64 | 65 | /* Basic markup elements */ 66 | 67 | b, strong { 68 | font-weight: 500; 69 | } 70 | 71 | i, em { 72 | font-style: italic; 73 | } 74 | 75 | sup { 76 | vertical-align: super; 77 | } 78 | 79 | sub { 80 | vertical-align: sub; 81 | } 82 | 83 | sup, sub { 84 | font-size: 12px; 85 | line-height: 0; 86 | margin-left: 0.2ex; 87 | } 88 | 89 | pre { 90 | margin-top: 0.8em; 91 | margin-bottom: 1.2em; 92 | } 93 | 94 | p, ul, ol { 95 | margin-top: 0.5em; 96 | margin-bottom: 1em; 97 | } 98 | ul, ol { 99 | list-style-position: outside 100 | } 101 | 102 | ul>li { 103 | margin-left: 22px; 104 | } 105 | 106 | ol>li { 107 | margin-left: 27.2px; 108 | } 109 | 110 | li>*:first-child { 111 | margin-top: 0 112 | } 113 | 114 | /* Text alignements, this should be forbidden. */ 115 | 116 | .left { 117 | text-align: left; 118 | } 119 | 120 | .right { 121 | text-align: right; 122 | } 123 | 124 | .center { 125 | text-align: center; 126 | } 127 | 128 | /* Links and anchors */ 129 | 130 | a { 131 | text-decoration: none; 132 | color: #2C5CBD; 133 | } 134 | 135 | a:hover { 136 | box-shadow: 0 1px 0 0 #2C5CBD; 137 | } 138 | 139 | /* Linked highlight */ 140 | *:target { 141 | background-color: rgba(187,239,253,0.3) !important; 142 | box-shadow: 0 0px 0 1px rgba(187,239,253,0.8) !important; 143 | border-radius: 1px; 144 | } 145 | 146 | *:hover>a.anchor { 147 | visibility: visible; 148 | } 149 | 150 | a.anchor:before { 151 | content: "#" 152 | } 153 | 154 | a.anchor:hover { 155 | box-shadow: none; 156 | text-decoration: none; 157 | color: #555; 158 | } 159 | 160 | a.anchor { 161 | visibility: hidden; 162 | position: absolute; 163 | /* top: 0px; */ 164 | /* margin-left: -3ex; */ 165 | margin-left: -1.3em; 166 | font-weight: normal; 167 | font-style: normal; 168 | padding-right: 0.4em; 169 | padding-left: 0.4em; 170 | /* To remain selectable */ 171 | color: #d5d5d5; 172 | } 173 | 174 | .spec > a.anchor { 175 | margin-left: -2.3em; 176 | padding-right: 0.9em; 177 | } 178 | 179 | .xref-unresolved { 180 | color: #2C5CBD; 181 | } 182 | .xref-unresolved:hover { 183 | box-shadow: 0 1px 0 0 #CC6666; 184 | } 185 | 186 | /* Section and document divisions. 187 | Until at least 4.03 many of the modules of the stdlib start at .h7, 188 | we restart the sequence there like h2 */ 189 | 190 | h1, h2, h3, h4, h5, h6, .h7, .h8, .h9, .h10 { 191 | font-family: "Fira Sans", Helvetica, Arial, sans-serif; 192 | font-weight: 400; 193 | margin: 0.5em 0 0.5em 0; 194 | padding-top: 0.1em; 195 | line-height: 1.2; 196 | overflow-wrap: break-word; 197 | } 198 | 199 | h1 { 200 | font-weight: 500; 201 | font-size: 2.441em; 202 | margin-top: 1.214em; 203 | } 204 | 205 | h1 { 206 | font-weight: 500; 207 | font-size: 1.953em; 208 | box-shadow: 0 1px 0 0 #ddd; 209 | } 210 | 211 | h2 { 212 | font-size: 1.563em; 213 | } 214 | 215 | h3 { 216 | font-size: 1.25em; 217 | } 218 | 219 | small, .font_small { 220 | font-size: 0.8em; 221 | } 222 | 223 | h1 code, h1 tt { 224 | font-size: inherit; 225 | font-weight: inherit; 226 | } 227 | 228 | h2 code, h2 tt { 229 | font-size: inherit; 230 | font-weight: inherit; 231 | } 232 | 233 | h3 code, h3 tt { 234 | font-size: inherit; 235 | font-weight: inherit; 236 | } 237 | 238 | h3 code, h3 tt { 239 | font-size: inherit; 240 | font-weight: inherit; 241 | } 242 | 243 | h4 { 244 | font-size: 1.12em; 245 | } 246 | 247 | 248 | /* Preformatted and code */ 249 | 250 | tt, code, pre { 251 | font-family: "Fira Mono", courier; 252 | font-weight: 400; 253 | } 254 | 255 | pre { 256 | padding: 0.1em; 257 | border: 1px solid #eee; 258 | border-radius: 5px; 259 | overflow-x: auto; 260 | } 261 | 262 | p code, li code { 263 | background-color: #f6f8fa; 264 | color: #0d2b3e; 265 | border-radius: 3px; 266 | padding: 0 0.3ex; 267 | } 268 | 269 | p a > code { 270 | color: #2C5CBD; 271 | } 272 | 273 | /* Code blocks (e.g. Examples) */ 274 | 275 | pre code { 276 | font-size: 0.893rem; 277 | } 278 | 279 | /* Code lexemes */ 280 | 281 | .keyword { 282 | font-weight: 500; 283 | } 284 | 285 | /* Module member specification */ 286 | 287 | .spec:not(.include), .spec.include details summary { 288 | background-color: #f6f8fa; 289 | border-radius: 3px; 290 | border-left: 4px solid #5c9cf5; 291 | border-right: 5px solid transparent; 292 | padding: 0.35em 0.5em; 293 | } 294 | 295 | .spec.include details summary:hover { 296 | background-color: #ebeff2; 297 | } 298 | 299 | dl, div.spec, .doc, aside { 300 | margin-bottom: 20px; 301 | } 302 | 303 | dl > dd { 304 | padding: 0.5em; 305 | } 306 | 307 | dd> :first-child { 308 | margin-top: 0; 309 | } 310 | 311 | dl:last-child, dd> :last-child, aside:last-child, article:last-child { 312 | margin-bottom: 0; 313 | } 314 | 315 | dt+dt { 316 | margin-top: 15px; 317 | } 318 | 319 | section+section, section > header + dl { 320 | margin-top: 25px; 321 | } 322 | 323 | .spec.type .variant { 324 | margin-left: 2ch; 325 | } 326 | .spec.type .variant p { 327 | margin: 0; 328 | font-style: italic; 329 | } 330 | .spec.type .record { 331 | margin-left: 2ch; 332 | } 333 | .spec.type .record p { 334 | margin: 0; 335 | font-style: italic; 336 | } 337 | 338 | div.def { 339 | margin-top: 0; 340 | text-indent: -2ex; 341 | padding-left: 2ex; 342 | } 343 | 344 | div.def+div.doc { 345 | margin-left: 1ex; 346 | margin-top: 2.5px 347 | } 348 | 349 | div.doc>*:first-child { 350 | margin-top: 0; 351 | } 352 | 353 | /* The elements other than heading should be wrapped in