Skip to content

Instantly share code, notes, and snippets.

@KeenS

KeenS/qsort.smi

Last active Jan 3, 2020
Embed
What would you like to do?
An example of SML#'s MassiveThreads support
_require "basis.smi"
_require "thread.smi"
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment