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 Posix.Signal | |
37 | open MLton | |
38 | open Itimer Signal Thread | |
39 | ||
40 | val topLevel: Thread.Runnable.t option ref = ref NONE | |
41 | ||
42 | local | |
43 | val threads: Thread.Runnable.t Queue.t = Queue.new () | |
44 | in | |
45 | fun ready (t: Thread.Runnable.t) : unit = | |
46 | Queue.enque(threads, t) | |
47 | fun next () : Thread.Runnable.t = | |
48 | case Queue.deque threads of | |
49 | NONE => valOf (!topLevel) | |
50 | | SOME t => t | |
51 | end | |
52 | ||
53 | fun 'a exit (): 'a = switch (fn _ => next ()) | |
54 | ||
55 | fun new (f: unit -> unit): Thread.Runnable.t = | |
56 | Thread.prepare | |
57 | (Thread.new (fn () => ((f () handle _ => exit ()) | |
58 | ; exit ())), | |
59 | ()) | |
60 | ||
61 | fun schedule t = (ready t; next ()) | |
62 | ||
63 | fun yield (): unit = switch (fn t => schedule (Thread.prepare (t, ()))) | |
64 | ||
65 | val spawn = ready o new | |
66 | ||
67 | fun setItimer t = | |
68 | Itimer.set (Itimer.Real, | |
69 | {value = t, | |
70 | interval = t}) | |
71 | ||
72 | fun run (): unit = | |
73 | (switch (fn t => | |
74 | (topLevel := SOME (Thread.prepare (t, ())) | |
75 | ; new (fn () => (setHandler (alrm, Handler.handler schedule) | |
76 | ; setItimer (Time.fromMilliseconds 20))))) | |
77 | ; setItimer Time.zeroTime | |
78 | ; ignore alrm | |
79 | ; topLevel := NONE) | |
80 | end | |
81 | ||
82 | val rec delay = | |
83 | fn 0 => () | |
84 | | n => delay (n - 1) | |
85 | ||
86 | val rec loop = | |
87 | fn 0 => () | |
88 | | n => (delay 500000; loop (n - 1)) | |
89 | ||
90 | val rec loop' = | |
91 | fn 0 => () | |
92 | | n => (Thread.spawn (fn () => loop n); loop' (n - 1)) | |
93 | ||
94 | val _ = Thread.spawn (fn () => loop' 10) | |
95 | ||
96 | val _ = Thread.run () | |
97 | ||
98 | val _ = print "success\n" |