Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/a243fa7985b482434bd5bcf5573210f3eb87f57c

>---------------------------------------------------------------

commit a243fa7985b482434bd5bcf5573210f3eb87f57c
Author: Ian Lynagh <i...@well-typed.com>
Date:   Fri Dec 14 18:12:09 2012 +0000

    Use ByteString rather than FastBytes in Binary

>---------------------------------------------------------------

 compiler/utils/Binary.hs      |   28 +++++++++++++++-------------
 compiler/utils/FastString.lhs |   20 +-------------------
 2 files changed, 16 insertions(+), 32 deletions(-)

diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index 2576562..77f29a0 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -74,7 +74,9 @@ import BasicTypes
 
 import Foreign
 import Data.Array
-import qualified Data.ByteString.Unsafe as BS
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Internal as BS
+import qualified Data.ByteString.Unsafe   as BS
 import Data.IORef
 import Data.Char                ( ord, chr )
 import Data.Time
@@ -714,14 +716,14 @@ type SymbolTable = Array Int Name
 ---------------------------------------------------------
 
 putFS :: BinHandle -> FastString -> IO ()
-putFS bh fs = putFB bh $ fastStringToFastBytes fs
+putFS bh fs = putBS bh $ fastStringToFastBytes fs
 
 getFS :: BinHandle -> IO FastString
-getFS bh = do fb <- getFB bh
-              mkFastStringFastBytes fb
+getFS bh = do bs <- getBS bh
+              mkFastStringFastBytes bs
 
-putFB :: BinHandle -> FastBytes -> IO ()
-putFB bh bs =
+putBS :: BinHandle -> ByteString -> IO ()
+putBS bh bs =
   BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do
   put_ bh l
   let
@@ -733,19 +735,19 @@ putFB bh bs =
   go 0
 
 {- -- possible faster version, not quite there yet:
-getFB bh@BinMem{} = do
+getBS bh@BinMem{} = do
   (I# l) <- get bh
   arr <- readIORef (arr_r bh)
   off <- readFastMutInt (off_r bh)
   return $! (mkFastSubBytesBA# arr off l)
 -}
-getFB :: BinHandle -> IO FastBytes
-getFB bh = do
+getBS :: BinHandle -> IO ByteString
+getBS bh = do
   l <- get bh
   fp <- mallocForeignPtrBytes l
   withForeignPtr fp $ \ptr -> do
   let
-        go n | n == l = return $ foreignPtrToFastBytes fp l
+        go n | n == l = return $ BS.fromForeignPtr fp 0 l
              | otherwise = do
                 b <- getByte bh
                 pokeElemOff ptr n b
@@ -753,9 +755,9 @@ getFB bh = do
   --
   go 0
 
-instance Binary FastBytes where
-  put_ bh f = putFB bh f
-  get bh = getFB bh
+instance Binary ByteString where
+  put_ bh f = putBS bh f
+  get bh = getBS bh
 
 instance Binary FastString where
   put_ bh f =
diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs
index faec292..228b053 100644
--- a/compiler/utils/FastString.lhs
+++ b/compiler/utils/FastString.lhs
@@ -29,7 +29,6 @@ module FastString
         -- * FastBytes
         FastBytes,
         mkFastStringFastBytes,
-        foreignPtrToFastBytes,
         fastStringToFastBytes,
         fastZStringToByteString,
         unsafeMkFastBytesString,
@@ -132,9 +131,6 @@ import GHC.Base         ( unpackCString# )
 
 type FastBytes = ByteString
 
-foreignPtrToFastBytes :: ForeignPtr Word8 -> Int -> FastBytes
-foreignPtrToFastBytes fp len = BS.fromForeignPtr fp 0 len
-
 mkFastStringFastBytes :: FastBytes -> IO FastString
 mkFastStringFastBytes bs = mkFastStringByteString bs
 
@@ -146,21 +142,7 @@ fastZStringToByteString (FastZString bs) = bs
 
 -- This will drop information if any character > '\xFF'
 unsafeMkFastBytesString :: String -> FastBytes
-unsafeMkFastBytesString str =
-  inlinePerformIO $ do
-    let l = Prelude.length str
-    buf <- mallocForeignPtrBytes l
-    withForeignPtr buf $ \ptr -> do
-      pokeCAString (castPtr ptr) str
-      return $ foreignPtrToFastBytes buf l
-
-pokeCAString :: Ptr CChar -> String -> IO ()
-pokeCAString ptr str =
-  let
-        go []     !_ = return ()
-        go (c:cs) n  = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
-  in
-  go str 0
+unsafeMkFastBytesString = BSC.pack
 
 hashByteString :: ByteString -> Int
 hashByteString bs



_______________________________________________
Cvs-ghc mailing list
Cvs-ghc@haskell.org
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to