/usr/share/doc/mlton/examples/thread1.sml is in mlton-doc 20100608-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 | structure Queue:
sig
type 'a t
val new: unit -> 'a t
val enque: 'a t * 'a -> unit
val deque: 'a t -> 'a option
end =
struct
datatype 'a t = T of {front: 'a list ref, back: 'a list ref}
fun new() = T{front = ref [], back = ref []}
fun enque(T{back, ...}, x) = back := x :: !back
fun deque(T{front, back}) =
case !front of
[] => (case !back of
[] => NONE
| l => let val l = rev l
in case l of
[] => raise Fail "deque"
| x :: l => (back := []; front := l; SOME x)
end)
| x :: l => (front := l; SOME x)
end
structure Thread:
sig
val exit: unit -> 'a
val run: unit -> unit
val spawn: (unit -> unit) -> unit
val yield: unit -> unit
end =
struct
open MLton
open Thread
val topLevel: Thread.Runnable.t option ref = ref NONE
local
val threads: Thread.Runnable.t Queue.t = Queue.new()
in
fun ready (t: Thread.Runnable.t) : unit =
Queue.enque(threads, t)
fun next () : Thread.Runnable.t =
case Queue.deque threads of
NONE => valOf(!topLevel)
| SOME t => t
end
fun 'a exit(): 'a = switch(fn _ => next())
fun new(f: unit -> unit): Thread.Runnable.t =
Thread.prepare
(Thread.new (fn () => ((f() handle _ => exit())
; exit())),
())
fun schedule t = (ready t; next())
fun yield(): unit = switch(fn t => schedule (Thread.prepare (t, ())))
val spawn = ready o new
fun run(): unit =
(switch(fn t =>
(topLevel := SOME (Thread.prepare (t, ()))
; next()))
; topLevel := NONE)
end
val rec loop =
fn 0 => ()
| n => (print(concat[Int.toString n, "\n"])
; Thread.yield()
; loop(n - 1))
val rec loop' =
fn 0 => ()
| n => (Thread.spawn(fn () => loop n); loop'(n - 2))
val _ = Thread.spawn(fn () => loop' 10)
val _ = Thread.run()
|