[commit: packages/bytestring] ghc-head: Fix the rewrite rule that optimizes packing of string literals (794c345)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/bytestring

On branch  : ghc-head
Link       : http://git.haskell.org/?p=packages/bytestring.git;a=commit;h=794c3459f8b6469bdc5c0a08f101696bf277ae65

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

commit 794c3459f8b6469bdc5c0a08f101696bf277ae65
Author: Patrick Palka <patrick at parcs.ath.cx>
Date:   Fri Mar 1 18:20:05 2013 -0500

    Fix the rewrite rule that optimizes packing of string literals
    
    This patch addresses two issues:
    
    1) The particular rule was guarded under the wrong CPP conditional
    
       #if !defined(__GLASGOW_HASKELL__)
       ...
       #endif
    
       so GHC never even knew about it!
    
    2) The rule didn't apply to ByteStrings that were implicitly packed
       via OverloadedStrings.
    
    So now the RULE is properly guarded and applied earlier (or later,
    depending how you look at it). Specifically, the rule changed from
    
      forall s.
      pack      (unpackCString# s) = inlinePerfomIO (unsafePackAddress s)
      -- defined in Data.ByteString.Char8
    
    to
    
      forall s.
      packChars (unpackCString# s) = inlinePerfomIO (unsafePackAddress s)
      -- defined in Data.ByteString.Internal
    
    To achieve this, the definition of 'unsafePackAddress' had to be
    moved from the .Unsafe module to the .Internal module.


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

794c3459f8b6469bdc5c0a08f101696bf277ae65
 Data/ByteString/Char8.hs    |   11 +----------
 Data/ByteString/Internal.hs |   27 ++++++++++++++++++++++++++-
 Data/ByteString/Unsafe.hs   |    8 +-------
 3 files changed, 28 insertions(+), 18 deletions(-)

diff --git a/Data/ByteString/Char8.hs b/Data/ByteString/Char8.hs
index 6bad28e..9e710d9 100644
--- a/Data/ByteString/Char8.hs
+++ b/Data/ByteString/Char8.hs
@@ -284,16 +284,7 @@ singleton = B.singleton . c2w
 -- bottleneck.
 pack :: String -> ByteString
 pack = packChars
-
-#if !defined(__GLASGOW_HASKELL__)
-{-# INLINE [1] pack #-}
-
-{-# RULES
-"ByteString pack/packAddress" forall s .
-   pack (unpackCString# s) = inlinePerformIO (B.unsafePackAddress s)
- #-}
-
-#endif
+{-# INLINE pack #-}
 
 -- | /O(n)/ Converts a 'ByteString' to a 'String'.
 unpack :: ByteString -> [Char]
diff --git a/Data/ByteString/Internal.hs b/Data/ByteString/Internal.hs
index ed8e459..c48c693 100644
--- a/Data/ByteString/Internal.hs
+++ b/Data/ByteString/Internal.hs
@@ -32,6 +32,7 @@ module Data.ByteString.Internal (
         packChars, packUptoLenChars, unsafePackLenChars,
         unpackBytes, unpackAppendBytesLazy, unpackAppendBytesStrict,
         unpackChars, unpackAppendCharsLazy, unpackAppendCharsStrict,
+        unsafePackAddr,
 
         -- * Low level imperative construction
         create,                 -- :: Int -> (Ptr Word8 -> IO ()) -> IO ByteString
@@ -112,6 +113,8 @@ import Data.Generics            (Data(..), mkNorepType)
 
 #ifdef __GLASGOW_HASKELL__
 import GHC.Base                 (realWorld#,unsafeChr)
+import GHC.CString              (unpackCString#)
+import GHC.Prim                 (Addr#)
 #if __GLASGOW_HASKELL__ >= 611
 import GHC.IO                   (IO(IO))
 #else
@@ -128,7 +131,8 @@ import System.IO.Unsafe         (unsafePerformIO)
 #endif
 
 #ifdef __GLASGOW_HASKELL__
-import GHC.ForeignPtr           (mallocPlainForeignPtrBytes)
+import GHC.ForeignPtr           (newForeignPtr_, mallocPlainForeignPtrBytes)
+import GHC.Ptr                  (Ptr(..), castPtr)
 #else
 import Foreign.ForeignPtr       (mallocForeignPtrBytes)
 #endif
@@ -226,6 +230,15 @@ packBytes ws = unsafePackLenBytes (List.length ws) ws
 packChars :: [Char] -> ByteString
 packChars cs = unsafePackLenChars (List.length cs) cs
 
+#if defined(__GLASGOW_HASKELL__)
+{-# INLINE [0] packChars #-}
+
+{-# RULES
+"ByteString packChars/packAddress" forall s .
+   packChars (unpackCString# s) = inlinePerformIO (unsafePackAddr s)
+ #-}
+#endif
+
 unsafePackLenBytes :: Int -> [Word8] -> ByteString
 unsafePackLenBytes len xs0 =
     unsafeCreate len $ \p -> go p xs0
@@ -240,6 +253,18 @@ unsafePackLenChars len cs0 =
     go !_ []     = return ()
     go !p (c:cs) = poke p (c2w c) >> go (p `plusPtr` 1) cs
 
+#if defined(__GLASGOW_HASKELL__)
+unsafePackAddr :: Addr# -> IO ByteString
+unsafePackAddr addr# = do
+    p <- newForeignPtr_ (castPtr cstr)
+    l <- c_strlen cstr
+    return $ PS p 0 (fromIntegral l)
+  where
+    cstr :: CString
+    cstr = Ptr addr#
+{-# INLINE unsafePackAddr #-}
+#endif
+
 packUptoLenBytes :: Int -> [Word8] -> (ByteString, [Word8])
 packUptoLenBytes len xs0 =
     unsafeCreateUptoN' len $ \p -> go p len xs0
diff --git a/Data/ByteString/Unsafe.hs b/Data/ByteString/Unsafe.hs
index 242e366..6f8f7de 100644
--- a/Data/ByteString/Unsafe.hs
+++ b/Data/ByteString/Unsafe.hs
@@ -172,13 +172,7 @@ unsafeDrop n (PS x s l) = assert (0 <= n && n <= l) $ PS x (s+n) (l-n)
 -- the string (strlen will fail).
 --
 unsafePackAddress :: Addr# -> IO ByteString
-unsafePackAddress addr# = do
-    p <- newForeignPtr_ (castPtr cstr)
-    l <- c_strlen cstr
-    return $ PS p 0 (fromIntegral l)
-  where
-    cstr :: CString
-    cstr = Ptr addr#
+unsafePackAddress = unsafePackAddr
 {-# INLINE unsafePackAddress #-}
 
 -- | /O(1)/ 'unsafePackAddressLen' provides constant-time construction of