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