From: simonmar <unknown>
Date: Fri, 14 Sep 2001 11:25:24 +0000 (+0000)
Subject: [project @ 2001-09-14 11:25:23 by simonmar]
X-Git-Tag: nhc98-1-18-release~1162
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=738fe4d596718c8fc9e2be60dee0ff59295275f4;p=haskell-directory.git

[project @ 2001-09-14 11:25:23 by simonmar]
- replace PackedString implementation with one based on UArray.  It hasn't
  been tuned for performance yet, and it seems that not enough fusion is
  happening yet, but in theory it should be nearly as fast as the old
  implementation (modulo the fact that the new packed string representation
  used 32-bit chars vs. 8-bit chars in the old implementation).

- remove hPutBufBA and hGetBufBA from GHC.IO.

- add new functions hPutArray and hGetArray to Data.Array.IO, to directly
  read/write arrays of bytes.  These are behind the implementations of
  hGetPS & hPutPS in the new PackedString.

- finally, remove the last vestiges of ByteArray and MutableByteArray
  from the core libraries.  Deprecated implementations will be available
  in the lang compatibility package.

- move the inline functions from GHC.Handle into HsCore.h, and declare
  them as 'extern inline'.
---

diff --git a/Data/Array/IO.hs b/Data/Array/IO.hs
index 9e7892e..c9eef9f 100644
--- a/Data/Array/IO.hs
+++ b/Data/Array/IO.hs
@@ -8,7 +8,7 @@
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
--- $Id: IO.hs,v 1.1 2001/06/28 14:15:02 simonmar Exp $
+-- $Id: IO.hs,v 1.2 2001/09/14 11:25:23 simonmar Exp $
 --
 -- Mutable boxed/unboxed arrays in the IO monad.
 --
@@ -19,6 +19,8 @@ module Data.Array.IO (
    IOArray,		-- instance of: Eq, Typeable
    IOUArray,		-- instance of: Eq, Typeable
    castIOUArray,	-- :: IOUArray i a -> IO (IOUArray i b)
+   hGetArray,		-- :: Handle -> IOUArray Int Word8 -> Int -> IO Int
+   hPutArray,		-- :: Handle -> IOUArray Int Word8 -> Int -> IO ()
  ) where
 
 import Prelude
@@ -29,6 +31,7 @@ import Data.Int
 import Data.Word
 import Data.Dynamic
 
+import Foreign.C
 import Foreign.Ptr		( Ptr, FunPtr )
 import Foreign.StablePtr	( StablePtr )
 
@@ -40,7 +43,10 @@ import GHC.Arr    	( STArray, freezeSTArray, unsafeFreezeSTArray,
                           thawSTArray, unsafeThawSTArray )
 
 import GHC.ST		( ST(..) )
-import GHC.IOBase	( stToIO )
+
+import GHC.IOBase
+import GHC.Handle
+import GHC.Conc
 
 import GHC.Base
 
@@ -362,4 +368,104 @@ castIOUArray (IOUArray marr) = stToIO $ do
     marr' <- castSTUArray marr
     return (IOUArray marr')
 
+-- ---------------------------------------------------------------------------
+-- hGetArray
+
+hGetArray :: Handle -> IOUArray Int Word8 -> Int -> IO Int
+hGetArray handle (IOUArray (STUArray l u ptr)) count
+  | count <= 0 || count > rangeSize (l,u)
+  = illegalBufferSize handle "hGetArray" count
+  | otherwise = do
+      wantReadableHandle "hGetArray" handle $ 
+	\ handle_@Handle__{ haFD=fd, haBuffer=ref } -> do
+	buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r } <- readIORef ref
+	if bufferEmpty buf
+	   then readChunkBA fd ptr 0 count
+	   else do 
+		let avail = w - r
+		copied <- if (count >= avail)
+		       	    then do 
+				memcpy_ba_baoff ptr raw r (fromIntegral avail)
+				writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
+				return avail
+		     	    else do 
+				memcpy_ba_baoff ptr raw r (fromIntegral count)
+				writeIORef ref buf{ bufRPtr = r + count }
+				return count
+
+		let remaining = count - copied
+		if remaining > 0 
+		   then do rest <- readChunkBA fd ptr copied remaining
+			   return (rest + count)
+		   else return count
+		
+readChunkBA :: FD -> RawBuffer -> Int -> Int -> IO Int
+readChunkBA fd ptr init_off bytes = loop init_off bytes 
+ where
+  loop :: Int -> Int -> IO Int
+  loop off bytes | bytes <= 0 = return (off - init_off)
+  loop off bytes = do
+    r' <- throwErrnoIfMinus1RetryMayBlock "readChunk"
+	    (readBA (fromIntegral fd) ptr 
+		(fromIntegral off) (fromIntegral bytes))
+	    (threadWaitRead fd)
+    let r = fromIntegral r'
+    if r == 0
+	then return (off - init_off)
+	else loop (off + r) (bytes - r)
+
+foreign import "read_ba_wrap" unsafe
+   readBA :: FD -> RawBuffer -> Int -> CInt -> IO CInt
+
+ -----------------------------------------------------------------------------
+-- hPutArray
+
+hPutArray
+	:: Handle			-- handle to write to
+	-> IOUArray Int Word8		-- buffer
+	-> Int				-- number of bytes of data to write
+	-> IO ()
+
+hPutArray handle (IOUArray (STUArray l u raw)) count
+  | count <= 0 || count > rangeSize (l,u)
+  = illegalBufferSize handle "hPutArray" count
+  | otherwise
+   = do wantWritableHandle "hPutArray" handle $ 
+          \ handle_@Handle__{ haFD=fd, haBuffer=ref } -> do
+
+          old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }
+	    <- readIORef ref
+
+          -- enough room in handle buffer?
+          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)
+		    writeIORef ref old_buf{ bufWPtr = w + count }
+		    return ()
+
+		-- else, we have to flush
+	    else do flushed_buf <- flushWriteBuffer fd old_buf
+		    writeIORef ref flushed_buf
+		    let this_buf = 
+			    Buffer{ bufBuf=raw, bufState=WriteBuffer, 
+				    bufRPtr=0, bufWPtr=count, bufSize=count }
+		    flushWriteBuffer fd this_buf
+		    return ()
+
+-----------------------------------------------------------------------------
+-- Internal Utils
+
+foreign import "memcpy_wrap_dst_off" unsafe 
+   memcpy_baoff_ba :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ())
+foreign import "memcpy_wrap_src_off" unsafe 
+   memcpy_ba_baoff :: RawBuffer -> RawBuffer -> Int -> CSize -> IO (Ptr ())
+
+illegalBufferSize :: Handle -> String -> Int -> IO a
+illegalBufferSize handle fn (sz :: Int) = 
+	ioException (IOError (Just handle)
+			    InvalidArgument  fn
+			    ("illegal buffer size " ++ showsPrec 9 sz [])
+			    Nothing)
+
 #endif /* __GLASGOW_HASKELL__ */
