{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_HADDOCK hide, prune #-}
module Data.ByteString.Search.Internal.KnuthMorrisPratt (
indicesL
, indicesS
, matchLL
, matchLS
, matchSL
, matchSS
) where
import Data.ByteString.Search.Internal.Utils (kmpBorders, strictify)
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Unsafe (unsafeIndex)
import Data.Array.Base (unsafeAt)
import Data.Int (Int64)
{-# INLINE indicesL #-}
indicesL :: S.ByteString
-> L.ByteString
-> [Int64]
indicesL :: ByteString -> ByteString -> [Int64]
indicesL pat :: ByteString
pat = [ByteString] -> [Int64]
search ([ByteString] -> [Int64])
-> (ByteString -> [ByteString]) -> ByteString -> [Int64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks
where
search :: [ByteString] -> [Int64]
search = Bool -> ByteString -> [ByteString] -> [Int64]
forall a. Integral a => Bool -> ByteString -> [ByteString] -> [a]
matcher Bool
True ByteString
pat
{-# INLINE indicesS #-}
indicesS :: S.ByteString
-> S.ByteString
-> [Int]
indicesS :: ByteString -> ByteString -> [Int]
indicesS pat :: ByteString
pat = [ByteString] -> [Int]
search ([ByteString] -> [Int])
-> (ByteString -> [ByteString]) -> ByteString -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[])
where
search :: [ByteString] -> [Int]
search = Bool -> ByteString -> [ByteString] -> [Int]
forall a. Integral a => Bool -> ByteString -> [ByteString] -> [a]
matcher Bool
True ByteString
pat
{-# INLINE matchLL #-}
matchLL :: L.ByteString
-> L.ByteString
-> [Int64]
matchLL :: ByteString -> ByteString -> [Int64]
matchLL pat :: ByteString
pat = [ByteString] -> [Int64]
search ([ByteString] -> [Int64])
-> (ByteString -> [ByteString]) -> ByteString -> [Int64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks
where
!spat :: ByteString
spat = ByteString -> ByteString
strictify ByteString
pat
search :: [ByteString] -> [Int64]
search = Bool -> ByteString -> [ByteString] -> [Int64]
forall a. Integral a => Bool -> ByteString -> [ByteString] -> [a]
matcher Bool
False ByteString
spat
{-# INLINE matchLS #-}
matchLS :: L.ByteString
-> S.ByteString
-> [Int]
matchLS :: ByteString -> ByteString -> [Int]
matchLS pat :: ByteString
pat = [ByteString] -> [Int]
search ([ByteString] -> [Int])
-> (ByteString -> [ByteString]) -> ByteString -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[])
where
!spat :: ByteString
spat = ByteString -> ByteString
strictify ByteString
pat
search :: [ByteString] -> [Int]
search = Bool -> ByteString -> [ByteString] -> [Int]
forall a. Integral a => Bool -> ByteString -> [ByteString] -> [a]
matcher Bool
False ByteString
spat
{-# INLINE matchSS #-}
matchSS :: S.ByteString
-> S.ByteString
-> [Int]
matchSS :: ByteString -> ByteString -> [Int]
matchSS pat :: ByteString
pat = [ByteString] -> [Int]
search ([ByteString] -> [Int])
-> (ByteString -> [ByteString]) -> ByteString -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[])
where
search :: [ByteString] -> [Int]
search = Bool -> ByteString -> [ByteString] -> [Int]
forall a. Integral a => Bool -> ByteString -> [ByteString] -> [a]
matcher Bool
False ByteString
pat
{-# INLINE matchSL #-}
matchSL :: S.ByteString
-> L.ByteString
-> [Int64]
matchSL :: ByteString -> ByteString -> [Int64]
matchSL pat :: ByteString
pat = [ByteString] -> [Int64]
search ([ByteString] -> [Int64])
-> (ByteString -> [ByteString]) -> ByteString -> [Int64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks
where
search :: [ByteString] -> [Int64]
search = Bool -> ByteString -> [ByteString] -> [Int64]
forall a. Integral a => Bool -> ByteString -> [ByteString] -> [a]
matcher Bool
False ByteString
pat
{-# SPECIALISE matcher :: Bool -> S.ByteString -> [S.ByteString] -> [Int],
Bool -> S.ByteString -> [S.ByteString] -> [Int64] #-}
matcher :: Integral a => Bool -> S.ByteString -> [S.ByteString] -> [a]
matcher :: Bool -> ByteString -> [ByteString] -> [a]
matcher _ !ByteString
pat
| ByteString -> Bool
S.null ByteString
pat = (0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> ([ByteString] -> [a]) -> [ByteString] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [ByteString] -> [a]
forall t. Num t => t -> [ByteString] -> [t]
go 0
where
go :: t -> [ByteString] -> [t]
go _ [] = []
go !t
prior (!str :: ByteString
str : rest :: [ByteString]
rest) = [t
prior t -> t -> t
forall a. Num a => a -> a -> a
+ Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i | Int
i <- [1 .. Int
l]]
[t] -> [t] -> [t]
forall a. [a] -> [a] -> [a]
++ t -> [ByteString] -> [t]
go t
prior' [ByteString]
rest
where
!l :: Int
l = ByteString -> Int
S.length ByteString
str
!prior' :: t
prior' = t
prior t -> t -> t
forall a. Num a => a -> a -> a
+ Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l
matcher !Bool
overlap pat :: ByteString
pat = a -> Int -> [ByteString] -> [a]
forall t. Num t => t -> Int -> [ByteString] -> [t]
searcher 0 0
where
!patLen :: Int
patLen = ByteString -> Int
S.length ByteString
pat
!bords :: UArray Int Int
bords = ByteString -> UArray Int Int
kmpBorders ByteString
pat
!patH :: Word8
patH = Int -> Word8
patAt 0
{-# INLINE misi #-}
misi :: Int -> Int
misi !Int
i = UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt UArray Int Int
bords Int
i
{-# INLINE patAt #-}
patAt :: Int -> Word8
patAt !Int
i = ByteString -> Int -> Word8
unsafeIndex ByteString
pat Int
i
!ami :: Int
ami = if Bool
overlap then Int -> Int
misi Int
patLen else 0
searcher :: t -> Int -> [ByteString] -> [t]
searcher _ _ [] = []
searcher !t
prior !Int
patPos (!str :: ByteString
str : rest :: [ByteString]
rest)
| Int
patPos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Int -> [t]
checkHead 0
| Bool
otherwise = Int -> Int -> [t]
findMatch Int
patPos 0
where
!strLen :: Int
strLen = ByteString -> Int
S.length ByteString
str
{-# INLINE strAt #-}
strAt :: Int -> Word8
strAt !Int
i = ByteString -> Int -> Word8
unsafeIndex ByteString
str Int
i
checkHead :: Int -> [t]
checkHead !Int
strI
| Int
strI Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
strLen =
t -> Int -> [ByteString] -> [t]
searcher (t
prior t -> t -> t
forall a. Num a => a -> a -> a
+ Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
strLen) 0 [ByteString]
rest
| Int -> Word8
strAt Int
strI Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
patH = Int -> Int -> [t]
findMatch 1 (Int
strI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
| Bool
otherwise = Int -> [t]
checkHead (Int
strI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
findMatch :: Int -> Int -> [t]
findMatch !Int
patI !Int
strI
| Int
patI Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
patLen =
(t
prior t -> t -> t
forall a. Num a => a -> a -> a
+ Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
strI t -> t -> t
forall a. Num a => a -> a -> a
- Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
patLen)
t -> [t] -> [t]
forall a. a -> [a] -> [a]
: if Int
ami Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then Int -> [t]
checkHead Int
strI else Int -> Int -> [t]
findMatch Int
ami Int
strI
| Int
strI Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
strLen =
t -> Int -> [ByteString] -> [t]
searcher (t
prior t -> t -> t
forall a. Num a => a -> a -> a
+ Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
strLen) Int
patI [ByteString]
rest
| Bool
otherwise =
if Int -> Word8
strAt Int
strI Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Word8
patAt Int
patI
then Int -> Int -> [t]
findMatch (Int
patI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) (Int
strI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
else case Int -> Int
misi Int
patI of
0 -> Int -> [t]
checkHead Int
strI
(-1) -> Int -> [t]
checkHead (Int
strI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
pI :: Int
pI -> Int -> Int -> [t]
findMatch Int
pI Int
strI