git.iko.soy/text
on master help sign in
Rewrite mapAccumL to be fast

--HG-- extra : convert_revision : 22349a191c458b3d567ebd256dd741e29011fb62

commit3e619a586b094b557089c6568de7c10997e2c52b authorBryan O'Sullivan <bos@serpentine.com> dateMon 13 Sep 2010, 00:25 (16 years ago) parent75fa760
3 files changed+53−7
compare with master
unifiedsplit
Data/Text.hs+2−7 Data/Text/Fusion.hs+30 tests/benchmarks/StripBrackets.hs+21
Data/Text.hs+2−7
@@ -781,16 +781,11 @@ scanr1 f t | null t = empty
781781 | otherwise = scanr f (last t) (init t)
782782{-# INLINE scanr1 #-}
783783
784−-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a
784+-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
785785-- function to each element of a 'Text', passing an accumulating
786786-- parameter from left to right, and returns a final 'Text'.
787787mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
788−mapAccumL f = go
789− where go s t = case uncons t of
790− Nothing -> (s, empty)
791− Just (x, xs) -> (s'', cons y ys)
792− where (s', y ) = f s x
793− (s'',ys) = go s' xs
788+mapAccumL f z0 = S.mapAccumL f z0 . stream
794789{-# INLINE mapAccumL #-}
795790
796791-- | The 'mapAccumR' function behaves like a combination of 'map' and
Data/Text/Fusion.hs+30
@@ -34,6 +34,9 @@ module Data.Text.Fusion
3434 -- ** Scans
3535 , reverseScanr
3636
37+ -- ** Accumulating maps
38+ , mapAccumL
39+
3740 -- ** Generation and unfolding
3841 , unfoldrN
3942
@@ -199,3 +202,30 @@ findIndex = S.findIndexI
199202countChar :: Char -> Stream Char -> Int
200203countChar = S.countCharI
201204{-# INLINE [0] countChar #-}
205+
206+-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
207+-- function to each element of a 'Text', passing an accumulating
208+-- parameter from left to right, and returns a final 'Text'.
209+mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)
210+mapAccumL f z0 (Stream next0 s0 len) = (nz,I.textP na 0 nl)
211+ where
212+ (na,(nz,nl)) = A.run2 (A.unsafeNew mlen >>= \arr -> outer arr mlen z0 s0 0)
213+ where mlen = upperBound 4 len
214+ outer arr top = loop
215+ where
216+ loop !z !s !i =
217+ case next0 s of
218+ Done -> return (arr, (z,i))
219+ Skip s' -> loop z s' i
220+ Yield x s'
221+ | j >= top -> {-# SCC "mapAccumL/resize" #-} do
222+ let top' = (top + 1) `shiftL` 1
223+ arr' <- A.unsafeNew top'
224+ A.copyM arr' 0 arr 0 top
225+ outer arr' top' z s i
226+ | otherwise -> do let (z',c) = f z x
227+ d <- unsafeWrite arr i c
228+ loop z' s' (i+d)
229+ where j | ord x < 0x10000 = i
230+ | otherwise = i + 1
231+{-# INLINE [0] mapAccumL #-}
tests/benchmarks/StripBrackets.hsnew file+21
@@ -0,0 +1,21 @@
1+-- From Petr Prokhorenkov.
2+
3+import Data.Text as T
4+import Data.Text.IO as T
5+
6+stripBrackets :: T.Text -> T.Text
7+stripBrackets text = snd $ T.mapAccumL f 0 text where
8+ f depth c = let
9+ depth' = depth + d' c
10+ c' | depth > 0 || depth' > 0 = ' '
11+ | otherwise = c
12+ in
13+ (depth', c')
14+
15+ d' '{' = 1
16+ d' '[' = 1
17+ d' '}' = -1
18+ d' ']' = -1
19+ d' _ = 0
20+
21+main = T.interact stripBrackets