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 #ifdef __GLASGOW_HASKELL__
28 -- * Doing I\/O with @IOUArray@s
29 hGetArray, -- :: Handle -> IOUArray Int Word8 -> Int -> IO Int
30 hPutArray, -- :: Handle -> IOUArray Int Word8 -> Int -> IO ()
36 import Data.Array ( Array )
37 import Data.Array.MArray
44 import Hugs.IOExts ( unsafeCoerce )
45 import Data.Array.Storable
48 #ifdef __GLASGOW_HASKELL__
50 import Foreign.Ptr ( Ptr, FunPtr )
51 import Foreign.StablePtr ( StablePtr )
53 import Data.Array.Base
54 import GHC.Arr ( STArray, freezeSTArray, unsafeFreezeSTArray,
55 thawSTArray, unsafeThawSTArray )
57 import GHC.ST ( ST(..) )
64 #endif /* __GLASGOW_HASKELL__ */
67 instance HasBounds IOArray where
68 bounds = boundsIOArray
70 instance MArray IOArray e IO where
72 unsafeRead = unsafeReadIOArray
73 unsafeWrite = unsafeWriteIOArray
75 type IOUArray = StorableArray
77 castIOUArray :: IOUArray i a -> IO (IOUArray i b)
78 castIOUArray marr = return (unsafeCoerce marr)
82 iOArrayTc = mkTyCon "IOArray"
84 instance (Typeable a, Typeable b) => Typeable (IOArray a b) where
85 typeOf a = mkAppTy iOArrayTc [typeOf ((undefined :: IOArray a b -> a) a),
86 typeOf ((undefined :: IOArray a b -> b) a)]
88 #ifdef __GLASGOW_HASKELL__
89 -- GHC only to the end of file
91 -----------------------------------------------------------------------------
92 -- | Mutable, boxed, non-strict arrays in the 'IO' monad. The type
93 -- arguments are as follows:
95 -- * @i@: the index type of the array (should be an instance of @Ix@)
97 -- * @e@: the element type of the array.
99 newtype IOArray i e = IOArray (STArray RealWorld i e) deriving Eq
101 instance HasBounds IOArray where
102 {-# INLINE bounds #-}
103 bounds (IOArray marr) = bounds marr
105 instance MArray IOArray e IO where
106 {-# INLINE newArray #-}
107 newArray lu init = stToIO $ do
108 marr <- newArray lu init; return (IOArray marr)
109 {-# INLINE newArray_ #-}
110 newArray_ lu = stToIO $ do
111 marr <- newArray_ lu; return (IOArray marr)
112 {-# INLINE unsafeRead #-}
113 unsafeRead (IOArray marr) i = stToIO (unsafeRead marr i)
114 {-# INLINE unsafeWrite #-}
115 unsafeWrite (IOArray marr) i e = stToIO (unsafeWrite marr i e)
117 -----------------------------------------------------------------------------
118 -- Flat unboxed mutable arrays (IO monad)
120 -- | Mutable, unboxed, strict arrays in the 'IO' monad. The type
121 -- arguments are as follows:
123 -- * @i@: the index type of the array (should be an instance of @Ix@)
125 -- * @e@: the element type of the array. Only certain element types
126 -- are supported: see 'MArray' for a list of instances.
128 newtype IOUArray i e = IOUArray (STUArray RealWorld i e) deriving Eq
131 iOUArrayTc = mkTyCon "IOUArray"
133 instance (Typeable a, Typeable b) => Typeable (IOUArray a b) where
134 typeOf a = mkAppTy iOUArrayTc [typeOf ((undefined :: IOUArray a b -> a) a),
135 typeOf ((undefined :: IOUArray a b -> b) a)]
137 instance HasBounds IOUArray where
138 {-# INLINE bounds #-}
139 bounds (IOUArray marr) = bounds marr
141 instance MArray IOUArray Bool IO where
142 {-# INLINE newArray #-}
143 newArray lu init = stToIO $ do
144 marr <- newArray lu init; return (IOUArray marr)
145 {-# INLINE newArray_ #-}
146 newArray_ lu = stToIO $ do
147 marr <- newArray_ lu; return (IOUArray marr)
148 {-# INLINE unsafeRead #-}
149 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
150 {-# INLINE unsafeWrite #-}
151 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
153 instance MArray IOUArray Char IO where
154 {-# INLINE newArray #-}
155 newArray lu init = stToIO $ do
156 marr <- newArray lu init; return (IOUArray marr)
157 {-# INLINE newArray_ #-}
158 newArray_ lu = stToIO $ do
159 marr <- newArray_ lu; return (IOUArray marr)
160 {-# INLINE unsafeRead #-}
161 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
162 {-# INLINE unsafeWrite #-}
163 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
165 instance MArray IOUArray Int IO where
166 {-# INLINE newArray #-}
167 newArray lu init = stToIO $ do
168 marr <- newArray lu init; return (IOUArray marr)
169 {-# INLINE newArray_ #-}
170 newArray_ lu = stToIO $ do
171 marr <- newArray_ lu; return (IOUArray marr)
172 {-# INLINE unsafeRead #-}
173 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
174 {-# INLINE unsafeWrite #-}
175 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
177 instance MArray IOUArray Word IO where
178 {-# INLINE newArray #-}
179 newArray lu init = stToIO $ do
180 marr <- newArray lu init; return (IOUArray marr)
181 {-# INLINE newArray_ #-}
182 newArray_ lu = stToIO $ do
183 marr <- newArray_ lu; return (IOUArray marr)
184 {-# INLINE unsafeRead #-}
185 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
186 {-# INLINE unsafeWrite #-}
187 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
189 instance MArray IOUArray (Ptr a) IO where
190 {-# INLINE newArray #-}
191 newArray lu init = stToIO $ do
192 marr <- newArray lu init; return (IOUArray marr)
193 {-# INLINE newArray_ #-}
194 newArray_ lu = stToIO $ do
195 marr <- newArray_ lu; return (IOUArray marr)
196 {-# INLINE unsafeRead #-}
197 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
198 {-# INLINE unsafeWrite #-}
199 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
201 instance MArray IOUArray (FunPtr a) IO where
202 {-# INLINE newArray #-}
203 newArray lu init = stToIO $ do
204 marr <- newArray lu init; return (IOUArray marr)
205 {-# INLINE newArray_ #-}
206 newArray_ lu = stToIO $ do
207 marr <- newArray_ lu; return (IOUArray marr)
208 {-# INLINE unsafeRead #-}
209 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
210 {-# INLINE unsafeWrite #-}
211 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
213 instance MArray IOUArray Float IO where
214 {-# INLINE newArray #-}
215 newArray lu init = stToIO $ do
216 marr <- newArray lu init; return (IOUArray marr)
217 {-# INLINE newArray_ #-}
218 newArray_ lu = stToIO $ do
219 marr <- newArray_ lu; return (IOUArray marr)
220 {-# INLINE unsafeRead #-}
221 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
222 {-# INLINE unsafeWrite #-}
223 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
225 instance MArray IOUArray Double IO where
226 {-# INLINE newArray #-}
227 newArray lu init = stToIO $ do
228 marr <- newArray lu init; return (IOUArray marr)
229 {-# INLINE newArray_ #-}
230 newArray_ lu = stToIO $ do
231 marr <- newArray_ lu; return (IOUArray marr)
232 {-# INLINE unsafeRead #-}
233 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
234 {-# INLINE unsafeWrite #-}
235 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
237 instance MArray IOUArray (StablePtr a) IO where
238 {-# INLINE newArray #-}
239 newArray lu init = stToIO $ do
240 marr <- newArray lu init; return (IOUArray marr)
241 {-# INLINE newArray_ #-}
242 newArray_ lu = stToIO $ do
243 marr <- newArray_ lu; return (IOUArray marr)
244 {-# INLINE unsafeRead #-}
245 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
246 {-# INLINE unsafeWrite #-}
247 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
249 instance MArray IOUArray Int8 IO where
250 {-# INLINE newArray #-}
251 newArray lu init = stToIO $ do
252 marr <- newArray lu init; return (IOUArray marr)
253 {-# INLINE newArray_ #-}
254 newArray_ lu = stToIO $ do
255 marr <- newArray_ lu; return (IOUArray marr)
256 {-# INLINE unsafeRead #-}
257 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
258 {-# INLINE unsafeWrite #-}
259 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
261 instance MArray IOUArray Int16 IO where
262 {-# INLINE newArray #-}
263 newArray lu init = stToIO $ do
264 marr <- newArray lu init; return (IOUArray marr)
265 {-# INLINE newArray_ #-}
266 newArray_ lu = stToIO $ do
267 marr <- newArray_ lu; return (IOUArray marr)
268 {-# INLINE unsafeRead #-}
269 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
270 {-# INLINE unsafeWrite #-}
271 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
273 instance MArray IOUArray Int32 IO where
274 {-# INLINE newArray #-}
275 newArray lu init = stToIO $ do
276 marr <- newArray lu init; return (IOUArray marr)
277 {-# INLINE newArray_ #-}
278 newArray_ lu = stToIO $ do
279 marr <- newArray_ lu; return (IOUArray marr)
280 {-# INLINE unsafeRead #-}
281 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
282 {-# INLINE unsafeWrite #-}
283 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
285 instance MArray IOUArray Int64 IO where
286 {-# INLINE newArray #-}
287 newArray lu init = stToIO $ do
288 marr <- newArray lu init; return (IOUArray marr)
289 {-# INLINE newArray_ #-}
290 newArray_ lu = stToIO $ do
291 marr <- newArray_ lu; return (IOUArray marr)
292 {-# INLINE unsafeRead #-}
293 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
294 {-# INLINE unsafeWrite #-}
295 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
297 instance MArray IOUArray Word8 IO where
298 {-# INLINE newArray #-}
299 newArray lu init = stToIO $ do
300 marr <- newArray lu init; return (IOUArray marr)
301 {-# INLINE newArray_ #-}
302 newArray_ lu = stToIO $ do
303 marr <- newArray_ lu; return (IOUArray marr)
304 {-# INLINE unsafeRead #-}
305 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
306 {-# INLINE unsafeWrite #-}
307 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
309 instance MArray IOUArray Word16 IO where
310 {-# INLINE newArray #-}
311 newArray lu init = stToIO $ do
312 marr <- newArray lu init; return (IOUArray marr)
313 {-# INLINE newArray_ #-}
314 newArray_ lu = stToIO $ do
315 marr <- newArray_ lu; return (IOUArray marr)
316 {-# INLINE unsafeRead #-}
317 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
318 {-# INLINE unsafeWrite #-}
319 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
321 instance MArray IOUArray Word32 IO where
322 {-# INLINE newArray #-}
323 newArray lu init = stToIO $ do
324 marr <- newArray lu init; return (IOUArray marr)
325 {-# INLINE newArray_ #-}
326 newArray_ lu = stToIO $ do
327 marr <- newArray_ lu; return (IOUArray marr)
328 {-# INLINE unsafeRead #-}
329 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
330 {-# INLINE unsafeWrite #-}
331 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
333 instance MArray IOUArray Word64 IO where
334 {-# INLINE newArray #-}
335 newArray lu init = stToIO $ do
336 marr <- newArray lu init; return (IOUArray marr)
337 {-# INLINE newArray_ #-}
338 newArray_ lu = stToIO $ do
339 marr <- newArray_ lu; return (IOUArray marr)
340 {-# INLINE unsafeRead #-}
341 unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
342 {-# INLINE unsafeWrite #-}
343 unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
345 -----------------------------------------------------------------------------
348 freezeIOArray :: Ix ix => IOArray ix e -> IO (Array ix e)
349 freezeIOArray (IOArray marr) = stToIO (freezeSTArray marr)
351 freezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)
352 freezeIOUArray (IOUArray marr) = stToIO (freezeSTUArray marr)
355 "freeze/IOArray" freeze = freezeIOArray
356 "freeze/IOUArray" freeze = freezeIOUArray
359 {-# INLINE unsafeFreezeIOArray #-}
360 unsafeFreezeIOArray :: Ix ix => IOArray ix e -> IO (Array ix e)
361 unsafeFreezeIOArray (IOArray marr) = stToIO (unsafeFreezeSTArray marr)
363 {-# INLINE unsafeFreezeIOUArray #-}
364 unsafeFreezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)
365 unsafeFreezeIOUArray (IOUArray marr) = stToIO (unsafeFreezeSTUArray marr)
368 "unsafeFreeze/IOArray" unsafeFreeze = unsafeFreezeIOArray
369 "unsafeFreeze/IOUArray" unsafeFreeze = unsafeFreezeIOUArray
372 -----------------------------------------------------------------------------
375 thawIOArray :: Ix ix => Array ix e -> IO (IOArray ix e)
376 thawIOArray arr = stToIO $ do
377 marr <- thawSTArray arr
378 return (IOArray marr)
380 thawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)
381 thawIOUArray arr = stToIO $ do
382 marr <- thawSTUArray arr
383 return (IOUArray marr)
386 "thaw/IOArray" thaw = thawIOArray
387 "thaw/IOUArray" thaw = thawIOUArray
390 {-# INLINE unsafeThawIOArray #-}
391 unsafeThawIOArray :: Ix ix => Array ix e -> IO (IOArray ix e)
392 unsafeThawIOArray arr = stToIO $ do
393 marr <- unsafeThawSTArray arr
394 return (IOArray marr)
396 {-# INLINE unsafeThawIOUArray #-}
397 unsafeThawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)
398 unsafeThawIOUArray arr = stToIO $ do
399 marr <- unsafeThawSTUArray arr
400 return (IOUArray marr)
403 "unsafeThaw/IOArray" unsafeThaw = unsafeThawIOArray
404 "unsafeThaw/IOUArray" unsafeThaw = unsafeThawIOUArray
407 castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)
408 castSTUArray (STUArray l u marr#) = return (STUArray l u marr#)
410 -- | Casts an 'IOUArray' with one element type into one with a
411 -- different element type. All the elements of the resulting array
412 -- are undefined (unless you know what you\'re doing...).
413 castIOUArray :: IOUArray ix a -> IO (IOUArray ix b)
414 castIOUArray (IOUArray marr) = stToIO $ do
415 marr' <- castSTUArray marr
416 return (IOUArray marr')
418 -- ---------------------------------------------------------------------------
421 -- | Reads a number of 'Word8's from the specified 'Handle' directly
424 :: Handle -- ^ Handle to read from
425 -> IOUArray Int Word8 -- ^ Array in which to place the values
426 -> Int -- ^ Number of 'Word8's to read
428 -- ^ Returns: the number of 'Word8's actually
429 -- read, which might be smaller than the number requested
430 -- if the end of file was reached.
432 hGetArray handle (IOUArray (STUArray l u ptr)) count
433 | count <= 0 || count > rangeSize (l,u)
434 = illegalBufferSize handle "hGetArray" count
436 wantReadableHandle "hGetArray" handle $
437 \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do
438 buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r } <- readIORef ref
440 then readChunk fd is_stream ptr 0 count
443 copied <- if (count >= avail)
445 memcpy_ba_baoff ptr raw r (fromIntegral avail)
446 writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
449 memcpy_ba_baoff ptr raw r (fromIntegral count)
450 writeIORef ref buf{ bufRPtr = r + count }
453 let remaining = count - copied
455 then do rest <- readChunk fd is_stream ptr copied remaining
456 return (rest + count)
459 readChunk :: FD -> Bool -> RawBuffer -> Int -> Int -> IO Int
460 readChunk fd is_stream ptr init_off bytes = loop init_off bytes
462 loop :: Int -> Int -> IO Int
463 loop off bytes | bytes <= 0 = return (off - init_off)
465 r' <- readRawBuffer "readChunk" (fromIntegral fd) is_stream ptr
466 (fromIntegral off) (fromIntegral bytes)
467 let r = fromIntegral r'
469 then return (off - init_off)
470 else loop (off + r) (bytes - r)
472 -- ---------------------------------------------------------------------------
475 -- | Writes an array of 'Word8' to the specified 'Handle'.
477 :: Handle -- ^ Handle to write to
478 -> IOUArray Int Word8 -- ^ Array to write from
479 -> Int -- ^ Number of 'Word8's to write
482 hPutArray handle (IOUArray (STUArray l u raw)) count
483 | count <= 0 || count > rangeSize (l,u)
484 = illegalBufferSize handle "hPutArray" count
486 = do wantWritableHandle "hPutArray" handle $
487 \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=stream } -> do
489 old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }
492 -- enough room in handle buffer?
493 if (size - w > count)
494 -- There's enough room in the buffer:
495 -- just copy the data in and update bufWPtr.
496 then do memcpy_baoff_ba old_raw w raw (fromIntegral count)
497 writeIORef ref old_buf{ bufWPtr = w + count }
500 -- else, we have to flush
501 else do flushed_buf <- flushWriteBuffer fd stream old_buf
502 writeIORef ref flushed_buf
504 Buffer{ bufBuf=raw, bufState=WriteBuffer,
505 bufRPtr=0, bufWPtr=count, bufSize=count }
506 flushWriteBuffer fd stream this_buf
509 -- ---------------------------------------------------------------------------
512 foreign import ccall unsafe "__hscore_memcpy_dst_off"
513 memcpy_baoff_ba :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ())
514 foreign import ccall unsafe "__hscore_memcpy_src_off"
515 memcpy_ba_baoff :: RawBuffer -> RawBuffer -> Int -> CSize -> IO (Ptr ())
517 illegalBufferSize :: Handle -> String -> Int -> IO a
518 illegalBufferSize handle fn sz =
519 ioException (IOError (Just handle)
521 ("illegal buffer size " ++ showsPrec 9 (sz::Int) [])
524 #endif /* __GLASGOW_HASKELL__ */