From 28ff35ca9fe4b5c7eaa41d5f34948fed4709888c Mon Sep 17 00:00:00 2001 From: Thomas Leonard Date: Thu, 19 May 2016 11:10:13 +0100 Subject: [PATCH] Update Lwt tutorial examples to match new tutorial In particular: - Change `C.log` to `log_s`. `log` is the emergency non-blocking version that discards data if the buffer is full. We should not encourage its use in a tutorial. Also, it doesn't demonstrate using Lwt. - Use `>>=` rather than `>|=` because the tutorial didn't introduce it yet. - Don't use `_` to ignore exceptions in timeout example. - Moved some functions out of `start` for clarity. - Remove mvar and stream examples, as they're no longer in the tutorial. --- console/unikernel.ml | 4 +- lwt/Makefile | 2 +- lwt/src/config.ml | 5 -- lwt/src/mvar_unikernels.ml | 99 -------------------------------------- lwt/src/stream_server.ml | 54 --------------------- lwt/src/unikernels.ml | 67 ++++++++++++-------------- 6 files changed, 34 insertions(+), 197 deletions(-) delete mode 100644 lwt/src/mvar_unikernels.ml delete mode 100644 lwt/src/stream_server.ml diff --git a/console/unikernel.ml b/console/unikernel.ml index fef10f2a..41b3ff52 100644 --- a/console/unikernel.ml +++ b/console/unikernel.ml @@ -6,9 +6,9 @@ module Main (C: V1_LWT.CONSOLE) = struct let rec loop = function | 0 -> Lwt.return_unit | n -> - C.log c "hello"; + C.log_s c "hello" >>= fun () -> OS.Time.sleep 1.0 >>= fun () -> - C.log c "world"; + C.log_s c "world" >>= fun () -> loop (n-1) in loop 4 diff --git a/lwt/Makefile b/lwt/Makefile index 57b88e0f..4541d819 100644 --- a/lwt/Makefile +++ b/lwt/Makefile @@ -1,7 +1,7 @@ include ../Makefile.config TARGETS=heads1 heads2 heads3 timeout1 timeout2 \ - echo_server1 echo_server2 int_server stream_server + echo_server1 echo_server2 configure: $(patsubst %,%-configure,$(TARGETS)) build: $(patsubst %,%-build,$(TARGETS)) diff --git a/lwt/src/config.ml b/lwt/src/config.ml index a1c54da0..97bfaa85 100644 --- a/lwt/src/config.ml +++ b/lwt/src/config.ml @@ -11,11 +11,6 @@ let (name, main) = | "echo_server1" -> ("echo_server1", "Unikernels.Echo_server1") - | "echo_server2" -> ("echo_server2", "Mvar_unikernels.Echo_server2") - | "int_server" -> ("int_server", "Mvar_unikernels.Int_server") - - | "stream_server" -> ("stream_server", "Stream_server.Unikernel") - with Not_found -> failwith "Must specify target" let () = diff --git a/lwt/src/mvar_unikernels.ml b/lwt/src/mvar_unikernels.ml deleted file mode 100644 index 6bc1fa4c..00000000 --- a/lwt/src/mvar_unikernels.ml +++ /dev/null @@ -1,99 +0,0 @@ -open OS -open Lwt.Infix - -let ( |> ) x f = f x - -let map f m_in = - let m_out = Lwt_mvar.create_empty () in - let rec aux () = - Lwt_mvar.( - take m_in >>= - f >>= fun v -> - put m_out v >>= fun () -> - aux () - ) - in - let _t = aux () in - m_out - -let split m_ab = - let m_a, m_b = Lwt_mvar.(create_empty (), create_empty ()) in - let rec aux () = - Lwt_mvar.take m_ab >>= fun (a, b) -> - Lwt.join [ - Lwt_mvar.put m_a a; - Lwt_mvar.put m_b b; - ] >>= aux - in - let _t = aux () in - (m_a, m_b) - -let filter f m_a = - let m_out = Lwt_mvar.create_empty () in - let rec aux () = - Lwt_mvar.take m_a >>= fun a -> - f a >>= function - | true -> Lwt_mvar.put m_out a >>= aux - | false -> aux () - in - let _t = aux () in - m_out - -let read_line () = - Lwt.return (String.make (Random.int 20) 'a') - -let wait_strlen str = - OS.Time.sleep (float_of_int (String.length str)) >>= fun () -> - Lwt.return str - -let cap_str str = - Lwt.return (String.uppercase str) - -module Echo_server2 (C: V1_LWT.CONSOLE) = struct - - let start c = - let m_input = Lwt_mvar.create_empty () in - let m_output = m_input |> map wait_strlen |> map cap_str in - - let rec read () = - read_line () >>= fun s -> - Lwt_mvar.put m_input s >>= - read - in - let rec write () = - Lwt_mvar.take m_output >>= fun r -> - C.log c r; - write () - in - (read ()) <&> (write ()) - -end - -module Int_server (C: V1_LWT.CONSOLE) = struct - - let start c = - let add_mult (a, b) = Lwt.return (a + b, a * b) in - let print_and_go str a = - C.log c (Printf.sprintf "%s %d" str a); - Lwt.return a - in - let test_odd a = Lwt.return (1 = (a mod 2)) in - let rec print_odd m = - Lwt_mvar.take m >>= fun a -> - C.log c (Printf.sprintf "Odd: %d" a); - print_odd m - in - let ( |> ) x f = f x in - - (* main *) - let m_input = Lwt_mvar.create_empty () in - let (ma, mm) = m_input |> map add_mult |> split in - let _ = ma |> map (print_and_go "Add:") |> filter test_odd |> print_odd in - let _ = mm |> map (print_and_go "Mult:") |> filter test_odd |> print_odd in - let rec inp () = - Lwt_mvar.put m_input (Random.int 1000, Random.int 1000) >>= fun () -> - Time.sleep 1. >>= fun () -> - inp () in - inp () - -end diff --git a/lwt/src/stream_server.ml b/lwt/src/stream_server.ml deleted file mode 100644 index 9236ba91..00000000 --- a/lwt/src/stream_server.ml +++ /dev/null @@ -1,54 +0,0 @@ -open Lwt.Infix - -let map f ins = - let (outs, push) = Lwt_stream.create () in - let rec aux () = - Lwt_stream.get ins >>= function - | None -> push None; Lwt.return () - | Some x -> f x >>= fun y -> push (Some y); aux () - in - let _t = aux () in - outs - -let split iab = - let (oa, pa) = Lwt_stream.create () in - let (ob, pb) = Lwt_stream.create () in - let rec aux () = - Lwt_stream.get iab >>= function - | None -> pa None; pb None; Lwt.return () - | Some (a,b) -> pa (Some a); pb (Some b); aux () - in - let _ = aux () in - (oa, ob) - -let filter p is = - let (os, push) = Lwt_stream.create () in - let rec aux () = - Lwt_stream.get is >>= function - | None -> push None; Lwt.return () - | Some x -> p x >>= function - | true -> push (Some x); aux () - | false -> aux () - in - let _ = aux () in - os - -let read_line () = - Lwt.return (String.make (Random.int 20) 's') - -module Unikernel (C: V1_LWT.CONSOLE) = struct - - let start c = - let ins, inp = Lwt_stream.create () in - let _outs, outp = Lwt_stream.create () in - - let rec read () = (read_line () >|= fun s -> inp (Some s)) >>= read - in - let rec write () = - Lwt_stream.get ins >>= function - | None -> outp None; Lwt.return () - | Some x -> C.log c x; outp (Some x); write () - in - read () <&> write () - -end diff --git a/lwt/src/unikernels.ml b/lwt/src/unikernels.ml index ac2f063b..d53861e2 100644 --- a/lwt/src/unikernels.ml +++ b/lwt/src/unikernels.ml @@ -5,12 +5,10 @@ module Heads1 (C: V1_LWT.CONSOLE) = struct let start c = Lwt.join [ - (Time.sleep 1.0 >|= fun () -> - C.log c "Heads"); - (Time.sleep 2.0 >|= fun () -> - C.log c "Tails"); - ] >|= fun () -> - C.log c ("Finished") + (Time.sleep 1.0 >>= fun () -> C.log_s c "Heads"); + (Time.sleep 2.0 >>= fun () -> C.log_s c "Tails") + ] >>= fun () -> + C.log_s c ("Finished") end @@ -43,56 +41,53 @@ end module Timeout1 (C: V1_LWT.CONSOLE) = struct + let timeout delay t = + Time.sleep delay >>= fun () -> + match Lwt.state t with + | Lwt.Sleep -> Lwt.cancel t; Lwt.return None + | Lwt.Return v -> Lwt.return (Some v) + | Lwt.Fail ex -> Lwt.fail ex + let start c = Random.self_init (); - - let timeout f t = - Time.sleep f >>= fun () -> - match Lwt.state t with - | Lwt.Return v -> Lwt.return (Some v) - | _ -> Lwt.cancel t; Lwt.return None - in - let t = Time.sleep (Random.float 3.0) >|= fun () -> "Heads" in - timeout 2.0 t >>= fun v -> - C.log c (match v with None -> "cancelled" | Some v -> v); - C.log c "Finished"; - Lwt.return_unit + timeout 2.0 t >>= function + | None -> C.log_s c "Cancelled" + | Some v -> C.log_s c (Printf.sprintf "Returned %S" v) end module Timeout2 (C: V1_LWT.CONSOLE) = struct + let timeout delay t = + let tmout = Time.sleep delay in + Lwt.pick [ + (tmout >|= fun () -> None); + (t >|= fun v -> Some v); + ] + let start c = Random.self_init (); - let timeout f t = - let tmout = Time.sleep f in - Lwt.pick [ - (tmout >|= fun () -> None); - (t >|= fun v -> Some v); - ] - in let t = Time.sleep (Random.float 3.0) >|= fun () -> "Heads" in - timeout 2.0 t >>= fun v -> - C.log c (match v with None -> "Cancelled" | Some v -> v); - C.log c "Finished"; - Lwt.return_unit + timeout 2.0 t >>= function + | None -> C.log_s c "Cancelled" + | Some v -> C.log_s c (Printf.sprintf "Returned %S" v) end module Echo_server1 (C: V1_LWT.CONSOLE) = struct + let read_line () = + OS.Time.sleep (Random.float 2.5) >|= fun () -> + String.make (Random.int 20) 'a' + let start c = - let read_line () = - Time.sleep (Random.float 2.5) - >|= fun () ->String.make (Random.int 20) 'a' - in let rec echo_server = function | 0 -> Lwt.return () | n -> - read_line () >>= fun s -> - C.log c s; - echo_server (n-1) + read_line () >>= fun s -> + C.log_s c s >>= fun () -> + echo_server (n - 1) in echo_server 10