Async In_thread in action.

_oasis

OASISFormat: 0.3
Name:        frenetic
Version:     1.0.2
Synopsis:    The Frenetic Compiler and Runtime System
License:     LGPL
Plugins:     META (0.3), DevFiles (0.3)
Authors:     Arjun Guha
BuildTools:
  ocamlbuild,
  ocamldoc


Executable demo
  Path: tool
  MainIs: Main.ml
  Install: False
  BuildDepends:
    core,
    async,
    threads

Main.ml

open Core.Std
open Async.Std

let rec interval_rec acc min max =
  if min > max then acc else interval_rec (min :: acc) (succ min) max

let interval min max = List.rev (interval_rec [] min max)

let remove_multiples_of n lst =
  List.filter lst (fun m -> m mod n <> 0)

(** Sieve of Eratosthenes, based on code found by Googling. Modified to use
    tail-calls. For large N, this is a time-consuming computation, just as the
    Frenetic compiler takes several seconds to compile Marco's policies. *)
let sieve max =
  let rec filter_again acc = function
  | [] -> acc
  | n :: r as l ->
      if n * n > max then l else filter_again (n :: acc) (remove_multiples_of n r)
  in
    filter_again [] (interval 2 max)

(** If we just invoke [sieve], we'll block the main OCaml thread. But, this
    computation runs it in a different thread. *)
let primes_less_than (n: int): int list Deferred.t =
  In_thread.run (fun () -> sieve n)
  >>= fun factors ->
  printf "%d primes less than %d\n%!" (List.length factors) n;
  return factors

(** [countdown n] sleep for a second and then wakes up to print. This is like
    the thead that responds to ECHO_REQUESTs from a thread. A long running
    computation, such as the Frenetic compiler, needs to not block it. *)
let rec countdown (n: int): unit Deferred.t = 
  printf "countdown %d\n%!" n;
  after (sec 1.) 
  >>= fun () ->
  if n = 0 then return () else countdown (n - 1)

(** Since the sieve runs in its own thread, we have concurrency. *) 
let main () =
  Deferred.both (countdown 10) (primes_less_than 2_000_000)

let _ = 
  main ();
  never_returns (Scheduler.go ())

Output

$ make && ./Main.byte 
ocaml setup.ml -build 
Finished, 0 targets (0 cached) in 00:00:00.
+ ocamlfind ocamlc -c -g -package threads -package core -package async -thread -I tool -o tool/Main.cmo tool/Main.ml
File "tool/Main.ml", line 43, characters 2-9:
Warning 10: this expression should have type unit.
Finished, 3 targets (0 cached) in 00:00:01.
countdown 10
countdown 9
countdown 8
countdown 7
countdown 6
countdown 5
countdown 4
148710 primes less than 2000000
countdown 3
countdown 2
countdown 1
countdown 0
^C