#if __GLASGOW_HASKELL__ >= 703
#endif
module Data.ByteString.Internal (
ByteString(..),
packBytes, packUptoLenBytes, unsafePackLenBytes,
packChars, packUptoLenChars, unsafePackLenChars,
unpackBytes, unpackAppendBytesLazy, unpackAppendBytesStrict,
unpackChars, unpackAppendCharsLazy, unpackAppendCharsStrict,
unsafePackAddress,
create,
createUptoN,
createAndTrim,
createAndTrim',
unsafeCreate,
unsafeCreateUptoN,
mallocByteString,
fromForeignPtr,
toForeignPtr,
nullForeignPtr,
checkedAdd,
c_strlen,
c_free_finalizer,
memchr,
memcmp,
memcpy,
memset,
c_reverse,
c_intersperse,
c_maximum,
c_minimum,
c_count,
w2c, c2w, isSpaceWord8, isSpaceChar8,
accursedUnutterablePerformIO,
inlinePerformIO
) where
import Prelude hiding (concat, null)
import qualified Data.List as List
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.Ptr (Ptr, FunPtr, plusPtr)
import Foreign.Storable (Storable(..))
#if MIN_VERSION_base(4,5,0) || __GLASGOW_HASKELL__ >= 703
import Foreign.C.Types (CInt(..), CSize(..), CULong(..))
#else
import Foreign.C.Types (CInt, CSize, CULong)
#endif
import Foreign.C.String (CString)
#if MIN_VERSION_base(4,13,0)
import Data.Semigroup (Semigroup (sconcat))
import Data.List.NonEmpty (NonEmpty ((:|)))
#elif MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup ((<>), sconcat))
import Data.List.NonEmpty (NonEmpty ((:|)))
#endif
#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid (Monoid(..))
#endif
import Control.DeepSeq (NFData(rnf))
import Data.String (IsString(..))
import Control.Exception (assert)
import Data.Char (ord)
import Data.Word (Word8)
import Data.Typeable (Typeable)
import Data.Data (Data(..), mkNoRepType)
import GHC.Base (nullAddr#,realWorld#,unsafeChr)
#if MIN_VERSION_base(4,4,0)
import GHC.CString (unpackCString#)
#else
import GHC.Base (unpackCString#)
#endif
import GHC.Prim (Addr#)
#if __GLASGOW_HASKELL__ >= 611
import GHC.IO (IO(IO),unsafeDupablePerformIO)
#else
import GHC.IOBase (IO(IO),RawBuffer,unsafeDupablePerformIO)
#endif
import GHC.ForeignPtr (ForeignPtr(ForeignPtr)
,newForeignPtr_, mallocPlainForeignPtrBytes)
import GHC.Ptr (Ptr(..), castPtr)
data ByteString = PS !(ForeignPtr Word8)
!Int
!Int
deriving (Typeable)
instance Eq ByteString where
(==) = eq
instance Ord ByteString where
compare = compareBytes
#if MIN_VERSION_base(4,9,0)
instance Semigroup ByteString where
(<>) = append
sconcat (b:|bs) = concat (b:bs)
#endif
instance Monoid ByteString where
mempty = PS nullForeignPtr 0 0
#if MIN_VERSION_base(4,9,0)
mappend = (<>)
#else
mappend = append
#endif
mconcat = concat
instance NFData ByteString where
rnf PS{} = ()
instance Show ByteString where
showsPrec p ps r = showsPrec p (unpackChars ps) r
instance Read ByteString where
readsPrec p str = [ (packChars x, y) | (x, y) <- readsPrec p str ]
instance IsString ByteString where
fromString = packChars
instance Data ByteString where
gfoldl f z txt = z packBytes `f` unpackBytes txt
toConstr _ = error "Data.ByteString.ByteString.toConstr"
gunfold _ _ = error "Data.ByteString.ByteString.gunfold"
dataTypeOf _ = mkNoRepType "Data.ByteString.ByteString"
packBytes :: [Word8] -> ByteString
packBytes ws = unsafePackLenBytes (List.length ws) ws
packChars :: [Char] -> ByteString
packChars cs = unsafePackLenChars (List.length cs) cs
unsafePackLenBytes :: Int -> [Word8] -> ByteString
unsafePackLenBytes len xs0 =
unsafeCreate len $ \p -> go p xs0
where
go !_ [] = return ()
go !p (x:xs) = poke p x >> go (p `plusPtr` 1) xs
unsafePackLenChars :: Int -> [Char] -> ByteString
unsafePackLenChars len cs0 =
unsafeCreate len $ \p -> go p cs0
where
go !_ [] = return ()
go !p (c:cs) = poke p (c2w c) >> go (p `plusPtr` 1) cs
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#
packUptoLenBytes :: Int -> [Word8] -> (ByteString, [Word8])
packUptoLenBytes len xs0 =
unsafeCreateUptoN' len $ \p -> go p len xs0
where
go !_ !n [] = return (lenn, [])
go !_ !0 xs = return (len, xs)
go !p !n (x:xs) = poke p x >> go (p `plusPtr` 1) (n1) xs
packUptoLenChars :: Int -> [Char] -> (ByteString, [Char])
packUptoLenChars len cs0 =
unsafeCreateUptoN' len $ \p -> go p len cs0
where
go !_ !n [] = return (lenn, [])
go !_ !0 cs = return (len, cs)
go !p !n (c:cs) = poke p (c2w c) >> go (p `plusPtr` 1) (n1) cs
unpackBytes :: ByteString -> [Word8]
unpackBytes bs = unpackAppendBytesLazy bs []
unpackChars :: ByteString -> [Char]
unpackChars bs = unpackAppendCharsLazy bs []
unpackAppendBytesLazy :: ByteString -> [Word8] -> [Word8]
unpackAppendBytesLazy (PS fp off len) xs
| len <= 100 = unpackAppendBytesStrict (PS fp off len) xs
| otherwise = unpackAppendBytesStrict (PS fp off 100) remainder
where
remainder = unpackAppendBytesLazy (PS fp (off+100) (len100)) xs
unpackAppendCharsLazy :: ByteString -> [Char] -> [Char]
unpackAppendCharsLazy (PS fp off len) cs
| len <= 100 = unpackAppendCharsStrict (PS fp off len) cs
| otherwise = unpackAppendCharsStrict (PS fp off 100) remainder
where
remainder = unpackAppendCharsLazy (PS fp (off+100) (len100)) cs
unpackAppendBytesStrict :: ByteString -> [Word8] -> [Word8]
unpackAppendBytesStrict (PS fp off len) xs =
accursedUnutterablePerformIO $ withForeignPtr fp $ \base ->
loop (base `plusPtr` (off1)) (base `plusPtr` (off1+len)) xs
where
loop !sentinal !p acc
| p == sentinal = return acc
| otherwise = do x <- peek p
loop sentinal (p `plusPtr` (1)) (x:acc)
unpackAppendCharsStrict :: ByteString -> [Char] -> [Char]
unpackAppendCharsStrict (PS fp off len) xs =
accursedUnutterablePerformIO $ withForeignPtr fp $ \base ->
loop (base `plusPtr` (off1)) (base `plusPtr` (off1+len)) xs
where
loop !sentinal !p acc
| p == sentinal = return acc
| otherwise = do x <- peek p
loop sentinal (p `plusPtr` (1)) (w2c x:acc)
nullForeignPtr :: ForeignPtr Word8
nullForeignPtr = ForeignPtr nullAddr# (error "nullForeignPtr")
fromForeignPtr :: ForeignPtr Word8
-> Int
-> Int
-> ByteString
fromForeignPtr = PS
toForeignPtr :: ByteString -> (ForeignPtr Word8, Int, Int)
toForeignPtr (PS ps s l) = (ps, s, l)
unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate l f = unsafeDupablePerformIO (create l f)
unsafeCreateUptoN :: Int -> (Ptr Word8 -> IO Int) -> ByteString
unsafeCreateUptoN l f = unsafeDupablePerformIO (createUptoN l f)
unsafeCreateUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> (ByteString, a)
unsafeCreateUptoN' l f = unsafeDupablePerformIO (createUptoN' l f)
create :: Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create l f = do
fp <- mallocByteString l
withForeignPtr fp $ \p -> f p
return $! PS fp 0 l
createUptoN :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString
createUptoN l f = do
fp <- mallocByteString l
l' <- withForeignPtr fp $ \p -> f p
assert (l' <= l) $ return $! PS fp 0 l'
createUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (ByteString, a)
createUptoN' l f = do
fp <- mallocByteString l
(l', res) <- withForeignPtr fp $ \p -> f p
assert (l' <= l) $ return (PS fp 0 l', res)
createAndTrim :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString
createAndTrim l f = do
fp <- mallocByteString l
withForeignPtr fp $ \p -> do
l' <- f p
if assert (l' <= l) $ l' >= l
then return $! PS fp 0 l
else create l' $ \p' -> memcpy p' p l'
createAndTrim' :: Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
createAndTrim' l f = do
fp <- mallocByteString l
withForeignPtr fp $ \p -> do
(off, l', res) <- f p
if assert (l' <= l) $ l' >= l
then return (PS fp 0 l, res)
else do ps <- create l' $ \p' ->
memcpy p' (p `plusPtr` off) l'
return (ps, res)
mallocByteString :: Int -> IO (ForeignPtr a)
mallocByteString = mallocPlainForeignPtrBytes
eq :: ByteString -> ByteString -> Bool
eq a@(PS fp off len) b@(PS fp' off' len')
| len /= len' = False
| fp == fp' && off == off' = True
| otherwise = compareBytes a b == EQ
compareBytes :: ByteString -> ByteString -> Ordering
compareBytes (PS _ _ 0) (PS _ _ 0) = EQ
compareBytes (PS fp1 off1 len1) (PS fp2 off2 len2) =
accursedUnutterablePerformIO $
withForeignPtr fp1 $ \p1 ->
withForeignPtr fp2 $ \p2 -> do
i <- memcmp (p1 `plusPtr` off1) (p2 `plusPtr` off2) (min len1 len2)
return $! case i `compare` 0 of
EQ -> len1 `compare` len2
x -> x
append :: ByteString -> ByteString -> ByteString
append (PS _ _ 0) b = b
append a (PS _ _ 0) = a
append (PS fp1 off1 len1) (PS fp2 off2 len2) =
unsafeCreate (len1+len2) $ \destptr1 -> do
let destptr2 = destptr1 `plusPtr` len1
withForeignPtr fp1 $ \p1 -> memcpy destptr1 (p1 `plusPtr` off1) len1
withForeignPtr fp2 $ \p2 -> memcpy destptr2 (p2 `plusPtr` off2) len2
concat :: [ByteString] -> ByteString
concat = \bss0 -> goLen0 bss0 bss0
where
goLen0 _ [] = mempty
goLen0 bss0 (PS _ _ 0 :bss) = goLen0 bss0 bss
goLen0 bss0 (bs :bss) = goLen1 bss0 bs bss
goLen1 _ bs [] = bs
goLen1 bss0 bs (PS _ _ 0 :bss) = goLen1 bss0 bs bss
goLen1 bss0 bs (PS _ _ len:bss) = goLen bss0 (checkedAdd "concat" len' len) bss
where PS _ _ len' = bs
goLen bss0 !total (PS _ _ len:bss) = goLen bss0 total' bss
where total' = checkedAdd "concat" total len
goLen bss0 total [] =
unsafeCreate total $ \ptr -> goCopy bss0 ptr
goCopy [] !_ = return ()
goCopy (PS _ _ 0 :bss) !ptr = goCopy bss ptr
goCopy (PS fp off len:bss) !ptr = do
withForeignPtr fp $ \p -> memcpy ptr (p `plusPtr` off) len
goCopy bss (ptr `plusPtr` len)
checkedAdd :: String -> Int -> Int -> Int
checkedAdd fun x y
| r >= 0 = r
| otherwise = overflowError fun
where r = x + y
w2c :: Word8 -> Char
w2c = unsafeChr . fromIntegral
c2w :: Char -> Word8
c2w = fromIntegral . ord
isSpaceWord8 :: Word8 -> Bool
isSpaceWord8 w =
w == 0x20 ||
w == 0x0A ||
w == 0x09 ||
w == 0x0C ||
w == 0x0D ||
w == 0x0B ||
w == 0xA0
isSpaceChar8 :: Char -> Bool
isSpaceChar8 c =
c == ' ' ||
c == '\t' ||
c == '\n' ||
c == '\r' ||
c == '\f' ||
c == '\v' ||
c == '\xa0'
overflowError :: String -> a
overflowError fun = error $ "Data.ByteString." ++ fun ++ ": size overflow"
accursedUnutterablePerformIO :: IO a -> a
accursedUnutterablePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
inlinePerformIO :: IO a -> a
inlinePerformIO = accursedUnutterablePerformIO
foreign import ccall unsafe "string.h strlen" c_strlen
:: CString -> IO CSize
foreign import ccall unsafe "static stdlib.h &free" c_free_finalizer
:: FunPtr (Ptr Word8 -> IO ())
foreign import ccall unsafe "string.h memchr" c_memchr
:: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)
memchr :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memchr p w s = c_memchr p (fromIntegral w) s
foreign import ccall unsafe "string.h memcmp" c_memcmp
:: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt
memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO CInt
memcmp p q s = c_memcmp p q (fromIntegral s)
foreign import ccall unsafe "string.h memcpy" c_memcpy
:: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)
memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy p q s = c_memcpy p q (fromIntegral s) >> return ()
foreign import ccall unsafe "string.h memset" c_memset
:: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)
memset :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memset p w s = c_memset p (fromIntegral w) s
foreign import ccall unsafe "static fpstring.h fps_reverse" c_reverse
:: Ptr Word8 -> Ptr Word8 -> CULong -> IO ()
foreign import ccall unsafe "static fpstring.h fps_intersperse" c_intersperse
:: Ptr Word8 -> Ptr Word8 -> CULong -> Word8 -> IO ()
foreign import ccall unsafe "static fpstring.h fps_maximum" c_maximum
:: Ptr Word8 -> CULong -> IO Word8
foreign import ccall unsafe "static fpstring.h fps_minimum" c_minimum
:: Ptr Word8 -> CULong -> IO Word8
foreign import ccall unsafe "static fpstring.h fps_count" c_count
:: Ptr Word8 -> CULong -> Word8 -> IO CULong