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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/3c171430d46c26bb733ee627d9a9a66951d22c74

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

commit 3c171430d46c26bb733ee627d9a9a66951d22c74
Author: Ian Lynagh <i...@well-typed.com>
Date:   Fri Dec 14 01:02:12 2012 +0000

    Use BS.pack instead of mkFastBytesByteList

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

 compiler/hsSyn/Convert.lhs    |    3 ++-
 compiler/utils/FastString.lhs |   10 ----------
 2 files changed, 2 insertions(+), 11 deletions(-)

diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs
index dc6308a..d65410d 100644
--- a/compiler/hsSyn/Convert.lhs
+++ b/compiler/hsSyn/Convert.lhs
@@ -30,6 +30,7 @@ import Util
 import FastString
 import Outputable
 
+import qualified Data.ByteString as BS
 import Control.Monad( unless )
 
 import Language.Haskell.TH as TH hiding (sigP)
@@ -752,7 +753,7 @@ cvtLit (CharL c)       = do { force c; return $ HsChar c }
 cvtLit (StringL s)     = do { let { s' = mkFastString s }
                             ; force s'
                             ; return $ HsString s' }
-cvtLit (StringPrimL s) = do { let { s' = mkFastBytesByteList s }
+cvtLit (StringPrimL s) = do { let { s' = BS.pack s }
                             ; force s'
                             ; return $ HsStringPrim s' }
 cvtLit _ = panic "Convert.cvtLit: Unexpected literal"
diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs
index 0a23792..3ef92a4 100644
--- a/compiler/utils/FastString.lhs
+++ b/compiler/utils/FastString.lhs
@@ -32,7 +32,6 @@ module FastString
         foreignPtrToFastBytes,
         fastStringToFastBytes,
         fastZStringToByteString,
-        mkFastBytesByteList,
         unsafeMkFastBytesString,
         hashFB,
 
@@ -145,15 +144,6 @@ fastStringToFastBytes f = fs_fb f
 fastZStringToByteString :: FastZString -> ByteString
 fastZStringToByteString (FastZString bs) = bs
 
-mkFastBytesByteList :: [Word8] -> FastBytes
-mkFastBytesByteList bs =
-  inlinePerformIO $ do
-    let l = Prelude.length bs
-    buf <- mallocForeignPtrBytes l
-    withForeignPtr buf $ \ptr -> do
-      pokeArray (castPtr ptr) bs
-      return $ foreignPtrToFastBytes buf l
-
 -- This will drop information if any character > '\xFF'
 unsafeMkFastBytesString :: String -> FastBytes
 unsafeMkFastBytesString str =



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

Reply via email to