lib/cml/tests/ping-pong.sml

   1
   2 structure Main =
   3 struct
   4    open CML
   5
   6    fun pong ch =
   7       let
   8          fun loop () =
   9             let
  10                val () = recv ch
  11             in
  12                loop ()
  13             end
  14          val _ = spawn (fn () => loop ())
  15       in
  16          ()
  17       end
  18
  19    fun ping ch n =
  20       let
  21          fun loop i =
  22             if i > n then RunCML.shutdown OS.Process.success
  23                else let
  24                        val () = send (ch, ())
  25                     in
  26                        loop (i + 1)
  27                     end
  28          val _ = spawn (fn () => loop 0)
  29       in
  30          ()
  31       end
  32
  33    fun doit n =
  34       RunCML.doit
  35       (fn () =>
  36        let
  37           val ch = channel ()
  38           val () = pong ch
  39           val () = ping ch n
  40        in
  41           ()
  42        end,
  43        SOME (Time.fromMilliseconds 10))
  44 end