module Z.Data.Vector.Search (
findIndices, elemIndices
, find, findR
, findIndex, findIndexR
, filter, partition
, indicesOverlapping
, indices
, elemIndicesBytes, findByte, findByteR
, indicesOverlappingBytes, indicesBytes
, kmpNextTable
, sundayBloom
, elemSundayBloom
) where
import Control.Monad.ST
import Data.Bits
import GHC.Word
import Prelude hiding (filter)
import Z.Data.Array
import Z.Data.Vector.Base
elemIndices :: (Vec v a, Eq a) => a -> v a -> [Int]
{-# INLINE [1] elemIndices #-}
{-# RULES "elemIndices/Bytes" elemIndices = elemIndicesBytes #-}
elemIndices :: forall (v :: * -> *) a. (Vec v a, Eq a) => a -> v a -> [Int]
elemIndices a
w (Vec IArray v a
arr Int
s Int
l) = Int -> [Int]
go Int
s
where
!end :: Int
end = Int
s forall a. Num a => a -> a -> a
+ Int
l
go :: Int -> [Int]
go !Int
i
| Int
i forall a. Ord a => a -> a -> Bool
>= Int
end = []
| a
x forall a. Eq a => a -> a -> Bool
== a
w = let !i' :: Int
i' = Int
i forall a. Num a => a -> a -> a
- Int
s in Int
i' forall a. a -> [a] -> [a]
: Int -> [Int]
go (Int
iforall a. Num a => a -> a -> a
+Int
1)
| Bool
otherwise = Int -> [Int]
go (Int
iforall a. Num a => a -> a -> a
+Int
1)
where (# a
x #) = forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> (# a #)
indexArr' IArray v a
arr Int
i
findIndices :: Vec v a => (a -> Bool) -> v a -> [Int]
{-# INLINE [1] findIndices #-}
{-# RULES "findIndices/Bytes1" forall w. findIndices (w `eqWord8`) = elemIndicesBytes w #-}
{-# RULES "findIndices/Bytes2" forall w. findIndices (`eqWord8` w) = elemIndicesBytes w #-}
findIndices :: forall (v :: * -> *) a. Vec v a => (a -> Bool) -> v a -> [Int]
findIndices a -> Bool
f (Vec IArray v a
arr Int
s Int
l) = Int -> [Int]
go Int
s
where
!end :: Int
end = Int
s forall a. Num a => a -> a -> a
+ Int
l
go :: Int -> [Int]
go !Int
p | Int
p forall a. Ord a => a -> a -> Bool
>= Int
end = []
| a -> Bool
f a
x = Int
p forall a. a -> [a] -> [a]
: Int -> [Int]
go (Int
pforall a. Num a => a -> a -> a
+Int
1)
| Bool
otherwise = Int -> [Int]
go (Int
pforall a. Num a => a -> a -> a
+Int
1)
where (# a
x #) = forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> (# a #)
indexArr' IArray v a
arr Int
p
elemIndicesBytes :: Word8 -> Bytes -> [Int]
{-# INLINABLE elemIndicesBytes #-}
elemIndicesBytes :: Word8 -> Bytes -> [Int]
elemIndicesBytes Word8
w (PrimVector (PrimArray ByteArray#
ba#) Int
s Int
l) = Int -> [Int]
go Int
s
where
!end :: Int
end = Int
s forall a. Num a => a -> a -> a
+ Int
l
go :: Int -> [Int]
go !Int
i
| Int
i forall a. Ord a => a -> a -> Bool
>= Int
end = []
| Bool
otherwise =
case ByteArray# -> Int -> Word8 -> Int -> Int
c_memchr ByteArray#
ba# Int
i Word8
w (Int
end forall a. Num a => a -> a -> a
- Int
i) of
-1 -> []
Int
r -> let !i' :: Int
i' = (Int
iforall a. Num a => a -> a -> a
+Int
r) in Int
i'forall a. a -> [a] -> [a]
: Int -> [Int]
go (Int
i'forall a. Num a => a -> a -> a
+Int
1)
findIndex :: Vec v a => (a -> Bool) -> v a -> Int
{-# INLINABLE findIndex #-}
findIndex :: forall (v :: * -> *) a. Vec v a => (a -> Bool) -> v a -> Int
findIndex a -> Bool
f v a
v = forall a b. (a, b) -> a
fst (forall (v :: * -> *) a.
Vec v a =>
(a -> Bool) -> v a -> (Int, Maybe a)
find a -> Bool
f v a
v)
findIndexR :: Vec v a => (a -> Bool) -> v a -> Int
{-# INLINABLE findIndexR #-}
findIndexR :: forall (v :: * -> *) a. Vec v a => (a -> Bool) -> v a -> Int
findIndexR a -> Bool
f v a
v = forall a b. (a, b) -> a
fst (forall (v :: * -> *) a.
Vec v a =>
(a -> Bool) -> v a -> (Int, Maybe a)
findR a -> Bool
f v a
v)
find :: Vec v a => (a -> Bool) -> v a -> (Int, Maybe a)
{-# INLINE [1] find #-}
{-# RULES "find/Bytes1" forall w. find (w `eqWord8`) = findByte w #-}
{-# RULES "find/Bytes2" forall w. find (`eqWord8` w) = findByte w #-}
find :: forall (v :: * -> *) a.
Vec v a =>
(a -> Bool) -> v a -> (Int, Maybe a)
find a -> Bool
f (Vec IArray v a
arr Int
s Int
l) = Int -> (Int, Maybe a)
go Int
s
where
!end :: Int
end = Int
s forall a. Num a => a -> a -> a
+ Int
l
go :: Int -> (Int, Maybe a)
go !Int
p | Int
p forall a. Ord a => a -> a -> Bool
>= Int
end = (Int
l, forall a. Maybe a
Nothing)
| a -> Bool
f a
x = let !i :: Int
i = Int
pforall a. Num a => a -> a -> a
-Int
s in (Int
i, forall a. a -> Maybe a
Just a
x)
| Bool
otherwise = Int -> (Int, Maybe a)
go (Int
pforall a. Num a => a -> a -> a
+Int
1)
where (# a
x #) = forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> (# a #)
indexArr' IArray v a
arr Int
p
findByte :: Word8 -> Bytes -> (Int, Maybe Word8)
{-# INLINABLE findByte #-}
findByte :: Word8 -> Bytes -> (Int, Maybe Word8)
findByte Word8
w (PrimVector (PrimArray ByteArray#
ba#) Int
s Int
l) =
case ByteArray# -> Int -> Word8 -> Int -> Int
c_memchr ByteArray#
ba# Int
s Word8
w Int
l of
-1 -> (Int
l, forall a. Maybe a
Nothing)
Int
r -> (Int
r, forall a. a -> Maybe a
Just Word8
w)
findR :: Vec v a => (a -> Bool) -> v a -> (Int, Maybe a)
{-# INLINE [1] findR #-}
{-# RULES "findR/Bytes1" forall w. findR (w `eqWord8`) = findByteR w #-}
{-# RULES "findR/Bytes2" forall w. findR (`eqWord8` w) = findByteR w #-}
findR :: forall (v :: * -> *) a.
Vec v a =>
(a -> Bool) -> v a -> (Int, Maybe a)
findR a -> Bool
f (Vec IArray v a
arr Int
s Int
l) = Int -> (Int, Maybe a)
go (Int
sforall a. Num a => a -> a -> a
+Int
lforall a. Num a => a -> a -> a
-Int
1)
where
go :: Int -> (Int, Maybe a)
go !Int
p | Int
p forall a. Ord a => a -> a -> Bool
< Int
s = (-Int
1, forall a. Maybe a
Nothing)
| a -> Bool
f a
x = let !i :: Int
i = Int
pforall a. Num a => a -> a -> a
-Int
s in (Int
i, forall a. a -> Maybe a
Just a
x)
| Bool
otherwise = Int -> (Int, Maybe a)
go (Int
pforall a. Num a => a -> a -> a
-Int
1)
where (# a
x #) = forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> (# a #)
indexArr' IArray v a
arr Int
p
findByteR :: Word8 -> Bytes -> (Int, Maybe Word8)
{-# INLINABLE findByteR #-}
findByteR :: Word8 -> Bytes -> (Int, Maybe Word8)
findByteR Word8
w (PrimVector (PrimArray ByteArray#
ba#) Int
s Int
l) =
case ByteArray# -> Int -> Word8 -> Int -> Int
c_memrchr ByteArray#
ba# Int
s Word8
w Int
l of
-1 -> (-Int
1, forall a. Maybe a
Nothing)
Int
r -> (Int
r, forall a. a -> Maybe a
Just Word8
w)
filter :: forall v a. Vec v a => (a -> Bool) -> v a -> v a
{-# INLINABLE filter #-}
filter :: forall (v :: * -> *) a. Vec v a => (a -> Bool) -> v a -> v a
filter a -> Bool
g (Vec IArray v a
arr Int
s Int
l)
| Int
l forall a. Eq a => a -> a -> Bool
== Int
0 = forall (v :: * -> *) a. Vec v a => v a
empty
| Bool
otherwise = forall (v :: * -> *) a.
(Vec v a, HasCallStack) =>
Int -> (forall s. MArr (IArray v) s a -> ST s Int) -> v a
createN Int
l (forall s.
(a -> Bool) -> Int -> Int -> MArr (IArray v) s a -> ST s Int
go a -> Bool
g Int
0 Int
s)
where
!end :: Int
end = Int
s forall a. Num a => a -> a -> a
+ Int
l
go :: (a -> Bool) -> Int -> Int -> MArr (IArray v) s a -> ST s Int
go :: forall s.
(a -> Bool) -> Int -> Int -> MArr (IArray v) s a -> ST s Int
go a -> Bool
f !Int
i !Int
p !MArr (IArray v) s a
marr
| Int
p forall a. Ord a => a -> a -> Bool
>= Int
end = forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
| a -> Bool
f a
x = forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s a
marr Int
i a
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s.
(a -> Bool) -> Int -> Int -> MArr (IArray v) s a -> ST s Int
go a -> Bool
f (Int
iforall a. Num a => a -> a -> a
+Int
1) (Int
pforall a. Num a => a -> a -> a
+Int
1) MArr (IArray v) s a
marr
| Bool
otherwise = forall s.
(a -> Bool) -> Int -> Int -> MArr (IArray v) s a -> ST s Int
go a -> Bool
f Int
i (Int
pforall a. Num a => a -> a -> a
+Int
1) MArr (IArray v) s a
marr
where (# a
x #) = forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> (# a #)
indexArr' IArray v a
arr Int
p
partition :: forall v a. Vec v a => (a -> Bool) -> v a -> (v a, v a)
{-# INLINABLE partition #-}
partition :: forall (v :: * -> *) a. Vec v a => (a -> Bool) -> v a -> (v a, v a)
partition a -> Bool
g (Vec IArray v a
arr Int
s Int
l)
| Int
l forall a. Eq a => a -> a -> Bool
== Int
0 = (forall (v :: * -> *) a. Vec v a => v a
empty, forall (v :: * -> *) a. Vec v a => v a
empty)
| Bool
otherwise = forall (v :: * -> *) a (u :: * -> *) b.
(Vec v a, Vec u b, HasCallStack) =>
Int
-> Int
-> (forall s.
MArr (IArray v) s a -> MArr (IArray u) s b -> ST s (Int, Int))
-> (v a, u b)
createN2 Int
l Int
l (forall s.
(a -> Bool)
-> Int
-> Int
-> Int
-> MArr (IArray v) s a
-> MArr (IArray v) s a
-> ST s (Int, Int)
go a -> Bool
g Int
0 Int
0 Int
s)
where
!end :: Int
end = Int
s forall a. Num a => a -> a -> a
+ Int
l
go :: (a -> Bool) -> Int -> Int -> Int -> MArr (IArray v) s a -> MArr (IArray v) s a -> ST s (Int, Int)
go :: forall s.
(a -> Bool)
-> Int
-> Int
-> Int
-> MArr (IArray v) s a
-> MArr (IArray v) s a
-> ST s (Int, Int)
go a -> Bool
f !Int
i !Int
j !Int
p !MArr (IArray v) s a
mba0 !MArr (IArray v) s a
mba1
| Int
p forall a. Ord a => a -> a -> Bool
>= Int
end = forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, Int
j)
| a -> Bool
f a
x = forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s a
mba0 Int
i a
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s.
(a -> Bool)
-> Int
-> Int
-> Int
-> MArr (IArray v) s a
-> MArr (IArray v) s a
-> ST s (Int, Int)
go a -> Bool
f (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
j (Int
pforall a. Num a => a -> a -> a
+Int
1) MArr (IArray v) s a
mba0 MArr (IArray v) s a
mba1
| Bool
otherwise = forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s a
mba1 Int
j a
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s.
(a -> Bool)
-> Int
-> Int
-> Int
-> MArr (IArray v) s a
-> MArr (IArray v) s a
-> ST s (Int, Int)
go a -> Bool
f Int
i (Int
jforall a. Num a => a -> a -> a
+Int
1) (Int
pforall a. Num a => a -> a -> a
+Int
1) MArr (IArray v) s a
mba0 MArr (IArray v) s a
mba1
where (# a
x #) = forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> (# a #)
indexArr' IArray v a
arr Int
p
indicesOverlapping :: (Vec v a, Eq a)
=> v a
-> v a
-> Bool
-> [Int]
{-# INLINE [1] indicesOverlapping #-}
{-# RULES "indicesOverlapping/Bytes" indicesOverlapping = indicesOverlappingBytes #-}
indicesOverlapping :: forall (v :: * -> *) a.
(Vec v a, Eq a) =>
v a -> v a -> Bool -> [Int]
indicesOverlapping needle :: v a
needle@(Vec IArray v a
narr Int
noff Int
nlen) = v a -> Bool -> [Int]
search
where
next :: PrimArray Int
next = forall (v :: * -> *) a. (Vec v a, Eq a) => v a -> PrimArray Int
kmpNextTable v a
needle
search :: v a -> Bool -> [Int]
search haystack :: v a
haystack@(Vec IArray v a
harr Int
hoff Int
hlen) Bool
reportPartial
| Int
nlen forall a. Ord a => a -> a -> Bool
<= Int
0 = [Int
0..Int
hlenforall a. Num a => a -> a -> a
-Int
1]
| Int
nlen forall a. Eq a => a -> a -> Bool
== Int
1 = case forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> (# a #)
indexArr' IArray v a
narr Int
noff of
(# a
x #) -> forall (v :: * -> *) a. (Vec v a, Eq a) => a -> v a -> [Int]
elemIndices a
x v a
haystack
| Bool
otherwise = Int -> Int -> [Int]
kmp Int
0 Int
0
where
kmp :: Int -> Int -> [Int]
kmp !Int
i !Int
j | Int
i forall a. Ord a => a -> a -> Bool
>= Int
hlen = if Bool
reportPartial Bool -> Bool -> Bool
&& Int
j forall a. Eq a => a -> a -> Bool
/= Int
0 then [-Int
j] else []
| IArray v a
narr forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` (Int
jforall a. Num a => a -> a -> a
+Int
noff) forall a. Eq a => a -> a -> Bool
== IArray v a
harr forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` (Int
iforall a. Num a => a -> a -> a
+Int
hoff) =
let !j' :: Int
j' = Int
jforall a. Num a => a -> a -> a
+Int
1
in if Int
j' forall a. Ord a => a -> a -> Bool
>= Int
nlen
then let !i' :: Int
i' = Int
iforall a. Num a => a -> a -> a
-Int
j
in case PrimArray Int
next forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` Int
j' of
-1 -> Int
i' forall a. a -> [a] -> [a]
: Int -> Int -> [Int]
kmp (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
0
Int
j'' -> Int
i' forall a. a -> [a] -> [a]
: Int -> Int -> [Int]
kmp (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
j''
else Int -> Int -> [Int]
kmp (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
j'
| Bool
otherwise = case PrimArray Int
next forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` Int
j of
-1 -> Int -> Int -> [Int]
kmp (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
0
Int
j' -> Int -> Int -> [Int]
kmp Int
i Int
j'
indicesOverlappingBytes :: Bytes
-> Bytes
-> Bool
-> [Int]
{-# INLINABLE indicesOverlappingBytes #-}
indicesOverlappingBytes :: Bytes -> Bytes -> Bool -> [Int]
indicesOverlappingBytes needle :: Bytes
needle@(Vec IArray PrimVector Word8
narr Int
noff Int
nlen) | forall a. Bits a => a -> Int
popCount Word64
bloom forall a. Ord a => a -> a -> Bool
> Int
48 = Bytes -> Bool -> [Int]
search
| Bool
otherwise = Bytes -> Bool -> [Int]
search'
where
next :: PrimArray Int
next = forall (v :: * -> *) a. (Vec v a, Eq a) => v a -> PrimArray Int
kmpNextTable Bytes
needle
bloom :: Word64
bloom = Bytes -> Word64
sundayBloom Bytes
needle
search :: Bytes -> Bool -> [Int]
search haystack :: Bytes
haystack@(Vec IArray PrimVector Word8
harr Int
hoff Int
hlen) Bool
reportPartial
| Int
nlen forall a. Ord a => a -> a -> Bool
<= Int
0 = [Int
0..Int
hlenforall a. Num a => a -> a -> a
-Int
1]
| Int
nlen forall a. Eq a => a -> a -> Bool
== Int
1 = case forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> (# a #)
indexArr' IArray PrimVector Word8
narr Int
noff of
(# Word8
x #) -> forall (v :: * -> *) a. (Vec v a, Eq a) => a -> v a -> [Int]
elemIndices Word8
x Bytes
haystack
| Bool
otherwise = Int -> Int -> [Int]
kmp Int
0 Int
0
where
kmp :: Int -> Int -> [Int]
kmp !Int
i !Int
j | Int
i forall a. Ord a => a -> a -> Bool
>= Int
hlen = if Bool
reportPartial Bool -> Bool -> Bool
&& Int
j forall a. Eq a => a -> a -> Bool
/= Int
0 then [-Int
j] else []
| IArray PrimVector Word8
narr forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` (Int
jforall a. Num a => a -> a -> a
+Int
noff) forall a. Eq a => a -> a -> Bool
== IArray PrimVector Word8
harr forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` (Int
iforall a. Num a => a -> a -> a
+Int
hoff) =
let !j' :: Int
j' = Int
jforall a. Num a => a -> a -> a
+Int
1
in if Int
j' forall a. Ord a => a -> a -> Bool
>= Int
nlen
then let !i' :: Int
i' = Int
iforall a. Num a => a -> a -> a
-Int
j
in case PrimArray Int
next forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` Int
j' of
-1 -> Int
i' forall a. a -> [a] -> [a]
: Int -> Int -> [Int]
kmp (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
0
Int
j'' -> Int
i' forall a. a -> [a] -> [a]
: Int -> Int -> [Int]
kmp (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
j''
else Int -> Int -> [Int]
kmp (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
j'
| Bool
otherwise = case PrimArray Int
next forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` Int
j of
-1 -> Int -> Int -> [Int]
kmp (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
0
Int
j' -> Int -> Int -> [Int]
kmp Int
i Int
j'
search' :: Bytes -> Bool -> [Int]
search' haystack :: Bytes
haystack@(Vec IArray PrimVector Word8
harr Int
hoff Int
hlen) Bool
reportPartial
| Int
nlen forall a. Ord a => a -> a -> Bool
<= Int
0 = [Int
0..Int
hlenforall a. Num a => a -> a -> a
-Int
1]
| Int
nlen forall a. Eq a => a -> a -> Bool
== Int
1 = forall (v :: * -> *) a. (Vec v a, Eq a) => a -> v a -> [Int]
elemIndices (forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
indexArr IArray PrimVector Word8
narr Int
noff) Bytes
haystack
| Bool
otherwise = Int -> Int -> [Int]
sunday Int
0 Int
0
where
kmp :: Int -> Int -> [Int]
kmp !Int
i !Int
j | Int
i forall a. Ord a => a -> a -> Bool
>= Int
hlen = if Bool
reportPartial Bool -> Bool -> Bool
&& Int
j forall a. Eq a => a -> a -> Bool
/= Int
0 then [-Int
j] else []
| IArray PrimVector Word8
narr forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` (Int
jforall a. Num a => a -> a -> a
+Int
noff) forall a. Eq a => a -> a -> Bool
== IArray PrimVector Word8
harr forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` (Int
iforall a. Num a => a -> a -> a
+Int
hoff) =
let !j' :: Int
j' = Int
jforall a. Num a => a -> a -> a
+Int
1
in if Int
j' forall a. Ord a => a -> a -> Bool
>= Int
nlen
then let !i' :: Int
i' = Int
iforall a. Num a => a -> a -> a
-Int
j
in case PrimArray Int
next forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` Int
j' of
-1 -> Int
i' forall a. a -> [a] -> [a]
: Int -> Int -> [Int]
kmp (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
0
Int
j'' -> Int
i' forall a. a -> [a] -> [a]
: Int -> Int -> [Int]
kmp (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
j''
else Int -> Int -> [Int]
kmp (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
j'
| Bool
otherwise = case PrimArray Int
next forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` Int
j of
-1 -> Int -> Int -> [Int]
kmp (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
0
Int
j' -> Int -> Int -> [Int]
kmp Int
i Int
j'
!hlen' :: Int
hlen' = Int
hlen forall a. Num a => a -> a -> a
- Int
nlen
sunday :: Int -> Int -> [Int]
sunday !Int
i !Int
j | Int
i forall a. Ord a => a -> a -> Bool
>= Int
hlen' = Int -> Int -> [Int]
kmp Int
i Int
j
| IArray PrimVector Word8
narr forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` (Int
jforall a. Num a => a -> a -> a
+Int
noff) forall a. Eq a => a -> a -> Bool
== IArray PrimVector Word8
harr forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` (Int
iforall a. Num a => a -> a -> a
+Int
hoff) =
let !j' :: Int
j' = Int
jforall a. Num a => a -> a -> a
+Int
1
in if Int
j' forall a. Ord a => a -> a -> Bool
>= Int
nlen
then let !i' :: Int
i' = Int
iforall a. Num a => a -> a -> a
-Int
j
in case PrimArray Int
next forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` Int
j' of
-1 -> Int
i' forall a. a -> [a] -> [a]
: Int -> Int -> [Int]
sunday (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
0
Int
j'' -> Int
i' forall a. a -> [a] -> [a]
: Int -> Int -> [Int]
sunday (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
j''
else Int -> Int -> [Int]
sunday (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
j'
| Bool
otherwise = let !k :: Int
k = Int
iforall a. Num a => a -> a -> a
+Int
nlenforall a. Num a => a -> a -> a
-Int
j
!afterNeedle :: Word8
afterNeedle = forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
indexArr IArray PrimVector Word8
harr (Int
kforall a. Num a => a -> a -> a
+Int
hoff)
in if Word64 -> Word8 -> Bool
elemSundayBloom Word64
bloom Word8
afterNeedle
then case PrimArray Int
next forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` Int
j of
-1 -> Int -> Int -> [Int]
sunday (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
0
Int
j' -> Int -> Int -> [Int]
sunday Int
i Int
j'
else Int -> Int -> [Int]
sunday (Int
kforall a. Num a => a -> a -> a
+Int
1) Int
0
indices :: (Vec v a, Eq a) => v a -> v a -> Bool -> [Int]
{-# INLINE [1] indices #-}
{-# RULES "indices/Bytes" indices = indicesBytes #-}
indices :: forall (v :: * -> *) a.
(Vec v a, Eq a) =>
v a -> v a -> Bool -> [Int]
indices needle :: v a
needle@(Vec IArray v a
narr Int
noff Int
nlen) = v a -> Bool -> [Int]
search
where
next :: PrimArray Int
next = forall (v :: * -> *) a. (Vec v a, Eq a) => v a -> PrimArray Int
kmpNextTable v a
needle
search :: v a -> Bool -> [Int]
search haystack :: v a
haystack@(Vec IArray v a
harr Int
hoff Int
hlen) Bool
reportPartial
| Int
nlen forall a. Ord a => a -> a -> Bool
<= Int
0 = [Int
0..Int
hlenforall a. Num a => a -> a -> a
-Int
1]
| Int
nlen forall a. Eq a => a -> a -> Bool
== Int
1 = case forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> (# a #)
indexArr' IArray v a
narr Int
noff of
(# a
x #) -> forall (v :: * -> *) a. (Vec v a, Eq a) => a -> v a -> [Int]
elemIndices a
x v a
haystack
| Bool
otherwise = Int -> Int -> [Int]
kmp Int
0 Int
0
where
kmp :: Int -> Int -> [Int]
kmp !Int
i !Int
j | Int
i forall a. Ord a => a -> a -> Bool
>= Int
hlen = if Bool
reportPartial Bool -> Bool -> Bool
&& Int
j forall a. Eq a => a -> a -> Bool
/= Int
0 then [-Int
j] else []
| IArray v a
narr forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` (Int
jforall a. Num a => a -> a -> a
+Int
noff) forall a. Eq a => a -> a -> Bool
== IArray v a
harr forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` (Int
iforall a. Num a => a -> a -> a
+Int
hoff) =
let !j' :: Int
j' = Int
jforall a. Num a => a -> a -> a
+Int
1
in if Int
j' forall a. Ord a => a -> a -> Bool
>= Int
nlen
then let !i' :: Int
i' = Int
iforall a. Num a => a -> a -> a
-Int
j in Int
i' forall a. a -> [a] -> [a]
: Int -> Int -> [Int]
kmp (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
0
else Int -> Int -> [Int]
kmp (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
j'
| Bool
otherwise = case PrimArray Int
next forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` Int
j of
-1 -> Int -> Int -> [Int]
kmp (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
0
Int
j' -> Int -> Int -> [Int]
kmp Int
i Int
j'
indicesBytes :: Bytes
-> Bytes
-> Bool
-> [Int]
{-# INLINABLE indicesBytes #-}
indicesBytes :: Bytes -> Bytes -> Bool -> [Int]
indicesBytes needle :: Bytes
needle@(Vec IArray PrimVector Word8
narr Int
noff Int
nlen) | forall a. Bits a => a -> Int
popCount Word64
bloom forall a. Ord a => a -> a -> Bool
> Int
48 = Bytes -> Bool -> [Int]
search
| Bool
otherwise = Bytes -> Bool -> [Int]
search'
where
next :: PrimArray Int
next = forall (v :: * -> *) a. (Vec v a, Eq a) => v a -> PrimArray Int
kmpNextTable Bytes
needle
bloom :: Word64
bloom = Bytes -> Word64
sundayBloom Bytes
needle
search :: Bytes -> Bool -> [Int]
search haystack :: Bytes
haystack@(Vec IArray PrimVector Word8
harr Int
hoff Int
hlen) Bool
reportPartial
| Int
nlen forall a. Ord a => a -> a -> Bool
<= Int
0 = [Int
0..Int
hlenforall a. Num a => a -> a -> a
-Int
1]
| Int
nlen forall a. Eq a => a -> a -> Bool
== Int
1 = case forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> (# a #)
indexArr' IArray PrimVector Word8
narr Int
noff of
(# Word8
x #) -> forall (v :: * -> *) a. (Vec v a, Eq a) => a -> v a -> [Int]
elemIndices Word8
x Bytes
haystack
| Bool
otherwise = Int -> Int -> [Int]
kmp Int
0 Int
0
where
kmp :: Int -> Int -> [Int]
kmp !Int
i !Int
j | Int
i forall a. Ord a => a -> a -> Bool
>= Int
hlen = if Bool
reportPartial Bool -> Bool -> Bool
&& Int
j forall a. Eq a => a -> a -> Bool
/= Int
0 then [-Int
j] else []
| IArray PrimVector Word8
narr forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` (Int
jforall a. Num a => a -> a -> a
+Int
noff) forall a. Eq a => a -> a -> Bool
== IArray PrimVector Word8
harr forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` (Int
iforall a. Num a => a -> a -> a
+Int
hoff) =
let !j' :: Int
j' = Int
jforall a. Num a => a -> a -> a
+Int
1
in if Int
j' forall a. Ord a => a -> a -> Bool
>= Int
nlen
then let !i' :: Int
i' = Int
iforall a. Num a => a -> a -> a
-Int
j in Int
i' forall a. a -> [a] -> [a]
: Int -> Int -> [Int]
kmp (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
0
else Int -> Int -> [Int]
kmp (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
j'
| Bool
otherwise = case PrimArray Int
next forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` Int
j of
-1 -> Int -> Int -> [Int]
kmp (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
0
Int
j' -> Int -> Int -> [Int]
kmp Int
i Int
j'
search' :: Bytes -> Bool -> [Int]
search' haystack :: Bytes
haystack@(Vec IArray PrimVector Word8
harr Int
hoff Int
hlen) Bool
reportPartial
| Int
nlen forall a. Ord a => a -> a -> Bool
<= Int
0 = [Int
0..Int
hlenforall a. Num a => a -> a -> a
-Int
1]
| Int
nlen forall a. Eq a => a -> a -> Bool
== Int
1 = forall (v :: * -> *) a. (Vec v a, Eq a) => a -> v a -> [Int]
elemIndices (forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
indexArr IArray PrimVector Word8
narr Int
noff) Bytes
haystack
| Bool
otherwise = Int -> Int -> [Int]
sunday Int
0 Int
0
where
kmp :: Int -> Int -> [Int]
kmp !Int
i !Int
j | Int
i forall a. Ord a => a -> a -> Bool
>= Int
hlen = if Bool
reportPartial Bool -> Bool -> Bool
&& Int
j forall a. Eq a => a -> a -> Bool
/= Int
0 then [-Int
j] else []
| IArray PrimVector Word8
narr forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` (Int
jforall a. Num a => a -> a -> a
+Int
noff) forall a. Eq a => a -> a -> Bool
== IArray PrimVector Word8
harr forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` (Int
iforall a. Num a => a -> a -> a
+Int
hoff) =
let !j' :: Int
j' = Int
jforall a. Num a => a -> a -> a
+Int
1
in if Int
j' forall a. Ord a => a -> a -> Bool
>= Int
nlen
then let !i' :: Int
i' = Int
iforall a. Num a => a -> a -> a
-Int
j in Int
i' forall a. a -> [a] -> [a]
: Int -> Int -> [Int]
kmp (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
0
else Int -> Int -> [Int]
kmp (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
j'
| Bool
otherwise = case PrimArray Int
next forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` Int
j of
-1 -> Int -> Int -> [Int]
kmp (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
0
Int
j' -> Int -> Int -> [Int]
kmp Int
i Int
j'
!hlen' :: Int
hlen' = Int
hlen forall a. Num a => a -> a -> a
- Int
nlen
sunday :: Int -> Int -> [Int]
sunday !Int
i !Int
j | Int
i forall a. Ord a => a -> a -> Bool
>= Int
hlen' = Int -> Int -> [Int]
kmp Int
i Int
j
| IArray PrimVector Word8
narr forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` (Int
jforall a. Num a => a -> a -> a
+Int
noff) forall a. Eq a => a -> a -> Bool
== IArray PrimVector Word8
harr forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` (Int
iforall a. Num a => a -> a -> a
+Int
hoff) =
let !j' :: Int
j' = Int
jforall a. Num a => a -> a -> a
+Int
1
in if Int
j' forall a. Ord a => a -> a -> Bool
>= Int
nlen
then let !i' :: Int
i' = Int
iforall a. Num a => a -> a -> a
-Int
j in Int
i' forall a. a -> [a] -> [a]
: Int -> Int -> [Int]
sunday (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
0
else Int -> Int -> [Int]
sunday (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
j'
| Bool
otherwise = let !k :: Int
k = Int
iforall a. Num a => a -> a -> a
+Int
nlenforall a. Num a => a -> a -> a
-Int
j
!afterNeedle :: Word8
afterNeedle = forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
indexArr IArray PrimVector Word8
harr (Int
kforall a. Num a => a -> a -> a
+Int
hoff)
in if Word64 -> Word8 -> Bool
elemSundayBloom Word64
bloom Word8
afterNeedle
then case PrimArray Int
next forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
`indexArr` Int
j of
-1 -> Int -> Int -> [Int]
sunday (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
0
Int
j' -> Int -> Int -> [Int]
sunday Int
i Int
j'
else Int -> Int -> [Int]
sunday (Int
kforall a. Num a => a -> a -> a
+Int
1) Int
0
kmpNextTable :: (Vec v a, Eq a) => v a -> PrimArray Int
{-# INLINABLE kmpNextTable #-}
kmpNextTable :: forall (v :: * -> *) a. (Vec v a, Eq a) => v a -> PrimArray Int
kmpNextTable (Vec IArray v a
arr Int
s Int
l) = forall a. (forall s. ST s a) -> a
runST (do
MArr PrimArray s Int
ma <- forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack) =>
Int -> m (MArr arr s a)
newArr (Int
lforall a. Num a => a -> a -> a
+Int
1)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr PrimArray s Int
ma Int
0 (-Int
1)
let dec :: a -> Int -> ST s Int
dec !a
w !Int
j
| Int
j forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| a
w forall a. Eq a => a -> a -> Bool
== forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
indexArr IArray v a
arr (Int
sforall a. Num a => a -> a -> a
+Int
j) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Int
jforall a. Num a => a -> a -> a
+Int
1
| Bool
otherwise = forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack) =>
MArr arr s a -> Int -> m a
readArr MArr PrimArray s Int
ma Int
j forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Int -> ST s Int
dec a
w
go :: Int -> Int -> ST s (PrimArray Int)
go !Int
i !Int
j
| Int
i forall a. Ord a => a -> a -> Bool
> Int
l = forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
unsafeFreezeArr MArr PrimArray s Int
ma
| Bool
otherwise = do
let !w :: a
w = forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
indexArr IArray v a
arr (Int
sforall a. Num a => a -> a -> a
+Int
iforall a. Num a => a -> a -> a
-Int
1)
Int
j' <- a -> Int -> ST s Int
dec a
w Int
j
if Int
i forall a. Ord a => a -> a -> Bool
< Int
l Bool -> Bool -> Bool
&& forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
indexArr IArray v a
arr (Int
sforall a. Num a => a -> a -> a
+Int
j') forall a. Eq a => a -> a -> Bool
== forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
indexArr IArray v a
arr (Int
sforall a. Num a => a -> a -> a
+Int
i)
then forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack) =>
MArr arr s a -> Int -> m a
readArr MArr PrimArray s Int
ma Int
j' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr PrimArray s Int
ma Int
i
else forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr PrimArray s Int
ma Int
i Int
j'
Int -> Int -> ST s (PrimArray Int)
go (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
j'
Int -> Int -> ST s (PrimArray Int)
go Int
1 (-Int
1))
sundayBloom :: Bytes -> Word64
{-# INLINABLE sundayBloom #-}
sundayBloom :: Bytes -> Word64
sundayBloom (Vec IArray PrimVector Word8
arr Int
s Int
l) = Word64 -> Int -> Word64
go Word64
0x00000000 Int
s
where
!end :: Int
end = Int
sforall a. Num a => a -> a -> a
+Int
l
go :: Word64 -> Int -> Word64
go !Word64
b !Int
i
| Int
i forall a. Ord a => a -> a -> Bool
>= Int
end = Word64
b
| Bool
otherwise =
let !w :: Word8
w = forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
indexArr IArray PrimVector Word8
arr Int
i
!b' :: Word64
b' = Word64
b forall a. Bits a => a -> a -> a
.|. (Word64
0x00000001 forall a. Bits a => a -> Int -> a
`unsafeShiftL` (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w forall a. Bits a => a -> a -> a
.&. Int
0x3f))
in Word64 -> Int -> Word64
go Word64
b' (Int
iforall a. Num a => a -> a -> a
+Int
1)
elemSundayBloom :: Word64 -> Word8 -> Bool
{-# INLINABLE elemSundayBloom #-}
elemSundayBloom :: Word64 -> Word8 -> Bool
elemSundayBloom Word64
b Word8
w = Word64
b forall a. Bits a => a -> a -> a
.&. (Word64
0x01 forall a. Bits a => a -> Int -> a
`unsafeShiftL` (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w forall a. Bits a => a -> a -> a
.&. Int
0x3f)) forall a. Eq a => a -> a -> Bool
/= Word64
0