1(*
2    Title:      Standard Basis Library: ImperativeIO functor
3    Copyright   David C.J. Matthews 2000, 2015, 2020
4
5    This library is free software; you can redistribute it and/or
6    modify it under the terms of the GNU Lesser General Public
7    License version 2.1 as published by the Free Software Foundation.
8    
9    This library is distributed in the hope that it will be useful,
10    but WITHOUT ANY WARRANTY; without even the implied warranty of
11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
12    Lesser General Public License for more details.
13    
14    You should have received a copy of the GNU Lesser General Public
15    License along with this library; if not, write to the Free Software
16    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
17*)
18
19(* This is also used in TextIO.  We need "protect". *)
20functor BasicImperativeIO (
21    structure StreamIO : STREAM_IO
22    structure Vector : MONO_VECTOR
23    structure Array : MONO_ARRAY
24    sharing type StreamIO.elem = Vector.elem = Array.elem
25    sharing type StreamIO.vector = Vector.vector = Array.vector
26) (* No signature on the result *)
27=
28struct
29    open IO
30
31    structure StreamIO = StreamIO
32    type vector = Vector.vector
33    and  elem = StreamIO.elem
34
35    datatype instream = InStream of {
36        (* An imperative input stream is a reference to a lazy functional stream.
37           It is an option ref because we use a volatile ref that is set to NONE
38           if this is exported and re-imported. *)
39        fStream: StreamIO.instream option ref,
40        lock: Thread.Mutex.mutex
41        }
42    and outstream = OutStream of {
43        (* An imperative output stream is a reference to the underlying stream.
44           Unlike instream the underlying stream is also imperative but we need
45           a reference here to allow us to redirect. As with instream
46           this is a volatile ref. *)
47        fStream: StreamIO.outstream option ref
48        }
49    (* We don't need a mutex for outstream assuming := and ! are atomic
50       i.e. '!' returns either the previous value or the current one and
51       not some intermediate value. *)
52
53    (* Use no-overwrite refs for imperative streams.  This is really only needed for
54       stdIn to make sure that when we call PolyML.SaveState.loadState we don't
55       overwrite any unread input by the contents of the buffer when saveState
56       was called. *)
57
58    fun mkInstream (s : StreamIO.instream) : instream =
59    let
60        val r = LibrarySupport.volatileOptionRef ()
61        val () = r := SOME s
62    in
63        InStream{fStream = r, lock = Thread.Mutex.mutex()}
64    end
65        
66    fun protect (InStream{fStream, lock}) f =
67        LibraryIOSupport.protect lock f fStream
68
69    (* Get and set the underlying stream.  We have to interlock
70       setInstream at least. *)
71    fun getInstream s =
72        protect s (
73            fn ref (SOME stream) => stream | _ => raise Io { name = "",  function = "getInstream", cause = ClosedStream }
74        ) 
75    and setInstream(InStream{fStream, lock}, s) =
76        LibraryIOSupport.protect lock (fn fStream => fStream := SOME s) fStream
77
78    (* These are just wrappers for the underlying functional calls. *)
79    fun input s = protect s 
80           (fn fStream as ref(SOME stream) =>
81            let
82                val (v, f') = StreamIO.input stream
83            in
84                fStream := SOME f';
85                v
86            end
87            |   _ => Vector.fromList[])
88
89    (* We don't use StreamIO.input1 here because that never advances over
90       a temporary EOF. *)
91    fun input1 s = protect s
92           (fn fStream as ref(SOME stream) =>
93            let
94                val (s, f') = StreamIO.inputN(stream, 1)
95            in
96                fStream := SOME f';
97                if Vector.length s = 0 then NONE else SOME(Vector.sub(s, 0))
98            end
99            |   _ => NONE)
100
101    fun inputN(InStream{fStream, lock}, n) =
102        LibraryIOSupport.protect lock
103           (fn fStream as ref(SOME stream) =>
104            let
105                val (v, f') = StreamIO.inputN(stream, n)
106            in
107                fStream := SOME f';
108                v
109            end
110            |   _ => Vector.fromList[]) fStream
111
112    fun inputAll s = protect s
113           (fn fStream as ref(SOME stream) =>
114            let
115                val (v, f') = StreamIO.inputAll stream
116            in
117                fStream := SOME f';
118                v
119            end
120            |   _ => Vector.fromList[])
121
122    (* These next functions only query the stream and don't affect the
123       fStream ref so don't really need interlocking.  If two threads
124       call these functions simultaneously the result is non-deterministic
125       anyway. *)
126    fun canInput(InStream{fStream, lock}, n) =
127        LibraryIOSupport.protect lock
128           (fn ref(SOME stream) => StreamIO.canInput(stream, n) | _ => SOME 0) fStream
129
130    and closeIn s =
131        protect s (fn ref(SOME stream) => StreamIO.closeIn stream | _ => ())
132    and endOfStream s =
133        protect s (fn ref(SOME stream) => StreamIO.endOfStream stream | _ => true)
134
135    fun lookahead s = protect s
136        (fn ref(SOME stream) =>
137            (
138                case StreamIO.input1 stream of
139                    NONE => NONE
140                |   SOME(s, _) => SOME s
141            )
142        |   _ => NONE
143        )
144
145    (* These are simply wrappers. *)
146
147    fun mkOutstream (s : StreamIO.outstream) : outstream =
148    let
149        val r = LibrarySupport.volatileOptionRef()
150        val () = r := SOME s
151    in
152        OutStream{fStream = r}
153    end
154
155    fun getOutstream(OutStream{fStream = ref(SOME s)}) = s
156    |   getOutstream _ = raise Io { name = "",  function = "getOutstream", cause = ClosedStream }
157    and setOutstream(OutStream{fStream}, s) = fStream := SOME s
158
159    fun output(out, v) = StreamIO.output(getOutstream out, v)
160    and output1(out, c) = StreamIO.output1(getOutstream out, c)
161    and flushOut out = StreamIO.flushOut(getOutstream out)
162    and closeOut out = StreamIO.closeOut(getOutstream out)
163    and getPosOut out = StreamIO.getPosOut(getOutstream out)
164
165    fun setPosOut(OutStream{fStream}, p) = fStream := SOME(StreamIO.setPosOut p)
166    
167    (* Add pretty printers to hide the internals.  These just use the implementation streams. *)
168    local
169        open PolyML
170        fun prettyIn depth _ (InStream{ fStream = ref(SOME s), ...}) =
171            PolyML.prettyRepresentation(s, depth)
172        |   prettyIn _ _ _ = PolyML.PrettyString("Instream-closed")
173        fun prettyOut depth _ (OutStream { fStream = ref(SOME s), ...}) =
174            PolyML.prettyRepresentation(s, depth)
175        |   prettyOut _ _ _ = PolyML.PrettyString("Outstream-closed")
176    in
177        val () = addPrettyPrinter prettyIn
178        val () = addPrettyPrinter prettyOut
179    end
180end;
181
182(* General exported version with final signature. *)
183functor ImperativeIO (
184    structure StreamIO : STREAM_IO
185    structure Vector : MONO_VECTOR
186    structure Array : MONO_ARRAY
187    sharing type StreamIO.elem = Vector.elem = Array.elem
188    sharing type StreamIO.vector = Vector.vector = Array.vector
189) : IMPERATIVE_IO
190        where type StreamIO.elem = StreamIO.elem
191        where type StreamIO.vector = StreamIO.vector
192        where type StreamIO.instream = StreamIO.instream
193        where type StreamIO.outstream = StreamIO.outstream
194        where type StreamIO.out_pos = StreamIO.out_pos
195        where type StreamIO.reader = StreamIO.reader
196        where type StreamIO.writer = StreamIO.writer
197        where type StreamIO.pos = StreamIO.pos
198        =
199    BasicImperativeIO(structure StreamIO = StreamIO and Vector = Vector and Array = Array);
200
201