Multicore OCaml in a nutshell

OCaml 5 provides parallelism for otherwise perfectly ordinary OCaml code. The program is divided into domains, each of which executes in a separate OS thread. Domains are allowed to pass values around freely to each other, so a function may at any time be accessing values allocated by other domains—and thus other domains may be accessing those values in parallel.

The great thing about multicore OCaml is that there is total flexibility to structure the program without concern for who may be touching what at any time. The problem of course is that there is total flexibilty to structure the program without concern for who may be touching what at any time. Race conditions may abound, of which data races are especially concerning. OxCaml's data-race freedom extensions retain the ability to run code in parallel and intermix data between parallel domains, yet they add enough guard rails to eliminate data races entirely.

What is a data race?

A data race is a race condition in which two accesses to the same memory location conflict. Specifically, there are four elements of the crime:

1. Code running in parallel, which is to say in two different domains
2. A memory location that may be accessed by both domains simultaneously
3. At least one of the accesses is a write
4. The location isn't atomic

The last condition is a carve-out for specially synchronized memory operations provided by Atomic.t, which we'll cover later on. Any “normal” mutable OCaml data can lead to a data race: references, mutable fields, and arrays are all possible culprits.

So, for example:

type record = { mutable field : int }

let reference : int ref = ref 1
let record : record = { field = 2 }
let arr : int array = [| 3; 4 |]

All three of these values are possible sources of data races, say if the following two functions were run in two different domains:

let fun1 () =
  reference := 2;
  record.field <- 3;
  arr.(0) <- 4;
  print_int arr.(1)

