diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,6 @@ +0.3.4: +- split implementation of Boyer-Moore between strict and lazy targets +- set spec-constr-count to 4 for ghc-7 0.3.3: - updated email address 0.3.2: diff --git a/Data/ByteString/Lazy/Search.hs b/Data/ByteString/Lazy/Search.hs --- a/Data/ByteString/Lazy/Search.hs +++ b/Data/ByteString/Lazy/Search.hs @@ -53,7 +53,7 @@ , strictify ) where -import qualified Data.ByteString.Search.Internal.BoyerMoore as BM +import qualified Data.ByteString.Lazy.Search.Internal.BoyerMoore as BM import Data.ByteString.Search.Substitution import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L diff --git a/Data/ByteString/Lazy/Search/Internal/BoyerMoore.hs b/Data/ByteString/Lazy/Search/Internal/BoyerMoore.hs new file mode 100644 --- /dev/null +++ b/Data/ByteString/Lazy/Search/Internal/BoyerMoore.hs @@ -0,0 +1,910 @@ +{-# LANGUAGE BangPatterns #-} +{-# OPTIONS_HADDOCK hide, prune #-} +-- | +-- Module : Data.ByteString.Lazy.Search.Internal.BoyerMoore +-- Copyright : Daniel Fischer +-- Chris Kuklewicz +-- Licence : BSD3 +-- Maintainer : Daniel Fischer +-- 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 +-- +-- and +-- +-- +-- Original authors: Daniel Fischer (daniel.is.fischer at googlemail.com) and +-- Chris Kuklewicz (haskell at list.mightyreason.com). + +module Data.ByteString.Lazy.Search.Internal.BoyerMoore ( + matchLL + , matchSL + + -- Non-overlapping + , matchNOL + + -- Replacing substrings + -- replacing + , replaceAllL + -- Breaking on substrings + -- breaking + , breakSubstringL + , breakAfterL + , breakFindAfterL + -- Splitting on substrings + -- splitting + , splitKeepEndL + , splitKeepFrontL + , splitDropL + ) where + + +import Data.ByteString.Search.Internal.Utils + (occurs, suffShifts, ldrop, lsplit, keep, release, strictify) +import Data.ByteString.Search.Substitution + +import qualified Data.ByteString as S +import qualified Data.ByteString.Lazy as L +import Data.ByteString.Unsafe (unsafeIndex) + +import Data.Array.Base (unsafeAt) + +import Data.Word (Word8) +import Data.Int (Int64) + +-- overview +-- +-- This module exports three search functions for searching in lazy +-- ByteSrings, one for searching non-overlapping occurrences of a strict +-- pattern, and one each for searchin overlapping occurrences of a strict +-- resp. lazy pattern. The common base name is @match@, the suffix +-- indicates the type of search. These functions +-- return (for a non-empty pattern) a list of all the indices of the target +-- string where an occurrence of the pattern begins, if some occurrences +-- overlap, all starting indices are reported. The list is produced lazily, +-- so not necessarily the entire target string is searched. +-- +-- The behaviour of these functions when given an empty pattern has changed. +-- Formerly, the @matchXY@ functions returned an empty list then, now it's +-- @[0 .. 'length' target]@. +-- +-- Newly added are functions to replace all (non-overlapping) occurrences +-- of a pattern within a string, functions to break ByteStrings at the first +-- occurrence of a pattern and functions to split ByteStrings at each +-- occurrence of a pattern. None of these functions does copying, so they +-- don't introduce large memory overhead. +-- +-- Internally, a lazy pattern is always converted to a strict ByteString, +-- which is necessary for an efficient implementation of the algorithm. +-- The limit this imposes on the length of the pattern is probably +-- irrelevant in practice, but perhaps it should be mentioned. +-- This also means that the @matchL*@ functions are mere convenience wrappers. +-- Except for the initial 'strictify'ing, there's no difference between lazy +-- and strict patterns, they call the same workers. There is, however, a +-- difference between strict and lazy target strings. +-- For the new functions, no such wrappers are provided, you have to +-- 'strictify' lazy patterns yourself. + +-- caution +-- +-- When working with a lazy target string, the relation between the pattern +-- length and the chunk size can play a big rô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@ + σ) in time and +-- space (σ is the alphabet size, 256 here) for all functions. +-- The time complexity of the searching phase for @matchXY@ +-- is /O/(@targetLength@ \/ @patternLength@) in the best case. +-- For non-periodic patterns, the worst case complexity is +-- /O/(@targetLength@), but for periodic patterns, the worst case complexity +-- is /O/(@targetLength@ * @patternLength@) for the original Boyer-Moore +-- algorithm. +-- +-- The searching functions in this module now contain a modification which +-- drastically improves the performance for periodic patterns. +-- I believe that for strict target strings, the worst case is now +-- /O/(@targetLength@) also for periodic patterns and for lazy target strings, +-- my semi-educated guess is +-- /O/(@targetLength@ * (1 + @patternLength@ \/ @chunkSize@)). +-- I may be very wrong, though. +-- +-- The other functions don't have to deal with possible overlapping +-- patterns, hence the worst case complexity for the processing phase +-- is /O/(@targetLength@) (respectively /O/(@firstIndex + patternLength@) +-- for the breaking functions if the pattern occurs). + +-- currying +-- +-- These functions can all be usefully curried. Given only a pattern +-- the curried version will compute the supporting lookup tables only +-- once, allowing for efficient re-use. Similarly, the curried +-- 'matchLL' and 'matchLS' will compute the concatenated pattern only +-- once. + +-- overflow +-- +-- The current code uses @Int@ to keep track of the locations in the +-- target string. If the length of the pattern plus the length of any +-- strict chunk of the target string is greater than +-- @'maxBound' :: 'Int'@ then this will overflow causing an error. We +-- try to detect this and call 'error' before a segfault occurs. + +------------------------------------------------------------------------------ +-- Wrappers -- +------------------------------------------------------------------------------ + +-- matching +-- +-- These functions find the indices of all (possibly overlapping) +-- occurrences of a pattern in a target string. +-- If the pattern is empty, the result is @[0 .. length target]@. +-- If the pattern is much shorter than the target string +-- and the pattern does not occur very near the beginning of the target, +-- +-- > not . null $ matchSS pattern target +-- +-- is a much more efficient version of 'S.isInfixOf'. + +-- | @matchLL@ finds the starting indices of all possibly overlapping +-- occurrences of the pattern in the target string. +-- It is a simple wrapper for 'Data.ByteString.Lazy.Search.indices'. +-- If the pattern is empty, the result is @[0 .. 'length' target]@. +{-# INLINE matchLL #-} +matchLL :: L.ByteString -- ^ Lazy pattern + -> L.ByteString -- ^ Lazy target string + -> [Int64] -- ^ Offsets of matches +matchLL pat = search . L.toChunks + where + search = lazySearcher True (strictify pat) + +-- | @matchSL@ finds the starting indices of all possibly overlapping +-- occurrences of the pattern in the target string. +-- It is an alias for 'Data.ByteString.Lazy.Search.indices'. +-- If the pattern is empty, the result is @[0 .. 'length' target]@. +{-# INLINE matchSL #-} +matchSL :: S.ByteString -- ^ Strict pattern + -> L.ByteString -- ^ Lazy target string + -> [Int64] -- ^ Offsets of matches +matchSL pat = search . L.toChunks + where + search = lazySearcher True pat + +-- | matchNOL finds the indices of all non-overlapping occurrences +-- of the pattern in the lazy target string. +{-# INLINE matchNOL #-} +matchNOL :: S.ByteString -- ^ Strict pattern + -> L.ByteString -- ^ Lazy target string + -> [Int64] -- ^ Offsets of matches +matchNOL pat = search . L.toChunks + where + search = lazySearcher False pat + +-- replacing +-- +-- These functions replace all (non-overlapping) occurrences of a pattern +-- in the target string. If some occurrences overlap, the earliest is +-- replaced and replacing continues at the index after the replaced +-- occurrence, for example +-- +-- > replaceAllL \"ana\" \"olog\" \"banana\" == \"bologna\", +-- > replaceAllS \"abacab\" \"u\" \"abacabacabacab\" == \"uacu\", +-- > replaceAllS \"aa\" \"aaa\" \"aaaa\" == \"aaaaaa\". +-- +-- Equality of pattern and substitution is not checked, but +-- +-- > pat == sub => 'strictify' (replaceAllS pat sub str) == str, +-- > pat == sub => replaceAllL pat sub str == str. +-- +-- The result is a lazily generated lazy ByteString, the first chunks will +-- generally be available before the entire target has been scanned. +-- If the pattern is empty, but not the substitution, the result is +-- equivalent to @'cycle' sub@. + +{-# INLINE replaceAllL #-} +replaceAllL :: Substitution rep + => S.ByteString -- ^ Pattern to replace + -> rep -- ^ Substitution string + -> L.ByteString -- ^ Target string + -> L.ByteString -- ^ Lazy result +replaceAllL pat + | S.null pat = \sub -> prependCycle sub + | S.length pat == 1 = + let breaker = lazyBreak pat + repl subst strs + | null strs = [] + | otherwise = + case breaker strs of + (pre, mtch) -> + pre ++ case mtch of + [] -> [] + _ -> subst (repl subst (ldrop 1 mtch)) + in \sub -> let repl1 = repl (substitution sub) + in L.fromChunks . repl1 . L.toChunks + | otherwise = + let repl = lazyRepl pat + in \sub -> let repl1 = repl (substitution sub) + in L.fromChunks . repl1 . L.toChunks + +-- breaking +-- +-- Break a string on a pattern. The first component of the result +-- contains the prefix of the string before the first occurrence of the +-- pattern, the second component contains the remainder. +-- The following relations hold: +-- +-- > breakSubstringX \"\" str = (\"\", str) +-- > not (pat `isInfixOf` str) == null (snd $ breakSunbstringX pat str) +-- > True == case breakSubstringX pat str of +-- > (x, y) -> not (pat `isInfixOf` x) +-- > && (null y || pat `isPrefixOf` y) + +-- | The analogous function for a lazy target string. +-- The first component is generated lazily, so parts of it can be +-- available before the pattern is detected (or found to be absent). +{-# INLINE breakSubstringL #-} +breakSubstringL :: S.ByteString -- ^ Pattern to break on + -> L.ByteString -- ^ String to break up + -> (L.ByteString, L.ByteString) + -- ^ Prefix and remainder of broken string +breakSubstringL pat = breaker . L.toChunks + where + lbrk = lazyBreak pat + breaker strs = let (f, b) = lbrk strs + in (L.fromChunks f, L.fromChunks b) + +breakAfterL :: S.ByteString + -> L.ByteString + -> (L.ByteString, L.ByteString) +breakAfterL pat + | S.null pat = \str -> (L.empty, str) +breakAfterL pat = breaker' . L.toChunks + where + !patLen = S.length pat + breaker = lazyBreak pat + breaker' strs = + let (pre, mtch) = breaker strs + (pl, a) = if null mtch then ([],[]) else lsplit patLen mtch + in (L.fromChunks (pre ++ pl), L.fromChunks a) + +breakFindAfterL :: S.ByteString + -> L.ByteString + -> ((L.ByteString, L.ByteString), Bool) +breakFindAfterL pat + | S.null pat = \str -> ((L.empty, str), True) +breakFindAfterL pat = breaker' . L.toChunks + where + !patLen = S.length pat + breaker = lazyBreak pat + breaker' strs = + let (pre, mtch) = breaker strs + (pl, a) = if null mtch then ([],[]) else lsplit patLen mtch + in ((L.fromChunks (pre ++ pl), L.fromChunks a), not (null mtch)) + +-- splitting +-- +-- These functions implement various splitting strategies. +-- +-- If the pattern to split on is empty, all functions return an +-- infinite list of empty ByteStrings. +-- Otherwise, the names are rather self-explanatory. +-- +-- For nonempty patterns, the following relations hold: +-- +-- > concat (splitKeepXY pat str) == str +-- > concat ('Data.List.intersperse' pat (splitDropX pat str)) == str. +-- +-- All fragments except possibly the last in the result of +-- @splitKeepEndX pat@ end with @pat@, none of the fragments contains +-- more than one occurrence of @pat@ or is empty. +-- +-- All fragments except possibly the first in the result of +-- @splitKeepFrontX pat@ begin with @pat@, none of the fragments +-- contains more than one occurrence of @patq or is empty. +-- +-- > splitDropX pat str == map dropPat (splitKeepFrontX pat str) +-- > where +-- > patLen = length pat +-- > dropPat frag +-- > | pat `isPrefixOf` frag = drop patLen frag +-- > | otherwise = frag +-- +-- but @splitDropX@ is a little more efficient than that. + +{-# INLINE splitKeepEndL #-} +splitKeepEndL :: S.ByteString -- ^ Pattern to split on + -> L.ByteString -- ^ String to split + -> [L.ByteString] -- ^ List of fragments +splitKeepEndL pat + | S.null pat = const (repeat L.empty) + | otherwise = + let splitter = lazySplitKeepEnd pat + in map L.fromChunks . splitter . L.toChunks + +{-# INLINE splitKeepFrontL #-} +splitKeepFrontL :: S.ByteString -- ^ Pattern to split on + -> L.ByteString -- ^ String to split + -> [L.ByteString] -- ^ List of fragments +splitKeepFrontL pat + | S.null pat = const (repeat L.empty) + | otherwise = + let splitter = lazySplitKeepFront pat + in map L.fromChunks . splitter . L.toChunks + + +{-# INLINE splitDropL #-} +splitDropL :: S.ByteString -- ^ Pattern to split on + -> L.ByteString -- ^ String to split + -> [L.ByteString] -- ^ List of fragments +splitDropL pat + | S.null pat = const (repeat L.empty) + | otherwise = + let splitter = lazySplitDrop pat + in map L.fromChunks . splitter . L.toChunks + +------------------------------------------------------------------------------ +-- Search Functions -- +------------------------------------------------------------------------------ + +lazySearcher :: Bool -> S.ByteString -> [S.ByteString] -> [Int64] +lazySearcher _ !pat + | S.null pat = + let zgo !prior [] = [prior] + zgo prior (!str : rest) = + let !l = S.length str + !prior' = prior + fromIntegral l + in [prior + fromIntegral i | i <- [0 .. l-1]] ++ zgo prior' rest + in zgo 0 + | S.length pat == 1 = + let !w = S.head pat + ixes = S.elemIndices w + go _ [] = [] + go !prior (!str : rest) + = let !prior' = prior + fromIntegral (S.length str) + in map ((+ prior) . fromIntegral) (ixes str) ++ go prior' rest + in go 0 +lazySearcher !overlap pat = searcher + where + {-# INLINE patAt #-} + patAt :: Int -> Word8 + patAt !i = unsafeIndex pat i + + !patLen = S.length pat + !patEnd = patLen - 1 + {-# INLINE preEnd #-} + preEnd = patEnd - 1 + !maxLen = maxBound - patLen + !occT = occurs pat -- for bad-character-shift + !suffT = suffShifts pat -- for good-suffix-shift + !skip = if overlap then unsafeAt suffT 0 else patLen + -- shift after a complete match + !kept = patLen - skip -- length of known prefix after full match + !pe = patAt patEnd -- last pattern byte for fast comparison + + {-# INLINE occ #-} + occ !w = unsafeAt occT (fromIntegral w) + + {-# INLINE suff #-} + suff !i = unsafeAt suffT i + + searcher lst = case lst of + [] -> [] + (h : t) -> + if maxLen < S.length h + then error "Overflow in BoyerMoore.lazySearcher" + else seek 0 [] h t 0 patEnd + + -- seek is used to position the "zipper" of (past, str, future) to the + -- correct S.ByteString to search. This is done by ensuring that + -- 0 <= strPos < strLen, where strPos = diffPos + patPos. + -- Note that future is not a strict parameter. The bytes being compared + -- will then be (strAt strPos) and (patAt patPos). + -- Splitting this into specialised versions is possible, but it would + -- only be useful if the pattern length is close to (or larger than) + -- the chunk size. For ordinary patterns of at most a few hundred bytes, + -- the overhead of yet more code-paths and larger code size will probably + -- outweigh the small gains in the relatively rare calls to seek. + seek :: Int64 -> [S.ByteString] -> S.ByteString + -> [S.ByteString] -> Int -> Int -> [Int64] + seek !prior !past !str future !diffPos !patPos + | strPos < 0 = -- need to look at previous chunk + case past of + (h : t) -> + let !hLen = S.length h + in seek (prior - fromIntegral hLen) t h (str : future) + (diffPos + hLen) patPos + [] -> error "seek back too far!" + | strEnd < strPos = -- need to look at next chunk if there is + case future of + (h : t) -> + let {-# INLINE prior' #-} + prior' = prior + fromIntegral strLen + !diffPos' = diffPos - strLen + {-# INLINE past' #-} + past' = release (-diffPos') (str : past) + in if maxLen < S.length h + then error "Overflow in BoyerMoore.lazySearcher" + else seek prior' past' h t diffPos' patPos + [] -> [] + | patPos == patEnd = checkEnd strPos + | diffPos < 0 = matcherN diffPos patPos + | otherwise = matcherP diffPos patPos + where + !strPos = diffPos + patPos + !strLen = S.length str + !strEnd = strLen - 1 + !maxDiff = strLen - patLen + + {-# INLINE strAt #-} + strAt !i = unsafeIndex str i + + -- While comparing the last byte of the pattern, the bad- + -- character-shift is always at least as large as the good- + -- suffix-shift. Eliminating the unnecessary memory reads and + -- comparison speeds things up noticeably. + checkEnd !sI -- index in string to compare to last of pattern + | strEnd < sI = seek prior past str future (sI - patEnd) patEnd + | otherwise = + case strAt sI of + !c | c == pe -> + if sI < patEnd + then case sI of + 0 -> seek prior past str future (-patEnd) preEnd + _ -> matcherN (sI - patEnd) preEnd + else matcherP (sI - patEnd) preEnd + | otherwise -> checkEnd (sI + patEnd + occ c) + + -- Once the last byte has matched, we enter the full matcher + -- diff is the offset of the window, patI the index of the + -- pattern byte to compare next. + + -- matcherN is the tight loop that walks backwards from the end + -- of the pattern checking for matching bytes. The offset is + -- always negative, so no complete match can occur here. + -- When a byte matches, we need to check whether we've reached + -- the front of this chunk, otherwise whether we need the next. + matcherN !diff !patI = + case strAt (diff + patI) of + !c | c == patAt patI -> + if diff + patI == 0 + then seek prior past str future diff (patI - 1) + else matcherN diff (patI - 1) + | otherwise -> + let {-# INLINE badShift #-} + badShift = patI + occ c + {-# INLINE goodShift #-} + goodShift = suff patI + !diff' = diff + max badShift goodShift + in if maxDiff < diff' + then seek prior past str future diff' patEnd + else checkEnd (diff' + patEnd) + + -- matcherP is the tight loop for non-negative offsets. + -- When the pattern is shifted, we must check whether we leave + -- the current chunk, otherwise we only need to check for a + -- complete match. + matcherP !diff !patI = + case strAt (diff + patI) of + !c | c == patAt patI -> + if patI == 0 + then prior + fromIntegral diff : + let !diff' = diff + skip + in if maxDiff < diff' + then seek prior past str future diff' patEnd + else + if skip == patLen + then + checkEnd (diff' + patEnd) + else + afterMatch diff' patEnd + else matcherP diff (patI - 1) + | otherwise -> + let {-# INLINE badShift #-} + badShift = patI + occ c + {-# INLINE goodShift #-} + goodShift = suff patI + !diff' = diff + max badShift goodShift + in if maxDiff < diff' + then seek prior past str future diff' patEnd + else checkEnd (diff' + patEnd) + + -- After a full match, we know how long a prefix of the pattern + -- still matches. Do not re-compare the prefix to prevent O(m*n) + -- behaviour for periodic patterns. + -- This breaks down at chunk boundaries, but except for long + -- patterns with a short period, that shouldn't matter much. + afterMatch !diff !patI = + case strAt (diff + patI) of + !c | c == patAt patI -> + if patI == kept + then prior + fromIntegral diff : + let !diff' = diff + skip + in if maxDiff < diff' + then seek prior past str future diff' patEnd + else afterMatch diff' patEnd + else afterMatch diff (patI - 1) + | patI == patEnd -> + checkEnd (diff + (2*patEnd) + occ c) + | otherwise -> + let {-# INLINE badShift #-} + badShift = patI + occ c + {-# INLINE goodShift #-} + goodShift = suff patI + !diff' = diff + max badShift goodShift + in if maxDiff < diff' + then seek prior past str future diff' patEnd + else checkEnd (diff' + patEnd) + +------------------------------------------------------------------------------ +-- Breaking Functions -- +------------------------------------------------------------------------------ + +-- Ugh! Code duplication ahead! +-- But we want to get the first component lazily, so it's no good to find +-- the first index (if any) and then split. +-- Therefore bite the bullet and copy most of the code of lazySearcher. +-- No need for afterMatch here, fortunately. +lazyBreak ::S.ByteString -> [S.ByteString] -> ([S.ByteString], [S.ByteString]) +lazyBreak !pat + | S.null pat = \lst -> ([],lst) + | S.length pat == 1 = + let !w = S.head pat + go [] = ([], []) + go (!str : rest) = + case S.elemIndices w str of + [] -> let (pre, post) = go rest in (str : pre, post) + (i:_) -> if i == 0 + then ([], str : rest) + else ([S.take i str], S.drop i str : rest) + in go +lazyBreak pat = breaker + where + !patLen = S.length pat + !patEnd = patLen - 1 + !occT = occurs pat + !suffT = suffShifts pat + !maxLen = maxBound - patLen + !pe = patAt patEnd + + {-# INLINE patAt #-} + patAt !i = unsafeIndex pat i + + {-# INLINE occ #-} + occ !w = unsafeAt occT (fromIntegral w) + + {-# INLINE suff #-} + suff !i = unsafeAt suffT i + + breaker lst = + case lst of + [] -> ([],[]) + (h:t) -> + if maxLen < S.length h + then error "Overflow in BoyerMoore.lazyBreak" + else seek [] h t 0 patEnd + + seek :: [S.ByteString] -> S.ByteString -> [S.ByteString] + -> Int -> Int -> ([S.ByteString], [S.ByteString]) + seek !past !str future !offset !patPos + | strPos < 0 = + case past of + [] -> error "not enough past!" + (h : t) -> seek t h (str : future) (offset + S.length h) patPos + | strEnd < strPos = + case future of + [] -> (foldr (flip (.) . (:)) id past [str], []) + (h : t) -> + let !off' = offset - strLen + (past', !discharge) = keep (-off') (str : past) + in if maxLen < S.length h + then error "Overflow in BoyerMoore.lazyBreak (future)" + else let (pre,post) = seek past' h t off' patPos + in (foldr (flip (.) . (:)) id discharge pre, post) + | patPos == patEnd = checkEnd strPos + | offset < 0 = matcherN offset patPos + | otherwise = matcherP offset patPos + where + {-# INLINE strAt #-} + strAt !i = unsafeIndex str i + + !strLen = S.length str + !strEnd = strLen - 1 + !maxOff = strLen - patLen + !strPos = offset + patPos + + checkEnd !sI + | strEnd < sI = seek past str future (sI - patEnd) patEnd + | otherwise = + case strAt sI of + !c | c == pe -> + if sI < patEnd + then (if sI == 0 + then seek past str future (-patEnd) (patEnd - 1) + else matcherN (sI - patEnd) (patEnd - 1)) + else matcherP (sI - patEnd) (patEnd - 1) + | otherwise -> checkEnd (sI + patEnd + occ c) + + matcherN !off !patI = + case strAt (off + patI) of + !c | c == patAt patI -> + if off + patI == 0 + then seek past str future off (patI - 1) + else matcherN off (patI - 1) + | otherwise -> + let !off' = off + max (suff patI) (patI + occ c) + in if maxOff < off' + then seek past str future off' patEnd + else checkEnd (off' + patEnd) + + matcherP !off !patI = + case strAt (off + patI) of + !c | c == patAt patI -> + if patI == 0 + then let !pre = if off == 0 then [] else [S.take off str] + !post = S.drop off str + in (foldr (flip (.) . (:)) id past pre, post:future) + else matcherP off (patI - 1) + | otherwise -> + let !off' = off + max (suff patI) (patI + occ c) + in if maxOff < off' + then seek past str future off' patEnd + else checkEnd (off' + patEnd) + + +------------------------------------------------------------------------------ +-- Splitting Functions -- +------------------------------------------------------------------------------ + +-- non-empty pattern +lazySplitKeepFront :: S.ByteString -> [S.ByteString] -> [[S.ByteString]] +lazySplitKeepFront pat = splitter' + where + !patLen = S.length pat + breaker = lazyBreak pat + splitter' strs = case splitter strs of + ([]:rest) -> rest + other -> other + splitter [] = [] + splitter strs = + case breaker strs of + (pre, mtch) -> + pre : case mtch of + [] -> [] + _ -> case lsplit patLen mtch of + (pt, rst) -> + if null rst + then [pt] + else let (h : t) = splitter rst + in (pt ++ h) : t + +-- non-empty pattern +lazySplitKeepEnd :: S.ByteString -> [S.ByteString] -> [[S.ByteString]] +lazySplitKeepEnd pat = splitter + where + !patLen = S.length pat + breaker = lazyBreak pat + splitter [] = [] + splitter strs = + case breaker strs of + (pre, mtch) -> + let (h : t) = if null mtch + then [[]] + else case lsplit patLen mtch of + (pt, rst) -> pt : splitter rst + in (pre ++ h) : t + +lazySplitDrop :: S.ByteString -> [S.ByteString] -> [[S.ByteString]] +lazySplitDrop pat = splitter + where + !patLen = S.length pat + breaker = lazyBreak pat + splitter [] = [] + splitter strs = splitter' strs + splitter' [] = [[]] + splitter' strs = case breaker strs of + (pre,mtch) -> + pre : case mtch of + [] -> [] + _ -> splitter' (ldrop patLen mtch) + +------------------------------------------------------------------------------ +-- Replacing Functions -- +------------------------------------------------------------------------------ + +{- + +These would be really nice. +Unfortunately they're too slow, so instead, there's another instance of +almost the same code as in lazySearcher below. + +-- variant of below +lazyFRepl :: S.ByteString -> ([S.ByteString] -> [S.ByteString]) + -> [S.ByteString] -> [S.ByteString] +lazyFRepl pat = repl + where + !patLen = S.length pat + breaker = lazyBreak pat + repl sub = replacer + where + replacer [] = [] + replacer strs = + let (pre, mtch) = breaker strs + in pre ++ case mtch of + [] -> [] + _ -> sub (replacer (ldrop patLen mtch)) + +-- This is nice and short. I really hope it's performing well! +lazyBRepl :: S.ByteString -> S.ByteString -> [S.ByteString] -> [S.ByteString] +lazyBRepl pat !sub = replacer + where + !patLen = S.length pat + breaker = lazyBreak pat + replacer [] = [] + replacer strs = let (pre, mtch) = breaker strs + in pre ++ case mtch of + [] -> [] + _ -> sub : replacer (ldrop patLen mtch) +-} + +-- Yet more code duplication. +-- +-- Benchmark it against an implementation using lazyBreak and, +-- unless it's significantly faster, NUKE IT!! +-- +-- Sigh, it is significantly faster. 10 - 25 %. +-- I could live with the 10, but 25 is too much. +-- +-- Hmm, maybe an implementation via +-- replace pat sub = L.intercalate sub . split pat +-- would be competitive now. +-- TODO: test speed and space usage. +-- +-- replacing loop for lazy ByteStrings as list of chunks, +-- called only for non-empty patterns +lazyRepl :: S.ByteString -> ([S.ByteString] -> [S.ByteString]) + -> [S.ByteString] -> [S.ByteString] +lazyRepl pat = replacer + where + !patLen = S.length pat + !patEnd = patLen - 1 + !occT = occurs pat + !suffT = suffShifts pat + !maxLen = maxBound - patLen + !pe = patAt patEnd + + {-# INLINE patAt #-} + patAt !i = unsafeIndex pat i + + {-# INLINE occ #-} + occ !w = unsafeAt occT (fromIntegral w) + + {-# INLINE suff #-} + suff !i = unsafeAt suffT i + + replacer sub lst = + case lst of + [] -> [] + (h:t) -> + if maxLen < S.length h + then error "Overflow in BoyerMoore.lazyRepl" + else seek [] h t 0 patEnd + where + chop _ [] = [] + chop !k (!str : rest) + | k < s = + if maxLen < (s - k) + then error "Overflow in BoyerMoore.lazyRepl (chop)" + else seek [] (S.drop k str) rest 0 patEnd + | otherwise = chop (k-s) rest + where + !s = S.length str + + seek :: [S.ByteString] -> S.ByteString -> [S.ByteString] + -> Int -> Int -> [S.ByteString] + seek !past !str fut !offset !patPos + | strPos < 0 = + case past of + [] -> error "not enough past!" + (h : t) -> seek t h (str : fut) (offset + S.length h) patPos + | strEnd < strPos = + case fut of + [] -> foldr (flip (.) . (:)) id past [str] + (h : t) -> + let !off' = offset - strLen + (past', !discharge) = keep (-off') (str : past) + in if maxLen < S.length h + then error "Overflow in BoyerMoore.lazyRepl (future)" + else foldr (flip (.) . (:)) id discharge $ + seek past' h t off' patPos + | patPos == patEnd = checkEnd strPos + | offset < 0 = matcherN offset patPos + | otherwise = matcherP offset patPos + where + {-# INLINE strAt #-} + strAt !i = unsafeIndex str i + + !strLen = S.length str + !strEnd = strLen - 1 + !maxOff = strLen - patLen + !strPos = offset + patPos + + checkEnd !sI + | strEnd < sI = seek past str fut (sI - patEnd) patEnd + | otherwise = + case strAt sI of + !c | c == pe -> + if sI < patEnd + then (if sI == 0 + then seek past str fut (-patEnd) (patEnd - 1) + else matcherN (sI - patEnd) (patEnd - 1)) + else matcherP (sI - patEnd) (patEnd - 1) + | otherwise -> checkEnd (sI + patEnd + occ c) + + matcherN !off !patI = + case strAt (off + patI) of + !c | c == patAt patI -> + if off + patI == 0 + then seek past str fut off (patI - 1) + else matcherN off (patI - 1) + | otherwise -> + let !off' = off + max (suff patI) (patI + occ c) + in if maxOff < off' + then seek past str fut off' patEnd + else checkEnd (off' + patEnd) + + matcherP !off !patI = + case strAt (off + patI) of + !c | c == patAt patI -> + if patI == 0 + then foldr (flip (.) . (:)) id past $ + let pre = if off == 0 + then id + else (S.take off str :) + in pre . sub $ + let !p = off + patLen + in if p < strLen + then seek [] (S.drop p str) fut 0 patEnd + else chop (p - strLen) fut + else matcherP off (patI - 1) + | otherwise -> + let !off' = off + max (suff patI) (patI + occ c) + in if maxOff < off' + then seek past str fut off' patEnd + else checkEnd (off' + patEnd) diff --git a/Data/ByteString/Search.hs b/Data/ByteString/Search.hs --- a/Data/ByteString/Search.hs +++ b/Data/ByteString/Search.hs @@ -1,6 +1,6 @@ -- | -- Module : Data.ByteString.Search --- Copyright : Daniel Fischer +-- Copyright : Daniel Fischer (2007-2011) -- Chris Kuklewicz -- Licence : BSD3 -- Maintainer : Daniel Fischer diff --git a/Data/ByteString/Search/BoyerMoore.hs b/Data/ByteString/Search/BoyerMoore.hs --- a/Data/ByteString/Search/BoyerMoore.hs +++ b/Data/ByteString/Search/BoyerMoore.hs @@ -54,7 +54,9 @@ ) where import Data.ByteString.Search.Internal.BoyerMoore - (matchLL, matchLS, matchSL, matchSS) + (matchLS, matchSS) +import Data.ByteString.Lazy.Search.Internal.BoyerMoore + (matchLL, matchSL) -- $overview -- diff --git a/Data/ByteString/Search/Internal/BoyerMoore.hs b/Data/ByteString/Search/Internal/BoyerMoore.hs --- a/Data/ByteString/Search/Internal/BoyerMoore.hs +++ b/Data/ByteString/Search/Internal/BoyerMoore.hs @@ -22,39 +22,29 @@ -- Chris Kuklewicz (haskell at list.mightyreason.com). module Data.ByteString.Search.Internal.BoyerMoore ( - matchLL - , matchLS - , matchSL + matchLS , 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) + (occurs, suffShifts, strictify) import Data.ByteString.Search.Substitution import qualified Data.ByteString as S @@ -62,19 +52,17 @@ 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.Array.Base (unsafeAt) 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 +-- This module exports three search functions for searching in strict +-- ByteStrings. One for searching non-overlapping occurrences of a strict +-- pattern and one each for possibly overlapping occurrences of a lazy +-- resp. strict pattern. The common base name is @match@, the suffix +-- indicates the type of search to perform. 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, @@ -194,18 +182,6 @@ -- -- 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'. @@ -218,18 +194,6 @@ 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'. @@ -242,16 +206,6 @@ 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 #-} @@ -295,31 +249,6 @@ 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 = - case breaker strs of - (pre, mtch) -> - pre ++ case mtch of - [] -> [] - _ -> subst (repl subst (ldrop 1 mtch)) - in \sub -> let repl1 = repl (substitution sub) - in L.fromChunks . repl1 . L.toChunks - | otherwise = - let repl = lazyRepl pat - in \sub -> let repl1 = repl (substitution sub) - in L.fromChunks . repl1 . L.toChunks - -- breaking -- -- Break a string on a pattern. The first component of the result @@ -355,48 +284,6 @@ [] -> (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. @@ -446,37 +333,6 @@ -> [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 -- ------------------------------------------------------------------------------ @@ -578,196 +434,6 @@ 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 -- ------------------------------------------------------------------------------ @@ -782,119 +448,6 @@ [] -> (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 -- ------------------------------------------------------------------------------ @@ -954,58 +507,6 @@ [] -> [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 = - case breaker strs of - (pre, mtch) -> - pre : case mtch of - [] -> [] - _ -> case lsplit patLen mtch of - (pt, rst) -> - if null rst - then [pt] - else let (h : t) = splitter rst - in (pt ++ h) : t - --- non-empty pattern -lazySplitKeepEnd :: S.ByteString -> [S.ByteString] -> [[S.ByteString]] -lazySplitKeepEnd pat = splitter - where - !patLen = S.length pat - breaker = lazyBreak pat - splitter [] = [] - splitter strs = - case breaker strs of - (pre, mtch) -> - let (h : t) = if null mtch - then [[]] - else case lsplit patLen mtch of - (pt, rst) -> pt : splitter rst - in (pre ++ h) : t - -lazySplitDrop :: S.ByteString -> [S.ByteString] -> [[S.ByteString]] -lazySplitDrop pat = splitter - where - !patLen = S.length pat - breaker = lazyBreak pat - splitter [] = [] - splitter strs = splitter' strs - splitter' [] = [[]] - splitter' strs = case breaker strs of - (pre,mtch) -> - pre : case mtch of - [] -> [] - _ -> splitter' (ldrop patLen mtch) - ------------------------------------------------------------------------------ -- Replacing Functions -- ------------------------------------------------------------------------------ @@ -1029,349 +530,3 @@ | 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. --- --- Hmm, maybe an implementation via --- replace pat sub = L.intercalate sub . split pat --- would be competitive now. --- TODO: test speed and space usage. --- --- replacing loop for lazy ByteStrings as list of chunks, --- called only for non-empty patterns -lazyRepl :: S.ByteString -> ([S.ByteString] -> [S.ByteString]) - -> [S.ByteString] -> [S.ByteString] -lazyRepl pat = replacer - where - !patLen = S.length pat - !patEnd = patLen - 1 - !occT = occurs pat - !suffT = suffShifts pat - !maxLen = maxBound - patLen - !pe = patAt patEnd - - {-# INLINE patAt #-} - patAt !i = unsafeIndex pat i - - {-# INLINE occ #-} - occ !w = unsafeAt occT (fromIntegral w) - - {-# INLINE suff #-} - suff !i = unsafeAt suffT i - - replacer sub lst = - case lst of - [] -> [] - (h:t) -> - if maxLen < S.length h - then error "Overflow in BoyerMoore.lazyRepl" - else seek [] h t 0 patEnd - where - chop _ [] = [] - chop !k (!str : rest) - | k < s = - if maxLen < (s - k) - then error "Overflow in BoyerMoore.lazyRepl (chop)" - else seek [] (S.drop k str) rest 0 patEnd - | otherwise = chop (k-s) rest - where - !s = S.length str - - seek :: [S.ByteString] -> S.ByteString -> [S.ByteString] - -> Int -> Int -> [S.ByteString] - seek !past !str fut !offset !patPos - | strPos < 0 = - case past of - [] -> error "not enough past!" - (h : t) -> seek t h (str : fut) (offset + S.length h) patPos - | strEnd < strPos = - case fut of - [] -> foldr (flip (.) . (:)) id past [str] - (h : t) -> - let !off' = offset - strLen - (past', !discharge) = keep (-off') (str : past) - in if maxLen < S.length h - then error "Overflow in BoyerMoore.lazyRepl (future)" - else foldr (flip (.) . (:)) id discharge $ - seek past' h t off' patPos - | patPos == patEnd = checkEnd strPos - | offset < 0 = matcherN offset patPos - | otherwise = matcherP offset patPos - where - {-# INLINE strAt #-} - strAt !i = unsafeIndex str i - - !strLen = S.length str - !strEnd = strLen - 1 - !maxOff = strLen - patLen - !strPos = offset + patPos - - checkEnd !sI - | strEnd < sI = seek past str fut (sI - patEnd) patEnd - | otherwise = - case strAt sI of - !c | c == pe -> - if sI < patEnd - then (if sI == 0 - then seek past str fut (-patEnd) (patEnd - 1) - else matcherN (sI - patEnd) (patEnd - 1)) - else matcherP (sI - patEnd) (patEnd - 1) - | otherwise -> checkEnd (sI + patEnd + occ c) - - matcherN !off !patI = - case strAt (off + patI) of - !c | c == patAt patI -> - if off + patI == 0 - then seek past str fut off (patI - 1) - else matcherN off (patI - 1) - | otherwise -> - let !off' = off + max (suff patI) (patI + occ c) - in if maxOff < off' - then seek past str fut off' patEnd - else checkEnd (off' + patEnd) - - matcherP !off !patI = - case strAt (off + patI) of - !c | c == patAt patI -> - if patI == 0 - then foldr (flip (.) . (:)) id past $ - let pre = if off == 0 - then id - else (S.take off str :) - in pre . sub $ - let !p = off + patLen - in if p < strLen - then seek [] (S.drop p str) fut 0 patEnd - else chop (p - strLen) fut - else matcherP off (patI - 1) - | otherwise -> - let !off' = off + max (suff patI) (patI + occ c) - in if maxOff < off' - then seek past str fut off' patEnd - else checkEnd (off' + patEnd) - ------------------------------------------------------------------------------- --- 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) diff --git a/Data/ByteString/Search/Internal/Utils.hs b/Data/ByteString/Search/Internal/Utils.hs --- a/Data/ByteString/Search/Internal/Utils.hs +++ b/Data/ByteString/Search/Internal/Utils.hs @@ -14,6 +14,8 @@ module Data.ByteString.Search.Internal.Utils ( kmpBorders , automaton + , occurs + , suffShifts , ldrop , ltake , lsplit @@ -88,6 +90,191 @@ else unsafeWrite ar i j' bordLoop (i+1) j' bordLoop 1 (-1)) + +------------------------------------------------------------------------------ +-- Boyer-Moore 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) ------------------------------------------------------------------------------ -- Helper Functions -- diff --git a/stringsearch.cabal b/stringsearch.cabal --- a/stringsearch.cabal +++ b/stringsearch.cabal @@ -7,7 +7,7 @@ -- 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.3 +Version: 0.3.4 -- A short (one-line) description of the package. Synopsis: Fast searching, splitting and replacing of ByteStrings @@ -38,7 +38,7 @@ Maintainer: daniel.is.fischer@googlemail.com -- A copyright notice. -Copyright: (c) 2007-2010 +Copyright: (c) 2007-2011 Daniel Fischer, Chris Kuklewicz, Justin Bailey Category: Text, Search @@ -49,8 +49,8 @@ -- 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 +Tested-with: GHC == 6.8.3, GHC == 6.12.1, GHC == 6.12.2, + GHC == 6.12.3, GHC == 7.0.3 -- Constraint on the version of Cabal needed to build this package. Cabal-version: >=1.2 @@ -89,13 +89,17 @@ Build-depends: base >= 2 && < 3 Extensions: BangPatterns - ghc-options: -O2 -Wall - ghc-prof-options: -auto-all + if flag(base4) + ghc-options: -O2 -fspec-constr-count=4 -Wall + else + ghc-options: -O2 -Wall + ghc-prof-options: -auto -- Modules not exported by this package. Other-modules: Data.ByteString.Search.Internal.BoyerMoore Data.ByteString.Search.Internal.KnuthMorrisPratt Data.ByteString.Search.Internal.Utils + Data.ByteString.Lazy.Search.Internal.BoyerMoore -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. -- Build-tools: