on master help sign in
14 files changed+69−43
since splitsnapshots
unifiedsplit
Data/Text.hs+10−7 Data/Text/Array.hs+1−1 Data/Text/Internal/Builder.hs+3−1 Data/Text/Internal/Builder/Int/Digits.hs+1−1 Data/Text/Internal/Fusion.hs+27−17 Data/Text/Internal/Fusion/Common.hs+3−3 Data/Text/Lazy.hs+2−2 Data/Text/Lazy/Builder.hs+1−1 Data/Text/Lazy/Builder/Int.hs+1−1 benchmarks/haskell/Benchmarks.hs+1−1 benchmarks/haskell/Benchmarks/Stream.hs+16−5 benchmarks/text-benchmarks.cabal+1−1 tests/text-tests.cabal+1−1 text.cabal+1−1
Data/Text.hs+10−7
@@ -238,6 +238,7 @@ import Data.ByteString (ByteString)
238238import qualified Data.Text.Lazy as L
239239import Data.Int (Int64)
240240#endif
241+import GHC.Base (eqInt, neInt, gtInt, geInt, ltInt, leInt)
241242#if __GLASGOW_HASKELL__ >= 708
242243import qualified GHC.Exts as Exts
243244#endif
@@ -571,7 +572,9 @@ isSingleton = S.isSingleton . stream
571572-- Subject to fusion.
572573length :: Text -> Int
573574length t = S.length (stream t)
574−{-# INLINE length #-}
575+{-# INLINE [0] length #-}
576+-- length needs to be phased after the compareN/length rules otherwise
577+-- it may inline before the rules have an opportunity to fire.
575578
576579-- | /O(n)/ Compare the count of characters in a 'Text' to a number.
577580-- Subject to fusion.
@@ -590,32 +593,32 @@ compareLength t n = S.compareLengthI (stream t) n
590593
591594{-# RULES
592595"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.
593− (==) (length t) n = compareLength t n == EQ
596+ eqInt (length t) n = compareLength t n == EQ
594597 #-}
595598
596599{-# RULES
597600"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.
598− (/=) (length t) n = compareLength t n /= EQ
601+ neInt (length t) n = compareLength t n /= EQ
599602 #-}
600603
601604{-# RULES
602605"TEXT <N/length -> compareLength/==LT" [~1] forall t n.
603− (<) (length t) n = compareLength t n == LT
606+ ltInt (length t) n = compareLength t n == LT
604607 #-}
605608
606609{-# RULES
607610"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.
608− (<=) (length t) n = compareLength t n /= GT
611+ leInt (length t) n = compareLength t n /= GT
609612 #-}
610613
611614{-# RULES
612615"TEXT >N/length -> compareLength/==GT" [~1] forall t n.
613− (>) (length t) n = compareLength t n == GT
616+ gtInt (length t) n = compareLength t n == GT
614617 #-}
615618
616619{-# RULES
617620"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.
618− (>=) (length t) n = compareLength t n /= LT
621+ geInt (length t) n = compareLength t n /= LT
619622 #-}
620623
621624-- -----------------------------------------------------------------------------
Data/Text/Array.hs+1−1
@@ -20,7 +20,7 @@
2020-- > import qualified Data.Text.Array as A
2121--
2222-- The names in this module resemble those in the 'Data.Array' family
23−-- of modules, but are shorter due to the assumption of qualifid
23+-- of modules, but are shorter due to the assumption of qualified
2424-- naming.
2525module Data.Text.Array
2626 (
Data/Text/Internal/Builder.hs+3−1
@@ -6,7 +6,7 @@
66-- Module : Data.Text.Internal.Builder
77-- Copyright : (c) 2013 Bryan O'Sullivan
88-- (c) 2010 Johan Tibell
9−-- License : BSD3-style (see LICENSE)
9+-- License : BSD-style (see LICENSE)
1010--
1111-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
1212-- Stability : experimental
@@ -242,6 +242,8 @@ flush = Builder $ \ k buf@(Buffer p o u l) ->
242242 !t = Text arr o u
243243 ts <- inlineInterleaveST (k b)
244244 return $! t : ts
245+{-# INLINE [1] flush #-}
246+-- defer inlining so that flush/flush rule may fire.
245247
246248------------------------------------------------------------------------
247249
Data/Text/Internal/Builder/Int/Digits.hs+1−1
@@ -2,7 +2,7 @@
22
33-- Module: Data.Text.Internal.Builder.Int.Digits
44-- Copyright: (c) 2013 Bryan O'Sullivan
5−-- License: BSD3
5+-- License: BSD-style
66-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
77-- Stability: experimental
88-- Portability: portable
Data/Text/Internal/Fusion.hs+27−17
@@ -98,25 +98,35 @@ reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `sh
9898-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
9999unstream :: Stream Char -> Text
100100unstream (Stream next0 s0 len) = runText $ \done -> do
101− let mlen = upperBound 4 len
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.
105+ let mlen = upperBound 4 len + 1
102106 arr0 <- A.new mlen
103− let outer arr top = loop
107+ let outer !arr !maxi = encode
104108 where
105− loop !s !i =
106− case next0 s of
107− Done -> done arr i
108− Skip s' -> loop s' i
109− Yield x s'
110− | j >= top -> {-# SCC "unstream/resize" #-} do
111− let top' = (top + 1) `shiftL` 1
112− arr' <- A.new top'
113− A.copyM arr' 0 arr 0 top
114− outer arr' top' s i
115− | otherwise -> do d <- unsafeWrite arr i x
116− loop s' (i+d)
117− where j | ord x < 0x10000 = i
118− | otherwise = i + 1
119− outer arr0 mlen s0 0
109+ -- keep the common case loop as small as possible
110+ encode !si !di =
111+ case next0 si of
112+ Done -> done arr di
113+ Skip si' -> encode si' di
114+ Yield c si'
115+ -- simply check for the worst case
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
125+ arr' <- A.new newlen
126+ A.copyM arr' 0 arr 0 di
127+ outer arr' (newlen - 1) si di
128+
129+ outer arr0 (mlen - 1) s0 0
120130{-# INLINE [0] unstream #-}
121131{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
122132
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
669669-- ** Generating and unfolding streams
670670
671671replicateCharI :: Integral a => a -> Char -> Stream Char
672−replicateCharI n c
672+replicateCharI !n !c
673673 | n < 0 = empty
674674 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
675675 where
676− next i | i >= n = Done
677− | otherwise = Yield c (i + 1)
676+ next !i | i >= n = Done
677+ | otherwise = Yield c (i + 1)
678678{-# INLINE [0] replicateCharI #-}
679679
680680data RI s = RI !s {-# UNPACK #-} !Int64
Data/Text/Lazy.hs+2−2
@@ -545,7 +545,7 @@ tail Empty = emptyError "tail"
545545 unstream (S.tail (stream t)) = tail t
546546 #-}
547547
548−-- | /O(1)/ Returns all but the last character of a 'Text', which must
548+-- | /O(n\/c)/ Returns all but the last character of a 'Text', which must
549549-- be non-empty. Subject to fusion.
550550init :: Text -> Text
551551init (Chunk t0 ts0) = go t0 ts0
@@ -581,7 +581,7 @@ isSingleton :: Text -> Bool
581581isSingleton = S.isSingleton . stream
582582{-# INLINE isSingleton #-}
583583
584−-- | /O(1)/ Returns the last character of a 'Text', which must be
584+-- | /O(n\/c)/ Returns the last character of a 'Text', which must be
585585-- non-empty. Subject to fusion.
586586last :: Text -> Char
587587last Empty = emptyError "last"
Data/Text/Lazy/Builder.hs+1−1
@@ -8,7 +8,7 @@
88-- Module : Data.Text.Lazy.Builder
99-- Copyright : (c) 2013 Bryan O'Sullivan
1010-- (c) 2010 Johan Tibell
11−-- License : BSD3-style (see LICENSE)
11+-- License : BSD-style (see LICENSE)
1212--
1313-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
1414-- Stability : experimental
Data/Text/Lazy/Builder/Int.hs+1−1
@@ -7,7 +7,7 @@
77-- Module: Data.Text.Lazy.Builder.Int
88-- Copyright: (c) 2013 Bryan O'Sullivan
99-- (c) 2011 MailRank, Inc.
10−-- License: BSD3
10+-- License: BSD-style
1111-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
1212-- Stability: experimental
1313-- Portability: portable
benchmarks/haskell/Benchmarks.hs+1−1
@@ -53,7 +53,7 @@ benchmarks = do
5353 , Mul.benchmark
5454 , Pure.benchmark "tiny" (tf "tiny.txt")
5555 , Pure.benchmark "ascii" (tf "ascii-small.txt")
56− , Pure.benchmark "france" (tf "france.html")
56+ -- , Pure.benchmark "france" (tf "france.html")
5757 , Pure.benchmark "russian" (tf "russian-small.txt")
5858 , Pure.benchmark "japanese" (tf "japanese.txt")
5959 , ReadNumbers.benchmark (tf "numbers.txt")
benchmarks/haskell/Benchmarks/Stream.hs+16−5
@@ -18,11 +18,11 @@ import qualified Data.Text.Encoding as T
1818import qualified Data.Text.Encoding.Error as E
1919import qualified Data.Text.Internal.Encoding.Fusion as T
2020import 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
2222import qualified Data.Text.IO as T
2323import qualified Data.Text.Lazy.Encoding as TL
2424import 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
2626import qualified Data.Text.Lazy.IO as TL
2727
2828instance NFData a => NFData (Stream a) where
@@ -53,14 +53,25 @@ benchmark fp = do
5353 !utf32beL = TL.encodeUtf32BE tl
5454
5555 -- For the functions which operate on streams
56− let !s = T.stream t
56+ let !s = F.stream t
5757
5858 return $ bgroup "Stream"
5959
6060 -- Fusion
6161 [ bgroup "stream" $
62− [ bench "Text" $ nf T.stream t
63− , bench "LazyText" $ nf TL.stream tl
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
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
6475 ]
6576
6677 -- Encoding.Fusion
benchmarks/text-benchmarks.cabal+1−1
@@ -3,7 +3,7 @@ version: 0.0.0.0
33synopsis: Benchmarks for the text package
44description: Benchmarks for the text package
55homepage: https://bitbucket.org/bos/text
6−license: BSD3
6+license: BSD2
77license-file: ../LICENSE
88author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
99 Bryan O'Sullivan <bos@serpentine.com>,
tests/text-tests.cabal+1−1
@@ -3,7 +3,7 @@ version: 0.0.0.0
33synopsis: Functional tests for the text package
44description: Functional tests for the text package
55homepage: https://github.com/bos/text
6−license: BSD3
6+license: BSD2
77license-file: ../LICENSE
88author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
99 Bryan O'Sullivan <bos@serpentine.com>,
text.cabal+1−1
@@ -31,7 +31,7 @@ description:
3131 the @text-icu@ package:
3232 <http://hackage.haskell.org/package/text-icu>
3333
34−license: BSD3
34+license: BSD2
3535license-file: LICENSE
3636author: Bryan O'Sullivan <bos@serpentine.com>
3737maintainer: Bryan O'Sullivan <bos@serpentine.com>