1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
|
%
% (c) The GRASP/AQUA Project, Glasgow University, 1994
%
\section[PrelReadTextIO]{Haskell 1.3 Text Input}
This module defines the standard set of input operations for reading
characters and strings from text files, using {\em handles}.
\begin{code}
module PreludeReadTextIO (
hReady,
hGetChar,
getChar,
hLookAhead,
hGetContents,
readFile13
) where
import Cls
import Core
import IChar
import IInt
import IList
import List ( (++) )
import Prel ( chr )
import Text
import PreludeIOError
import PreludeMonadicIO
import PreludePrimIO
import PreludeGlaST
import PreludeStdIO
import PS
---------------------------------
infixr 1 `my_then`
my_then :: IO a -> (a -> PrimIO b) -> PrimIO b
{-# INLINE my_then #-}
my_then m k = m `thenPrimIO` \ r -> k' r
where
k' (Right x) = k x
k' (Left err) = error "my_then"
---------------------------------
hReady :: Handle -> IO Bool
hReady handle =
takeMVar handle >>= \ htype ->
case htype of
_ErrorHandle ioError ->
putMVar handle htype >>
failWith ioError
_ClosedHandle ->
putMVar handle htype >>
failWith (IllegalOperation "handle is closed")
_SemiClosedHandle _ _ ->
putMVar handle htype >>
failWith (IllegalOperation "handle is closed")
_AppendHandle _ _ _ ->
putMVar handle htype >>
failWith (IllegalOperation "handle is not open for reading")
_WriteHandle _ _ _ ->
putMVar handle htype >>
failWith (IllegalOperation "handle is not open for reading")
other ->
_ccall_ inputReady (_filePtr other) `thenPrimIO` \ rc ->
putMVar handle (_markHandle htype) >>
case rc of
0 -> return False
1 -> return True
_ -> _constructError `thenPrimIO` \ ioError ->
failWith ioError
\end{code}
Computation $hReady hdl$ indicates whether at least
one item is available for input from handle {\em hdl}.
\begin{code}
hGetChar :: Handle -> IO Char
hGetChar handle =
takeMVar handle >>= \ htype ->
case htype of
_ErrorHandle ioError ->
putMVar handle htype >>
failWith ioError
_ClosedHandle ->
putMVar handle htype >>
failWith (IllegalOperation "handle is closed")
_SemiClosedHandle _ _ ->
putMVar handle htype >>
failWith (IllegalOperation "handle is closed")
_AppendHandle _ _ _ ->
putMVar handle htype >>
failWith (IllegalOperation "handle is not open for reading")
_WriteHandle _ _ _ ->
putMVar handle htype >>
failWith (IllegalOperation "handle is not open for reading")
other ->
_ccall_ fileGetc (_filePtr other) `thenPrimIO` \ intc ->
putMVar handle (_markHandle htype) >>
if intc /= ``EOF'' then
return (chr intc)
else
_constructError `thenPrimIO` \ ioError ->
failWith ioError
getChar :: IO Char
getChar = hGetChar stdin13
\end{code}
Computation $hGetChar hdl$ reads the next character from handle {\em
hdl}, blocking until a character is available.
$getChar$ reads the next character from $stdin$.
\begin{code}
hLookAhead :: Handle -> IO Char
hLookAhead handle =
takeMVar handle >>= \ htype ->
case htype of
_ErrorHandle ioError ->
putMVar handle htype >>
failWith ioError
_ClosedHandle ->
putMVar handle htype >>
failWith (IllegalOperation "handle is closed")
_SemiClosedHandle _ _ ->
putMVar handle htype >>
failWith (IllegalOperation "handle is closed")
_AppendHandle _ _ _ ->
putMVar handle htype >>
failWith (IllegalOperation "handle is not open for reading")
_WriteHandle _ _ _ ->
putMVar handle htype >>
failWith (IllegalOperation "handle is not open for reading")
other ->
_ccall_ fileLookAhead (_filePtr other) `thenPrimIO` \ intc ->
putMVar handle (_markHandle htype) >>
if intc /= ``EOF'' then
return (chr intc)
else
_constructError `thenPrimIO` \ ioError ->
failWith ioError
\end{code}
Computation $hLookahead hdl$ returns the next character from handle
{\em hdl} without removing it from the input buffer, blocking until a
character is available.
\begin{code}
hGetContents :: Handle -> IO String
hGetContents handle =
takeMVar handle >>= \ htype ->
case htype of
_ErrorHandle ioError ->
putMVar handle htype >>
failWith ioError
_ClosedHandle ->
putMVar handle htype >>
failWith (IllegalOperation "handle is closed")
_SemiClosedHandle _ _ ->
putMVar handle htype >>
failWith (IllegalOperation "handle is closed")
_AppendHandle _ _ _ ->
putMVar handle htype >>
failWith (IllegalOperation "handle is not open for reading")
_WriteHandle _ _ _ ->
putMVar handle htype >>
failWith (IllegalOperation "handle is not open for reading")
other ->
{-
To avoid introducing an extra layer of buffering here,
we provide three lazy read methods, based on character,
line, and block buffering.
-}
_getBufferMode other `thenPrimIO` \ other ->
case _bufferMode other of
Just LineBuffering ->
allocBuf Nothing >>= \ buf_info ->
putMVar handle (_SemiClosedHandle (_filePtr other) buf_info)
>>
unsafeInterleavePrimIO (lazyReadLine handle)
`thenPrimIO` \ contents ->
return contents
Just (BlockBuffering size) ->
allocBuf size >>= \ buf_info ->
putMVar handle (_SemiClosedHandle (_filePtr other) buf_info)
>>
unsafeInterleavePrimIO (lazyReadBlock handle)
`thenPrimIO` \ contents ->
return contents
_ -> -- Nothing is treated pessimistically as NoBuffering
putMVar handle (_SemiClosedHandle (_filePtr other) (``NULL'', 0))
>>
unsafeInterleavePrimIO (lazyReadChar handle)
`thenPrimIO` \ contents ->
return contents
where
allocBuf :: (Maybe Int) -> IO (_Addr, Int)
allocBuf msize =
_ccall_ malloc size `thenPrimIO` \ buf ->
if buf /= ``NULL'' then
return (buf, size)
else
failWith (ResourceExhausted "not enough virtual memory")
where
size =
case msize of
Just x -> x
Nothing -> ``BUFSIZ''
{-
Note that someone may yank our handle out from under us, and then re-use
the same FILE * for something else. Therefore, we have to re-examine the
handle every time through.
-}
lazyReadBlock :: Handle -> PrimIO String
lazyReadBlock handle =
takeMVar handle `my_then` \ htype ->
case htype of
-- There cannae be an _ErrorHandle here
_ClosedHandle ->
putMVar handle htype `seqPrimIO`
returnPrimIO ""
_SemiClosedHandle fp (buf, size) ->
_ccall_ readBlock buf fp size `thenPrimIO` \ bytes ->
(if bytes <= 0 then returnStrictlyST _nilPS
else _packCBytesST bytes buf) `thenStrictlyST` \ some ->
if bytes < 0 then
putMVar handle (_SemiClosedHandle ``NULL'' (``NULL'', 0))
`seqPrimIO`
_ccall_ free buf `thenPrimIO` \ () ->
_ccall_ closeFile fp `seqPrimIO`
returnPrimIO (_unpackPS some)
else
putMVar handle htype `seqPrimIO`
unsafeInterleavePrimIO (lazyReadBlock handle)
`thenPrimIO` \ more ->
returnPrimIO (_unpackPS some ++ more)
lazyReadLine :: Handle -> PrimIO String
lazyReadLine handle =
takeMVar handle `my_then` \ htype ->
case htype of
-- There cannae be an _ErrorHandle here
_ClosedHandle ->
putMVar handle htype `seqPrimIO`
returnPrimIO ""
_SemiClosedHandle fp (buf, size) ->
_ccall_ readLine buf fp size `thenPrimIO` \ bytes ->
(if bytes <= 0 then returnStrictlyST _nilPS
else _packCBytesST bytes buf) `thenStrictlyST` \ some ->
if bytes < 0 then
putMVar handle (_SemiClosedHandle ``NULL'' (``NULL'', 0))
`seqPrimIO`
_ccall_ free buf `thenPrimIO` \ () ->
_ccall_ closeFile fp `seqPrimIO`
returnPrimIO (_unpackPS some)
else
putMVar handle htype `seqPrimIO`
unsafeInterleavePrimIO (lazyReadLine handle)
`thenPrimIO` \ more ->
returnPrimIO (_unpackPS some ++ more)
lazyReadChar :: Handle -> PrimIO String
lazyReadChar handle =
takeMVar handle `my_then` \ htype ->
case htype of
-- There cannae be an _ErrorHandle here
_ClosedHandle ->
putMVar handle htype `seqPrimIO`
returnPrimIO ""
_SemiClosedHandle fp buf_info ->
_ccall_ readChar fp `thenPrimIO` \ char ->
if char == ``EOF'' then
putMVar handle (_SemiClosedHandle ``NULL'' buf_info)
`seqPrimIO`
_ccall_ closeFile fp `seqPrimIO`
returnPrimIO ""
else
putMVar handle htype `seqPrimIO`
unsafeInterleavePrimIO (lazyReadChar handle)
`thenPrimIO` \ more ->
returnPrimIO (chr char : more)
\end{code}
Computation $hGetContents hdl$ returns the list of characters
corresponding to the unread portion of the channel or file managed by
{\em hdl}, which is made semi-closed.
\begin{code}
readFile13 :: FilePath -> IO String
readFile13 name = openFile name ReadMode >>= hGetContents
\end{code}
$readFile file$ returns the contents of {\em file} as a lazy string.
|
