1 {-# OPTIONS -#include "HsBase.h" #-}
2 -----------------------------------------------------------------------------
4 -- Module : Data.Array.IO
5 -- Copyright : (c) The University of Glasgow 2001
6 -- License : BSD-style (see the file libraries/base/LICENSE)
8 -- Maintainer : libraries@haskell.org
9 -- Stability : experimental
10 -- Portability : non-portable
12 -- Mutable boxed and unboxed arrays in the IO monad.
14 -----------------------------------------------------------------------------
16 module Data.Array.IO (
17 -- * @IO@ arrays with boxed elements
18 IOArray, -- instance of: Eq, Typeable
20 -- * @IO@ arrays with unboxed elements
21 IOUArray, -- instance of: Eq, Typeable
22 castIOUArray, -- :: IOUArray i a -> IO (IOUArray i b)
24 -- * Overloaded mutable array interface
25 module Data.Array.MArray,
27 -- * Doing I\/O with @IOUArray@s
28 hGetArray, -- :: Handle -> IOUArray Int Word8 -> Int -> IO Int
29 hPutArray, -- :: Handle -> IOUArray Int Word8 -> Int -> IO ()
34 import Data.Array ( Array )
35 import Data.Array.MArray
41 import Foreign.Ptr ( Ptr, FunPtr )
42 import Foreign.StablePtr ( StablePtr )
44 #ifdef __GLASGOW_HASKELL__
45 -- GHC only to the end of file
47 import Data.Array.Base
48 import GHC.Arr ( STArray, freezeSTArray, unsafeFreezeSTArray,
49 thawSTArray, unsafeThawSTArray )
51 import GHC.ST ( ST(..) )
59 -----------------------------------------------------------------------------
60 -- | Mutable, boxed, non-strict arrays in the 'IO' monad. The type
61 -- arguments are as follows:
63 -- * @i@: the index type of the array (should be an instance of @Ix@)
65 -- * @e@: the element type of the array.
67 newtype IOArray i e = IOArray (STArray RealWorld i e) deriving Eq
70 iOArrayTc = mkTyCon "IOArray"
72 instance (Typeable a, Typeable b) => Typeable (IOArray a b) where
73 typeOf a = mkAppTy iOArrayTc [typeOf ((undefined :: IOArray a b -> a) a),
74 typeOf ((undefined :: IOArray a b -> b) a)]
76 instance HasBounds IOArray where
78 bounds (IOArray marr) = bounds marr
80 instance MArray IOArray e IO where
81 {-# INLINE newArray #-}
82 newArray lu init = stToIO $ do
83 marr <- newArray lu init; return (IOArray marr)
84 {-# INLINE newArray_ #-}
85 newArray_ lu = stToIO $ do
86 marr <- newArray_ lu; return (IOArray marr)
87 {-# INLINE unsafeRead #-}
88 unsafeRead (IOArray marr) i = stToIO (unsafeRead marr i)
89 {-# INLINE unsafeWrite #-}
90 unsafeWrite (IOArray marr) i e = stToIO (unsafeWrite marr i e)
92 -----------------------------------------------------------------------------
93 -- Flat unboxed mutable arrays (IO monad)
95 -- | Mutable, unboxed, strict arrays in the 'IO' monad. The type
96 -- arguments are as follows:
98 -- * @i@: the index type of the array (should be an instance of @Ix@)
100 -- * @e@: the element type of the array. Only certain element types
101 -- are supported: see 'MArray' for a list of instances.
103 newtype IOUArray i e = IOUArray (STUArray RealWorld i e) deriving Eq
106 iOUArrayTc = mkTyCon "IOUArray"
108 instance (Typeable a, Typeable b) => Typeable (IOUArray a b) where
109 typeOf a = mkAppTy iOUArrayTc [typeOf ((undefined :: IOUArray a b -> a) a),
110 typeOf ((undefined :: IOUArray a b -> b) a)]
112 instance HasBounds IOUArray where
113 {-# INLINE bounds #-}
114 bounds (IOUArray marr) = bounds marr
116 instance MArray IOUArray Bool IO where
117 {-# INLINE newArray #-}
118 newArray lu init = stToIO $ do
119 marr <- newArray lu init; return (IOUArray marr)
120 {-# INLINE newArray_ #-}
121 newArray_ lu = stToIO $ do
122 marr <- newArray_ lu; return (IOUArray marr)
123 {-# INLINE unsafeRead #-}
124 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
125 {-# INLINE unsafeWrite #-}
126 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
128 instance MArray IOUArray Char IO where
129 {-# INLINE newArray #-}
130 newArray lu init = stToIO $ do
131 marr <- newArray lu init; return (IOUArray marr)
132 {-# INLINE newArray_ #-}
133 newArray_ lu = stToIO $ do
134 marr <- newArray_ lu; return (IOUArray marr)
135 {-# INLINE unsafeRead #-}
136 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
137 {-# INLINE unsafeWrite #-}
138 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
140 instance MArray IOUArray Int IO where
141 {-# INLINE newArray #-}
142 newArray lu init = stToIO $ do
143 marr <- newArray lu init; return (IOUArray marr)
144 {-# INLINE newArray_ #-}
145 newArray_ lu = stToIO $ do
146 marr <- newArray_ lu; return (IOUArray marr)
147 {-# INLINE unsafeRead #-}
148 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
149 {-# INLINE unsafeWrite #-}
150 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
152 instance MArray IOUArray Word IO where
153 {-# INLINE newArray #-}
154 newArray lu init = stToIO $ do
155 marr <- newArray lu init; return (IOUArray marr)
156 {-# INLINE newArray_ #-}
157 newArray_ lu = stToIO $ do
158 marr <- newArray_ lu; return (IOUArray marr)
159 {-# INLINE unsafeRead #-}
160 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
161 {-# INLINE unsafeWrite #-}
162 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
164 instance MArray IOUArray (Ptr a) IO where
165 {-# INLINE newArray #-}
166 newArray lu init = stToIO $ do
167 marr <- newArray lu init; return (IOUArray marr)
168 {-# INLINE newArray_ #-}
169 newArray_ lu = stToIO $ do
170 marr <- newArray_ lu; return (IOUArray marr)
171 {-# INLINE unsafeRead #-}
172 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
173 {-# INLINE unsafeWrite #-}
174 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
176 instance MArray IOUArray (FunPtr a) IO where
177 {-# INLINE newArray #-}
178 newArray lu init = stToIO $ do
179 marr <- newArray lu init; return (IOUArray marr)
180 {-# INLINE newArray_ #-}
181 newArray_ lu = stToIO $ do
182 marr <- newArray_ lu; return (IOUArray marr)
183 {-# INLINE unsafeRead #-}
184 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
185 {-# INLINE unsafeWrite #-}
186 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
188 instance MArray IOUArray Float IO where
189 {-# INLINE newArray #-}
190 newArray lu init = stToIO $ do
191 marr <- newArray lu init; return (IOUArray marr)
192 {-# INLINE newArray_ #-}
193 newArray_ lu = stToIO $ do
194 marr <- newArray_ lu; return (IOUArray marr)
195 {-# INLINE unsafeRead #-}
196 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
197 {-# INLINE unsafeWrite #-}
198 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
200 instance MArray IOUArray Double IO where
201 {-# INLINE newArray #-}
202 newArray lu init = stToIO $ do
203 marr <- newArray lu init; return (IOUArray marr)
204 {-# INLINE newArray_ #-}
205 newArray_ lu = stToIO $ do
206 marr <- newArray_ lu; return (IOUArray marr)
207 {-# INLINE unsafeRead #-}
208 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
209 {-# INLINE unsafeWrite #-}
210 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
212 instance MArray IOUArray (StablePtr a) IO where
213 {-# INLINE newArray #-}
214 newArray lu init = stToIO $ do
215 marr <- newArray lu init; return (IOUArray marr)
216 {-# INLINE newArray_ #-}
217 newArray_ lu = stToIO $ do
218 marr <- newArray_ lu; return (IOUArray marr)
219 {-# INLINE unsafeRead #-}
220 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
221 {-# INLINE unsafeWrite #-}
222 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
224 instance MArray IOUArray Int8 IO where
225 {-# INLINE newArray #-}
226 newArray lu init = stToIO $ do
227 marr <- newArray lu init; return (IOUArray marr)
228 {-# INLINE newArray_ #-}
229 newArray_ lu = stToIO $ do
230 marr <- newArray_ lu; return (IOUArray marr)
231 {-# INLINE unsafeRead #-}
232 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
233 {-# INLINE unsafeWrite #-}
234 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
236 instance MArray IOUArray Int16 IO where
237 {-# INLINE newArray #-}
238 newArray lu init = stToIO $ do
239 marr <- newArray lu init; return (IOUArray marr)
240 {-# INLINE newArray_ #-}
241 newArray_ lu = stToIO $ do
242 marr <- newArray_ lu; return (IOUArray marr)
243 {-# INLINE unsafeRead #-}
244 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
245 {-# INLINE unsafeWrite #-}
246 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
248 instance MArray IOUArray Int32 IO where
249 {-# INLINE newArray #-}
250 newArray lu init = stToIO $ do
251 marr <- newArray lu init; return (IOUArray marr)
252 {-# INLINE newArray_ #-}
253 newArray_ lu = stToIO $ do
254 marr <- newArray_ lu; return (IOUArray marr)
255 {-# INLINE unsafeRead #-}
256 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
257 {-# INLINE unsafeWrite #-}
258 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
260 instance MArray IOUArray Int64 IO where
261 {-# INLINE newArray #-}
262 newArray lu init = stToIO $ do
263 marr <- newArray lu init; return (IOUArray marr)
264 {-# INLINE newArray_ #-}
265 newArray_ lu = stToIO $ do
266 marr <- newArray_ lu; return (IOUArray marr)
267 {-# INLINE unsafeRead #-}
268 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
269 {-# INLINE unsafeWrite #-}
270 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
272 instance MArray IOUArray Word8 IO where
273 {-# INLINE newArray #-}
274 newArray lu init = stToIO $ do
275 marr <- newArray lu init; return (IOUArray marr)
276 {-# INLINE newArray_ #-}
277 newArray_ lu = stToIO $ do
278 marr <- newArray_ lu; return (IOUArray marr)
279 {-# INLINE unsafeRead #-}
280 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
281 {-# INLINE unsafeWrite #-}
282 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
284 instance MArray IOUArray Word16 IO where
285 {-# INLINE newArray #-}
286 newArray lu init = stToIO $ do
287 marr <- newArray lu init; return (IOUArray marr)
288 {-# INLINE newArray_ #-}
289 newArray_ lu = stToIO $ do
290 marr <- newArray_ lu; return (IOUArray marr)
291 {-# INLINE unsafeRead #-}
292 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
293 {-# INLINE unsafeWrite #-}
294 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
296 instance MArray IOUArray Word32 IO where
297 {-# INLINE newArray #-}
298 newArray lu init = stToIO $ do
299 marr <- newArray lu init; return (IOUArray marr)
300 {-# INLINE newArray_ #-}
301 newArray_ lu = stToIO $ do
302 marr <- newArray_ lu; return (IOUArray marr)
303 {-# INLINE unsafeRead #-}
304 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
305 {-# INLINE unsafeWrite #-}
306 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
308 instance MArray IOUArray Word64 IO where
309 {-# INLINE newArray #-}
310 newArray lu init = stToIO $ do
311 marr <- newArray lu init; return (IOUArray marr)
312 {-# INLINE newArray_ #-}
313 newArray_ lu = stToIO $ do
314 marr <- newArray_ lu; return (IOUArray marr)
315 {-# INLINE unsafeRead #-}
316 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
317 {-# INLINE unsafeWrite #-}
318 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
320 -----------------------------------------------------------------------------
323 freezeIOArray :: Ix ix => IOArray ix e -> IO (Array ix e)
324 freezeIOArray (IOArray marr) = stToIO (freezeSTArray marr)
326 freezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)
327 freezeIOUArray (IOUArray marr) = stToIO (freezeSTUArray marr)
330 "freeze/IOArray" freeze = freezeIOArray
331 "freeze/IOUArray" freeze = freezeIOUArray
334 {-# INLINE unsafeFreezeIOArray #-}
335 unsafeFreezeIOArray :: Ix ix => IOArray ix e -> IO (Array ix e)
336 unsafeFreezeIOArray (IOArray marr) = stToIO (unsafeFreezeSTArray marr)
338 {-# INLINE unsafeFreezeIOUArray #-}
339 unsafeFreezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)
340 unsafeFreezeIOUArray (IOUArray marr) = stToIO (unsafeFreezeSTUArray marr)
343 "unsafeFreeze/IOArray" unsafeFreeze = unsafeFreezeIOArray
344 "unsafeFreeze/IOUArray" unsafeFreeze = unsafeFreezeIOUArray
347 -----------------------------------------------------------------------------
350 thawIOArray :: Ix ix => Array ix e -> IO (IOArray ix e)
351 thawIOArray arr = stToIO $ do
352 marr <- thawSTArray arr
353 return (IOArray marr)
355 thawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)
356 thawIOUArray arr = stToIO $ do
357 marr <- thawSTUArray arr
358 return (IOUArray marr)
361 "thaw/IOArray" thaw = thawIOArray
362 "thaw/IOUArray" thaw = thawIOUArray
365 {-# INLINE unsafeThawIOArray #-}
366 unsafeThawIOArray :: Ix ix => Array ix e -> IO (IOArray ix e)
367 unsafeThawIOArray arr = stToIO $ do
368 marr <- unsafeThawSTArray arr
369 return (IOArray marr)
371 {-# INLINE unsafeThawIOUArray #-}
372 unsafeThawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)
373 unsafeThawIOUArray arr = stToIO $ do
374 marr <- unsafeThawSTUArray arr
375 return (IOUArray marr)
378 "unsafeThaw/IOArray" unsafeThaw = unsafeThawIOArray
379 "unsafeThaw/IOUArray" unsafeThaw = unsafeThawIOUArray
382 castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)
383 castSTUArray (STUArray l u marr#) = return (STUArray l u marr#)
385 -- | Casts an 'IOUArray' with one element type into one with a
386 -- different element type. All the elements of the resulting array
387 -- are undefined (unless you know what you\'re doing...).
388 castIOUArray :: IOUArray ix a -> IO (IOUArray ix b)
389 castIOUArray (IOUArray marr) = stToIO $ do
390 marr' <- castSTUArray marr
391 return (IOUArray marr')
393 -- ---------------------------------------------------------------------------
396 -- | Reads a number of 'Word8's from the specified 'Handle' directly
399 :: Handle -- ^ Handle to read from
400 -> IOUArray Int Word8 -- ^ Array in which to place the values
401 -> Int -- ^ Number of 'Word8's to read
403 -- ^ Returns: the number of 'Word8's actually
404 -- read, which might be smaller than the number requested
405 -- if the end of file was reached.
407 hGetArray handle (IOUArray (STUArray l u ptr)) count
408 | count <= 0 || count > rangeSize (l,u)
409 = illegalBufferSize handle "hGetArray" count
411 wantReadableHandle "hGetArray" handle $
412 \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do
413 buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r } <- readIORef ref
415 then readChunk fd is_stream ptr 0 count
418 copied <- if (count >= avail)
420 memcpy_ba_baoff ptr raw r (fromIntegral avail)
421 writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
424 memcpy_ba_baoff ptr raw r (fromIntegral count)
425 writeIORef ref buf{ bufRPtr = r + count }
428 let remaining = count - copied
430 then do rest <- readChunk fd is_stream ptr copied remaining
431 return (rest + count)
434 readChunk :: FD -> Bool -> RawBuffer -> Int -> Int -> IO Int
435 readChunk fd is_stream ptr init_off bytes = loop init_off bytes
437 loop :: Int -> Int -> IO Int
438 loop off bytes | bytes <= 0 = return (off - init_off)
440 r' <- throwErrnoIfMinus1RetryMayBlock "readChunk"
441 (read_off_ba (fromIntegral fd) is_stream ptr
442 (fromIntegral off) (fromIntegral bytes))
444 let r = fromIntegral r'
446 then return (off - init_off)
447 else loop (off + r) (bytes - r)
449 -- ---------------------------------------------------------------------------
452 -- | Writes an array of 'Word8' to the specified 'Handle'.
454 :: Handle -- ^ Handle to write to
455 -> IOUArray Int Word8 -- ^ Array to write from
456 -> Int -- ^ Number of 'Word8's to write
459 hPutArray handle (IOUArray (STUArray l u raw)) count
460 | count <= 0 || count > rangeSize (l,u)
461 = illegalBufferSize handle "hPutArray" count
463 = do wantWritableHandle "hPutArray" handle $
464 \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=stream } -> do
466 old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }
469 -- enough room in handle buffer?
470 if (size - w > count)
471 -- There's enough room in the buffer:
472 -- just copy the data in and update bufWPtr.
473 then do memcpy_baoff_ba old_raw w raw (fromIntegral count)
474 writeIORef ref old_buf{ bufWPtr = w + count }
477 -- else, we have to flush
478 else do flushed_buf <- flushWriteBuffer fd stream old_buf
479 writeIORef ref flushed_buf
481 Buffer{ bufBuf=raw, bufState=WriteBuffer,
482 bufRPtr=0, bufWPtr=count, bufSize=count }
483 flushWriteBuffer fd stream this_buf
486 -- ---------------------------------------------------------------------------
489 foreign import ccall unsafe "__hscore_memcpy_dst_off"
490 memcpy_baoff_ba :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ())
491 foreign import ccall unsafe "__hscore_memcpy_src_off"
492 memcpy_ba_baoff :: RawBuffer -> RawBuffer -> Int -> CSize -> IO (Ptr ())
494 illegalBufferSize :: Handle -> String -> Int -> IO a
495 illegalBufferSize handle fn sz =
496 ioException (IOError (Just handle)
498 ("illegal buffer size " ++ showsPrec 9 (sz::Int) [])
501 #endif /* __GLASGOW_HASKELL__ */