lib/mlton/basic/thread.sml

   1 (* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
   2  *    Jagannathan, and Stephen Weeks.
   3  *
   4  * MLton is released under a BSD-style license.
   5  * See the file MLton-LICENSE for details.
   6  *)
   7
   8 structure Thread: THREAD =
   9 struct
  10
  11 open MLton.Thread
  12
  13 fun generate (f: ('a -> unit) -> unit): unit -> 'a option =
  14    let
  15       val paused: 'a option t option ref = ref NONE
  16       val gen: unit t option ref = ref NONE
  17       fun return (a: 'a option): unit =
  18          switch (fn t' =>
  19                  let
  20                     val _ = gen := SOME t'
  21                     val t = valOf (!paused)
  22                     val _ = paused := NONE
  23                  in
  24                     prepare (t, a)
  25                  end)
  26       val _ =
  27          gen := SOME (new (fn () => (f (return o SOME)
  28                                      ; return NONE)))
  29    in fn () => switch (fn t => (paused := SOME t
  30                                 ; prepare (valOf (!gen), ())))
  31    end
  32
  33 end