{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE CPP, BangPatterns #-}
#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif
module Data.Trie.Internal.ByteString
( ByteString, ByteStringElem
, breakMaximalPrefix
, RevLazyByteString(..), (+>!), (+>?), fromStrict, toStrict
) where
import qualified Data.ByteString as S
import qualified Data.ByteString.Internal as S
import Data.ByteString.Internal (ByteString(PS))
import Data.Word
import Foreign.ForeignPtr (ForeignPtr)
#if MIN_VERSION_base(4,15,0)
import GHC.ForeignPtr (unsafeWithForeignPtr)
#else
import Foreign.ForeignPtr (withForeignPtr)
#endif
import Foreign.Ptr (Ptr, plusPtr)
import Foreign.Storable (Storable(..))
import GHC.IO (unsafeDupablePerformIO)
#if !(MIN_VERSION_base(4,15,0))
unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr = ForeignPtr a -> (Ptr a -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr
#endif
type ByteStringElem = Word8
breakMaximalPrefix
:: ByteString
-> ByteString
-> (ByteString, ByteString, ByteString)
breakMaximalPrefix :: ByteString -> ByteString -> (ByteString, ByteString, ByteString)
breakMaximalPrefix
s0 :: ByteString
s0@(PS ForeignPtr Word8
fp0 Int
off0 Int
len0)
s1 :: ByteString
s1@(PS ForeignPtr Word8
fp1 Int
off1 Int
len1)
| Int
len0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ByteString
-> ByteString -> ByteString -> (ByteString, ByteString, ByteString)
strictTriple ByteString
S.empty ByteString
S.empty ByteString
s1
| Int
len1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ByteString
-> ByteString -> ByteString -> (ByteString, ByteString, ByteString)
strictTriple ByteString
S.empty ByteString
s0 ByteString
S.empty
| Bool
otherwise =
let i :: Int
i = IO Int -> Int
forall a. IO a -> a
unsafeDupablePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$
ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp0 ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p0 ->
ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp1 ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p1 ->
Ptr Word8 -> Ptr Word8 -> Int -> IO Int
indexOfDifference
(Ptr Word8
p0 Ptr Word8 -> Int -> Ptr Word8
forall a. Storable a => Ptr a -> Int -> Ptr a
`ptrElemOff` Int
off0)
(Ptr Word8
p1 Ptr Word8 -> Int -> Ptr Word8
forall a. Storable a => Ptr a -> Int -> Ptr a
`ptrElemOff` Int
off1)
(Int
len0 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
len1)
in if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then ByteString
-> ByteString -> ByteString -> (ByteString, ByteString, ByteString)
strictTriple ByteString
S.empty ByteString
s0 ByteString
s1
else ByteString
-> ByteString -> ByteString -> (ByteString, ByteString, ByteString)
strictTriple
(if Int
off0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
off1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len1
then ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp0 Int
off0 Int
i
else ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp1 Int
off1 Int
i)
(Int -> ForeignPtr Word8 -> Int -> Int -> ByteString
dropPS Int
i ForeignPtr Word8
fp0 Int
off0 Int
len0)
(Int -> ForeignPtr Word8 -> Int -> Int -> ByteString
dropPS Int
i ForeignPtr Word8
fp1 Int
off1 Int
len1)
strictTriple :: ByteString -> ByteString -> ByteString
-> (ByteString, ByteString, ByteString)
strictTriple :: ByteString
-> ByteString -> ByteString -> (ByteString, ByteString, ByteString)
strictTriple !ByteString
p !ByteString
s !ByteString
z = (ByteString
p,ByteString
s,ByteString
z)
{-# INLINE strictTriple #-}
sizeOfElem :: Storable a => Ptr a -> Int
sizeOfElem :: Ptr a -> Int
sizeOfElem = a -> Int
forall a. Storable a => a -> Int
sizeOf (a -> Int) -> (Ptr a -> a) -> Ptr a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Ptr a -> a
forall a. HasCallStack => a
undefined :: Ptr a -> a)
{-# INLINE sizeOfElem #-}
ptrElemOff :: Storable a => Ptr a -> Int -> Ptr a
ptrElemOff :: Ptr a -> Int -> Ptr a
ptrElemOff Ptr a
p Int
i = Ptr a
p Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Ptr a -> Int
forall a. Storable a => Ptr a -> Int
sizeOfElem Ptr a
p)
{-# INLINE [0] ptrElemOff #-}
{-# RULES
"Data.Trie.ByteStringInternal ptrElemOff/0"
forall p . ptrElemOff p 0 = p
#-}
dropPS :: Int -> ForeignPtr ByteStringElem -> Int -> Int -> ByteString
dropPS :: Int -> ForeignPtr Word8 -> Int -> Int -> ByteString
dropPS !Int
n !ForeignPtr Word8
fp !Int
off !Int
len
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = ByteString
S.empty
| Bool
otherwise = ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
{-# INLINE dropPS #-}
indexOfDifference
:: Ptr ByteStringElem
-> Ptr ByteStringElem
-> Int
-> IO Int
indexOfDifference :: Ptr Word8 -> Ptr Word8 -> Int -> IO Int
indexOfDifference !Ptr Word8
p1 !Ptr Word8
p2 !Int
limit = Int -> IO Int
goByte Int
0
where
goByte :: Int -> IO Int
goByte Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
limit = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
limit
| Bool
otherwise = do
Word8
c1 <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
p1 Int
n
Word8
c2 <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
p2 Int
n
if Word8
c1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
c2
then Int -> IO Int
goByte (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
else Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
data RevLazyByteString
= RevLazyByteString :+> {-# UNPACK #-} !S.ByteString
| Nil
(+>!) :: RevLazyByteString -> S.ByteString -> RevLazyByteString
RevLazyByteString
xs +>! :: RevLazyByteString -> ByteString -> RevLazyByteString
+>! ByteString
x = RevLazyByteString
xs RevLazyByteString -> ByteString -> RevLazyByteString
:+> ByteString
x
{-# INLINE (+>!) #-}
(+>?) :: RevLazyByteString -> S.ByteString -> RevLazyByteString
RevLazyByteString
xs +>? :: RevLazyByteString -> ByteString -> RevLazyByteString
+>? PS ForeignPtr Word8
_ Int
_ Int
0 = RevLazyByteString
xs
RevLazyByteString
xs +>? ByteString
x = RevLazyByteString
xs RevLazyByteString -> ByteString -> RevLazyByteString
:+> ByteString
x
{-# INLINE (+>?) #-}
fromStrict :: S.ByteString -> RevLazyByteString
fromStrict :: ByteString -> RevLazyByteString
fromStrict = (RevLazyByteString
Nil RevLazyByteString -> ByteString -> RevLazyByteString
+>?)
{-# INLINE fromStrict #-}
(+?) :: Int -> Int -> Int
Int
x +? :: Int -> Int -> Int
+? Int
y
| Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Int
r
| Bool
otherwise = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
overflowError
where r :: Int
r = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y
{-# INLINE (+?) #-}
overflowError :: String
overflowError :: [Char]
overflowError = [Char]
"Data.Trie.ByteStringInternal.toStrict: size overflow"
{-# NOINLINE overflowError #-}
toStrict :: RevLazyByteString -> S.ByteString
toStrict :: RevLazyByteString -> ByteString
toStrict = \RevLazyByteString
cs0 -> RevLazyByteString -> RevLazyByteString -> ByteString
goLen0 RevLazyByteString
cs0 RevLazyByteString
cs0
where
goLen0 :: RevLazyByteString -> RevLazyByteString -> ByteString
goLen0 RevLazyByteString
_ RevLazyByteString
Nil = ByteString
S.empty
goLen0 RevLazyByteString
cs0 (RevLazyByteString
cs :+> PS ForeignPtr Word8
_ Int
_ Int
0) = RevLazyByteString -> RevLazyByteString -> ByteString
goLen0 RevLazyByteString
cs0 RevLazyByteString
cs
goLen0 RevLazyByteString
cs0 (RevLazyByteString
cs :+> ByteString
c) = RevLazyByteString -> ByteString -> RevLazyByteString -> ByteString
goLen1 RevLazyByteString
cs0 ByteString
c RevLazyByteString
cs
goLen1 :: RevLazyByteString -> ByteString -> RevLazyByteString -> ByteString
goLen1 RevLazyByteString
_ ByteString
b RevLazyByteString
Nil = ByteString
b
goLen1 RevLazyByteString
cs0 ByteString
b (RevLazyByteString
cs :+> PS ForeignPtr Word8
_ Int
_ Int
0) = RevLazyByteString -> ByteString -> RevLazyByteString -> ByteString
goLen1 RevLazyByteString
cs0 ByteString
b RevLazyByteString
cs
goLen1 RevLazyByteString
cs0 (PS ForeignPtr Word8
_ Int
_ Int
bl) (RevLazyByteString
cs :+> PS ForeignPtr Word8
_ Int
_ Int
cl) = RevLazyByteString -> Int -> RevLazyByteString -> ByteString
goLen RevLazyByteString
cs0 (Int
bl Int -> Int -> Int
+? Int
cl) RevLazyByteString
cs
goLen :: RevLazyByteString -> Int -> RevLazyByteString -> ByteString
goLen RevLazyByteString
cs0 !Int
total (RevLazyByteString
cs :+> PS ForeignPtr Word8
_ Int
_ Int
cl) = RevLazyByteString -> Int -> RevLazyByteString -> ByteString
goLen RevLazyByteString
cs0 (Int
total Int -> Int -> Int
+? Int
cl) RevLazyByteString
cs
goLen RevLazyByteString
cs0 Int
total RevLazyByteString
Nil =
Int -> (Ptr Word8 -> IO ()) -> ByteString
S.unsafeCreate Int
total ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
RevLazyByteString -> Ptr Word8 -> IO ()
goCopy RevLazyByteString
cs0 (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a. Storable a => Ptr a -> Int -> Ptr a
`ptrElemOff` Int
total)
goCopy :: RevLazyByteString -> Ptr Word8 -> IO ()
goCopy RevLazyByteString
Nil !Ptr Word8
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
goCopy (RevLazyByteString
cs :+> PS ForeignPtr Word8
_ Int
_ Int
0 ) !Ptr Word8
ptr = RevLazyByteString -> Ptr Word8 -> IO ()
goCopy RevLazyByteString
cs Ptr Word8
ptr
goCopy (RevLazyByteString
cs :+> PS ForeignPtr Word8
fp Int
off Int
len) !Ptr Word8
ptr =
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
let ptr' :: Ptr Word8
ptr' = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a. Storable a => Ptr a -> Int -> Ptr a
`ptrElemOff` Int -> Int
forall a. Num a => a -> a
negate Int
len
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
S.memcpy Ptr Word8
ptr' (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a. Storable a => Ptr a -> Int -> Ptr a
`ptrElemOff` Int
off) Int
len
RevLazyByteString -> Ptr Word8 -> IO ()
goCopy RevLazyByteString
cs Ptr Word8
ptr'