src/Pure/ML-Systems/polyml-time-limit.ML
author wenzelm
Sat, 11 Jun 2005 23:17:28 +0200
changeset 16374 f4b7cf8975af
parent 14849 73a0a6e0426a
child 16993 2ec0b8159e8e
permissions -rw-r--r--
some cygwin support;

(*  Title:      Pure/ML-Systems/polyml-time-limit.ML
    ID:         $Id$
    Author:     Tjark Weber
    Copyright   2004

Bounded time execution (similar to SML/NJ's TimeLimit structure) for Poly/ML.
*)

structure TimeLimit : sig
	exception TimeOut
	val timeLimit : Time.time -> ('a -> 'b) -> 'a -> 'b
end = struct

	exception TimeOut

	fun timeLimit t f x =
	let
		datatype ('a, 'b) union =
			INL of 'a | INR of 'b
		val result = Process.channel ()
		fun workerThread () =
			Process.send (result, SOME (INL (f x) handle exn => INR exn))
		val interrupt = Process.console workerThread
		val old_handle = Signal.signal (Posix.Signal.alrm, Signal.SIG_HANDLE
			(fn _ => ((Process.send (result, NONE)) before (interrupt ()))))
	in
		Posix.Process.alarm t;
		case Process.receive result of
		  SOME (INL fx)  => (Posix.Process.alarm Time.zeroTime; Signal.signal (Posix.Signal.alrm, old_handle); fx)
		| SOME (INR exn) => (Posix.Process.alarm Time.zeroTime; Signal.signal (Posix.Signal.alrm, old_handle); raise exn)
		| NONE           => (Signal.signal (Posix.Signal.alrm, old_handle); raise TimeOut)
	end

end;