git.iko.soy/streamly
on master help sign in
Port the changed impl of splitOn to master branch
29ebe7eHarendra Kumar
src/Streamly/Internal/Data/Stream/StreamD.hs+244−164
compare with master
unifiedsplit
@@ -1786,12 +1786,25 @@ data SplitOptions = SplitOptions
1786 }
1786 }
1787-}
1787-}
1788
1788
1789+{-# ANN type SplitOnState Fuse #-}
1789−data SplitOnState s a =
1790+data SplitOnState fs s a b w rb rh ck =
1790 GO_START
1791 GO_START
1791 | GO_EMPTY_PAT s
1792 | GO_EMPTY_PAT s
1792− | GO_SINGLE_PAT s a
1793+ | GO_EMPTY_PAT_WITH s a
1793− | GO_SHORT_PAT s
1794+ -- | GO_SINGLE_PAT_BEGIN s a -- Only for splitSuffixOn
1794− | GO_KARP_RABIN s !(RB.Ring a) !(Ptr a)
1795+ | GO_SINGLE_PAT_NEXT !fs s a
1796+ | GO_SINGLE_PAT_WITH !fs s a a
1797+ | GO_SHORT_PAT_ACCUM Int s !w
1798+ | GO_SHORT_PAT_NEXT !fs s !w
1799+ | GO_SHORT_PAT_NEXT_WITH !fs s a !w
1800+ | GO_SHORT_PAT_DRAIN Int !fs !w
1801+ -- | GO_SHORT_PAT_YIELD_SEP Int !fs s w -- Only for splitSuffixOn.
1802+ | GO_KARP_RABIN_ACCUM Int s rb rh
1803+ | GO_KARP_RABIN_NEXT !fs s rb rh !ck
1804+ | GO_KARP_RABIN_NEXT_WITH !fs s a rb rh !ck
1805+ | GO_KARP_RABIN_DRAIN Int !fs rb rh
1806+ -- | GO_KARP_RABIN_YIELD_SEP Int !fs s rb rh -- Only for splitSuffixOn.
1807+ | GO_YIELD b (SplitOnState fs s a b w rb rh ck)
1795 | GO_DONE
1808 | GO_DONE
1796
1809
1797{-# INLINE_NORMAL splitOn #-}
1810{-# INLINE_NORMAL splitOn #-}
@@ -1810,169 +1823,236 @@ splitOn patArr (Fold fstep initial done) (Stream step state) =
1810 maxIndex = patLen - 1
1823 maxIndex = patLen - 1
1811 elemBits = sizeOf (undefined :: a) * 8
1824 elemBits = sizeOf (undefined :: a) * 8
1812
1825
1813− {-# INLINE_LATE stepOuter #-}
1826+ -- XXX I initially put this in the state but I'd like to keep the state as
1814− stepOuter _ GO_START =
1827+ -- simple as possible to allow more fusion (if that's how it
1815− if patLen == 0
1828+ -- works). Removing this from the state did not change anything. I'll
1816− then return $ Skip $ GO_EMPTY_PAT state
1829+ -- introduce them back once I figure out what's currently wrong. Ideally, I
1817− else if patLen == 1
1830+ -- want them to be associated with the state.
1818− then do
1831+ mask :: Word
1819− r <- liftIO $ (A.unsafeIndexIO patArr 0)
1832+ mask = (1 `shiftL` (elemBits * patLen)) - 1
1820− return $ Skip $ GO_SINGLE_PAT state r
1821− else if sizeOf (undefined :: a) * patLen
1822− <= sizeOf (undefined :: Word)
1823− then return $ Skip $ GO_SHORT_PAT state
1824− else do
1825− (rb, rhead) <- liftIO $ RB.new patLen
1826− return $ Skip $ GO_KARP_RABIN state rb rhead
1827
1833
1828− stepOuter gst (GO_SINGLE_PAT stt pat) = initial >>= go SPEC stt
1834+ -- XXX I initially put this in the state but I'd like to keep the state as
1835+ -- simple as possible to allow more fusion. Removing this from the state did
1836+ -- not change anything. I'll introduce them back once I figure out what's
1837+ -- currently wrong.
1838+ pat :: Word
1839+ -- XXX You dont need .&. here?
1840+ pat = mask .&. A.foldl' addToWord 0 patArr
1829
1841
1830− where
1842+ -- Used only if the pattern is short
1843+ addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)
1831
1844
1832− go !_ st !acc = do
1845+ -- Used in Rabin-Karp
1833− res <- step (adaptState gst) st
1846+ k = 2891336453 :: Word32
1834− case res of
1847+ coeff = k ^ patLen
1835− Yield x s -> do
1836− if pat == x
1837− then do
1838− r <- done acc
1839− return $ Yield r (GO_SINGLE_PAT s pat)
1840− else fstep acc x >>= go SPEC s
1841− Skip s -> go SPEC s acc
1842− Stop -> done acc >>= \r -> return $ Yield r GO_DONE
1843−
1844− stepOuter gst (GO_SHORT_PAT stt) = initial >>= go0 SPEC 0 (0 :: Word) stt
1845
1848
1846− where
1849+ addCksum cksum a = cksum * k + fromIntegral (fromEnum a)
1847
1850
1848− mask :: Word
1851+ deltaCksum cksum old new =
1849− mask = (1 `shiftL` (elemBits * patLen)) - 1
1850−
1851− addToWord wrd a = (wrd `shiftL` elemBits) .|. fromIntegral (fromEnum a)
1852+ addCksum cksum new - coeff * fromIntegral (fromEnum old)
1852
1853
1853− patWord :: Word
1854+ -- XXX shall we use a random starting hash or 1 instead of 0?
1854− patWord = mask .&. A.foldl' addToWord 0 patArr
1855+ patHash = A.foldl' addCksum 0 patArr
1855
1856
1856− go0 !_ !idx wrd st !acc = do
1857+ {-# INLINE_LATE stepOuter #-}
1857− res <- step (adaptState gst) st
1858+ stepOuter _ GO_START =
1858− case res of
1859+ if patLen == 0
1859− Yield x s -> do
1860+ then return $ Skip $ GO_EMPTY_PAT state
1860− let wrd' = addToWord wrd x
1861+ else if patLen == 1
1861− if idx == maxIndex
1862+ then do
1862− then do
1863− if wrd' .&. mask == patWord
1864− then do
1865− r <- done acc
1866− return $ Yield r (GO_SHORT_PAT s)
1867− else go1 SPEC wrd' s acc
1868− else go0 SPEC (idx + 1) wrd' s acc
1869− Skip s -> go0 SPEC idx wrd s acc
1870− Stop -> do
1871− acc' <- if idx /= 0
1872− then go2 wrd idx acc
1873− else return acc
1874− done acc' >>= \r -> return $ Yield r GO_DONE
1875−
1876− {-# INLINE go1 #-}
1877− go1 !_ wrd st !acc = do
1878− res <- step (adaptState gst) st
1879− case res of
1880− Yield x s -> do
1881− let wrd' = addToWord wrd x
1882− old = (mask .&. wrd) `shiftR` (elemBits * (patLen - 1))
1883− acc' <- fstep acc (toEnum $ fromIntegral old)
1884− if wrd' .&. mask == patWord
1885− then done acc' >>= \r -> return $ Yield r (GO_SHORT_PAT s)
1886− else go1 SPEC wrd' s acc'
1887− Skip s -> go1 SPEC wrd s acc
1888− Stop -> do
1889− acc' <- go2 wrd patLen acc
1890− done acc' >>= \r -> return $ Yield r GO_DONE
1891−
1892− go2 !wrd !n !acc | n > 0 = do
1893− let old = (mask .&. wrd) `shiftR` (elemBits * (n - 1))
1894− fstep acc (toEnum $ fromIntegral old) >>= go2 wrd (n - 1)
1895− go2 _ _ acc = return acc
1896−
1897− stepOuter gst (GO_KARP_RABIN stt rb rhead) = do
1898− initial >>= go0 SPEC 0 rhead stt
1863+ acc <- initial
1899−
1864+ pat_ <- liftIO $ A.unsafeIndexIO patArr 0
1900− where
1865+ return $ Skip $ GO_SINGLE_PAT_NEXT acc state pat_
1901−
1866+ else if sizeOf (undefined :: a) * patLen
1902− k = 2891336453 :: Word32
1867+ <= sizeOf (undefined :: Word)
1903− coeff = k ^ patLen
1868+ then return $ Skip $ GO_SHORT_PAT_ACCUM 0 state (0 :: Word)
1904− addCksum cksum a = cksum * k + fromIntegral (fromEnum a)
1869+ else do
1905− deltaCksum cksum old new =
1870+ (rb, rhead) <- liftIO $ RB.new patLen
1906− addCksum cksum new - coeff * fromIntegral (fromEnum old)
1871+ return $ Skip $ GO_KARP_RABIN_ACCUM 0 state rb rhead
1907−
1872+ stepOuter _ (GO_YIELD x ns) = return $ Yield x ns
1908− -- XXX shall we use a random starting hash or 1 instead of 0?
1873+ stepOuter _ GO_DONE = return Stop
1909− patHash = A.foldl' addCksum 0 patArr
1910
1874
1911− -- rh == ringHead
1875+ ---------------------------
1912− go0 !_ !idx !rh st !acc = do
1876+ -- Empty pattern
1913− res <- step (adaptState gst) st
1877+ ---------------------------
1914− case res of
1915− Yield x s -> do
1916− rh' <- liftIO $ RB.unsafeInsert rb rh x
1917− if idx == maxIndex
1918− then do
1919− let fold = RB.unsafeFoldRing (RB.ringBound rb)
1920− let !ringHash = fold addCksum 0 rb
1921− if ringHash == patHash
1922− then go2 SPEC ringHash rh' s acc
1923− else go1 SPEC ringHash rh' s acc
1924− else go0 SPEC (idx + 1) rh' s acc
1925− Skip s -> go0 SPEC idx rh s acc
1926− Stop -> do
1927− !acc' <- if idx /= 0
1928− then RB.unsafeFoldRingM rh fstep acc rb
1929− else return acc
1930− done acc' >>= \r -> return $ Yield r GO_DONE
1931
1878
1932− -- XXX Theoretically this code can do 4 times faster if GHC generates
1879+ stepOuter _ (GO_EMPTY_PAT_WITH s x) = do
1933− -- optimal code. If we use just "(cksum' == patHash)" condition it goes
1880+ ini <- initial
1934− -- 4x faster, as soon as we add the "RB.unsafeEqArray rb v" condition
1881+ res <- fstep ini x
1935− -- the generated code changes drastically and becomes 4x slower. Need
1882+ r <- done res
1936− -- to investigate what is going on with GHC.
1883+ return $ Skip $ GO_YIELD r (GO_EMPTY_PAT s)
1937− {-# INLINE go1 #-}
1884+ stepOuter gst (GO_EMPTY_PAT st) = do
1938− go1 !_ !cksum !rh st !acc = do
1939− res <- step (adaptState gst) st
1885+ res <- step (adaptState gst) st
1886+ return
1940− case res of
1887+ $ case res of
1941− Yield x s -> do
1888+ Yield x s -> Skip $ GO_EMPTY_PAT_WITH s x
1942− old <- liftIO $ peek rh
1889+ Skip s -> Skip $ GO_EMPTY_PAT s
1943− let cksum' = deltaCksum cksum old x
1890+ Stop -> Stop
1944− acc' <- fstep acc old
1945
1891
1946− if (cksum' == patHash)
1892+ -----------------
1893+ -- Single Pattern
1894+ -----------------
1895+
1896+ -- XXX These functions cab be designed in a better way? Get rid of go and
1897+ -- have more info in the state but you would be relying on GHC for
1898+ -- simplification.
1899+ -- XXX We can probably move pat_ outside? Or move the things outside, inside
1900+ -- the state to make it consistent.
1901+ stepOuter _ (GO_SINGLE_PAT_WITH fs s pat_ x) =
1902+ if pat_ == x
1947− then do
1903+ then do
1948− rh' <- liftIO (RB.unsafeInsert rb rh x)
1904+ r <- done fs
1949− go2 SPEC cksum' rh' s acc'
1905+ ini <- initial
1906+ return $ Skip $ GO_YIELD r (GO_SINGLE_PAT_NEXT ini s pat_)
1950− else do
1907+ else do
1951− rh' <- liftIO (RB.unsafeInsert rb rh x)
1908+ res <- fstep fs x
1952− go1 SPEC cksum' rh' s acc'
1909+ return $ Skip $ (GO_SINGLE_PAT_NEXT res s pat_)
1953− Skip s -> go1 SPEC cksum rh s acc
1910+ stepOuter gst (GO_SINGLE_PAT_NEXT fs st pat_) = do
1954− Stop -> do
1911+ res <- step (adaptState gst) st
1955− acc' <- RB.unsafeFoldRingFullM rh fstep acc rb
1912+ case res of
1956− done acc' >>= \r -> return $ Yield r GO_DONE
1913+ Yield x s -> return $ Skip $ GO_SINGLE_PAT_WITH fs s pat_ x
1914+ Skip s -> return $ Skip $ GO_SINGLE_PAT_NEXT fs s pat_
1915+ Stop -> do
1916+ r <- done fs
1917+ return $ Skip $ GO_YIELD r GO_DONE
1957
1918
1958− go2 !_ !cksum' !rh' s !acc' = do
1919+ ---------------------------
1959− if RB.unsafeEqArray rb rh' patArr
1920+ -- Short Pattern - Shift Or
1960− then do
1921+ ---------------------------
1961− r <- done acc'
1962− return $ Yield r (GO_KARP_RABIN s rb rhead)
1963− else go1 SPEC cksum' rh' s acc'
1964
1922
1923+ -- XXX mask can be omitted in most of the places?
1965− stepOuter gst (GO_EMPTY_PAT st) = do
1924+ stepOuter gst (GO_SHORT_PAT_ACCUM idx st wrd) = do
1966 res <- step (adaptState gst) st
1925 res <- step (adaptState gst) st
1967 case res of
1926 case res of
1968 Yield x s -> do
1927 Yield x s -> do
1969− acc <- initial
1928+ let wrd1 = addToWord wrd x
1970− acc' <- fstep acc x
1929+ if idx == maxIndex
1971− done acc' >>= \r -> return $ Yield r (GO_EMPTY_PAT s)
1930+ then if wrd1 .&. mask == pat
1931+ then do
1932+ r <- initial >>= done
1933+ return
1934+ $ Skip
1935+ $ GO_YIELD r $ GO_SHORT_PAT_ACCUM 0 s (0 :: Word)
1936+ else do
1937+ ini <- initial
1938+ return $ Skip $ GO_SHORT_PAT_NEXT ini s wrd1
1939+ else return $ Skip $ GO_SHORT_PAT_ACCUM (idx + 1) s wrd1
1972− Skip s -> return $ Skip (GO_EMPTY_PAT s)
1940+ Skip s -> return $ Skip $ GO_SHORT_PAT_ACCUM idx s wrd
1973− Stop -> return Stop
1941+ Stop -> do
1974−
1942+ ini <- initial
1975− stepOuter _ GO_DONE = return Stop
1943+ if idx /= 0
1944+ then return $ Skip $ GO_SHORT_PAT_DRAIN idx ini wrd
1945+ else do
1946+ r <- done ini
1947+ return $ Skip $ GO_YIELD r GO_DONE
1948+ stepOuter _ (GO_SHORT_PAT_NEXT_WITH fs s x wrd) = do
1949+ let wrd1 = mask .&. addToWord wrd x
1950+ old = wrd `shiftR` (elemBits * (patLen - 1))
1951+ fres <- fstep fs (toEnum $ fromIntegral old)
1952+ -- XXX Removing the then branch increases the
1953+ -- performance by 150%
1954+ if wrd1 .&. mask == pat
1955+ then do
1956+ r <- done fres
1957+ return
1958+ $ Skip $ GO_YIELD r $ GO_SHORT_PAT_ACCUM 0 s (0 :: Word)
1959+ else return $ Skip $ GO_SHORT_PAT_NEXT fres s wrd1
1960+ -- If the fold terminates then the behaviour is same as if
1961+ -- the pattern is matched. We should not ignore the
1962+ -- currently stored pattern though.
1963+ stepOuter gst (GO_SHORT_PAT_NEXT fs st wrd) = do
1964+ res <- step (adaptState gst) st
1965+ case res of
1966+ Yield x s -> return $ Skip $ GO_SHORT_PAT_NEXT_WITH fs s x wrd
1967+ Skip s -> return $ Skip $ GO_SHORT_PAT_NEXT fs s wrd
1968+ Stop -> return $ Skip $ GO_SHORT_PAT_DRAIN patLen fs wrd
1969+ -- XXX Check if this is correct? Consider n == 1, fromIntegral (mask
1970+ -- .&. word) is considering more than one element. We should change the mask
1971+ -- to ignore the previous elements.
1972+ stepOuter _ (GO_SHORT_PAT_DRAIN 0 fs _) = do
1973+ r <- done fs
1974+ return $ Skip $ GO_YIELD r GO_DONE
1975+ stepOuter _ (GO_SHORT_PAT_DRAIN n fs wrd) = do
1976+ let old = wrd `shiftR` (elemBits * (n - 1))
1977+ mask1 = (1 `shiftL` (elemBits * (n - 1))) - 1 :: Word
1978+ wrd1 = mask1 .&. wrd
1979+ fres <- fstep fs (toEnum $ fromIntegral old)
1980+ return $ Skip $ GO_SHORT_PAT_DRAIN (n - 1) fres wrd1
1981+
1982+ -------------------------------
1983+ -- General Pattern - Karp Rabin
1984+ -------------------------------
1985+
1986+ stepOuter gst (GO_KARP_RABIN_ACCUM idx st rb rh) = do
1987+ res <- step (adaptState gst) st
1988+ case res of
1989+ Yield x s -> do
1990+ rh1 <- liftIO $ RB.unsafeInsert rb rh x
1991+ if idx == maxIndex
1992+ then do
1993+ let fold = RB.unsafeFoldRing (RB.ringBound rb)
1994+ let !ringHash = fold addCksum 0 rb
1995+ if ringHash == patHash
1996+ then do
1997+ r <- initial >>= done
1998+ return
1999+ $ Skip $ GO_YIELD r $ GO_KARP_RABIN_ACCUM 0 s rb rh1
2000+ else do
2001+ ini <- initial
2002+ return $ Skip $ GO_KARP_RABIN_NEXT ini s rb rh1 ringHash
2003+ else return $ Skip $ GO_KARP_RABIN_ACCUM (idx + 1) s rb rh1
2004+ Skip s -> return $ Skip $ GO_KARP_RABIN_ACCUM idx s rb rh
2005+ Stop -> do
2006+ ini <- initial
2007+ let rh1 = RB.moveBy (0 - idx) rb (rh :: Ptr a)
2008+ if idx /= 0
2009+ then return $ Skip $ GO_KARP_RABIN_DRAIN idx ini rb rh1
2010+ else do
2011+ r <- done ini
2012+ return $ Skip $ GO_YIELD r GO_DONE
2013+ -- XXX Theoretically this code can do 4 times faster if GHC generates
2014+ -- optimal code. If we use just "(cksum1 == patHash)" condition it goes 4x
2015+ -- faster, as soon as we add the "RB.unsafeEqArray rb v" condition the
2016+ -- generated code changes drastically and becomes 4x slower. Need to
2017+ -- investigate what is going on with GHC.
2018+ stepOuter _ (GO_KARP_RABIN_NEXT_WITH fs s x rb rh cksum) = do
2019+ old <- liftIO $ peek rh
2020+ let cksum1 = deltaCksum cksum old x
2021+ fres <- fstep fs old
2022+ if (cksum1 == patHash)
2023+ then do
2024+ r <- done fres
2025+ -- XXX It does not matter whether we give rh or rh1
2026+ -- here. We restart anyway.
2027+ return $ Skip $ GO_YIELD r $ GO_KARP_RABIN_ACCUM 0 s rb rh
2028+ else do
2029+ rh1 <- liftIO (RB.unsafeInsert rb rh x)
2030+ return $ Skip $ GO_KARP_RABIN_NEXT fres s rb rh1 cksum1
2031+ stepOuter gst (GO_KARP_RABIN_NEXT fs st rb rh cksum) = do
2032+ res <- step (adaptState gst) st
2033+ return
2034+ $ Skip
2035+ $ case res of
2036+ Yield x s -> GO_KARP_RABIN_NEXT_WITH fs s x rb rh cksum
2037+ Skip s -> GO_KARP_RABIN_NEXT fs s rb rh cksum
2038+ Stop -> GO_KARP_RABIN_DRAIN patLen fs rb rh
2039+ stepOuter _ (GO_KARP_RABIN_DRAIN 0 fs _ _) = do
2040+ r <- done fs
2041+ return $ Skip $ GO_YIELD r GO_DONE
2042+ stepOuter _ (GO_KARP_RABIN_DRAIN n fs rb rh) = do
2043+ old <- liftIO $ peek rh
2044+ let rh1 = RB.advance rb rh
2045+ fres <- fstep fs old
2046+ return $ Skip $ GO_KARP_RABIN_DRAIN (n - 1) fres rb rh1
2047+ stepOuter _ _ = undefined
2048+
2049+data SplitOnState1 s a =
2050+ GO_START1
2051+ | GO_EMPTY_PAT1 s
2052+ | GO_SINGLE_PAT s a
2053+ | GO_SHORT_PAT s
2054+ | GO_KARP_RABIN s !(RB.Ring a) !(Ptr a)
2055+ | GO_DONE1
1976
2056
1977{-# INLINE_NORMAL splitSuffixOn #-}
2057{-# INLINE_NORMAL splitSuffixOn #-}
1978splitSuffixOn
2058splitSuffixOn
@@ -1984,7 +2064,7 @@ splitSuffixOn
1984 -> Stream m b
2064 -> Stream m b
1985splitSuffixOn withSep patArr (Fold fstep initial done)
2065splitSuffixOn withSep patArr (Fold fstep initial done)
1986 (Stream step state) =
2066 (Stream step state) =
1987− Stream stepOuter GO_START
2067+ Stream stepOuter GO_START1
1988
2068
1989 where
2069 where
1990
2070
@@ -1993,9 +2073,9 @@ splitSuffixOn withSep patArr (Fold fstep initial done)
1993 elemBits = sizeOf (undefined :: a) * 8
2073 elemBits = sizeOf (undefined :: a) * 8
1994
2074
1995 {-# INLINE_LATE stepOuter #-}
2075 {-# INLINE_LATE stepOuter #-}
1996− stepOuter _ GO_START =
2076+ stepOuter _ GO_START1 =
1997 if patLen == 0
2077 if patLen == 0
1998− then return $ Skip $ GO_EMPTY_PAT state
2078+ then return $ Skip $ GO_EMPTY_PAT1 state
1999 else if patLen == 1
2079 else if patLen == 1
2000 then do
2080 then do
2001 r <- liftIO $ (A.unsafeIndexIO patArr 0)
2081 r <- liftIO $ (A.unsafeIndexIO patArr 0)
@@ -2037,7 +2117,7 @@ splitSuffixOn withSep patArr (Fold fstep initial done)
2037 return $ Yield r (GO_SINGLE_PAT s pat)
2117 return $ Yield r (GO_SINGLE_PAT s pat)
2038 else fstep acc x >>= go SPEC s
2118 else fstep acc x >>= go SPEC s
2039 Skip s -> go SPEC s acc
2119 Skip s -> go SPEC s acc
2040− Stop -> done acc >>= \r -> return $ Yield r GO_DONE
2120+ Stop -> done acc >>= \r -> return $ Yield r GO_DONE1
2041
2121
2042 stepOuter gst (GO_SHORT_PAT stt) = do
2122 stepOuter gst (GO_SHORT_PAT stt) = do
2043
2123
@@ -2095,7 +2175,7 @@ splitSuffixOn withSep patArr (Fold fstep initial done)
2095 acc' <- if idx /= 0 && not withSep
2175 acc' <- if idx /= 0 && not withSep
2096 then go2 wrd idx acc
2176 then go2 wrd idx acc
2097 else return acc
2177 else return acc
2098− done acc' >>= \r -> return $ Yield r GO_DONE
2178+ done acc' >>= \r -> return $ Yield r GO_DONE1
2099
2179
2100 {-# INLINE go1 #-}
2180 {-# INLINE go1 #-}
2101 go1 !_ wrd st !acc = do
2181 go1 !_ wrd st !acc = do
@@ -2120,7 +2200,7 @@ splitSuffixOn withSep patArr (Fold fstep initial done)
2120 acc' <- if withSep
2200 acc' <- if withSep
2121 then return acc
2201 then return acc
2122 else go2 wrd patLen acc
2202 else go2 wrd patLen acc
2123− done acc' >>= \r -> return $ Yield r GO_DONE
2203+ done acc' >>= \r -> return $ Yield r GO_DONE1
2124
2204
2125 go2 !wrd !n !acc | n > 0 = do
2205 go2 !wrd !n !acc | n > 0 = do
2126 let old = (mask .&. wrd) `shiftR` (elemBits * (n - 1))
2206 let old = (mask .&. wrd) `shiftR` (elemBits * (n - 1))
@@ -2181,7 +2261,7 @@ splitSuffixOn withSep patArr (Fold fstep initial done)
2181 !acc' <- if idx /= 0 && not withSep
2261 !acc' <- if idx /= 0 && not withSep
2182 then RB.unsafeFoldRingM rh fstep acc rb
2262 then RB.unsafeFoldRingM rh fstep acc rb
2183 else return acc
2263 else return acc
2184− done acc' >>= \r -> return $ Yield r GO_DONE
2264+ done acc' >>= \r -> return $ Yield r GO_DONE1
2185
2265
2186 -- XXX Theoretically this code can do 4 times faster if GHC generates
2266 -- XXX Theoretically this code can do 4 times faster if GHC generates
2187 -- optimal code. If we use just "(cksum' == patHash)" condition it goes
2267 -- optimal code. If we use just "(cksum' == patHash)" condition it goes
@@ -2214,7 +2294,7 @@ splitSuffixOn withSep patArr (Fold fstep initial done)
2214 acc' <- if withSep
2294 acc' <- if withSep
2215 then return acc
2295 then return acc
2216 else RB.unsafeFoldRingFullM rh fstep acc rb
2296 else RB.unsafeFoldRingFullM rh fstep acc rb
2217− done acc' >>= \r -> return $ Yield r GO_DONE
2297+ done acc' >>= \r -> return $ Yield r GO_DONE1
2218
2298
2219 go2 !_ !cksum' !rh' s !acc' = do
2299 go2 !_ !cksum' !rh' s !acc' = do
2220 if RB.unsafeEqArray rb rh' patArr
2300 if RB.unsafeEqArray rb rh' patArr
@@ -2223,17 +2303,17 @@ splitSuffixOn withSep patArr (Fold fstep initial done)
2223 return $ Yield r (GO_KARP_RABIN s rb rhead)
2303 return $ Yield r (GO_KARP_RABIN s rb rhead)
2224 else go1 SPEC cksum' rh' s acc'
2304 else go1 SPEC cksum' rh' s acc'
2225
2305
2226− stepOuter gst (GO_EMPTY_PAT st) = do
2306+ stepOuter gst (GO_EMPTY_PAT1 st) = do
2227 res <- step (adaptState gst) st
2307 res <- step (adaptState gst) st
2228 case res of
2308 case res of
2229 Yield x s -> do
2309 Yield x s -> do
2230 acc <- initial
2310 acc <- initial
2231 acc' <- fstep acc x
2311 acc' <- fstep acc x
2232− done acc' >>= \r -> return $ Yield r (GO_EMPTY_PAT s)
2312+ done acc' >>= \r -> return $ Yield r (GO_EMPTY_PAT1 s)
2233− Skip s -> return $ Skip (GO_EMPTY_PAT s)
2313+ Skip s -> return $ Skip (GO_EMPTY_PAT1 s)
2234 Stop -> return Stop
2314 Stop -> return Stop
2235
2315
2236− stepOuter _ GO_DONE = return Stop
2316+ stepOuter _ GO_DONE1 = return Stop
2237
2317
2238data SplitState s arr
2318data SplitState s arr
2239 = SplitInitial s
2319 = SplitInitial s
src/Streamly/Memory/Ring.hs+19
@@ -12,6 +12,8 @@ module Streamly.Memory.Ring
12
12
13 -- * Construction
13 -- * Construction
14 , new
14 , new
15+ , advance
16+ , moveBy
15
17
16 -- * Modification
18 -- * Modification
17 , unsafeInsert
19 , unsafeInsert
@@ -79,6 +81,23 @@ advance Ring{..} ringHead =
79 then ptr
81 then ptr
80 else unsafeForeignPtrToPtr ringStart
82 else unsafeForeignPtrToPtr ringStart
81
83
84+-- | Move the ringHead by n items. The direction depends on the sign on whether
85+-- n is positive or negative. Wrap around if we hit the beginning or end of the
86+-- array.
87+{-# INLINE moveBy #-}
88+moveBy :: forall a. Storable a => Int -> Ring a -> Ptr a -> Ptr a
89+moveBy by Ring {..} ringHead = ringStartPtr `plusPtr` advanceFromHead
90+
91+ where
92+
93+ elemSize = sizeOf (undefined :: a)
94+ ringStartPtr = unsafeForeignPtrToPtr ringStart
95+ lenInBytes = ringBound `minusPtr` ringStartPtr
96+ offInBytes = ringHead `minusPtr` ringStartPtr
97+ len = assert (lenInBytes `mod` elemSize == 0) $ lenInBytes `div` elemSize
98+ off = assert (offInBytes `mod` elemSize == 0) $ offInBytes `div` elemSize
99+ advanceFromHead = (off + by `mod` len) * elemSize
100+
82-- | Insert an item at the head of the ring, when the ring is full this
101-- | Insert an item at the head of the ring, when the ring is full this
83-- replaces the oldest item in the ring with the new item. This is unsafe
102-- replaces the oldest item in the ring with the new item. This is unsafe
84-- beause ringHead supplied is not verified to be within the Ring. Also,
103-- beause ringHead supplied is not verified to be within the Ring. Also,