stringsearch (empty) → 0.1
raw patch · 5 files changed
+723/−0 lines, 5 filesdep +basebuild-type:Customsetup-changed
Dependencies added: base
Files
- Data/ByteString/Search/BoyerMoore.hs +498/−0
- Data/ByteString/Search/KnuthMorrisPratt.hs +178/−0
- LICENSE +31/−0
- Setup.lhs +3/−0
- stringsearch.cabal +13/−0
+ Data/ByteString/Search/BoyerMoore.hs view
@@ -0,0 +1,498 @@+{-# 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+--+-- Fast overlapping Boyer-Moore search of both strict and lazy+-- 'S.ByteString' values.+--+-- 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.BoyerMoore+ (+ -- * Overview+ -- $overview++ -- ** Parameter and return types+ -- $types++ -- ** Lazy ByteStrings+ -- $lazy++ -- ** Performance+ -- $performance++ -- ** Complexity+ -- $complexity++ -- ** Currying+ -- $currying++ -- ** Integer overflow+ -- $overflow++ -- * Functions+ matchLL+ , matchLS+ , matchSL+ , matchSS+ ) where++import qualified Data.ByteString as S (ByteString,null,length,concat)+import qualified Data.ByteString.Lazy as L (ByteString,toChunks)+import qualified Data.ByteString.Base as B (unsafeIndex)++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)++-- $overview+--+-- This module exports 4 search functions: 'matchLL', 'matchLS',+-- 'matchSL', and 'matchSS'.+--+-- If given an empty pattern, a search will always return an empty+-- list.++-- $types+--+-- The first parameter is always the pattern string. The second+-- parameter is always the target string to be searched. The returned+-- list contains the offsets of all /overlapping/ patterns.+--+-- A returned @Int@ or @Int64@ is an index into the target string+-- which is aligned to the head of the pattern string. Strict targets+-- return @Int@ indices and lazy targets return @Int64@ indices. All+-- returned lists are computed and returned in a lazy fashion.++-- $lazy+--+-- 'matchLL' and 'matchLS' take lazy bytestrings as patterns. For+-- performance, if the pattern is not a single strict chunk then all+-- the the pattern chunks will copied into a concatenated strict+-- bytestring. This limits the patterns to a length of (maxBound ::+-- Int).+--+-- 'matchLL' and 'matchSL' take lazy bytestrings as targets.+-- These are written so that while they work they will not retain a+-- reference to all the earlier parts of the the lazy bytestring.+-- This means the garbage collector would be able to keep only a small+-- 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.++-- $complexity+--+-- Preprocessing the pattern string is O(@patternLength@). The search+-- performance is O(@targetLength@\/@patternLength@) in the best case,+-- 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+--+-- 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.++-- $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.++{-# 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 = B.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 = B.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 = B.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 = B.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 = B.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 `B.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 `B.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 `B.unsafeIndex` i) /= (pat `B.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/KnuthMorrisPratt.hs view
@@ -0,0 +1,178 @@+{-# 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+-- +-- Fast non-overlapping 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.KnuthMorrisPratt+ (+ -- * Overview+ -- $ overview++ -- ** Parameter and return types+ -- $types++ -- ** Lazy ByteStrings+ -- $lazy++ -- * Functions+ matchLL+ , matchLS+ , matchSS+ , 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+import qualified Data.ByteString.Base as B (unsafeIndex)+import Data.Int (Int64)++-- $overview+--+-- This module exports 4 search functions: 'matchLL', 'matchLS',+-- 'matchSL', and 'matchSS'.+--+-- If given an empty pattern, a search will always return an empty+-- list.++-- $types+--+-- The first parameter is always the pattern string. The second+-- parameter is always the target string to be searched. The returned+-- list contains the offsets of all /non-overlapping/ patterns.+--+-- A returned @Int@ or @Int64@ is an index into the target string+-- which is aligned to the head of the pattern string. Strict targets+-- return @Int@ indices and lazy targets return @Int64@ indices. All+-- returned lists are computed and returned in a lazy fashion.++-- $lazy+--+-- 'matchLL' and 'matchLS' take lazy bytestrings as patterns. For+-- performance, if the pattern is not a single strict chunk then all+-- the the pattern chunks will copied into a concatenated strict+-- bytestring. This limits the patterns to a length of (maxBound ::+-- Int).+--+-- 'matchLL' and 'matchSL' take lazy bytestrings as targets.+-- These are written so that while they work they will not retain a+-- reference to all the earlier parts of the the lazy bytestring.+-- 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 (B.unsafeIndex str strIndex) == (B.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.+ | B.unsafeIndex pat (shiftPrefix + prefixIdx) == B.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++ +{-|+ 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.++ 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
+ LICENSE view
@@ -0,0 +1,31 @@+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.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ stringsearch.cabal view
@@ -0,0 +1,13 @@+Name: stringsearch+Version: 0.1+Description: Fast search of ByteStrings+License: BSD3+License-file: LICENSE+Author: Daniel Fischer, Chris Kuklewicz+Maintainer: bos@serpentine.com+Build-Depends: base+Exposed-modules: Data.ByteString.Search.BoyerMoore+ Data.ByteString.Search.KnuthMorrisPratt+Extensions: CPP+ghc-options: -O2 -Wall -Werror+nhc98-options: -K4M