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/cml/src/IO/clean-io.sml
ViewVC logotype

Annotation of /sml/trunk/src/cml/src/IO/clean-io.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 844 - (view) (download)

1 : monnier 2 (* clean-io.sml
2 :     *
3 :     * COPYRIGHT (c) 1997 Bell Labs, Lucent Technologies.
4 :     * COPYRIGHT (c) 1996 AT&T Research.
5 :     *
6 :     * This module keeps track of open I/O streams, and handles the proper
7 :     * cleaning of them. It is a modified version of the SML/NJ module
8 :     * of the same name (in boot/IO/clean-io.sml). Unlike the SML/NJ version,
9 :     * we only do cleanup at shutdown/exit time (we do not try to support the
10 :     * persistence of CML streams across invocations of RunCML.doit), and only
11 :     * require a single clean-up function (this flushes the standard streams,
12 :     * and closes all others). These operations should only be called while
13 :     * CML is running, since they use synchronization primitives.
14 :     *
15 :     * NOTE: there is currently a problem with removing the cleaners for streams
16 :     * that get dropped by the application, but the system limit on open files
17 :     * will limit this.
18 :     *
19 :     *)
20 :    
21 :     structure CleanIO :> sig
22 :    
23 :     type tag
24 :    
25 :     val osInitHook : (unit -> unit) ref
26 :     (* this function gets invoked as the first action during the IO
27 :     * initialization. It is meant to support any OS specific initialization
28 :     * that might be necessary.
29 :     *)
30 :    
31 :     val stdStrmHook : (unit -> unit) ref
32 :     (* this function is defined in TextIOFn, and is called after the osHook.
33 :     * It is used to rebuild the standard streams.
34 :     *)
35 :    
36 :     val addCleaner : (unit -> unit) -> tag
37 :    
38 :     val rebindCleaner : (tag * (unit -> unit)) -> unit
39 :    
40 :     val removeCleaner : tag -> unit
41 :    
42 : blume 844 (* for linking the master IO cleaner function into the list of cleanup hooks *)
43 :     val ioCleaner : (string * CleanUp.when list * (CleanUp.when -> unit))
44 :    
45 : monnier 2 end = struct
46 :    
47 :     structure SV = SyncVar
48 :    
49 :     type tag = unit ref
50 :    
51 :     type cleaner = {
52 :     tag : tag, (* unique ID for this cleaner *)
53 :     close : unit -> unit (* called AtExit and AtShutdown *)
54 :     }
55 :    
56 :     val osInitHook = ref(fn () => ())
57 :     val stdStrmHook = ref(fn () => ())
58 :    
59 :     val cleaners = SV.mVarInit ([] : cleaner list)
60 :    
61 :     fun addCleaner close = let
62 :     val tag = ref()
63 :     val cleanerRec = {tag = tag, close = close}
64 :     in
65 :     SV.mPut (cleaners, cleanerRec :: SV.mTake cleaners);
66 :     tag
67 :     end
68 :    
69 :     fun getTag ({tag, ...} : cleaner) = tag
70 :    
71 :     fun rebindCleaner (t, close) = let
72 :     fun f [] = raise Fail "rebindCleaner: tag not found"
73 :     | f (x :: r) = let
74 :     val t' = getTag x
75 :     in
76 :     if (t' = t)
77 :     then {tag=t, close=close} :: r
78 :     else x :: f r
79 :     end
80 :     in
81 :     SV.mPut (cleaners, f (SV.mTake cleaners))
82 :     end
83 :    
84 :     fun removeCleaner t = let
85 :     fun f [] = [] (* should we raise an exception here? *)
86 :     | f (x :: r) = if (getTag x = t) then r else x :: f r
87 :     in
88 :     SV.mPut (cleaners, f (SV.mTake cleaners))
89 :     end
90 :    
91 :     fun doClean () = let
92 :     fun doit [] = ()
93 :     | doit ({tag, close}::r) = ((close()) handle _ => (); doit r)
94 :     in
95 :     doit (SV.mGet cleaners)
96 :     end
97 :    
98 :     structure C = CleanUp
99 :    
100 :     fun cleanUp (C.AtShutdown | C.AtExit) = doClean ()
101 :     | cleanUp (C.AtInit | C.AtInitFn) = (
102 :     (!osInitHook)();
103 :     (!stdStrmHook)())
104 :    
105 : blume 844 (* for linking the master IO cleaner function into the list of cleanup hooks *)
106 :     val ioCleaner = ("IO", C.atAll, cleanUp)
107 : monnier 2
108 :     end (* CleanIO *)
109 :    

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