How to wait for Concurrent ML threads to finish before exiting program?

I am attempting to implement a basic 'stress testing' program in MLton and its Concurrent ML implementation, specifically the Monte Carlo Pi test described here. While I think I have most of what I need figured out, I have a problem in that my program always terminates before the CML threads have finished their work. I know that they are doing something, since I sometimes see them print text to the console that I have directed should be printed, but there seems to be a race condition between them getting started and running, and the program as a whole exiting.

The code where I start CML is:

local
    val iterations : int = 10
    val num_threads : int = 1
    val still_going : bool ref = ref true
in
   val _ = (RunCML.doit ((experiment iterations num_threads still_going), NONE);
            (* while !still_going do (); (* Spin-wait for the CML stuff to finish.  This doesn't work... *) *)
            print "All done!\n")
end

the contents of the experiment function are:

fun experiment (iterations : int) (num_threads : int) (still_going : bool ref) () : unit = let
    val iters_per_thread : int = iterations div num_threads
    val return_ivars = Vector.tabulate (num_threads, (fn _ => SyncVar.iVar()))
    val _ = Vector.map (fn return_ivar => CML.spawn (montecarlopi iters_per_thread return_ivar)) return_ivars
    val return_val = Vector.foldl (fn (elem, acc) => acc + (SyncVar.iGet elem)) 0.0 return_ivars
in
    (TextIO.print ("Result is: " ^ (Real.toString return_val) ^ "\n");
            still_going := false)
end

and finally, the montecarlopi function is:

fun montecarlopi (iterations : int) (return_ivar : real SyncVar.ivar) () = let
    val _ = MLton.Random.srand (valOf (MLton.Random.useed ()))
    fun helper accumulator 0 = accumulator
      | helper accumulator iteration = let
          val x : real = wordToBoundedReal (MLton.Random.rand ())
          val y : real = wordToBoundedReal (MLton.Random.rand ())
          val in_target = (x * x) + (y * y)
          val next_iter = iteration - 1
          val _ = TextIO.print ("next_iter is: " ^ (Int.toString next_iter) ^ ", in_target is: " ^ (Real.toString in_target)  ^ ",x is: " ^ (Real.toString x) ^ ",y is: " ^ (Real.toString y) ^ "\n")
      in
          if in_target < 1.0 then
              helper (accumulator + 1) next_iter
          else
              helper accumulator next_iter
      end
in
    SyncVar.iPut (return_ivar, (4.0 * ((real (helper 0 iterations)) / (real iterations))))
end

(The full (small) program and accompanying .mlb file can be viewed here). I'm reasonably sure that the bits inside the RunCML.doit function call do what they're supposed to, which leads me to think that the issue is probably to do with the outermost part of the program.

As you can see, I tried to spin wait, using a ref cell on a boolean to determine when to stop, but that doesn't seem to work. Nor does trying to spin wait using RunCML.isRunning - although both of those sound like terrible ideas to begin with, really, anyway. Of course, I can't use something like a CML channel or syncvar, since those need to be inside the RunCML.doit segment to be used. Changing the number of threads doesn't make any difference to this problem. Nor was I able to find any other functions that would make the main part go into a non-blocking wait.

How do I get the outer part of my program to wait until the bulk of it, inside the RunCML.doit function call, completes? Or, am I doing something wrong inside that part, which is causing the problem?

Solution

If we look at the the function RunCML.doit, It has type OS.Process.status which can either be success or failure, from which your call to doit is returning failure. There is a CML function shutdown: OS.Process.status -> 'a.

Which could be an explaination for why it's failing, except you don't call shutdown, and parts of your output results never print.

Here is a small example exercising various mechanisms for CML's shutdown, where CML seems to be doing something such as 'graceful' internally. Catching exceptions raised and turning those into failure.

structure Main = struct
  open CML
  structure RunCML = RunCML;
  exception ohno

  fun raises() = raise ohno
  fun succeed() = RunCML.shutdown(OS.Process.success)
  fun fail() = RunCML.shutdown(OS.Process.failure)
  fun graceful f () =
    let val () = f() handle _ => RunCML.shutdown(OS.Process.failure);
     in RunCML.shutdown(OS.Process.success)
    end

  fun print_status status =
      if OS.Process.isSuccess status
         then TextIO.print("success\n")
         else TextIO.print("failure\n")

  fun main() = let
    val _ = TextIO.print(banner ^ "\n");
    val _ = print_status(RunCML.doit(succeed, NONE))
    val _ = print_status(RunCML.doit(fail, NONE))
    val _ = print_status(RunCML.doit(raises, NONE))
    val _ = print_status(RunCML.doit(graceful(raises), NONE))
    val _ = print_status(RunCML.doit(graceful(succeed), NONE))
    in OS.Process.success end
end

So, if CML is exiting strangely, and you aren't calling shutdown yourself, its a good chance there is an exception being raised somewhere, which turned out to be the case.

One way to avoid this silent handling of exceptions might in the future might be adding something like:

  fun noisy f () =
    let val () = f()
    handle e => 
       let val () = TextIO.print ("Exception: " ^ (exnName e)
         ^ " Message: " ^ (exnMessage e) ^ "\n")
        in RunCML.shutdown(OS.Process.failure) end
     in RunCML.shutdown(OS.Process.success)
    end

then calling RunCML.doit(noisy(f), NONE)

P.S. Thank you for including a link to your code, it would have been much harder to understand the problem otherwise.