2720a7e · streamly · git.iko.soy

320import Data.IORef (newIORef, readIORef, mkWeakIORef, writeIORef, IORef)

321import Data.Maybe (fromJust, isJust, isNothing)

322import Data.Word (Word32)

323−import Foreign.Ptr (Ptr)

324import Foreign.Storable (Storable(..))

323import Foreign.Storable (Storable(..))

325import GHC.Exts (SpecConstrAnnotation(..))

324import GHC.Exts (SpecConstrAnnotation(..))

326import GHC.Types (SPEC(..))

325import GHC.Types (SPEC(..))

1793 | SplitOnSeqDone

1792 | SplitOnSeqDone

1794

1793

1795 | SplitOnSeqEmpty s

1794 | SplitOnSeqEmpty s

1795+

1796+ | SplitOnSeqSingleInit s x

1796 | SplitOnSeqSingle !fs s x

1797 | SplitOnSeqSingle !fs s x

1797

1798

1798 | SplitOnSeqWordInit s

1799 | SplitOnSeqWordInit s

1889 -- Single Pattern

1890 -- Single Pattern

1890 -----------------

1891 -----------------

1891

1892

1893+ stepOuter _ (SplitOnSeqSingleInit _ _) =

1894+ error "This branch should not have hit"

1895+

1892 stepOuter gst (SplitOnSeqSingle fs st pat) = do

1896 stepOuter gst (SplitOnSeqSingle fs st pat) = do

1893 res <- step (adaptState gst) st

1897 res <- step (adaptState gst) st

1894 case res of

1898 case res of

2059 fs1 <- fstep fs old

2063 fs1 <- fstep fs old

2060 skip $ SplitOnSeqKRDone (n - 1) fs1 rb rh1

2064 skip $ SplitOnSeqKRDone (n - 1) fs1 rb rh1

2061

2065

2062−data SplitOnState1 s a =

2063− GO_START1

2064− | GO_EMPTY_PAT1 s

2065− | GO_SINGLE_PAT s a

2066− | GO_SHORT_PAT s

2067− | GO_KARP_RABIN s !(RB.Ring a) !(Ptr a)

2068− | GO_DONE1

2069−

