packages feed

stringsearch 0.2.1.1 → 0.3.0

raw patch · 20 files changed

+4027/−611 lines, 20 filesdep +containersdep ~arraydep ~basedep ~bytestringsetup-changednew-uploader

Dependencies added: containers

Dependency ranges changed: array, base, bytestring

Files

+ CHANGES view
@@ -0,0 +1,10 @@+0.3.0:+- improved performance of old KMP searching functions (minor)+- changed behaviour for empty patterns+- changed return type to [Int] for KMP matching in strict BS+- improved performance of old BM searching functions+- (minor speedup for ordinary searches, major improvement for worst case)+- added new functionality,+- breaking, splitting and replacing+- new algorithm (DFA)+- simultaneous search for multiple patterns (KarpRabin)
+ Data/ByteString/Lazy/Search.hs view
@@ -0,0 +1,324 @@+-- |+-- Module         : Data.ByteString.Lazy.Search+-- Copyright      : Daniel Fischer+--                  Chris Kuklewicz+-- Licence        : BSD3+-- Maintainer     : Daniel Fischer <daniel.is.fischer@web.de>+-- Stability      : Provisional+-- Portability    : non-portable (BangPatterns)+--+-- Fast overlapping Boyer-Moore search of lazy+-- 'L.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 web.de) and+-- Chris Kuklewicz (haskell at list.mightyreason.com).+module Data.ByteString.Lazy.Search( -- * Overview+                                    -- $overview++                                    -- ** Performance+                                    -- $performance++                                    -- ** Caution+                                    -- $caution++                                    -- ** Complexity+                                    -- $complexity++                                    -- ** Partial application+                                    -- $partial++                                    -- ** Integer overflow+                                    -- $overflow++                                    -- * Finding substrings+                                    indices+                                  , nonOverlappingIndices+                                    -- * Breaking on substrings+                                  , breakOn+                                  , breakAfter+                                  , breakFindAfter+                                    -- * Replacing+                                  , replace+                                    -- * Splitting+                                  , split+                                  , splitKeepEnd+                                  , splitKeepFront+                                    -- * Convenience+                                  , strictify+                                  ) where++import qualified Data.ByteString.Search.Internal.BoyerMoore as BM+import Data.ByteString.Search.Substitution+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L++import Data.Int (Int64)++-- $overview+--+-- This module provides functions related to searching a substring within+-- a string, using the Boyer-Moore algorithm with minor modifications+-- to improve the overall performance and ameliorate the worst case+-- performance degradation of the original Boyer-Moore algorithm for+-- periodic patterns.+--+-- Efficiency demands that the pattern be a strict 'S.ByteString',+-- to work with a lazy pattern, convert it to a strict 'S.ByteString'+-- first via 'strictify' (provided it is not too long).+-- If support for long lazy patterns is needed, mail a feature-request.+--+-- When searching a pattern in a UTF-8-encoded 'S.ByteString', be aware that+-- these functions work on bytes, not characters, so the indices are+-- byte-offsets, not character offsets.+++-- $performance+--+-- In general, the Boyer-Moore algorithm is the most efficient method to+-- search for a pattern inside a string. The advantage over other algorithms+-- (e.g. Na&#239;ve, Knuth-Morris-Pratt, Horspool, Sunday) can be made+-- arbitrarily large for specially selected patterns and targets, but+-- usually, it's a factor of 2&#8211;3 versus Knuth-Morris-Pratt and of+-- 6&#8211;10 versus the na&#239;ve algorithm. The Horspool and Sunday+-- algorithms, which are simplified variants of the Boyer-Moore algorithm,+-- typically have performance between Boyer-Moore and Knuth-Morris-Pratt,+-- mostly closer to Boyer-Moore. The advantage of the Boyer-moore variants+-- over other algorithms generally becomes larger for longer patterns. For+-- very short patterns (or patterns with a very short period), other+-- algorithms, e.g. "Data.ByteString.Lazy.Search.DFA" can be faster (my+-- tests suggest that \"very short\" means two, maybe three bytes).+--+-- In general, searching in a strict 'S.ByteString' is slightly faster+-- than searching in a lazy 'L.ByteString', but for long targets the+-- smaller memory footprint of lazy 'L.ByteStrings' can make searching+-- those (sometimes much) faster. On the other hand, there are cases+-- where searching in a strict target is much faster, even for long targets.+--+-- On 32-bit systems, 'Int'-arithmetic is much faster than 'Int64'-arithmetic,+-- so when there are many matches, that can make a significant difference.+--+-- Also, the modification to ameliorate the case of periodic patterns+-- is defeated by chunk-boundaries, so long patterns with a short period+-- and many matches exhibit poor behaviour (consider using @indices@ from+-- "Data.ByteString.Lazy.Search.DFA" or "Data.ByteString.Lazy.Search.KMP"+-- in those cases, the former for medium-length patterns, the latter for+-- long patterns; none of the functions except 'indices' suffer from+-- this problem, though).++-- $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.++-- $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 'indices'+-- 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 contain a modification which+-- drastically improves the performance for periodic patterns, although+-- less for lazy targets than for strict ones.+-- If I'm not mistaken, the worst case complexity for periodic patterns+-- is /O/(@targetLength@ * (1 + @patternLength@ \/ @chunkSize@)).+--+-- 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).++-- $partial+--+-- All functions can usefully be partially applied. Given only a pattern,+-- the pattern is preprocessed only once, allowing efficient re-use.++-- $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 or equal to+-- @'maxBound' :: 'Int'@ then this will overflow causing an error.  We try+-- to detect this and call 'error' before a segfault occurs.++------------------------------------------------------------------------------+--                            Exported Functions                            --+------------------------------------------------------------------------------++-- | @indices@ finds the starting indices of all possibly overlapping+--   occurrences of the pattern in the target string.+--   If the pattern is empty, the result is @[0 .. 'length' target]@.+{-# INLINE indices #-}+indices :: S.ByteString     -- ^ Strict pattern to find+        -> L.ByteString     -- ^ Lazy string to search+        -> [Int64]          -- ^ Offsets of matches+indices = BM.matchSL++-- | @nonOverlappingIndices@ finds the starting indices of all+--   non-overlapping occurrences of the pattern in the target string.+--   It is more efficient than removing indices from the list produced+--   by 'indices'.+{-# INLINE nonOverlappingIndices #-}+nonOverlappingIndices :: S.ByteString   -- ^ Strict pattern to find+                      -> L.ByteString   -- ^ Lazy string to search+                      -> [Int64]        -- ^ Offsets of matches+nonOverlappingIndices = BM.matchNOL++-- | @breakOn pattern target@ splits @target@ at the first occurrence+--   of @pattern@. If the pattern does not occur in the target, the+--   second component of the result is empty, otherwise it starts with+--   @pattern@. If the pattern is empty, the first component is empty.+--   For a non-empty pattern, the first component is generated lazily,+--   thus the first parts of it can be available before the pattern has+--   been found or determined to be absent.+--+-- @+--   'uncurry' 'L.append' . 'breakOn' pattern = 'id'+-- @+{-# INLINE breakOn #-}+breakOn :: S.ByteString  -- ^ Strict pattern to search for+        -> L.ByteString  -- ^ Lazy string to search in+        -> (L.ByteString, L.ByteString)+                         -- ^ Head and tail of string broken at substring+breakOn = BM.breakSubstringL++-- | @breakAfter pattern target@ splits @target@ behind the first occurrence+--   of @pattern@. An empty second component means that either the pattern+--   does not occur in the target or the first occurrence of pattern is at+--   the very end of target. If you need to discriminate between those cases,+--   use breakFindAfter.+--   If the pattern is empty, the first component is empty.+--   For a non-empty pattern, the first component is generated lazily,+--   thus the first parts of it can be available before the pattern has+--   been found or determined to be absent.+--+-- @+--   'uncurry' 'L.append' . 'breakAfter' pattern = 'id'+-- @+{-# INLINE breakAfter #-}+breakAfter :: S.ByteString  -- ^ Strict pattern to search for+           -> L.ByteString  -- ^ Lazy string to search in+           -> (L.ByteString, L.ByteString)+                            -- ^ Head and tail of string broken after substring+breakAfter = BM.breakAfterL++-- | @breakFindAfter@ does the same as 'breakAfter' but additionally indicates+--   whether the pattern is present in the target.+--+-- @+--   'fst' . 'breakFindAfter' pat = 'breakAfter' pat+-- @+{-# INLINE breakFindAfter #-}+breakFindAfter :: S.ByteString  -- ^ Strict pattern to search for+               -> L.ByteString  -- ^ Lazy string to search in+               -> ((L.ByteString, L.ByteString), Bool)+                            -- ^ Head and tail of string broken after substring+                            --   and presence of pattern+breakFindAfter = BM.breakFindAfterL++-- | @replace pat sub text@ replaces all (non-overlapping) occurrences of+--   @pat@ in @text@ with @sub@. If occurrences of @pat@ overlap, the first+--   occurrence that does not overlap with a replaced previous occurrence+--   is substituted. Occurrences of @pat@ arising from a substitution+--   will not be substituted. For example:+--+-- @+--   'replace' \"ana\" \"olog\" \"banana\" = \"bologna\"+--   'replace' \"ana\" \"o\" \"bananana\" = \"bono\"+--   'replace' \"aab\" \"abaa\" \"aaab\" = \"abaaab\"+-- @+--+--   The result is a /lazy/ 'L.ByteString',+--   which is lazily produced, without copying.+--   Equality of pattern and substitution is not checked, but+--+-- @+--   'replace' pat pat text == text+-- @+--+--   holds (the internal structure is generally different).+--   If the pattern is empty but not the substitution, the result+--   is equivalent to (were they 'String's) @cycle sub@.+--+--   For non-empty @pat@ and @sub@ a lazy 'L.ByteString',+--+-- @+--   'L.concat' . 'Data.List.intersperse' sub . 'split' pat = 'replace' pat sub+-- @+--+--   and analogous relations hold for other types of @sub@.+{-# INLINE replace #-}+replace :: Substitution rep+        => S.ByteString     -- ^ Strict pattern to replace+        -> rep              -- ^ Replacement string+        -> L.ByteString     -- ^ Lazy string to modify+        -> L.ByteString     -- ^ Lazy result+replace = BM.replaceAllL++-- | @split pattern target@ splits @target@ at each (non-overlapping)+--   occurrence of @pattern@, removing @pattern@. If @pattern@ is empty,+--   the result is an infinite list of empty 'L.ByteString's, if @target@+--   is empty but not @pattern@, the result is an empty list, otherwise+--   the following relations hold (where @patL@ is the lazy 'L.ByteString'+--   corresponding to @pat@):+--+-- @+--   'L.concat' . 'Data.List.intersperse' patL . 'split' pat = 'id',+--   'length' ('split' pattern target) ==+--               'length' ('nonOverlappingIndices' pattern target) + 1,+-- @+--+--   no fragment in the result contains an occurrence of @pattern@.+{-# INLINE split #-}+split :: S.ByteString   -- ^ Strict pattern to split on+      -> L.ByteString   -- ^ Lazy string to split+      -> [L.ByteString] -- ^ Fragments of string+split = BM.splitDropL++-- | @splitKeepEnd pattern target@ splits @target@ after each (non-overlapping)+--   occurrence of @pattern@. If @pattern@ is empty, the result is an+--   infinite list of empty 'L.ByteString's, otherwise the following+--   relations hold:+--+-- @+--   'L.concat' . 'splitKeepEnd' pattern = 'id',+-- @+--+--   all fragments in the result except possibly the last end with+--   @pattern@, no fragment contains more than one occurrence of @pattern@.+{-# INLINE splitKeepEnd #-}+splitKeepEnd :: S.ByteString    -- ^ Strict pattern to split on+             -> L.ByteString    -- ^ Lazy string to split+             -> [L.ByteString]  -- ^ Fragments of string+splitKeepEnd = BM.splitKeepEndL++-- | @splitKeepFront@ is like 'splitKeepEnd', except that @target@ is split+--   before each occurrence of @pattern@ and hence all fragments+--   with the possible exception of the first begin with @pattern@.+{-# INLINE splitKeepFront #-}+splitKeepFront :: S.ByteString    -- ^ Strict pattern to split on+               -> L.ByteString    -- ^ Lazy string to split+               -> [L.ByteString]  -- ^ Fragments of string+splitKeepFront = BM.splitKeepFrontL++-- | @strictify@ converts a lazy 'L.ByteString' to a strict 'S.ByteString'+--   to make it a suitable pattern.+strictify :: L.ByteString -> S.ByteString+strictify = S.concat . L.toChunks
+ Data/ByteString/Lazy/Search/DFA.hs view
@@ -0,0 +1,436 @@+{-# LANGUAGE BangPatterns #-}+-- |+-- Module         : Data.ByteString.Lazy.Search.DFA+-- Copyright      : Daniel Fischer+-- Licence        : BSD3+-- Maintainer     : Daniel Fischer <daniel.is.fischer@web.de>+-- Stability      : Provisional+-- Portability    : non-portable (BangPatterns)+--+-- Fast search of lazy 'L.ByteString' values. Breaking,+-- splitting and replacing using a deterministic finite automaton.++module Data.ByteString.Lazy.Search.DFA ( -- * Overview+                                         -- $overview++                                         -- ** Complexity and performance+                                         -- $complexity++                                         -- ** Partial application+                                         -- $partial++                                         -- * Finding substrings+                                         indices+                                       , nonOverlappingIndices+                                         -- * Breaking on substrings+                                       , breakOn+                                       , breakAfter+                                       , breakFindAfter+                                         -- * Replacing+                                       , replace+                                         -- * Splitting+                                       , split+                                       , splitKeepEnd+                                       , splitKeepFront+                                       ) where++import Data.ByteString.Search.Internal.Utils (automaton, keep, ldrop, lsplit)+import Data.ByteString.Search.Substitution++import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Internal as LI+import Data.ByteString.Unsafe (unsafeIndex)++import Data.Array.Base (unsafeAt)+--import Data.Array.Unboxed (UArray)++import Data.Bits+import Data.Int (Int64)++-- $overview+--+-- This module provides functions related to searching a substring within+-- a string. The searching algorithm uses a deterministic finite automaton+-- based on the Knuth-Morris-Pratt algorithm.+-- The automaton is implemented as an array of @(patternLength + 1) * &#963;@+-- state transitions, where &#963; is the alphabet size (256), so it is only+-- suitable for short enough patterns, therefore the patterns in this module+-- are required to be strict 'S.ByteString's.+--+-- When searching a pattern in a UTF-8-encoded 'L.ByteString', be aware that+-- these functions work on bytes, not characters, so the indices are+-- byte-offsets, not character offsets.++-- $complexity+--+-- The time and space complexity of the preprocessing phase is+-- /O/(@patternLength * &#963;@).+-- The searching phase is /O/(@targetLength@), each target character is+-- inspected only once.+--+-- In general the functions in this module have about the same performance as+-- the corresponding functions using the Knuth-Morris-Pratt algorithm but+-- are considerably slower than the Boyer-Moore functions. For very short+-- patterns or, in the case of 'indices', patterns with a short period+-- which occur often, however, times are close to or even below the+-- Boyer-Moore times.++-- $partial+--+-- All functions can usefully be partially applied. Given only a pattern,+-- the automaton is constructed only once, allowing efficient re-use.++------------------------------------------------------------------------------+--                            Exported Functions                            --+------------------------------------------------------------------------------++-- | @indices@ finds the starting indices of all possibly overlapping+--   occurrences of the pattern in the target string.+--   If the pattern is empty, the result is @[0 .. 'length' target]@.+{-# INLINE indices #-}+indices :: S.ByteString     -- ^ Strict pattern to find+        -> L.ByteString     -- ^ Lazy string to search+        -> [Int64]          -- ^ Offsets of matches+indices !pat = lazySearcher True pat . L.toChunks++-- | @nonOverlappingIndices@ finds the starting indices of all+--   non-overlapping occurrences of the pattern in the target string.+--   It is more efficient than removing indices from the list produced+--   by 'indices'.+{-# INLINE nonOverlappingIndices #-}+nonOverlappingIndices :: S.ByteString   -- ^ Strict pattern to find+                      -> L.ByteString   -- ^ Lazy string to search+                      -> [Int64]        -- ^ Offsets of matches+nonOverlappingIndices !pat = lazySearcher False pat . L.toChunks++-- | @breakOn pattern target@ splits @target@ at the first occurrence+--   of @pattern@. If the pattern does not occur in the target, the+--   second component of the result is empty, otherwise it starts with+--   @pattern@. If the pattern is empty, the first component is empty.+--   For a non-empty pattern, the first component is generated lazily,+--   thus the first parts of it can be available before the pattern has+--   been found or determined to be absent.+--+-- @+--   'uncurry' 'L.append' . 'breakOn' pattern = 'id'+-- @+breakOn :: S.ByteString  -- ^ Strict pattern to search for+        -> L.ByteString  -- ^ Lazy string to search in+        -> (L.ByteString, L.ByteString)+                         -- ^ Head and tail of string broken at substring+breakOn pat = breaker . L.toChunks+  where+    lbrk = lazyBreaker True pat+    breaker strs = let (f, b) = lbrk strs+                   in (L.fromChunks f, L.fromChunks b)++-- | @breakAfter pattern target@ splits @target@ behind the first occurrence+--   of @pattern@. An empty second component means that either the pattern+--   does not occur in the target or the first occurrence of pattern is at+--   the very end of target. If you need to discriminate between those cases,+--   use breakFindAfter.+--   If the pattern is empty, the first component is empty.+--   For a non-empty pattern, the first component is generated lazily,+--   thus the first parts of it can be available before the pattern has+--   been found or determined to be absent.+-- @+--   'uncurry' 'L.append' . 'breakAfter' pattern = 'id'+-- @+breakAfter :: S.ByteString  -- ^ Strict pattern to search for+           -> L.ByteString  -- ^ Lazy string to search in+           -> (L.ByteString, L.ByteString)+                            -- ^ Head and tail of string broken after substring+breakAfter pat = breaker . L.toChunks+  where+    lbrk = lazyBreaker False pat+    breaker strs = let (f, b) = lbrk strs+                   in (L.fromChunks f, L.fromChunks b)++-- | @breakFindAfter@ does the same as 'breakAfter' but additionally indicates+--   whether the pattern is present in the target.+--+-- @+--   'fst' . 'breakFindAfter' pat = 'breakAfter' pat+-- @+breakFindAfter :: S.ByteString  -- ^ Strict pattern to search for+               -> L.ByteString  -- ^ Lazy string to search in+               -> ((L.ByteString, L.ByteString), Bool)+                            -- ^ Head and tail of string broken after substring+                            --   and presence of pattern+breakFindAfter pat+  | S.null pat  = \str -> ((L.empty, str), True)+breakFindAfter pat = breaker . L.toChunks+  where+    !patLen = S.length pat+    lbrk = lazyBreaker True pat+    breaker strs = let (f, b) = lbrk strs+                       (f1, b1) = lsplit patLen b+                       mbpat = L.fromChunks f1+                   in ((foldr LI.chunk mbpat f, L.fromChunks b1), not (null b))++-- | @replace pat sub text@ replaces all (non-overlapping) occurrences of+--   @pat@ in @text@ with @sub@. If occurrences of @pat@ overlap, the first+--   occurrence that does not overlap with a replaced previous occurrence+--   is substituted. Occurrences of @pat@ arising from a substitution+--   will not be substituted. For example:+--+-- @+--   'replace' \"ana\" \"olog\" \"banana\" = \"bologna\"+--   'replace' \"ana\" \"o\" \"bananana\" = \"bono\"+--   'replace' \"aab\" \"abaa\" \"aaab\" = \"abaaab\"+-- @+--+--   The result is a /lazy/ 'L.ByteString',+--   which is lazily produced, without copying.+--   Equality of pattern and substitution is not checked, but+--+-- @+--   'replace' pat pat text == text+-- @+--+--   holds (the internal structure is generally different).+--   If the pattern is empty but not the substitution, the result+--   is equivalent to (were they 'String's) @cycle sub@.+--+--   For non-empty @pat@ and @sub@ a lazy 'L.ByteString',+--+-- @+--   'L.concat' . 'Data.List.intersperse' sub . 'split' pat = 'replace' pat sub+-- @+--+--   and analogous relations hold for other types of @sub@.+replace :: Substitution rep+        => S.ByteString     -- ^ Strict pattern to replace+        -> rep              -- ^ Replacement string+        -> L.ByteString     -- ^ Lazy string to modify+        -> L.ByteString     -- ^ Lazy result+replace pat+  | S.null pat = \sub -> prependCycle sub+  | otherwise =+    let !patLen = S.length pat+        breaker = lazyBreaker True pat+        repl subst strs+          | null strs   = []+          | otherwise   =+            let (pre, mtch) = breaker strs+            in pre ++ case mtch of+                        [] -> []+                        _  -> subst (repl subst (ldrop patLen mtch))+    in \sub -> let {-# NOINLINE subst #-}+                   !subst = substitution sub+                   repl1 = repl subst+               in L.fromChunks . repl1 . L.toChunks+++-- | @split pattern target@ splits @target@ at each (non-overlapping)+--   occurrence of @pattern@, removing @pattern@. If @pattern@ is empty,+--   the result is an infinite list of empty 'L.ByteString's, if @target@+--   is empty but not @pattern@, the result is an empty list, otherwise+--   the following relations hold (where @patL@ is the lazy 'L.ByteString'+--   corresponding to @pat@):+--+-- @+--   'L.concat' . 'Data.List.intersperse' patL . 'split' pat = 'id',+--   'length' ('split' pattern target) ==+--               'length' ('nonOverlappingIndices' pattern target) + 1,+-- @+--+--   no fragment in the result contains an occurrence of @pattern@.+split :: S.ByteString   -- ^ Strict pattern to split on+      -> L.ByteString   -- ^ Lazy string to split+      -> [L.ByteString] -- ^ Fragments of string+split pat+  | S.null pat  = const (repeat L.empty)+split pat = map L.fromChunks . splitter . L.toChunks+  where+    !patLen = S.length pat+    breaker = lazyBreaker True pat+    splitter strs+      | null strs  = []+      | otherwise  = splitter' strs+    splitter' strs+      | null strs  = [[]]+      | otherwise  =+        let (pre, mtch) = breaker strs+        in pre : case mtch of+                    [] -> []+                    _  -> splitter' (ldrop patLen mtch)++-- | @splitKeepEnd pattern target@ splits @target@ after each (non-overlapping)+--   occurrence of @pattern@. If @pattern@ is empty, the result is an+--   infinite list of empty 'L.ByteString's, otherwise the following+--   relations hold:+--+-- @+--   'L.concat' . 'splitKeepEnd' pattern = 'id,'+-- @+--+--   all fragments in the result except possibly the last end with+--   @pattern@, no fragment contains more than one occurrence of @pattern@.+splitKeepEnd :: S.ByteString    -- ^ Strict pattern to split on+             -> L.ByteString    -- ^ Lazy string to split+             -> [L.ByteString]  -- ^ Fragments of string+splitKeepEnd pat+  | S.null pat = const (repeat L.empty)+splitKeepEnd pat = map L.fromChunks . splitter . L.toChunks+  where+    breaker = lazyBreaker False pat+    splitter [] = []+    splitter strs =+      let (pre, mtch) = breaker strs+      in pre : splitter mtch++-- | @splitKeepFront@ is like 'splitKeepEnd', except that @target@ is split+--   before each occurrence of @pattern@ and hence all fragments+--   with the possible exception of the first begin with @pattern@.+splitKeepFront :: S.ByteString    -- ^ Strict pattern to split on+               -> L.ByteString    -- ^ Lazy string to split+               -> [L.ByteString]  -- ^ Fragments of string+splitKeepFront pat+  | S.null pat  = const (repeat L.empty)+splitKeepFront pat = map L.fromChunks . splitter . L.toChunks+  where+    !patLen = S.length pat+    breaker = lazyBreaker True pat+    splitter strs = case splitter' strs of+                      ([] : rst) -> rst+                      other -> other+    splitter' []    = []+    splitter' strs  =+      let (pre, mtch) = breaker strs+      in 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++------------------------------------------------------------------------------+--                            Searching Function                            --+------------------------------------------------------------------------------++lazySearcher :: Bool -> S.ByteString -> [S.ByteString] -> [Int64]+lazySearcher _ !pat+    | S.null pat        =+      let zgo _ [] = []+          zgo !prior (!str : rest) =+              let !l = S.length str+                  !prior' = prior + fromIntegral l+              in [prior + fromIntegral i | i <- [1 .. l]] ++ zgo prior' rest+      in (0:) . 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 = search 0 0+  where+    !patLen = S.length pat+    !auto   = automaton pat+    !p0     = unsafeIndex pat 0+    !ams    = if overlap then patLen else 0+    search _ _ [] = []+    search !prior st (!str:rest) = match st 0+      where+        !strLen = S.length str+        {-# INLINE strAt #-}+        strAt :: Int -> Int+        strAt i = fromIntegral (str `unsafeIndex` i)+        match 0 !idx+          | idx == strLen = search (prior + fromIntegral strLen) 0 rest+          | unsafeIndex str idx == p0   = match 1 (idx + 1)+          | otherwise     = match 0 (idx + 1)+        match state idx+          | idx == strLen = search (prior + fromIntegral strLen) state rest+          | otherwise     =+            let nstate = unsafeAt auto ((state `shiftL` 8) + strAt idx)+                !nxtIdx = idx + 1+            in if nstate == patLen+                then (prior + fromIntegral (nxtIdx - patLen)) :+                            match ams nxtIdx+                else match nstate nxtIdx++------------------------------------------------------------------------------+--                                 Breaking                                 --+------------------------------------------------------------------------------++-- Code duplication :(+-- Needed for reasonable performance.+lazyBreaker :: Bool -> S.ByteString -> [S.ByteString]+                    -> ([S.ByteString], [S.ByteString])+lazyBreaker before pat+  | S.null pat  = \strs -> ([], strs)+  | S.length pat == 1 =+    let !w = S.head pat+        !a = if before then 0 else 1+        ixes = S.elemIndices w+        scan [] = ([], [])+        scan (!str:rest) =+            let !strLen = S.length str+            in case ixes str of+                []  -> let (fr, bk) = scan rest in (str : fr, bk)+                (i:_) -> let !j = i + a+                         in if j == strLen+                              then ([str],rest)+                              else ([S.take j str], S.drop j str : rest)+    in scan+lazyBreaker !before pat = bscan [] 0+  where+    !patLen = S.length pat+    !auto   = automaton pat+    !p0     = unsafeIndex pat 0+    bscan _ _ [] = ([], [])+    bscan !past !sta (!str:rest) = match sta 0+      where+        !strLen = S.length str+        {-# INLINE strAt #-}+        strAt :: Int -> Int+        strAt i = fromIntegral (str `unsafeIndex` i)+        match 0 idx+          | idx == strLen =+            let (fr, bk) = bscan [] 0 rest+            in (foldr (flip (.) . (:)) id past (str:fr), bk)+          | unsafeIndex str idx == p0 = match 1 (idx + 1)+          | otherwise = match 0 (idx + 1)+        match state idx+          | idx == strLen =+            let (kp, !rl) = if before+                                then keep state (str:past)+                                else ([], str:past)+                (fr, bk) = bscan kp state rest+            in (foldr (flip (.) . (:)) id rl fr, bk)+          | otherwise =+            let !nstate = unsafeAt auto ((state `shiftL` 8) + strAt idx)+                !nxtIdx = idx + 1+            in if nstate == patLen+                then case if before then nxtIdx - patLen else nxtIdx of+                       0 -> (foldr (flip (.) . (:)) id past [], str:rest)+                       stIx | stIx < 0 -> rgo (-stIx) (str:rest) past+                            | stIx == strLen ->+                              (foldr (flip (.) . (:)) id past [str],rest)+                            | otherwise ->+                              (foldr (flip (.) . (:)) id past+                                    [S.take stIx str], S.drop stIx str : rest)+                else match nstate nxtIdx+++-- Did I already mention that I suck at finding names?+{-# INLINE rgo #-}+rgo :: Int -> [S.ByteString] -> [S.ByteString]+    -> ([S.ByteString], [S.ByteString])+rgo !kp acc (!str:more)+  | sl == kp    = (reverse more, str:acc)+  | sl < kp     = rgo (kp - sl) (str:acc) more+  | otherwise   = case S.splitAt (sl - kp) str of+                    (fr, bk) ->+                      (foldr (flip (.) . (:)) id more [fr], bk:acc)+    where+      !sl = S.length str+rgo _ _ [] = error "Not enough past!"+-- If that error is ever encountered, I screwed up badly.
+ Data/ByteString/Lazy/Search/KMP.hs view
@@ -0,0 +1,94 @@+-- |+-- Module         : Data.ByteString.Lazy.Search.KMP+-- Copyright      : Justin Bailey+--                  Chris Kuklewicz+--                  Daniel Fischer+-- Licence        : BSD3+-- Maintainer     : Daniel Fischer <daniel.is.fischer@web.de>+-- Stability      : Provisional+-- Portability    : non-portable (BangPatterns)+--+-- Fast search of lazy 'L.ByteString' values using the+-- Knuth-Morris-Pratt algorithm.+--+-- A description of the algorithm can be found at+-- <http://en.wikipedia.org/wiki/Knuth-Morris-Pratt_algorithm>.+--+-- Original authors: Justin Bailey (jgbailey at gmail.com) and+-- Chris Kuklewicz (haskell at list.mightyreason.com).+module Data.ByteString.Lazy.Search.KMP (-- * Overview+                                        -- $overview++                                        -- ** Complexity and Performance+                                        -- $complexity++                                        -- ** Partial application+                                        -- $partial++                                        -- * Functions+                                          indices+                                        , nonOverlappingIndices+                                        -- ** Convenience+                                        , strictify+                                        ) where++import Data.ByteString.Search.Internal.KnuthMorrisPratt (matchSL, indicesL)+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L++import Data.Int (Int64)++-- $overview+--+-- This module provides two functions for finding the occurrences of a+-- pattern in a target string using the Knuth-Morris-Pratt algorithm.+-- It exists mostly for systematic reasons, the functions from+-- "Data.ByteString.Lazy.Search" are much faster, except for very short+-- patterns or long patterns with a short period if overlap is allowed.+-- In the latter case, 'indices' from this module may be the best choice+-- since the Boyer-Moore function's performance degrades if there are many+-- matches and the DFA function's automaton needs much space for long+-- patterns.+-- In the former case, for some pattern\/target combinations DFA has better+-- performance, for others KMP, usually the difference is small.++-- $complexity+--+-- The preprocessing of the pattern is /O/(@patternLength@) in time and space.+-- The time complexity of the searching phase is /O/(@targetLength@) for both+-- functions.+--+-- In most cases, these functions are considerably slower than the+-- Boyer-Moore variants, performance is close to that of those from+-- "Data.ByteString.Search.DFA".++-- $partial+--+-- Both functions can be usefully partially applied. Given only a+-- pattern, the auxiliary data will be computed only once, allowing for+-- efficient re-use.++-- | @indices@ finds the starting indices of all possibly overlapping+--   occurrences of the pattern in the target string.+--   If the pattern is empty, the result is @[0 .. 'length' target]@.+{-# INLINE indices #-}+indices :: S.ByteString     -- ^ Strict pattern to find+        -> L.ByteString     -- ^ Lazy string to search+        -> [Int64]          -- ^ Offsets of matches+indices = indicesL++-- | @nonOverlappingIndices@ finds the starting indices of all+--   non-overlapping occurrences of the pattern in the target string.+--   It is more efficient than removing indices from the list produced+--   by 'indices'.+{-# INLINE nonOverlappingIndices #-}+nonOverlappingIndices :: S.ByteString   -- ^ Strict pattern to find+                      -> L.ByteString   -- ^ Lazy string to search+                      -> [Int64]        -- ^ Offsets of matches+nonOverlappingIndices = matchSL++-- | @strictify@ transforms a lazy 'L.ByteString' into a strict+--   'S.ByteString', to make it a suitable pattern for the searching+--   functions.+strictify :: L.ByteString -> S.ByteString+strictify = S.concat . L.toChunks
+ Data/ByteString/Lazy/Search/KarpRabin.hs view
@@ -0,0 +1,251 @@+{-# LANGUAGE BangPatterns #-}+-- |+-- Module         : Data.ByteString.Lazy.Search.KarpRabin+-- Copyright      : (c) 2010 Daniel Fischer+-- Licence        : BSD3+-- Maintainer     : Daniel Fischer <daniel.is.fischer@web.de>+-- Stability      : Provisional+-- Portability    : non-portable (BangPatterns)+--+-- Simultaneous search for multiple patterns in a lazy 'L.ByteString'+-- using the Karp-Rabin algorithm.+--+-- A description of the algorithm for a single pattern can be found at+-- <http://www-igm.univ-mlv.fr/~lecroq/string/node5.html#SECTION0050>.+module Data.ByteString.Lazy.Search.KarpRabin ( -- * Overview+                                               -- $overview++                                               -- ** Caution+                                               -- $caution++                                               -- * Function+                                               indicesOfAny+                                             ) where++import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import Data.ByteString.Unsafe (unsafeIndex)++import qualified Data.IntMap as IM++import Data.Array+import Data.Array.Base (unsafeAt)++import Data.Word (Word8)+import Data.Int (Int64)+import Data.Bits+import Data.List (foldl')++-- $overview+--+-- The Karp-Rabin algorithm works by calculating a hash of the pattern and+-- comparing that hash with the hash of a slice of the target string with+-- the same length as the pattern. If the hashes are equal, the slice of the+-- target is compared to the pattern character by character (since the hash+-- function generally isn't injective).+--+-- For a single pattern, this tends to be more efficient than the na&#239;ve+-- algorithm, but it cannot compete with algorithms like+-- Knuth-Morris-Pratt or Boyer-Moore.+--+-- However, the algorithm can be generalised to search for multiple patterns+-- simultaneously. If the shortest pattern has length @k@, hash the prefix of+-- length @k@ of all patterns and compare the hash of the target's slices of+-- length @k@ to them. If there's a match, check whether the slice is part+-- of an occurrence of the corresponding pattern.+--+-- With a hash-function that+--+--   * allows to compute the hash of one slice in constant time from the hash+--     of the previous slice, the new and the dropped character, and+--+--   * produces few spurious matches,+--+-- searching for occurrences of any of @n@ patterns has a best-case complexity+-- of /O/(@targetLength@ * @lookup n@). The worst-case complexity is+-- /O/(@targetLength@ * @lookup n@ * @sum patternLengths@), the average is+-- not much worse than the best case.+--+-- The functions in this module store the hashes of the patterns in an+-- 'IM.IntMap', so the lookup is /O/(@log n@). Re-hashing is done in constant+-- time and spurious matches of the hashes /should be/ sufficiently rare.+-- The maximal length of the prefixes to be hashed is 32.++-- $caution+--+-- Unfortunately, the constant factors are high, so these functions are slow.+-- Unless the number of patterns to search for is high (larger than 50 at+-- least), repeated search for single patterns using Boyer-Moore or DFA and+-- manual merging of the indices is faster. /Much/ faster for less than 40+-- or so patterns.+--+-- 'indicesOfAny' has the advantage over multiple single-pattern searches that+-- it doesn't hold on to large parts of the string (which is likely to happen+-- for multiple searches), however, so in contrast to the strict version, it+-- may be useful for relatively few patterns already.+--+-- Nevertheless, this module seems more of an interesting curiosity than+-- anything else.++-- | @indicesOfAny@ finds all occurrences of any of several non-empty strict+--   patterns in a lazy target string. If no non-empty patterns are given,+--   the result is an empty list. Otherwise the result list contains+--   the pairs of all indices where any of the (non-empty) patterns start+--   and the list of all patterns starting at that index, the patterns being+--   represented by their (zero-based) position in the pattern list.+--   Empty patterns are filtered out before processing begins.+{-# INLINE indicesOfAny #-}+indicesOfAny :: [S.ByteString]  -- ^ List of non-empty patterns+             -> L.ByteString    -- ^ String to search+             -> [(Int64,[Int])]   -- ^ List of matches+indicesOfAny pats+    | null nepats   = const []+    | otherwise     = lazyMatcher nepats . L.toChunks+      where+        nepats = filter (not . S.null) pats++------------------------------------------------------------------------------+--                                 Workers                                 --+------------------------------------------------------------------------------++{-# INLINE rehash1 #-}+rehash1 :: Int -> Int -> Word8 -> Word8 -> Int+rehash1 out h o n =+    (h `shiftL` 1 - (fromIntegral o `shiftL` out)) + fromIntegral n++{-# INLINE rehash2 #-}+rehash2 :: Int -> Int -> Word8 -> Word8 -> Int+rehash2 out h o n =+    (h `shiftL` 2 - (fromIntegral o `shiftL` out)) + fromIntegral n++{-# INLINE rehash3 #-}+rehash3 :: Int -> Int -> Word8 -> Word8 -> Int+rehash3 out h o n =+    (h `shiftL` 3 - (fromIntegral o `shiftL` out)) + fromIntegral n++{-# INLINE rehash4 #-}+rehash4 :: Int -> Int -> Word8 -> Word8 -> Int+rehash4 out h o n =+    (h `shiftL` 4 - (fromIntegral o `shiftL` out)) + fromIntegral n++lazyMatcher :: [S.ByteString] -> [S.ByteString] -> [(Int64,[Int])]+lazyMatcher pats = search 0 hLen S.empty+  where+    !hLen = minimum (32 : map S.length pats)+    !shDi = case 32 `quot` hLen of+              q | q < 4 -> q+                | otherwise -> 4+    !outS = shDi*hLen+    !patNum = length pats+    !patArr = listArray (0, patNum - 1) pats+    {-# INLINE rehash #-}+    rehash :: Int -> Word8 -> Word8 -> Int+    rehash = case shDi of+                1 -> rehash1 hLen+                2 -> rehash2 outS+                3 -> rehash3 outS+                _ -> rehash4 outS+    hash :: S.ByteString -> Int+    hash = S.foldl' (\h w -> (h `shiftL` shDi) + fromIntegral w) 0 . S.take hLen+    !hashMap =+        foldl' (\mp (h,i) -> IM.insertWith (flip (++)) h [i] mp) IM.empty $+                                zip (map hash pats) [0 :: Int .. ]+    search _ _ _ [] = []+    search !h !rm !prev (!str : rest)+      | strLen < rm =+          let !h' = S.foldl' (\o w -> (o `shiftL` 1) + fromIntegral w) h str+              !prev' = S.append prev str+          in search h' (rm - strLen) prev' rest+      | otherwise =+          let !h' = S.foldl' (\o w -> (o `shiftL` 1) + fromIntegral w) h+                                                (S.take rm str)+          in if S.null prev+                then noPast 0 rest str h'+                else past 0 rest prev 0 str rm h'+        where+          !strLen = S.length str++    noPast !prior rest !str hsh = go hsh 0+      where+        !strLen = S.length str+        !maxIdx = strLen - hLen+        {-# INLINE strAt #-}+        strAt !i = unsafeIndex str i+        go !h sI =+          case IM.lookup h hashMap of+            Nothing ->+              if sI == maxIdx+                then case rest of+                        [] -> []+                        (nxt : more) ->+                          let !h' = rehash h (strAt sI) (unsafeIndex nxt 0)+                              !prior' = prior + fromIntegral strLen+                              !prev = S.drop (sI + 1) str+                          in if hLen == 1+                                then noPast prior' more nxt h'+                                else past prior' more prev 0 nxt 1 h'+                else go (rehash h (strAt sI) (strAt (sI + hLen))) (sI + 1)+            Just ps ->+              let !rst = S.drop sI str+                  !rLen = strLen - sI+                  {-# INLINE hd #-}+                  hd = strAt sI+                  {-# INLINE more #-}+                  more =+                    if sI == maxIdx+                      then case rest of+                            [] -> []+                            (nxt : fut) ->+                              let !h' = rehash h hd (unsafeIndex nxt 0)+                                  !prior' = prior + fromIntegral strLen+                              in if hLen == 1+                                    then noPast prior' fut nxt h'+                                    else past prior' fut rst 1 nxt 1 h'+                      else go (rehash h hd (strAt (sI + hLen))) (sI + 1)+                  okay bs+                    | rLen < S.length bs = S.isPrefixOf rst bs &&+                            checkFut (S.drop rLen bs) rest+                    | otherwise = S.isPrefixOf bs rst+              in case filter (okay . (patArr `unsafeAt`)) ps of+                    [] -> more+                    qs -> seq (length qs) $+                            (prior + fromIntegral sI,qs) : more++    past !prior rest !prev !pI !str !sI !hsh+      | strLen < 4040 =+        let !prior' = prior - 1 + fromIntegral (sI - hLen)+            !curr   = S.append (S.drop pI prev) str+        in noPast prior' rest curr hsh+      | otherwise = go hsh pI sI+        where+          !strLen = S.length str+          {-# INLINE strAt #-}+          strAt !i = unsafeIndex str i+          {-# INLINE prevAt #-}+          prevAt !i = unsafeIndex prev i+          go !h !p !s+            | s == hLen = noPast prior rest str h+            | otherwise =+              case IM.lookup h hashMap of+                Nothing ->+                  let {-# INLINE h' #-}+                      h' = rehash h (prevAt p) (strAt s)+                  in go h' (p + 1) (s + 1)+                Just ps ->+                  let !prst = S.drop p prev+                      {-# INLINE more #-}+                      more = go (rehash h (prevAt p) (strAt s)) (p + 1) (s + 1)+                      okay bs = checkFut bs (prst : str : rest)+                  in case filter (okay . (unsafeAt patArr)) ps of+                        [] -> more+                        qs -> seq (length qs) $+                                (prior + fromIntegral (s - hLen), qs) : more++{-# INLINE checkFut #-}+checkFut :: S.ByteString -> [S.ByteString] -> Bool+checkFut _ [] = False+checkFut !bs (!h : t)+    | hLen < S.length bs = S.isPrefixOf h bs && checkFut (S.drop hLen bs) t+    | otherwise = S.isPrefixOf bs h+      where+        !hLen = S.length h
+ Data/ByteString/Search.hs view
@@ -0,0 +1,252 @@+-- |+-- Module         : Data.ByteString.Search+-- Copyright      : Daniel Fischer+--                  Chris Kuklewicz+-- Licence        : BSD3+-- Maintainer     : Daniel Fischer <daniel.is.fischer@web.de>+-- Stability      : Provisional+-- Portability    : non-portable (BangPatterns)+--+-- Fast overlapping Boyer-Moore search of strict+-- '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 web.de) and+-- Chris Kuklewicz (haskell at list.mightyreason.com).+module Data.ByteString.Search ( -- * Overview+                                -- $overview++                                -- ** Performance+                                -- $performance++                                -- ** Complexity+                                -- $complexity++                                -- ** Partial application+                                -- $partial++                                -- * Finding substrings+                                indices+                              , nonOverlappingIndices+                                -- * Breaking on substrings+                              , breakOn+                              , breakAfter+                                -- * Replacing+                              , replace+                                -- * Splitting+                              , split+                              , splitKeepEnd+                              , splitKeepFront+                              ) where++import qualified Data.ByteString.Search.Internal.BoyerMoore as BM+import Data.ByteString.Search.Substitution+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L++-- $overview+--+-- This module provides functions related to searching a substring within+-- a string, using the Boyer-Moore algorithm with minor modifications+-- to improve the overall performance and avoid the worst case+-- performance degradation of the original Boyer-Moore algorithm for+-- periodic patterns.+--+-- When searching a pattern in a UTF-8-encoded 'S.ByteString', be aware that+-- these functions work on bytes, not characters, so the indices are+-- byte-offsets, not character offsets.+++-- $performance+--+-- In general, the Boyer-Moore algorithm is the most efficient method to+-- search for a pattern inside a string. The advantage over other algorithms+-- (e.g. Na&#239;ve, Knuth-Morris-Pratt, Horspool, Sunday) can be made+-- arbitrarily large for specially selected patterns and targets, but+-- usually, it's a factor of 2&#8211;3 versus Knuth-Morris-Pratt and of+-- 6&#8211;10 versus the na&#239;ve algorithm. The Horspool and Sunday+-- algorithms, which are simplified variants of the Boyer-Moore algorithm,+-- typically have performance between Boyer-Moore and Knuth-Morris-Pratt,+-- mostly closer to Boyer-Moore. The advantage of the Boyer-moore variants+-- over other algorithms generally becomes larger for longer patterns. For+-- very short patterns (or patterns with a very short period), other+-- algorithms, e.g. "Data.ByteString.Search.DFA" can be faster (my+-- tests suggest that \"very short\" means two, maybe three bytes).+--+-- In general, searching in a strict 'S.ByteString' is slightly faster+-- than searching in a lazy 'L.ByteString', but for long targets, the+-- smaller memory footprint of lazy 'L.ByteStrings' can make searching+-- those (sometimes much) faster. On the other hand, there are cases+-- where searching in a strict target is much faster, even for long targets.++-- $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 'indices'+-- 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 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.+-- I may be 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).++-- $partial+--+-- All functions can usefully be partially applied. Given only a pattern,+-- the pattern is preprocessed only once, allowing efficient re-use.++------------------------------------------------------------------------------+--                            Exported Functions                            --+------------------------------------------------------------------------------++-- | @indices@ finds the starting indices of all possibly overlapping+--   occurrences of the pattern in the target string.+--   If the pattern is empty, the result is @[0 .. 'length' target]@.+--+--   In general, @'not' . 'null' $ 'indices' pat target@ is a much more+--   efficient version of 'S.isInfixOf'.+{-# INLINE indices #-}+indices :: S.ByteString     -- ^ Pattern to find+        -> S.ByteString     -- ^ String to search+        -> [Int]            -- ^ Offsets of matches+indices = BM.matchSS++-- | @nonOverlappingIndices@ finds the starting indices of all+--   non-overlapping occurrences of the pattern in the target string.+--   It is more efficient than removing indices from the list produced+--   by 'indices'.+{-# INLINE nonOverlappingIndices #-}+nonOverlappingIndices :: S.ByteString   -- ^ Pattern to find+                      -> S.ByteString   -- ^ String to search+                      -> [Int]          -- ^ Offsets of matches+nonOverlappingIndices = BM.matchNOS++-- | @breakOn pattern target@ splits @target@ at the first occurrence+--   of @pattern@. If the pattern does not occur in the target, the+--   second component of the result is empty, otherwise it starts with+--   @pattern@. If the pattern is empty, the first component is empty.+--+-- @+--   'uncurry' 'S.append' . 'breakOn' pattern = 'id'+-- @+{-# INLINE breakOn #-}+breakOn :: S.ByteString  -- ^ String to search for+        -> S.ByteString  -- ^ String to search in+        -> (S.ByteString, S.ByteString)+                         -- ^ Head and tail of string broken at substring+breakOn = BM.breakSubstringS++-- | @breakAfter pattern target@ splits @target@ behind the first occurrence+--   of @pattern@. An empty second component means that either the pattern+--   does not occur in the target or the first occurrence of pattern is at+--   the very end of target. To discriminate between those cases, use e.g.+--   'S.isSuffixOf'.+--+-- @+--   'uncurry' 'S.append' . 'breakAfter' pattern = 'id'+-- @+{-# INLINE breakAfter #-}+breakAfter :: S.ByteString  -- ^ String to search for+           -> S.ByteString  -- ^ String to search in+           -> (S.ByteString, S.ByteString)+                            -- ^ Head and tail of string broken after substring+breakAfter = BM.breakAfterS++-- | @replace pat sub text@ replaces all (non-overlapping) occurrences of+--   @pat@ in @text@ with @sub@. If occurrences of @pat@ overlap, the first+--   occurrence that does not overlap with a replaced previous occurrence+--   is substituted. Occurrences of @pat@ arising from a substitution+--   will not be substituted. For example:+--+-- @+--   'replace' \"ana\" \"olog\" \"banana\" = \"bologna\"+--   'replace' \"ana\" \"o\" \"bananana\" = \"bono\"+--   'replace' \"aab\" \"abaa\" \"aaab\" = \"abaaab\"+-- @+--+--   The result is a /lazy/ 'L.ByteString',+--   which is lazily produced, without copying.+--   Equality of pattern and substitution is not checked, but+--+-- @+--   ('S.concat' . 'L.toChunks' $ 'replace' pat pat text) == text+-- @+--+--   holds. If the pattern is empty but not the substitution, the result+--   is equivalent to (were they 'String's) @cycle sub@.+--+--   For non-empty @pat@ and @sub@ a strict 'S.ByteString',+--+-- @+--   'L.fromChunks' . 'Data.List.intersperse' sub . 'split' pat = 'replace' pat sub+-- @+--+--   and analogous relations hold for other types of @sub@.+{-# INLINE replace #-}+replace :: Substitution rep+        => S.ByteString     -- ^ Substring to replace+        -> rep              -- ^ Replacement string+        -> S.ByteString     -- ^ String to modify+        -> L.ByteString     -- ^ Lazy result+replace = BM.replaceAllS++-- | @split pattern target@ splits @target@ at each (non-overlapping)+--   occurrence of @pattern@, removing @pattern@. If @pattern@ is empty,+--   the result is an infinite list of empty 'S.ByteString's, if @target@+--   is empty but not @pattern@, the result is an empty list, otherwise+--   the following relations hold:+--+-- @+--   'S.concat' . 'Data.List.intersperse' pat . 'split' pat = 'id',+--   'length' ('split' pattern target) ==+--               'length' ('nonOverlappingIndices' pattern target) + 1,+-- @+--+--   no fragment in the result contains an occurrence of @pattern@.+{-# INLINE split #-}+split :: S.ByteString   -- ^ Pattern to split on+      -> S.ByteString   -- ^ String to split+      -> [S.ByteString] -- ^ Fragments of string+split = BM.splitDropS++-- | @splitKeepEnd pattern target@ splits @target@ after each (non-overlapping)+--   occurrence of @pattern@. If @pattern@ is empty, the result is an+--   infinite list of empty 'S.ByteString's, otherwise the following+--   relations hold:+--+-- @+--   'S.concat' . 'splitKeepEnd' pattern = 'id',+-- @+--+--   all fragments in the result except possibly the last end with+--   @pattern@, no fragment contains more than one occurrence of @pattern@.+{-# INLINE splitKeepEnd #-}+splitKeepEnd :: S.ByteString    -- ^ Pattern to split on+             -> S.ByteString    -- ^ String to split+             -> [S.ByteString]  -- ^ Fragments of string+splitKeepEnd = BM.splitKeepEndS++-- | @splitKeepFront@ is like 'splitKeepEnd', except that @target@ is split+--   before each occurrence of @pattern@ and hence all fragments+--   with the possible exception of the first begin with @pattern@.+{-# INLINE splitKeepFront #-}+splitKeepFront :: S.ByteString    -- ^ Pattern to split on+               -> S.ByteString    -- ^ String to split+               -> [S.ByteString]  -- ^ Fragments of string+splitKeepFront = BM.splitKeepFrontS
Data/ByteString/Search/BoyerMoore.hs view
@@ -1,12 +1,11 @@-{-# OPTIONS_GHC -fbang-patterns #-} -- |--- Module      : Data.ByteString.Seach.BoyerMoore--- Copyright   : Daniel Fischer---               Chris Kuklewicz--- License     : BSD3--- Maintainer  : Bryan O'Sullivan <bos@serpentine.com>--- Stability   : experimental--- Portability : portable+-- Module         : Data.ByteString.Search.BoyerMoore+-- Copyright      : Daniel Fischer+--                  Chris Kuklewicz+-- Licence        : BSD3+-- Maintainer     : Daniel Fischer <daniel.is.fischer@web.de>+-- Stability      : Provisional+-- Portability    : non-portable (BangPatterns) -- -- Fast overlapping Boyer-Moore search of both strict and lazy -- 'S.ByteString' values.@@ -18,60 +17,65 @@ -- -- Original authors: Daniel Fischer (daniel.is.fischer at web.de) and -- Chris Kuklewicz (haskell at list.mightyreason.com).- module Data.ByteString.Search.BoyerMoore-    (-      -- * Overview-      -- $overview+    {-# DEPRECATED "Use the new interface instead" #-} (+                                         -- * Overview+                                         -- $overview -      -- ** Parameter and return types-      -- $types+                                         -- ** Changes+                                         -- $changes -      -- ** Lazy ByteStrings-      -- $lazy+                                         -- ** Deprecation+                                         -- $deprecation -      -- ** Performance-      -- $performance+                                         -- ** Parameter and return types+                                         -- $types -      -- ** Complexity-      -- $complexity+                                         -- ** Lazy ByteStrings+                                         -- $lazy -      -- ** Currying-      -- $currying+                                         -- ** Performance+                                         -- $performance -      -- ** Integer overflow-      -- $overflow+                                         -- ** Complexity+                                         -- $complexity -      -- * Functions-      matchLL-    , matchLS-    , matchSL-    , matchSS-    ) where+                                         -- ** Partial application+                                         -- $currying -import qualified Data.ByteString as S (ByteString,null,length,concat)-import qualified Data.ByteString.Lazy as L (ByteString,toChunks)-#if __GLASGOW_HASKELL__ >= 608-import qualified Data.ByteString.Unsafe as U (unsafeIndex)-#else-import qualified Data.ByteString.Base as U (unsafeIndex)-#endif+                                         -- ** Integer overflow+                                         -- $overflow -import Data.Array.Base (unsafeAt,unsafeRead,unsafeWrite)-import Data.Array.ST (newArray,newArray_,runSTUArray)-import Data.Array.IArray (array,accumArray)-import Data.Array.Unboxed (UArray)-import Data.Word (Word8)-import Data.Int (Int64)+                                         -- * Functions+                                           matchLL+                                         , matchLS+                                         , matchSL+                                         , matchSS+                                         ) where +import Data.ByteString.Search.Internal.BoyerMoore+            (matchLL, matchLS, matchSL, matchSS)+ -- $overview ----- This module exports 4 search functions: 'matchLL', 'matchLS',--- 'matchSL', and 'matchSS'.+-- This module exists only for backwards compatibility. Nevertheless+-- there have been small changes in the behaviour of the functions.+-- The module exports four search functions: 'matchLL', 'matchLS',+-- 'matchSL', and 'matchSS'. All of them return the list of all+-- starting positions of possibly overlapping occurrences of a pattern+-- in a string.++-- $changes ----- If given an empty pattern, a search will always return an empty--- list.+-- Formerly, all four functions returned an empty list when passed+-- an empty pattern. Now, in accordance with the functions from the other+-- modules, @matchXY \"\" target = [0 .. 'length' target]@. +-- $deprecation+--+-- This module is /deprecated/. You should use the new interface provided+-- in "Data.ByteString.Search" resp. "Data.ByteString.Lazy.Search".+ -- $types -- -- The first parameter is always the pattern string.  The second@@ -98,12 +102,46 @@ -- amount of the target string and free the rest.  -- $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.+--+-- These functions can all be usefully partially applied.+-- Given only a pattern the partially applied version will compute+-- the supporting lookup tables only once, allowing for efficient re-use.+-- Similarly, the partially applied 'matchLL' and 'matchLS' will compute+-- the concatenated pattern only once. +-- $performance+--+-- In general, the Boyer-Moore algorithm is the most efficient method to+-- search for a pattern inside a string. The advantage over other algorithms+-- (e.g. Na&#239;ve, Knuth-Morris-Pratt, Horspool, Sunday) can be made+-- arbitrarily large for specially selected patterns and targets, but+-- usually, it's a factor of 2&#8211;3 versus Knuth-Morris-Pratt and of+-- 6&#8211;10 versus the na&#239;ve algorithm. The Horspool and Sunday+-- algorithms, which are simplified variants of the Boyer-Moore algorithm,+-- typically have performance between Boyer-Moore and Knuth-Morris-Pratt,+-- mostly closer to Boyer-Moore. The advantage of the Boyer-moore variants+-- over other algorithms generally becomes larger for longer patterns. For+-- very short patterns (or patterns with a very short period), other+-- algorithms, e.g. "Data.ByteString.Search.DFA" can be faster (my+-- tests suggest that \"very short\" means two, maybe three bytes).+--+-- In general, searching in a strict 'S.ByteString' is slightly faster+-- than searching in a lazy 'L.ByteString', but for long targets the+-- smaller memory footprint of lazy 'L.ByteStrings' can make searching+-- those (sometimes much) faster. On the other hand, there are cases+-- where searching in a strict target is much faster, even for long targets.+--+-- On 32-bit systems, 'Int'-arithmetic is much faster than 'Int64'-arithmetic,+-- so when there are many matches, that can make a significant difference.+--+-- Also, the modification to ameliorate the case of periodic patterns+-- is defeated by chunk-boundaries, so long patterns with a short period+-- and many matches exhibit poor behaviour (consider using @indices@ from+-- "Data.ByteString.Lazy.Search.DFA" or "Data.ByteString.Lazy.Search.KMP"+-- in those cases, the former for medium-length patterns, the latter for+-- long patterns; only 'matchLL' and 'matchSL' suffer from+-- this problem, though).+ -- $complexity -- -- Preprocessing the pattern string is O(@patternLength@).  The search@@ -111,16 +149,15 @@ -- allowing it to go faster than a Knuth-Morris-Pratt algorithm.  With -- a non-periodic pattern the worst case uses O(3\*@targetLength@) -- comparisons.  The periodic pattern worst case is quadratic--- O(@targetLength@\*@patternLength@) complexity.  Improvements--- (e.g. Turbo-Boyer-Moore) to catch and linearize worst case--- performance slow down the loop significantly.---- $performance+-- O(@targetLength@\*@patternLength@) complexity for the original+-- Boyer-Moore algorithm. ----- Operating on a strict target string is faster than a lazy target--- string.  It is unclear why the performance gap is as large as it is--- (patches welcome).  To slightly ameliorate this, if the lazy string--- is a single chunk then a copy of the strict algorithm is used.+-- The searching functions in this module 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@)).  -- $overflow --@@ -129,374 +166,3 @@ -- strict chunk of the target string is greater or equal to -- @'maxBound'::Int@ then this will overflow causing an error.  We try -- to detect this and call 'error' before a segfault occurs.--{-# INLINE matchLL #-}-matchLL :: L.ByteString         -- ^ lazy pattern-        -> L.ByteString         -- ^ lazy target string-        -> [Int64]              -- ^ offsets of matches-matchLL pat = let search = matchSSsd (S.concat (L.toChunks pat))-                in search . L.toChunks--{-# INLINE matchLS #-}-matchLS :: L.ByteString         -- ^ lazy pattern-        -> S.ByteString         -- ^ strict target string-        -> [Int]                -- ^ offsets of matches-matchLS pat = matchSSd (S.concat (L.toChunks pat))--{-# INLINE matchSL #-}-matchSL :: S.ByteString         -- ^ strict pattern-        -> L.ByteString         -- ^ lazy target string-        -> [Int64]              -- ^ offsets of matches-matchSL pat = let search = matchSSsd pat-                in search . L.toChunks--{-# INLINE matchSS #-}-matchSS :: S.ByteString         -- ^ strict pattern-        -> S.ByteString         -- ^ strict target string-        -> [Int]                -- ^ offsets of matches-matchSS pat = matchSSd pat--#ifndef __HADDOCK__-matchSSd :: S.ByteString -> S.ByteString -> [Int]-matchSSd pat | S.null pat = const []-               | otherwise = -  let !patLen = S.length pat-      !patEnd = pred patLen-      !maxStrLen = maxBound - patLen-      !occT   = occurs pat       -- used to compute bad-character shift-      !suffT  = suffShifts pat   -- used to compute good-suffix shift-      !skip   = unsafeAt suffT 0 -- used after each matching position is found-      -- 0 < skip <= patLen--      {-# INLINE patAt #-}-      patAt :: Int -> Word8-      patAt !i = U.unsafeIndex pat i--      searcher str | maxStrLen <= S.length str = error "Overflow error in BoyerMoore.matchSSd"-                   | otherwise =-        let !strLen = S.length str-            !maxDiff = strLen-patLen-            {-# INLINE strAt #-}-            strAt :: Int -> Word8-            strAt !i = U.unsafeIndex str i--            findMatch !diff !patI =-              case strAt (diff+patI) of-                c | c==patAt patI -> if patI == 0-                                       then diff :-                                              let diff' = diff + skip-                                              in if maxDiff < diff'-                                                   then []-                                                   else findMatch diff' patEnd-                                       else findMatch diff (pred patI)-                  | otherwise -> let {-# INLINE badShift #-}-                                     badShift = patI - unsafeAt occT (fromIntegral c)-                                     -- (-patEnd) < badShift <= patLen-                                     {-# INLINE goodShift #-}-                                     goodShift = unsafeAt suffT patI-                                     -- 0 < goodShift <= patLen-                                     diff' = diff + max badShift goodShift-                                 in if maxDiff < diff'-                                      then []-                                      else findMatch diff' patEnd-        in if maxDiff < 0-             then []-             else findMatch 0 patEnd-  in searcher-#endif---- release is used to keep the zipper in matchSSs from remembering--- the leading part of the searched string.  The deep parameter is the--- number of characters that the past needs to hold.  This ensures--- lazy streaming consumption of the searched string.-{-# INLINE release #-}-release :: Int ->  [S.ByteString] -> [S.ByteString]-#ifndef __HADDOCK__-release !deep _ | deep <= 0 = []-release !deep (!x:xs) = let !rest = release (deep-S.length x) xs in x : rest-release _ [] = error "BoyerMoore 'release' could not find enough past of length deep!"-#endif--matchSSsd :: S.ByteString -> [S.ByteString] -> [Int64]-#ifndef __HADDOCK__-matchSSsd pat | S.null pat = const []-               | otherwise =-  let !patLen = S.length pat-      !patEnd = pred patLen-      !occT   = occurs pat       -- used to compute bad-character shift-      !suffT  = suffShifts pat   -- used to compute good-suffix shift-      !skip   = unsafeAt suffT 0 -- used after each matching position is found-      -- 0 < skip <= patLen--      {-# INLINE patAt #-}-      patAt :: Int -> Word8-      patAt !i = U.unsafeIndex pat i--      searcher string =-        let -- seek is used to position the "zipper" of-            -- (past,str,future) to the correct S.ByteString to search-            -- with matcher.  This is done by ensuring 0 <= strPos <-            -- strLen where (strPos == diffPos+patPos). Note that-            -- future is not a strict parameter.  The character being-            -- compared will then be (strAt strPos) and (patAt-            -- patPos).  Splitting this into specialized versions-            -- seems like going too, and is only useful if pat is-            -- close to (or larger than) the chunk size.-            seek :: Int64 -> [S.ByteString] -> S.ByteString -> [S.ByteString] -> Int -> Int -> [Int64]-            seek !prior !past !str future !diffPos !patPos | (diffPos+patPos) < 0 = {-# SCC "seek/past" #-}-              case past of-                [] -> error "seek back too far!"-                (h:t) -> let hLen = S.length h-                         in seek (prior - fromIntegral hLen) t h (str:future) (diffPos + hLen) patPos-                                                           | strLen <= (diffPos+patPos) = {-# SCC "seek/future" #-}-              case future of-                [] -> []-                (h:t) -> let {-# INLINE prior' #-}-                             prior' = prior + fromIntegral strLen-                             !diffPos' = diffPos - strLen-                             {-# INLINE past' #-}-                             past' = release (-diffPos') (str:past)-                         in if maxStrLen <= S.length h-                              then error "Overflow in BoyerMoore.matchSSsd"-                              else seek prior' past' h t diffPos' patPos-                                                          | otherwise = {-# SCC "seek/str" #-}-              -- matcher is the tight loop that walks backwards from the end-              -- of the pattern checking for matching characters.  The upper-              -- bound of strLen is checked only when strI is shifted-              -- upwards to strI'.  The lower bound must be checked.-              let matcher !diff !patI =-                    case strAt (diff+patI) of-                      c | c==patAt patI ->-                            if patI == 0-                              then prior + fromIntegral (diff+patI) :-                                     let !diff' = (diff+patI) + skip -- Assert : diff < diff'-                                     in if maxDiff < diff'-                                          then seek prior past str future diff' patEnd-                                          else if diff' < 0-                                                 then matcher diff' patEnd-                                                 else matcherF diff' patEnd-                              else if (diff+patI) == 0 -- diff < 0 means need to check underflow-                                     then seek prior past str future diff (pred patI) -                                     else matcher diff (pred patI)-                        | otherwise ->-                            let {-# INLINE badShift #-}-                                badShift = patI - unsafeAt occT (fromIntegral c)-                                -- (-patEnd) < badShift <= patLen-                                {-# INLINE goodShift #-}-                                goodShift = unsafeAt suffT patI-                                -- 0 < goodShift <= patLen-                                -- Assert : diff < diff'-                                !diff' = diff + max badShift goodShift-                            in if maxDiff < diff'-                                 then seek prior past str future diff' patEnd-                                 else if diff' < 0-                                        then matcher diff' patEnd-                                        else matcherF diff' patEnd--              -- mathcherF only needs to check overflow since 0<=diff-                  matcherF !diff !patI =-                    case strAt (diff+patI) of-                      c | c==patAt patI ->-                            if patI == 0-                              then prior + fromIntegral (diff+patI) :-                                     let !diff' = (diff+patI) + skip -- Assert : diff < diff'-                                     in if maxDiff < diff'-                                          then seek prior past str future diff' patEnd-                                          else matcherF diff' patEnd-                              else matcherF diff (pred patI) -- 0 <= diff means no need to check underflow-                        | otherwise ->-                            let {-# INLINE badShift #-}-                                badShift = patI - unsafeAt occT (fromIntegral c)-                                -- (-patEnd) < badShift <= patLen-                                {-# INLINE goodShift #-}-                                goodShift = unsafeAt suffT patI-                                -- 0 < goodShift <= patLen-                                -- Assert : diff < diff'-                                !diff' = diff + max badShift goodShift-                            in if maxDiff < diff'-                                 then seek prior past str future diff' patEnd-                                 else matcherF diff' patEnd-              in if diffPos < 0-                   then matcher diffPos patPos-                   else matcherF diffPos patPos--             where !strLen = S.length str-                   !maxDiff = strLen - patLen-                   !maxStrLen = pred ((maxBound::Int) - patLen)-                   {-# INLINE strAt #-}-                   strAt :: Int -> Word8-                   strAt !i = U.unsafeIndex str i-        in case string of-             [] -> []-             [str] -> -- Steal the quick findMatch from matchSSd for this case:-               let findMatch !diff !patI =-                     case strAt (diff+patI) of-                       c | c==patAt patI -> if patI == 0-                                              then fromIntegral diff :-                                                     let diff' = diff + skip-                                                     in if maxDiff < diff'-                                                          then []-                                                          else findMatch diff' patEnd-                                              else findMatch diff (pred patI)-                         | otherwise -> let {-# INLINE badShift #-}-                                            badShift = patI - unsafeAt occT (fromIntegral c)-                                            -- (-patEnd) < badShift <= patLen-                                            {-# INLINE goodShift #-}-                                            goodShift = unsafeAt suffT patI-                                            -- 0 < goodShift <= patLen-                                            diff' = diff + max badShift goodShift-                                        in if maxDiff < diff'-                                             then []-                                             else findMatch diff' patEnd-                   !strLen = S.length str-                   !maxDiff = strLen - patLen-                   !maxStrLen = ((maxBound::Int) - patLen)-                   {-# INLINE strAt #-}-                   strAt :: Int -> Word8-                   strAt !i = U.unsafeIndex str i-               in if maxStrLen <= strLen-                    then error "Overflow in BoyerMoore.matchSSsd"-                    else findMatch 0 patEnd-             (str:future) -> if ((maxBound::Int) - patLen) <= S.length str-                               then error "Overflow in BoyerMoore.matchSSsd"-                               else seek 0 [] str future 0 patEnd-  in searcher-#endif--{- Format of bad character table generated by occurs:--Index is good for Word8 / ASCII searching only.-The last character (at the last index) in pat is ignored.-Excluding that last element, the value is largest index of occurances of that Word8 in the pat.-The default value for Word8's not in the pattern is (-1).--Range of values: -1 <= value < length of pattern---}-{-# INLINE occurs #-}-occurs :: S.ByteString -> UArray Word8 Int-#ifndef __HADDOCK__-occurs !pat | patEnd < 0 = emptyOccurs-            | otherwise  = runSTUArray-    (do ar <- newArray (minBound,maxBound) (-1)-        let loop !i | i == patEnd = return ar-                    | otherwise   = do unsafeWrite ar (fromEnum $ pat `U.unsafeIndex` i) i-                                       loop (succ i)-        loop 0)-  where-    !patEnd = pred (S.length pat)-#endif--emptyOccurs :: UArray Word8 Int-emptyOccurs = accumArray const (-1) (minBound,maxBound) []--{- Non ST variants of occurs--occurs' :: S.ByteString -> UArray Word8 Int-occurs' !pat = accumArray (flip const) (-1) (0,255)-  [ (pat `U.unsafeIndex` i, i) | i <- [0..pred (S.length pat)] ]--occurs'' :: S.ByteString -> UArray Word8 Int-occurs'' !pat = accumArray (flip const) (-1) (minBound,maxBound) $ zip (init $ S.unpack pat) [0..]--}--{--suffLengths uses a ST array to allow for strict querying of previously-filled in values durring the fill loops.--Format for suffLengths array:--Valid index range is the same as for the pat.--The value at index k is used when there is a mismatch at index k in-pat after checking that all indices j where j > k correctly match.--For all indices consider the prefix of pat that ends with the-character at that index.  Now the value of suffLength is the number of-character at the end of this prefix that are identical to the end of-pat.--By the above definition, the last index has the length of the pattern-as its value, since the whole pattern is compared to itself and the-overlap is always the whole pattern length.  And the maximum value at-index k is (k+1).--This value itself is a non-negative integer less than the length of-pat except for the last index, where the value is the length of pat.--For most positions the value will be 0.  Aside from the at the last-index the value can be non-zero only at indices where the last-character of the pat occurs earlier in pat.--}-{-# INLINE suffLengths #-}-suffLengths :: S.ByteString -> UArray Int Int-#ifndef __HADDOCK__-suffLengths !pat | 0==patLen = array (0,-1) []-                 | otherwise = runSTUArray-    (do ar <- newArray_ (0,patEnd)-        unsafeWrite ar patEnd patLen-        let {-# INLINE matchSuffix #-}-            matchSuffix !idx !from = do-                let !d = patEnd - idx-                    helper !i | i < 0 || (pat `U.unsafeIndex` i) /= (pat `U.unsafeIndex` (i+d)) = i-                              | otherwise = helper (pred i)-                    pre' = helper from-                unsafeWrite ar idx (idx-pre')-                idxLoop (pred idx) pre' start-            idxLoop !idx !pre !end-                | idx < 0   = return ar-                | pre < idx = do matching <- unsafeRead ar end  -- try and reuse old result-                                 if pre + matching < idx        -- check if old matching length is too long for current idx-                                   then do unsafeWrite ar idx matching-                                           idxLoop (pred idx) pre (pred end)-                                   else matchSuffix idx pre-                | otherwise = matchSuffix idx idx-        idxLoop start start start) -- the third argument, the initial value of "end", is never used and does not matter.-  where-    !patLen = S.length pat-    !patEnd = pred patLen-    !start  = pred patEnd-#endif--{- Format for suffShifts:--The valid index range is the same as for pat.--The index k is used when there is a mismatch at pat index k and all-indices j where j > k have matched.--The value is the smallest number of characters one can advance the-pattern such that there the shifted pattern agrees at the already-checked positions j>k.--Thus the value range is : 0 < value <= length of pattern---}-{-# INLINE suffShifts #-}-suffShifts :: S.ByteString -> UArray Int Int-#ifndef __HADDOCK__-suffShifts !pat | patLen == 0 = array (0,-1) []-                | otherwise = runSTUArray-    (do ar <- newArray (0,patEnd) patLen-        let preShift !idx !j -- idx counts down and j starts at 0 and is non-decreasing-                | idx < 0   = return ()-                | suff `unsafeAt` idx == idx+1  =-              do let !shf = patEnd - idx-                     fill_to_shf !i | i==shf = return ()-                                    | otherwise = do unsafeWrite ar i shf-                                                     fill_to_shf (succ i)-                 fill_to_shf j-                 preShift (pred idx) shf-                | otherwise = preShift (pred idx) j-            sufShift !idx-                | idx == patEnd = return ar-                | otherwise = do unsafeWrite ar (patEnd - (suff `unsafeAt` idx)) (patEnd - idx)-                                 sufShift (succ idx)-        preShift start 0-        sufShift 0)-      where-        !patLen = S.length pat-        !patEnd = pred patLen-        !start = pred patEnd-        !suff = suffLengths pat-#endif
+ Data/ByteString/Search/DFA.hs view
@@ -0,0 +1,322 @@+{-# LANGUAGE BangPatterns #-}+-- |+-- Module         : Data.ByteString.Search.DFA+-- Copyright      : Daniel Fischer+-- Licence        : BSD3+-- Maintainer     : Daniel Fischer <daniel.is.fischer@web.de>+-- Stability      : Provisional+-- Portability    : non-portable (BangPatterns)+--+-- Fast search of strict 'S.ByteString' values. Breaking, splitting and+-- replacing using a deterministic finite automaton.++module Data.ByteString.Search.DFA ( -- * Overview+                                    -- $overview++                                    -- ** Complexity and performance+                                    -- $complexity++                                    -- ** Partial application+                                    -- $partial++                                    -- * Finding substrings+                                    indices+                                  , nonOverlappingIndices+                                    -- * Breaking on substrings+                                  , breakOn+                                  , breakAfter+                                    -- * Replacing+                                  , replace+                                    -- * Splitting+                                  , split+                                  , splitKeepEnd+                                  , splitKeepFront+                                  ) where++import Data.ByteString.Search.Internal.Utils (automaton)+import Data.ByteString.Search.Substitution++import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Internal as LI+import Data.ByteString.Unsafe (unsafeIndex)++import Data.Array.Base (unsafeAt)+--import Data.Array.Unboxed++import Data.Bits++-- $overview+--+-- This module provides functions related to searching a substring within+-- a string. The searching algorithm uses a deterministic finite automaton+-- based on the Knuth-Morris-Pratt algorithm.+-- The automaton is implemented as an array of @(patternLength + 1) * &#963;@+-- state transitions, where &#963; is the alphabet size (256), so it is+-- only suitable for short enough patterns.+--+-- When searching a pattern in a UTF-8-encoded 'S.ByteString', be aware that+-- these functions work on bytes, not characters, so the indices are+-- byte-offsets, not character offsets.++-- $complexity+--+-- The time and space complexity of the preprocessing phase is+-- /O/(@patternLength * &#963;@).+-- The searching phase is /O/(@targetLength@), each target character is+-- inspected only once.+--+-- In general the functions in this module are slightly faster than the+-- corresponding functions using the Knuth-Morris-Pratt algorithm but+-- considerably slower than the Boyer-Moore functions. For very short+-- patterns or, in the case of 'indices', patterns with a short period+-- which occur often, however, times are close to or even below the+-- Boyer-Moore times.++-- $partial+--+-- All functions can usefully be partially applied. Given only a pattern,+-- the automaton is constructed only once, allowing efficient re-use.++------------------------------------------------------------------------------+--                            Exported Functions                            --+------------------------------------------------------------------------------++-- | @indices@ finds the starting indices of all possibly overlapping+--   occurrences of the pattern in the target string.+--   If the pattern is empty, the result is @[0 .. 'length' target]@.+{-# INLINE indices #-}+indices :: S.ByteString     -- ^ Pattern to find+        -> S.ByteString     -- ^ String to search+        -> [Int]            -- ^ Offsets of matches+indices = strictSearcher True++-- | @nonOverlappingIndices@ finds the starting indices of all+--   non-overlapping occurrences of the pattern in the target string.+--   It is more efficient than removing indices from the list produced+--   by 'indices'.+{-# INLINE nonOverlappingIndices #-}+nonOverlappingIndices :: S.ByteString   -- ^ Pattern to find+                      -> S.ByteString   -- ^ String to search+                      -> [Int]          -- ^ Offsets of matches+nonOverlappingIndices = strictSearcher False++-- | @breakOn pattern target@ splits @target@ at the first occurrence+--   of @pattern@. If the pattern does not occur in the target, the+--   second component of the result is empty, otherwise it starts with+--   @pattern@. If the pattern is empty, the first component is empty.+--+-- @+--   'uncurry' 'S.append' . 'breakOn' pattern = 'id'+-- @+breakOn :: S.ByteString  -- ^ String to search for+        -> S.ByteString  -- ^ String to search in+        -> (S.ByteString, S.ByteString)+                         -- ^ Head and tail of string broken at substring+breakOn pat = breaker+  where+    searcher = strictSearcher False pat+    breaker str = case searcher str of+                    []      -> (str, S.empty)+                    (i:_)   -> S.splitAt i str++-- | @breakAfter pattern target@ splits @target@ behind the first occurrence+--   of @pattern@. An empty second component means that either the pattern+--   does not occur in the target or the first occurrence of pattern is at+--   the very end of target. To discriminate between those cases, use e.g.+--   'S.isSuffixOf'.+--+-- @+--   'uncurry' 'S.append' . 'breakAfter' pattern = 'id'+-- @+breakAfter :: S.ByteString  -- ^ String to search for+           -> S.ByteString  -- ^ String to search in+           -> (S.ByteString, S.ByteString)+                            -- ^ Head and tail of string broken after substring+breakAfter pat = breaker+  where+    !patLen = S.length pat+    searcher = strictSearcher False pat+    breaker str = case searcher str of+                    []      -> (str, S.empty)+                    (i:_)   -> S.splitAt (i + patLen) str+++-- | @replace pat sub text@ replaces all (non-overlapping) occurrences of+--   @pat@ in @text@ with @sub@. If occurrences of @pat@ overlap, the first+--   occurrence that does not overlap with a replaced previous occurrence+--   is substituted. Occurrences of @pat@ arising from a substitution+--   will not be substituted. For example:+--+-- @+--   'replace' \"ana\" \"olog\" \"banana\" = \"bologna\"+--   'replace' \"ana\" \"o\" \"bananana\" = \"bono\"+--   'replace' \"aab\" \"abaa\" \"aaab\" = \"abaaab\"+-- @+--+--   The result is a /lazy/ 'L.ByteString',+--   which is lazily produced, without copying.+--   Equality of pattern and substitution is not checked, but+--+-- @+--   'S.concat' . 'L.toChunks' $ 'replace' pat pat text == text+-- @+--+--   holds. If the pattern is empty but not the substitution, the result+--   is equivalent to (were they 'String's) @'cycle' sub@.+--+--   For non-empty @pat@ and @sub@ a strict 'S.ByteString',+--+-- @+--   'L.fromChunks' . 'Data.List.intersperse' sub . 'split' pat = 'replace' pat sub+-- @+--+--   and analogous relations hold for other types of @sub@.+replace :: Substitution rep+        => S.ByteString     -- ^ Substring to replace+        -> rep              -- ^ Replacement string+        -> S.ByteString     -- ^ String to modify+        -> L.ByteString     -- ^ Lazy result+replace pat+  | S.null pat = \sub -> prependCycle sub . flip LI.chunk LI.Empty+  | otherwise =+    let !patLen = S.length pat+        searcher = strictSearcher False pat+        repl sub =+          let {-# NOINLINE subst #-}+              !subst = substitution sub+              replacer str+                | S.null str    = []+                | otherwise     =+                  case searcher str of+                    []              -> [str]+                    (i:_)+                        | i == 0    -> subst $ replacer (S.drop patLen str)+                        | otherwise -> S.take i str : subst+                                        (replacer (S.drop (i + patLen) str))+          in replacer+    in \sub -> L.fromChunks . repl sub++-- | @split pattern target@ splits @target@ at each (non-overlapping)+--   occurrence of @pattern@, removing @pattern@. If @pattern@ is empty,+--   the result is an infinite list of empty 'S.ByteString's, if @target@+--   is empty but not @pattern@, the result is an empty list, otherwise+--   the following relations hold:+--+-- @+--   'S.concat' . 'Data.List.intersperse' pat . 'split' pat = 'id',+--   'length' ('split' pattern target) ==+--               'length' ('nonOverlappingIndices' pattern target) + 1,+-- @+--+--   no fragment in the result contains an occurrence of @pattern@.+split :: S.ByteString   -- ^ Pattern to split on+      -> S.ByteString   -- ^ String to split+      -> [S.ByteString] -- ^ Fragments of string+split pat+  | S.null pat  = const (repeat S.empty)+split pat = splitter+  where+    !patLen = S.length pat+    searcher = strictSearcher False pat+    splitter str+      | S.null str = []+      | otherwise  = splitter' str+    splitter' str+      | S.null str = [S.empty]+      | otherwise  =+        case searcher str of+          []    -> [str]+          (i:_) -> S.take i str : splitter' (S.drop (i + patLen) str)++-- | @splitKeepEnd pattern target@ splits @target@ after each (non-overlapping)+--   occurrence of @pattern@. If @pattern@ is empty, the result is an+--   infinite list of empty 'S.ByteString's, otherwise the following+--   relations hold:+--+-- @+--   'S.concat' . 'splitKeepEnd' pattern = 'id',+-- @+--+--   all fragments in the result except possibly the last end with+--   @pattern@, no fragment contains more than one occurrence of @pattern@.+splitKeepEnd :: S.ByteString    -- ^ Pattern to split on+             -> S.ByteString    -- ^ String to split+             -> [S.ByteString]  -- ^ Fragments of string+splitKeepEnd pat+  | S.null pat = const (repeat S.empty)+splitKeepEnd pat = splitter+  where+    !patLen = S.length pat+    searcher = strictSearcher False pat+    splitter str+      | S.null str  = []+      | otherwise   =+        case searcher str of+          []    -> [str]+          (i:_) -> S.take (i + patLen) str :+                        splitter (S.drop (i + patLen) str)++-- | @splitKeepFront@ is like 'splitKeepEnd', except that @target@ is split+--   before each occurrence of @pattern@ and hence all fragments+--   with the possible exception of the first begin with @pattern@.+splitKeepFront :: S.ByteString    -- ^ Pattern to split on+               -> S.ByteString    -- ^ String to split+               -> [S.ByteString]  -- ^ Fragments of string+splitKeepFront pat+  | S.null pat  = const (repeat S.empty)+splitKeepFront pat = splitter+  where+    !patLen = S.length pat+    searcher = strictSearcher False pat+    splitter str+      | S.null str  = []+      | otherwise   =+        case searcher str of+          []            -> [str]+          (i:rst)+            | i == 0    -> case rst of+                             []     -> [str]+                             (j:_)  -> S.take j str : splitter' (S.drop j str)+            | otherwise -> S.take i str : splitter' (S.drop i str)+    splitter' str+      | S.null str  = []+      | otherwise   =+        case searcher (S.drop patLen str) of+          []    -> [str]+          (i:_) -> S.take (i + patLen) str :+                        splitter' (S.drop (i + patLen) str)++------------------------------------------------------------------------------+--                            Searching Function                            --+------------------------------------------------------------------------------++strictSearcher :: Bool -> S.ByteString -> S.ByteString -> [Int]+strictSearcher _ !pat+    | S.null pat = enumFromTo 0 . S.length+    | S.length pat == 1 = let !w = S.head pat in S.elemIndices w+strictSearcher !overlap pat = search+  where+    !patLen = S.length pat+    !auto   = automaton pat+    !p0     = unsafeIndex pat 0+    !ams    = if overlap then patLen else 0+    search str = match 0 0+      where+        !strLen = S.length str+        {-# INLINE strAt #-}+        strAt :: Int -> Int+        strAt !i = fromIntegral (unsafeIndex str i)+        match 0 idx+          | idx == strLen               = []+          | unsafeIndex str idx == p0   = match 1 (idx + 1)+          | otherwise                   = match 0 (idx + 1)+        match state idx+          | idx == strLen   = []+          | otherwise       =+            let !nstate = unsafeAt auto ((state `shiftL` 8) + strAt idx)+                !nxtIdx = idx + 1+            in if nstate == patLen+                then (nxtIdx - patLen) : match ams nxtIdx+                else match nstate nxtIdx+
+ Data/ByteString/Search/Internal/BoyerMoore.hs view
@@ -0,0 +1,1368 @@+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_HADDOCK hide, prune #-}+-- |+-- Module         : Data.ByteString.Search.Internal.BoyerMoore+-- Copyright      : Daniel Fischer+--                  Chris Kuklewicz+-- Licence        : BSD3+-- Maintainer     : Daniel Fischer <daniel.is.fischer@web.de>+-- 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 web.de) and+-- Chris Kuklewicz (haskell at list.mightyreason.com).++module Data.ByteString.Search.Internal.BoyerMoore (+                                           matchLL+                                         , matchLS+                                         , matchSL+                                         , matchSS++                                           --  Non-overlapping+                                         , matchNOL+                                         , matchNOS++                                            --  Replacing substrings+                                            -- replacing+                                         , replaceAllS+                                         , replaceAllL+                                            --  Breaking on substrings+                                            -- breaking+                                         , breakSubstringS+                                         , breakAfterS+                                         , breakSubstringL+                                         , breakAfterL+                                         , breakFindAfterL+                                            --  Splitting on substrings+                                            -- splitting+                                         , splitKeepEndS+                                         , splitKeepFrontS+                                         , splitDropS+                                         , splitKeepEndL+                                         , splitKeepFrontL+                                         , splitDropL+                                         ) where+++import Data.ByteString.Search.Internal.Utils+                (ldrop, lsplit, keep, release, strictify)+import Data.ByteString.Search.Substitution++import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Internal as LI+import Data.ByteString.Unsafe (unsafeIndex)++import Data.Array.Base (unsafeRead, unsafeWrite, unsafeAt)+import Data.Array.ST+import Data.Array.Unboxed++import Data.Word (Word8)+import Data.Int (Int64)++-- overview+--+-- This module exports four search functions, one for each combination of+-- strict and lazy ByteStrings as pattern and target. The common base name+-- is @match@, the two-letter suffix indicates the types of the pattern+-- (first letter of the suffix) and target (second letter). 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)++-- | @matchLS@ finds the starting indices of all possibly overlapping+--   occurrences of the pattern in the target string.+--   It is a simple wrapper for 'Data.ByteString.Search.indices'.+--   If the pattern is empty, the result is @[0 .. 'length' target]@.+{-# INLINE matchLS #-}+matchLS :: L.ByteString     -- ^ Lazy pattern+        -> S.ByteString     -- ^ Strict target string+        -> [Int]            -- ^ Offsets of matches+matchLS pat = search+  where+    search = strictSearcher 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++-- | @matchSS@ finds the starting indices of all possibly overlapping+--   occurrences of the pattern in the target string.+--   It is an alias for 'Data.ByteString.Search.indices'.+--   If the pattern is empty, the result is @[0 .. 'length' target]@.+{-# INLINE matchSS #-}+matchSS :: S.ByteString     -- ^ Strict pattern+        -> S.ByteString     -- ^ Strict target string+        -> [Int]            -- ^ Offsets of matches+matchSS pat = search+  where+    search = strictSearcher 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++-- | matchNOS finds the indices of all non-overlapping occurrences+--   of the pattern in the Strict target string.+{-# INLINE matchNOS #-}+matchNOS :: S.ByteString    -- ^ Strict pattern+         -> S.ByteString    -- ^ Strict target string+         -> [Int]           -- ^ Offsets of matches+matchNOS pat = search+  where+    search = strictSearcher 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 replaceAllS #-}+replaceAllS :: Substitution rep+            => S.ByteString  -- ^ Pattern to replace+            -> rep           -- ^ Substitution string+            -> S.ByteString  -- ^ Target string+            -> L.ByteString  -- ^ Lazy result+replaceAllS pat+    | S.null pat = \sub -> prependCycle sub . flip LI.chunk LI.Empty+    | otherwise =+      let repl = strictRepl pat+      in \sub -> L.fromChunks . repl (substitution 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 =+                let (pre, mtch) = breaker strs+                in 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)++-- | This function has the same semantics as 'S.breakSubstring'+--   but is generally much faster.+{-# INLINE breakSubstringS #-}+breakSubstringS :: S.ByteString  -- ^ Pattern to break on+                -> S.ByteString  -- ^ String to break up+                -> (S.ByteString, S.ByteString)+                    -- ^ Prefix and remainder of broken string+breakSubstringS = strictBreak++breakAfterS :: S.ByteString+            -> S.ByteString+            -> (S.ByteString, S.ByteString)+breakAfterS pat+  | S.null pat = \str -> (S.empty, str)+breakAfterS pat = breaker+  where+    !patLen  = S.length pat+    searcher = strictSearcher False pat+    breaker str = case searcher str of+                    []    -> (str, S.empty)+                    (i:_) -> S.splitAt (i + patLen) str++-- | 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 splitKeepEndS #-}+splitKeepEndS :: S.ByteString    -- ^ Pattern to split on+              -> S.ByteString    -- ^ String to split+              -> [S.ByteString]  -- ^ List of fragments+splitKeepEndS = strictSplitKeepEnd++{-# INLINE splitKeepFrontS #-}+splitKeepFrontS :: S.ByteString    -- ^ Pattern to split on+                -> S.ByteString    -- ^ String to split+                -> [S.ByteString]  -- ^ List of fragments+splitKeepFrontS = strictSplitKeepFront++{-# INLINE splitDropS #-}+splitDropS :: S.ByteString    -- ^ Pattern to split on+           -> S.ByteString    -- ^ String to split+           -> [S.ByteString]  -- ^ List of fragments+splitDropS = strictSplitDrop++{-# 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                             --+------------------------------------------------------------------------------++strictSearcher :: Bool -> S.ByteString -> S.ByteString -> [Int]+strictSearcher _ !pat+    | S.null pat = enumFromTo 0 . S.length+    | S.length pat == 1 = let !w = S.head pat in S.elemIndices w+strictSearcher !overlap pat = searcher+  where+    {-# INLINE patAt #-}+    patAt :: Int -> Word8+    patAt !i = unsafeIndex pat i++    !patLen = S.length pat+    !patEnd = patLen - 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 str+        | maxLen < strLen+            = error "Overflow in BoyerMoore.strictSearcher"+        | maxDiff < 0   = []+        | otherwise     = checkEnd patEnd+          where+            !strLen  = S.length str+            !strEnd  = strLen - 1+            !maxDiff = strLen - patLen++            {-# INLINE strAt #-}+            strAt !i = unsafeIndex str i++            -- 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.+            afterMatch !diff !patI =+              case strAt (diff + patI) of+                !c  | c == patAt patI ->+                      if patI == kept+                        then diff : let !diff' = diff + skip+                                    in if maxDiff < diff'+                                        then []+                                        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 []+                                else checkEnd (diff + patEnd)++            -- 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   = []+                | otherwise     =+                  case strAt sI of+                    !c  | c == pe   -> findMatch (sI - patEnd) (patEnd - 1)+                        | 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.+            findMatch !diff !patI =+                case strAt (diff + patI) of+                    !c  | c == patAt patI ->+                            if patI == 0    -- full match, report+                                then diff : let !diff' = diff + skip+                                            in if maxDiff < diff'+                                                then []+                                                else+                                                  if skip == patLen+                                                    then+                                                      checkEnd (diff' + patEnd)+                                                    else+                                                      afterMatch diff' patEnd+                                else findMatch diff (patI - 1)+                        | otherwise       ->+                            let !diff' = diff + max (patI + occ c) (suff patI)+                            in if maxDiff < diff'+                                then []+                                else checkEnd (diff' + patEnd)+++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                            --+------------------------------------------------------------------------------++strictBreak :: S.ByteString -> S.ByteString -> (S.ByteString, S.ByteString)+strictBreak pat+    | S.null pat    = \str -> (S.empty, str)+    | otherwise     = breaker+      where+        searcher = strictSearcher False pat+        breaker str = case searcher str of+                        []      -> (str, S.empty)+                        (i:_)   -> S.splitAt i str+++-- 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                           --+------------------------------------------------------------------------------++strictSplitKeepFront :: S.ByteString -> S.ByteString -> [S.ByteString]+strictSplitKeepFront pat+  | S.null pat  = const (repeat S.empty)+strictSplitKeepFront pat = splitter+  where+    !patLen = S.length pat+    searcher = strictSearcher False pat+    splitter str+        | S.null str    = []+        | otherwise     =+          case searcher str of+            []            -> [str]+            (i:_)+              | i == 0    -> psplitter str+              | otherwise -> S.take i str : psplitter (S.drop i str)+    psplitter !str+        | S.null str    = []+        | otherwise     =+          case searcher (S.drop patLen str) of+            []      -> [str]+            (i:_)   -> S.take (i + patLen) str :+                        psplitter (S.drop (i + patLen) str)++strictSplitKeepEnd :: S.ByteString -> S.ByteString -> [S.ByteString]+strictSplitKeepEnd pat+  | S.null pat  = const (repeat S.empty)+strictSplitKeepEnd pat = splitter+  where+    !patLen = S.length pat+    searcher = strictSearcher False pat+    splitter str+        | S.null str    = []+        | otherwise     =+          case searcher str of+            [] -> [str]+            (i:_) -> S.take (i + patLen) str :+                        splitter (S.drop (i + patLen) str)++strictSplitDrop :: S.ByteString -> S.ByteString -> [S.ByteString]+strictSplitDrop pat+    | S.null pat    = const (repeat S.empty)+strictSplitDrop pat = splitter'+  where+    !patLen = S.length pat+    searcher = strictSearcher False pat+    splitter' str+        | S.null str    = []+        | otherwise     = splitter str+    splitter str+        | S.null str    = [S.empty]+        | otherwise     =+          case searcher str of+            []            -> [str]+            (i:_) -> S.take i str : splitter (S.drop (i + patLen) str)++-- 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 =+        let (pre, mtch) = breaker strs+        in 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 =+        let (pre, mtch) = breaker strs+            (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 = let (pre, mtch) = breaker strs+                     in pre : case mtch of+                                [] -> []+                                _  -> splitter' (ldrop patLen mtch)++------------------------------------------------------------------------------+--                            Replacing Functions                           --+------------------------------------------------------------------------------++-- replacing loop for strict ByteStrings, called only for+-- non-empty patterns and substitutions+strictRepl :: S.ByteString -> ([S.ByteString] -> [S.ByteString])+            -> S.ByteString -> [S.ByteString]+strictRepl pat  = repl+  where+    !patLen = S.length pat+    searcher = strictSearcher False pat+    repl sub = replacer+      where+        replacer str+          | S.null str    = []+          | otherwise     =+            case searcher str of+              []            -> [str]+              (i:_)+                | i == 0    -> sub $ replacer (S.drop patLen str)+                | otherwise ->+                  S.take i str : sub (replacer (S.drop (i + patLen) str))++{-++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.+--+-- 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)++------------------------------------------------------------------------------+--                              Preprocessing                               --+------------------------------------------------------------------------------++{- Table of last occurrences of bytes in the pattern.++For each byte we record the (negated) position of its last+occurrence in the pattern except at the last position.++Thus, if byte b gives a mismatch at pattern position patPos,+we know that we can shift the window right by at least++patPos - (last occurrence of b in init pat)++or, since we negated the positions,++patPos + (occurs pat)++If the byte doesn't occur in the pattern, we can shift the window+so that the start of the pattern is aligned with the byte after this,+hence the default value of 1.++Complexity: O(patLen + size of alphabet)++-}+{- Precondition: non-empty pattern++This invariant is guaranteed by not exporting occurs,+inside this module, we don't call it for empty patterns.++-}+{-# INLINE occurs #-}+occurs :: S.ByteString -> UArray Int Int+occurs pat = runSTUArray (do+    let !patEnd = S.length pat - 1+        {-# INLINE patAt #-}+        patAt :: Int -> Int+        patAt i = fromIntegral (unsafeIndex pat i)+    ar <- newArray (0, 255) 1+    let loop !i+            | i == patEnd   = return ar+            | otherwise     = do+                unsafeWrite ar (patAt i) (-i)+                loop (i + 1)+    loop 0)++{- Table of suffix-shifts.++When a mismatch occurs at pattern position patPos, assumed to be not the+last position in the pattern, the suffix u of length (patEnd - patPos)+has been successfully matched.+Let c be the byte in the pattern at position patPos.++If the sub-pattern u also occurs in the pattern somewhere *not* preceded+by c, let uPos be the position of the last byte in u for the last of+all such occurrences. Then there can be no match if the window is shifted+less than (patEnd - uPos) places, because either the part of the string+which matched the suffix u is not aligned with an occurrence of u in the+pattern, or it is aligned with an occurrence of u which is preceded by+the same byte c as the originally matched suffix.++If the complete sub-pattern u does not occur again in the pattern, or all+of its occurrences are preceded by the byte c, then we can align the+pattern with the string so that a suffix v of u matches a prefix of the+pattern. If v is chosen maximal, no smaller shift can give a match, so+we can shift by at least (patLen - length v).++If a complete match is encountered, we can shift by at least the same+amount as if the first byte of the pattern was a mismatch, no complete+match is possible between these positions.++For non-periodic patterns, only very short suffixes will usually occur+again in the pattern, so if a longer suffix has been matched before a+mismatch, the window can then be shifted entirely past the partial+match, so that part of the string will not be re-compared.+For periodic patterns, the suffix shifts will be shorter in general,+leading to an O(strLen * patLen) worst-case performance.++To compute the suffix-shifts, we use an array containing the lengths of+the longest common suffixes of the entire pattern and its prefix ending+with position pos.++-}+{- Precondition: non-empty pattern -}+{-# INLINE suffShifts #-}+suffShifts :: S.ByteString -> UArray Int Int+suffShifts pat = runSTUArray (do+    let !patLen = S.length pat+        !patEnd = patLen - 1+        !suff   = suffLengths pat+    ar <- newArray (0,patEnd) patLen+    let preShift !idx !j+            | idx < 0   = return ()+            | suff `unsafeAt` idx == idx + 1 = do+                let !shf = patEnd - idx+                    fillToShf !i+                        | i == shf  = return ()+                        | otherwise = do+                            unsafeWrite ar i shf+                            fillToShf (i + 1)+                fillToShf j+                preShift (idx - 1) shf+            | otherwise = preShift (idx - 1) j+        sufShift !idx+            | idx == patEnd = return ar+            | otherwise     = do+                unsafeWrite ar (patEnd - unsafeAt suff idx) (patEnd - idx)+                sufShift (idx + 1)+    preShift (patEnd - 1) 0+    sufShift 0)++{- Table of suffix-lengths.++The value of this array at place i is the length of the longest common+suffix of the entire pattern and the prefix of the pattern ending at+position i.++Usually, most of the entries will be 0. Only if the byte at position i+is the same as the last byte of the pattern can the value be positive.+In any case the value at index patEnd is patLen (since the pattern is+identical to itself) and 0 <= value at i <= (i + 1).++To keep this part of preprocessing linear in the length of the pattern,+the implementation must be non-obvious (the obvious algorithm for this+is quadratic).++When the index under consideration is inside a previously identified+common suffix, we align that suffix with the end of the pattern and+check whether the suffix ending at the position corresponding to idx+is shorter than the part of the suffix up to idx. If that is the case,+the length of the suffix ending at idx is that of the suffix at the+corresponding position. Otherwise extend the suffix as far as possible.+If the index under consideration is not inside a previously identified+common suffix, compare with the last byte of the pattern. If that gives+a suffix of length > 1, for the next index we're in the previous+situation, otherwise we're back in the same situation for the next+index.++-}+{- Precondition: non-empty pattern -}+{-# INLINE suffLengths #-}+suffLengths :: S.ByteString -> UArray Int Int+suffLengths pat = runSTUArray (do+    let !patLen = S.length pat+        !patEnd = patLen - 1+        !preEnd = patEnd - 1+        {-# INLINE patAt #-}+        patAt i = unsafeIndex pat i+        -- last byte for comparisons+        !pe     = patAt patEnd+        -- find index preceding the longest suffix+        dec !diff !j+            | j < 0 || patAt j /= patAt (j + diff) = j+            | otherwise = dec diff (j - 1)+    ar <- newArray_ (0, patEnd)+    unsafeWrite ar patEnd patLen+    let noSuff !i+            | i < 0     = return ar+            | patAt i == pe = do+                let !diff  = patEnd - i+                    !nextI = i - 1+                    !prevI = dec diff nextI+                if prevI == nextI+                    then unsafeWrite ar i 1 >> noSuff nextI+                    else do unsafeWrite ar i (i - prevI)+                            suffLoop prevI preEnd nextI+            | otherwise = do+                unsafeWrite ar i 0+                noSuff (i - 1)+        suffLoop !pre !end !idx+            | idx < 0   = return ar+            | pre < idx =+              if patAt idx /= pe+                then unsafeWrite ar idx 0 >> suffLoop pre (end - 1) (idx - 1)+                else do+                    prevS <- unsafeRead ar end+                    if pre + prevS < idx+                        then do unsafeWrite ar idx prevS+                                suffLoop pre (end - 1) (idx - 1)+                        else do let !prI = dec (patEnd - idx) pre+                                unsafeWrite ar idx (idx - prI)+                                suffLoop prI preEnd (idx - 1)+            | otherwise = noSuff idx+    noSuff preEnd)
+ Data/ByteString/Search/Internal/KnuthMorrisPratt.hs view
@@ -0,0 +1,227 @@+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_HADDOCK hide, prune #-}+-- |+-- Module         : Data.ByteString.Search.Internal.KnuthMorrisPratt+-- Copyright      : Justin Bailey+--                  Chris Kuklewicz+--                  Daniel Fischer+-- Licence        : BSD3+-- Maintainer     : Daniel Fischer <daniel.is.fischer@web.de>+-- Stability      : Provisional+-- Portability    : non-portable (BangPatterns)+--+-- Fast Knuth-Morris-Pratt search of both strict and+-- lazy 'S.ByteString' values.+--+-- A description of the algorithm can be found at+-- <http://en.wikipedia.org/wiki/Knuth-Morris-Pratt_algorithm>.++-- Original authors: Justin Bailey (jgbailey at gmail.com) and+-- Chris Kuklewicz (haskell at list.mightyreason.com).++module Data.ByteString.Search.Internal.KnuthMorrisPratt ( -- * Overview+                                                          -- $overview++                                                          -- * Partial application+                                                          -- $partial++                                                          -- * Complexity and Performance+                                                          -- $complexity++                                                          -- * Finding substrings+                                                          -- ** Overlapping+                                                            indicesL+                                                          , indicesS+                                                          -- ** Non-overlapping+                                                          , 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.Array.Unboxed++import Data.Int (Int64)++-- $overview+--+-- This module exports 6 search functions: 'matchLL', 'matchLS',+-- 'matchSL', and 'matchSS', which find the indices of all non-overlapping+-- occurrences of a pattern in a target string, and the newly added+-- 'indicesL' and 'indicesS' which find the indices of+-- all (possibly overlapping) occurrences of the pattern in the target+-- string. The performance should be the same when the pattern can't+-- overlap, but when the pattern occurs often and can have significant+-- overlap, the search excluding the overlap is faster.+--+-- In all cases, the list of indices is produced lazily.+--+-- The behaviour of the old @matchXY@ functions for an empty pattern has+-- changed, formerly they returned an empty list, now all functions+-- return @[0 .. 'length' target]@ for an empty pattern.+--+-- The return type of the @matchXS@ functions changed to @['Int']@, since+-- strict ByteStrings are @'Int'@-indexed.+--+-- The trailing @L\/S@ in the function names indicate whether they work+-- on lazy or strict ByteStrings. Since all patterns are converted to+-- strict ByteStrings for performance reasons, the @matchLX@ add just+-- an additional bit of wrapping around the worker in comparison to+-- @matchSX@. For the new functions, no such wrapping is provided, you+-- have to 'strictify' lazy patterns before feeding them to the searcher.+-- The limit on the pattern lengths that the conversion to a strict+-- ByteString imposes should be irrelevant in practice.+--+-- The functions searching in lazy ByteStrings don't keep any references+-- to chunks already traversed. This means the garbage collector can free+-- those chunks early and only a small part of the target string needs to+-- be in memory.++-- $partial+--+-- These functions can all be usefully partially applied. Given only a+-- pattern, the auxiliary data will be computed only once, allowing for+-- efficient re-use.++-- $complexity+--+-- The preprocessing of the pattern is /O/(@patternLength@) in time and space.+-- The time complexity of the searching phase is /O/(@targetLength@) for all+-- functions.+--+-- In most cases, these functions are considerably slower than the+-- Boyer-Moore variants, performance is close to that of those from+-- "Data.ByteString.Search.DFA" resp. "Data.ByteString.Lazy.Search.DFA".++------------------------------------------------------------------------------+--                                 Wrappers                                 --+------------------------------------------------------------------------------++-- | @indicesL@ finds all indices of (possibly overlapping)+--   occurrences of the pattern in the target string.+{-# INLINE indicesL #-}+indicesL :: S.ByteString     -- ^ Strict pattern+         -> L.ByteString     -- ^ Lazy target string+         -> [Int64]          -- ^ Offsets of matches+indicesL pat = search . L.toChunks+  where+    search = matcher True pat++-- | @indicesS@ finds all indices of (possibly overlapping)+--   occurrences of the pattern in the target string.+{-# INLINE indicesS #-}+indicesS :: S.ByteString     -- ^ Strict pattern+         -> S.ByteString     -- ^ Strict target string+         -> [Int]            -- ^ Offsets of matches+indicesS pat = search . (:[])+  where+    search = matcher True pat++-- | @matchLL@ finds the starting indices of all /non-overlapping/ occurrences+--   of the pattern in the target string. It is a simple wrapper around+--   'Data.ByteString.Lazy.Search.KMP.nonOverlappingIndices' strictifying+--   the pattern.+{-# INLINE matchLL #-}+matchLL :: L.ByteString           -- ^ Lazy pattern+        -> L.ByteString           -- ^ Lazy target string+        -> [Int64]                -- ^ Offsets of matches+matchLL pat = search . L.toChunks+  where+    !spat = strictify pat+    search = matcher False spat++-- | @matchLS@ finds the starting indices of all /non-overlapping/ occurrences+--   of the pattern in the target string. It is a simple wrapper around+--   'Data.ByteString.Search.KMP.nonOverlappingIndices' strictifying+--   the pattern.+{-# INLINE matchLS #-}+matchLS :: L.ByteString         -- ^ Lazy pattern+        -> S.ByteString         -- ^ Strict target string+        -> [Int]                -- ^ Offsets of matches+matchLS pat = search . (:[])+  where+    !spat = strictify pat+    search = matcher False spat++-- | @matchSS@ finds the starting indices of all /non-overlapping/ occurrences+--   of the pattern in the target string. It is an alias for+--   'Data.ByteString.Search.KMP.nonOverlappingIndices'.+{-# INLINE matchSS #-}+matchSS :: S.ByteString         -- ^ Strict pattern+        -> S.ByteString         -- ^ Strict target string+        -> [Int]                -- ^ Offsets of matches+matchSS pat = search . (:[])+  where+    search = matcher False pat++-- | @matchSL@ finds the starting indices of all /non-overlapping/ occurrences+--   of the pattern in the target string. It is an alias for+--   'Data.ByteString.Lazy.Search.KMP.nonOverlappingIndices'.+{-# INLINE matchSL #-}+matchSL :: S.ByteString         -- ^ Strict pattern+        -> L.ByteString         -- ^ Lazy target string+        -> [Int64]              -- ^ Offsets of matches+matchSL pat = search . L.toChunks+  where+    search = matcher False pat+++------------------------------------------------------------------------------+--                                  Worker                                  --+------------------------------------------------------------------------------++{-# SPECIALISE matcher :: Bool -> S.ByteString -> [S.ByteString] -> [Int],+                          Bool -> S.ByteString -> [S.ByteString] -> [Int64] #-}+matcher :: Integral a => Bool -> S.ByteString -> [S.ByteString] -> [a]+matcher _ !pat+  | S.null pat =  (0 :) . go 0+    where+      go _ [] = []+      go !prior (!str : rest) = [prior + fromIntegral i | i <- [1 .. l]]+                                  ++ go prior' rest+        where+          !l = S.length str+          !prior' = prior + fromIntegral l+matcher !overlap pat = searcher 0 0+  where+    !patLen = S.length pat+    !bords  = kmpBorders pat+    !patH   = patAt 0+    {-# INLINE misi #-}+    misi !i = unsafeAt bords i+    {-# INLINE patAt #-}+    patAt !i = unsafeIndex pat i+    !ami    = if overlap then misi patLen else 0+    searcher _ _ [] = []+    searcher !prior !patPos (!str : rest)+      | patPos == 0 = checkHead 0+      | otherwise = findMatch patPos 0+      where+        !strLen = S.length str+        {-# INLINE strAt #-}+        strAt !i = unsafeIndex str i+        checkHead !strI+            | strI == strLen =+              searcher (prior + fromIntegral strLen) 0 rest+            | strAt strI == patH = findMatch 1 (strI + 1)+            | otherwise = checkHead (strI + 1)+        findMatch !patI !strI+            | patI == patLen =+                (prior + fromIntegral strI - fromIntegral patLen)+                    : if ami == 0 then checkHead strI else findMatch ami strI+            | strI == strLen =+                searcher (prior + fromIntegral strLen) patI rest+            | otherwise      =+                if strAt strI == patAt patI+                    then findMatch (patI + 1) (strI + 1)+                    else case misi patI of+                            0    -> checkHead strI+                            (-1) -> checkHead (strI + 1)+                            pI   -> findMatch pI strI
+ Data/ByteString/Search/Internal/Utils.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_HADDOCK hide, prune #-}+-- |+-- Module         : Data.ByteString.Search.Internal.Utils+-- Copyright      : Daniel Fischer+-- Licence        : BSD3+-- Maintainer     : Daniel Fischer <daniel.is.fischer@web.de>+-- Stability      : Provisional+-- Portabiltity   : non-portable+--+-- Author         : Daniel Fischer+--+-- Utilities for several searching algorithms.++module Data.ByteString.Search.Internal.Utils ( kmpBorders+                                             , automaton+                                             , ldrop+                                             , ltake+                                             , lsplit+                                             , release+                                             , keep+                                             , strictify+                                             ) where++import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import Data.ByteString.Unsafe (unsafeIndex)++import Data.Array.Base (unsafeRead, unsafeWrite, unsafeAt)+import Data.Array.ST+import Data.Array.Unboxed+import Control.Monad (when)++import Data.Bits+import Data.Word (Word8)++------------------------------------------------------------------------------+--                              Preprocessing                               --+------------------------------------------------------------------------------++{-# INLINE automaton #-}+automaton :: S.ByteString -> UArray Int Int+automaton !pat = runSTUArray (do+    let !patLen = S.length pat+        {-# INLINE patAt #-}+        patAt !i = fromIntegral (unsafeIndex pat i)+        !bord = kmpBorders pat+    aut <- newArray (0, (patLen + 1)*256 - 1) 0+    unsafeWrite aut (patAt 0) 1+    let loop !state = do+            let !base = state `shiftL` 8+                inner j+                    | j < 0     = if state == patLen+                                    then return aut+                                    else loop (state+1)+                    | otherwise = do+                        let !i = base + patAt j+                        s <- unsafeRead aut i+                        when (s == 0) (unsafeWrite aut i (j+1))+                        inner (unsafeAt bord j)+            if state == patLen+                then inner (unsafeAt bord state)+                else inner state+    loop 1)++-- kmpBorders calculates the width of the widest borders of the prefixes+-- of the pattern which are not extensible to borders of the next+-- longer prefix. Most entries will be 0.+{-# INLINE kmpBorders #-}+kmpBorders :: S.ByteString -> UArray Int Int+kmpBorders pat = runSTUArray (do+    let !patLen = S.length pat+        {-# INLINE patAt #-}+        patAt :: Int -> Word8+        patAt i = unsafeIndex pat i+    ar <- newArray_ (0, patLen)+    unsafeWrite ar 0 (-1)+    let dec w j+            | j < 0 || w == patAt j = return $! j+1+            | otherwise = unsafeRead ar j >>= dec w+        bordLoop !i !j+            | patLen < i    = return ar+            | otherwise     = do+                let !w = patAt (i-1)+                j' <- dec w j+                if i < patLen && patAt j' == patAt i+                    then unsafeRead ar j' >>= unsafeWrite ar i+                    else unsafeWrite ar i j'+                bordLoop (i+1) j'+    bordLoop 1 (-1))++------------------------------------------------------------------------------+--                             Helper Functions                             --+------------------------------------------------------------------------------++{-# INLINE strictify #-}+strictify :: L.ByteString -> S.ByteString+strictify = S.concat . L.toChunks++-- drop k bytes from a list of strict ByteStrings+{-# INLINE ldrop #-}+ldrop :: Int -> [S.ByteString] -> [S.ByteString]+ldrop _ [] = []+ldrop k (!h : t)+  | k < l     = S.drop k h : t+  | otherwise = ldrop (k - l) t+    where+      !l = S.length h++-- take k bytes from a list of strict ByteStrings+{-# INLINE ltake #-}+ltake :: Int -> [S.ByteString] -> [S.ByteString]+ltake _ [] = []+ltake !k (!h : t)+  | l < k     = h : ltake (k - l) t+  | otherwise = [S.take k h]+    where+      !l = S.length h++-- split a list of strict ByteStrings at byte k+{-# INLINE lsplit #-}+lsplit :: Int -> [S.ByteString] -> ([S.ByteString], [S.ByteString])+lsplit _ [] = ([],[])+lsplit !k (!h : t)+  = case compare k l of+      LT -> ([S.take k h], S.drop k h : t)+      EQ -> ([h], t)+      GT -> let (u, v) = lsplit (k - l) t in (h : u, v)+  where+    !l = S.length h+++-- release is used to keep the zipper in lazySearcher from remembering+-- the leading part of the searched string.  The deep parameter is the+-- number of characters that the past needs to hold.  This ensures+-- lazy streaming consumption of the searched string.+{-# INLINE release #-}+release :: Int ->  [S.ByteString] -> [S.ByteString]+release !deep _+    | deep <= 0 = []+release !deep (!x:xs) = let !rest = release (deep-S.length x) xs in x : rest+release _ [] = error "stringsearch.release could not find enough past!"++-- keep is like release, only we mustn't forget the part of the past+-- we don't need anymore for matching but have to keep it for+-- breaking, splitting and replacing.+-- The names would be more appropriate the other way round, but that's+-- a historical accident, so what?+{-# INLINE keep #-}+keep :: Int -> [S.ByteString] -> ([S.ByteString],[S.ByteString])+keep !deep xs+    | deep < 1    = ([],xs)+keep deep (!x:xs) = let (!p,d) = keep (deep - S.length x) xs in (x:p,d)+keep _ [] = error "Forgot too much"
+ Data/ByteString/Search/KMP.hs view
@@ -0,0 +1,77 @@+-- |+-- Module         : Data.ByteString.Search.KMP+-- Copyright      : Justin Bailey+--                  Chris Kuklewicz+--                  Daniel Fischer+-- Licence        : BSD3+-- Maintainer     : Daniel Fischer <daniel.is.fischer@web.de>+-- Stability      : Provisional+-- Portability    : non-portable (BangPatterns)+--+-- Fast search of strict 'S.ByteString' values using the+-- Knuth-Morris-Pratt algorithm.+--+-- A description of the algorithm can be found at+-- <http://en.wikipedia.org/wiki/Knuth-Morris-Pratt_algorithm>.+--+-- Original authors: Justin Bailey (jgbailey at gmail.com) and+-- Chris Kuklewicz (haskell at list.mightyreason.com).+module Data.ByteString.Search.KMP ( -- * Overview+                                    -- $overview++                                    -- ** Complexity and Performance+                                    -- $complexity++                                    -- ** Partial application+                                    -- $partial++                                    -- * Functions+                                      indices+                                    , nonOverlappingIndices+                                    ) where++import Data.ByteString.Search.Internal.KnuthMorrisPratt (matchSS, indicesS)+import qualified Data.ByteString as S++-- $overview+--+-- This module provides two functions for finding the occurrences of a+-- pattern in a target string using the Knuth-Morris-Pratt algorithm.+-- It exists only for systematic reasons, the functions from+-- "Data.ByteString.Search" are much faster, except for very short patterns,+-- in which case "Data.ByteString.Search.DFA" provides better functions.++-- $complexity+--+-- The preprocessing of the pattern is /O/(@patternLength@) in time and space.+-- The time complexity of the searching phase is /O/(@targetLength@) for both+-- functions.+--+-- In most cases, these functions are considerably slower than the+-- Boyer-Moore variants, performance is close to that of those from+-- "Data.ByteString.Search.DFA".++-- $partial+--+-- Both functions can be usefully partially applied. Given only a+-- pattern, the auxiliary data will be computed only once, allowing for+-- efficient re-use.++-- | @indices@ finds the starting indices of all possibly overlapping+--   occurrences of the pattern in the target string.+--   If the pattern is empty, the result is @[0 .. 'length' target]@.+{-# INLINE indices #-}+indices :: S.ByteString     -- ^ Pattern to find+        -> S.ByteString     -- ^ String to search+        -> [Int]            -- ^ Offsets of matches+indices = indicesS++-- | @nonOverlappingIndices@ finds the starting indices of all+--   non-overlapping occurrences of the pattern in the target string.+--   It is more efficient than removing indices from the list produced+--   by 'indices'.+{-# INLINE nonOverlappingIndices #-}+nonOverlappingIndices :: S.ByteString   -- ^ Pattern to find+                      -> S.ByteString   -- ^ String to search+                      -> [Int]          -- ^ Offsets of matches+nonOverlappingIndices = matchSS
+ Data/ByteString/Search/KarpRabin.hs view
@@ -0,0 +1,175 @@+{-# LANGUAGE BangPatterns #-}+-- |+-- Module         : Data.ByteString.Search.KarpRabin+-- Copyright      : (c) 2010 Daniel Fischer+-- Licence        : BSD3+-- Maintainer     : Daniel Fischer <daniel.is.fischer@web.de>+-- Stability      : Provisional+-- Portability    : non-portable (BangPatterns)+--+-- Simultaneous search for multiple patterns in a strict 'S.ByteString'+-- using the Karp-Rabin algorithm.+--+-- A description of the algorithm for a single pattern can be found at+-- <http://www-igm.univ-mlv.fr/~lecroq/string/node5.html#SECTION0050>.+module Data.ByteString.Search.KarpRabin ( -- * Overview+                                          -- $overview++                                          -- ** Caution+                                          -- $caution++                                          -- * Function+                                          indicesOfAny+                                        ) where++import qualified Data.ByteString as S+import Data.ByteString.Unsafe (unsafeIndex)++import qualified Data.IntMap as IM++import Data.Array+import Data.Array.Base (unsafeAt)++import Data.Word (Word8)+import Data.Bits+import Data.List (foldl')+++-- $overview+--+-- The Karp-Rabin algorithm works by calculating a hash of the pattern and+-- comparing that hash with the hash of a slice of the target string with+-- the same length as the pattern. If the hashes are equal, the slice of the+-- target is compared to the pattern byte for byte (since the hash+-- function generally isn't injective).+--+-- For a single pattern, this tends to be more efficient than the na&#239;ve+-- algorithm, but it cannot compete with algorithms like+-- Knuth-Morris-Pratt or Boyer-Moore.+--+-- However, the algorithm can be generalised to search for multiple patterns+-- simultaneously. If the shortest pattern has length @k@, hash the prefix of+-- length @k@ of all patterns and compare the hash of the target's slices of+-- length @k@ to them. If there's a match, check whether the slice is part+-- of an occurrence of the corresponding pattern.+--+-- With a hash-function that+--+--   * allows to compute the hash of one slice in constant time from the hash+--     of the previous slice, the new and the dropped character, and+--+--   * produces few spurious matches,+--+-- searching for occurrences of any of @n@ patterns has a best-case complexity+-- of /O/(@targetLength@ * @lookup n@). The worst-case complexity is+-- /O/(@targetLength@ * @lookup n@ * @sum patternLengths@), the average is+-- not much worse than the best case.+--+-- The functions in this module store the hashes of the patterns in an+-- 'IM.IntMap', so the lookup is /O/(@log n@). Re-hashing is done in constant+-- time and spurious matches of the hashes /should be/ sufficiently rare.+-- The maximal length of the prefixes to be hashed is 32.++-- $caution+--+-- Unfortunately, the constant factors are high, so these functions are slow.+-- Unless the number of patterns to search for is high (larger than 50 at+-- least), repeated search for single patterns using Boyer-Moore or DFA and+-- manual merging of the indices is faster. /Much/ faster for less than 40+-- or so patterns.+--+-- In summary, this module is more of an interesting curiosity than anything+-- else.++-- | @indicesOfAny@ finds all occurrences of any of several non-empty patterns+--   in a strict target string. If no non-empty patterns are given,+--   the result is an empty list. Otherwise the result list contains+--   the pairs of all indices where any of the (non-empty) patterns start+--   and the list of all patterns starting at that index, the patterns being+--   represented by their (zero-based) position in the pattern list.+--   Empty patterns are filtered out before processing begins.+{-# INLINE indicesOfAny #-}+indicesOfAny :: [S.ByteString]  -- ^ List of non-empty patterns+             -> S.ByteString    -- ^ String to search+             -> [(Int,[Int])]   -- ^ List of matches+indicesOfAny pats+    | null nepats   = const []+    | otherwise     = strictMatcher nepats+      where+        nepats = filter (not . S.null) pats+++------------------------------------------------------------------------------+--                                 Workers                                 --+------------------------------------------------------------------------------++{-# INLINE rehash1 #-}+rehash1 :: Int -> Int -> Word8 -> Word8 -> Int+rehash1 out h o n =+    (h `shiftL` 1 - (fromIntegral o `shiftL` out)) + fromIntegral n++{-# INLINE rehash2 #-}+rehash2 :: Int -> Int -> Word8 -> Word8 -> Int+rehash2 out h o n =+    (h `shiftL` 2 - (fromIntegral o `shiftL` out)) + fromIntegral n++{-# INLINE rehash3 #-}+rehash3 :: Int -> Int -> Word8 -> Word8 -> Int+rehash3 out h o n =+    (h `shiftL` 3 - (fromIntegral o `shiftL` out)) + fromIntegral n++{-# INLINE rehash4 #-}+rehash4 :: Int -> Int -> Word8 -> Word8 -> Int+rehash4 out h o n =+    (h `shiftL` 4 - (fromIntegral o `shiftL` out)) + fromIntegral n++strictMatcher :: [S.ByteString] -> S.ByteString -> [(Int,[Int])]+strictMatcher pats = search+  where+    !hLen = minimum (32 : map S.length pats)+    !shDi = case 32 `quot` hLen of+              q | q < 4 -> q+                | otherwise -> 4+    !outS = shDi*hLen+    !patNum = length pats+    !patArr = listArray (0, patNum - 1) pats+    {-# INLINE rehash #-}+    rehash :: Int -> Word8 -> Word8 -> Int+    rehash = case shDi of+                1 -> rehash1 hLen+                2 -> rehash2 outS+                3 -> rehash3 outS+                _ -> rehash4 outS+    hash :: S.ByteString -> Int+    hash = S.foldl' (\h w -> (h `shiftL` shDi) + fromIntegral w) 0 . S.take hLen+    !hashMap =+        foldl' (\mp (h,i) -> IM.insertWith (flip (++)) h [i] mp) IM.empty $+                                zip (map hash pats) [0 :: Int .. ]+    search str+        | strLen < hLen   = []+        | otherwise = go 0 shash+          where+            !strLen = S.length str+            !maxIdx = strLen - hLen+            {-# INLINE strAt #-}+            strAt !i = unsafeIndex str i+            !shash = hash str+            go !sI !h =+              case IM.lookup h hashMap of+                Nothing ->+                  if sI == maxIdx+                    then []+                    else go (sI + 1) (rehash h (strAt sI) (strAt (sI + hLen)))+                Just ps ->+                  let !rst = S.drop sI str+                      {-# INLINE hd #-}+                      hd  = strAt sI+                      {-# INLINE more #-}+                      more = if sI == maxIdx then [] else+                                go (sI + 1) (rehash h hd (strAt (sI + hLen)))+                      {-# INLINE okay #-}+                      okay bs = S.isPrefixOf bs rst+                  in case filter (okay . (patArr `unsafeAt`)) ps of+                           [] -> more+                           qs -> seq (length qs) $+                                (sI,qs) : more
Data/ByteString/Search/KnuthMorrisPratt.hs view
@@ -1,33 +1,45 @@-{-# OPTIONS_GHC -fbang-patterns #-} -- |--- Module      : Data.ByteString.Seach.KnuthMorrisPratt--- Copyright   : Justin Bailey---               Chris Kuklewicz--- License     : BSD3--- Maintainer  : Bryan O'Sullivan <bos@serpentine.com>--- Stability   : experimental--- Portability : portable---  +-- Module         : Data.ByteString.Search.KnuthMorrisPratt+-- Copyright      : Justin Bailey+--                  Chris Kuklewicz+--                  Daniel Fischer+-- Licence        : BSD3+-- Maintainer     : Daniel Fischer <daniel.is.fischer@web.de>+-- Stability      : Provisional+-- Portability    : non-portable (BangPatterns)+-- -- Fast non-overlapping Knuth-Morris-Pratt search of both strict and--- lazy 'S.ByteString' values.+-- lazy 'Data.ByteString.ByteString' values. -- -- A description of the algorithm can be found at -- <http://en.wikipedia.org/wiki/Knuth-Morris-Pratt_algorithm>.-+-- -- Original authors: Justin Bailey (jgbailey at gmail.com) and -- Chris Kuklewicz (haskell at list.mightyreason.com).- module Data.ByteString.Search.KnuthMorrisPratt+    {-# DEPRECATED "Use the new interface instead" #-}     (       -- * Overview       -- $overview +      -- ** Changes+      -- $changes++      -- ** Deprecation+      -- $deprecation+       -- ** Parameter and return types       -- $types        -- ** Lazy ByteStrings       -- $lazy +      -- * Partial application+      -- $partial++      -- * Complexity and Performance+      -- $complexity+       -- * Functions       matchLL     , matchLS@@ -35,26 +47,34 @@     , matchSL     ) where -import qualified Data.Array.Base as Base (unsafeAt)-import qualified Data.Array.Unboxed as Unboxed (UArray)-import qualified Data.Array.IArray as IArray (array)-import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString as S-#if __GLASGOW_HASKELL__ >= 608-import qualified Data.ByteString.Unsafe as U (unsafeIndex)-#else-import qualified Data.ByteString.Base as U (unsafeIndex)-#endif-import Data.Int (Int64)+import Data.ByteString.Search.Internal.KnuthMorrisPratt+            (matchLL, matchLS, matchSL, matchSS)  -- $overview ----- This module exports 4 search functions: 'matchLL', 'matchLS',--- 'matchSL', and 'matchSS'.+-- This module exists only for backwards compatibility. Nevertheless+-- there have been small changes in the behaviour of the functions.+-- The module exports four search functions: 'matchLL', 'matchLS',+-- 'matchSL', and 'matchSS'. All of them return the list of all+-- starting positions of non-overlapping occurrences of a pattern+-- in a string.++-- $changes ----- If given an empty pattern, a search will always return an empty--- list.+-- Formerly, all four functions returned an empty list when passed+-- an empty pattern. Now, in accordance with the functions from the other+-- modules, @matchXY \"\" target = [0 .. 'length' target]@.+--+-- Further, the return type of 'matchLS' and 'matchSS' has changed to+-- @['Int']@, since strict 'Data.ByteString.ByteString's are 'Int'-indexed. +-- $deprecation+--+-- This module is /deprecated/. You should use the new interface provided+-- in "Data.ByteString.Search.KMP" and "Data.ByteString.Lazy.Search.KMP"+-- or the generally faster functions from "Data.ByteString.Search" and+-- "Data.ByteString.Search.DFA", respectively the lazy versions.+ -- $types -- -- The first parameter is always the pattern string.  The second@@ -80,103 +100,19 @@ -- This means the garbage collector would be able to keep only a small -- amount of the target string and free the rest. -{-# INLINE matchLL #-}-matchLL :: L.ByteString         -- ^ lazy pattern-        -> L.ByteString         -- ^ lazy target string-        -> [Int64]              -- ^ offsets of matches-matchLL pat = let search = matchSSs' (S.concat (L.toChunks pat)) in search . L.toChunks--{-# INLINE matchLS #-}-matchLS :: L.ByteString         -- ^ lazy pattern-        -> S.ByteString         -- ^ strict target string-        -> [Int64]              -- ^ offsets of matches-matchLS pat = let search = matchSSs' (S.concat (L.toChunks pat)) in search . (:[])--{-# INLINE matchSS #-}-matchSS :: S.ByteString         -- ^ strict pattern-        -> S.ByteString         -- ^ strict target string-        -> [Int64]              -- ^ offsets of matches-matchSS pat = let search = matchSSs' pat in search . (:[])--{-# INLINE matchSL #-}-matchSL :: S.ByteString         -- ^ strict pattern-        -> L.ByteString         -- ^ lazy target string-        -> [Int64]              -- ^ offsets of matches-matchSL pat = let search = matchSSs' pat in search . L.toChunks--matchSSs' :: S.ByteString -> [S.ByteString] -> [Int64]-#ifndef __HADDOCK__-matchSSs' pat | S.null pat = const []-                 | otherwise =-  let !patLen = S.length pat -- Evaluate S.length once; -      !lookupTable = computeLookup pat -- lower bound of UArray must be 0 for Base.unsafeAt, but index 0 will never be looked up-      searcher :: Int64 -> Int -> [S.ByteString] -> [Int64]-      searcher _ _ [] = []-      searcher !prior !patStart (!str:strRest) =-        let !strLen = S.length str -- Evaluate S.length once; -            findMatch :: Int -> Int -> [Int64]-            findMatch !strIndex !patIndex | patIndex == patLen = (prior + fromIntegral strIndex - fromIntegral patLen) : findMatch strIndex 0-                                          | strIndex == strLen = searcher (prior + fromIntegral strLen) patIndex strRest-                                          | otherwise =-              if (U.unsafeIndex str strIndex) == (U.unsafeIndex pat patIndex)-                then findMatch (succ strIndex) (succ patIndex)-                else if patIndex == 0-                       then findMatch (succ strIndex) 0-                       else findMatch strIndex (Base.unsafeAt lookupTable patIndex) -- here 1 <= patIndex <= patLen-1-        in-          findMatch 0 patStart-  in searcher 0 0-#endif--{-|-- Given our pattern, get all the prefixes of the pattern. For each of those- prefixes, find the longest prefix from the original pattern that is also a- suffix of the prefix segment being considered, and is not equal to it. The- argument given to overlap is the length of the prefix matched so far, and the- length of the longest prefix, which is a suffix and is not equal to it, is the- value overlap returns.-- If a given prefix has no possible overlap, it is mapped to -1.---}-overlap :: S.ByteString -> [(Int, Int)]-#ifndef __HADDOCK__-overlap pat =- let patternLength = S.length pat-     -- Given an index into the pattern (representing a substring), find the longest prefix of-     -- the pattern which is a suffix of the substring given, without being-     -- equal to it.-     ---     -- patIdx represents the index of the last character in the prefix, not the-     -- character after it. Therefore, compare the pattern starting at the first-     -- character of the prefix, not the zeroth.-     longestSuffix !patIdx =-      let longestSuffix' !shiftPrefix !prefixIdx -            | shiftPrefix == patIdx = 0 -- No match-            | shiftPrefix + prefixIdx == patIdx = prefixIdx -- Suffix found.-            -- Compare pattern to itself, but shifted, here.-            | U.unsafeIndex pat (shiftPrefix + prefixIdx) == U.unsafeIndex pat prefixIdx = longestSuffix' shiftPrefix (prefixIdx + 1)-            | otherwise = longestSuffix' (shiftPrefix + 1) 0-      in-        longestSuffix' 1 0- in-  (0, 0) : [(matchLen, longestSuffix matchLen) | matchLen <- [1 .. patternLength - 1]]-  -- List.map (\prefix -> (fromIntegral $ S.length prefix, fromIntegral $ longestPreSuffix prefix)) prefixes-#endif+-- $partial+--+-- These functions can all be usefully partially applied. Given only a+-- pattern, the auxiliary data will be computed only once, allowing for+-- efficient re-use. - -{-|- Given a string representing a search pattern, this function- returns a function which represents, for each prefix of that- pattern, the maximally long prefix of the pattern which is a suffix- of the indicated pattern segment.+-- $complexity+--+-- The preprocessing of the pattern is /O/(@patternLength@) in time and space.+-- The time complexity of the searching phase is /O/(@targetLength@) for all+-- functions.+--+-- In most cases, these functions are considerably slower than the+-- Boyer-Moore variants, performance is close to that of those from+-- "Data.ByteString.Search.DFA" resp. "Data.ByteString.Lazy.Search.DFA". - If there is no such prefix, 0 is returned.- -}-computeLookup :: S.ByteString -> Unboxed.UArray Int Int-computeLookup pat =- let patLen = fromIntegral $ S.length pat-     table :: Unboxed.UArray Int Int-     table = {-# SCC "computeLookup_table" #-} IArray.array (0, patLen - 1) (overlap pat)- in table
+ Data/ByteString/Search/Substitution.hs view
@@ -0,0 +1,49 @@+-- |+-- Module         : Data.ByteString.Search.Substitution+-- Copyright      : Daniel Fischer+-- Licence        : BSD3+-- Maintainer     : Daniel Fischer <daniel.is.fischer@web.de>+-- Stability      : Provisional+-- Portability    : portable+--+-- Class for values to be substituted into strict and lazy 'S.ByteString's+-- by the @replace@ functions defined in this package.+--+module Data.ByteString.Search.Substitution ( Substitution(..)) where++import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Internal as LI++-- | Type class of meaningful substitutions for replace functions+--   on ByteStrings. Instances for strict and lazy ByteStrings are+--   provided here.+class Substitution a where+    -- | @substitution@ transforms a value to a substitution function.+    substitution :: a -> ([S.ByteString] -> [S.ByteString])+    {-# INLINE substitution #-}+    -- | @prependCycle sub lazyBS@ shall prepend infinitely many copies+    --   of @sub@ to @lazyBS@ without entering an infinite loop in case+    --   of an empty @sub@, so e.g.+    --+    -- @+    --   'prependCycle' \"\" \"ab\" == \"ab\"+    -- @+    --+    -- shall (quickly) evaluate to 'True'.+    -- For non-empty @sub@, the cycle shall be constructed efficiently.+    prependCycle :: a -> (L.ByteString -> L.ByteString)+    {-# INLINE prependCycle #-}++instance Substitution S.ByteString where+    substitution sub = if S.null sub then id else (sub :)+    prependCycle sub+        | S.null sub    = id+        | otherwise     = let c = LI.Chunk sub c in const c++instance Substitution L.ByteString where+    substitution LI.Empty = id+    substitution (LI.Chunk c t) = (c :) . flip (LI.foldrChunks (:)) t+    prependCycle sub+        | L.null sub    = id+    prependCycle sub = let cyc = LI.foldrChunks LI.Chunk cyc sub in const cyc
+ LICENCE view
@@ -0,0 +1,30 @@+Copyright (c)2010, Daniel Fischer++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Daniel Fischer nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
− LICENSE 
@@ -1,31 +0,0 @@-Copyright:-    Daniel Fischer-    Justin Bailey-    Chris Kuklewicz-    Bryan O'Sullivan--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions-are met:-1. Redistributions of source code must retain the above copyright-   notice, this list of conditions and the following disclaimer.-2. Redistributions in binary form must reproduce the above copyright-   notice, this list of conditions and the following disclaimer in the-   documentation and/or other materials provided with the distribution.-3. Neither the name of the author nor the names of his contributors-   may be used to endorse or promote products derived from this software-   without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF-SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
− Setup.lhs 
@@ -1,3 +0,0 @@-#!/usr/bin/env runhaskell-> import Distribution.Simple-> main = defaultMain
stringsearch.cabal view
@@ -1,24 +1,101 @@-Name:              stringsearch-Version:           0.2.1.1-Description:       Fast search of ByteStrings-Category:          Text, Data, Search-License:           BSD3-License-file:      LICENSE-Author:            Daniel Fischer, Chris Kuklewicz, Justin Bailey-Maintainer:        bos@serpentine.com-Cabal-version:     >= 1.2-Build-type:        Simple+-- stringsearch.cabal auto-generated by cabal init. For additional+-- options, see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name:                stringsearch -Flag splitBase-  Description:     Choose the new, split-up base package.+-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version:             0.3.0 +-- A short (one-line) description of the package.+Synopsis:            Fast searching, splitting and replacing of ByteStrings++-- A longer description of the package.+Description:         This package provides several functions to quickly+                     search for substrings in strict or lazy ByteStrings.+                     It also provides functions for breaking or splitting+                     on substrings and replacing all occurrences of a+                     substring (the first in case of overlaps) with another.++                     GHC before 6.8 are no longer supported, other compilers+                     only if they support BangPatterns. If you need it to+                     work with other compilers, send a feature request.+++-- The license under which the package is released.+License:             BSD3++-- The file containing the license text.+License-file:        LICENCE++-- The package author(s).+Author:              Daniel Fischer, Chris Kuklewicz, Justin Bailey++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer:          daniel.is.fischer@web.de++-- A copyright notice.+Copyright:           (c) 2007-2010+                     Daniel Fischer, Chris Kuklewicz, Justin Bailey++Category:            Text, Search++Build-type:          Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+Extra-source-files:  CHANGES++Tested-with:         GHC == 6.8.3, GHC == 6.10.1, GHC == 6.10.3, GHC == 6.12.1,+                     GHC == 6.12.2, GHC == 6.12.3++-- Constraint on the version of Cabal needed to build this package.+Cabal-version:       >=1.2++Flag base4+  Description:       Choose base-4.*++Flag base3+  Description:       Choose base-3.* if base-4 isn't available+  Default:           False++ Library-  if flag(splitBase)-    Build-depends: base, array, bytestring+  -- Modules exported by the library.+  Exposed-modules:   Data.ByteString.Search+                     Data.ByteString.Search.BoyerMoore+                     Data.ByteString.Search.DFA+                     Data.ByteString.Search.KarpRabin+                     Data.ByteString.Search.KMP+                     Data.ByteString.Search.KnuthMorrisPratt+                     Data.ByteString.Search.Substitution+                     Data.ByteString.Lazy.Search+                     Data.ByteString.Lazy.Search.DFA+                     Data.ByteString.Lazy.Search.KarpRabin+                     Data.ByteString.Lazy.Search.KMP++  -- Packages needed in order to build this package.+  if flag(base4)+    Build-depends:   base >= 4 && < 5, array >= 0.3 && < 0.4,+                     bytestring >= 0.9 && < 1, containers >= 0.3 && < 0.4   else-    Build-depends: base-  Exposed-modules: Data.ByteString.Search.BoyerMoore-                   Data.ByteString.Search.KnuthMorrisPratt-  Extensions:      CPP-  ghc-options:     -O2 -Wall-  nhc98-options:   -K4M+    if flag(base3)+      Build-depends: base >= 3 && < 4, array >= 0.1 && < 0.4,+                     bytestring >= 0.9 && < 1, containers >= 0.1 && < 0.4+    else+      Build-depends: base >= 2 && < 3++  Extensions:        BangPatterns+  ghc-options:       -O2 -Wall+  ghc-prof-options:  -auto-all++  -- Modules not exported by this package.+  Other-modules:     Data.ByteString.Search.Internal.BoyerMoore+                     Data.ByteString.Search.Internal.KnuthMorrisPratt+                     Data.ByteString.Search.Internal.Utils++  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+  -- Build-tools: