An example of SML#'s MassiveThreads support

qsort.smi

_require "basis.smi"
_require "thread.smi"

qsort.sml

infixr 1 $
infix 1 |>

fun f $ e = f e
fun e |> f = f e
fun printLn s = print s before print "\n"
fun ignore _ = ()
fun repeat n f = let
    val i = ref 0
in
    while !i < n
    do (f (!i); i := !i + 1)
end

structure Thread = Myth.Thread

fun join (f1, f2) = let
    val chan = ref NONE
    val th = Thread.create (fn () => 0 before chan := SOME(f2 ()))
    val r1 = f1 ()
    val _ = Thread.join th
    val r2 = Option.valOf $ !chan
in (r1, r2) end

fun joinSingle (f1, f2) = (f1(), f2())

fun chunks arr size = let
    val len = Array.length arr
    fun loop arr from acc =
        if len <= from
        then List.rev acc
        else loop arr (from + size) (ArraySlice.subslice(arr, from, SOME(Int.min(size, len - from))) :: acc)
in loop (ArraySlice.full arr) 0 [] end

fun printArray arr col = let
    fun printCol arr = ArraySlice.app (print o StringCvt.padLeft #" " 5 o Int.toString) arr
in chunks arr col |> List.app (fn col => (printCol col; print "\n")) end


fun swap arr i j = let
    open ArraySlice
    val ei = sub(arr, i)
    val ej = sub(arr, j)
    val () = update(arr, j, ei)
    val () = update(arr, i, ej)
in () end

fun insertionSortSlice arr = let
    open ArraySlice
    fun insert arr 0 = ()
      | insert arr n = if sub(arr,n) < sub(arr, n -1)
                       then (swap arr n (n - 1); insert arr (n - 1))
                       else ()
in repeat (length arr) (insert arr) end

fun partition arr = let
    open ArraySlice
    val len = length arr
    val pivot = sub(arr, 0)
    (*        front     curr           *)
    (*          |         |            *)
    (* small    v large   v  unknown   *)
    (* |s|s|s|s|p|l|l|l|l|-|-|-|-|-|-| *)
    fun loop front curr =
        if curr = len
        then front
        else if sub(arr, curr) < pivot
        then let in
                 swap arr front curr;
                 swap arr (front + 1) curr;
                 loop (front + 1) (curr + 1)
             end
        else loop front (curr + 1)
    val i = loop 0 1
in (subslice(arr, 0, SOME(i)), subslice(arr, i + 1, NONE)) end

val cutOff = 50
val singleThread = 400

fun qsortSlice arr =
    if ArraySlice.length(arr) <= cutOff
    then insertionSortSlice arr
    else let
        open ArraySlice
        val (l, h) = partition arr
        val join = if length(arr) <= singleThread then joinSingle else join
    in ignore $ join((fn () => qsortSlice l), (fn () => qsortSlice h)) end

fun qsort arr = qsortSlice (ArraySlice.full arr)

fun rng seed = let
    open Word32
    val seed = fromInt seed
    val state = ref seed
    fun next () = let val v = (!state * 0w2017 + 0w2020) mod 0w2027
                  in toInt v before state := v end
in next end

val rand = rng 7
val n = case CommandLine.arguments () of
            [] => 2020
          | arg::_  => Option.valOf $ Int.fromString arg
val arr = Array.tabulate(n, fn i => rand () + 1)
val () = qsort arr