/usr/share/doc/mlton/examples/thread2.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 86 87 88 89 90 91 92 93 94 95 96 97 | 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 Posix.Signal
open MLton
open Itimer Signal Thread
val topLevel: Thread.Runnable.t option ref = ref NONE
local
val threads: Thread.Runnable.t Queue.t = Queue.new ()
in
fun ready t = Queue.enque (threads, t)
fun next () =
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 setItimer t =
Itimer.set (Itimer.Real,
{value = t,
interval = t})
fun run (): unit =
(switch (fn t =>
(topLevel := SOME (Thread.prepare (t, ()))
; new (fn () => (setHandler (alrm, Handler.handler schedule)
; setItimer (Time.fromMilliseconds 20)))))
; setItimer Time.zeroTime
; ignore alrm
; topLevel := NONE)
end
val rec delay =
fn 0 => ()
| n => delay (n - 1)
val rec loop =
fn 0 => ()
| n => (delay 500000; loop (n - 1))
val rec loop' =
fn 0 => ()
| n => (Thread.spawn (fn () => loop n); loop' (n - 1))
val _ = Thread.spawn (fn () => loop' 10)
val _ = Thread.run ()
val _ = print "success\n"
|