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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 286 - (view) (download)

1 : blume 272 (*
2 : blume 274 * Turning SMLofNJ signals into exceptions
3 : blume 272 *
4 :     * Copyright (c) 1998 by Lucent Bell Laboratories
5 :     *
6 :     * author: Matthias Blume (blume@cs.princeton.edu)
7 :     *)
8 :     signature INTERRUPT = sig
9 :    
10 :     exception Interrupt
11 :    
12 :     (*
13 :     * guarded: thunk -> 'a
14 :     * - run thunk () and return the result
15 :     * - if the thunk gets interrupted then raise Interrupt
16 :     *)
17 :     val guarded: (unit -> 'a) -> 'a
18 :     end
19 :    
20 :     structure Interrupt :> INTERRUPT = struct
21 :    
22 :     exception Interrupt
23 :    
24 :     structure Sig = Signals
25 :    
26 :     val sigINT = Sig.sigINT
27 :     val inqHandler = Sig.inqHandler
28 :     val setHandler = Sig.setHandler
29 :    
30 :     fun guarded thunk = let
31 :     val oh = inqHandler sigINT
32 :     fun reset () = ignore (setHandler (sigINT, oh))
33 :     fun thunk' () = thunk () handle exn => (reset (); raise exn)
34 :     val callcc = SMLofNJ.Cont.callcc
35 :     val throw = SMLofNJ.Cont.throw
36 :     in
37 :     callcc (fn exitK =>
38 :     (callcc (fn intK =>
39 :     (setHandler (sigINT, Sig.HANDLER (fn _ => intK));
40 :     throw exitK (thunk' () before reset ())));
41 :     reset ();
42 :     raise Interrupt))
43 :     end
44 :     end

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