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/compiler/PervEnv/OS/at-exit.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/PervEnv/OS/at-exit.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 94 - (view) (download)

1 : monnier 16 (* at-exit.sml
2 :     *
3 :     * COPYRIGHT (c) 1997 Bell Labs, Lucent Technologies.
4 :     *
5 :     * The (generic) support for the OS.Process.atExit function.
6 :     *)
7 :    
8 :     structure AtExit : sig
9 :    
10 :     val atExit : (unit -> unit) -> unit
11 :    
12 :     end = struct
13 :    
14 :     structure CU = CleanUp
15 :    
16 :     val hooks = ref ([] : (unit -> unit) list)
17 :    
18 :     (* Note that the semantics of atExit require that calls to exit
19 :     * in an atExit action cause the remaining atExit actions to be
20 :     * performed.
21 :     *)
22 :     fun doAtExit () = (case !hooks
23 :     of [] => ()
24 :     | (f::r) => (hooks := r; f() handle _ => (); doAtExit())
25 :     (* end case *))
26 :    
27 :     fun cleaner CU.AtExit = doAtExit()
28 :     | cleaner CU.AtExportFn = hooks := []
29 :     | cleaner _ = ()
30 :    
31 :     val _ = CU.addCleaner ("OS.Process", [CU.AtExit, CU.AtExportFn], cleaner)
32 :    
33 :     fun atExit hook = hooks := hook :: !hooks
34 :    
35 :     end;
36 :    
37 :     (*
38 :     * $Log: at-exit.sml,v $
39 : monnier 93 * Revision 1.1.1.1 1998/04/08 18:39:56 george
40 :     * Version 110.5
41 : monnier 16 *
42 :     *)
43 :    

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