1 {-# OPTIONS_GHC -#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.Base
35 import Data.Array.IO.Internals
36 import Data.Array ( Array )
37 import Data.Array.MArray
41 #ifdef __GLASGOW_HASKELL__
51 import System.IO.Error
54 #ifdef __GLASGOW_HASKELL__
55 -----------------------------------------------------------------------------
58 freezeIOArray :: Ix ix => IOArray ix e -> IO (Array ix e)
59 freezeIOArray (IOArray marr) = stToIO (freezeSTArray marr)
61 freezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)
62 freezeIOUArray (IOUArray marr) = stToIO (freezeSTUArray marr)
65 "freeze/IOArray" freeze = freezeIOArray
66 "freeze/IOUArray" freeze = freezeIOUArray
69 {-# INLINE unsafeFreezeIOArray #-}
70 unsafeFreezeIOArray :: Ix ix => IOArray ix e -> IO (Array ix e)
71 unsafeFreezeIOArray (IOArray marr) = stToIO (unsafeFreezeSTArray marr)
73 {-# INLINE unsafeFreezeIOUArray #-}
74 unsafeFreezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)
75 unsafeFreezeIOUArray (IOUArray marr) = stToIO (unsafeFreezeSTUArray marr)
78 "unsafeFreeze/IOArray" unsafeFreeze = unsafeFreezeIOArray
79 "unsafeFreeze/IOUArray" unsafeFreeze = unsafeFreezeIOUArray
82 -----------------------------------------------------------------------------
85 thawIOArray :: Ix ix => Array ix e -> IO (IOArray ix e)
86 thawIOArray arr = stToIO $ do
87 marr <- thawSTArray arr
90 thawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)
91 thawIOUArray arr = stToIO $ do
92 marr <- thawSTUArray arr
93 return (IOUArray marr)
96 "thaw/IOArray" thaw = thawIOArray
97 "thaw/IOUArray" thaw = thawIOUArray
100 {-# INLINE unsafeThawIOArray #-}
101 unsafeThawIOArray :: Ix ix => Array ix e -> IO (IOArray ix e)
102 unsafeThawIOArray arr = stToIO $ do
103 marr <- unsafeThawSTArray arr
104 return (IOArray marr)
106 {-# INLINE unsafeThawIOUArray #-}
107 unsafeThawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)
108 unsafeThawIOUArray arr = stToIO $ do
109 marr <- unsafeThawSTUArray arr
110 return (IOUArray marr)
113 "unsafeThaw/IOArray" unsafeThaw = unsafeThawIOArray
114 "unsafeThaw/IOUArray" unsafeThaw = unsafeThawIOUArray
117 -- ---------------------------------------------------------------------------
120 -- | Reads a number of 'Word8's from the specified 'Handle' directly
123 :: Handle -- ^ Handle to read from
124 -> IOUArray Int Word8 -- ^ Array in which to place the values
125 -> Int -- ^ Number of 'Word8's to read
127 -- ^ Returns: the number of 'Word8's actually
128 -- read, which might be smaller than the number requested
129 -- if the end of file was reached.
131 hGetArray handle (IOUArray (STUArray l u ptr)) count
134 | count < 0 || count > rangeSize (l,u)
135 = illegalBufferSize handle "hGetArray" count
137 wantReadableHandle "hGetArray" handle $
138 \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do
139 buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r } <- readIORef ref
141 then readChunk fd is_stream ptr 0 count
144 copied <- if (count >= avail)
146 memcpy_ba_baoff ptr raw r (fromIntegral avail)
147 writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
150 memcpy_ba_baoff ptr raw r (fromIntegral count)
151 writeIORef ref buf{ bufRPtr = r + count }
154 let remaining = count - copied
156 then do rest <- readChunk fd is_stream ptr copied remaining
157 return (rest + copied)
160 readChunk :: FD -> Bool -> RawBuffer -> Int -> Int -> IO Int
161 readChunk fd is_stream ptr init_off bytes = loop init_off bytes
163 loop :: Int -> Int -> IO Int
164 loop off bytes | bytes <= 0 = return (off - init_off)
166 r' <- readRawBuffer "readChunk" (fromIntegral fd) is_stream ptr
167 (fromIntegral off) (fromIntegral bytes)
168 let r = fromIntegral r'
170 then return (off - init_off)
171 else loop (off + r) (bytes - r)
173 -- ---------------------------------------------------------------------------
176 -- | Writes an array of 'Word8' to the specified 'Handle'.
178 :: Handle -- ^ Handle to write to
179 -> IOUArray Int Word8 -- ^ Array to write from
180 -> Int -- ^ Number of 'Word8's to write
183 hPutArray handle (IOUArray (STUArray l u raw)) count
186 | count < 0 || count > rangeSize (l,u)
187 = illegalBufferSize handle "hPutArray" count
189 = do wantWritableHandle "hPutArray" handle $
190 \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=stream } -> do
192 old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }
195 -- enough room in handle buffer?
196 if (size - w > count)
197 -- There's enough room in the buffer:
198 -- just copy the data in and update bufWPtr.
199 then do memcpy_baoff_ba old_raw w raw (fromIntegral count)
200 writeIORef ref old_buf{ bufWPtr = w + count }
203 -- else, we have to flush
204 else do flushed_buf <- flushWriteBuffer fd stream old_buf
205 writeIORef ref flushed_buf
207 Buffer{ bufBuf=raw, bufState=WriteBuffer,
208 bufRPtr=0, bufWPtr=count, bufSize=count }
209 flushWriteBuffer fd stream this_buf
212 -- ---------------------------------------------------------------------------
215 foreign import ccall unsafe "__hscore_memcpy_dst_off"
216 memcpy_baoff_ba :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ())
217 foreign import ccall unsafe "__hscore_memcpy_src_off"
218 memcpy_ba_baoff :: RawBuffer -> RawBuffer -> Int -> CSize -> IO (Ptr ())
220 illegalBufferSize :: Handle -> String -> Int -> IO a
221 illegalBufferSize handle fn sz =
222 ioException (IOError (Just handle)
224 ("illegal buffer size " ++ showsPrec 9 (sz::Int) [])
227 #else /* !__GLASGOW_HASKELL__ */
228 hGetArray :: Handle -> IOUArray Int Word8 -> Int -> IO Int
229 hGetArray handle arr count
230 | count < 0 || count > rangeSize (bounds arr)
231 = illegalBufferSize handle "hGetArray" count
234 get i | i == count = return i
236 error_or_c <- try (hGetChar handle)
239 | isEOFError ex -> return i
240 | otherwise -> ioError ex
242 unsafeWrite arr i (fromIntegral (ord c))
245 hPutArray :: Handle -> IOUArray Int Word8 -> Int -> IO ()
246 hPutArray handle arr count
247 | count < 0 || count > rangeSize (bounds arr)
248 = illegalBufferSize handle "hPutArray" count
251 put i | i == count = return ()
253 w <- unsafeRead arr i
254 hPutChar handle (chr (fromIntegral w))
257 illegalBufferSize :: Handle -> String -> Int -> IO a
258 illegalBufferSize _ fn sz = ioError $
259 userError (fn ++ ": illegal buffer size " ++ showsPrec 9 (sz::Int) [])
260 #endif /* !__GLASGOW_HASKELL__ */