alms-0.4.9: examples/threads4.alms

(* A semi-bad example with threads. (Possible contract error!)
    We start a thread printing 'x's, and then two threads, each
    of which can kill it:

      1. counts 4 second
      2. waits for user input

    If 2 happens first (press enter), then the program exits
    without error!  But if 1 happens first, then 2 will wait
    for input, and when it tries to kill the printer thread,
    that's a contract violation.
*)

#load "libthread"

let printer : unit -> unit =
  let rec loop (_ : unit) : unit =
    AThread.delay 100000;
    putStr "x";
    flush ();
    loop ()
  in loop

let startStop : unit -> unit -> unit =
  fun _: unit ->
    let id = AThread.fork printer in
    let id = AThread.print id in
      (fun () -> AThread.kill id :> unit -> unit)

let after : int -> (unit -o unit) -> unit =
  fun delay: int ->
    fun stop: (unit -o unit) ->
      AThread.fork (fun () -> AThread.delay delay; stop ());
      ()

let main : unit -> unit =
  fun _: unit ->
    putStrLn "Press <ENTER> to exit.";
    let stop = startStop () in
      after 4000000 stop;
      getLine ();
      stop ()

in main ()