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 274 - (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 :    
9 :     signature INTERRUPT = sig
10 :    
11 :     exception Interrupt
12 :    
13 :     (*
14 :     * guarded: thunk -> 'a
15 :     * - run thunk () and return the result
16 :     * - if the thunk gets interrupted then raise Interrupt
17 :     *)
18 :     val guarded: (unit -> 'a) -> 'a
19 :     end
20 :    
21 :     structure Interrupt :> INTERRUPT = struct
22 :    
23 :     exception Interrupt
24 :    
25 :     structure Sig = Signals
26 :    
27 :     val sigINT = Sig.sigINT
28 :     val inqHandler = Sig.inqHandler
29 :     val setHandler = Sig.setHandler
30 :    
31 :     fun guarded thunk = let
32 :     val oh = inqHandler sigINT
33 :     fun reset () = ignore (setHandler (sigINT, oh))
34 :     fun thunk' () = thunk () handle exn => (reset (); raise exn)
35 :     val callcc = SMLofNJ.Cont.callcc
36 :     val throw = SMLofNJ.Cont.throw
37 :     in
38 :     callcc (fn exitK =>
39 :     (callcc (fn intK =>
40 :     (setHandler (sigINT, Sig.HANDLER (fn _ => intK));
41 :     throw exitK (thunk' () before reset ())));
42 :     reset ();
43 :     raise Interrupt))
44 :     end
45 :     end

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