let fun2 () =
  reference := 3; (* Data race: write vs. write *)
  print_int record.field; (* Data race: read vs. write *)
  arr.(0) <- arr.(0) + 1; (* Two data races! *)
  print_int arr.(1) (* This one's okay: read vs. read *)

Why are data races bad?

let calculate_price_of_gold () = ();;
let really_good_price_for_gold = 10.0;;
let buy_lots_of_gold () = ();;

Every race condition is a bug, but data races are especially insidious. Obviously, the outcome is unpredictable, since we don't know which side will “win the race,” but the problems don't end there. Both the compiler and the CPU routinely reorder instructions for performance, and they do so assuming there are no data races. As a consequence, in a program with data races, it's difficult if not impossible to reason about the order in which things happen.

As an example, imagine we have two global variables:

let price_of_gold = ref 0.0
let initialised = ref false

Now consider two pieces of code running in parallel. One is some startup code we'll call domain A:

(* ... *)
price_of_gold := calculate_price_of_gold ();
initialised := true
(* ... *)

The other, domain B, accesses the variables:

(* ... *)
if !initialised then
  if !price_of_gold < really_good_price_for_gold then
    buy_lots_of_gold ()
(* ... *)

What happens? Well, since they're running in parallel, we don't know exactly. There is of course an intuitive way to reason it out: at any given point in time, each domain will be partway done running, we just never know exactly which domain gets to go next. So maybe domain A sets price_of_gold, and then domain B reads initialised and sees that it's false, and then domain A sets initialised to true. Or maybe domain A sets both variables before domain B checks initialised, and then if gold is cheap, domain B heads to the market.

The one thing we want not to happen is for domain B to see that !initialised is true and yet find that price_of_gold is still stuck at its initial value of 0.0, thus causing us to buy_lots_of_gold () no matter the price. Our intuitive method reassures us that this cannot happen: domain A doesn't set initialised to true until it's already done setting price_of_gold to something sensible.

Unfortunately, our intuitive reasoning is wrong: this code very much can end up calling buy_lots_of_gold () despite price_of_gold being high. Since the assignments to price_of_gold and initialised happen in the same domain and neither is a fancy atomic operation, they can be reordered so that initialised is set first, while price_of_gold is still zero, leading domain B to make an expensive mistake.

It turns out our intuition assumes what the literature calls sequential consistency: essentially, the principle that things happen in order they're written, and parallelism just means we're not sure which domain will do its next thing. This principle is so essential that it's hard to imagine reasoning about a multicore program without it. Alas, OCaml 5 doesn't guarantee sequential consistency for this code—because of the data races.

There are two data races, to be specific: each of price_of_gold and initialised is being modified by domain A and read by domain B in parallel. When there is a data race, the OCaml memory model throws up its hands and says “sorry, no sequential consistency.”^bounded-in-space-and-time

The good news is that the inverse is also true: any program without data races is sequentially consistent. Data-race freedom gives us back the power to reason intuitively about our code, no matter how buggy it might get. In our example, that means that once we fix the data races (easy to do with Atomic.t), we know our bug is gone: sequential consistency means that it's impossible for domain B to observe a state where initialised is true and price_of_gold is 0.0.^price-zero

The even better news is that, in code using OxCaml's extensions, the data races in price_of_gold and initialised would never have compiled to begin with. There's a tradeoff, of course: just as OCaml's type safety means having to understand the type system, the system for data-race freedom has a learning curve. This tutorial aims to get you moving with a practical framework that hopes to achieve significant parallel speedups without much fuss. You'll still need to convince the compiler that your code has no data races, but we'll walk through the rules and even some shortcuts for common special cases.

Fork/join parallelism

Any problem that can be neatly subdivided is a good candidate for fork/join parallelism, as provided by the parallel library’s fork_join* functions (XX link to .mli). For example, a very expensive way to add four integers (we promise the other examples are more substantial) would be this:

let add4 (par : Parallel.t) a b c d =
  let a_plus_b, c_plus_d =
    Parallel.fork_join2 par (fun _par -> a + b) (fun _par -> c + d)
  in
  a_plus_b + c_plus_d

The call to Parallel.fork_join2 will schedule the calculations of a + b and c + d as independent tasks, returning both once they're both done, and then add4 finishes by adding the results from the tasks. The par argument parameterizes fork_join2 (and, in turn, add4) by a particular implementation of parallelism. It is also passed to the tasks so that they can spawn sub-tasks.

To run add4, we need to get our hands on a scheduler. Each scheduler is provided by a library and determines the policy by which tasks get doled out and run in domains. For this tutorial, we'll use parallel_scheduler_work_stealing, which implements the popular work-stealing strategy.

# let test_add4 par = add4 par 1 10 100 1000
# let () =
    let module Scheduler = Parallel_scheduler_work_stealing in
    let scheduler = Scheduler.create () in
    let monitor = Parallel.Monitor.create_root () in
    let result = Scheduler.schedule scheduler ~monitor ~f:test_add4 in
    Scheduler.stop scheduler;
    Printf.printf "result: %d\n" result;;
result: 1111
- : unit = ()

This creates a work-stealing scheduler, along with a monitor to manage exceptions. Then it tells the scheduler to run the test_add4 function before shutting down the scheduler. (Naturally, a real program will want to keep the monitor and scheduler around longer!)

You can also use the parallel library's own Parallel.Scheduler.Sequential, which simply runs everything on the primary domain. This is handy for testing or debugging when you want to eliminate nondeterminism. To do so, simply replace Parallel_scheduler_work_stealing with Parallel.Scheduler.Sequential.

Now for something more substantial. Suppose we're working with binary trees, and we want to take an average over all the values in the tree. Here's a basic implementation (note that we've made use of the new labeled tuples (XX: link) feature):

module Tree = struct
  type 'a t =
    | Leaf of 'a
    | Node of 'a t * 'a t
end

let average (tree : float Tree.t) =
  let rec total tree : (total:float * count:int) =
    match tree with
    | Tree.Leaf x -> ~total:x, ~count:1
    | Tree.Node (l, r) ->
      let ~total:total_l, ~count:count_l = total l in
      let ~total:total_r, ~count:count_r = total r in
      ~total:(total_l +. total_r), ~count:(count_l + count_r)
  in
  let ~total, ~count = total tree in
  total /. (count |> Float.of_int)
;;

let test_tree = Tree.Node (Leaf 3.0, Leaf 4.0)

We can use fork_join2 to parallelize average:

let average_par (par : Parallel.t) tree =
  let rec total par tree : total:float * count:int =
    match tree with
    | Tree.Leaf x -> ~total:x, ~count:1
    | Tree.Node (l, r) ->
      let (~total:total_l, ~count:count_l), (~total:total_r, ~count:count_r) =
        Parallel.fork_join2
          par
          (fun par -> total par l)
          (fun par -> total par r)
      in
      ~total:(total_l +. total_r), ~count:(count_l + count_r)
  in
  let ~total, ~count = total par tree in
  total /. (count |> Float.of_int)
;;

Note that we don't have to worry about unbalanced trees: the work-stealing algorithm dynamically adapts whenever tasks are unevenly distributed among cores.

We're not limited to working with simple floats, of course. Suppose we add a module Thing earlier in the file:

module Thing = struct
  module Mood = struct
    type t =
      | Happy
      | Neutral
      | Sad
  end

  type t =
    { price : float
    ; mutable mood : Mood.t
    }

  let create ~price ~mood = { price; mood }
  let price { price; _ } = price
  let mood { mood; _ } = mood
  let cheer_up t = t.mood <- Happy
end

All we have to do to sum over the prices in a Thing.t Tree.t is change the Tree.Leaf case:

  let rec total par tree : total:float * count:int =
    match tree with
-   | Tree.Leaf x -> ~total:x, ~count:1
+   | Tree.Leaf x -> ~total:(Thing.price x), ~count:1
    | Tree.Node (l, r) ->
      let (~total:total_l, ~count:count_l), (~total:total_r, ~count:count_r) =

And of course you'll need a new test tree:

let test_tree =
  Tree.Node
    ( Leaf (Thing.create ~price:3.0 ~mood:Happy)
    , Leaf (Thing.create ~price:4.0 ~mood:Sad) )

So far, so good. But something annoying happens if we introduce an abstraction barrier. Let's introduce a signature for [Thing].

module type THING = sig
  type t

  module Mood : sig
    type t =
      | Happy
      | Neutral
      | Sad
  end

  val create : price:float -> mood:Mood.t -> t
  val price : t -> float
  val mood : t -> Mood.t
  val cheer_up : t -> unit
end
module Thing : THING = struct
  module Mood = struct
    type t =
      | Happy
      | Neutral
      | Sad
  end

  type t =
    { price : float
    ; mutable mood : Mood.t
    }

  let create ~price ~mood = { price; mood }
  let price { price; _ } = price
  let mood { mood; _ } = mood
  let cheer_up t = t.mood <- Happy
end

But now we get an error from the compiler:

The value total is nonportable, so cannot be used inside a function that is
portable.

Why are things breaking just because we moved some code? We can get closer to the answer by insisting that total is portable:

 let average_par (par : Parallel.t) (tree : Thing.t Tree.t) =
-  let rec total par tree =
+  let rec (total @ portable) par tree =
     match tree with

The value Thing.price is nonportable, so cannot be used inside a function that
is portable.

What's going on is that our declaration for price left out crucial information that the compiler was previously able to infer. We can take the compiler's suggestion easily enough by explaining that price is portable:

val price : t -> float @@ portable

But the compiler isn't satisfied. Now it complains about the l in total par l (which is still as it was before):

This value is contended but expected to be uncontended.

Now the solution is much less obvious, but as we'll see, it again comes down to missing information on price:

val price : t @ contended -> float @@ portable

(The precedences here are such that the t argument is contended and the whole function, namely price, is portable.)

Once you're familiar with the portable and contended modes, you'll see that this can be read as saying:

Why should we believe this is true? Well, remember, price is simply

let price { price; _ } = price

It does nothing but project an immutable field out of a record. And as we covered in defining a data race, rule 3 is that in order for two accesses to produce a data race, one of them must be a write—and an immutable field can't be modified[^write-on-initialization]. Hence price can't produce a data race no matter what is happening in parallel. The situation changes if we make price mutable:

   type t =
-    { price : float
+    { mutable price : float
     ; mutable mood : Mood.t
     }

Values do not match:
  val price : t -> float @@ portable
is not included in
  val price : t @ contended -> float @@ portable

The type that the compiler now wants to give price says essentially “this is only safe to call if no other domain can access the argument.” But Parallel.fork_join2 can't make that promise, since it's scheduling tasks in parallel. (If this all seems vague at the moment, we'll make it systematic when we detail how portable and contended work.)

Giving price the right type is enough to let average_par go through: from there, the compiler infers that our calls to Parallel.fork_join2 won't produce data races, and in turn that average_par is again data-race free.

If you modify our test code to run average_par on the new test_tree, you'll find yourself needing to make one more change to thing.mli:

val create : price:float -> mood:Mood.t -> t @ portable @@ portable

This says somewhat tediously that create both returns something portable and is itself portable. Fortunately, we'll see in the section on niceties that both of these can be made implicit.

Adding portable and contended to your .mli files can take some work, but over the next few sections we'll cover what exactly the modes mean, what the most important rules for using them are, and some workarounds and shortcuts. In return, these two modes suffice to run even large amounts of code in fork/join style without fear of data races.

type t = {
  price : float;
  mutable mood : Mood.t
}

let price (t @ contended) = t.price (* ok: [price] is immutable *)
let cheer_up (t @ contended) = t.mood <- Happy (* error! *)

Error: This value is contended but expected to be uncontended.

let bum_out t = t.mood <- Sad (* cue ominous music: a data race lurks! *)

let cheer_up (t @ uncontended) = t.mood <- Happy (* ok: [t] is [uncontended] *)

let mood (t @ contended) = t.mood (* error! *)

Error: This value is contended but expected to be shared or uncontended.

val cheer_up : t -> unit @@ portable
val bum_out : t -> unit @@ portable

let beat_the_system par =
  let t = { price = 42.0; mood = Neutral } in
  let (), () =
    Parallel.fork_join2 par (fun _par -> cheer_up t) (fun _par -> bum_out t)
  in
  ()

Error: This value is contended but expected to be uncontended.

let price_and_mood (t @ uncontended) = price t, mood t

type t_in_a_trenchcoat = {
  inner_t : t;
}

let cheer_up_sneakily (t_in_a_trenchcoat @ contended) =
  let t @ uncontended = t_in_a_trenchcoat.inner_t (* error: rule 4 *) in
  cheer_up t (* cue the ominous music again *)

let price t = t.price

val price : t @ contended -> float @@ portable

let beat_the_system par =
  let t @ uncontended = { price = 42.0; mood = Neutral }
  cheer_up t; (* line A *)
  let (), () =
    Parallel.fork_join2 par
      (fun _par -> cheer_up t) (* line B *)
      (fun _par -> bum_out t) (* line C *)
  in
  ()

let (factorial @ portable) i =
  let a @ uncontended = ref 1 in
  let rec (loop @ nonportable) i =
    if i > 1 then (a := !a * i; loop (i - 1))
  in
  loop i;
  !a

This value is contended but expected to be uncontended.

let (factorial' @ portable) i =
  let a @ uncontended = ref 1 in
  let rec (loop' @ portable) (a @ uncontended) i =
    if i > 1 then (a := !a * i; loop' a (i - 1))
  in
  loop' a i;
  !a

val loop : int -> unit
val loop' : int ref @ uncontended -> int -> unit @@ portable

Niceties

As with most systems, data-race freedom involves a tradeoff between safety and convenience. Fortunately there are powerful ways to keep things convenient in common cases.

type t

module Mood : sig
  type t =
    | Happy
    | Neutral
    | Sad
end

val create : price:float -> mood:Mood.t -> t @ portable @@ portable
val price : t @ contended -> float @@ portable
val mood : t -> Mood.t @@ portable
val cheer_up : t -> unit @@ portable
val bum_out : t -> unit @@ portable
val do_something_involving_shared_state : unit -> unit

@@ portable

type t

module Mood : sig
  type t =
    | Happy
    | Neutral
    | Sad
end

val create : price:float -> mood:Mood.t -> t @ portable
val price : t @ contended -> float
val mood : t -> Mood.t
val cheer_up : t -> unit
val bum_out : t -> unit
val do_something_involving_shared_state : unit -> unit @@ nonportable

type float_and_int : immutable_data = float * int

let always_portable : int_or_string @ nonportable -> int_or_string @ portable =
 fun a ->
  let a' @ portable = a in (* ok because [int_or_string] crosses portability *)
  a'

type t =
  { price : float
  ; mutable mood : Mood.t
  }

-type t
+type t : mutable_data

-val create : price:float -> mood:Mood.t -> t @ portable
+val create : price:float -> mood:Mood.t -> t

let always_portable' : ('a : mutable_data) @ nonportable -> 'a @ portable =
 fun a ->
  let a' @ portable = a in
  a'

module Thing = struct
  module Mood = struct
    type t =
      | Happy
      | Neutral
      | Sad
  end

  type t : immutable_data =
    { price : float
    ; mood : Mood.t Atomic.t
    }

  let create ~price ~mood = { price; mood = Atomic.make mood }
  let price { price; _ } = price
  let mood { mood; _ } = Atomic.get mood
  let cheer_up { mood; _ } = Atomic.set mood Happy
  let bum_out { mood; _ } = Atomic.set mood Sad
end

let average_par_running (par : Parallel.t) tree =
  let total = Atomic.make 0.0 in
  let count = Atomic.make 0 in
  let rec go par tree =
    match tree with
    | Tree.Leaf x ->
      Atomic.update total ~pure_f:(fun total -> total +. Thing.price x);
      Atomic.incr count
    | Tree.Node (l, r) ->
      let (), () =
        Parallel.fork_join2 par (fun par -> go par l) (fun par -> go par r)
      in
      ()
  in
  go par tree;
  Atomic.get total /. (Atomic.get count |> Float.of_int)

Parallel sequences

Our very first example added exactly four integers, and generally we've been assuming that our data is in a shape that makes it obvious how to parallelize (or at least makes one strategy obvious). But of course real data isn't so convenient:

let add_many (arr : int iarray) =
  Iarray.fold arr ~init:0 ~f:(fun a b -> a + b)

(We'll be using immutable arrays a lot, since mutable arrays are miserable for parallelism. A mutable array is essentially nothing but a series of mutable fields, requiring uncontended access to do almost anything.)

Parallelizing this directly is possible but fussy even in this simple case. The Parallel.Sequence module makes it nearly trivial:

let add_many_par par arr =
  let seq = Parallel.Sequence.of_iarray arr in
  Parallel.Sequence.reduce par seq ~f:(fun a b -> a + b)
  |> Option.value ~default:0

We first need to convert from iarray to Parallel.Sequence.t (XX link to documentation), a general sequence type supporting a rich selection of parallel operations. Among them is a parallel reduce, which operates much like an unordered fold.

Just like Parallel.fork_join2, we can use parallel sequences in a nested manner. Suppose that rather than a binary tree we have an n-ary tree:

module Tree = struct
  type 'a t =
    | Leaf of 'a
    | Nodes of 'a t iarray
end

The sequential code isn't much different from before:

let average tree =
  let rec total tree =
    match tree with
    | Tree.Leaf x -> ~total:(Thing.price x), ~count:1
    | Tree.Nodes arr ->
      let totals_and_counts =
        Iarray.map arr ~f:(fun subtree -> total subtree)
      in
      Iarray.fold
        totals_and_counts
        ~init:(~total:0.0, ~count:0)
        ~f:(fun (~total:total_acc, ~count:count_acc) (~total, ~count) ->
          ~total:(total +. total_acc), ~count:(count + count_acc))
  in
  let ~total, ~count = total tree in
  total /. (count |> Float.of_int)
;;

Naturally, we now use Iarray.map to recurse on subnodes and Iarray.fold to combine the results. To parallelize, we still need the Parallel.Sequence.of_iarray, but now Parallel.Sequence.fold' combines the map and reduce operations:

let average_par (par : Parallel.t) tree =
  let rec (total @ portable) par tree =
    match tree with
    | Tree.Leaf x -> ~total:(Thing.price x), ~count:1
    | Tree.Node arr ->
      let seq = Parallel.Sequence.of_iarray arr in
      Parallel.Sequence.fold'
        par
        seq
        ~f:(fun par subtree -> total par subtree)
        ~init:(~total:0.0, ~count:0)
        ~combine:(fun _par (~total, ~count) (~total:total2, ~count:count2) ->
          ~total:(total +. total2), ~count:(count + count2))
      [@nontail]
  in
  let ~total, ~count = total par tree in
  total /. (count |> Float.of_int)

(We use fold' rather than fold to get the version that passes par down into our f and combine functions.)

Another approach would be to convert the entire tree into a Parallel.Sequence.t at once rather than rely on nested parallelism. This is possible using Parallel.Sequence.unfold, though it does take more work, requiring a definition of an unfolding state with an operation that splits it in half.