mjambon · May 29, 2022 19:59 · erikmd · Apr 13, 2021 · mjambon · Apr 13, 2021
diff --git a/ocaml_lwt_sample.ml b/ocaml_lwt_sample.ml
 (*
   Interactive approach
   --------------------

   You can copy-paste code into `utop`, provided you load the lwt.unix
   package:

     #use "topfind";;
     #thread;;  (* only needed in the plain `ocaml` toplevel, not in `utop`. *)
     #require "lwt.unix";;

   Each statement must be followed by `;;` to let utop know that you're done.

   You can also load the whole file using `#use`:

     #use "ocaml_lwt_sample.ml";;

   Standalone executable
   ---------------------

   You an compile this program into a standalone executable
   with the following command:

     ocamlfind opt -o ocaml_lwt_sample -package lwt.unix -linkpkg \
       ocaml_lwt_sample.ml

   Then run it:

     ./ocaml_lwt_sample
 *)

 (*** Basic syntax ***)

 (* Compute an int and call it `four`. It is immutable. *)
 let four = 2 + 2

 let greeting = "Yo"

 (* Function definition. One argument of type `unit`. *)
 let hello () =
  (* Call a function of one argument *)
  print_endline greeting

 (* Another variable `greeting` that shadows the first one only in the
   code that follows. *)
 let greeting = "Hello"

 (* Syntax wart - this phony `let` is how we avoid sticking `;;` everywhere *)
 let () = hello ()

 (* Note that we printed `Yo`, not `Hello` *)

 (* Function of multiple arguments *)
 let add a b =
  a + b

 (* Partial application: `add2 x` calls `add 2 x` *)
 let add2 = add 2

 (* Often we avoid partial application for more clarity *)
 let add3 x =
  add 3 x

 (* When several arguments have the same type or there are many arguments,
   we label them. *)
 let say_hello ~greeting ~name =
  Printf.printf "%s %s.\n" greeting name

 (* Calling functions with labeled arguments is accepted by the compiler
   only if the labels are correct. Argument no longer matters since the
   arguments are labeled. *)
 let () = say_hello ~name:"there" ~greeting:"Hi"

 (* Optional arguments *)
 let say_hello2 ?(greeting = "Hi") ~name () =
  Printf.printf "%s %s.\n" greeting name

 (* We can omit optional arguments or not. *)
 let () = say_hello2 ~name:"you" ()
 let () = say_hello2 ~greeting:"Hello" ~name:"programmer" ()

 (* Pattern-matching *)
 let is_hello s =
  match s with
  | "Hello" | "hello" -> true
  | _ (* otherwise *) -> false

 (* Type definitions *)
 type time = int  (* an alias *)

 (* A record type definition *)
 type profile = {
  name: string;
  age: int;
 }

 (* Variants *)
 type color = Green | Red
 type fruit = Banana | Apple of color

 (* Polymorphic variants: same as regular variants but they
   don't need a type definition, although it's recommended to simplify
   to error messages.
 *)
 type result = [ `OK | `Error of string ]

 (* Parametrized types *)
 type 'a stuff = (* equivalent to Stuff<A> in other languages *)
  {
    id: string;
    items: 'a list
  }

 (* More pattern-matching *)

 let give_me_a_result () : result (* optional type annotation *) =
  `Error "This is a test"

 let success =
  match give_me_a_result () with
  | `OK -> true
  | `Error _ -> false

 (* Lists - immutable singly-linked lists.
   They're the default data structure for storing collections of items.
   These are not suitable for random access.

   A list is either the empty list denoted `[]`
   or a pair of the first element called the head and the rest of the list
   called the tail, e.g. `element :: other_elements`
 *)
 let list0 = 1 :: (2 :: (3 :: []))
 let list1 = 1 :: 2 :: 3 :: []     (* same as list0 *)
 let list2 = [1; 2; 3]             (* same as list1 *)

 (* More pattern-matching *)

 let first_fruit_is_an_apple fruits =
  match fruits with
  | [] -> false
  | Banana :: _ -> false
  | Apple _ :: _ -> true

 (* Simpler code that will break silently if an
   `Apple2` case is added to the type definition later: *)
 let fragile_first_fruit_is_an_apple fruits =
  match fruits with
  | Apple _ :: _ -> true
  | _ -> false

 (* Recursive functions require the `rec` keyword (but type definitions are
   implicitly recursive). We don't need to write recursive functions
   too often in "enterprise" code but this is how all iterators
   over lists are defined, and sometimes it's better to write our own.

   The following is the same as the standard `List.filter`.
 *)
 let rec filter predicate list =
  match list with
  | [] -> []
  | head :: tail ->
      if predicate head then
        head :: filter predicate tail
      else
        filter predicate tail

 (* Similar code that performs the tests from right to left instead
   but otherwise returns the same result
   (assuming `predicate` is stateless). *)
 let rec filter2 predicate list =
  match list with
  | [] -> []
  | head :: tail ->
      let new_tail = filter predicate tail in
      if predicate head then
        head :: new_tail
      else
        new_tail

 let is_even x =
  x mod 2 = 0

 let filtered_list = filter is_even [0; 2; 3; 4; 5; 88; 99]

 (* Using an anonymous function *)
 let filtered_list2 = filter (fun x -> x mod 2 = 0) [0; 2; 3; 4; 5; 88; 99]

 (* Exercises:

   1. Implement the `iter` function, which takes a function and a list,
      and applies the function to each element of the list from
      left to right:

        iter print_endline ["a"; "b"; "c"]

      must print:

        a
        b
        c

   2. Define your own list type as a variant type
      without the special syntax `[]` and `::`.

   3. Modify your `iter` function to work on your own list type instead.
 *)

 (* The built-in option type
   Defined as:

   type 'a option = None | Some of 'a
 *)
 let obtain_value default_value optional_value =
  match optional_value with
  | None -> default_value
  | Some x -> x

 (* Optional arguments without a default use the option type *)
 let show_optional_arg ?x () =
  x

 (* Exceptions

   Exceptions are of the type `exn` which is a special variant type
   than can be extended with new cases.
 *)
 exception Fishsticks of string
  (* Now `Fishsticks "uh oh"` is a valid value for the type `exn`. *)

 (* Catching exceptions *)
 let found =
  try
    Some (List.find (fun x -> x < 0) [1;2;3])
  with Not_found ->
    None

 (* Tuples *)
 let some_stuff = (123, "abc", None)

 (*** Mutable stuff ***)

 (* Records with mutable fields: not often used directly *)
 type point = {
  mutable x: int;
  mutable y: int;
 }

 let p =
  let p = { x = 0; y = 0 } in
  p.x <- 123;
  p

 (* References: a single mutable cell.
   Predefined as:

     type 'a ref = { mutable contents : 'a }

   References come with 2 handy set/get operators `:=` and `!`,
   plus `incr` and `decr` to operate on counters.
 *)
 let counter = ref 0

 let () =
  counter := 10

 let ten = !counter

 let () =
  counter := !counter + 1

 let eleven = !counter

 let () = incr counter

 let twelve = !counter

 (* Assertions *)
 let () =
  assert (ten = 10);
  assert (eleven = 11);
  assert (twelve = 12)

 (* Arrays: for efficient random access and mutability *)
 let some_array = [| 123; 45; 678 |]
 let fortyfive = some_array.(1)

 (*** Modules ***)

 (*
   Each .ml source file results in a module after capitalization.
   The standard library has a source file `printf.ml`.
 *)
 open Printf

 let say_hello3 ?(greeting = "Hello") name =
  (* instead of Printf.printf *)
  printf "%s %s.\n" greeting name

 (* We can also define submodules as follows *)
 module Op = struct
  let (=) a b =
    String.lowercase a = String.lowercase b
 end

 let result1 = "Pistachio" = "pistachio"      (* false *)
 let result2 = Op.("Pistachio" = "pistachio") (* true *)

 (* Same as result2 definition, alternative syntax *)
 let result3 =
  let open Op in
  "Pistachio" = "pistachio"


 (*** Asynchronous programming with Lwt ***)

 (* Lwt is a regular OCaml library that supports a "cooperative
   threads" model, similar to JavaScript.

   Each computation is called a promise (formerly "thread"), but only
   one promise can run at once.  A promise is typically defined as an
   anonymous function that will be called after the result of some
   other promise becomes available, with a possible delay.

   A promise is an opaque object of type `'a Lwt.t`, representing the
   asynchronous computation of a value of type 'a.

   Which promise runs at a given time is determined by a scheduler,
   which is launched by the function `Lwt_main.run`.

   When a promise terminates ("resolves"), it is in either of these
   states: - successful, holding a result - failed, holding an
   exception

   Waiting on the promise is done using the bind operator `(>>=)` which
   is the same function as `Lwt.bind`.  *)

 (* Make `(>>=)` available. *)
 open Lwt

 (* Sleep 1.5 seconds, then make the result `()` available. *)
 let wait_for_a_while () =
  Lwt_unix.sleep 1.5

 let () =
  Lwt_main.run (wait_for_a_while ())

 (* `Lwt.return` wraps an OCaml value into a resolved lwt promise *)
 let print_message_after_a_while () =
  wait_for_a_while () >>= (fun () -> print_endline "done"; Lwt.return ())

 (*
   Several promises can wait on a given promise.
   There's no guarantee on the order in which promises 1,2,3 will run.
   Worse, the promises 1 and 2 are ignored, i.e. the main loop
   `Lwt_main.run` won't wait for them. If promise 3 finishes first,
   `1` and `2` won't be printed.
 *)
 let print_messages_after_a_while_v1 () =
  let timer = wait_for_a_while () in
  ignore (timer >>= fun () -> print_endline "1"; Lwt.return ());
  ignore (timer >>= fun () -> print_endline "2"; Lwt.return ());
  timer >>= fun () -> print_endline "3"; Lwt.return ()

 let () =
  print_endline "print_messages_after_a_while_v1";
  Lwt_main.run (print_messages_after_a_while_v1 ())

 (* Better, make sure to wait for the 3 promises.
   Additionally, we print a message when we're done with all 3 promises. *)
 let print_messages_after_a_while_v2 () =
  let timer = wait_for_a_while () in
  let t1 = timer >>= fun () -> print_endline "1"; Lwt.return () in
  let t2 = timer >>= fun () -> print_endline "2"; Lwt.return () in
  let t3 = timer >>= fun () -> print_endline "3"; Lwt.return () in
  Lwt.join [t1; t2; t3] >>= fun () ->
  print_endline "all done";
  Lwt.return ()

 let () =
  print_endline "print_messages_after_a_while_v2";
  Lwt_main.run (print_messages_after_a_while_v2 ())

 (* Exceptions are propagated along bind points. If a promise B waits for its
   input from another promise A but A results in an exception, then
   B resolves to the same exception. *)
 let make_promise_that_fails () =
  Lwt_unix.sleep 0.1 >>= fun () ->
  failwith "Uh oh" (* raises the exception `Failure "Uh oh"` *) >>= fun () ->
  print_endline "This never happens.";
  Lwt.return ()

 let report_error promise_name make_promise =
  Lwt.catch
    (fun () -> make_promise ())
    (fun e ->
       Printf.eprintf "Expected exception in promise %s: %s\n"
         promise_name
         (Printexc.to_string e);
       return ()
    )

 let () =
  let promise = report_error "promise-that-fails" make_promise_that_fails in
  Lwt_main.run promise
	(*
	Interactive approach
	--------------------

	You can copy-paste code into `utop`, provided you load the lwt.unix
	package:

	#use "topfind";;
	#thread;; (* only needed in the plain `ocaml` toplevel, not in `utop`. *)
	#require "lwt.unix";;

	Each statement must be followed by `;;` to let utop know that you're done.

	You can also load the whole file using `#use`:

	#use "ocaml_lwt_sample.ml";;

	Standalone executable
	---------------------

	You an compile this program into a standalone executable
	with the following command:

	ocamlfind opt -o ocaml_lwt_sample -package lwt.unix -linkpkg \
	ocaml_lwt_sample.ml

	Then run it:

	./ocaml_lwt_sample
	*)

	(* Basic syntax *)

	(* Compute an int and call it `four`. It is immutable. *)
	let four = 2 + 2

	let greeting = "Yo"

	(* Function definition. One argument of type `unit`. *)
	let hello () =
	(* Call a function of one argument *)
	print_endline greeting

	(* Another variable `greeting` that shadows the first one only in the
	code that follows. *)
	let greeting = "Hello"

	(* Syntax wart - this phony `let` is how we avoid sticking `;;` everywhere *)
	let () = hello ()

	(* Note that we printed `Yo`, not `Hello` *)

	(* Function of multiple arguments *)
	let add a b =
	a + b

	(* Partial application: `add2 x` calls `add 2 x` *)
	let add2 = add 2

	(* Often we avoid partial application for more clarity *)
	let add3 x =
	add 3 x

	(* When several arguments have the same type or there are many arguments,
	we label them. *)
	let say_hello ~greeting ~name =
	Printf.printf "%s %s.\n" greeting name

	(* Calling functions with labeled arguments is accepted by the compiler
	only if the labels are correct. Argument no longer matters since the
	arguments are labeled. *)
	let () = say_hello ~name:"there" ~greeting:"Hi"

	(* Optional arguments *)
	let say_hello2 ?(greeting = "Hi") ~name () =
	Printf.printf "%s %s.\n" greeting name

	(* We can omit optional arguments or not. *)
	let () = say_hello2 ~name:"you" ()
	let () = say_hello2 ~greeting:"Hello" ~name:"programmer" ()

	(* Pattern-matching *)
	let is_hello s =
	match s with
	\| "Hello" \| "hello" -> true
	\| _ (* otherwise *) -> false

	(* Type definitions *)
	type time = int (* an alias *)

	(* A record type definition *)
	type profile = {
	name: string;
	age: int;
	}

	(* Variants *)
	type color = Green \| Red
	type fruit = Banana \| Apple of color

	(* Polymorphic variants: same as regular variants but they
	don't need a type definition, although it's recommended to simplify
	to error messages.
	*)
	type result = [ `OK \| `Error of string ]

	(* Parametrized types *)
	type 'a stuff = (* equivalent to Stuff<A> in other languages *)
	{
	id: string;
	items: 'a list
	}

	(* More pattern-matching *)

	let give_me_a_result () : result (* optional type annotation *) =
	`Error "This is a test"

	let success =
	match give_me_a_result () with
	\| `OK -> true
	\| `Error _ -> false

	(* Lists - immutable singly-linked lists.
	They're the default data structure for storing collections of items.
	These are not suitable for random access.

	A list is either the empty list denoted `[]`
	or a pair of the first element called the head and the rest of the list
	called the tail, e.g. `element :: other_elements`
	*)
	let list0 = 1 :: (2 :: (3 :: []))
	let list1 = 1 :: 2 :: 3 :: [] (* same as list0 *)
	let list2 = [1; 2; 3] (* same as list1 *)

	(* More pattern-matching *)

	let first_fruit_is_an_apple fruits =
	match fruits with
	\| [] -> false
	\| Banana :: _ -> false
	\| Apple _ :: _ -> true

	(* Simpler code that will break silently if an
	`Apple2` case is added to the type definition later: *)
	let fragile_first_fruit_is_an_apple fruits =
	match fruits with
	\| Apple _ :: _ -> true
	\| _ -> false

	(* Recursive functions require the `rec` keyword (but type definitions are
	implicitly recursive). We don't need to write recursive functions
	too often in "enterprise" code but this is how all iterators
	over lists are defined, and sometimes it's better to write our own.

	The following is the same as the standard `List.filter`.
	*)
	let rec filter predicate list =
	match list with
	\| [] -> []
	\| head :: tail ->
	if predicate head then
	head :: filter predicate tail
	else
	filter predicate tail

	(* Similar code that performs the tests from right to left instead
	but otherwise returns the same result
	(assuming `predicate` is stateless). *)
	let rec filter2 predicate list =
	match list with
	\| [] -> []
	\| head :: tail ->
	let new_tail = filter predicate tail in
	if predicate head then
	head :: new_tail
	else
	new_tail

	let is_even x =
	x mod 2 = 0

	let filtered_list = filter is_even [0; 2; 3; 4; 5; 88; 99]

	(* Using an anonymous function *)
	let filtered_list2 = filter (fun x -> x mod 2 = 0) [0; 2; 3; 4; 5; 88; 99]

	(* Exercises:

	1. Implement the `iter` function, which takes a function and a list,
	and applies the function to each element of the list from
	left to right:

	iter print_endline ["a"; "b"; "c"]

	must print:

	a
	b
	c

	2. Define your own list type as a variant type
	without the special syntax `[]` and `::`.

	3. Modify your `iter` function to work on your own list type instead.
	*)

	(* The built-in option type
	Defined as:

	type 'a option = None \| Some of 'a
	*)
	let obtain_value default_value optional_value =
	match optional_value with
	\| None -> default_value
	\| Some x -> x

	(* Optional arguments without a default use the option type *)
	let show_optional_arg ?x () =
	x

	(* Exceptions

	Exceptions are of the type `exn` which is a special variant type
	than can be extended with new cases.
	*)
	exception Fishsticks of string
	(* Now `Fishsticks "uh oh"` is a valid value for the type `exn`. *)

	(* Catching exceptions *)
	let found =
	try
	Some (List.find (fun x -> x < 0) [1;2;3])
	with Not_found ->
	None

	(* Tuples *)
	let some_stuff = (123, "abc", None)

	(* Mutable stuff *)

	(* Records with mutable fields: not often used directly *)
	type point = {
	mutable x: int;
	mutable y: int;
	}

	let p =
	let p = { x = 0; y = 0 } in
	p.x <- 123;
	p

	(* References: a single mutable cell.
	Predefined as:

	type 'a ref = { mutable contents : 'a }

	References come with 2 handy set/get operators `:=` and `!`,
	plus `incr` and `decr` to operate on counters.
	*)
	let counter = ref 0

	let () =
	counter := 10

	let ten = !counter

	let () =
	counter := !counter + 1

	let eleven = !counter

	let () = incr counter

	let twelve = !counter

	(* Assertions *)
	let () =
	assert (ten = 10);
	assert (eleven = 11);
	assert (twelve = 12)

	(* Arrays: for efficient random access and mutability *)
	let some_array = [\| 123; 45; 678 \|]
	let fortyfive = some_array.(1)

	(* Modules *)

	(*
	Each .ml source file results in a module after capitalization.
	The standard library has a source file `printf.ml`.
	*)
	open Printf

	let say_hello3 ?(greeting = "Hello") name =
	(* instead of Printf.printf *)
	printf "%s %s.\n" greeting name

	(* We can also define submodules as follows *)
	module Op = struct
	let (=) a b =
	String.lowercase a = String.lowercase b
	end

	let result1 = "Pistachio" = "pistachio" (* false *)
	let result2 = Op.("Pistachio" = "pistachio") (* true *)

	(* Same as result2 definition, alternative syntax *)
	let result3 =
	let open Op in
	"Pistachio" = "pistachio"


	(* Asynchronous programming with Lwt *)

	(* Lwt is a regular OCaml library that supports a "cooperative
	threads" model, similar to JavaScript.

	Each computation is called a promise (formerly "thread"), but only
	one promise can run at once. A promise is typically defined as an
	anonymous function that will be called after the result of some
	other promise becomes available, with a possible delay.

	A promise is an opaque object of type `'a Lwt.t`, representing the
	asynchronous computation of a value of type 'a.

	Which promise runs at a given time is determined by a scheduler,
	which is launched by the function `Lwt_main.run`.

	When a promise terminates ("resolves"), it is in either of these
	states: - successful, holding a result - failed, holding an
	exception

	Waiting on the promise is done using the bind operator `(>>=)` which
	is the same function as `Lwt.bind`. *)

	(* Make `(>>=)` available. *)
	open Lwt

	(* Sleep 1.5 seconds, then make the result `()` available. *)
	let wait_for_a_while () =
	Lwt_unix.sleep 1.5

	let () =
	Lwt_main.run (wait_for_a_while ())

	(* `Lwt.return` wraps an OCaml value into a resolved lwt promise *)
	let print_message_after_a_while () =
	wait_for_a_while () >>= (fun () -> print_endline "done"; Lwt.return ())

	(*
	Several promises can wait on a given promise.
	There's no guarantee on the order in which promises 1,2,3 will run.
	Worse, the promises 1 and 2 are ignored, i.e. the main loop
	`Lwt_main.run` won't wait for them. If promise 3 finishes first,
	`1` and `2` won't be printed.
	*)
	let print_messages_after_a_while_v1 () =
	let timer = wait_for_a_while () in
	ignore (timer >>= fun () -> print_endline "1"; Lwt.return ());
	ignore (timer >>= fun () -> print_endline "2"; Lwt.return ());
	timer >>= fun () -> print_endline "3"; Lwt.return ()

	let () =
	print_endline "print_messages_after_a_while_v1";
	Lwt_main.run (print_messages_after_a_while_v1 ())

	(* Better, make sure to wait for the 3 promises.
	Additionally, we print a message when we're done with all 3 promises. *)
	let print_messages_after_a_while_v2 () =
	let timer = wait_for_a_while () in
	let t1 = timer >>= fun () -> print_endline "1"; Lwt.return () in
	let t2 = timer >>= fun () -> print_endline "2"; Lwt.return () in
	let t3 = timer >>= fun () -> print_endline "3"; Lwt.return () in
	Lwt.join [t1; t2; t3] >>= fun () ->
	print_endline "all done";
	Lwt.return ()

	let () =
	print_endline "print_messages_after_a_while_v2";
	Lwt_main.run (print_messages_after_a_while_v2 ())

	(* Exceptions are propagated along bind points. If a promise B waits for its
	input from another promise A but A results in an exception, then
	B resolves to the same exception. *)
	let make_promise_that_fails () =
	Lwt_unix.sleep 0.1 >>= fun () ->
	failwith "Uh oh" (* raises the exception `Failure "Uh oh"` *) >>= fun () ->
	print_endline "This never happens.";
	Lwt.return ()

	let report_error promise_name make_promise =
	Lwt.catch
	(fun () -> make_promise ())
	(fun e ->
	Printf.eprintf "Expected exception in promise %s: %s\n"
	promise_name
	(Printexc.to_string e);
	return ()
	)

	let () =
	let promise = report_error "promise-that-fails" make_promise_that_fails in
	Lwt_main.run promise