Repository : ssh://darcs.haskell.org//srv/darcs/packages/bytestring On branch : ghc-7.6
http://hackage.haskell.org/trac/ghc/changeset/d7c4f5b1d57fe0689bd6bd753e9390f35a109b5d >--------------------------------------------------------------- commit d7c4f5b1d57fe0689bd6bd753e9390f35a109b5d Author: Duncan Coutts <[email protected]> Date: Tue Sep 25 15:21:14 2012 +0000 Fix a few incorrect uses of inlinePerformIO The incorrect use of inlinePerformIO resulted in multiple calls to mallocByteString being shared, and hence two different strings sharing the same memory. See http://hackage.haskell.org/trac/ghc/ticket/7270 Consider: foo x = s `seq` r where r = B.map succ x s = B.map succ r The B.map function used a pattern like: map f (PS fp s len) = inlinePerformIO $ ... fp' <- mallocByteString len Now, in the foo function above, we have both r and s where the compiler can see that the 'len' is the same in both cases, and with inlinePerformIO exposing everything, the compiler is free to share the two calls to mallocByteString len. The answer is not to use inlinePerformIO if we are allocating, but to use unsafeDupablePerformIO instead. Another reminder that inlinePerformIO is really really unsafe, and that we should be using the ST monad instead. >--------------------------------------------------------------- Data/ByteString.hs | 12 ++++++------ 1 files changed, 6 insertions(+), 6 deletions(-) diff --git a/Data/ByteString.hs b/Data/ByteString.hs index 3c05109..91dcf94 100644 --- a/Data/ByteString.hs +++ b/Data/ByteString.hs @@ -474,7 +474,7 @@ append = mappend -- | /O(n)/ 'map' @f xs@ is the ByteString obtained by applying @f@ to each -- element of @xs@. This function is subject to array fusion. map :: (Word8 -> Word8) -> ByteString -> ByteString -map f (PS fp s len) = inlinePerformIO $ withForeignPtr fp $ \a -> +map f (PS fp s len) = unsafeDupablePerformIO $ withForeignPtr fp $ \a -> create len $ map_ 0 (a `plusPtr` s) where map_ :: Int -> Ptr Word8 -> Ptr Word8 -> IO () @@ -665,7 +665,7 @@ minimum xs@(PS x s l) -- passing an accumulating parameter from left to right, and returning a -- final value of this accumulator together with the new list. mapAccumL :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString) -mapAccumL f acc (PS fp o len) = inlinePerformIO $ withForeignPtr fp $ \a -> do +mapAccumL f acc (PS fp o len) = unsafeDupablePerformIO $ withForeignPtr fp $ \a -> do gp <- mallocByteString len acc' <- withForeignPtr gp $ \p -> mapAccumL_ acc 0 (a `plusPtr` o) p return $! (acc', PS gp 0 len) @@ -685,7 +685,7 @@ mapAccumL f acc (PS fp o len) = inlinePerformIO $ withForeignPtr fp $ \a -> do -- passing an accumulating parameter from right to left, and returning a -- final value of this accumulator together with the new ByteString. mapAccumR :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString) -mapAccumR f acc (PS fp o len) = inlinePerformIO $ withForeignPtr fp $ \a -> do +mapAccumR f acc (PS fp o len) = unsafeDupablePerformIO $ withForeignPtr fp $ \a -> do gp <- mallocByteString len acc' <- withForeignPtr gp $ \p -> mapAccumR_ acc (len-1) (a `plusPtr` o) p return $! (acc', PS gp 0 len) @@ -714,7 +714,7 @@ mapAccumR f acc (PS fp o len) = inlinePerformIO $ withForeignPtr fp $ \a -> do -- scanl :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString -scanl f v (PS fp s len) = inlinePerformIO $ withForeignPtr fp $ \a -> +scanl f v (PS fp s len) = unsafeDupablePerformIO $ withForeignPtr fp $ \a -> create (len+1) $ \q -> do poke q v scanl_ v 0 (a `plusPtr` s) (q `plusPtr` 1) @@ -745,7 +745,7 @@ scanl1 f ps -- | scanr is the right-to-left dual of scanl. scanr :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString -scanr f v (PS fp s len) = inlinePerformIO $ withForeignPtr fp $ \a -> +scanr f v (PS fp s len) = unsafeDupablePerformIO $ withForeignPtr fp $ \a -> create (len+1) $ \q -> do poke (q `plusPtr` len) v scanr_ v (len-1) (a `plusPtr` s) q @@ -1497,7 +1497,7 @@ zipWith f ps qs -- performed on the result of zipWith. -- zipWith' :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString -zipWith' f (PS fp s l) (PS fq t m) = inlinePerformIO $ +zipWith' f (PS fp s l) (PS fq t m) = unsafeDupablePerformIO $ withForeignPtr fp $ \a -> withForeignPtr fq $ \b -> create len $ zipWith_ 0 (a `plusPtr` s) (b `plusPtr` t) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