diff --git a/Data/PackedString.hs b/Data/PackedString.hs
index 8feb2a8..2a315a2 100644
--- a/Data/PackedString.hs
+++ b/Data/PackedString.hs
@@ -1,4 +1,3 @@
-{-# OPTIONS -#include "PackedString.h" #-}
 -----------------------------------------------------------------------------
 -- 
 -- Module      :  Data.PackedString
@@ -9,10 +8,12 @@
 -- Stability   :  experimental
 -- Portability :  portable
 --
--- $Id: PackedString.hs,v 1.2 2001/07/03 11:37:50 simonmar Exp $
+-- $Id: PackedString.hs,v 1.3 2001/09/14 11:25:23 simonmar Exp $
 --
 -- The PackedString type, and associated operations.
--- GHC implementation by Bryan O'Sullivan.
+--
+-- Original GHC implementation by Bryan O'Sullivan, 
+-- rewritten to use UArray by Simon Marlow.
 --
 -----------------------------------------------------------------------------
 
@@ -20,21 +21,8 @@ module Data.PackedString (
         PackedString,      -- abstract, instances: Eq, Ord, Show, Typeable
 
          -- Creating the beasts
-	packString,          -- :: [Char] -> PackedString
-	packStringST,        -- :: [Char] -> ST s PackedString
-        packCBytesST,        -- :: Int -> Ptr a -> ST s PackedString
-
-	byteArrayToPS,       -- :: ByteArray Int -> PackedString
-	cByteArrayToPS,	     -- :: ByteArray Int -> PackedString
-	unsafeByteArrayToPS, -- :: ByteArray a   -> Int -> PackedString
-
-	psToByteArray,       -- :: PackedString  -> ByteArray Int
-	psToCString,	     -- :: PackedString  -> Ptr a
-        isCString,	     -- :: PackedString  -> Bool
-
-	unpackPS,        -- :: PackedString -> [Char]
-	unpackNBytesPS,  -- :: PackedString -> Int -> [Char]
-	unpackPSIO,      -- :: PackedString -> IO [Char]
+	packString,  -- :: [Char] -> PackedString
+	unpackPS,    -- :: PackedString -> [Char]
 
 	hPutPS,      -- :: Handle -> PackedString -> IO ()
 	hGetPS,      -- :: Handle -> Int -> IO PackedString
@@ -46,15 +34,19 @@ module Data.PackedString (
 	nullPS,      -- :: PackedString -> Bool
 	appendPS,    -- :: PackedString -> PackedString -> PackedString
 	lengthPS,    -- :: PackedString -> Int
-          {- 0-origin indexing into the string -}
 	indexPS,     -- :: PackedString -> Int -> Char
 	mapPS,       -- :: (Char -> Char) -> PackedString -> PackedString
 	filterPS,    -- :: (Char -> Bool) -> PackedString -> PackedString
-	foldlPS,     -- :: (a -> Char -> a) -> a -> PackedString -> a
-	foldrPS,     -- :: (Char -> a -> a) -> a -> PackedString -> a
+	reversePS,   -- :: PackedString -> PackedString
+	concatPS,    -- :: [PackedString] -> PackedString
+	elemPS,      -- :: Char -> PackedString -> Bool
+	substrPS,    -- :: PackedString -> Int -> Int -> PackedString
 	takePS,      -- :: Int -> PackedString -> PackedString
 	dropPS,      -- :: Int -> PackedString -> PackedString
 	splitAtPS,   -- :: Int -> PackedString -> (PackedString, PackedString)
+
+	foldlPS,     -- :: (a -> Char -> a) -> a -> PackedString -> a
+	foldrPS,     -- :: (Char -> a -> a) -> a -> PackedString -> a
 	takeWhilePS, -- :: (Char -> Bool) -> PackedString -> PackedString
 	dropWhilePS, -- :: (Char -> Bool) -> PackedString -> PackedString
 	spanPS,      -- :: (Char -> Bool) -> PackedString -> (PackedString, PackedString)
@@ -62,428 +54,86 @@ module Data.PackedString (
 	linesPS,     -- :: PackedString -> [PackedString]
 
 	wordsPS,     -- :: PackedString -> [PackedString]
-	reversePS,   -- :: PackedString -> PackedString
 	splitPS,     -- :: Char -> PackedString -> [PackedString]
 	splitWithPS, -- :: (Char -> Bool) -> PackedString -> [PackedString]
-	joinPS,      -- :: PackedString -> [PackedString] -> PackedString
-	concatPS,    -- :: [PackedString] -> PackedString
-	elemPS,      -- :: Char -> PackedString -> Bool
-
-	 {-
-           Pluck out a piece of a PS start and end
-	   chars you want; both 0-origin-specified
-         -}
-	substrPS,    -- :: PackedString -> Int -> Int -> PackedString
 
-	comparePS    -- :: PackedString -> PackedString -> Ordering
+--	joinPS,      -- :: PackedString -> [PackedString] -> PackedString
 
     ) where
 
 import Prelude
 
-import Foreign
-import Foreign.C
-
-import GHC.Prim
-import GHC.Base
-import GHC.ST
-import GHC.ByteArr
-
-import GHC.Show		( showList__  ) -- ToDo: better
-import GHC.Pack 	( new_ps_array,  freeze_ps_array,  write_ps_array )
-
-import Control.Monad.ST
+import Data.Array.Unboxed
+import Data.Array.IO
+import Data.Dynamic
+import Data.Char
 
 import System.IO
-import System.IO.Unsafe	( unsafePerformIO )
-import GHC.IO		( hPutBufBA, hGetBufBA )
-
-import Data.Ix
-import Data.Char	( isSpace )
-import Data.Dynamic
 
 -- -----------------------------------------------------------------------------
 -- PackedString type declaration
 
-data PackedString
-  = PS	ByteArray#  -- the bytes
-	Int#	    -- length (*not* including NUL at the end)
-	Bool	    -- True <=> contains a NUL
-  | CPS	Addr#	    -- pointer to the (null-terminated) bytes in C land
-	Int#	    -- length, as per strlen
-		    -- definitely doesn't contain a NUL
+newtype PackedString = PS (UArray Int Char)
 
 instance Eq PackedString where
-    x == y  = compare x y == EQ
-    x /= y  = compare x y /= EQ
+   (PS x) == (PS y)  =  x == y
 
 instance Ord PackedString where
-    compare = comparePS
-    x <= y  = compare x y /= GT
-    x <	 y  = compare x y == LT
-    x >= y  = compare x y /= LT
-    x >	 y  = compare x y == GT
-    max x y = case (compare x y) of { LT -> y ; EQ -> x ; GT -> x }
-    min x y = case (compare x y) of { LT -> x ; EQ -> x ; GT -> y }
+    compare (PS x) (PS y) = compare x y
 
 --instance Read PackedString: ToDo
 
 instance Show PackedString where
     showsPrec p ps r = showsPrec p (unpackPS ps) r
-    showList = showList__ (showsPrec 0) 
 
 #include "Dynamic.h"
 INSTANCE_TYPEABLE0(PackedString,packedStringTc,"PackedString")
 
 -- -----------------------------------------------------------------------------
--- PackedString instances
-
--- We try hard to make this go fast:
-
-comparePS :: PackedString -> PackedString -> Ordering
-
-comparePS (PS  bs1 len1 has_null1) (PS  bs2 len2 has_null2)
-  | not has_null1 && not has_null2
-  = unsafePerformIO (
-    _ccall_ strcmp ba1 ba2  >>= \ (I# res) ->
-    return (
-    if      res <#  0# then LT
-    else if res ==# 0# then EQ
-    else		    GT
-    ))
-  where
-    ba1 = ByteArray 0 (I# (len1 -# 1#)) bs1
-    ba2 = ByteArray 0 (I# (len2 -# 1#)) bs2
-
-comparePS (PS  bs1 len1 has_null1) (CPS bs2 _)
-  | not has_null1
-  = unsafePerformIO (
-    _ccall_ strcmp ba1 ba2  >>= \ (I# res) ->
-    return (
-    if      res <#  0# then LT
-    else if res ==# 0# then EQ
-    else		    GT
-    ))
-  where
-    ba1 = ByteArray 0 (I# (len1 -# 1#)) bs1
-    ba2 = Ptr bs2
-
-comparePS (CPS bs1 len1) (CPS bs2 _)
-  = unsafePerformIO (
-    _ccall_ strcmp ba1 ba2  >>= \ (I# res) ->
-    return (
-    if      res <#  0# then LT
-    else if res ==# 0# then EQ
-    else		    GT
-    ))
-  where
-    ba1 = Ptr bs1
-    ba2 = Ptr bs2
-
-comparePS a@(CPS _ _) b@(PS _ _ has_null2)
-  | not has_null2
-  = -- try them the other way 'round
-    case (comparePS b a) of { LT -> GT; EQ -> EQ; GT -> LT }
-
-comparePS ps1 ps2 -- slow catch-all case (esp for "has_null" True)
-  = looking_at 0#
-  where
-    end1 = lengthPS# ps1 -# 1#
-    end2 = lengthPS# ps2 -# 1#
-
-    looking_at char#
-      = if char# ># end1 then
-	   if char# ># end2 then -- both strings ran out at once
-	      EQ
-	   else	-- ps1 ran out before ps2
-	      LT
-	else if char# ># end2 then
-	   GT	-- ps2 ran out before ps1
-	else
-	   let
-	      ch1 = indexPS# ps1 char#
-	      ch2 = indexPS# ps2 char#
-	   in
-	   if ch1 `eqChar#` ch2 then
-	      looking_at (char# +# 1#)
-	   else if ch1 `ltChar#` ch2 then LT
-				     else GT
-
-
--- -----------------------------------------------------------------------------
 -- Constructor functions
 
--- Easy ones first.  @packString@ requires getting some heap-bytes and
--- scribbling stuff into them.
-
 nilPS :: PackedString
-nilPS = CPS ""# 0#
+nilPS = PS (array (0,-1) [])
 
 consPS :: Char -> PackedString -> PackedString
 consPS c cs = packString (c : (unpackPS cs)) -- ToDo:better
 
 packString :: [Char] -> PackedString
-packString str = runST (packStringST str)
-
-packStringST :: [Char] -> ST s PackedString
-packStringST str =
-  let len = length str  in
-  packNCharsST len str
-
-packNCharsST :: Int -> [Char] -> ST s PackedString
-packNCharsST (I# length#) str =
-  {- 
-   allocate an array that will hold the string
-   (not forgetting the NUL byte at the end)
-  -}
- new_ps_array (length# +# 1#) >>= \ ch_array ->
-   -- fill in packed string from "str"
- fill_in ch_array 0# str   >>
-   -- freeze the puppy:
- freeze_ps_array ch_array length# >>= \ (ByteArray _ _ frozen#) ->
- let has_null = byteArrayHasNUL# frozen# length# in
- return (PS frozen# length# has_null)
- where
-  fill_in :: MutableByteArray s Int -> Int# -> [Char] -> ST s ()
-  fill_in arr_in# idx [] =
-   write_ps_array arr_in# idx (chr# 0#) >>
-   return ()
-
-  fill_in arr_in# idx (C# c : cs) =
-   write_ps_array arr_in# idx c	 >>
-   fill_in arr_in# (idx +# 1#) cs
-
-byteArrayToPS :: ByteArray Int -> PackedString
-byteArrayToPS (ByteArray l u frozen#) =
- let
-  ixs = (l,u)
-  n# = 
-   case (
-	 if null (range ixs)
-	  then 0
-	  else ((index ixs u) + 1)
-        ) of { I# x -> x }
- in
- PS frozen# n# (byteArrayHasNUL# frozen# n#)
-
--- byteArray is zero-terminated, make everything upto it
--- a packed string.
-cByteArrayToPS :: ByteArray Int -> PackedString
-cByteArrayToPS (ByteArray l u frozen#) =
- let
-  ixs = (l,u)
-  n# = 
-   case (
-	 if null (range ixs)
-	  then 0
-	  else ((index ixs u) + 1)
-        ) of { I# x -> x }
-  len# = findNull 0#
-
-  findNull i#
-     | i# ==# n#	   = n#
-     | ch# `eqChar#` '\0'# = i# -- everything upto the sentinel
-     | otherwise	   = findNull (i# +# 1#)
-    where
-     ch#  = indexCharArray# frozen# i#
- in
- PS frozen# len# False
-
-unsafeByteArrayToPS :: ByteArray a -> Int -> PackedString
-unsafeByteArrayToPS (ByteArray _ _ frozen#) (I# n#)
-  = PS frozen# n# (byteArrayHasNUL# frozen# n#)
-
-psToByteArray	 :: PackedString -> ByteArray Int
-psToByteArray (PS bytes n _) = ByteArray 0 (I# (n -# 1#)) bytes
-
-psToByteArray (CPS addr len#)
-  = let
-	len		= I# len#
-	byte_array_form = packCBytes len (Ptr addr)
-    in
-    case byte_array_form of { PS bytes _ _ ->
-    ByteArray 0 (len - 1) bytes }
-
--- isCString is useful when passing PackedStrings to the
--- outside world, and need to figure out whether you can
--- pass it as an Addr or ByteArray.
---
-isCString :: PackedString -> Bool
-isCString (CPS _ _ ) = True
-isCString _	     = False
-
--- psToCString doesn't add a zero terminator!
--- this doesn't appear to be very useful --SDM
-psToCString :: PackedString -> Ptr a
-psToCString (CPS addr _)    = (Ptr addr)
-psToCString (PS bytes l# _) = 
-  unsafePerformIO $ do
-    stuff <- mallocBytes (I# (l# +# 1#))
-    let
-     fill_in n# i#
-      | n# ==# 0# = return ()
-      | otherwise = do
-         let ch#  = indexCharArray# bytes i#
-         pokeByteOff stuff (I# i#) (castCharToCChar (C# ch#))
-         fill_in (n# -# 1#) (i# +# 1#)
-    fill_in l# 0#
-    pokeByteOff stuff (I# l#) (C# '\0'#)
-    return stuff    
+packString str = packNChars (length str) str
+
+packNChars :: Int -> [Char] -> PackedString
+packNChars len str = PS (array (0,len-1) (zip [0..] str))
 
 -- -----------------------------------------------------------------------------
 -- Destructor functions (taking PackedStrings apart)
 
--- OK, but this code gets *hammered*:
--- unpackPS ps
---   = [ indexPS ps n | n <- [ 0::Int .. lengthPS ps - 1 ] ]
-
 unpackPS :: PackedString -> [Char]
-unpackPS (PS bytes len _) = unpack 0#
- where
-    unpack nh
-      | nh >=# len  = []
-      | otherwise   = C# ch : unpack (nh +# 1#)
-      where
-	ch = indexCharArray# bytes nh
-
-unpackPS (CPS addr _) = unpack 0#
-  where
-    unpack nh
-      | ch `eqChar#` '\0'# = []
-      | otherwise	   = C# ch : unpack (nh +# 1#)
-      where
-	ch = indexCharOffAddr# addr nh
-
-unpackNBytesPS :: PackedString -> Int -> [Char]
-unpackNBytesPS ps len@(I# l#)
- | len < 0	= error ("PackedString.unpackNBytesPS: negative length "++ show len)
- | len == 0     = []
- | otherwise    =
-    case ps of
-      PS bytes len# has_null -> unpackPS (PS bytes (min# len# l#) has_null)
-      CPS a len# -> unpackPS (CPS a (min# len# l#))
- where
-  min# x# y# 
-    | x# <# y#  = x#
-    | otherwise = y#
-
-unpackPSIO :: PackedString -> IO String
-unpackPSIO ps@(PS bytes _ _) = return (unpackPS ps)
-unpackPSIO (CPS addr _)      = unpack 0#
-  where
-    unpack nh = do
-       ch <- peekByteOff (Ptr addr) (I# nh)
-       let c = castCCharToChar ch
-       if c == '\0'
-        then return []
-	else do
-	   ls <- unpack (nh +# 1#)
-	   return (c : ls)
-
--- Output a packed string via a handle:
-
-hPutPS :: Handle -> PackedString -> IO ()
-hPutPS handle (CPS a# len#)    = hPutBuf handle (Ptr a#) (I# len#)
-hPutPS handle (PS  ba# len# _) = do
-   let mba = MutableByteArray (bottom::Int) bottom (unsafeCoerce# ba#)
-   hPutBufBA  handle mba (I# len#)
-  where
-    bottom = error "hPutPS"
-
--- The dual to @_putPS@, note that the size of the chunk specified
--- is the upper bound of the size of the chunk returned.
-
-hGetPS :: Handle -> Int -> IO PackedString
-hGetPS hdl len@(I# len#)
- | len# <=# 0# = return nilPS -- I'm being kind here.
- | otherwise   =
-    -- Allocate an array for system call to store its bytes into.
-   stToIO (new_ps_array len# )		 >>= \ ch_arr ->
-   stToIO (freeze_ps_array ch_arr len#)  >>= \ (ByteArray _ _ frozen#) ->
-   hGetBufBA hdl ch_arr len >>= \  (I# read#) ->
-   if read# ==# 0# then -- EOF or other error
-      ioError (userError "hGetPS: EOF reached or other error")
-   else
-     {-
-       The system call may not return the number of
-       bytes requested. Instead of failing with an error
-       if the number of bytes read is less than requested,
-       a packed string containing the bytes we did manage
-       to snarf is returned.
-     -}
-     let
-      has_null = byteArrayHasNUL# frozen# read#
-     in 
-     return (PS frozen# read# has_null)
+unpackPS (PS ps) = elems ps
 
 -- -----------------------------------------------------------------------------
 -- List-mimicking functions for PackedStrings
 
--- First, the basic functions that do look into the representation;
--- @indexPS@ is the most important one.
-
-lengthPS   :: PackedString -> Int
-lengthPS ps = I# (lengthPS# ps)
-
-{-# INLINE lengthPS# #-}
-
-lengthPS# :: PackedString -> Int#
-lengthPS# (PS  _ i _) = i
-lengthPS# (CPS _ i)   = i
-
-{-# INLINE strlen# #-}
-
-strlen# :: Addr# -> Int
-strlen# a
-  = unsafePerformIO (
-    _ccall_ strlen (Ptr a)  >>= \ len@(I# _) ->
-    return len
-    )
-
-byteArrayHasNUL# :: ByteArray# -> Int#{-length-} -> Bool
-byteArrayHasNUL# bs len
-  = unsafePerformIO (
-    _ccall_ byteArrayHasNUL__ ba (I# len)  >>= \ (I# res) ->
-    return (
-    if res ==# 0# then False else True
-    ))
-  where
-    ba = ByteArray 0 (I# (len -# 1#)) bs
-
------------------------
+lengthPS :: PackedString -> Int
+lengthPS (PS ps) = rangeSize (bounds ps)
 
 indexPS :: PackedString -> Int -> Char
-indexPS ps (I# n) = C# (indexPS# ps n)
-
-{-# INLINE indexPS# #-}
-
-indexPS# :: PackedString -> Int# -> Char#
-indexPS# (PS bs i _) n
-  = --ASSERT (n >=# 0# && n <# i)	-- error checking: my eye!  (WDP 94/10)
-    indexCharArray# bs n
-
-indexPS# (CPS a _) n
-  = indexCharOffAddr# a n
-
--- Now, the rest of the functions can be defined without digging
--- around in the representation.
+indexPS (PS ps) i = ps ! i
 
 headPS :: PackedString -> Char
 headPS ps
-  | nullPS ps = error "headPS: head []"
-  | otherwise  = C# (indexPS# ps 0#)
+  | nullPS ps = error "Data.PackedString.headPS: head []"
+  | otherwise  = indexPS ps 0
 
 tailPS :: PackedString -> PackedString
 tailPS ps
-  | len <=# 0# = error "tailPS: tail []"
-  | len ==# 1# = nilPS
-  | otherwise  = substrPS# ps 1# (len -# 1#)
+  | len <= 0 = error "Data.PackedString.tailPS: tail []"
+  | len == 1 = nilPS
+  | otherwise  = substrPS ps 1 (len - 1)
   where
-    len = lengthPS# ps
+    len = lengthPS ps
 
 nullPS :: PackedString -> Bool
-nullPS (PS  _ i _) = i ==# 0#
-nullPS (CPS _ i)   = i ==# 0#
+nullPS (PS ps) = rangeSize (bounds ps) == 0
 
 appendPS :: PackedString -> PackedString -> PackedString
 appendPS xs ys
@@ -491,224 +141,36 @@ appendPS xs ys
   | nullPS ys = xs
   | otherwise  = concatPS [xs,ys]
 
-mapPS :: (Char -> Char) -> PackedString -> PackedString {-or String?-}
-mapPS f xs = 
-  if nullPS xs then
-     xs
-  else
-     runST (
-       new_ps_array (length +# 1#)         >>= \ ps_arr ->
-       whizz ps_arr length 0#              >>
-       freeze_ps_array ps_arr length       >>= \ (ByteArray _ _ frozen#) ->
-       let has_null = byteArrayHasNUL# frozen# length in
-       return (PS frozen# length has_null))
-  where
-   length = lengthPS# xs
-
-   whizz :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
-   whizz arr# n i 
-    | n ==# 0#
-      = write_ps_array arr# i (chr# 0#) >>
-	return ()
-    | otherwise
-      = let
-	 ch = indexPS# xs i
-	in
-	write_ps_array arr# i (case f (C# ch) of { (C# x) -> x})     >>
-	whizz arr# (n -# 1#) (i +# 1#)
+mapPS :: (Char -> Char) -> PackedString -> PackedString
+mapPS f (PS ps) = PS (amap f ps)
 
 filterPS :: (Char -> Bool) -> PackedString -> PackedString {-or String?-}
-filterPS pred ps = 
-  if nullPS ps then
-     ps
-  else
-     {-
-      Filtering proceeds as follows:
-      
-       * traverse the list, applying the pred. to each element,
-	 remembering the positions where it was satisfied.
-
-	 Encode these positions using a run-length encoding of the gaps
-	 between the matching positions. 
- 
-       * Allocate a MutableByteArray in the heap big enough to hold
-         all the matched entries, and copy the elements that matched over.
-
-      A better solution that merges the scan&copy passes into one,
-      would be to copy the filtered elements over into a growable
-      buffer. No such operation currently supported over
-      MutableByteArrays (could of course use malloc&realloc)
-      But, this solution may in the case of repeated realloc's
-      be worse than the current solution.
-     -}
-     runST (
-       let
-        (rle,len_filtered) = filter_ps (len# -# 1#) 0# 0# []
-	len_filtered#      = case len_filtered of { I# x# -> x#}
-       in
-       if len# ==# len_filtered# then 
-         {- not much filtering as everything passed through. -}
-         return ps
-       else if len_filtered# ==# 0# then
-	 return nilPS
-       else
-         new_ps_array (len_filtered# +# 1#)   >>= \ ps_arr ->
-         copy_arr ps_arr rle 0# 0#            >>
-         freeze_ps_array ps_arr len_filtered# >>= \ (ByteArray _ _ frozen#) ->
-         let has_null = byteArrayHasNUL# frozen# len_filtered# in
-         return (PS frozen# len_filtered# has_null))
-  where
-   len# = lengthPS# ps
-
-   matchOffset :: Int# -> [Char] -> (Int,[Char])
-   matchOffset off [] = (I# off,[])
-   matchOffset off (C# c:cs) =
-    let
-     x    = ord# c
-     off' = off +# x
-    in
-    if x==# 0# then -- escape code, add 255#
-       matchOffset off' cs
-    else
-       (I# off', cs)
-
-   copy_arr :: MutableByteArray s Int -> [Char] -> Int# -> Int# -> ST s ()
-   copy_arr _    [_] _ _ = return ()
-   copy_arr arr# ls  n i =
-     let
-      (x,ls') = matchOffset 0# ls
-      n'      = n +# (case x of { (I# x#) -> x#}) -# 1#
-      ch      = indexPS# ps n'
-     in
-     write_ps_array arr# i ch                >>
-     copy_arr arr# ls' (n' +# 1#) (i +# 1#)
-
-   esc :: Int# -> Int# -> [Char] -> [Char]
-   esc v 0# ls = (C# (chr# v)):ls
-   esc v n  ls = esc v (n -# 1#) (C# (chr# 0#):ls)
-
-   filter_ps :: Int# -> Int# -> Int# -> [Char] -> ([Char],Int)
-   filter_ps n hits run acc
-    | n <# 0# = 
-        let
-	 escs = run `quotInt#` 255#
-	 v    = run `remInt#`  255#
-        in
-       (esc (v +# 1#) escs acc, I# hits)
-    | otherwise
-       = let
-          ch = indexPS# ps n
-          n' = n -# 1#
-	 in
-         if pred (C# ch) then
-	    let
-	     escs = run `quotInt#` 255#
-	     v    = run `remInt#`  255#
-	     acc' = esc (v +# 1#) escs acc
-	    in
-	    filter_ps n' (hits +# 1#) 0# acc'
-	 else
-	    filter_ps n' hits (run +# 1#) acc
-
+filterPS pred ps = packString (filter pred (unpackPS ps))
 
 foldlPS :: (a -> Char -> a) -> a -> PackedString -> a
-foldlPS f b ps 
- = if nullPS ps then
-      b 
-   else
-      whizzLR b 0#
-   where
-    len = lengthPS# ps
-
-    --whizzLR :: a -> Int# -> a
-    whizzLR b idx
-     | idx ==# len = b
-     | otherwise   = whizzLR (f b (C# (indexPS# ps idx))) (idx +# 1#)
- 
+foldlPS f b ps = foldl f b (unpackPS ps)
 
 foldrPS :: (Char -> a -> a) -> a -> PackedString -> a
-foldrPS f v ps
-  | nullPS ps = v
-  | otherwise = whizzRL v len
-   where
-    len = lengthPS# ps
-
-    --whizzRL :: a -> Int# -> a
-    whizzRL b idx
-     | idx <# 0# = b
-     | otherwise = whizzRL (f (C# (indexPS# ps idx)) b) (idx -# 1#)
+foldrPS f v ps = foldr f v (unpackPS ps)
 
 takePS :: Int -> PackedString -> PackedString
-takePS (I# n) ps 
-  | n ==# 0#   = nilPS
-  | otherwise  = substrPS# ps 0# (n -# 1#)
+takePS n ps = substrPS ps 0 (n-1)
 
 dropPS	:: Int -> PackedString -> PackedString
-dropPS (I# n) ps
-  | n ==# len = nilPS
-  | otherwise = substrPS# ps n  (lengthPS# ps -# 1#)
-  where
-    len = lengthPS# ps
+dropPS n ps = substrPS ps n (lengthPS ps - 1)
 
 splitAtPS :: Int -> PackedString -> (PackedString, PackedString)
 splitAtPS  n ps  = (takePS n ps, dropPS n ps)
 
 takeWhilePS :: (Char -> Bool) -> PackedString -> PackedString
-takeWhilePS pred ps
-  = let
-	break_pt = char_pos_that_dissatisfies
-			(\ c -> pred (C# c))
-			ps
-			(lengthPS# ps)
-			0#
-    in
-    if break_pt ==# 0# then
-       nilPS
-    else
-       substrPS# ps 0# (break_pt -# 1#)
+takeWhilePS pred ps = packString (takeWhile pred (unpackPS ps))
 
 dropWhilePS :: (Char -> Bool) -> PackedString -> PackedString
-dropWhilePS pred ps
-  = let
-	len	 = lengthPS# ps
-	break_pt = char_pos_that_dissatisfies
-			(\ c -> pred (C# c))
-			ps
-			len
-			0#
-    in
-    if len ==# break_pt then
-       nilPS
-    else
-       substrPS# ps break_pt (len -# 1#)
+dropWhilePS pred ps = packString (dropWhile pred (unpackPS ps))
 
 elemPS :: Char -> PackedString -> Bool
-elemPS (C# ch) ps
-  = let
-	len	 = lengthPS# ps
-	break_pt = first_char_pos_that_satisfies
-			(`eqChar#` ch)
-			ps
-			len
-			0#
-    in
-    break_pt <# len
-
-char_pos_that_dissatisfies :: (Char# -> Bool) -> PackedString -> Int# -> Int# -> Int#
-
-char_pos_that_dissatisfies p ps len pos
-  | pos >=# len		= pos -- end
-  | p (indexPS# ps pos) = -- predicate satisfied; keep going
-			  char_pos_that_dissatisfies p ps len (pos +# 1#)
-  | otherwise		= pos -- predicate not satisfied
-
-first_char_pos_that_satisfies :: (Char# -> Bool) -> PackedString -> Int# -> Int# -> Int#
-first_char_pos_that_satisfies p ps len pos
-  | pos >=# len		= pos -- end
-  | p (indexPS# ps pos) = pos -- got it!
-  | otherwise		= first_char_pos_that_satisfies p ps len (pos +# 1#)
-
--- ToDo: could certainly go quicker
+elemPS c ps = c `elem` unpackPS ps
+
 spanPS :: (Char -> Bool) -> PackedString -> (PackedString, PackedString)
 spanPS  p ps = (takeWhilePS p ps, dropWhilePS p ps)
 
@@ -722,66 +184,13 @@ wordsPS :: PackedString -> [PackedString]
 wordsPS ps = splitWithPS isSpace ps
 
 reversePS :: PackedString -> PackedString
-reversePS ps =
-  if nullPS ps then -- don't create stuff unnecessarily. 
-     ps
-  else
-    runST (
-      new_ps_array (length +# 1#)    >>= \ arr# -> -- incl NUL byte!
-      fill_in arr# (length -# 1#) 0# >>
-      freeze_ps_array arr# length    >>= \ (ByteArray _ _ frozen#) ->
-      let has_null = byteArrayHasNUL# frozen# length in
-      return (PS frozen# length has_null))
- where
-  length = lengthPS# ps
-  
-  fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
-  fill_in arr_in# n i =
-   let
-    ch = indexPS# ps n
-   in
-   write_ps_array arr_in# i ch		         >>
-   if n ==# 0# then
-      write_ps_array arr_in# (i +# 1#) (chr# 0#) >>
-      return ()
-   else
-      fill_in arr_in# (n -# 1#) (i +# 1#)
-     
-concatPS :: [PackedString] -> PackedString
-concatPS [] = nilPS
-concatPS pss
-  = let
-	tot_len# = case (foldr ((+) . lengthPS) 0 pss) of { I# x -> x }
-    in
-    runST (
-    new_ps_array (tot_len# +# 1#)   >>= \ arr# -> -- incl NUL byte!
-    packum arr# pss 0#		    >>
-    freeze_ps_array arr# tot_len#   >>= \ (ByteArray _ _ frozen#) ->
-
-    let has_null = byteArrayHasNUL# frozen# tot_len# in
-	  
-    return (PS frozen# tot_len# has_null)
-    )
-  where
-    packum :: MutableByteArray s Int -> [PackedString] -> Int# -> ST s ()
-
-    packum arr [] pos
-      = write_ps_array arr pos (chr# 0#) >>
-	return ()
-    packum arr (ps : pss) pos
-      = fill arr pos ps 0# (lengthPS# ps)  >>= \ (I# next_pos) ->
-	packum arr pss next_pos
-
-    fill :: MutableByteArray s Int -> Int# -> PackedString -> Int# -> Int# -> ST s Int
+reversePS ps = packString (reverse (unpackPS ps))
 
-    fill arr arr_i ps ps_i ps_len
-     | ps_i ==# ps_len
-       = return (I# (arr_i +# ps_len))
-     | otherwise
-       = write_ps_array arr (arr_i +# ps_i) (indexPS# ps ps_i) >>
-	 fill arr arr_i ps (ps_i +# 1#) ps_len
+concatPS :: [PackedString] -> PackedString
+concatPS pss = packString (concat (map unpackPS pss))
 
 ------------------------------------------------------------
+{-
 joinPS :: PackedString -> [PackedString] -> PackedString
 joinPS filler pss = concatPS (splice pss)
  where
@@ -806,32 +215,33 @@ joinPS filler pss = concatPS (splice pss)
   * joinPS (packString [x]) (_splitPS x ls) = ls
 
 -}
+-}
 
 splitPS :: Char -> PackedString -> [PackedString]
-splitPS (C# ch) = splitWithPS (\ (C# c) -> c `eqChar#` ch)
+splitPS c = splitWithPS (== c)
 
 splitWithPS :: (Char -> Bool) -> PackedString -> [PackedString]
-splitWithPS pred ps =
- splitify 0#
+splitWithPS pred (PS ps) =
+ splitify 0
  where
-  len = lengthPS# ps
+  len = lengthPS (PS ps)
   
   splitify n 
-   | n >=# len = []
+   | n >= len = []
    | otherwise =
       let
-       break_pt = 
-         first_char_pos_that_satisfies
-	    (\ c -> pred (C# c))
-	    ps
-	    len
-	    n
+       break_pt = first_pos_that_satisfies pred ps len n
       in
-      if break_pt ==# n then -- immediate match, no substring to cut out.
-         splitify (break_pt +# 1#)
+      if break_pt == n then -- immediate match, no substring to cut out.
+         splitify (break_pt + 1)
       else 
-         substrPS# ps n (break_pt -# 1#): -- leave out the matching character
-         splitify (break_pt +# 1#)
+         substrPS (PS ps) n (break_pt - 1) -- leave out the matching character
+         : splitify (break_pt + 1)
+
+first_pos_that_satisfies pred ps len n = 
+   case [ m | m <- [n..len], pred (ps ! m) ] of
+	[]    -> len
+	(m:_) -> m
 
 -- -----------------------------------------------------------------------------
 -- Local utility functions
@@ -840,75 +250,24 @@ splitWithPS pred ps =
 -- @take (end - begin + 1) (drop begin str)@.
 
 substrPS :: PackedString -> Int -> Int -> PackedString
-substrPS ps (I# begin) (I# end) = substrPS# ps begin end
-
-substrPS# :: PackedString -> Int# -> Int# -> PackedString
-substrPS# ps s e
-  | s <# 0# || s >=# len || result_len# <=# 0#
-  = nilPS
-
-  | otherwise
-  = runST (
-	new_ps_array (result_len# +# 1#)   >>= \ ch_arr -> -- incl NUL byte!
-	fill_in ch_arr 0#	           >>
-	freeze_ps_array ch_arr result_len# >>= \ (ByteArray _ _ frozen#) ->
-
-	let has_null = byteArrayHasNUL# frozen# result_len# in
-	  
-	return (PS frozen# result_len# has_null)
-    )
-  where
-    len = lengthPS# ps
-
-    result_len# = (if e <# len then (e +# 1#) else len) -# s
+substrPS (PS ps) begin end = packString [ ps ! i | i <- [begin..end] ]
 
-    -----------------------
-    fill_in :: MutableByteArray s Int -> Int# -> ST s ()
+-- -----------------------------------------------------------------------------
+-- hPutPS
 
-    fill_in arr_in# idx
-      | idx ==# result_len#
-      = write_ps_array arr_in# idx (chr# 0#) >>
-	return ()
-      | otherwise
-      = let
-	    ch = indexPS# ps (s +# idx)
-	in
-	write_ps_array arr_in# idx ch	     >>
-	fill_in arr_in# (idx +# 1#)
+hPutPS :: Handle -> PackedString -> IO ()
+hPutPS h (PS ps) = do
+  let l = lengthPS (PS ps)
+  arr <- newArray_ (0, l-1)
+  sequence_ [ writeArray arr i (fromIntegral (ord (ps ! i))) | i <- [0..l-1] ]
+  hPutArray h arr l
 
 -- -----------------------------------------------------------------------------
--- Packing and unpacking C strings
+-- hGetPS
 
-cStringToPS	 :: Ptr a -> PackedString
-cStringToPS (Ptr a#) =	-- the easy one; we just believe the caller
- CPS a# len
- where
-  len = case (strlen# a#) of { I# x -> x }
-
-packCBytes :: Int -> Ptr a -> PackedString
-packCBytes len addr = runST (packCBytesST len addr)
-
-packCBytesST :: Int -> Ptr a -> ST s PackedString
-packCBytesST (I# length#) (Ptr addr) =
-  {- 
-    allocate an array that will hold the string
-    (not forgetting the NUL byte at the end)
-  -}
-  new_ps_array (length# +# 1#)  >>= \ ch_array ->
-   -- fill in packed string from "addr"
-  fill_in ch_array 0#   >>
-   -- freeze the puppy:
-  freeze_ps_array ch_array length# >>= \ (ByteArray _ _ frozen#) ->
-  let has_null = byteArrayHasNUL# frozen# length# in
-  return (PS frozen# length# has_null)
-  where
-    fill_in :: MutableByteArray s Int -> Int# -> ST s ()
-
-    fill_in arr_in# idx
-      | idx ==# length#
-      = write_ps_array arr_in# idx (chr# 0#) >>
-	return ()
-      | otherwise
-      = case (indexCharOffAddr# addr idx) of { ch ->
-	write_ps_array arr_in# idx ch >>
-	fill_in arr_in# (idx +# 1#) }
+hGetPS :: Handle -> Int -> IO PackedString
+hGetPS h i = do
+  arr <- newArray_ (0, i-1)
+  l <- hGetArray h arr i
+  chars <- mapM (\i -> readArray arr i >>= return.chr.fromIntegral) [0..l-1]
+  return (packString chars)
diff --git a/GHC/ByteArr.lhs b/GHC/ByteArr.lhs
deleted file mode 100644
index 49756fa..0000000
--- a/GHC/ByteArr.lhs
+++ /dev/null
@@ -1,184 +0,0 @@
-% -----------------------------------------------------------------------------
-% $Id: ByteArr.lhs,v 1.1 2001/06/28 14:15:03 simonmar Exp $
-%
-% (c) The University of Glasgow, 1994-2000
-%
-
-\section[GHC.ByteArr]{Module @GHC.ByteArr@}
-
-Byte-arrays are flat arrays of non-pointers only.
-
-\begin{code}
-{-# OPTIONS -fno-implicit-prelude #-}
-
-module GHC.ByteArr where
-
-import {-# SOURCE #-} GHC.Err ( error )
-import GHC.Num
-import GHC.Arr
-import GHC.Float
-import GHC.ST
-import GHC.Base
-\end{code}
-
-%*********************************************************
-%*							*
-\subsection{The @Array@ types}
-%*							*
-%*********************************************************
-
-\begin{code}
-data Ix ix => ByteArray ix      	= ByteArray	   ix ix ByteArray#
-data Ix ix => MutableByteArray s ix     = MutableByteArray ix ix (MutableByteArray# s)
-
-instance CCallable (ByteArray ix)
-instance CCallable (MutableByteArray RealWorld ix)
-	-- Note the RealWorld!  You can only ccall with MutableByteArray args
-	-- which are in the real world.  When this was missed out, the result
-	-- was that a CCallOpId had a free tyvar, and since the compiler doesn't
-	-- expect that it didn't get zonked or substituted.  Bad news.
-
-instance Eq (MutableByteArray s ix) where
-	MutableByteArray _ _ arr1# == MutableByteArray _ _ arr2#
-		= sameMutableByteArray# arr1# arr2#
-\end{code}
-
-%*********************************************************
-%*							*
-\subsection{Operations on mutable arrays}
-%*							*
-%*********************************************************
-
-\begin{code}
-newCharArray, newIntArray, newFloatArray, newDoubleArray
-	 :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix) 
-
-{-# SPECIALIZE newCharArray   :: IPr -> ST s (MutableByteArray s Int) #-}
-{-# SPECIALIZE newIntArray    :: IPr -> ST s (MutableByteArray s Int) #-}
-{-# SPECIALIZE newFloatArray  :: IPr -> ST s (MutableByteArray s Int) #-}
-{-# SPECIALIZE newDoubleArray :: IPr -> ST s (MutableByteArray s Int) #-}
-
-newCharArray (l,u) = ST $ \ s# ->
-    case rangeSize (l,u)          of { I# n# ->
-    case (newByteArray# (cHAR_SCALE n#) s#) of { (# s2#, barr# #) ->
-    (# s2#, MutableByteArray l u barr# #) }}
-
-newIntArray (l,u) = ST $ \ s# ->
-    case rangeSize (l,u)          of { I# n# ->
-    case (newByteArray# (wORD_SCALE n#) s#) of { (# s2#, barr# #) ->
-    (# s2#, MutableByteArray l u barr# #) }}
-
-newWordArray (l,u) = ST $ \ s# ->
-    case rangeSize (l,u)          of { I# n# ->
-    case (newByteArray# (wORD_SCALE n#) s#) of { (# s2#, barr# #) ->
-    (# s2#, MutableByteArray l u barr# #) }}
-
-newFloatArray (l,u) = ST $ \ s# ->
-    case rangeSize (l,u)          of { I# n# ->
-    case (newByteArray# (fLOAT_SCALE n#) s#) of { (# s2#, barr# #) ->
-    (# s2#, MutableByteArray l u barr# #) }}
-
-newDoubleArray (l,u) = ST $ \ s# ->
-    case rangeSize (l,u)          of { I# n# ->
-    case (newByteArray# (dOUBLE_SCALE n#) s#) of { (# s2#, barr# #) ->
-    (# s2#, MutableByteArray l u barr# #) }}
-
-#include "config.h"
-
-  -- Char arrays really contain only 8-bit bytes for compatibility.
-cHAR_SCALE   n = 1# *# n
-wORD_SCALE   n = (case SIZEOF_VOID_P :: Int of I# x -> x *# n)
-dOUBLE_SCALE n = (case SIZEOF_DOUBLE :: Int of I# x -> x *# n)
-fLOAT_SCALE  n = (case SIZEOF_FLOAT  :: Int of I# x -> x *# n)
-
-readCharArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Char 
-readIntArray    :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
-readFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
-readDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
-
-{-# SPECIALIZE readCharArray   :: MutableByteArray s Int -> Int -> ST s Char #-}
-{-# SPECIALIZE readIntArray    :: MutableByteArray s Int -> Int -> ST s Int #-}
---NO:{-# SPECIALIZE readFloatArray  :: MutableByteArray s Int -> Int -> ST s Float #-}
-{-# SPECIALIZE readDoubleArray :: MutableByteArray s Int -> Int -> ST s Double #-}
-
-readCharArray (MutableByteArray l u barr#) n = ST $ \ s# ->
-    case (index (l,u) n)	    	of { I# n# ->
-    case readCharArray# barr# n# s#	of { (# s2#, r# #) ->
-    (# s2#, C# r# #) }}
-
-readIntArray (MutableByteArray l u barr#) n = ST $ \ s# ->
-    case (index (l,u) n)	    	of { I# n# ->
-    case readIntArray# barr# n# s#	of { (# s2#, r# #) ->
-    (# s2#, I# r# #) }}
-
-readFloatArray (MutableByteArray l u barr#) n = ST $ \ s# ->
-    case (index (l,u) n)	    	of { I# n# ->
-    case readFloatArray# barr# n# s#	of { (# s2#, r# #) ->
-    (# s2#, F# r# #) }}
-
-readDoubleArray (MutableByteArray l u barr#) n = ST $ \ s# ->
-    case (index (l,u) n) 	    	of { I# n# ->
-    case readDoubleArray# barr# n# s#	of { (# s2#, r# #) ->
-    (# s2#, D# r# #) }}
-
---Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here.
-indexCharArray   :: Ix ix => ByteArray ix -> ix -> Char 
-indexIntArray    :: Ix ix => ByteArray ix -> ix -> Int
-indexFloatArray  :: Ix ix => ByteArray ix -> ix -> Float
-indexDoubleArray :: Ix ix => ByteArray ix -> ix -> Double
-
-{-# SPECIALIZE indexCharArray   :: ByteArray Int -> Int -> Char #-}
-{-# SPECIALIZE indexIntArray    :: ByteArray Int -> Int -> Int #-}
---NO:{-# SPECIALIZE indexFloatArray  :: ByteArray Int -> Int -> Float #-}
-{-# SPECIALIZE indexDoubleArray :: ByteArray Int -> Int -> Double #-}
-
-indexCharArray (ByteArray l u barr#) n
-  = case (index (l,u) n)	    	of { I# n# ->
-    case indexCharArray# barr# n# 	of { r# ->
-    (C# r#)}}
-
-indexIntArray (ByteArray l u barr#) n
-  = case (index (l,u) n)	    	of { I# n# ->
-    case indexIntArray# barr# n# 	of { r# ->
-    (I# r#)}}
-
-indexFloatArray (ByteArray l u barr#) n
-  = case (index (l,u) n)	    	of { I# n# ->
-    case indexFloatArray# barr# n# 	of { r# ->
-    (F# r#)}}
-
-indexDoubleArray (ByteArray l u barr#) n
-  = case (index (l,u) n) 	    	of { I# n# ->
-    case indexDoubleArray# barr# n# 	of { r# ->
-    (D# r#)}}
-
-writeCharArray   :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s () 
-writeIntArray    :: Ix ix => MutableByteArray s ix -> ix -> Int  -> ST s () 
-writeFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s () 
-writeDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s () 
-
-{-# SPECIALIZE writeCharArray   :: MutableByteArray s Int -> Int -> Char -> ST s () #-}
-{-# SPECIALIZE writeIntArray    :: MutableByteArray s Int -> Int -> Int  -> ST s () #-}
---NO:{-# SPECIALIZE writeFloatArray  :: MutableByteArray s Int -> Int -> Float -> ST s () #-}
-{-# SPECIALIZE writeDoubleArray :: MutableByteArray s Int -> Int -> Double -> ST s () #-}
-
-writeCharArray (MutableByteArray l u barr#) n (C# ele) = ST $ \ s# ->
-    case index (l,u) n	    	    	    of { I# n# ->
-    case writeCharArray# barr# n# ele s#    of { s2#   ->
-    (# s2#, () #) }}
-
-writeIntArray (MutableByteArray l u barr#) n (I# ele) = ST $ \ s# ->
-    case index (l,u) n	    	    	    of { I# n# ->
-    case writeIntArray# barr# n# ele s#     of { s2#   ->
-    (# s2#, () #) }}
-
-writeFloatArray (MutableByteArray l u barr#) n (F# ele) = ST $ \ s# ->
-    case index (l,u) n	    	    	    of { I# n# ->
-    case writeFloatArray# barr# n# ele s#   of { s2#   ->
-    (# s2#, () #) }}
-
-writeDoubleArray (MutableByteArray l u barr#) n (D# ele) = ST $ \ s# ->
-    case index (l,u) n	    	    	    of { I# n# ->
-    case writeDoubleArray# barr# n# ele s#  of { s2#   ->
-    (# s2#, () #) }}
-\end{code}
diff --git a/GHC/Handle.hsc b/GHC/Handle.hsc
index 05b19b6..cf0956a 100644
--- a/GHC/Handle.hsc
+++ b/GHC/Handle.hsc
@@ -4,7 +4,7 @@
 #undef DEBUG
 
 -- -----------------------------------------------------------------------------
--- $Id: Handle.hsc,v 1.5 2001/07/31 13:03:28 simonmar Exp $
+-- $Id: Handle.hsc,v 1.6 2001/09/14 11:25:24 simonmar Exp $
 --
 -- (c) The University of Glasgow, 1994-2001
 --
@@ -426,9 +426,6 @@ flushWriteBuffer fd buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w }  = do
 
 foreign import "write_wrap" unsafe
    write_off :: CInt -> RawBuffer -> Int -> CInt -> IO CInt
-#def inline \
-int write_wrap(int fd, void *ptr, HsInt off, int size) \
-{ return write(fd, ptr + off, size); }
 
 
 fillReadBuffer :: FD -> Bool -> Buffer -> IO Buffer
@@ -469,9 +466,6 @@ fillReadBufferLoop fd is_line buf b w size = do
  
 foreign import "read_wrap" unsafe
    read_off :: FD -> RawBuffer -> Int -> CInt -> IO CInt
-#def inline \
-int read_wrap(int fd, void *ptr, HsInt off, int size) \
-{ return read(fd, ptr + off, size); }
 
 -- ---------------------------------------------------------------------------
 -- Standard Handles
diff --git a/GHC/IO.hsc b/GHC/IO.hsc
index a9c91ec..ac1e98d 100644
--- a/GHC/IO.hsc
+++ b/GHC/IO.hsc
@@ -3,7 +3,7 @@
 #undef DEBUG_DUMP
 
 -- -----------------------------------------------------------------------------
--- $Id: IO.hsc,v 1.2 2001/07/31 12:46:17 simonmar Exp $
+-- $Id: IO.hsc,v 1.3 2001/09/14 11:25:24 simonmar Exp $
 --
 -- (c) The University of Glasgow, 1992-2001
 --
@@ -17,7 +17,6 @@
 module GHC.IO where
 
 #include "HsCore.h"
-#include "GHC/Handle_hsc.h"
 
 import Foreign
 import Foreign.C
@@ -25,7 +24,6 @@ import Foreign.C
 import Data.Maybe
 import Control.Monad
 
-import GHC.ByteArr
 import GHC.Enum
 import GHC.Base
 import GHC.Posix
@@ -420,13 +418,19 @@ writeLines hdl Buffer{ bufBuf=raw, bufSize=len } s =
 	-- check n == len first, to ensure that shoveString is strict in n.
    shoveString n cs | n == len = do
 	new_buf <- commitBuffer hdl raw len n True{-needs flush-} False
-	writeBlocks hdl new_buf cs
+	writeLines hdl new_buf cs
    shoveString n [] = do
 	commitBuffer hdl raw len n False{-no flush-} True{-release-}
 	return ()
    shoveString n (c:cs) = do
 	n' <- writeCharIntoBuffer raw n c
-	shoveString n' cs
+	-- we're line-buffered, so flush the buffer if we just got a newline
+	if (c == '\n')
+	  then do
+	    new_buf <- commitBuffer hdl raw len n' True{-needs flush-} False
+	    writeLines hdl new_buf cs
+	  else do
+	    shoveString n' cs
   in
   shoveString 0 s
 
@@ -672,92 +676,6 @@ slurpFile fname = do
     return (chunk, r)
 
 -- ---------------------------------------------------------------------------
--- hGetBufBA
-
-hGetBufBA :: Handle -> MutableByteArray RealWorld a -> Int -> IO Int
-hGetBufBA handle (MutableByteArray _ _ ptr) count
-  | count <= 0 = illegalBufferSize handle "hGetBuf" count
-  | otherwise = 
-      wantReadableHandle "hGetBuf" handle $ 
-	\ handle_@Handle__{ haFD=fd, haBuffer=ref } -> do
-	buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r } <- readIORef ref
-	if bufferEmpty buf
-	   then readChunkBA fd ptr 0 count
-	   else do 
-		let avail = w - r
-		copied <- if (count >= avail)
-		       	    then do 
-				memcpy_ba_baoff ptr raw r (fromIntegral avail)
-				writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
-				return avail
-		     	    else do 
-				memcpy_ba_baoff ptr raw r (fromIntegral count)
-				writeIORef ref buf{ bufRPtr = r + count }
-				return count
-
-		let remaining = count - copied
-		if remaining > 0 
-		   then do rest <- readChunkBA fd ptr copied remaining
-			   return (rest + count)
-		   else return count
-		
-readChunkBA :: FD -> RawBuffer -> Int -> Int -> IO Int
-readChunkBA fd ptr init_off bytes = loop init_off bytes 
- where
-  loop :: Int -> Int -> IO Int
-  loop off bytes | bytes <= 0 = return (off - init_off)
-  loop off bytes = do
-    r <- fromIntegral `liftM`
-	   throwErrnoIfMinus1RetryMayBlock "readChunk"
-	    (readBA (fromIntegral fd) ptr 
-		(fromIntegral off) (fromIntegral bytes))
-	    (threadWaitRead fd)
-    if r == 0
-	then return (off - init_off)
-	else loop (off + r) (bytes - r)
-
-foreign import "read_ba_wrap" unsafe
-   readBA :: FD -> RawBuffer -> Int -> CInt -> IO CInt
-#def inline \
-int read_ba_wrap(int fd, void *ptr, HsInt off, int size) \
-{ return read(fd, ptr + off, size); }
-
--- -----------------------------------------------------------------------------
--- hPutBufBA
-
-hPutBufBA
-	:: Handle			-- handle to write to
-	-> MutableByteArray RealWorld a -- buffer
-	-> Int				-- number of bytes of data in buffer
-	-> IO ()
-
-hPutBufBA handle (MutableByteArray _ _ raw) count
-  | count <= 0 = illegalBufferSize handle "hPutBufBA" count
-  | otherwise = do
-    wantWritableHandle "hPutBufBA" handle $ 
-      \ handle_@Handle__{ haFD=fd, haBuffer=ref } -> do
-
-        old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }
-	  <- readIORef ref
-
-        -- enough room in handle buffer?
-        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)
-		    writeIORef ref old_buf{ bufWPtr = w + count }
-		    return ()
-
-		-- else, we have to flush
-	    else do flushed_buf <- flushWriteBuffer fd old_buf
-		    writeIORef ref flushed_buf
-		    let this_buf = 
-			    Buffer{ bufBuf=raw, bufState=WriteBuffer, 
-				    bufRPtr=0, bufWPtr=count, bufSize=count }
-		    flushWriteBuffer fd this_buf
-		    return ()
-
--- ---------------------------------------------------------------------------
 -- memcpy wrappers
 
 foreign import "memcpy_wrap_src_off" unsafe 
@@ -769,14 +687,6 @@ foreign import "memcpy_wrap_dst_off" unsafe
 foreign import "memcpy_wrap_dst_off" unsafe 
    memcpy_baoff_ptr :: RawBuffer -> Int -> Ptr a -> CSize -> IO (Ptr ())
 
-#def inline \
-void *memcpy_wrap_dst_off(char *dst, int dst_off, char *src, size_t sz) \
-{ return memcpy(dst+dst_off, src, sz); }
-
-#def inline \
-void *memcpy_wrap_src_off(char *dst, char *src, int src_off, size_t sz) \
-{ return memcpy(dst, src+src_off, sz); }
-
 -----------------------------------------------------------------------------
 -- Internal Utils
 
diff --git a/GHC/Pack.lhs b/GHC/Pack.lhs
index 1b4e56a..081a390 100644
--- a/GHC/Pack.lhs
+++ b/GHC/Pack.lhs
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: Pack.lhs,v 1.1 2001/06/28 14:15:03 simonmar Exp $
+% $Id: Pack.lhs,v 1.2 2001/09/14 11:25:24 simonmar Exp $
 %
 % (c) The University of Glasgow, 1997-2000
 %
@@ -20,34 +20,12 @@ module GHC.Pack
        (
 	-- (**) - emitted by compiler.
 
-	packCString#,      -- :: [Char] -> ByteArray#  **
-	packString,	   -- :: [Char] -> ByteArray Int
-	packStringST,      -- :: [Char] -> ST s (ByteArray Int)
-	packNBytesST,      -- :: Int -> [Char] -> ST s (ByteArray Int)
-
-	unpackCString,     -- :: Ptr a -> [Char]
-	unpackCStringST,   -- :: Ptr a -> ST s [Char]
-	unpackNBytes,      -- :: Ptr a -> Int -> [Char]
-	unpackNBytesST,    -- :: Ptr a -> Int -> ST s [Char]
-	unpackNBytesAccST, -- :: Ptr a -> Int -> [Char] -> ST s [Char]
-	unpackNBytesAccST#,-- :: Ptr a -> Int -> [Char] -> ST s [Char]
+	packCString#,      -- :: [Char] -> ByteArray#    **
+	unpackCString,
 	unpackCString#,    -- :: Addr# -> [Char]	 **
 	unpackNBytes#,     -- :: Addr# -> Int# -> [Char] **
-	unpackNBytesST#,   -- :: Addr# -> Int# -> ST s [Char]
-
-	unpackCStringBA,   -- :: ByteArray Int -> [Char]
-	unpackNBytesBA,    -- :: ByteArray Int -> Int  -> [Char]
-	unpackCStringBA#,  -- :: ByteArray#    -> Int# -> [Char]
-	unpackNBytesBA#,   -- :: ByteArray#    -> Int# -> [Char]
-
-
 	unpackFoldrCString#,  -- **
 	unpackAppendCString#,  -- **
-
-	new_ps_array,		-- Int# -> ST s (MutableByteArray s Int)
-	write_ps_array,		-- MutableByteArray s Int -> Int# -> Char# -> ST s () 
-	freeze_ps_array		-- MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
-
        ) 
 	where
 
@@ -56,121 +34,16 @@ import {-# SOURCE #-} GHC.Err ( error )
 import GHC.List ( length )
 import GHC.ST
 import GHC.Num
-import GHC.ByteArr
-import Foreign.Ptr
-
-\end{code}
-
-%*********************************************************
-%*							*
-\subsection{Unpacking Ptrs}
-%*							*
-%*********************************************************
+import GHC.Ptr
 
-Primitives for converting Addrs pointing to external
-sequence of bytes into a list of @Char@s:
+data ByteArray ix      	       = ByteArray	  ix ix ByteArray#
+data MutableByteArray s ix     = MutableByteArray ix ix (MutableByteArray# s)
 
-\begin{code}
 unpackCString :: Ptr a -> [Char]
 unpackCString a@(Ptr addr)
   | a == nullPtr  = []
   | otherwise	   = unpackCString# addr
-     
-unpackNBytes :: Ptr a -> Int -> [Char]
-unpackNBytes (Ptr addr) (I# l) = unpackNBytes# addr l
-
-unpackCStringST  :: Ptr a{- ptr. to NUL terminated string-} -> ST s [Char]
-unpackCStringST a@(Ptr addr)
-  | a == nullPtr  = return []
-  | otherwise	   = unpack 0#
-  where
-    unpack nh
-      | ch `eqChar#` '\0'# = return []
-      | otherwise	   = do
-		ls <- unpack (nh +# 1#)
-		return ((C# ch ) : ls)
-      where
-	ch = indexCharOffAddr# addr nh
-
-unpackNBytesST :: Ptr a -> Int -> ST s [Char]
-unpackNBytesST (Ptr addr) (I# l) = unpackNBytesAccST# addr l []
-
-unpackNBytesAccST :: Ptr a -> Int -> [Char] -> ST s [Char]
-unpackNBytesAccST (Ptr addr) (I# l) rest = unpackNBytesAccST# addr l rest
-
-unpackNBytesST# :: Addr# -> Int# -> ST s [Char]
-unpackNBytesST# addr# l#   = unpackNBytesAccST# addr# l# []
-
-unpackNBytesAccST# :: Addr# -> Int# -> [Char] -> ST s [Char]
-unpackNBytesAccST# _addr 0#   rest = return rest
-unpackNBytesAccST#  addr len# rest = unpack rest (len# -# 1#)
-  where
-    unpack acc i# 
-      | i# <# 0#  = return acc
-      | otherwise  = 
-	 case indexCharOffAddr# addr i# of
-	  ch -> unpack (C# ch : acc) (i# -# 1#)
-
-\end{code}
-
-%********************************************************
-%*							*
-\subsection{Unpacking ByteArrays}
-%*							*
-%********************************************************
-
-Converting byte arrays into list of chars:
 
-\begin{code}
-unpackCStringBA :: ByteArray Int -> [Char]
-unpackCStringBA (ByteArray l@(I# l#) u@(I# u#) bytes) 
- | l > u     = []
- | otherwise = unpackCStringBA# bytes (u# -# l# +# 1#)
-
-{-
- unpack until NUL or end of BA is reached, whatever comes first.
--}
-unpackCStringBA# :: ByteArray# -> Int# -> [Char]
-unpackCStringBA# bytes len
- = unpack 0#
- where
-    unpack nh
-      | nh >=# len         || 
-        ch `eqChar#` '\0'#    = []
-      | otherwise	      = C# ch : unpack (nh +# 1#)
-      where
-	ch = indexCharArray# bytes nh
-
-unpackNBytesBA :: ByteArray Int -> Int -> [Char]
-unpackNBytesBA (ByteArray l u bytes) i
- = unpackNBytesBA# bytes len#
-   where
-    len# = case max 0 (min i len) of I# v# -> v#
-    len | l > u     = 0
-        | otherwise = u-l+1
-
-unpackNBytesBA# :: ByteArray# -> Int# -> [Char]
-unpackNBytesBA# _bytes 0#   = []
-unpackNBytesBA#  bytes len# = unpack [] (len# -# 1#)
-   where
-    unpack acc i#
-     | i# <# 0#  = acc
-     | otherwise = 
-          case indexCharArray# bytes i# of
-	    ch -> unpack (C# ch : acc) (i# -# 1#)
-
-\end{code}
-
-
-%********************************************************
-%*							*
-\subsection{Packing Strings}
-%*							*
-%********************************************************
-
-Converting a list of chars into a packed @ByteArray@ representation.
-
-\begin{code}
 packCString#	     :: [Char]          -> ByteArray#
 packCString# str = case (packString str) of { ByteArray _ _ bytes -> bytes }
 
@@ -203,11 +76,8 @@ packNBytesST (I# length#) str =
    write_ps_array arr_in# idx c	 >>
    fill_in arr_in# (idx +# 1#) cs
 
-\end{code}
-
-(Very :-) ``Specialised'' versions of some CharArray things...
+-- (Very :-) ``Specialised'' versions of some CharArray things...
 
-\begin{code}
 new_ps_array	:: Int# -> ST s (MutableByteArray s Int)
 write_ps_array	:: MutableByteArray s Int -> Int# -> Char# -> ST s () 
 freeze_ps_array :: MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
@@ -227,5 +97,3 @@ freeze_ps_array (MutableByteArray _ _ arr#) len# = ST $ \ s# ->
     case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
     (# s2#, ByteArray 0 (I# len#) frozen# #) }
 \end{code}
-
-