2070{-# INLINE_NORMAL splitSuffixOn #-}

2066{-# INLINE_NORMAL splitSuffixOn #-}

2071splitSuffixOn

2067splitSuffixOn

2072 :: forall m a b. (MonadIO m, Storable a, Enum a, Eq a)

2068 :: forall m a b. (MonadIO m, Storable a, Enum a, Eq a)

2075 -> Fold m a b

2071 -> Fold m a b

2076 -> Stream m a

2072 -> Stream m a

2077 -> Stream m b

2073 -> Stream m b

2078−splitSuffixOn withSep patArr (Fold fstep initial done)

2074+splitSuffixOn withSep patArr (Fold fstep initial done) (Stream step state) =

2079− (Stream step state) =

2080− Stream stepOuter GO_START1

2075+ Stream stepOuter SplitOnSeqInit

2081

2076

2082 where

2077 where

2083

2078

2085 maxIndex = patLen - 1

2080 maxIndex = patLen - 1

2086 elemBits = sizeOf (undefined :: a) * 8

2081 elemBits = sizeOf (undefined :: a) * 8

2087

2082

2083+ -- For word pattern case

2084+ wordMask :: Word

2085+ wordMask = (1 `shiftL` (elemBits * patLen)) - 1

2086+

2087+ elemMask :: Word

2088+ elemMask = (1 `shiftL` elemBits) - 1

2089+

2090+ wordPat :: Word

2091+ wordPat = wordMask .&. A.foldl' addToWord 0 patArr

2092+

2093+ addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)

2094+

2095+ -- For Rabin-Karp search

2096+ k = 2891336453 :: Word32

2097+ coeff = k ^ patLen

2098+

2099+ addCksum cksum a = cksum * k + fromIntegral (fromEnum a)

2100+

2101+ deltaCksum cksum old new =

2102+ addCksum cksum new - coeff * fromIntegral (fromEnum old)

2103+

2104+ -- XXX shall we use a random starting hash or 1 instead of 0?

2105+ patHash = A.foldl' addCksum 0 patArr

2106+

2107+ skip = return . Skip

2108+

2088 {-# INLINE_LATE stepOuter #-}

2109 {-# INLINE_LATE stepOuter #-}

2089− stepOuter _ GO_START1 =

2110+ stepOuter _ SplitOnSeqInit =

2090 if patLen == 0

2111 if patLen == 0

2091− then return $ Skip $ GO_EMPTY_PAT1 state

2112+ then return $ Skip $ SplitOnSeqEmpty state

2092 else if patLen == 1

2113 else if patLen == 1

2093 then do

2114 then do

2094− r <- liftIO $ (A.unsafeIndexIO patArr 0)

2115+ let !pat = A.unsafeIndex patArr 0

2095− return $ Skip $ GO_SINGLE_PAT state r

2116+ return $ Skip $ SplitOnSeqSingleInit state pat

2096 else if sizeOf (undefined :: a) * patLen

2117 else if sizeOf (undefined :: a) * patLen

2097− <= sizeOf (undefined :: Word)

2118+ <= sizeOf (undefined :: Word)

2098− then return $ Skip $ GO_SHORT_PAT state

2119+ then return $ Skip $ SplitOnSeqWordInit state

2099 else do

2120 else do

2100− (rb, rhead) <- liftIO $ RB.new patLen

2121+ (rb, rhead) <- liftIO $ RB.new patLen

2101− return $ Skip $ GO_KARP_RABIN state rb rhead

2122+ skip $ SplitOnSeqKRInit 0 state rb rhead

2102−

2123+

2103− stepOuter gst (GO_SINGLE_PAT stt pat) = do

2124+ stepOuter _ (SplitOnSeqYield x next) = return $ Yield x next

2104− -- This first part is the only difference between splitOn and

2125+

2105− -- splitSuffixOn.

2126+ ---------------------------

2106− -- If the last element is a separator do not issue a blank segment.

2127+ -- Empty pattern

2128+ ---------------------------

2129+

2130+ stepOuter gst (SplitOnSeqEmpty st) = do

2107− res <- step (adaptState gst) stt

2131+ res <- step (adaptState gst) st

2108 case res of

2132 case res of

2109 Yield x s -> do

2133 Yield x s -> do

2110 acc <- initial

2134 acc <- initial

2135+ acc1 <- fstep acc x

2136+ r <- done acc1

2137+ skip $ SplitOnSeqYield r (SplitOnSeqEmpty s)

2138+ Skip s -> return $ Skip (SplitOnSeqEmpty s)

2139+ Stop -> return Stop

2140+

2141+ -----------------

2142+ -- Done

2143+ -----------------

2144+

2145+ stepOuter _ SplitOnSeqDone = return Stop

2146+

2147+ -----------------

2148+ -- Single Pattern

2149+ -----------------

2150+

2151+ stepOuter gst (SplitOnSeqSingleInit st pat) = do

2152+ res <- step (adaptState gst) st

2153+ case res of

2154+ Yield x s -> do

2155+ fs <- initial

2111 if pat == x

2156 if pat == x

2112 then do

2157 then do

2113− acc' <- if withSep then fstep acc x else return acc

2158+ if withSep

2114− done acc' >>= \r -> return $ Yield r (GO_SINGLE_PAT s pat)

2159+ then do

2115− else fstep acc x >>= go SPEC s

2160+ fs1 <- fstep fs x

2161+ r <- done fs1

2162+ let next = SplitOnSeqSingleInit s pat

2163+ skip $ SplitOnSeqYield r next

2164+ else do

2165+ r <- done fs

2166+ let next = SplitOnSeqSingleInit s pat

2167+ skip $ SplitOnSeqYield r next

2168+ else do

2169+ fs1 <- fstep fs x

2170+ skip $ SplitOnSeqSingle fs1 s pat

2116− Skip s -> return $ Skip $ (GO_SINGLE_PAT s pat)

2171+ Skip s -> return $ Skip $ (SplitOnSeqSingleInit s pat)

2117− Stop -> return Stop

2172+ Stop -> return Stop

2118−

2119− where

2120

2173

2121− -- This is identical for splitOn and splitSuffixOn

2174+ stepOuter gst (SplitOnSeqSingle fs st pat) = do

2122− go !_ st !acc = do

2123− res <- step (adaptState gst) st

2175+ res <- step (adaptState gst) st

2124− case res of

2176+ case res of

2125− Yield x s -> do

2177+ Yield x s -> do

2126− if pat == x

2178+ if pat == x

2179+ then do

2180+ if withSep

2127 then do

2181 then do

2128− acc' <- if withSep then fstep acc x else return acc

2182+ fs1 <- fstep fs x

2183+ r <- done fs1

2184+ let next = SplitOnSeqSingleInit s pat

2185+ skip $ SplitOnSeqYield r next

2186+ else do

2129− r <- done acc'

2187+ r <- done fs

2130− return $ Yield r (GO_SINGLE_PAT s pat)

2188+ let next = SplitOnSeqSingleInit s pat

2131− else fstep acc x >>= go SPEC s

2189+ skip $ SplitOnSeqYield r next

2132− Skip s -> go SPEC s acc

2190+ else do

2133− Stop -> done acc >>= \r -> return $ Yield r GO_DONE1

2191+ fs1 <- fstep fs x

2192+ return $ Skip $ (SplitOnSeqSingle fs1 s pat)

2193+ Skip s -> return $ Skip $ SplitOnSeqSingle fs s pat

2194+ Stop -> do

2195+ r <- done fs

2196+ return $ Skip $ SplitOnSeqYield r SplitOnSeqDone

2134

2197

2135− stepOuter gst (GO_SHORT_PAT stt) = do

2198+ ---------------------------

2199+ -- Short Pattern - Shift Or

2200+ ---------------------------

2136

2201

2137− -- Call "initial" only if the stream yields an element, otherwise we

2202+ stepOuter _ (SplitOnSeqWordDone 0 fs _) = do

2138− -- may call "initial" but never yield anything. initial may produce a

2203+ r <- done fs

2139− -- side effect, therefore we will end up doing and discard a side

2204+ skip $ SplitOnSeqYield r SplitOnSeqDone

2140− -- effect.

2205+ stepOuter _ (SplitOnSeqWordDone n fs wrd) = do

2206+ let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))

2207+ fs1 <- fstep fs (toEnum $ fromIntegral old)

2208+ skip $ SplitOnSeqWordDone (n - 1) fs1 wrd

2141

2209

2142− let idx = 0

2210+ stepOuter gst (SplitOnSeqWordInit st0) = do

2143− let wrd = 0

2144− res <- step (adaptState gst) stt

2211+ res <- step (adaptState gst) st0

2145 case res of

2212 case res of

2146 Yield x s -> do

2213 Yield x s -> do

2147− acc <- initial

2214+ fs <- initial

2148− let wrd' = addToWord wrd x

2215+ let wrd = addToWord 0 x

2149− acc' <- if withSep then fstep acc x else return acc

2216+ if withSep

2150− if idx == maxIndex

2151 then do

2217 then do

2152− if wrd' .&. mask == patWord

2218+ fs1 <- fstep fs x

2153− then done acc' >>= \r -> return $ Yield r (GO_SHORT_PAT s)

2154− else go0 SPEC (idx + 1) wrd' s acc'

2219+ go SPEC 1 wrd s fs1

2155− else go0 SPEC (idx + 1) wrd' s acc'

2220+ else go SPEC 1 wrd s fs

2156− Skip s -> return $ Skip (GO_SHORT_PAT s)

2221+ Skip s -> return $ Skip (SplitOnSeqWordInit s)

2157 Stop -> return Stop

2222 Stop -> return Stop

2158

2223

2159 where

2224 where

2160

2225

2161− mask :: Word

2226+ {-# INLINE go #-}

2162− mask = (1 `shiftL` (elemBits * patLen)) - 1

2163−

2164− addToWord wrd a = (wrd `shiftL` elemBits) .|. fromIntegral (fromEnum a)

2165−

2166− patWord :: Word

2167− patWord = mask .&. A.foldl' addToWord 0 patArr

2168−

2169− go0 !_ !idx wrd st !acc = do

2227+ go !_ !idx !wrd !st !fs = do

2170 res <- step (adaptState gst) st

2228 res <- step (adaptState gst) st

2171 case res of

2229 case res of

2172 Yield x s -> do

2230 Yield x s -> do

2173− let wrd' = addToWord wrd x

2231+ let wrd1 = addToWord wrd x

2174− acc' <- if withSep then fstep acc x else return acc

2232+ if withSep

2175− if idx == maxIndex

2176 then do

2233 then do

2177− if wrd' .&. mask == patWord

2234+ fs1 <- fstep fs x

2235+ if idx == maxIndex

2178 then do

2236 then do

2237+ if wrd1 .&. wordMask == wordPat

2238+ then do

2179− r <- done acc'

2239+ r <- done fs

2180− return $ Yield r (GO_SHORT_PAT s)

2240+ let next = SplitOnSeqWordInit s

2181− else go1 SPEC wrd' s acc'

2241+ skip $ SplitOnSeqYield r next

2182− else go0 SPEC (idx + 1) wrd' s acc'

2242+ else skip $ SplitOnSeqWordLoop wrd1 s fs1

2183− Skip s -> go0 SPEC idx wrd s acc

2243+ else go SPEC (idx + 1) wrd1 s fs1

2184− Stop -> do

2185− if (idx == maxIndex) && (wrd .&. mask == patWord)

2186− then return Stop

2187 else do

2244 else do

2188− acc' <- if idx /= 0 && not withSep

2245+ if idx == maxIndex

2189− then go2 wrd idx acc

2246+ then do

2190− else return acc

2247+ if wrd1 .&. wordMask == wordPat

2191− done acc' >>= \r -> return $ Yield r GO_DONE1

2248+ then do

2249+ r <- done fs

2250+ let next = SplitOnSeqWordInit s

2251+ skip $ SplitOnSeqYield r next

2252+ else skip $ SplitOnSeqWordLoop wrd1 s fs

2253+ else go SPEC (idx + 1) wrd1 s fs

2254+ Skip s -> go SPEC idx wrd s fs

2255+ Stop -> skip $ SplitOnSeqWordDone idx fs wrd

2256+

2257+ stepOuter gst (SplitOnSeqWordLoop wrd0 st0 fs0) =

2258+ go SPEC wrd0 st0 fs0

2192

2259

2260+ where

2261+

2193− {-# INLINE go1 #-}

2262+ {-# INLINE go #-}

2194− go1 !_ wrd st !acc = do

2263+ go !_ !wrd !st !fs = do

2195 res <- step (adaptState gst) st

2264 res <- step (adaptState gst) st

2196 case res of

2265 case res of

2197 Yield x s -> do

2266 Yield x s -> do

2198− let wrd' = addToWord wrd x

2267+ let wrd1 = addToWord wrd x

2268+ old = (wordMask .&. wrd)

2199− old = (mask .&. wrd) `shiftR` (elemBits * (patLen - 1))

2269+ `shiftR` (elemBits * (patLen - 1))

2200− acc' <- if withSep

2270+ if withSep

2271+ then do

2201− then fstep acc x

2272+ fs1 <- fstep fs x

2273+ if wrd1 .&. wordMask == wordPat

2274+ then do

2275+ r <- done fs1

2276+ let next = SplitOnSeqWordInit s

2277+ skip $ SplitOnSeqYield r next

2278+ else go SPEC wrd1 s fs1

2279+ else do

2202− else fstep acc (toEnum $ fromIntegral old)

2280+ fs1 <- fstep fs (toEnum $ fromIntegral old)

2203− if wrd' .&. mask == patWord

2281+ if wrd1 .&. wordMask == wordPat

2204− then done acc' >>= \r -> return $ Yield r (GO_SHORT_PAT s)

2282+ then do

2283+ r <- done fs1

2284+ let next = SplitOnSeqWordInit s

2285+ skip $ SplitOnSeqYield r next

2205− else go1 SPEC wrd' s acc'

2286+ else go SPEC wrd1 s fs1

2206− Skip s -> go1 SPEC wrd s acc

2287+ Skip s -> go SPEC wrd s fs

2207 Stop ->

2288 Stop ->

2208− -- If the last sequence is a separator do not issue a blank

2289+ if wrd .&. wordMask == wordPat

2209− -- segment.

2210− if wrd .&. mask == patWord

2211 then return Stop

2290 then return Stop

2212− else do

2291+ else

2213− acc' <- if withSep

2292+ if withSep

2214− then return acc

2293+ then do

2215− else go2 wrd patLen acc

2294+ r <- done fs

2216− done acc' >>= \r -> return $ Yield r GO_DONE1

2295+ skip $ SplitOnSeqYield r SplitOnSeqDone

2217−

2296+ else skip $ SplitOnSeqWordDone patLen fs wrd

2218− go2 !wrd !n !acc | n > 0 = do

2297+

2219− let old = (mask .&. wrd) `shiftR` (elemBits * (n - 1))

2298+ -------------------------------

2220− fstep acc (toEnum $ fromIntegral old) >>= go2 wrd (n - 1)

2299+ -- General Pattern - Karp Rabin

2221− go2 _ _ acc = return acc

2300+ -------------------------------

2222−

2301+

2223− stepOuter gst (GO_KARP_RABIN stt rb rhead) = do

2302+ stepOuter gst (SplitOnSeqKRInit idx0 st0 rb rh0) = do

2224− let idx = 0

2225− res <- step (adaptState gst) stt

2303+ res <- step (adaptState gst) st0

2226 case res of

2304 case res of

2227 Yield x s -> do

2305 Yield x s -> do

2228− acc <- initial

2229− acc' <- if withSep then fstep acc x else return acc

2230− rh' <- liftIO (RB.unsafeInsert rb rhead x)

2306+ rh1 <- liftIO $ RB.unsafeInsert rb rh0 x

2231− if idx == maxIndex

2307+ fs <- initial

2308+ if withSep

2232 then do

2309 then do

2233− let fold = RB.unsafeFoldRing (RB.ringBound rb)

2310+ fs1 <- fstep fs x

2234− let !ringHash = fold addCksum 0 rb

2311+ go SPEC 1 rh1 s fs1

2235− if ringHash == patHash

2236− then go2 SPEC ringHash rh' s acc'

2237− else go0 SPEC (idx + 1) rh' s acc'

2238− else go0 SPEC (idx + 1) rh' s acc'

2312+ else go SPEC 1 rh1 s fs

2239− Skip s -> return $ Skip (GO_KARP_RABIN s rb rhead)

2313+ Skip s -> skip $ SplitOnSeqKRInit idx0 s rb rh0

2240 Stop -> return Stop

2314 Stop -> return Stop

2241

2315

2242 where

2316 where

2243

2317

2244− k = 2891336453 :: Word32

2245− coeff = k ^ patLen

2246− addCksum cksum a = cksum * k + fromIntegral (fromEnum a)

2247− deltaCksum cksum old new =

2248− addCksum cksum new - coeff * fromIntegral (fromEnum old)

2249−

2250− -- XXX shall we use a random starting hash or 1 instead of 0?

2251− patHash = A.foldl' addCksum 0 patArr

2252−

2253− -- rh == ringHead

2254− go0 !_ !idx !rh st !acc = do

2318+ go !_ !idx !rh st !fs = do

2255 res <- step (adaptState gst) st

2319 res <- step (adaptState gst) st

2256 case res of

2320 case res of

2257 Yield x s -> do

2321 Yield x s -> do

2258− acc' <- if withSep then fstep acc x else return acc

2259− rh' <- liftIO (RB.unsafeInsert rb rh x)

2322+ rh1 <- liftIO (RB.unsafeInsert rb rh x)

2260− if idx == maxIndex

2323+ if withSep

2261 then do

2324 then do

2325+ fs1 <- fstep fs x

2326+ if idx == maxIndex

2327+ then do

2262− let fold = RB.unsafeFoldRing (RB.ringBound rb)

2328+ let fold = RB.unsafeFoldRing (RB.ringBound rb)

2263− let !ringHash = fold addCksum 0 rb

2329+ let !ringHash = fold addCksum 0 rb

2264− if ringHash == patHash

2330+ if ringHash == patHash

2265− then go2 SPEC ringHash rh' s acc'

2331+ then skip $ SplitOnSeqKRCheck fs1 s rb rh1

2266− else go1 SPEC ringHash rh' s acc'

2332+ else skip $ SplitOnSeqKRLoop fs1 s rb rh1 ringHash

2333+ else go SPEC (idx + 1) rh1 s fs1

2334+ else

2335+ if idx == maxIndex

2336+ then do

2337+ let fold = RB.unsafeFoldRing (RB.ringBound rb)

2338+ let !ringHash = fold addCksum 0 rb

2339+ if ringHash == patHash

2340+ then skip $ SplitOnSeqKRCheck fs s rb rh1

2341+ else skip $ SplitOnSeqKRLoop fs s rb rh1 ringHash

2267− else go0 SPEC (idx + 1) rh' s acc'

2342+ else go SPEC (idx + 1) rh1 s fs

2268− Skip s -> go0 SPEC idx rh s acc

2343+ Skip s -> go SPEC idx rh s fs

2269 Stop -> do

2344 Stop -> do

2270 -- do not issue a blank segment when we end at pattern

2345 -- do not issue a blank segment when we end at pattern

2271 if (idx == maxIndex) && RB.unsafeEqArray rb rh patArr

2346 if (idx == maxIndex) && RB.unsafeEqArray rb rh patArr

2272 then return Stop

2347 then return Stop

2273− else do

2348+ else

2274− !acc' <- if idx /= 0 && not withSep

2349+ if withSep

2275− then RB.unsafeFoldRingM rh fstep acc rb

2350+ then do

2276− else return acc

2351+ r <- done fs

2277− done acc' >>= \r -> return $ Yield r GO_DONE1

2352+ skip $ SplitOnSeqYield r SplitOnSeqDone

2278−

2353+ else skip $ SplitOnSeqKRDone idx fs rb (RB.startOf rb)

2279− -- XXX Theoretically this code can do 4 times faster if GHC generates

2354+

2280− -- optimal code. If we use just "(cksum' == patHash)" condition it goes

2355+ -- XXX The recursive "go" is more efficient than the state based recursion

2281− -- 4x faster, as soon as we add the "RB.unsafeEqArray rb v" condition

2356+ -- code commented out below. Perhaps its more efficient because of

2282− -- the generated code changes drastically and becomes 4x slower. Need

2357+ -- factoring out "rb" outside the loop.

2283− -- to investigate what is going on with GHC.

2358+ --

2284− {-# INLINE go1 #-}

2359+ stepOuter gst (SplitOnSeqKRLoop fs0 st0 rb rh0 cksum0) =

2285− go1 !_ !cksum !rh st !acc = do

2360+ go SPEC fs0 st0 rh0 cksum0

2361+

2362+ where

2363+

2364+ go !_ !fs !st !rh !cksum = do

2286 res <- step (adaptState gst) st

2365 res <- step (adaptState gst) st

2287 case res of

2366 case res of

2288 Yield x s -> do

2367 Yield x s -> do

2289 old <- liftIO $ peek rh

2368 old <- liftIO $ peek rh

2369+ rh1 <- liftIO (RB.unsafeInsert rb rh x)

2290− let cksum' = deltaCksum cksum old x

2370+ let cksum1 = deltaCksum cksum old x

2291− acc' <- if withSep

2371+ if withSep

2292− then fstep acc x

2293− else fstep acc old

2294−

2295− if (cksum' == patHash)

2296 then do

2372 then do

2297− rh' <- liftIO (RB.unsafeInsert rb rh x)

2373+ fs1 <- fstep fs x

2298− go2 SPEC cksum' rh' s acc'

2374+ if (cksum1 == patHash)

2375+ then skip $ SplitOnSeqKRCheck fs1 s rb rh1

2376+ else go SPEC fs1 s rh1 cksum1

2299 else do

2377 else do

2300− rh' <- liftIO (RB.unsafeInsert rb rh x)

2378+ fs1 <- fstep fs old

2301− go1 SPEC cksum' rh' s acc'

2379+ if (cksum1 == patHash)

2380+ then skip $ SplitOnSeqKRCheck fs1 s rb rh1

2381+ else go SPEC fs1 s rh1 cksum1

2302− Skip s -> go1 SPEC cksum rh s acc

2382+ Skip s -> go SPEC fs s rh cksum

2303− Stop -> do

2383+ Stop ->

2304 if RB.unsafeEqArray rb rh patArr

2384 if RB.unsafeEqArray rb rh patArr

2305 then return Stop

2385 then return Stop

2306− else do

2386+ else

2307− acc' <- if withSep

2387+ if withSep

2308− then return acc

2388+ then do

2309− else RB.unsafeFoldRingFullM rh fstep acc rb

2389+ r <- done fs

2310− done acc' >>= \r -> return $ Yield r GO_DONE1

2390+ skip $ SplitOnSeqYield r SplitOnSeqDone

2311−

2391+ else skip $ SplitOnSeqKRDone patLen fs rb rh

2312− go2 !_ !cksum' !rh' s !acc' = do

2392+

2393+ stepOuter _ (SplitOnSeqKRCheck fs st rb rh) = do

2313− if RB.unsafeEqArray rb rh' patArr

2394+ if RB.unsafeEqArray rb rh patArr

2314− then do

2395+ then do

2315− r <- done acc'

2396+ r <- done fs

2316− return $ Yield r (GO_KARP_RABIN s rb rhead)

2397+ let next = SplitOnSeqKRInit 0 st rb (RB.startOf rb)

2317− else go1 SPEC cksum' rh' s acc'

2398+ skip $ SplitOnSeqYield r next

2318−

2399+ else skip $ SplitOnSeqKRLoop fs st rb rh patHash

2319− stepOuter gst (GO_EMPTY_PAT1 st) = do

2320− res <- step (adaptState gst) st

2321− case res of

2322− Yield x s -> do

2323− acc <- initial

2324− acc' <- fstep acc x

2325− done acc' >>= \r -> return $ Yield r (GO_EMPTY_PAT1 s)

2326− Skip s -> return $ Skip (GO_EMPTY_PAT1 s)

2327− Stop -> return Stop

2328

2400

2329− stepOuter _ GO_DONE1 = return Stop

2401+ stepOuter _ (SplitOnSeqKRDone 0 fs _ _) = do

2402+ r <- done fs

2403+ skip $ SplitOnSeqYield r SplitOnSeqDone

2404+ stepOuter _ (SplitOnSeqKRDone n fs rb rh) = do

2405+ old <- liftIO $ peek rh

2406+ let rh1 = RB.advance rb rh

2407+ fs1 <- fstep fs old

2408+ skip $ SplitOnSeqKRDone (n - 1) fs1 rb rh1

2330

2409

2331data SplitState s arr

2410data SplitState s arr

2332 = SplitInitial s

2411 = SplitInitial s