Merge ../bs

2 files changed, 32 insertions, 21 deletions

diff --git a/compiler/utils/BufWrite.hs b/compiler/utils/BufWrite.hs
index ea5cee01db..5ad165dcd8 100644
--- a/compiler/utils/BufWrite.hs
+++ b/compiler/utils/BufWrite.hs
@@ -35,8 +35,11 @@ import FastTypes
 import FastMutInt
 
 import Control.Monad	( when )
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Unsafe as BS
 import Data.Char	( ord )
 import Foreign
+import Foreign.C.String
 import System.IO
 
 -- -----------------------------------------------------------------------------
@@ -88,21 +91,27 @@ bPutFS :: BufHandle -> FastString -> IO ()
 bPutFS b fs = bPutFB b $ fastStringToFastBytes fs
 
 bPutFZS :: BufHandle -> FastZString -> IO ()
-bPutFZS b fs = bPutFB b $ fastZStringToFastBytes fs
+bPutFZS b fs = bPutBS b $ fastZStringToByteString fs
 
 bPutFB :: BufHandle -> FastBytes -> IO ()
-bPutFB b@(BufHandle buf r hdl) fb@(FastBytes len fp) =
- withForeignPtr fp $ \ptr -> do
+bPutFB b (FastBytes len fp) =
+ withForeignPtr fp $ \ptr -> bPutCStringLen b (castPtr ptr, len)
+
+bPutBS :: BufHandle -> ByteString -> IO ()
+bPutBS b bs = BS.unsafeUseAsCStringLen bs $ bPutCStringLen b
+
+bPutCStringLen :: BufHandle -> CStringLen -> IO ()
+bPutCStringLen b@(BufHandle buf r hdl) cstr@(ptr, len) = do
   i <- readFastMutInt r
   if (i + len) >= buf_size
-	then do hPutBuf hdl buf i
-		writeFastMutInt r 0
-		if (len >= buf_size) 
-		    then hPutBuf hdl ptr len
-		    else bPutFB b fb
-	else do
-		copyBytes (buf `plusPtr` i) ptr len
-		writeFastMutInt r (i+len)
+        then do hPutBuf hdl buf i
+                writeFastMutInt r 0
+                if (len >= buf_size)
+                    then hPutBuf hdl ptr len
+                    else bPutCStringLen b cstr
+        else do
+                copyBytes (buf `plusPtr` i) ptr len
+                writeFastMutInt r (i + len)
 
 bPutLitString :: BufHandle -> LitString -> FastInt -> IO ()
 bPutLitString b@(BufHandle buf r hdl) a len_ = a `seq` do
diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs
index fafb52c131..03a36f21e2 100644
--- a/compiler/utils/FastString.lhs
+++ b/compiler/utils/FastString.lhs
@@ -31,7 +31,7 @@ module FastString
         mkFastStringFastBytes,
         foreignPtrToFastBytes,
         fastStringToFastBytes,
-        fastZStringToFastBytes,
+        fastZStringToByteString,
         mkFastBytesByteList,
         unsafeMkFastBytesString,
         bytesFB,
@@ -108,6 +108,9 @@ import FastFunctions
 import Panic
 import Util
 
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8  as BS
+import qualified Data.ByteString.Unsafe as BS
 import Foreign.C
 import GHC.Exts
 import System.IO
@@ -164,8 +167,8 @@ mkFastStringFastBytes (FastBytes len fp)
 fastStringToFastBytes :: FastString -> FastBytes
 fastStringToFastBytes f = fs_fb f
 
-fastZStringToFastBytes :: FastZString -> FastBytes
-fastZStringToFastBytes (FastZString fb) = fb
+fastZStringToByteString :: FastZString -> ByteString
+fastZStringToByteString (FastZString bs) = bs
 
 mkFastBytesByteList :: [Word8] -> FastBytes
 mkFastBytesByteList bs =
@@ -228,21 +231,20 @@ hPutFB handle (FastBytes len fp)
 
 -- -----------------------------------------------------------------------------
 
-newtype FastZString = FastZString FastBytes
+newtype FastZString = FastZString ByteString
 
 hPutFZS :: Handle -> FastZString -> IO ()
-hPutFZS handle (FastZString fb) = hPutFB handle fb
+hPutFZS handle (FastZString bs) = BS.hPut handle bs
 
 zString :: FastZString -> String
-zString (FastZString (FastBytes n_bytes buf)) =
-    inlinePerformIO $ withForeignPtr buf $ \ptr ->
-        peekCAStringLen (castPtr ptr, n_bytes)
+zString (FastZString bs) =
+    inlinePerformIO $ BS.unsafeUseAsCStringLen bs peekCAStringLen
 
 lengthFZS :: FastZString -> Int
-lengthFZS (FastZString fb) = lengthFB fb
+lengthFZS (FastZString bs) = BS.length bs
 
 mkFastZStringString :: String -> FastZString
-mkFastZStringString str = FastZString (unsafeMkFastBytesString str)
+mkFastZStringString str = FastZString (BS.pack str)
 
 -- -----------------------------------------------------------------------------