{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns #-}
{-# LANGUAGE UnliftedFFITypes, MagicHash,
UnboxedTuples #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# LANGUAGE Unsafe #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# OPTIONS_HADDOCK not-home #-}
module Data.ByteString.Internal.Type (
ByteString
( BS
, PS
),
StrictByteString,
findIndexOrLength,
packBytes, packUptoLenBytes, unsafePackLenBytes,
packChars, packUptoLenChars, unsafePackLenChars,
unpackBytes, unpackAppendBytesLazy, unpackAppendBytesStrict,
unpackChars, unpackAppendCharsLazy, unpackAppendCharsStrict,
unsafePackAddress, unsafePackLenAddress,
unsafePackLiteral, unsafePackLenLiteral,
empty,
createFp,
createFpUptoN,
createFpUptoN',
createFpAndTrim,
createFpAndTrim',
unsafeCreateFp,
unsafeCreateFpUptoN,
unsafeCreateFpUptoN',
create,
createUptoN,
createUptoN',
createAndTrim,
createAndTrim',
unsafeCreate,
unsafeCreateUptoN,
unsafeCreateUptoN',
mallocByteString,
mkDeferredByteString,
fromForeignPtr,
toForeignPtr,
fromForeignPtr0,
toForeignPtr0,
nullForeignPtr,
peekFp,
pokeFp,
peekFpByteOff,
pokeFpByteOff,
minusForeignPtr,
memcpyFp,
deferForeignPtrAvailability,
unsafeDupablePerformIO,
checkedAdd,
c_strlen,
c_free_finalizer,
memchr,
memcmp,
memcpy,
memset,
c_reverse,
c_intersperse,
c_maximum,
c_minimum,
c_count,
c_sort,
w2c, c2w, isSpaceWord8, isSpaceChar8,
accursedUnutterablePerformIO,
plusForeignPtr,
unsafeWithForeignPtr
) 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(..))
import Foreign.C.Types (CInt(..), CSize(..))
import Foreign.C.String (CString)
import Foreign.Marshal.Utils
#if MIN_VERSION_base(4,13,0)
import Data.Semigroup (Semigroup (sconcat, stimes))
#else
import Data.Semigroup (Semigroup ((<>), sconcat, stimes))
#endif
import Data.List.NonEmpty (NonEmpty ((:|)))
import Control.DeepSeq (NFData(rnf))
import Data.String (IsString(..))
import Control.Exception (assert)
import Data.Bits ((.&.))
import Data.Char (ord)
import Data.Word
import Data.Data (Data(..), mkNoRepType)
import GHC.Base (nullAddr#,realWorld#,unsafeChr)
import GHC.Exts (IsList(..), Addr#, minusAddr#)
import GHC.CString (unpackCString#)
import GHC.Magic (runRW#, lazy)
import GHC.IO (IO(IO))
import GHC.ForeignPtr (ForeignPtr(ForeignPtr)
#if __GLASGOW_HASKELL__ < 900
, newForeignPtr_
#endif
, mallocPlainForeignPtrBytes)
#if MIN_VERSION_base(4,10,0)
import GHC.ForeignPtr (plusForeignPtr)
#else
import GHC.Prim (plusAddr#)
#endif
#if __GLASGOW_HASKELL__ >= 811
import GHC.CString (cstringLength#)
import GHC.ForeignPtr (ForeignPtrContents(FinalPtr))
#else
import GHC.Ptr (Ptr(..))
#endif
import GHC.Types (Int (..))
#if MIN_VERSION_base(4,15,0)
import GHC.ForeignPtr (unsafeWithForeignPtr)
#endif
import qualified Language.Haskell.TH.Lib as TH
import qualified Language.Haskell.TH.Syntax as TH
#if !MIN_VERSION_base(4,15,0)
unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr = withForeignPtr
#endif
{-# CFILES cbits/fpstring.c #-}
#if !MIN_VERSION_base(4,10,0)
plusForeignPtr :: ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr (ForeignPtr addr guts) (I# offset) = ForeignPtr (plusAddr# addr offset) guts
{-# INLINE [0] plusForeignPtr #-}
{-# RULES
"ByteString plusForeignPtr/0" forall fp .
plusForeignPtr fp 0 = fp
#-}
#endif
minusForeignPtr :: ForeignPtr a -> ForeignPtr b -> Int
minusForeignPtr :: forall a b. ForeignPtr a -> ForeignPtr b -> Int
minusForeignPtr (ForeignPtr Addr#
addr1 ForeignPtrContents
_) (ForeignPtr Addr#
addr2 ForeignPtrContents
_)
= Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
addr1 Addr#
addr2)
peekFp :: Storable a => ForeignPtr a -> IO a
peekFp :: forall a. Storable a => ForeignPtr a -> IO a
peekFp ForeignPtr a
fp = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr a
fp forall a. Storable a => Ptr a -> IO a
peek
pokeFp :: Storable a => ForeignPtr a -> a -> IO ()
pokeFp :: forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp ForeignPtr a
fp a
val = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr a
fp forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
p a
val
peekFpByteOff :: Storable a => ForeignPtr a -> Int -> IO a
peekFpByteOff :: forall a. Storable a => ForeignPtr a -> Int -> IO a
peekFpByteOff ForeignPtr a
fp Int
off = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr a
fp forall a b. (a -> b) -> a -> b
$ \Ptr a
p ->
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr a
p Int
off
pokeFpByteOff :: Storable a => ForeignPtr b -> Int -> a -> IO ()
pokeFpByteOff :: forall a b. Storable a => ForeignPtr b -> Int -> a -> IO ()
pokeFpByteOff ForeignPtr b
fp Int
off a
val = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr b
fp forall a b. (a -> b) -> a -> b
$ \Ptr b
p ->
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p Int
off a
val
deferForeignPtrAvailability :: ForeignPtr a -> IO (ForeignPtr a)
deferForeignPtrAvailability :: forall a. ForeignPtr a -> IO (ForeignPtr a)
deferForeignPtrAvailability (ForeignPtr Addr#
addr0# ForeignPtrContents
guts) = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s0 ->
case forall a. a -> a
lazy forall o. (State# RealWorld -> o) -> o
runRW# (\State# RealWorld
_ -> (# State# RealWorld
s0, Addr#
addr0# #)) of
(# State# RealWorld
s1, Addr#
addr1# #) -> (# State# RealWorld
s1, forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
addr1# ForeignPtrContents
guts #)
mkDeferredByteString :: ForeignPtr Word8 -> Int -> IO ByteString
mkDeferredByteString :: ForeignPtr Word8 -> Int -> IO ByteString
mkDeferredByteString ForeignPtr Word8
fp Int
len = do
ForeignPtr Word8
deferredFp <- forall a. ForeignPtr a -> IO (ForeignPtr a)
deferForeignPtrAvailability ForeignPtr Word8
fp
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
deferredFp Int
len
unsafeDupablePerformIO :: IO a -> a
unsafeDupablePerformIO :: forall a. IO a -> a
unsafeDupablePerformIO (IO State# RealWorld -> (# State# RealWorld, a #)
act) = case forall o. (State# RealWorld -> o) -> o
runRW# State# RealWorld -> (# State# RealWorld, a #)
act of (# State# RealWorld
_, a
res #) -> a
res
data ByteString = BS {-# UNPACK #-} !(ForeignPtr Word8)
{-# UNPACK #-} !Int
type StrictByteString = ByteString
pattern PS :: ForeignPtr Word8 -> Int -> Int -> ByteString
pattern $bPS :: ForeignPtr Word8 -> Int -> Int -> ByteString
$mPS :: forall {r}.
ByteString
-> (ForeignPtr Word8 -> Int -> Int -> r) -> ((# #) -> r) -> r
PS fp zero len <- BS fp ((0,) -> (zero, len)) where
PS ForeignPtr Word8
fp Int
o Int
len = ForeignPtr Word8 -> Int -> ByteString
BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
fp Int
o) Int
len
#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE PS #-}
#endif
instance Eq ByteString where
== :: ByteString -> ByteString -> Bool
(==) = ByteString -> ByteString -> Bool
eq
instance Ord ByteString where
compare :: ByteString -> ByteString -> Ordering
compare = ByteString -> ByteString -> Ordering
compareBytes
instance Semigroup ByteString where
<> :: ByteString -> ByteString -> ByteString
(<>) = ByteString -> ByteString -> ByteString
append
sconcat :: NonEmpty ByteString -> ByteString
sconcat (ByteString
b:|[ByteString]
bs) = [ByteString] -> ByteString
concat (ByteString
bforall a. a -> [a] -> [a]
:[ByteString]
bs)
stimes :: forall b. Integral b => b -> ByteString -> ByteString
stimes = forall b. Integral b => b -> ByteString -> ByteString
times
instance Monoid ByteString where
mempty :: ByteString
mempty = ByteString
empty
mappend :: ByteString -> ByteString -> ByteString
mappend = forall a. Semigroup a => a -> a -> a
(<>)
mconcat :: [ByteString] -> ByteString
mconcat = [ByteString] -> ByteString
concat
instance NFData ByteString where
rnf :: ByteString -> ()
rnf BS{} = ()
instance Show ByteString where
showsPrec :: Int -> ByteString -> ShowS
showsPrec Int
p ByteString
ps String
r = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (ByteString -> String
unpackChars ByteString
ps) String
r
instance Read ByteString where
readsPrec :: Int -> ReadS ByteString
readsPrec Int
p String
str = [ (String -> ByteString
packChars String
x, String
y) | (String
x, String
y) <- forall a. Read a => Int -> ReadS a
readsPrec Int
p String
str ]
instance IsList ByteString where
type Item ByteString = Word8
fromList :: [Item ByteString] -> ByteString
fromList = [Word8] -> ByteString
packBytes
toList :: ByteString -> [Item ByteString]
toList = ByteString -> [Word8]
unpackBytes
instance IsString ByteString where
{-# INLINE fromString #-}
fromString :: String -> ByteString
fromString = String -> ByteString
packChars
instance Data ByteString where
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ByteString -> c ByteString
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z ByteString
txt = forall g. g -> c g
z [Word8] -> ByteString
packBytes forall d b. Data d => c (d -> b) -> d -> c b
`f` ByteString -> [Word8]
unpackBytes ByteString
txt
toConstr :: ByteString -> Constr
toConstr ByteString
_ = forall a. (?callStack::CallStack) => String -> a
error String
"Data.ByteString.ByteString.toConstr"
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ByteString
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_ = forall a. (?callStack::CallStack) => String -> a
error String
"Data.ByteString.ByteString.gunfold"
dataTypeOf :: ByteString -> DataType
dataTypeOf ByteString
_ = String -> DataType
mkNoRepType String
"Data.ByteString.ByteString"
instance TH.Lift ByteString where
#if MIN_VERSION_template_haskell(2,16,0)
lift :: forall (m :: * -> *). Quote m => ByteString -> m Exp
lift (BS ForeignPtr Word8
ptr Int
len) = [| unsafePackLenLiteral |]
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`TH.appE` forall (m :: * -> *). Quote m => Lit -> m Exp
TH.litE (Integer -> Lit
TH.integerL (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`TH.appE` forall (m :: * -> *). Quote m => Lit -> m Exp
TH.litE (Bytes -> Lit
TH.BytesPrimL forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Word -> Word -> Bytes
TH.Bytes ForeignPtr Word8
ptr Word
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))
#else
lift bs@(BS _ len) = [| unsafePackLenLiteral |]
`TH.appE` TH.litE (TH.integerL (fromIntegral len))
`TH.appE` TH.litE (TH.StringPrimL $ unpackBytes bs)
#endif
#if MIN_VERSION_template_haskell(2,17,0)
liftTyped :: forall (m :: * -> *). Quote m => ByteString -> Code m ByteString
liftTyped = forall a (m :: * -> *). Quote m => m Exp -> Code m a
TH.unsafeCodeCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift
#elif MIN_VERSION_template_haskell(2,16,0)
liftTyped = TH.unsafeTExpCoerce . TH.lift
#endif
findIndexOrLength :: (Word8 -> Bool) -> ByteString -> Int
findIndexOrLength :: (Word8 -> Bool) -> ByteString -> Int
findIndexOrLength Word8 -> Bool
k (BS ForeignPtr Word8
x Int
l) =
forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> IO Int
g ForeignPtr Word8
x
where
g :: ForeignPtr Word8 -> IO Int
g ForeignPtr Word8
ptr = Int -> IO Int
go Int
0
where
go :: Int -> IO Int
go !Int
n | Int
n forall a. Ord a => a -> a -> Bool
>= Int
l = forall (m :: * -> *) a. Monad m => a -> m a
return Int
l
| Bool
otherwise = do Word8
w <- forall a. Storable a => ForeignPtr a -> IO a
peekFp forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8
ptr forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
n
if Word8 -> Bool
k Word8
w
then forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
else Int -> IO Int
go (Int
nforall a. Num a => a -> a -> a
+Int
1)
{-# INLINE findIndexOrLength #-}
packBytes :: [Word8] -> ByteString
packBytes :: [Word8] -> ByteString
packBytes [Word8]
ws = Int -> [Word8] -> ByteString
unsafePackLenBytes (forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [Word8]
ws) [Word8]
ws
packChars :: [Char] -> ByteString
packChars :: String -> ByteString
packChars String
cs = Int -> String -> ByteString
unsafePackLenChars (forall (t :: * -> *) a. Foldable t => t a -> Int
List.length String
cs) String
cs
{-# INLINE [0] packChars #-}
{-# RULES
"ByteString packChars/packAddress" forall s .
packChars (unpackCString# s) = unsafePackLiteral s
#-}
unsafePackLenBytes :: Int -> [Word8] -> ByteString
unsafePackLenBytes :: Int -> [Word8] -> ByteString
unsafePackLenBytes Int
len [Word8]
xs0 =
Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
len forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
p -> forall {b}. Storable b => ForeignPtr b -> [b] -> IO ()
go ForeignPtr Word8
p [Word8]
xs0
where
go :: ForeignPtr b -> [b] -> IO ()
go !ForeignPtr b
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
go !ForeignPtr b
p (b
x:[b]
xs) = forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp ForeignPtr b
p b
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ForeignPtr b -> [b] -> IO ()
go (ForeignPtr b
p forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1) [b]
xs
unsafePackLenChars :: Int -> [Char] -> ByteString
unsafePackLenChars :: Int -> String -> ByteString
unsafePackLenChars Int
len String
cs0 =
Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
len forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
p -> ForeignPtr Word8 -> String -> IO ()
go ForeignPtr Word8
p String
cs0
where
go :: ForeignPtr Word8 -> String -> IO ()
go !ForeignPtr Word8
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
go !ForeignPtr Word8
p (Char
c:String
cs) = forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp ForeignPtr Word8
p (Char -> Word8
c2w Char
c) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ForeignPtr Word8 -> String -> IO ()
go (ForeignPtr Word8
p forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1) String
cs
unsafePackAddress :: Addr# -> IO ByteString
unsafePackAddress :: Addr# -> IO ByteString
unsafePackAddress Addr#
addr# = do
#if __GLASGOW_HASKELL__ >= 811
Int -> Addr# -> IO ByteString
unsafePackLenAddress (Int# -> Int
I# (Addr# -> Int#
cstringLength# Addr#
addr#)) Addr#
addr#
#else
l <- c_strlen (Ptr addr#)
unsafePackLenAddress (fromIntegral l) addr#
#endif
{-# INLINE unsafePackAddress #-}
unsafePackLenAddress :: Int -> Addr# -> IO ByteString
unsafePackLenAddress :: Int -> Addr# -> IO ByteString
unsafePackLenAddress Int
len Addr#
addr# = do
#if __GLASGOW_HASKELL__ >= 811
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> ByteString
BS (forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
addr# ForeignPtrContents
FinalPtr) Int
len)
#else
p <- newForeignPtr_ (Ptr addr#)
return $ BS p len
#endif
{-# INLINE unsafePackLenAddress #-}
unsafePackLiteral :: Addr# -> ByteString
unsafePackLiteral :: Addr# -> ByteString
unsafePackLiteral Addr#
addr# =
#if __GLASGOW_HASKELL__ >= 811
Int -> Addr# -> ByteString
unsafePackLenLiteral (Int# -> Int
I# (Addr# -> Int#
cstringLength# Addr#
addr#)) Addr#
addr#
#else
let len = accursedUnutterablePerformIO (c_strlen (Ptr addr#))
in unsafePackLenLiteral (fromIntegral len) addr#
#endif
{-# INLINE unsafePackLiteral #-}
unsafePackLenLiteral :: Int -> Addr# -> ByteString
unsafePackLenLiteral :: Int -> Addr# -> ByteString
unsafePackLenLiteral Int
len Addr#
addr# =
#if __GLASGOW_HASKELL__ >= 811
ForeignPtr Word8 -> Int -> ByteString
BS (forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
addr# ForeignPtrContents
FinalPtr) Int
len
#else
BS (unsafeDupablePerformIO (newForeignPtr_ (Ptr addr#))) len
#endif
{-# INLINE unsafePackLenLiteral #-}
packUptoLenBytes :: Int -> [Word8] -> (ByteString, [Word8])
packUptoLenBytes :: Int -> [Word8] -> (ByteString, [Word8])
packUptoLenBytes Int
len [Word8]
xs0 =
forall a.
Int -> (ForeignPtr Word8 -> IO (Int, a)) -> (ByteString, a)
unsafeCreateFpUptoN' Int
len forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
p0 ->
let p_end :: ForeignPtr Word8
p_end = forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
p0 Int
len
go :: ForeignPtr Word8 -> [Word8] -> IO (Int, [Word8])
go !ForeignPtr Word8
p [] = forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
p forall a b. ForeignPtr a -> ForeignPtr b -> Int
`minusForeignPtr` ForeignPtr Word8
p0, [])
go !ForeignPtr Word8
p [Word8]
xs | ForeignPtr Word8
p forall a. Eq a => a -> a -> Bool
== ForeignPtr Word8
p_end = forall (m :: * -> *) a. Monad m => a -> m a
return (Int
len, [Word8]
xs)
go !ForeignPtr Word8
p (Word8
x:[Word8]
xs) = forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp ForeignPtr Word8
p Word8
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ForeignPtr Word8 -> [Word8] -> IO (Int, [Word8])
go (ForeignPtr Word8
p forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1) [Word8]
xs
in ForeignPtr Word8 -> [Word8] -> IO (Int, [Word8])
go ForeignPtr Word8
p0 [Word8]
xs0
packUptoLenChars :: Int -> [Char] -> (ByteString, [Char])
packUptoLenChars :: Int -> String -> (ByteString, String)
packUptoLenChars Int
len String
cs0 =
forall a.
Int -> (ForeignPtr Word8 -> IO (Int, a)) -> (ByteString, a)
unsafeCreateFpUptoN' Int
len forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
p0 ->
let p_end :: ForeignPtr Word8
p_end = forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
p0 Int
len
go :: ForeignPtr Word8 -> String -> IO (Int, String)
go !ForeignPtr Word8
p [] = forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
p forall a b. ForeignPtr a -> ForeignPtr b -> Int
`minusForeignPtr` ForeignPtr Word8
p0, [])
go !ForeignPtr Word8
p String
cs | ForeignPtr Word8
p forall a. Eq a => a -> a -> Bool
== ForeignPtr Word8
p_end = forall (m :: * -> *) a. Monad m => a -> m a
return (Int
len, String
cs)
go !ForeignPtr Word8
p (Char
c:String
cs) = forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp ForeignPtr Word8
p (Char -> Word8
c2w Char
c) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ForeignPtr Word8 -> String -> IO (Int, String)
go (ForeignPtr Word8
p forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1) String
cs
in ForeignPtr Word8 -> String -> IO (Int, String)
go ForeignPtr Word8
p0 String
cs0
unpackBytes :: ByteString -> [Word8]
unpackBytes :: ByteString -> [Word8]
unpackBytes ByteString
bs = ByteString -> [Word8] -> [Word8]
unpackAppendBytesLazy ByteString
bs []
unpackChars :: ByteString -> [Char]
unpackChars :: ByteString -> String
unpackChars ByteString
bs = ByteString -> ShowS
unpackAppendCharsLazy ByteString
bs []
unpackAppendBytesLazy :: ByteString -> [Word8] -> [Word8]
unpackAppendBytesLazy :: ByteString -> [Word8] -> [Word8]
unpackAppendBytesLazy (BS ForeignPtr Word8
fp Int
len) [Word8]
xs
| Int
len forall a. Ord a => a -> a -> Bool
<= Int
100 = ByteString -> [Word8] -> [Word8]
unpackAppendBytesStrict (ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
fp Int
len) [Word8]
xs
| Bool
otherwise = ByteString -> [Word8] -> [Word8]
unpackAppendBytesStrict (ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
fp Int
100) [Word8]
remainder
where
remainder :: [Word8]
remainder = ByteString -> [Word8] -> [Word8]
unpackAppendBytesLazy (ForeignPtr Word8 -> Int -> ByteString
BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
fp Int
100) (Int
lenforall a. Num a => a -> a -> a
-Int
100)) [Word8]
xs
unpackAppendCharsLazy :: ByteString -> [Char] -> [Char]
unpackAppendCharsLazy :: ByteString -> ShowS
unpackAppendCharsLazy (BS ForeignPtr Word8
fp Int
len) String
cs
| Int
len forall a. Ord a => a -> a -> Bool
<= Int
100 = ByteString -> ShowS
unpackAppendCharsStrict (ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
fp Int
len) String
cs
| Bool
otherwise = ByteString -> ShowS
unpackAppendCharsStrict (ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
fp Int
100) String
remainder
where
remainder :: String
remainder = ByteString -> ShowS
unpackAppendCharsLazy (ForeignPtr Word8 -> Int -> ByteString
BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
fp Int
100) (Int
lenforall a. Num a => a -> a -> a
-Int
100)) String
cs
unpackAppendBytesStrict :: ByteString -> [Word8] -> [Word8]
unpackAppendBytesStrict :: ByteString -> [Word8] -> [Word8]
unpackAppendBytesStrict (BS ForeignPtr Word8
fp Int
len) [Word8]
xs =
forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
base ->
forall {b}. Storable b => Ptr b -> Ptr b -> [b] -> IO [b]
loop (Ptr Word8
base forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) (Ptr Word8
base forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1forall a. Num a => a -> a -> a
+Int
len)) [Word8]
xs
where
loop :: Ptr b -> Ptr b -> [b] -> IO [b]
loop !Ptr b
sentinal !Ptr b
p [b]
acc
| Ptr b
p forall a. Eq a => a -> a -> Bool
== Ptr b
sentinal = forall (m :: * -> *) a. Monad m => a -> m a
return [b]
acc
| Bool
otherwise = do b
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr b
p
Ptr b -> Ptr b -> [b] -> IO [b]
loop Ptr b
sentinal (Ptr b
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) (b
xforall a. a -> [a] -> [a]
:[b]
acc)
unpackAppendCharsStrict :: ByteString -> [Char] -> [Char]
(BS ForeignPtr Word8
fp Int
len) String
xs =
forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
base ->
Ptr Word8 -> Ptr Word8 -> String -> IO String
loop (Ptr Word8
base forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) (Ptr Word8
base forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1forall a. Num a => a -> a -> a
+Int
len)) String
xs
where
loop :: Ptr Word8 -> Ptr Word8 -> String -> IO String
loop !Ptr Word8
sentinal !Ptr Word8
p String
acc
| Ptr Word8
p forall a. Eq a => a -> a -> Bool
== Ptr Word8
sentinal = forall (m :: * -> *) a. Monad m => a -> m a
return String
acc
| Bool
otherwise = do Word8
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
Ptr Word8 -> Ptr Word8 -> String -> IO String
loop Ptr Word8
sentinal (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) (Word8 -> Char
w2c Word8
xforall a. a -> [a] -> [a]
:String
acc)
nullForeignPtr :: ForeignPtr Word8
#if __GLASGOW_HASKELL__ >= 811
nullForeignPtr :: ForeignPtr Word8
nullForeignPtr = forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
nullAddr# ForeignPtrContents
FinalPtr
#else
nullForeignPtr = ForeignPtr nullAddr# (error "nullForeignPtr")
#endif
fromForeignPtr :: ForeignPtr Word8
-> Int
-> Int
-> ByteString
fromForeignPtr :: ForeignPtr Word8 -> Int -> Int -> ByteString
fromForeignPtr ForeignPtr Word8
fp Int
o = ForeignPtr Word8 -> Int -> ByteString
BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
fp Int
o)
{-# INLINE fromForeignPtr #-}
fromForeignPtr0 :: ForeignPtr Word8
-> Int
-> ByteString
fromForeignPtr0 :: ForeignPtr Word8 -> Int -> ByteString
fromForeignPtr0 = ForeignPtr Word8 -> Int -> ByteString
BS
{-# INLINE fromForeignPtr0 #-}
toForeignPtr :: ByteString -> (ForeignPtr Word8, Int, Int)
toForeignPtr :: ByteString -> (ForeignPtr Word8, Int, Int)
toForeignPtr (BS ForeignPtr Word8
ps Int
l) = (ForeignPtr Word8
ps, Int
0, Int
l)
{-# INLINE toForeignPtr #-}
toForeignPtr0 :: ByteString -> (ForeignPtr Word8, Int)
toForeignPtr0 :: ByteString -> (ForeignPtr Word8, Int)
toForeignPtr0 (BS ForeignPtr Word8
ps Int
l) = (ForeignPtr Word8
ps, Int
l)
{-# INLINE toForeignPtr0 #-}
unsafeCreateFp :: Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp :: Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
l ForeignPtr Word8 -> IO ()
f = forall a. IO a -> a
unsafeDupablePerformIO (Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
createFp Int
l ForeignPtr Word8 -> IO ()
f)
{-# INLINE unsafeCreateFp #-}
unsafeCreateFpUptoN :: Int -> (ForeignPtr Word8 -> IO Int) -> ByteString
unsafeCreateFpUptoN :: Int -> (ForeignPtr Word8 -> IO Int) -> ByteString
unsafeCreateFpUptoN Int
l ForeignPtr Word8 -> IO Int
f = forall a. IO a -> a
unsafeDupablePerformIO (Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpUptoN Int
l ForeignPtr Word8 -> IO Int
f)
{-# INLINE unsafeCreateFpUptoN #-}
unsafeCreateFpUptoN'
:: Int -> (ForeignPtr Word8 -> IO (Int, a)) -> (ByteString, a)
unsafeCreateFpUptoN' :: forall a.
Int -> (ForeignPtr Word8 -> IO (Int, a)) -> (ByteString, a)
unsafeCreateFpUptoN' Int
l ForeignPtr Word8 -> IO (Int, a)
f = forall a. IO a -> a
unsafeDupablePerformIO (forall a.
Int -> (ForeignPtr Word8 -> IO (Int, a)) -> IO (ByteString, a)
createFpUptoN' Int
l ForeignPtr Word8 -> IO (Int, a)
f)
{-# INLINE unsafeCreateFpUptoN' #-}
createFp :: Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
createFp :: Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
createFp Int
l ForeignPtr Word8 -> IO ()
action = do
ForeignPtr Word8
fp <- forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
l
ForeignPtr Word8 -> IO ()
action ForeignPtr Word8
fp
ForeignPtr Word8 -> Int -> IO ByteString
mkDeferredByteString ForeignPtr Word8
fp Int
l
{-# INLINE createFp #-}
createFpUptoN :: Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpUptoN :: Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpUptoN Int
l ForeignPtr Word8 -> IO Int
action = do
ForeignPtr Word8
fp <- forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
l
Int
l' <- ForeignPtr Word8 -> IO Int
action ForeignPtr Word8
fp
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
l' forall a. Ord a => a -> a -> Bool
<= Int
l) forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> IO ByteString
mkDeferredByteString ForeignPtr Word8
fp Int
l'
{-# INLINE createFpUptoN #-}
createFpUptoN' :: Int -> (ForeignPtr Word8 -> IO (Int, a)) -> IO (ByteString, a)
createFpUptoN' :: forall a.
Int -> (ForeignPtr Word8 -> IO (Int, a)) -> IO (ByteString, a)
createFpUptoN' Int
l ForeignPtr Word8 -> IO (Int, a)
action = do
ForeignPtr Word8
fp <- forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
l
(Int
l', a
res) <- ForeignPtr Word8 -> IO (Int, a)
action ForeignPtr Word8
fp
ByteString
bs <- ForeignPtr Word8 -> Int -> IO ByteString
mkDeferredByteString ForeignPtr Word8
fp Int
l'
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
l' forall a. Ord a => a -> a -> Bool
<= Int
l) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
bs, a
res)
{-# INLINE createFpUptoN' #-}
createFpAndTrim :: Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpAndTrim :: Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpAndTrim Int
l ForeignPtr Word8 -> IO Int
action = do
ForeignPtr Word8
fp <- forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
l
Int
l' <- ForeignPtr Word8 -> IO Int
action ForeignPtr Word8
fp
if forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
0 forall a. Ord a => a -> a -> Bool
<= Int
l' Bool -> Bool -> Bool
&& Int
l' forall a. Ord a => a -> a -> Bool
<= Int
l) forall a b. (a -> b) -> a -> b
$ Int
l' forall a. Ord a => a -> a -> Bool
>= Int
l
then ForeignPtr Word8 -> Int -> IO ByteString
mkDeferredByteString ForeignPtr Word8
fp Int
l
else Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
createFp Int
l' forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
dest -> ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
dest ForeignPtr Word8
fp Int
l'
{-# INLINE createFpAndTrim #-}
createFpAndTrim' :: Int -> (ForeignPtr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
createFpAndTrim' :: forall a.
Int -> (ForeignPtr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
createFpAndTrim' Int
l ForeignPtr Word8 -> IO (Int, Int, a)
action = do
ForeignPtr Word8
fp <- forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
l
(Int
off, Int
l', a
res) <- ForeignPtr Word8 -> IO (Int, Int, a)
action ForeignPtr Word8
fp
ByteString
bs <- if forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
0 forall a. Ord a => a -> a -> Bool
<= Int
l' Bool -> Bool -> Bool
&& Int
l' forall a. Ord a => a -> a -> Bool
<= Int
l) forall a b. (a -> b) -> a -> b
$ Int
l' forall a. Ord a => a -> a -> Bool
>= Int
l
then ForeignPtr Word8 -> Int -> IO ByteString
mkDeferredByteString ForeignPtr Word8
fp Int
l
else Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
createFp Int
l' forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
dest ->
ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
dest (ForeignPtr Word8
fp forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
off) Int
l'
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bs, a
res)
{-# INLINE createFpAndTrim' #-}
wrapAction :: (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res
wrapAction :: forall res. (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res
wrapAction = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr
unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
l Ptr Word8 -> IO ()
f = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
l (forall res. (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res
wrapAction Ptr Word8 -> IO ()
f)
{-# INLINE unsafeCreate #-}
unsafeCreateUptoN :: Int -> (Ptr Word8 -> IO Int) -> ByteString
unsafeCreateUptoN :: Int -> (Ptr Word8 -> IO Int) -> ByteString
unsafeCreateUptoN Int
l Ptr Word8 -> IO Int
f = Int -> (ForeignPtr Word8 -> IO Int) -> ByteString
unsafeCreateFpUptoN Int
l (forall res. (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res
wrapAction Ptr Word8 -> IO Int
f)
{-# INLINE unsafeCreateUptoN #-}
unsafeCreateUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> (ByteString, a)
unsafeCreateUptoN' :: forall a. Int -> (Ptr Word8 -> IO (Int, a)) -> (ByteString, a)
unsafeCreateUptoN' Int
l Ptr Word8 -> IO (Int, a)
f = forall a.
Int -> (ForeignPtr Word8 -> IO (Int, a)) -> (ByteString, a)
unsafeCreateFpUptoN' Int
l (forall res. (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res
wrapAction Ptr Word8 -> IO (Int, a)
f)
{-# INLINE unsafeCreateUptoN' #-}
create :: Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create :: Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
l Ptr Word8 -> IO ()
action = Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
createFp Int
l (forall res. (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res
wrapAction Ptr Word8 -> IO ()
action)
{-# INLINE create #-}
createUptoN :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString
createUptoN :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString
createUptoN Int
l Ptr Word8 -> IO Int
action = Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpUptoN Int
l (forall res. (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res
wrapAction Ptr Word8 -> IO Int
action)
{-# INLINE createUptoN #-}
createUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (ByteString, a)
createUptoN' :: forall a. Int -> (Ptr Word8 -> IO (Int, a)) -> IO (ByteString, a)
createUptoN' Int
l Ptr Word8 -> IO (Int, a)
action = forall a.
Int -> (ForeignPtr Word8 -> IO (Int, a)) -> IO (ByteString, a)
createFpUptoN' Int
l (forall res. (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res
wrapAction Ptr Word8 -> IO (Int, a)
action)
{-# INLINE createUptoN' #-}
createAndTrim :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString
createAndTrim :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString
createAndTrim Int
l Ptr Word8 -> IO Int
action = Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpAndTrim Int
l (forall res. (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res
wrapAction Ptr Word8 -> IO Int
action)
{-# INLINE createAndTrim #-}
createAndTrim' :: Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
createAndTrim' :: forall a.
Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
createAndTrim' Int
l Ptr Word8 -> IO (Int, Int, a)
action = forall a.
Int -> (ForeignPtr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
createFpAndTrim' Int
l (forall res. (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res
wrapAction Ptr Word8 -> IO (Int, Int, a)
action)
{-# INLINE createAndTrim' #-}
mallocByteString :: Int -> IO (ForeignPtr a)
mallocByteString :: forall a. Int -> IO (ForeignPtr a)
mallocByteString = forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes
{-# INLINE mallocByteString #-}
eq :: ByteString -> ByteString -> Bool
eq :: ByteString -> ByteString -> Bool
eq a :: ByteString
a@(BS ForeignPtr Word8
fp Int
len) b :: ByteString
b@(BS ForeignPtr Word8
fp' Int
len')
| Int
len forall a. Eq a => a -> a -> Bool
/= Int
len' = Bool
False
| ForeignPtr Word8
fp forall a. Eq a => a -> a -> Bool
== ForeignPtr Word8
fp' = Bool
True
| Bool
otherwise = ByteString -> ByteString -> Ordering
compareBytes ByteString
a ByteString
b forall a. Eq a => a -> a -> Bool
== Ordering
EQ
{-# INLINE eq #-}
compareBytes :: ByteString -> ByteString -> Ordering
compareBytes :: ByteString -> ByteString -> Ordering
compareBytes (BS ForeignPtr Word8
_ Int
0) (BS ForeignPtr Word8
_ Int
0) = Ordering
EQ
compareBytes (BS ForeignPtr Word8
fp1 Int
len1) (BS ForeignPtr Word8
fp2 Int
len2) =
forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp1 forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p1 ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp2 forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p2 -> do
CInt
i <- Ptr Word8 -> Ptr Word8 -> Int -> IO CInt
memcmp Ptr Word8
p1 Ptr Word8
p2 (forall a. Ord a => a -> a -> a
min Int
len1 Int
len2)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! case CInt
i forall a. Ord a => a -> a -> Ordering
`compare` CInt
0 of
Ordering
EQ -> Int
len1 forall a. Ord a => a -> a -> Ordering
`compare` Int
len2
Ordering
x -> Ordering
x
empty :: ByteString
empty :: ByteString
empty = ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
nullForeignPtr Int
0
append :: ByteString -> ByteString -> ByteString
append :: ByteString -> ByteString -> ByteString
append (BS ForeignPtr Word8
_ Int
0) ByteString
b = ByteString
b
append ByteString
a (BS ForeignPtr Word8
_ Int
0) = ByteString
a
append (BS ForeignPtr Word8
fp1 Int
len1) (BS ForeignPtr Word8
fp2 Int
len2) =
Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp (Int
len1forall a. Num a => a -> a -> a
+Int
len2) forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
destptr1 -> do
let destptr2 :: ForeignPtr Word8
destptr2 = ForeignPtr Word8
destptr1 forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
len1
ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
destptr1 ForeignPtr Word8
fp1 Int
len1
ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
destptr2 ForeignPtr Word8
fp2 Int
len2
concat :: [ByteString] -> ByteString
concat :: [ByteString] -> ByteString
concat = \[ByteString]
bss0 -> [ByteString] -> [ByteString] -> ByteString
goLen0 [ByteString]
bss0 [ByteString]
bss0
where
goLen0 :: [ByteString] -> [ByteString] -> ByteString
goLen0 [ByteString]
_ [] = ByteString
empty
goLen0 [ByteString]
bss0 (BS ForeignPtr Word8
_ Int
0 :[ByteString]
bss) = [ByteString] -> [ByteString] -> ByteString
goLen0 [ByteString]
bss0 [ByteString]
bss
goLen0 [ByteString]
bss0 (ByteString
bs :[ByteString]
bss) = [ByteString] -> ByteString -> [ByteString] -> ByteString
goLen1 [ByteString]
bss0 ByteString
bs [ByteString]
bss
goLen1 :: [ByteString] -> ByteString -> [ByteString] -> ByteString
goLen1 [ByteString]
_ ByteString
bs [] = ByteString
bs
goLen1 [ByteString]
bss0 ByteString
bs (BS ForeignPtr Word8
_ Int
0 :[ByteString]
bss) = [ByteString] -> ByteString -> [ByteString] -> ByteString
goLen1 [ByteString]
bss0 ByteString
bs [ByteString]
bss
goLen1 [ByteString]
bss0 ByteString
bs (BS ForeignPtr Word8
_ Int
len:[ByteString]
bss) = [ByteString] -> Int -> [ByteString] -> ByteString
goLen [ByteString]
bss0 (String -> Int -> Int -> Int
checkedAdd String
"concat" Int
len' Int
len) [ByteString]
bss
where BS ForeignPtr Word8
_ Int
len' = ByteString
bs
goLen :: [ByteString] -> Int -> [ByteString] -> ByteString
goLen [ByteString]
bss0 !Int
total (BS ForeignPtr Word8
_ Int
len:[ByteString]
bss) = [ByteString] -> Int -> [ByteString] -> ByteString
goLen [ByteString]
bss0 Int
total' [ByteString]
bss
where total' :: Int
total' = String -> Int -> Int -> Int
checkedAdd String
"concat" Int
total Int
len
goLen [ByteString]
bss0 Int
total [] =
Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
total forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
ptr -> [ByteString] -> ForeignPtr Word8 -> IO ()
goCopy [ByteString]
bss0 ForeignPtr Word8
ptr
goCopy :: [ByteString] -> ForeignPtr Word8 -> IO ()
goCopy [] !ForeignPtr Word8
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
goCopy (BS ForeignPtr Word8
_ Int
0 :[ByteString]
bss) !ForeignPtr Word8
ptr = [ByteString] -> ForeignPtr Word8 -> IO ()
goCopy [ByteString]
bss ForeignPtr Word8
ptr
goCopy (BS ForeignPtr Word8
fp Int
len:[ByteString]
bss) !ForeignPtr Word8
ptr = do
ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
ptr ForeignPtr Word8
fp Int
len
[ByteString] -> ForeignPtr Word8 -> IO ()
goCopy [ByteString]
bss (ForeignPtr Word8
ptr forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
len)
{-# NOINLINE concat #-}
{-# RULES
"ByteString concat [] -> empty"
concat [] = empty
"ByteString concat [bs] -> bs" forall x.
concat [x] = x
#-}
times :: Integral a => a -> ByteString -> ByteString
times :: forall b. Integral b => b -> ByteString -> ByteString
times a
n (BS ForeignPtr Word8
fp Int
len)
| a
n forall a. Ord a => a -> a -> Bool
< a
0 = forall a. (?callStack::CallStack) => String -> a
error String
"stimes: non-negative multiplier expected"
| a
n forall a. Eq a => a -> a -> Bool
== a
0 = ByteString
empty
| a
n forall a. Eq a => a -> a -> Bool
== a
1 = ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
fp Int
len
| Int
len forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString
empty
| Int
len forall a. Eq a => a -> a -> Bool
== Int
1 = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
size forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
destfptr -> do
Word8
byte <- forall a. Storable a => ForeignPtr a -> IO a
peekFp ForeignPtr Word8
fp
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
destfptr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
destptr ->
forall a. Ptr a -> Word8 -> Int -> IO ()
fillBytes Ptr Word8
destptr Word8
byte (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)
| Bool
otherwise = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
size forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
destptr -> do
ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
destptr ForeignPtr Word8
fp Int
len
ForeignPtr Word8 -> Int -> IO ()
fillFrom ForeignPtr Word8
destptr Int
len
where
size :: Int
size = Int
len forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n
fillFrom :: ForeignPtr Word8 -> Int -> IO ()
fillFrom :: ForeignPtr Word8 -> Int -> IO ()
fillFrom ForeignPtr Word8
destptr Int
copied
| Int
2 forall a. Num a => a -> a -> a
* Int
copied forall a. Ord a => a -> a -> Bool
<= Int
size = do
ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp (ForeignPtr Word8
destptr forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
copied) ForeignPtr Word8
destptr Int
copied
ForeignPtr Word8 -> Int -> IO ()
fillFrom ForeignPtr Word8
destptr (Int
copied forall a. Num a => a -> a -> a
* Int
2)
| Bool
otherwise = ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp (ForeignPtr Word8
destptr forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
copied) ForeignPtr Word8
destptr (Int
size forall a. Num a => a -> a -> a
- Int
copied)
checkedAdd :: String -> Int -> Int -> Int
checkedAdd :: String -> Int -> Int -> Int
checkedAdd String
fun Int
x Int
y
| Int
r forall a. Ord a => a -> a -> Bool
>= Int
0 = Int
r
| Bool
otherwise = forall a. String -> a
overflowError String
fun
where r :: Int
r = Int
x forall a. Num a => a -> a -> a
+ Int
y
{-# INLINE checkedAdd #-}
w2c :: Word8 -> Char
w2c :: Word8 -> Char
w2c = Int -> Char
unsafeChr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE w2c #-}
c2w :: Char -> Word8
c2w :: Char -> Word8
c2w = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
{-# INLINE c2w #-}
isSpaceWord8 :: Word8 -> Bool
isSpaceWord8 :: Word8 -> Bool
isSpaceWord8 Word8
w8 =
let w :: Word
!w :: Word
w = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8
in Word
w forall a. Bits a => a -> a -> a
.&. Word
0x50 forall a. Eq a => a -> a -> Bool
== Word
0
Bool -> Bool -> Bool
&& Word
w forall a. Num a => a -> a -> a
- Word
0x21 forall a. Ord a => a -> a -> Bool
> Word
0x7e
Bool -> Bool -> Bool
&& ( Word
w forall a. Eq a => a -> a -> Bool
== Word
0x20
Bool -> Bool -> Bool
|| Word
w forall a. Eq a => a -> a -> Bool
== Word
0xa0
Bool -> Bool -> Bool
|| Word
w forall a. Num a => a -> a -> a
- Word
0x09 forall a. Ord a => a -> a -> Bool
< Word
5)
{-# INLINE isSpaceWord8 #-}
isSpaceChar8 :: Char -> Bool
isSpaceChar8 :: Char -> Bool
isSpaceChar8 = Word8 -> Bool
isSpaceWord8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w
{-# INLINE isSpaceChar8 #-}
overflowError :: String -> a
overflowError :: forall a. String -> a
overflowError String
fun = forall a. (?callStack::CallStack) => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Data.ByteString." forall a. [a] -> [a] -> [a]
++ String
fun forall a. [a] -> [a] -> [a]
++ String
": size overflow"
{-# INLINE accursedUnutterablePerformIO #-}
accursedUnutterablePerformIO :: IO a -> a
accursedUnutterablePerformIO :: forall a. IO a -> a
accursedUnutterablePerformIO (IO State# RealWorld -> (# State# RealWorld, a #)
m) = case State# RealWorld -> (# State# RealWorld, a #)
m State# RealWorld
realWorld# of (# State# RealWorld
_, a
r #) -> a
r
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 :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memchr Ptr Word8
p Word8
w CSize
sz = Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)
c_memchr Ptr Word8
p (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w) CSize
sz
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 :: Ptr Word8 -> Ptr Word8 -> Int -> IO CInt
memcmp Ptr Word8
p Ptr Word8
q Int
s = Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt
c_memcmp Ptr Word8
p Ptr Word8
q (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s)
{-# DEPRECATED memcpy "Use Foreign.Marshal.Utils.copyBytes instead" #-}
memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy = forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes
memcpyFp :: ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp :: ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
fp ForeignPtr Word8
fq Int
s = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fq forall a b. (a -> b) -> a -> b
$ \Ptr Word8
q -> forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
p Ptr Word8
q Int
s
foreign import ccall unsafe "string.h memset" c_memset
:: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)
{-# DEPRECATED memset "Use Foreign.Marshal.Utils.fillBytes instead" #-}
memset :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memset :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memset Ptr Word8
p Word8
w CSize
sz = Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)
c_memset Ptr Word8
p (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w) CSize
sz
foreign import ccall unsafe "static fpstring.h fps_reverse" c_reverse
:: Ptr Word8 -> Ptr Word8 -> CSize -> IO ()
foreign import ccall unsafe "static fpstring.h fps_intersperse" c_intersperse
:: Ptr Word8 -> Ptr Word8 -> CSize -> Word8 -> IO ()
foreign import ccall unsafe "static fpstring.h fps_maximum" c_maximum
:: Ptr Word8 -> CSize -> IO Word8
foreign import ccall unsafe "static fpstring.h fps_minimum" c_minimum
:: Ptr Word8 -> CSize -> IO Word8
foreign import ccall unsafe "static fpstring.h fps_count" c_count
:: Ptr Word8 -> CSize -> Word8 -> IO CSize
foreign import ccall unsafe "static fpstring.h fps_sort" c_sort
:: Ptr Word8 -> CSize -> IO ()