git.iko.soy/text
on master help sign in
Merge pull request #151 from harendra-kumar/master
7a0e002Bryan O'Sullivan
Data/Text/Internal/Fusion.hs+27−17
compare with master
unifiedsplit
@@ -98,25 +98,35 @@ reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `sh
98-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
98-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
99unstream :: Stream Char -> Text
99unstream :: Stream Char -> Text
100unstream (Stream next0 s0 len) = runText $ \done -> do
100unstream (Stream next0 s0 len) = runText $ \done -> do
101+ -- Before encoding each char we perform a buffer realloc check assuming
102+ -- worst case encoding size of two 16-bit units for the char. Just add an
103+ -- extra space to the buffer so that we do not end up reallocating even when
104+ -- all the chars are encoded as single unit.
101− let mlen = upperBound 4 len
105+ let mlen = upperBound 4 len + 1
102 arr0 <- A.new mlen
106 arr0 <- A.new mlen
103− let outer arr top = loop
107+ let outer !arr !maxi = encode
104 where
108 where
105− loop !s !i =
109+ -- keep the common case loop as small as possible
110+ encode !si !di =
106− case next0 s of
111+ case next0 si of
107− Done -> done arr i
112+ Done -> done arr di
108− Skip s' -> loop s' i
113+ Skip si' -> encode si' di
109− Yield x s'
114+ Yield c si'
110− | j >= top -> {-# SCC "unstream/resize" #-} do
115+ -- simply check for the worst case
111− let top' = (top + 1) `shiftL` 1
116+ | maxi < di + 1 -> realloc si di
117+ | otherwise -> do
118+ n <- unsafeWrite arr di c
119+ encode si' (di + n)
120+
121+ -- keep uncommon case separate from the common case code
122+ {-# NOINLINE realloc #-}
123+ realloc !si !di = do
124+ let newlen = (maxi + 1) * 2
112− arr' <- A.new top'
125+ arr' <- A.new newlen
113− A.copyM arr' 0 arr 0 top
126+ A.copyM arr' 0 arr 0 di
114− outer arr' top' s i
127+ outer arr' (newlen - 1) si di
115− | otherwise -> do d <- unsafeWrite arr i x
128+
116− loop s' (i+d)
117− where j | ord x < 0x10000 = i
118− | otherwise = i + 1
119− outer arr0 mlen s0 0
129+ outer arr0 (mlen - 1) s0 0
120{-# INLINE [0] unstream #-}
130{-# INLINE [0] unstream #-}
121{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
131{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
122
132
Data/Text/Internal/Fusion/Common.hs+3−3
@@ -669,12 +669,12 @@ scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT may
669-- ** Generating and unfolding streams
669-- ** Generating and unfolding streams
670
670
671replicateCharI :: Integral a => a -> Char -> Stream Char
671replicateCharI :: Integral a => a -> Char -> Stream Char
672−replicateCharI n c
672+replicateCharI !n !c
673 | n < 0 = empty
673 | n < 0 = empty
674 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
674 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
675 where
675 where
676− next i | i >= n = Done
676+ next !i | i >= n = Done
677− | otherwise = Yield c (i + 1)
677+ | otherwise = Yield c (i + 1)
678{-# INLINE [0] replicateCharI #-}
678{-# INLINE [0] replicateCharI #-}
679
679
680data RI s = RI !s {-# UNPACK #-} !Int64
680data RI s = RI !s {-# UNPACK #-} !Int64
benchmarks/haskell/Benchmarks.hs+1−1
@@ -53,7 +53,7 @@ benchmarks = do
53 , Mul.benchmark
53 , Mul.benchmark
54 , Pure.benchmark "tiny" (tf "tiny.txt")
54 , Pure.benchmark "tiny" (tf "tiny.txt")
55 , Pure.benchmark "ascii" (tf "ascii-small.txt")
55 , Pure.benchmark "ascii" (tf "ascii-small.txt")
56− , Pure.benchmark "france" (tf "france.html")
56+ -- , Pure.benchmark "france" (tf "france.html")
57 , Pure.benchmark "russian" (tf "russian-small.txt")
57 , Pure.benchmark "russian" (tf "russian-small.txt")
58 , Pure.benchmark "japanese" (tf "japanese.txt")
58 , Pure.benchmark "japanese" (tf "japanese.txt")
59 , ReadNumbers.benchmark (tf "numbers.txt")
59 , ReadNumbers.benchmark (tf "numbers.txt")
benchmarks/haskell/Benchmarks/Stream.hs+16−5
@@ -18,11 +18,11 @@ import qualified Data.Text.Encoding as T
18import qualified Data.Text.Encoding.Error as E
18import qualified Data.Text.Encoding.Error as E
19import qualified Data.Text.Internal.Encoding.Fusion as T
19import qualified Data.Text.Internal.Encoding.Fusion as T
20import qualified Data.Text.Internal.Encoding.Fusion.Common as F
20import qualified Data.Text.Internal.Encoding.Fusion.Common as F
21−import qualified Data.Text.Internal.Fusion as T
21+import qualified Data.Text.Internal.Fusion as F
22import qualified Data.Text.IO as T
22import qualified Data.Text.IO as T
23import qualified Data.Text.Lazy.Encoding as TL
23import qualified Data.Text.Lazy.Encoding as TL
24import qualified Data.Text.Internal.Lazy.Encoding.Fusion as TL
24import qualified Data.Text.Internal.Lazy.Encoding.Fusion as TL
25−import qualified Data.Text.Internal.Lazy.Fusion as TL
25+import qualified Data.Text.Internal.Lazy.Fusion as FL
26import qualified Data.Text.Lazy.IO as TL
26import qualified Data.Text.Lazy.IO as TL
27
27
28instance NFData a => NFData (Stream a) where
28instance NFData a => NFData (Stream a) where
@@ -53,14 +53,25 @@ benchmark fp = do
53 !utf32beL = TL.encodeUtf32BE tl
53 !utf32beL = TL.encodeUtf32BE tl
54
54
55 -- For the functions which operate on streams
55 -- For the functions which operate on streams
56− let !s = T.stream t
56+ let !s = F.stream t
57
57
58 return $ bgroup "Stream"
58 return $ bgroup "Stream"
59
59
60 -- Fusion
60 -- Fusion
61 [ bgroup "stream" $
61 [ bgroup "stream" $
62− [ bench "Text" $ nf T.stream t
62+ [ bench "Text" $ nf F.stream t
63+ , bench "LazyText" $ nf FL.stream tl
64+ ]
65+ -- must perform exactly the same as stream above due to
66+ -- stream/unstream (i.e. stream after unstream) fusion
67+ , bgroup "stream-fusion" $
68+ [ bench "Text" $ nf (F.stream . F.unstream . F.stream) t
63− , bench "LazyText" $ nf TL.stream tl
69+ , bench "LazyText" $ nf (FL.stream . FL.unstream . FL.stream) tl
70+ ]
71+ -- measure the overhead of unstream after stream
72+ , bgroup "stream-unstream" $
73+ [ bench "Text" $ nf (F.unstream . F.stream) t
74+ , bench "LazyText" $ nf (FL.unstream . FL.stream) tl
64 ]
75 ]
65
76
66 -- Encoding.Fusion
77 -- Encoding.Fusion