regression/thread2.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 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"