regression/thread1.sml

   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()