X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FArray%2FIO.hs;h=0023a6a5adbdf5edac79f4a742b0103b2d187793;hb=052b9b84fff4bffabbd93d19cb17a2c6c6672128;hp=5644e5863a0b629f0b83dd361a61cc3b56cffa33;hpb=42824ad743d2a456539ecb15b5e756afb6ac90c2;p=ghc-base.git

diff --git a/Data/Array/IO.hs b/Data/Array/IO.hs
index 5644e58..0023a6a 100644
--- a/Data/Array/IO.hs
+++ b/Data/Array/IO.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS -#include "HsBase.h" #-}
+{-# OPTIONS_GHC -#include "HsBase.h" #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Array.IO
@@ -19,22 +19,19 @@ module Data.Array.IO (
 
    -- * @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
@@ -44,12 +41,14 @@ import Data.Word
 #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__
@@ -115,17 +114,6 @@ unsafeThawIOUArray arr = stToIO $ do
 "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
 
@@ -141,7 +129,9 @@ 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 $ 
@@ -164,7 +154,7 @@ hGetArray handle (IOUArray (STUArray l u ptr)) count
 		let remaining = count - copied
 		if remaining > 0 
 		   then do rest <- readChunk fd is_stream ptr copied remaining
-			   return (rest + count)
+			   return (rest + copied)
 		   else return count
 
 readChunk :: FD -> Bool -> RawBuffer -> Int -> Int -> IO Int
@@ -191,7 +181,9 @@ hPutArray
 	-> 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 $ 
@@ -232,4 +224,37 @@ 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
+  | count < 0 || count > rangeSize (bounds arr)
+  = illegalBufferSize handle "hGetArray" count
+  | otherwise = 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
+  | count < 0 || count > rangeSize (bounds arr)
+  = illegalBufferSize handle "hPutArray" count
+  | otherwise = 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__ */