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.IO.Internals
37 import Data.Array ( Array )
38 import Data.Array.MArray
42 #ifdef __GLASGOW_HASKELL__
45 import Data.Array.Base
52 #ifdef __GLASGOW_HASKELL__
53 -----------------------------------------------------------------------------
56 freezeIOArray :: Ix ix => IOArray ix e -> IO (Array ix e)
57 freezeIOArray (IOArray marr) = stToIO (freezeSTArray marr)
59 freezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)
60 freezeIOUArray (IOUArray marr) = stToIO (freezeSTUArray marr)
63 "freeze/IOArray" freeze = freezeIOArray
64 "freeze/IOUArray" freeze = freezeIOUArray
67 {-# INLINE unsafeFreezeIOArray #-}
68 unsafeFreezeIOArray :: Ix ix => IOArray ix e -> IO (Array ix e)
69 unsafeFreezeIOArray (IOArray marr) = stToIO (unsafeFreezeSTArray marr)
71 {-# INLINE unsafeFreezeIOUArray #-}
72 unsafeFreezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)
73 unsafeFreezeIOUArray (IOUArray marr) = stToIO (unsafeFreezeSTUArray marr)
76 "unsafeFreeze/IOArray" unsafeFreeze = unsafeFreezeIOArray
77 "unsafeFreeze/IOUArray" unsafeFreeze = unsafeFreezeIOUArray
80 -----------------------------------------------------------------------------
83 thawIOArray :: Ix ix => Array ix e -> IO (IOArray ix e)
84 thawIOArray arr = stToIO $ do
85 marr <- thawSTArray arr
88 thawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)
89 thawIOUArray arr = stToIO $ do
90 marr <- thawSTUArray arr
91 return (IOUArray marr)
94 "thaw/IOArray" thaw = thawIOArray
95 "thaw/IOUArray" thaw = thawIOUArray
98 {-# INLINE unsafeThawIOArray #-}
99 unsafeThawIOArray :: Ix ix => Array ix e -> IO (IOArray ix e)
100 unsafeThawIOArray arr = stToIO $ do
101 marr <- unsafeThawSTArray arr
102 return (IOArray marr)
104 {-# INLINE unsafeThawIOUArray #-}
105 unsafeThawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)
106 unsafeThawIOUArray arr = stToIO $ do
107 marr <- unsafeThawSTUArray arr
108 return (IOUArray marr)
111 "unsafeThaw/IOArray" unsafeThaw = unsafeThawIOArray
112 "unsafeThaw/IOUArray" unsafeThaw = unsafeThawIOUArray
115 -- ---------------------------------------------------------------------------
118 -- | Reads a number of 'Word8's from the specified 'Handle' directly
119 -- into an array (GHC only).
121 :: Handle -- ^ Handle to read from
122 -> IOUArray Int Word8 -- ^ Array in which to place the values
123 -> Int -- ^ Number of 'Word8's to read
125 -- ^ Returns: the number of 'Word8's actually
126 -- read, which might be smaller than the number requested
127 -- if the end of file was reached.
129 hGetArray handle (IOUArray (STUArray l u ptr)) count
132 | count < 0 || count > rangeSize (l,u)
133 = illegalBufferSize handle "hGetArray" count
135 wantReadableHandle "hGetArray" handle $
136 \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do
137 buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r } <- readIORef ref
139 then readChunk fd is_stream ptr 0 count
142 copied <- if (count >= avail)
144 memcpy_ba_baoff ptr raw r (fromIntegral avail)
145 writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
148 memcpy_ba_baoff ptr raw r (fromIntegral count)
149 writeIORef ref buf{ bufRPtr = r + count }
152 let remaining = count - copied
154 then do rest <- readChunk fd is_stream ptr copied remaining
155 return (rest + copied)
158 readChunk :: FD -> Bool -> RawBuffer -> Int -> Int -> IO Int
159 readChunk fd is_stream ptr init_off bytes = loop init_off bytes
161 loop :: Int -> Int -> IO Int
162 loop off bytes | bytes <= 0 = return (off - init_off)
164 r' <- readRawBuffer "readChunk" (fromIntegral fd) is_stream ptr
165 (fromIntegral off) (fromIntegral bytes)
166 let r = fromIntegral r'
168 then return (off - init_off)
169 else loop (off + r) (bytes - r)
171 -- ---------------------------------------------------------------------------
174 -- | Writes an array of 'Word8' to the specified 'Handle' (GHC only).
176 :: Handle -- ^ Handle to write to
177 -> IOUArray Int Word8 -- ^ Array to write from
178 -> Int -- ^ Number of 'Word8's to write
181 hPutArray handle (IOUArray (STUArray l u raw)) count
184 | count < 0 || count > rangeSize (l,u)
185 = illegalBufferSize handle "hPutArray" count
187 = do wantWritableHandle "hPutArray" handle $
188 \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=stream } -> do
190 old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }
193 -- enough room in handle buffer?
194 if (size - w > count)
195 -- There's enough room in the buffer:
196 -- just copy the data in and update bufWPtr.
197 then do memcpy_baoff_ba old_raw w raw (fromIntegral count)
198 writeIORef ref old_buf{ bufWPtr = w + count }
201 -- else, we have to flush
202 else do flushed_buf <- flushWriteBuffer fd stream old_buf
203 writeIORef ref flushed_buf
205 Buffer{ bufBuf=raw, bufState=WriteBuffer,
206 bufRPtr=0, bufWPtr=count, bufSize=count }
207 flushWriteBuffer fd stream this_buf
210 -- ---------------------------------------------------------------------------
213 foreign import ccall unsafe "__hscore_memcpy_dst_off"
214 memcpy_baoff_ba :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ())
215 foreign import ccall unsafe "__hscore_memcpy_src_off"
216 memcpy_ba_baoff :: RawBuffer -> RawBuffer -> Int -> CSize -> IO (Ptr ())
218 illegalBufferSize :: Handle -> String -> Int -> IO a
219 illegalBufferSize handle fn sz =
220 ioException (IOError (Just handle)
222 ("illegal buffer size " ++ showsPrec 9 (sz::Int) [])
225 #endif /* __GLASGOW_HASKELL__ */