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 = Queue.enque (threads, t) | |
46 | fun next () = | |
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 setItimer t = | |
67 | Itimer.set (Itimer.Real, | |
68 | {value = t, | |
69 | interval = t}) | |
70 | ||
71 | fun run (): unit = | |
72 | (switch (fn t => | |
73 | (topLevel := SOME (Thread.prepare (t, ())) | |
74 | ; new (fn () => (setHandler (alrm, Handler.handler schedule) | |
75 | ; setItimer (Time.fromMilliseconds 20))))) | |
76 | ; setItimer Time.zeroTime | |
77 | ; ignore alrm | |
78 | ; topLevel := NONE) | |
79 | end | |
80 | ||
81 | val rec delay = | |
82 | fn 0 => () | |
83 | | n => delay (n - 1) | |
84 | ||
85 | val rec loop = | |
86 | fn 0 => () | |
87 | | n => (delay 500000; loop (n - 1)) | |
88 | ||
89 | val rec loop' = | |
90 | fn 0 => () | |
91 | | n => (Thread.spawn (fn () => loop n); loop' (n - 1)) | |
92 | ||
93 | val _ = Thread.spawn (fn () => loop' 10) | |
94 | ||
95 | val _ = Thread.run () | |
96 | ||
97 | val _ = print "success\n" |