1(*
2    Title:      Standard Basis Library: ImperativeIO functor
3    Copyright   David C.J. Matthews 2000, 2015
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
30    structure StreamIO = StreamIO
31    type vector = Vector.vector
32    and  elem = StreamIO.elem
33
34    datatype instream = InStream of {
35        (* An imperative input stream is a reference to a lazy functional stream. *)
36        fStream: StreamIO.instream ref,
37        lock: Thread.Mutex.mutex
38        }
39    and outstream = OutStream of {
40        (* An imperative output stream is a reference to the underlying stream.
41           Unlike instream the underlying stream is also imperative but we need
42           a reference here to allow us to redirect. *)
43        fStream: StreamIO.outstream ref
44        }
45    (* We don't need a mutex for outstream assuming := and ! are atomic
46       i.e. '!' returns either the previous value or the current one and
47       not some intermediate value. *)
48
49    (* Use no-overwrite refs for imperative streams.  This is really only needed for
50       stdIn to make sure that when we call PolyML.SaveState.loadState we don't
51       overwrite any unread input by the contents of the buffer when saveState
52       was called. *)
53
54    fun mkInstream (s : StreamIO.instream) : instream =
55        InStream{fStream = LibrarySupport.noOverwriteRef s, lock = Thread.Mutex.mutex()}
56        
57    fun protect (InStream{fStream, lock}) f =
58        LibraryIOSupport.protect lock f fStream
59
60    (* Get and set the underlying stream.  We have to interlock
61       setInstream at least. *)
62    fun getInstream s = protect s (fn fStream => !fStream) 
63    and setInstream(InStream{fStream, lock}, s) =
64        LibraryIOSupport.protect lock (fn fStream => fStream := s) fStream
65
66    (* These are just wrappers for the underlying functional calls. *)
67    fun input s = protect s 
68           (fn fStream =>
69            let
70                val (v, f') = StreamIO.input(!fStream)
71            in
72                fStream := f';
73                v
74            end)
75
76    (* We don't use StreamIO.input1 here because that never advances over
77       a temporary EOF. *)
78    fun input1 s = protect s
79           (fn fStream =>
80            let
81                val (s, f') = StreamIO.inputN(!fStream, 1)
82            in
83                fStream := f';
84                if Vector.length s = 0 then NONE else SOME(Vector.sub(s, 0))
85            end)
86
87    fun inputN(InStream{fStream, lock}, n) =
88        LibraryIOSupport.protect lock
89           (fn fStream =>
90            let
91                val (v, f') = StreamIO.inputN(!fStream, n)
92            in
93                fStream := f';
94                v
95            end) fStream
96
97    fun inputAll s = protect s
98           (fn fStream =>
99            let
100                val (v, f') = StreamIO.inputAll(!fStream)
101            in
102                fStream := f';
103                v
104            end)
105
106    (* These next functions only query the stream and don't affect the
107       fStream ref so don't really need interlocking.  If two threads
108       call these functions simultaneously the result is non-deterministic
109       anyway. *)
110    fun canInput(InStream{fStream, lock}, n) =
111        LibraryIOSupport.protect lock
112           (fn fStream => StreamIO.canInput(! fStream, n)) fStream
113
114    and closeIn s = protect s (fn fStream => StreamIO.closeIn(! fStream))
115    and endOfStream s = protect s (fn fStream => StreamIO.endOfStream(! fStream))
116
117    fun lookahead s = protect s
118        (fn fStream =>
119            case StreamIO.input1 (! fStream) of
120                NONE => NONE
121            |   SOME(s, _) => SOME s
122        )
123
124    (* These are simply wrappers. *)
125
126    fun mkOutstream (s : StreamIO.outstream) : outstream =
127        OutStream{fStream = LibrarySupport.noOverwriteRef s}
128
129    fun getOutstream(OutStream{fStream = ref s}) = s
130    and setOutstream(OutStream{fStream}, s) = fStream := s
131
132    fun output(OutStream{fStream=ref f, ...}, v) = StreamIO.output(f, v)
133    and output1(OutStream{fStream=ref f, ...}, c) = StreamIO.output1(f, c)
134    and flushOut(OutStream{fStream=ref f, ...}) = StreamIO.flushOut f
135    and closeOut(OutStream{fStream=ref f, ...}) = StreamIO.closeOut f
136    and getPosOut(OutStream{fStream=ref f, ...}) = StreamIO.getPosOut f
137
138    fun setPosOut(OutStream{fStream, ...}, p) = fStream := StreamIO.setPosOut p
139    
140    (* Add pretty printers to hide the internals.  These just use the implementation streams. *)
141    local
142        open PolyML
143        fun prettyIn depth _ (InStream{ fStream = ref s, ...}) =
144            PolyML.prettyRepresentation(s, depth)
145        fun prettyOut depth _ (OutStream { fStream = ref s, ...}) =
146            PolyML.prettyRepresentation(s, depth)
147    in
148        val () = addPrettyPrinter prettyIn
149        val () = addPrettyPrinter prettyOut
150    end
151end;
152
153(* General exported version with final signature. *)
154functor ImperativeIO (
155    structure StreamIO : STREAM_IO
156    structure Vector : MONO_VECTOR
157    structure Array : MONO_ARRAY
158    sharing type StreamIO.elem = Vector.elem = Array.elem
159    sharing type StreamIO.vector = Vector.vector = Array.vector
160) : IMPERATIVE_IO
161        where type StreamIO.elem = StreamIO.elem
162        where type StreamIO.vector = StreamIO.vector
163        where type StreamIO.instream = StreamIO.instream
164        where type StreamIO.outstream = StreamIO.outstream
165        where type StreamIO.out_pos = StreamIO.out_pos
166        where type StreamIO.reader = StreamIO.reader
167        where type StreamIO.writer = StreamIO.writer
168        where type StreamIO.pos = StreamIO.pos
169        =
170    BasicImperativeIO(structure StreamIO = StreamIO and Vector = Vector and Array = Array);
171
172