regression/signals2.sml

   1 signature CRITICAL =
   2    sig
   3       val atomicBegin : unit -> unit
   4       val atomicEnd : unit -> unit
   5       val doAtomic : (unit -> unit) -> unit
   6    end
   7 structure Critical : CRITICAL =
   8    struct
   9       structure Thread = MLton.Thread
  10
  11       val atomicBegin = Thread.atomicBegin
  12       val atomicEnd = Thread.atomicEnd
  13       fun doAtomic f = (atomicBegin (); f (); atomicEnd ())
  14    end
  15
  16 structure Main =
  17    struct
  18       structure Signal = MLton.Signal
  19       structure Itimer = MLton.Itimer
  20
  21       val alrmHandler = fn t => t
  22       fun setItimer t =
  23          Itimer.set (Itimer.Real,
  24                      {value = t,
  25                       interval = t})
  26       fun setAlrmHandler h =
  27          Signal.setHandler (Itimer.signal Itimer.Real, h)
  28
  29       fun print s =
  30          Critical.doAtomic (fn () => TextIO.print s)
  31
  32       fun doit n =
  33          let
  34             val () = setAlrmHandler (Signal.Handler.handler alrmHandler)
  35             val () = setItimer (Time.fromMilliseconds 10)
  36
  37             fun loop i =
  38                if i > n
  39                   then OS.Process.exit OS.Process.success
  40                   else let
  41                           val i' = (Int.toString i) ^ "\n"
  42                           fun loop' j =
  43                              if j > i then ()
  44                              else (print i'
  45                                    ; loop' (j + 1))
  46                        in
  47                           loop' 0
  48                           ; loop (i + 1)
  49                        end
  50          in
  51             loop 0
  52          end
  53    end
  54
  55 val _ = Main.doit 500