-{-# OPTIONS -#include "HsBase.h" #-}
+{-# OPTIONS_GHC -#include "HsBase.h" #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Array.IO
--
-- Maintainer : libraries@haskell.org
-- Stability : experimental
--- Portability : non-portable
+-- Portability : non-portable (uses Data.Array.MArray)
--
-- Mutable boxed and unboxed arrays in the IO monad.
--
-- * @IO@ arrays with unboxed elements
IOUArray, -- instance of: Eq, Typeable
-#ifdef __GLASGOW_HASKELL__
castIOUArray, -- :: IOUArray i a -> IO (IOUArray i b)
-#endif
-- * Overloaded mutable array interface
module Data.Array.MArray,
-#ifdef __GLASGOW_HASKELL__
-- * Doing I\/O with @IOUArray@s
hGetArray, -- :: Handle -> IOUArray Int Word8 -> Int -> IO Int
hPutArray, -- :: Handle -> IOUArray Int Word8 -> Int -> IO ()
-#endif
) where
import Prelude
+import Data.Array.Base
import Data.Array.IO.Internals
import Data.Array ( Array )
import Data.Array.MArray
#ifdef __GLASGOW_HASKELL__
import Foreign
import Foreign.C
-import Data.Array.Base
import GHC.Arr
-import GHC.ST ( ST(..) )
import GHC.IOBase
import GHC.Handle
+#else
+import Data.Char
+import System.IO
+import System.IO.Error
#endif
#ifdef __GLASGOW_HASKELL__
"unsafeThaw/IOUArray" unsafeThaw = unsafeThawIOUArray
#-}
-castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)
-castSTUArray (STUArray l u marr#) = return (STUArray l u marr#)
-
--- | Casts an 'IOUArray' with one element type into one with a
--- different element type. All the elements of the resulting array
--- are undefined (unless you know what you\'re doing...).
-castIOUArray :: IOUArray ix a -> IO (IOUArray ix b)
-castIOUArray (IOUArray marr) = stToIO $ do
- marr' <- castSTUArray marr
- return (IOUArray marr')
-
-- ---------------------------------------------------------------------------
-- hGetArray
-- if the end of file was reached.
hGetArray handle (IOUArray (STUArray l u ptr)) count
- | count <= 0 || count > rangeSize (l,u)
+ | count == 0
+ = return 0
+ | count < 0 || count > rangeSize (l,u)
= illegalBufferSize handle "hGetArray" count
| otherwise = do
wantReadableHandle "hGetArray" handle $
let avail = w - r
copied <- if (count >= avail)
then do
- memcpy_ba_baoff ptr raw r (fromIntegral avail)
+ memcpy_ba_baoff ptr raw (fromIntegral r) (fromIntegral avail)
writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
return avail
else do
- memcpy_ba_baoff ptr raw r (fromIntegral count)
+ memcpy_ba_baoff ptr raw (fromIntegral r) (fromIntegral count)
writeIORef ref buf{ bufRPtr = r + count }
return count
-> IO ()
hPutArray handle (IOUArray (STUArray l u raw)) count
- | count <= 0 || count > rangeSize (l,u)
+ | count == 0
+ = return ()
+ | count < 0 || count > rangeSize (l,u)
= illegalBufferSize handle "hPutArray" count
| otherwise
= do wantWritableHandle "hPutArray" handle $
if (size - w > count)
-- There's enough room in the buffer:
-- just copy the data in and update bufWPtr.
- then do memcpy_baoff_ba old_raw w raw (fromIntegral count)
+ then do memcpy_baoff_ba old_raw (fromIntegral w) raw (fromIntegral count)
writeIORef ref old_buf{ bufWPtr = w + count }
return ()
-- Internal Utils
foreign import ccall unsafe "__hscore_memcpy_dst_off"
- memcpy_baoff_ba :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ())
+ memcpy_baoff_ba :: RawBuffer -> CInt -> RawBuffer -> CSize -> IO (Ptr ())
foreign import ccall unsafe "__hscore_memcpy_src_off"
- memcpy_ba_baoff :: RawBuffer -> RawBuffer -> Int -> CSize -> IO (Ptr ())
+ memcpy_ba_baoff :: RawBuffer -> RawBuffer -> CInt -> CSize -> IO (Ptr ())
illegalBufferSize :: Handle -> String -> Int -> IO a
illegalBufferSize handle fn sz =
("illegal buffer size " ++ showsPrec 9 (sz::Int) [])
Nothing)
-#endif /* __GLASGOW_HASKELL__ */
+#else /* !__GLASGOW_HASKELL__ */
+hGetArray :: Handle -> IOUArray Int Word8 -> Int -> IO Int
+hGetArray handle arr count = do
+ bds <- getBounds arr
+ if count < 0 || count > rangeSize bds
+ then illegalBufferSize handle "hGetArray" count
+ else get 0
+ where
+ get i | i == count = return i
+ | otherwise = do
+ error_or_c <- try (hGetChar handle)
+ case error_or_c of
+ Left ex
+ | isEOFError ex -> return i
+ | otherwise -> ioError ex
+ Right c -> do
+ unsafeWrite arr i (fromIntegral (ord c))
+ get (i+1)
+
+hPutArray :: Handle -> IOUArray Int Word8 -> Int -> IO ()
+hPutArray handle arr count = do
+ bds <- getBounds arr
+ if count < 0 || count > rangeSize bds
+ then illegalBufferSize handle "hPutArray" count
+ else put 0
+ where
+ put i | i == count = return ()
+ | otherwise = do
+ w <- unsafeRead arr i
+ hPutChar handle (chr (fromIntegral w))
+ put (i+1)
+
+illegalBufferSize :: Handle -> String -> Int -> IO a
+illegalBufferSize _ fn sz = ioError $
+ userError (fn ++ ": illegal buffer size " ++ showsPrec 9 (sz::Int) [])
+#endif /* !__GLASGOW_HASKELL__ */