{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_HADDOCK hide, prune #-}
-- |
-- Module         : Data.ByteString.Lazy.Search.Internal.BoyerMoore
-- Copyright      : Daniel Fischer
--                  Chris Kuklewicz
-- Licence        : BSD3
-- Maintainer     : Daniel Fischer <daniel.is.fischer@googlemail.com>
-- Stability      : Provisional
-- Portability    : non-portable (BangPatterns)
--
-- Fast overlapping Boyer-Moore search of both strict and lazy
-- 'S.ByteString' values. Breaking, splitting and replacing
-- using the Boyer-Moore algorithm.
--
-- Descriptions of the algorithm can be found at
-- <http://www-igm.univ-mlv.fr/~lecroq/string/node14.html#SECTION00140>
-- and
-- <http://en.wikipedia.org/wiki/Boyer-Moore_string_search_algorithm>
--
-- Original authors: Daniel Fischer (daniel.is.fischer at googlemail.com) and
-- Chris Kuklewicz (haskell at list.mightyreason.com).

module Data.ByteString.Lazy.Search.Internal.BoyerMoore (
                                           matchLL
                                         , matchSL

                                           --  Non-overlapping
                                         , matchNOL

                                            --  Replacing substrings
                                            -- replacing
                                         , replaceAllL
                                            --  Breaking on substrings
                                            -- breaking
                                         , breakSubstringL
                                         , breakAfterL
                                         , breakFindAfterL
                                            --  Splitting on substrings
                                            -- splitting
                                         , splitKeepEndL
                                         , splitKeepFrontL
                                         , splitDropL
                                         ) where


import Data.ByteString.Search.Internal.Utils
                (occurs, suffShifts, ldrop, lsplit, keep, release, strictify)
import Data.ByteString.Search.Substitution

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.Word (Word8)
import Data.Int (Int64)

-- overview
--
-- This module exports three search functions for searching in lazy
-- ByteSrings, one for searching non-overlapping occurrences of a strict
-- pattern, and one each for searchin overlapping occurrences of a strict
-- resp. lazy pattern. The common base name is @match@, the suffix
-- indicates the type of search. These functions
-- return (for a non-empty pattern) a list of all the indices of the target
-- string where an occurrence of the pattern begins, if some occurrences
-- overlap, all starting indices are reported. The list is produced lazily,
-- so not necessarily the entire target string is searched.
--
-- The behaviour of these functions when given an empty pattern has changed.
-- Formerly, the @matchXY@ functions returned an empty list then, now it's
-- @[0 .. 'length' target]@.
--
-- Newly added are functions to replace all (non-overlapping) occurrences
-- of a pattern within a string, functions to break ByteStrings at the first
-- occurrence of a pattern and functions to split ByteStrings at each
-- occurrence of a pattern. None of these functions does copying, so they
-- don't introduce large memory overhead.
--
-- Internally, a lazy pattern is always converted to a strict ByteString,
-- which is necessary for an efficient implementation of the algorithm.
-- The limit this imposes on the length of the pattern is probably
-- irrelevant in practice, but perhaps it should be mentioned.
-- This also means that the @matchL*@ functions are mere convenience wrappers.
-- Except for the initial 'strictify'ing, there's no difference between lazy
-- and strict patterns, they call the same workers. There is, however, a
-- difference between strict and lazy target strings.
-- For the new functions, no such wrappers are provided, you have to
-- 'strictify' lazy patterns yourself.

-- caution
--
-- When working with a lazy target string, the relation between the pattern
-- length and the chunk size can play a big r&#244;le.
-- Crossing chunk boundaries is relatively expensive, so when that becomes
-- a frequent occurrence, as may happen when the pattern length is close
-- to or larger than the chunk size, performance is likely to degrade.
-- If it is needed, steps can be taken to ameliorate that effect, but unless
-- entirely separate functions are introduced, that would hurt the
-- performance for the more common case of patterns much shorter than
-- the default chunk size.

-- performance
--
-- In general, the Boyer-Moore algorithm is the most efficient method to
-- search for a pattern inside a string, so most of the time, you'll want
-- to use the functions of this module, hence this is where the most work
-- has gone. Very short patterns are an exception to this, for those you
-- should consider using a finite automaton
-- ("Data.ByteString.Search.DFA.Array"). That is also often the better
-- choice for searching longer periodic patterns in a lazy ByteString
-- with many matches.
--
-- Operating on a strict target string is mostly faster than on a lazy
-- target string, but the difference is usually small (according to my
-- tests).
--
-- The known exceptions to this rule of thumb are
--
-- [long targets] Then the smaller memory footprint of a lazy target often
-- gives (much) better performance.
--
-- [high number of matches] When there are very many matches, strict target
-- strings are much faster, especially if the pattern is periodic.
--
-- If both conditions hold, either may outweigh the other.

-- complexity
--
-- Preprocessing the pattern is /O/(@patternLength@ + &#963;) in time and
-- space (&#963; is the alphabet size, 256 here) for all functions.
-- The time complexity of the searching phase for @matchXY@
-- is /O/(@targetLength@ \/ @patternLength@) in the best case.
-- For non-periodic patterns, the worst case complexity is
-- /O/(@targetLength@), but for periodic patterns, the worst case complexity
-- is /O/(@targetLength@ * @patternLength@) for the original Boyer-Moore
-- algorithm.
--
-- The searching functions in this module now contain a modification which
-- drastically improves the performance for periodic patterns.
-- I believe that for strict target strings, the worst case is now
-- /O/(@targetLength@) also for periodic patterns and for lazy target strings,
-- my semi-educated guess is
-- /O/(@targetLength@ * (1 + @patternLength@ \/ @chunkSize@)).
-- I may be very wrong, though.
--
-- The other functions don't have to deal with possible overlapping
-- patterns, hence the worst case complexity for the processing phase
-- is /O/(@targetLength@) (respectively /O/(@firstIndex + patternLength@)
-- for the breaking functions if the pattern occurs).

-- currying
--
-- These functions can all be usefully curried. Given only a pattern
-- the curried version will compute the supporting lookup tables only
-- once, allowing for efficient re-use.  Similarly, the curried
-- 'matchLL' and 'matchLS' will compute the concatenated pattern only
-- once.

-- overflow
--
-- The current code uses @Int@ to keep track of the locations in the
-- target string.  If the length of the pattern plus the length of any
-- strict chunk of the target string is greater than
-- @'maxBound' :: 'Int'@ then this will overflow causing an error.  We
-- try to detect this and call 'error' before a segfault occurs.

------------------------------------------------------------------------------
--                                 Wrappers                                 --
------------------------------------------------------------------------------

-- matching
--
-- These functions find the indices of all (possibly overlapping)
-- occurrences of a pattern in a target string.
-- If the pattern is empty, the result is @[0 .. length target]@.
-- If the pattern is much shorter than the target string
-- and the pattern does not occur very near the beginning of the target,
--
-- > not . null $ matchSS pattern target
--
-- is a much more efficient version of 'S.isInfixOf'.

-- | @'matchLL'@ finds the starting indices of all possibly overlapping
--   occurrences of the pattern in the target string.
--   It is a simple wrapper for 'Data.ByteString.Lazy.Search.indices'.
--   If the pattern is empty, the result is @[0 .. 'length' target]@.
{-# INLINE matchLL #-}
matchLL :: L.ByteString     -- ^ Lazy pattern
        -> L.ByteString     -- ^ Lazy target string
        -> [Int64]          -- ^ Offsets of matches
matchLL pat = search . L.toChunks
  where
    search  = lazySearcher True (strictify pat)

-- | @'matchSL'@ finds the starting indices of all possibly overlapping
--   occurrences of the pattern in the target string.
--   It is an alias for 'Data.ByteString.Lazy.Search.indices'.
--   If the pattern is empty, the result is @[0 .. 'length' target]@.
{-# INLINE matchSL #-}
matchSL :: S.ByteString     -- ^ Strict pattern
        -> L.ByteString     -- ^ Lazy target string
        -> [Int64]          -- ^ Offsets of matches
matchSL pat = search . L.toChunks
  where
    search = lazySearcher True pat

-- | @'matchNOL'@ finds the indices of all non-overlapping occurrences
--   of the pattern in the lazy target string.
{-# INLINE matchNOL #-}
matchNOL :: S.ByteString    -- ^ Strict pattern
         -> L.ByteString    -- ^ Lazy target string
         -> [Int64]         -- ^ Offsets of matches
matchNOL pat = search . L.toChunks
  where
    search = lazySearcher False pat

-- replacing
--
--   These functions replace all (non-overlapping) occurrences of a pattern
--   in the target string. If some occurrences overlap, the earliest is
--   replaced and replacing continues at the index after the replaced
--   occurrence, for example
--
-- > replaceAllL \"ana\" \"olog\" \"banana\" == \"bologna\",
-- > replaceAllS \"abacab\" \"u\" \"abacabacabacab\" == \"uacu\",
-- > replaceAllS \"aa\" \"aaa\" \"aaaa\" == \"aaaaaa\".
--
--   Equality of pattern and substitution is not checked, but
--
-- > pat == sub => 'strictify' (replaceAllS pat sub str) == str,
-- > pat == sub => replaceAllL pat sub str == str.
--
--   The result is a lazily generated lazy ByteString, the first chunks will
--   generally be available before the entire target has been scanned.
--   If the pattern is empty, but not the substitution, the result is
--   equivalent to @'cycle' sub@.

{-# INLINE replaceAllL #-}
replaceAllL :: Substitution rep
            => S.ByteString  -- ^ Pattern to replace
            -> rep           -- ^ Substitution string
            -> L.ByteString  -- ^ Target string
            -> L.ByteString  -- ^ Lazy result
replaceAllL pat
    | S.null pat = \sub -> prependCycle sub
    | S.length pat == 1 =
      let breaker = lazyBreak pat
          repl subst strs
              | null strs = []
              | otherwise =
                case breaker strs of
                  (pre, mtch) ->
                        pre ++ case mtch of
                                [] -> []
                                _  -> subst (repl subst (ldrop 1 mtch))
      in \sub -> let repl1 = repl (substitution sub)
                 in L.fromChunks . repl1 . L.toChunks
    | otherwise =
      let repl = lazyRepl pat
      in \sub -> let repl1 = repl (substitution sub)
                 in L.fromChunks . repl1 . L.toChunks

-- breaking
--
-- Break a string on a pattern. The first component of the result
-- contains the prefix of the string before the first occurrence of the
-- pattern, the second component contains the remainder.
-- The following relations hold:
--
-- > breakSubstringX \"\" str = (\"\", str)
-- > not (pat `isInfixOf` str) == null (snd $ breakSunbstringX pat str)
-- > True == case breakSubstringX pat str of
-- >          (x, y) -> not (pat `isInfixOf` x)
-- >                       && (null y || pat `isPrefixOf` y)

-- | The analogous function for a lazy target string.
--   The first component is generated lazily, so parts of it can be
--   available before the pattern is detected (or found to be absent).
{-# INLINE breakSubstringL #-}
breakSubstringL :: S.ByteString  -- ^ Pattern to break on
                -> L.ByteString  -- ^ String to break up
                -> (L.ByteString, L.ByteString)
                    -- ^ Prefix and remainder of broken string
breakSubstringL pat = breaker . L.toChunks
  where
    lbrk = lazyBreak pat
    breaker strs = let (f, b) = lbrk strs
                   in (L.fromChunks f, L.fromChunks b)

breakAfterL :: S.ByteString
            -> L.ByteString
            -> (L.ByteString, L.ByteString)
breakAfterL pat
  | S.null pat      = \str -> (L.empty, str)
breakAfterL pat     = breaker' . L.toChunks
  where
    !patLen = S.length pat
    breaker = lazyBreak pat
    breaker' strs =
      let (pre, mtch) = breaker strs
          (pl, a) = if null mtch then ([],[]) else lsplit patLen mtch
      in (L.fromChunks (pre ++ pl), L.fromChunks a)

breakFindAfterL :: S.ByteString
                -> L.ByteString
                -> ((L.ByteString, L.ByteString), Bool)
breakFindAfterL pat
  | S.null pat  = \str -> ((L.empty, str), True)
breakFindAfterL pat = breaker' . L.toChunks
  where
    !patLen = S.length pat
    breaker = lazyBreak pat
    breaker' strs =
      let (pre, mtch) = breaker strs
          (pl, a) = if null mtch then ([],[]) else lsplit patLen mtch
      in ((L.fromChunks (pre ++ pl), L.fromChunks a), not (null mtch))

-- splitting
--
-- These functions implement various splitting strategies.
--
-- If the pattern to split on is empty, all functions return an
-- infinite list of empty ByteStrings.
-- Otherwise, the names are rather self-explanatory.
--
-- For nonempty patterns, the following relations hold:
--
-- > concat (splitKeepXY pat str) == str
-- > concat ('Data.List.intersperse' pat (splitDropX pat str)) == str.
--
-- All fragments except possibly the last in the result of
-- @splitKeepEndX pat@ end with @pat@, none of the fragments contains
-- more than one occurrence of @pat@ or is empty.
--
-- All fragments except possibly the first in the result of
-- @splitKeepFrontX pat@ begin with @pat@, none of the fragments
-- contains more than one occurrence of @patq or is empty.
--
-- > splitDropX pat str == map dropPat (splitKeepFrontX pat str)
-- >   where
-- >     patLen = length pat
-- >     dropPat frag
-- >        | pat `isPrefixOf` frag = drop patLen frag
-- >        | otherwise             = frag
--
-- but @splitDropX@ is a little more efficient than that.

{-# INLINE splitKeepEndL #-}
splitKeepEndL :: S.ByteString    -- ^ Pattern to split on
              -> L.ByteString    -- ^ String to split
              -> [L.ByteString]  -- ^ List of fragments
splitKeepEndL pat
    | S.null pat    = const (repeat L.empty)
    | otherwise     =
      let splitter = lazySplitKeepEnd pat
      in  map L.fromChunks . splitter . L.toChunks

{-# INLINE splitKeepFrontL #-}
splitKeepFrontL :: S.ByteString    -- ^ Pattern to split on
                -> L.ByteString    -- ^ String to split
                -> [L.ByteString]  -- ^ List of fragments
splitKeepFrontL pat
    | S.null pat    = const (repeat L.empty)
    | otherwise     =
      let splitter = lazySplitKeepFront pat
      in  map L.fromChunks . splitter . L.toChunks


{-# INLINE splitDropL #-}
splitDropL :: S.ByteString    -- ^ Pattern to split on
           -> L.ByteString    -- ^ String to split
           -> [L.ByteString]  -- ^ List of fragments
splitDropL pat
    | S.null pat    = const (repeat L.empty)
    | otherwise     =
      let splitter = lazySplitDrop pat
      in map L.fromChunks . splitter . L.toChunks

------------------------------------------------------------------------------
--                             Search Functions                             --
------------------------------------------------------------------------------

lazySearcher :: Bool -> S.ByteString -> [S.ByteString] -> [Int64]
lazySearcher _ !pat
    | S.null pat        =
      let zgo !prior [] = [prior]
          zgo prior (!str : rest) =
              let !l = S.length str
                  !prior' = prior + fromIntegral l
              in [prior + fromIntegral i | i <- [0 .. l-1]] ++ zgo prior' rest
      in zgo 0
    | S.length pat == 1 =
      let !w = S.head pat
          ixes = S.elemIndices w
          go _ [] = []
          go !prior (!str : rest)
            = let !prior' = prior + fromIntegral (S.length str)
              in map ((+ prior) . fromIntegral) (ixes str) ++ go prior' rest
      in go 0
lazySearcher !overlap pat = searcher
  where
    {-# INLINE patAt #-}
    patAt :: Int -> Word8
    patAt !i = unsafeIndex pat i

    !patLen = S.length pat
    !patEnd = patLen - 1
    {-# INLINE preEnd #-}
    preEnd  = patEnd - 1
    !maxLen = maxBound - patLen
    !occT   = occurs pat        -- for bad-character-shift
    !suffT  = suffShifts pat    -- for good-suffix-shift
    !skip   = if overlap then unsafeAt suffT 0 else patLen
    -- shift after a complete match
    !kept   = patLen - skip     -- length of known prefix after full match
    !pe     = patAt patEnd      -- last pattern byte for fast comparison

    {-# INLINE occ #-}
    occ !w = unsafeAt occT (fromIntegral w)

    {-# INLINE suff #-}
    suff !i = unsafeAt suffT i

    searcher lst = case lst of
                    []      -> []
                    (h : t) ->
                      if maxLen < S.length h
                        then error "Overflow in BoyerMoore.lazySearcher"
                        else seek 0 [] h t 0 patEnd

    -- seek is used to position the "zipper" of (past, str, future) to the
    -- correct S.ByteString to search. This is done by ensuring that
    -- 0 <= strPos < strLen, where strPos = diffPos + patPos.
    -- Note that future is not a strict parameter. The bytes being compared
    -- will then be (strAt strPos) and (patAt patPos).
    -- Splitting this into specialised versions is possible, but it would
    -- only be useful if the pattern length is close to (or larger than)
    -- the chunk size. For ordinary patterns of at most a few hundred bytes,
    -- the overhead of yet more code-paths and larger code size will probably
    -- outweigh the small gains in the relatively rare calls to seek.
    seek :: Int64 -> [S.ByteString] -> S.ByteString
            -> [S.ByteString] -> Int -> Int -> [Int64]
    seek !prior !past !str future !diffPos !patPos
        | strPos < 0 =  -- need to look at previous chunk
            case past of
                (h : t) ->
                    let !hLen = S.length h
                    in seek (prior - fromIntegral hLen) t h (str : future)
                                (diffPos + hLen) patPos
                []      -> error "seek back too far!"
        | strEnd < strPos =  -- need to look at next chunk if there is
            case future of
                (h : t) ->
                    let {-# INLINE prior' #-}
                        prior' = prior + fromIntegral strLen
                        !diffPos' = diffPos - strLen
                        {-# INLINE past' #-}
                        past' = release (-diffPos') (str : past)
                    in if maxLen < S.length h
                        then error "Overflow in BoyerMoore.lazySearcher"
                        else seek prior' past' h t diffPos' patPos
                []      -> []
        | patPos == patEnd  = checkEnd strPos
        | diffPos < 0       = matcherN diffPos patPos
        | otherwise         = matcherP diffPos patPos
          where
            !strPos  = diffPos + patPos
            !strLen  = S.length str
            !strEnd  = strLen - 1
            !maxDiff = strLen - patLen

            {-# INLINE strAt #-}
            strAt !i = unsafeIndex str i

            -- While comparing the last byte of the pattern, the bad-
            -- character-shift is always at least as large as the good-
            -- suffix-shift. Eliminating the unnecessary memory reads and
            -- comparison speeds things up noticeably.
            checkEnd !sI  -- index in string to compare to last of pattern
              | strEnd < sI = seek prior past str future (sI - patEnd) patEnd
              | otherwise   =
                case strAt sI of
                  !c | c == pe   ->
                       if sI < patEnd
                        then case sI of
                              0 -> seek prior past str future (-patEnd) preEnd
                              _ -> matcherN (sI - patEnd) preEnd
                        else matcherP (sI - patEnd) preEnd
                     | otherwise -> checkEnd (sI + patEnd + occ c)

            -- Once the last byte has matched, we enter the full matcher
            -- diff is the offset of the window, patI the index of the
            -- pattern byte to compare next.

            -- matcherN is the tight loop that walks backwards from the end
            -- of the pattern checking for matching bytes. The offset is
            -- always negative, so no complete match can occur here.
            -- When a byte matches, we need to check whether we've reached
            -- the front of this chunk, otherwise whether we need the next.
            matcherN !diff !patI =
              case strAt (diff + patI) of
                !c  | c == patAt patI   ->
                        if diff + patI == 0
                            then seek prior past str future diff (patI - 1)
                            else matcherN diff (patI - 1)
                    | otherwise         ->
                        let {-# INLINE badShift #-}
                            badShift = patI + occ c
                            {-# INLINE goodShift #-}
                            goodShift = suff patI
                            !diff' = diff + max badShift goodShift
                        in if maxDiff < diff'
                            then seek prior past str future diff' patEnd
                            else checkEnd (diff' + patEnd)

            -- matcherP is the tight loop for non-negative offsets.
            -- When the pattern is shifted, we must check whether we leave
            -- the current chunk, otherwise we only need to check for a
            -- complete match.
            matcherP !diff !patI =
              case strAt (diff + patI) of
                !c  | c == patAt patI   ->
                      if patI == 0
                        then prior + fromIntegral diff :
                              let !diff' = diff + skip
                              in if maxDiff < diff'
                                then seek prior past str future diff' patEnd
                                else
                                  if skip == patLen
                                    then
                                      checkEnd (diff' + patEnd)
                                    else
                                      afterMatch diff' patEnd
                        else matcherP diff (patI - 1)
                    | otherwise         ->
                        let {-# INLINE badShift #-}
                            badShift = patI + occ c
                            {-# INLINE goodShift #-}
                            goodShift = suff patI
                            !diff' = diff + max badShift goodShift
                        in if maxDiff < diff'
                            then seek prior past str future diff' patEnd
                            else checkEnd (diff' + patEnd)

            -- After a full match, we know how long a prefix of the pattern
            -- still matches. Do not re-compare the prefix to prevent O(m*n)
            -- behaviour for periodic patterns.
            -- This breaks down at chunk boundaries, but except for long
            -- patterns with a short period, that shouldn't matter much.
            afterMatch !diff !patI =
              case strAt (diff + patI) of
                !c  | c == patAt patI ->
                      if patI == kept
                        then prior + fromIntegral diff :
                            let !diff' = diff + skip
                            in if maxDiff < diff'
                                then seek prior past str future diff' patEnd
                                else afterMatch diff' patEnd
                        else afterMatch diff (patI - 1)
                    | patI == patEnd  ->
                        checkEnd (diff + (2*patEnd) + occ c)
                    | otherwise       ->
                        let {-# INLINE badShift #-}
                            badShift = patI + occ c
                            {-# INLINE goodShift #-}
                            goodShift = suff patI
                            !diff' = diff + max badShift goodShift
                        in if maxDiff < diff'
                            then seek prior past str future diff' patEnd
                            else checkEnd (diff' + patEnd)

------------------------------------------------------------------------------
--                            Breaking Functions                            --
------------------------------------------------------------------------------

-- Ugh! Code duplication ahead!
-- But we want to get the first component lazily, so it's no good to find
-- the first index (if any) and then split.
-- Therefore bite the bullet and copy most of the code of lazySearcher.
-- No need for afterMatch here, fortunately.
lazyBreak ::S.ByteString -> [S.ByteString] -> ([S.ByteString], [S.ByteString])
lazyBreak !pat
  | S.null pat  = \lst -> ([],lst)
  | S.length pat == 1 =
    let !w = S.head pat
        go [] = ([], [])
        go (!str : rest) =
            case S.elemIndices w str of
                []    -> let (pre, post) = go rest in (str : pre, post)
                (i:_) -> if i == 0
                            then ([], str : rest)
                            else ([S.take i str], S.drop i str : rest)
    in go
lazyBreak pat = breaker
  where
    !patLen = S.length pat
    !patEnd = patLen - 1
    !occT   = occurs pat
    !suffT  = suffShifts pat
    !maxLen = maxBound - patLen
    !pe     = patAt patEnd

    {-# INLINE patAt #-}
    patAt !i = unsafeIndex pat i

    {-# INLINE occ #-}
    occ !w = unsafeAt occT (fromIntegral w)

    {-# INLINE suff #-}
    suff !i = unsafeAt suffT i

    breaker lst =
      case lst of
        []    -> ([],[])
        (h:t) ->
          if maxLen < S.length h
            then error "Overflow in BoyerMoore.lazyBreak"
            else seek [] h t 0 patEnd

    seek :: [S.ByteString] -> S.ByteString -> [S.ByteString]
                -> Int -> Int -> ([S.ByteString], [S.ByteString])
    seek !past !str future !offset !patPos
      | strPos < 0 =
        case past of
          [] -> error "not enough past!"
          (h : t) -> seek t h (str : future) (offset + S.length h) patPos
      | strEnd < strPos =
        case future of
          []      -> (foldr (flip (.) . (:)) id past [str], [])
          (h : t) ->
            let !off' = offset - strLen
                (past', !discharge) = keep (-off') (str : past)
            in if maxLen < S.length h
                then error "Overflow in BoyerMoore.lazyBreak (future)"
                else let (pre,post) = seek past' h t off' patPos
                     in (foldr (flip (.) . (:)) id discharge pre, post)
      | patPos == patEnd = checkEnd strPos
      | offset < 0 = matcherN offset patPos
      | otherwise  = matcherP offset patPos
      where
        {-# INLINE strAt #-}
        strAt !i = unsafeIndex str i

        !strLen = S.length str
        !strEnd = strLen - 1
        !maxOff = strLen - patLen
        !strPos = offset + patPos

        checkEnd !sI
          | strEnd < sI = seek past str future (sI - patEnd) patEnd
          | otherwise   =
            case strAt sI of
              !c  | c == pe   ->
                    if sI < patEnd
                      then (if sI == 0
                              then seek past str future (-patEnd) (patEnd - 1)
                              else matcherN (sI - patEnd) (patEnd - 1))
                      else matcherP (sI - patEnd) (patEnd - 1)
                  | otherwise -> checkEnd (sI + patEnd + occ c)

        matcherN !off !patI =
          case strAt (off + patI) of
            !c  | c == patAt patI ->
                  if off + patI == 0
                    then seek past str future off (patI - 1)
                    else matcherN off (patI - 1)
                | otherwise ->
                    let !off' = off + max (suff patI) (patI + occ c)
                    in if maxOff < off'
                        then seek past str future off' patEnd
                        else checkEnd (off' + patEnd)

        matcherP !off !patI =
          case strAt (off + patI) of
            !c  | c == patAt patI ->
                  if patI == 0
                    then let !pre = if off == 0 then [] else [S.take off str]
                             !post = S.drop off str
                         in (foldr (flip (.) . (:)) id past pre, post:future)
                    else matcherP off (patI - 1)
                | otherwise ->
                    let !off' = off + max (suff patI) (patI + occ c)
                    in if maxOff < off'
                        then seek past str future off' patEnd
                        else checkEnd (off' + patEnd)


------------------------------------------------------------------------------
--                            Splitting Functions                           --
------------------------------------------------------------------------------

-- non-empty pattern
lazySplitKeepFront :: S.ByteString -> [S.ByteString] -> [[S.ByteString]]
lazySplitKeepFront pat = splitter'
  where
    !patLen = S.length pat
    breaker = lazyBreak pat
    splitter' strs = case splitter strs of
                        ([]:rest) -> rest
                        other -> other
    splitter [] = []
    splitter strs =
      case breaker strs of
        (pre, mtch) ->
           pre : case mtch of
                    [] -> []
                    _  -> case lsplit patLen mtch of
                            (pt, rst) ->
                              if null rst
                                then [pt]
                                else let (h : t) = splitter rst
                                     in (pt ++ h) : t

-- non-empty pattern
lazySplitKeepEnd :: S.ByteString -> [S.ByteString] -> [[S.ByteString]]
lazySplitKeepEnd pat = splitter
  where
    !patLen = S.length pat
    breaker = lazyBreak pat
    splitter [] = []
    splitter strs =
      case breaker strs of
        (pre, mtch) ->
            let (h : t) = if null mtch
                            then [[]]
                            else case lsplit patLen mtch of
                                    (pt, rst) -> pt : splitter rst
            in (pre ++ h) : t

lazySplitDrop :: S.ByteString -> [S.ByteString] -> [[S.ByteString]]
lazySplitDrop pat = splitter
  where
    !patLen = S.length pat
    breaker = lazyBreak pat
    splitter [] = []
    splitter strs = splitter' strs
    splitter' [] = [[]]
    splitter' strs = case breaker strs of
                        (pre,mtch) ->
                            pre : case mtch of
                                    [] -> []
                                    _  -> splitter' (ldrop patLen mtch)

------------------------------------------------------------------------------
--                            Replacing Functions                           --
------------------------------------------------------------------------------

{-

These would be really nice.
Unfortunately they're too slow, so instead, there's another instance of
almost the same code as in lazySearcher below.

-- variant of below
lazyFRepl :: S.ByteString -> ([S.ByteString] -> [S.ByteString])
                -> [S.ByteString] -> [S.ByteString]
lazyFRepl pat = repl
  where
    !patLen = S.length pat
    breaker = lazyBreak pat
    repl sub = replacer
      where
        replacer [] = []
        replacer strs =
          let (pre, mtch) = breaker strs
          in pre ++ case mtch of
                      [] -> []
                      _  -> sub (replacer (ldrop patLen mtch))

-- This is nice and short. I really hope it's performing well!
lazyBRepl :: S.ByteString -> S.ByteString -> [S.ByteString] -> [S.ByteString]
lazyBRepl pat !sub = replacer
  where
    !patLen = S.length pat
    breaker = lazyBreak pat
    replacer [] = []
    replacer strs = let (pre, mtch) = breaker strs
                    in pre ++ case mtch of
                                [] -> []
                                _  -> sub : replacer (ldrop patLen mtch)
-}

-- Yet more code duplication.
--
-- Benchmark it against an implementation using lazyBreak and,
-- unless it's significantly faster, NUKE IT!!
--
-- Sigh, it is significantly faster. 10 - 25 %.
-- I could live with the 10, but 25 is too much.
--
-- Hmm, maybe an implementation via
-- replace pat sub = L.intercalate sub . split pat
-- would be competitive now.
-- TODO: test speed and space usage.
--
-- replacing loop for lazy ByteStrings as list of chunks,
-- called only for non-empty patterns
lazyRepl :: S.ByteString -> ([S.ByteString] -> [S.ByteString])
            -> [S.ByteString] -> [S.ByteString]
lazyRepl pat = replacer
 where
  !patLen = S.length pat
  !patEnd = patLen - 1
  !occT   = occurs pat
  !suffT  = suffShifts pat
  !maxLen = maxBound - patLen
  !pe     = patAt patEnd

  {-# INLINE patAt #-}
  patAt !i = unsafeIndex pat i

  {-# INLINE occ #-}
  occ !w = unsafeAt occT (fromIntegral w)

  {-# INLINE suff #-}
  suff !i = unsafeAt suffT i

  replacer sub lst =
      case lst of
        []    -> []
        (h:t) ->
          if maxLen < S.length h
            then error "Overflow in BoyerMoore.lazyRepl"
            else seek [] h t 0 patEnd
   where
        chop _ [] = []
        chop !k (!str : rest)
          | k < s     =
            if maxLen < (s - k)
                then error "Overflow in BoyerMoore.lazyRepl (chop)"
                else seek [] (S.drop k str) rest 0 patEnd
          | otherwise = chop (k-s) rest
            where
              !s = S.length str

        seek :: [S.ByteString] -> S.ByteString -> [S.ByteString]
                                    -> Int -> Int -> [S.ByteString]
        seek !past !str fut !offset !patPos
          | strPos < 0 =
            case past of
              [] -> error "not enough past!"
              (h : t) -> seek t h (str : fut) (offset + S.length h) patPos
          | strEnd < strPos =
            case fut of
              []      -> foldr (flip (.) . (:)) id past [str]
              (h : t) ->
                let !off' = offset - strLen
                    (past', !discharge) = keep (-off') (str : past)
                in if maxLen < S.length h
                    then error "Overflow in BoyerMoore.lazyRepl (future)"
                    else foldr (flip (.) . (:)) id discharge $
                                            seek past' h t off' patPos
          | patPos == patEnd = checkEnd strPos
          | offset < 0 = matcherN offset patPos
          | otherwise  = matcherP offset patPos
            where
              {-# INLINE strAt #-}
              strAt !i = unsafeIndex str i

              !strLen = S.length str
              !strEnd = strLen - 1
              !maxOff = strLen - patLen
              !strPos = offset + patPos

              checkEnd !sI
                | strEnd < sI = seek past str fut (sI - patEnd) patEnd
                | otherwise   =
                  case strAt sI of
                    !c  | c == pe   ->
                          if sI < patEnd
                            then (if sI == 0
                              then seek past str fut (-patEnd) (patEnd - 1)
                              else matcherN (sI - patEnd) (patEnd - 1))
                          else matcherP (sI - patEnd) (patEnd - 1)
                        | otherwise -> checkEnd (sI + patEnd + occ c)

              matcherN !off !patI =
                case strAt (off + patI) of
                  !c  | c == patAt patI ->
                        if off + patI == 0
                          then seek past str fut off (patI - 1)
                          else matcherN off (patI - 1)
                      | otherwise ->
                        let !off' = off + max (suff patI) (patI + occ c)
                        in if maxOff < off'
                            then seek past str fut off' patEnd
                            else checkEnd (off' + patEnd)

              matcherP !off !patI =
                case strAt (off + patI) of
                  !c  | c == patAt patI ->
                        if patI == 0
                          then foldr (flip (.) . (:)) id past $
                            let pre = if off == 0
                                        then id
                                        else (S.take off str :)
                            in pre . sub $
                                let !p = off + patLen
                                in if p < strLen
                                    then seek [] (S.drop p str) fut 0 patEnd
                                    else chop (p - strLen) fut
                        else matcherP off (patI - 1)
                      | otherwise ->
                        let !off' = off + max (suff patI) (patI + occ c)
                        in if maxOff < off'
                            then seek past str fut off' patEnd
                            else checkEnd (off' + patEnd)