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 #ifdef __GLASGOW_HASKELL__
23 castIOUArray, -- :: IOUArray i a -> IO (IOUArray i b)
26 -- * Overloaded mutable array interface
27 module Data.Array.MArray,
29 #ifdef __GLASGOW_HASKELL__
30 -- * Doing I\/O with @IOUArray@s
31 hGetArray, -- :: Handle -> IOUArray Int Word8 -> Int -> IO Int
32 hPutArray, -- :: Handle -> IOUArray Int Word8 -> Int -> IO ()
38 import Data.Array.IO.Internals
39 import Data.Array ( Array )
40 import Data.Array.MArray
44 #ifdef __GLASGOW_HASKELL__
47 import Data.Array.Base
50 import GHC.ST ( ST(..) )
55 #ifdef __GLASGOW_HASKELL__
56 -----------------------------------------------------------------------------
59 freezeIOArray :: Ix ix => IOArray ix e -> IO (Array ix e)
60 freezeIOArray (IOArray marr) = stToIO (freezeSTArray marr)
62 freezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)
63 freezeIOUArray (IOUArray marr) = stToIO (freezeSTUArray marr)
66 "freeze/IOArray" freeze = freezeIOArray
67 "freeze/IOUArray" freeze = freezeIOUArray
70 {-# INLINE unsafeFreezeIOArray #-}
71 unsafeFreezeIOArray :: Ix ix => IOArray ix e -> IO (Array ix e)
72 unsafeFreezeIOArray (IOArray marr) = stToIO (unsafeFreezeSTArray marr)
74 {-# INLINE unsafeFreezeIOUArray #-}
75 unsafeFreezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)
76 unsafeFreezeIOUArray (IOUArray marr) = stToIO (unsafeFreezeSTUArray marr)
79 "unsafeFreeze/IOArray" unsafeFreeze = unsafeFreezeIOArray
80 "unsafeFreeze/IOUArray" unsafeFreeze = unsafeFreezeIOUArray
83 -----------------------------------------------------------------------------
86 thawIOArray :: Ix ix => Array ix e -> IO (IOArray ix e)
87 thawIOArray arr = stToIO $ do
88 marr <- thawSTArray arr
91 thawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)
92 thawIOUArray arr = stToIO $ do
93 marr <- thawSTUArray arr
94 return (IOUArray marr)
97 "thaw/IOArray" thaw = thawIOArray
98 "thaw/IOUArray" thaw = thawIOUArray
101 {-# INLINE unsafeThawIOArray #-}
102 unsafeThawIOArray :: Ix ix => Array ix e -> IO (IOArray ix e)
103 unsafeThawIOArray arr = stToIO $ do
104 marr <- unsafeThawSTArray arr
105 return (IOArray marr)
107 {-# INLINE unsafeThawIOUArray #-}
108 unsafeThawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)
109 unsafeThawIOUArray arr = stToIO $ do
110 marr <- unsafeThawSTUArray arr
111 return (IOUArray marr)
114 "unsafeThaw/IOArray" unsafeThaw = unsafeThawIOArray
115 "unsafeThaw/IOUArray" unsafeThaw = unsafeThawIOUArray
118 castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)
119 castSTUArray (STUArray l u marr#) = return (STUArray l u marr#)
121 -- | Casts an 'IOUArray' with one element type into one with a
122 -- different element type. All the elements of the resulting array
123 -- are undefined (unless you know what you\'re doing...).
124 castIOUArray :: IOUArray ix a -> IO (IOUArray ix b)
125 castIOUArray (IOUArray marr) = stToIO $ do
126 marr' <- castSTUArray marr
127 return (IOUArray marr')
129 -- ---------------------------------------------------------------------------
132 -- | Reads a number of 'Word8's from the specified 'Handle' directly
135 :: Handle -- ^ Handle to read from
136 -> IOUArray Int Word8 -- ^ Array in which to place the values
137 -> Int -- ^ Number of 'Word8's to read
139 -- ^ Returns: the number of 'Word8's actually
140 -- read, which might be smaller than the number requested
141 -- if the end of file was reached.
143 hGetArray handle (IOUArray (STUArray l u ptr)) count
146 | count < 0 || count > rangeSize (l,u)
147 = illegalBufferSize handle "hGetArray" count
149 wantReadableHandle "hGetArray" handle $
150 \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do
151 buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r } <- readIORef ref
153 then readChunk fd is_stream ptr 0 count
156 copied <- if (count >= avail)
158 memcpy_ba_baoff ptr raw r (fromIntegral avail)
159 writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
162 memcpy_ba_baoff ptr raw r (fromIntegral count)
163 writeIORef ref buf{ bufRPtr = r + count }
166 let remaining = count - copied
168 then do rest <- readChunk fd is_stream ptr copied remaining
169 return (rest + copied)
172 readChunk :: FD -> Bool -> RawBuffer -> Int -> Int -> IO Int
173 readChunk fd is_stream ptr init_off bytes = loop init_off bytes
175 loop :: Int -> Int -> IO Int
176 loop off bytes | bytes <= 0 = return (off - init_off)
178 r' <- readRawBuffer "readChunk" (fromIntegral fd) is_stream ptr
179 (fromIntegral off) (fromIntegral bytes)
180 let r = fromIntegral r'
182 then return (off - init_off)
183 else loop (off + r) (bytes - r)
185 -- ---------------------------------------------------------------------------
188 -- | Writes an array of 'Word8' to the specified 'Handle'.
190 :: Handle -- ^ Handle to write to
191 -> IOUArray Int Word8 -- ^ Array to write from
192 -> Int -- ^ Number of 'Word8's to write
195 hPutArray handle (IOUArray (STUArray l u raw)) count
198 | count < 0 || count > rangeSize (l,u)
199 = illegalBufferSize handle "hPutArray" count
201 = do wantWritableHandle "hPutArray" handle $
202 \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=stream } -> do
204 old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }
207 -- enough room in handle buffer?
208 if (size - w > count)
209 -- There's enough room in the buffer:
210 -- just copy the data in and update bufWPtr.
211 then do memcpy_baoff_ba old_raw w raw (fromIntegral count)
212 writeIORef ref old_buf{ bufWPtr = w + count }
215 -- else, we have to flush
216 else do flushed_buf <- flushWriteBuffer fd stream old_buf
217 writeIORef ref flushed_buf
219 Buffer{ bufBuf=raw, bufState=WriteBuffer,
220 bufRPtr=0, bufWPtr=count, bufSize=count }
221 flushWriteBuffer fd stream this_buf
224 -- ---------------------------------------------------------------------------
227 foreign import ccall unsafe "__hscore_memcpy_dst_off"
228 memcpy_baoff_ba :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ())
229 foreign import ccall unsafe "__hscore_memcpy_src_off"
230 memcpy_ba_baoff :: RawBuffer -> RawBuffer -> Int -> CSize -> IO (Ptr ())
232 illegalBufferSize :: Handle -> String -> Int -> IO a
233 illegalBufferSize handle fn sz =
234 ioException (IOError (Just handle)
236 ("illegal buffer size " ++ showsPrec 9 (sz::Int) [])
239 #endif /* __GLASGOW_HASKELL__ */