1 (* Copyright (C
) 1999-2006 Henry Cejtin
, Matthew Fluet
, Suresh
2 * Jagannathan
, and Stephen Weeks
.
4 * MLton is released under a BSD
-style license
.
5 * See the file MLton
-LICENSE for details
.
8 structure Engine
: ENGINE
=
11 datatype 'a t
= T
of {return
: 'a res Thread
.t option ref
,
12 thread
: Thread
.Runnable
.t
}
18 val which
= Itimer
.Real
19 val signal
= Itimer
.signal which
21 fun done (return
): unit
=
23 ; Itimer
.set (which
, {value
= Time
.zero
,
24 interval
= Time
.zero
})
25 ; Signal
.setHandler (signal
, Signal
.Handler
.default
))
27 fun new (f
: unit
-> 'a
): 'a t
=
34 val res
= Done (f ()) handle e
=> Raise e
35 val ret
= valOf (!return
)
38 Thread
.switch (fn _
=> Thread
.prepare (ret
, res
))
40 val thread
= Thread
.prepare (thread
, ())
42 T
{return
= return
, thread
= thread
}
45 fun run (T
{return
, thread
}, time
: Time
.t
): 'a res
=
47 (fn cur
: 'a res Thread
.t
=>
49 val _
= return
:= SOME cur
50 fun handler (me
: Thread
.Runnable
.t
): Thread
.Runnable
.t
=
52 (Thread
.prepend (cur
, fn () => (done return
53 ; TimeOut (T
{return
= return
,
56 val _
= Signal
.setHandler (signal
, Signal
.Handler
.handler handler
)
57 val _
= Itimer
.set (which
, {value
= time
,
58 interval
= Time
.zero
})
63 fun timeLimit (t
: Time
.t
, f
: unit
-> 'a
): 'a option
=
64 case run (new f
, t
) of
69 fun repeat
{thunk
, limit
, tries
} =
74 else (case timeLimit (limit
, thunk
) of