with-timeout.sml

local
   structure Cont = SMLofNJ.Cont
   structure IntervalTimer = SMLofNJ.IntervalTimer
   structure S = Signals
in
   (* `withTimeout t f` calls `f ()` and returns `SOME x` where `x` is the result of the function call.
    * If `f ()` takes longer than `t` to execute, `withTimeout` instead returns `NONE` *)
   fun withTimeout t f =
      let
         val result = ref NONE
         val oldhandler = ref NONE
         fun restore () =
            (IntervalTimer.setIntTimer NONE
             ; S.setHandler (S.sigALRM, Option.valOf (!oldhandler)))
         fun makeHandler k = S.HANDLER (fn _ => (restore (); k))
      in
         Cont.callcc (fn k =>
            (oldhandler := SOME (S.setHandler (S.sigALRM, makeHandler k))
             ; IntervalTimer.setIntTimer (SOME t)
             ; result := SOME (f ())
             ; ignore (restore ())))
             ; !result
      end
      
   val _: Time.time -> (unit -> 'a) -> 'a option = withTimeout
end