Solution of the Santa Claus problem in Ocaml

build.sh

#!/bin/bash

rm santa_problem &> /dev/null
rm *.cmo &> /dev/null
rm *.cmi &> /dev/null
rm *.mli &> /dev/null

THREAD_PARAMS="-thread unix.cma threads.cma"
OCAML_COMMAND="ocamlc $THREAD_PARAMS"

$OCAML_COMMAND -i semaphore.ml > semaphore.mli

$OCAML_COMMAND -c semaphore.mli
$OCAML_COMMAND -c semaphore.ml

$OCAML_COMMAND semaphore.mli -i santa_problem.ml > santa_problem.mli

$OCAML_COMMAND semaphore.mli -c santa_problem.mli
$OCAML_COMMAND semaphore.mli -c santa_problem.ml

$OCAML_COMMAND -o santa_problem semaphore.cmo santa_problem.cmo

santa_problem.ml

open Semaphore;;

let stdout_sem = new Semaphore.semaphore 1 "stdout_sem";;
let puts s =
  stdout_sem#wait;
  Printf.printf "%s\n" s;
  flush stdout;
  stdout_sem#signal ();;

type santa_counters = { mutable elves : int;
                        mutable reindeer : int;
                        santa_sem : Semaphore.semaphore;
                        reindeer_sem : Semaphore.semaphore;
                        elf_sem : Semaphore.semaphore;
                        elf_mutex : Semaphore.semaphore;
                        mutex : Semaphore.semaphore };;

let new_santa_counters () = { elves = 0;
                              reindeer = 0;
                              santa_sem = new Semaphore.semaphore 0 "santa_sem";
                              reindeer_sem = new Semaphore.semaphore 0 "reindeer_sem";
                              elf_sem = new Semaphore.semaphore 0 "elf_sem";
                              elf_mutex = new Semaphore.semaphore 1 "elf_mutex";
                              mutex = new Semaphore.semaphore 1 "mutex" };;


let prepare_sleigh () = puts "Prepare sleigh";;
let help_elves () = puts "Help Elves";;
let get_hitched () = puts "Get Hitched";;
let get_help () = puts "Get Help";;

let santa_role_func c =
  c.santa_sem#wait;
  c.mutex#wait;

  if c.reindeer = 9 then (
    prepare_sleigh ();
    c.reindeer_sem#signal ~n:9 ();
    c.reindeer <- 0;
   )
  else if c.elves = 3 then (
    help_elves ();
    c.elf_sem#signal ~n:3 ()
   );

  c.mutex#signal ();;


let reindeer_role_func (c, i) =
  Thread.delay 0.5;
  let s = Printf.sprintf "Starting reindeer (%d)" i in
  puts s;
  
  c.mutex#wait;
  c.reindeer <- c.reindeer + 1;
  if c.reindeer = 9 then c.santa_sem#signal ();
  c.mutex#signal ();

  c.reindeer_sem#wait;

  get_hitched ();;


let elves_role_func (c, i) =
  Thread.delay 0.5;
  let s = Printf.sprintf "Starting elf [%d]" i in
  puts s;
  
  c.elf_mutex#wait;
  c.mutex#wait;
  c.elves <- c.elves + 1;
  if c.elves = 3 then
    c.santa_sem#signal ()
  else
    c.elf_mutex#signal ();
  c.mutex#signal ();

  c.elf_sem#wait;
  get_help ();

  c.mutex#wait;
  c.elves <- c.elves - 1;
  if c.elves = 0 then c.elf_mutex#signal ();
  c.mutex#signal ();;


let c = new_santa_counters () in
let santa_loop () =
  puts "Starting Santa loop";
  while true do
    santa_role_func c;
  done
in
let santa_array = [| Thread.create santa_loop () |]
and
reindeer_array = Array.init 9 (fun i -> Thread.create reindeer_role_func (c, i))
and
elf_array = Array.init 20 (fun i -> Thread.create elves_role_func (c, i))
in
Array.iter Thread.join (Array.concat [santa_array; reindeer_array; elf_array]);;

flush_all ()

semaphore.ml

module Semaphore = struct
  class semaphore initial_count initial_name =
    object (self)
      val mutable count = initial_count
      val name = initial_name
      val sync = Mutex.create()
      val cond = Condition.create()
          
      method inc n = count <- count + n
      method dec n = count <- count - n

      method signal ?(n=1) () =
        Mutex.lock sync;
        self#inc n;
        for i = 1 to n do
          Condition.signal cond
        done;
        Mutex.unlock sync

      method wait =
        Mutex.lock sync;
        while count = 0 do
          Condition.wait cond sync
        done;
        self#dec 1;
        Mutex.unlock sync
    end
end;;