Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /sml/trunk/src/cm/util/interrupt.sml
ViewVC logotype

View of /sml/trunk/src/cm/util/interrupt.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 286 - (download) (annotate)
Fri May 21 07:47:16 1999 UTC (20 years, 10 months ago) by blume
File size: 1030 byte(s)
skeleton type simplified; improved conversion, etc.
(*
 * Turning SMLofNJ signals into exceptions
 *
 *   Copyright (c) 1998 by Lucent Bell Laboratories
 *
 * author: Matthias Blume (blume@cs.princeton.edu)
 *)
signature INTERRUPT = sig

    exception Interrupt

    (*
     * guarded: thunk -> 'a
     *  - run thunk () and return the result
     *  - if the thunk gets interrupted then raise Interrupt
     *)
    val guarded: (unit -> 'a) -> 'a
end

structure Interrupt :> INTERRUPT = struct

    exception Interrupt

    structure Sig = Signals

    val sigINT = Sig.sigINT
    val inqHandler = Sig.inqHandler
    val setHandler = Sig.setHandler

    fun guarded thunk = let
	val oh = inqHandler sigINT
	fun reset () = ignore (setHandler (sigINT, oh))
	fun thunk' () = thunk () handle exn => (reset (); raise exn)
	val callcc = SMLofNJ.Cont.callcc
	val throw = SMLofNJ.Cont.throw
    in
	callcc (fn exitK =>
		(callcc (fn intK =>
			 (setHandler (sigINT, Sig.HANDLER (fn _ => intK));
			  throw exitK (thunk' () before reset ())));
		 reset ();
		 raise Interrupt))
    end
end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0