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
48 import GHC.ST ( ST(..) )
53 #ifdef __GLASGOW_HASKELL__
54 -----------------------------------------------------------------------------
57 freezeIOArray :: Ix ix => IOArray ix e -> IO (Array ix e)
58 freezeIOArray (IOArray marr) = stToIO (freezeSTArray marr)
60 freezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)
61 freezeIOUArray (IOUArray marr) = stToIO (freezeSTUArray marr)
64 "freeze/IOArray" freeze = freezeIOArray
65 "freeze/IOUArray" freeze = freezeIOUArray
68 {-# INLINE unsafeFreezeIOArray #-}
69 unsafeFreezeIOArray :: Ix ix => IOArray ix e -> IO (Array ix e)
70 unsafeFreezeIOArray (IOArray marr) = stToIO (unsafeFreezeSTArray marr)
72 {-# INLINE unsafeFreezeIOUArray #-}
73 unsafeFreezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)
74 unsafeFreezeIOUArray (IOUArray marr) = stToIO (unsafeFreezeSTUArray marr)
77 "unsafeFreeze/IOArray" unsafeFreeze = unsafeFreezeIOArray
78 "unsafeFreeze/IOUArray" unsafeFreeze = unsafeFreezeIOUArray
81 -----------------------------------------------------------------------------
84 thawIOArray :: Ix ix => Array ix e -> IO (IOArray ix e)
85 thawIOArray arr = stToIO $ do
86 marr <- thawSTArray arr
89 thawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)
90 thawIOUArray arr = stToIO $ do
91 marr <- thawSTUArray arr
92 return (IOUArray marr)
95 "thaw/IOArray" thaw = thawIOArray
96 "thaw/IOUArray" thaw = thawIOUArray
99 {-# INLINE unsafeThawIOArray #-}
100 unsafeThawIOArray :: Ix ix => Array ix e -> IO (IOArray ix e)
101 unsafeThawIOArray arr = stToIO $ do
102 marr <- unsafeThawSTArray arr
103 return (IOArray marr)
105 {-# INLINE unsafeThawIOUArray #-}
106 unsafeThawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)
107 unsafeThawIOUArray arr = stToIO $ do
108 marr <- unsafeThawSTUArray arr
109 return (IOUArray marr)
112 "unsafeThaw/IOArray" unsafeThaw = unsafeThawIOArray
113 "unsafeThaw/IOUArray" unsafeThaw = unsafeThawIOUArray
116 castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)
117 castSTUArray (STUArray l u marr#) = return (STUArray l u marr#)
119 -- | Casts an 'IOUArray' with one element type into one with a
120 -- different element type. All the elements of the resulting array
121 -- are undefined (unless you know what you\'re doing...).
122 castIOUArray :: IOUArray ix a -> IO (IOUArray ix b)
123 castIOUArray (IOUArray marr) = stToIO $ do
124 marr' <- castSTUArray marr
125 return (IOUArray marr')
127 -- ---------------------------------------------------------------------------
130 -- | Reads a number of 'Word8's from the specified 'Handle' directly
133 :: Handle -- ^ Handle to read from
134 -> IOUArray Int Word8 -- ^ Array in which to place the values
135 -> Int -- ^ Number of 'Word8's to read
137 -- ^ Returns: the number of 'Word8's actually
138 -- read, which might be smaller than the number requested
139 -- if the end of file was reached.
141 hGetArray handle (IOUArray (STUArray l u ptr)) count
142 | count <= 0 || count > rangeSize (l,u)
143 = illegalBufferSize handle "hGetArray" count
145 wantReadableHandle "hGetArray" handle $
146 \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do
147 buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r } <- readIORef ref
149 then readChunk fd is_stream ptr 0 count
152 copied <- if (count >= avail)
154 memcpy_ba_baoff ptr raw r (fromIntegral avail)
155 writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
158 memcpy_ba_baoff ptr raw r (fromIntegral count)
159 writeIORef ref buf{ bufRPtr = r + count }
162 let remaining = count - copied
164 then do rest <- readChunk fd is_stream ptr copied remaining
165 return (rest + count)
168 readChunk :: FD -> Bool -> RawBuffer -> Int -> Int -> IO Int
169 readChunk fd is_stream ptr init_off bytes = loop init_off bytes
171 loop :: Int -> Int -> IO Int
172 loop off bytes | bytes <= 0 = return (off - init_off)
174 r' <- readRawBuffer "readChunk" (fromIntegral fd) is_stream ptr
175 (fromIntegral off) (fromIntegral bytes)
176 let r = fromIntegral r'
178 then return (off - init_off)
179 else loop (off + r) (bytes - r)
181 -- ---------------------------------------------------------------------------
184 -- | Writes an array of 'Word8' to the specified 'Handle'.
186 :: Handle -- ^ Handle to write to
187 -> IOUArray Int Word8 -- ^ Array to write from
188 -> Int -- ^ Number of 'Word8's to write
191 hPutArray handle (IOUArray (STUArray l u raw)) count
192 | count <= 0 || count > rangeSize (l,u)
193 = illegalBufferSize handle "hPutArray" count
195 = do wantWritableHandle "hPutArray" handle $
196 \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=stream } -> do
198 old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }
201 -- enough room in handle buffer?
202 if (size - w > count)
203 -- There's enough room in the buffer:
204 -- just copy the data in and update bufWPtr.
205 then do memcpy_baoff_ba old_raw w raw (fromIntegral count)
206 writeIORef ref old_buf{ bufWPtr = w + count }
209 -- else, we have to flush
210 else do flushed_buf <- flushWriteBuffer fd stream old_buf
211 writeIORef ref flushed_buf
213 Buffer{ bufBuf=raw, bufState=WriteBuffer,
214 bufRPtr=0, bufWPtr=count, bufSize=count }
215 flushWriteBuffer fd stream this_buf
218 -- ---------------------------------------------------------------------------
221 foreign import ccall unsafe "__hscore_memcpy_dst_off"
222 memcpy_baoff_ba :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ())
223 foreign import ccall unsafe "__hscore_memcpy_src_off"
224 memcpy_ba_baoff :: RawBuffer -> RawBuffer -> Int -> CSize -> IO (Ptr ())
226 illegalBufferSize :: Handle -> String -> Int -> IO a
227 illegalBufferSize handle fn sz =
228 ioException (IOError (Just handle)
230 ("illegal buffer size " ++ showsPrec 9 (sz::Int) [])
233 #endif /* __GLASGOW_HASKELL__ */