up to date with the journal revision

README.md

@@ -6,12 +6,12 @@ Session-ocaml is an implementation of session types in OCaml.
 
 ## How to try it
 
-Prepare OCaml 4.02.1 or later and install ```findlib```, ```ocamlbuild```, ```ppx_tools```.
-We recommend to use ```opam``` and OCaml 4.03.0.
+Prepare OCaml __4.05__ and install ```findlib```, ```ocamlbuild```, ```ppx_tools```.
+We recommend to use ```opam```
 
-Install the compiler and prerequisite libraries.
+Install the compiler and prerequisite libraries. (__NOTE__: the version number has changed:  4.03 ==> __4.05__)
 
-    opam switch 4.03.0
+    opam switch 4.05.0
     eval `opam config env`
     opam install ocamlfind ocamlbuild ppx_tools
 
@@ -46,12 +46,11 @@ Also, you can uninstall manually by ```ocamlfind remove session-ocaml```.
 
 # Macro for branching / selection
 
-For branching on arbitrary labels, we provide a macro ```match%branch0``` and ```match%branch```.
-
-Single-channel case (```open Session0```):
+For branching on arbitrary labels, we provide a macro ```match%branch```.
 
 ```ocaml
-  match%branch0 () with
+  open Session
+  match%branch s with
   | `apple  -> send 100
   | `banana -> recv ()
   | `orange -> send "Hello!"
@@ -66,39 +65,11 @@ Its protocol type will be:
     | `orange of [`msg of req * string * 'a]]
 ```
 
-Multi-channel case (```open SessionN```):
-
-```ocaml
-  match%branch _2 with
-  | `batman  -> [%select _2 `goodbye]
-  | `ironman -> let%s x = recv _2 in send _2 x
-  | `hulk    -> send _2 "foobar"
-```
-
-Protocol type:
-
-```
-  [ `branch of resp *
-    [ `batman  of [ `branch of req * _[> `goodbye of '_e ] ]
-    | `hulk    of [ `msg of req * string * '_e ]
-    | `ironman of [ `msg of resp * '_f * [ `msg of req * '_f * '_e ] ] ] ]
-```
-
   Similarly, we have a macro for selection, like
 
 ```ocaml
-  [%select0 `label]
-```
-
-or
-
+  [%select s `label]
 ```
-  [%select _n `bark]
-```
-
-## TODO
-
-* Better error reporting inside %branch0 and %branch
 
 ----
 author: Keigo IMAI (@keigoi on Twitter / keigoi __AT__ gifu-u.ac.jp)

examples/dbserver.ml

@@ -0,0 +1,36 @@
+open Session
+
+type result = Result (*stub*)
+type credential = Cred (*stub*)
+let bad_credential Cred = false (*stub*)
+let do_query (query:string) : result = Result (*stub*)
+
+let db_ch = new_channel ()
+and worker_ch = new_channel ()  
+
+let rec main () =
+  accept db_ch ~bindto:_0 >>
+  recv _0 >>= fun cred ->
+  if bad_credential cred then
+    select_left _0 >>
+    close _0
+  else
+    select_right _0 >>
+    connect worker_ch ~bindto:_1 >>
+    deleg_send _1 ~release:_0 >>
+    close _1 >>=
+    main
+
+let rec worker () =
+  accept worker_ch ~bindto:_0 >>
+  deleg_recv _0 ~bindto:_1 >>
+  close _0 >>
+  let rec loop () =
+    branch
+      ~left:(_1, fun () -> close _1)
+      ~right:(_1, fun () ->
+          recv _1 >>= fun query ->
+          let res = do_query query in
+          send _1 res >>=
+          loop)
+  in loop () >>= worker

examples/example_journal1.ml

@@ -0,0 +1,14 @@
+open Session
+let xor : bool -> bool -> bool = (<>)
+let print_bool = Printf.printf "%B"
+let xor_ch = new_channel ();;
+Thread.create
+  (accept_ xor_ch (fun () ->
+    recv s >>= fun (x,y) ->
+    send s (xor x y) >>
+    close s)) ();;
+connect_ xor_ch (fun () ->
+  send s (false,true) >>
+  recv s >>= fun b ->
+  print_bool b;
+  close s) ()

examples/example_journal2.ml

@@ -0,0 +1,27 @@
+open Session
+let xor : bool -> bool -> bool = (<>)
+let print_bool = Printf.printf "%B"
+type binop = And | Or | Xor | Imp
+let log_ch = new_channel ()
+let eval_op = function
+  | And -> (&&)
+  | Or -> (||)
+  | Xor -> xor
+  | Imp -> (fun a b -> not a || b)
+let rec logic_server () =
+  branch ~left:(s, fun () ->
+      recv s >>= fun op ->
+      recv s >>= fun (x,y) ->
+      send s (eval_op op x y) >>= fun () ->
+      logic_server ())
+    ~right:(s, fun () -> close s);;
+Thread.create
+  (accept_ log_ch logic_server) ();;
+connect_ log_ch (fun () ->
+  select_left s >>
+  send s And >>
+  send s (true, false) >>
+  recv s >>= fun ans ->
+  (print_bool ans;
+  select_right s >>
+  close s)) ()

examples/example_journal3.ml

@@ -0,0 +1,38 @@
+open Session
+open Example_journal2
+let worker_ch = new_channel ()
+let rec main () =
+  accept log_ch ~bindto:_0 >>
+  connect worker_ch ~bindto:_1 >>
+  deleg_send _1 ~release:_0 >>
+  close _1 >>= fun () ->
+  main ()
+let rec worker () =
+  accept worker_ch ~bindto:_1 >>
+  deleg_recv _1 ~bindto:_0 >>
+  close _1 >>
+  logic_server () >>= fun () ->
+  worker ();;
+for i = 0 to 5 do
+  Thread.create (run worker) ()
+done;;
+Thread.create (run main) ();;
+connect_ log_ch (fun () ->
+  select_left s >>
+  send s Or >>
+  send s (true, false) >>
+  recv s >>= fun ans ->
+  print_bool ans; print_newline ();
+  select_left s >>
+  send s And >>
+  send s (true, false) >>
+  recv s >>= fun ans ->
+  print_bool ans; print_newline ();
+  select_left s >>
+  send s Xor >>
+  send s (true, false) >>
+  recv s >>= fun ans ->
+  print_bool ans; print_newline ();
+  select_right s >>
+  close s) ()
+

examples/smtp2.ml

@@ -137,7 +137,7 @@ open Tcp
 
 let s = _0
 
-let sendmail host port from to_ mailbody () : ((smtp,cli,stream) dsess * empty_three, empty_four, unit lin) lmonad =
+let sendmail host port from to_ mailbody () : ((smtp,cli,stream) dsess * empty_three, empty_four, unit) lmonad =
   let%lin `_200(msg,#s) = branch s in
   List.iter print_endline msg;
   let%lin #s = select (fun x -> `EHLO("me.example.com",x)) s in