From 07f7fcb4c845865dd220e00ec3ba2c224ee797b9 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Thu, 1 Apr 2021 21:23:29 -0400 Subject: [PATCH] Use unsafeWithForeignPtr when available It turns out that all uses of withForeignPtr can safely use unsafeWithForeignPtr. --- src/Data/Text/Encoding.hs | 14 ++++++------- src/Data/Text/Foreign.hs | 5 +++-- src/Data/Text/Internal/ByteStringCompat.hs | 1 + src/Data/Text/Internal/Encoding/Fusion.hs | 11 +++++----- src/Data/Text/Internal/Functions.hs | 20 ++++++++++++++++++- .../Text/Internal/Lazy/Encoding/Fusion.hs | 12 ++++++----- 6 files changed, 43 insertions(+), 20 deletions(-) diff --git a/src/Data/Text/Encoding.hs b/src/Data/Text/Encoding.hs index 239e15e35..39f57981d 100644 --- a/src/Data/Text/Encoding.hs +++ b/src/Data/Text/Encoding.hs @@ -69,9 +69,10 @@ import Control.Exception (evaluate, try, throwIO, ErrorCall(ErrorCall)) import Control.Monad.ST (runST) import Data.Bits ((.&.)) import Data.ByteString as B -import Data.ByteString.Internal as B hiding (c2w) +import Data.ByteString.Internal as B hiding (c2w, unsafeWithForeignPtr) import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode) import Data.Text.Internal (Text(..), safe, text) +import Data.Text.Internal.Functions import Data.Text.Internal.Private (runText) import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite) import Data.Text.Internal.Unsafe.Shift (shiftR) @@ -83,7 +84,6 @@ import Foreign.C.Types (CSize(CSize)) #else import Foreign.C.Types (CSize) #endif -import Foreign.ForeignPtr (withForeignPtr) import Foreign.Marshal.Utils (with) import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr) import Foreign.Storable (Storable, peek, poke) @@ -128,7 +128,7 @@ decodeLatin1 bs = withBS bs aux where aux fp len = text a 0 len where a = A.run (A.new len >>= unsafeIOToST . go) - go dest = withForeignPtr fp $ \ptr -> do + go dest = unsafeWithForeignPtr fp $ \ptr -> do c_decode_latin1 (A.maBA dest) ptr (ptr `plusPtr` len) return dest @@ -144,7 +144,7 @@ decodeUtf8With :: OnDecodeError -> ByteString -> Text decodeUtf8With onErr bs = withBS bs aux where aux fp len = runText $ \done -> do - let go dest = withForeignPtr fp $ \ptr -> + let go dest = unsafeWithForeignPtr fp $ \ptr -> with (0::CSize) $ \destOffPtr -> do let end = ptr `plusPtr` len loop curPtr = do @@ -300,7 +300,7 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0 aux fp len = runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1) where decodeChunkToBuffer :: A.MArray s -> IO Decoding - decodeChunkToBuffer dest = withForeignPtr fp $ \ptr -> + decodeChunkToBuffer dest = unsafeWithForeignPtr fp $ \ptr -> with (0::CSize) $ \destOffPtr -> with codepoint0 $ \codepointPtr -> with state0 $ \statePtr -> @@ -434,7 +434,7 @@ encodeUtf8 (Text arr off len) | len == 0 = B.empty | otherwise = unsafeDupablePerformIO $ do fp <- mallocByteString (len*3) -- see https://github.com/haskell/text/issues/194 for why len*3 is enough - withForeignPtr fp $ \ptr -> + unsafeWithForeignPtr fp $ \ptr -> with ptr $ \destPtr -> do c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len) newDest <- peek destPtr @@ -443,7 +443,7 @@ encodeUtf8 (Text arr off len) then return (mkBS fp utf8len) else do fp' <- mallocByteString utf8len - withForeignPtr fp' $ \ptr' -> do + unsafeWithForeignPtr fp' $ \ptr' -> do memcpy ptr' ptr (fromIntegral utf8len) return (mkBS fp' utf8len) diff --git a/src/Data/Text/Foreign.hs b/src/Data/Text/Foreign.hs index 2e9feab6b..b156a047e 100644 --- a/src/Data/Text/Foreign.hs +++ b/src/Data/Text/Foreign.hs @@ -42,10 +42,11 @@ import Control.Monad.ST (unsafeIOToST) import Data.ByteString.Unsafe (unsafePackCStringLen, unsafeUseAsCStringLen) import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Text.Internal (Text(..), empty) +import Data.Text.Internal.Functions (unsafeWithForeignPtr) import Data.Text.Unsafe (lengthWord16) import Data.Word (Word16) import Foreign.C.String (CStringLen) -import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray, withForeignPtr) +import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray) import Foreign.Marshal.Alloc (allocaBytes) import Foreign.Ptr (Ptr, castPtr, plusPtr) import Foreign.Storable (peek, poke) @@ -150,7 +151,7 @@ useAsPtr t@(Text _arr _off len) action = asForeignPtr :: Text -> IO (ForeignPtr Word16, I16) asForeignPtr t@(Text _arr _off len) = do fp <- mallocForeignPtrArray len - withForeignPtr fp $ unsafeCopyToPtr t + unsafeWithForeignPtr fp $ unsafeCopyToPtr t return (fp, I16 len) -- | /O(n)/ Decode a C string with explicit length, which is assumed diff --git a/src/Data/Text/Internal/ByteStringCompat.hs b/src/Data/Text/Internal/ByteStringCompat.hs index ee6dc18d5..4f8b39498 100644 --- a/src/Data/Text/Internal/ByteStringCompat.hs +++ b/src/Data/Text/Internal/ByteStringCompat.hs @@ -53,3 +53,4 @@ plusForeignPtr (ForeignPtr addr guts) (I# offset) = ForeignPtr (plusAddr# addr o #-} #endif #endif + diff --git a/src/Data/Text/Internal/Encoding/Fusion.hs b/src/Data/Text/Internal/Encoding/Fusion.hs index 41e0926f0..1354fbed1 100644 --- a/src/Data/Text/Internal/Encoding/Fusion.hs +++ b/src/Data/Text/Internal/Encoding/Fusion.hs @@ -44,8 +44,9 @@ import Data.Text.Encoding.Error import Data.Text.Internal.Encoding.Fusion.Common import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32) import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR) +import Data.Text.Internal.Functions (unsafeWithForeignPtr) import Data.Word (Word8, Word16, Word32) -import Foreign.ForeignPtr (withForeignPtr, ForeignPtr) +import Foreign.ForeignPtr (ForeignPtr) import Foreign.Storable (pokeByteOff) import qualified Data.ByteString as B import qualified Data.ByteString.Unsafe as B @@ -177,13 +178,13 @@ unstream (Stream next s0 len) = unsafeDupablePerformIO $ do Yield x s' | off == n -> realloc fp n off s' x | otherwise -> do - withForeignPtr fp $ \p -> pokeByteOff p off x + unsafeWithForeignPtr fp $ \p -> pokeByteOff p off x loop n (off+1) s' fp {-# NOINLINE realloc #-} realloc fp n off s x = do let n' = n+n fp' <- copy0 fp n n' - withForeignPtr fp' $ \p -> pokeByteOff p off x + unsafeWithForeignPtr fp' $ \p -> pokeByteOff p off x loop n' (off+1) s fp' {-# NOINLINE trimUp #-} trimUp fp _ off = return $! mkBS fp off @@ -194,8 +195,8 @@ unstream (Stream next s0 len) = unsafeDupablePerformIO $ do #endif do dest <- mallocByteString destLen - withForeignPtr src $ \src' -> - withForeignPtr dest $ \dest' -> + unsafeWithForeignPtr src $ \src' -> + unsafeWithForeignPtr dest $ \dest' -> memcpy dest' src' (fromIntegral srcLen) return dest diff --git a/src/Data/Text/Internal/Functions.hs b/src/Data/Text/Internal/Functions.hs index 2973b1e32..87d03216d 100644 --- a/src/Data/Text/Internal/Functions.hs +++ b/src/Data/Text/Internal/Functions.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -- | -- Module : Data.Text.Internal.Functions -- Copyright : 2010 Bryan O'Sullivan @@ -15,9 +17,18 @@ module Data.Text.Internal.Functions ( - intersperse + intersperse, + unsafeWithForeignPtr ) where +import Foreign.Ptr (Ptr) +import Foreign.ForeignPtr (ForeignPtr) +#if MIN_VERSION_base(4,15,0) +import qualified GHC.ForeignPtr (unsafeWithForeignPtr) +#else +import qualified Foreign.ForeignPtr (withForeignPtr) +#endif + -- | A lazier version of Data.List.intersperse. The other version -- causes space leaks! intersperse :: a -> [a] -> [a] @@ -27,3 +38,10 @@ intersperse sep (x:xs) = x : go xs go [] = [] go (y:ys) = sep : y: go ys {-# INLINE intersperse #-} + +unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b +#if MIN_VERSION_base(4,15,0) +unsafeWithForeignPtr = GHC.ForeignPtr.unsafeWithForeignPtr +#else +unsafeWithForeignPtr = Foreign.ForeignPtr.withForeignPtr +#endif diff --git a/src/Data/Text/Internal/Lazy/Encoding/Fusion.hs b/src/Data/Text/Internal/Lazy/Encoding/Fusion.hs index eff060714..43dabd9ba 100644 --- a/src/Data/Text/Internal/Lazy/Encoding/Fusion.hs +++ b/src/Data/Text/Internal/Lazy/Encoding/Fusion.hs @@ -35,18 +35,20 @@ module Data.Text.Internal.Lazy.Encoding.Fusion import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize) import qualified Data.ByteString as B import qualified Data.ByteString.Unsafe as B +import Data.Text.Internal.ByteStringCompat import Data.Text.Internal.Encoding.Fusion.Common import Data.Text.Encoding.Error import Data.Text.Internal.Fusion (Step(..), Stream(..)) import Data.Text.Internal.Fusion.Size import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32) import Data.Text.Internal.Unsafe.Shift (shiftL) +import Data.Text.Internal.Functions (unsafeWithForeignPtr) import Data.Word (Word8, Word16, Word32) import qualified Data.Text.Internal.Encoding.Utf8 as U8 import qualified Data.Text.Internal.Encoding.Utf16 as U16 import qualified Data.Text.Internal.Encoding.Utf32 as U32 import Data.Text.Unsafe (unsafeDupablePerformIO) -import Foreign.ForeignPtr (withForeignPtr, ForeignPtr) +import Foreign.ForeignPtr (ForeignPtr) import Foreign.Storable (pokeByteOff) import Data.ByteString.Internal (mallocByteString, memcpy) #if defined(ASSERTS) @@ -289,13 +291,13 @@ unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0) return $! Chunk (trimUp fp off) (chunk s newLen) | off == n -> realloc fp n off s' x | otherwise -> do - withForeignPtr fp $ \p -> pokeByteOff p off x + unsafeWithForeignPtr fp $ \p -> pokeByteOff p off x loop n (off+1) s' fp {-# NOINLINE realloc #-} realloc fp n off s x = do let n' = min (n+n) chunkSize fp' <- copy0 fp n n' - withForeignPtr fp' $ \p -> pokeByteOff p off x + unsafeWithForeignPtr fp' $ \p -> pokeByteOff p off x loop n' (off+1) s fp' trimUp fp off = mkBS fp off copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8) @@ -305,8 +307,8 @@ unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0) #endif do dest <- mallocByteString destLen - withForeignPtr src $ \src' -> - withForeignPtr dest $ \dest' -> + unsafeWithForeignPtr src $ \src' -> + unsafeWithForeignPtr dest $ \dest' -> memcpy dest' src' (fromIntegral srcLen) return dest