<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="UTF-8">
<meta http-equiv="X-UA-Compatible" content="IE=edge">
<meta name="viewport" content="width=device-width, initial-scale=1.0">
<meta name="generator" content="Asciidoctor 2.0.20">
<title>MLtonThread</title>
<link rel="stylesheet" href="https://fonts.googleapis.com/css?family=Open+Sans:300,300italic,400,400italic,600,600italic%7CNoto+Serif:400,400italic,700,700italic%7CDroid+Sans+Mono:400,700">
<link rel="stylesheet" href="./asciidoctor.css">
<link rel="stylesheet" href="./mlton.css">

</head>
<body class="article">
<div id="mlton-header">
<div id="mlton-header-text">
<h2>
<a href="./Home">
MLton
20241230+git20251029+dfsg-ok1
</a>
</h2>
</div>
</div>
<div id="header">
<h1>MLtonThread</h1>
</div>
<div id="content">
<div id="preamble">
<div class="sectionbody">
<div class="listingblock">
<div class="content">
<pre class="rouge highlight"><code data-lang="sml">signature MLTON_THREAD =
   sig
      structure AtomicState:
         sig
            datatype t = NonAtomic | Atomic of int
         end

      val atomically: (unit -&gt; 'a) -&gt; 'a
      val atomicBegin: unit -&gt; unit
      val atomicEnd: unit -&gt; unit
      val atomicState: unit -&gt; AtomicState.t

      structure Runnable:
         sig
            type t
         end

      type 'a t

      val atomicSwitch: ('a t -&gt; Runnable.t) -&gt; 'a
      val new: ('a -&gt; unit) -&gt; 'a t
      val prepend: 'a t * ('b -&gt; 'a) -&gt; 'b t
      val prepare: 'a t * 'a -&gt; Runnable.t
      val switch: ('a t -&gt; Runnable.t) -&gt; 'a
   end</code></pre>
</div>
</div>
<div class="paragraph">
<p><code>MLton.Thread</code> provides access to MLton&#8217;s user-level thread
implementation (i.e. not OS-level threads).  Threads are lightweight
data structures that represent a paused computation.  Runnable threads
are threads that will begin or continue computing when <code>switch</code>-ed to.
<code>MLton.Thread</code> does not include a default scheduling mechanism, but it
can be used to implement both preemptive and non-preemptive threads.</p>
</div>
<div class="ulist">
<ul>
<li>
<p><code>type AtomicState.t</code></p>
<div class="paragraph">
<p>the type of atomic states.</p>
</div>
</li>
<li>
<p><code>atomically f</code></p>
<div class="paragraph">
<p>runs <code>f</code> in a critical section.</p>
</div>
</li>
<li>
<p><code>atomicBegin ()</code></p>
<div class="paragraph">
<p>begins a critical section.</p>
</div>
</li>
<li>
<p><code>atomicEnd ()</code></p>
<div class="paragraph">
<p>ends a critical section.</p>
</div>
</li>
<li>
<p><code>atomicState ()</code></p>
<div class="paragraph">
<p>returns the current atomic state.</p>
</div>
</li>
<li>
<p><code>type Runnable.t</code></p>
<div class="paragraph">
<p>the type of threads that can be resumed.</p>
</div>
</li>
<li>
<p><code>type 'a t</code></p>
<div class="paragraph">
<p>the type of threads that expect a value of type <code>'a</code>.</p>
</div>
</li>
<li>
<p><code>atomicSwitch f</code></p>
<div class="paragraph">
<p>like <code>switch</code>, but assumes an atomic calling context.  Upon
<code>switch</code>-ing back to the current thread, an implicit <code>atomicEnd</code> is
performed.</p>
</div>
</li>
<li>
<p><code>new f</code></p>
<div class="paragraph">
<p>creates a new thread that, when run, applies <code>f</code> to the value given to
the thread.  <code>f</code> must terminate by `switch`ing to another thread or
exiting the process.</p>
</div>
</li>
<li>
<p><code>prepend (t, f)</code></p>
<div class="paragraph">
<p>creates a new thread (destroying <code>t</code> in the process) that first
applies <code>f</code> to the value given to the thread and then continues with
<code>t</code>.  This is a constant time operation.</p>
</div>
</li>
<li>
<p><code>prepare (t, v)</code></p>
<div class="paragraph">
<p>prepares a new runnable thread (destroying <code>t</code> in the process) that
will evaluate <code>t</code> on <code>v</code>.</p>
</div>
</li>
<li>
<p><code>switch f</code></p>
<div class="paragraph">
<p>applies <code>f</code> to the current thread to get <code>rt</code>, and then start running
thread <code>rt</code>.  It is an error for <code>f</code> to perform another <code>switch</code>.  <code>f</code>
is guaranteed to run atomically.</p>
</div>
</li>
</ul>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_example_of_non_preemptive_threads">Example of non-preemptive threads</h2>
<div class="sectionbody">
<div class="listingblock">
<div class="content">
<pre class="rouge highlight"><code data-lang="sml">structure Queue:
   sig
      type 'a t

      val new: unit -&gt; 'a t
      val enque: 'a t * 'a -&gt; unit
      val deque: 'a t -&gt; '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
            [] =&gt; (case !back of
                      [] =&gt; NONE
                    | l =&gt; let val l = rev l
                           in case l of
                              [] =&gt; raise Fail "deque"
                            | x :: l =&gt; (back := []; front := l; SOME x)
                           end)
          | x :: l =&gt; (front := l; SOME x) 
   end

structure Thread:
   sig
      val exit: unit -&gt; 'a
      val run: unit -&gt; unit
      val spawn: (unit -&gt; unit) -&gt; unit
      val yield: unit -&gt; unit
   end =
   struct
      open MLton
      open Thread

      val topLevel: Thread.Runnable.t option ref = ref NONE

      local
         val threads: Thread.Runnable.t Queue.t = Queue.new ()
      in
         fun ready (t: Thread.Runnable.t) : unit =
            Queue.enque(threads, t)
         fun next () : Thread.Runnable.t =
            case Queue.deque threads of
               NONE =&gt; valOf (!topLevel)
             | SOME t =&gt; t
      end

      fun 'a exit (): 'a = switch (fn _ =&gt; next ())

      fun new (f: unit -&gt; unit): Thread.Runnable.t =
         Thread.prepare
         (Thread.new (fn () =&gt; ((f () handle _ =&gt; exit ())
                                ; exit ())),
          ())

      fun schedule t = (ready t; next ())

      fun yield (): unit = switch (fn t =&gt; schedule (Thread.prepare (t, ())))

      val spawn = ready o new

      fun run(): unit =
         (switch (fn t =&gt;
                  (topLevel := SOME (Thread.prepare (t, ()))
                   ; next()))
          ; topLevel := NONE)
   end

val rec loop =
   fn 0 =&gt; ()
    | n =&gt; (print(concat[Int.toString n, "\n"])
            ; Thread.yield()
            ; loop(n - 1))

val rec loop' =
   fn 0 =&gt; ()
    | n =&gt; (Thread.spawn (fn () =&gt; loop n); loop' (n - 2))

val _ = Thread.spawn (fn () =&gt; loop' 10)

val _ = Thread.run ()

val _ = print "success\n"</code></pre>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_example_of_preemptive_threads">Example of preemptive threads</h2>
<div class="sectionbody">
<div class="listingblock">
<div class="content">
<pre class="rouge highlight"><code data-lang="sml">structure Queue:
   sig
      type 'a t

      val new: unit -&gt; 'a t
      val enque: 'a t * 'a -&gt; unit
      val deque: 'a t -&gt; '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
            [] =&gt; (case !back of
                      [] =&gt; NONE
                    | l =&gt; let val l = rev l
                           in case l of
                              [] =&gt; raise Fail "deque"
                            | x :: l =&gt; (back := []; front := l; SOME x)
                           end)
          | x :: l =&gt; (front := l; SOME x)
   end

structure Thread:
   sig
      val exit: unit -&gt; 'a
      val run: unit -&gt; unit
      val spawn: (unit -&gt; unit) -&gt; unit
      val yield: unit -&gt; 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: Thread.Runnable.t) : unit =
            Queue.enque(threads, t)
         fun next () : Thread.Runnable.t =
            case Queue.deque threads of
               NONE =&gt; valOf (!topLevel)
             | SOME t =&gt; t
      end

      fun 'a exit (): 'a = switch (fn _ =&gt; next ())

      fun new (f: unit -&gt; unit): Thread.Runnable.t =
         Thread.prepare
         (Thread.new (fn () =&gt; ((f () handle _ =&gt; exit ())
                                ; exit ())),
          ())

      fun schedule t = (ready t; next ())

      fun yield (): unit = switch (fn t =&gt; 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 =&gt;
                  (topLevel := SOME (Thread.prepare (t, ()))
                   ; new (fn () =&gt; (setHandler (alrm, Handler.handler schedule)
                                    ; setItimer (Time.fromMilliseconds 20)))))
          ; setItimer Time.zeroTime
          ; ignore alrm
          ; topLevel := NONE)
   end

val rec delay =
   fn 0 =&gt; ()
    | n =&gt; delay (n - 1)

val rec loop =
   fn 0 =&gt; ()
    | n =&gt; (delay 500000; loop (n - 1))

val rec loop' =
   fn 0 =&gt; ()
    | n =&gt; (Thread.spawn (fn () =&gt; loop n); loop' (n - 1))

val _ = Thread.spawn (fn () =&gt; loop' 10)

val _ = Thread.run ()

val _ = print "success\n"</code></pre>
</div>
</div>
</div>
</div>
</div>
</body>
</html>