d2e7cbe · text · git.iko.soy

git.iko.soy/text

ZOMG size isn't everything.

--HG-- extra : convert_revision : 65b5b49140c23d2819817f3f618aa6c070ba13b6

commitd2e7cbecace1b4946fb579f899d88e1504b90b44 authorBryan O'Sullivan <bos@serpentine.com> dateFri 2 Oct 2009, 06:44 (17 years ago) parentd6db0be

10 files changed+201−54

compare with master

unifiedsplit

Data/Text/Encoding/Fusion.hs+10−8 Data/Text/Fusion.hs+11−9 Data/Text/Fusion/Common.hs+20−21 Data/Text/Fusion/Internal.hs+2−1 Data/Text/Fusion/Size.hs+129 Data/Text/Lazy/Encoding/Fusion.hs+4−6 Data/Text/Lazy/Fusion.hs+3−2 tests/Makefile+2−1 tests/Properties.hs+19−6 text.cabal+1

Data/Text/Encoding/Fusion.hs+10−8

@@ -35,10 +35,11 @@ import Control.Exception (assert)

3535import Data.ByteString as B

3636import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)

3737import Data.Text.Fusion (Step(..), Stream(..))

38+import Data.Text.Fusion.Size

3839import Data.Text.Encoding.Error

3940import Data.Text.Encoding.Fusion.Common

4041import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)

41−import Data.Text.UnsafeShift (shiftL)

42+import Data.Text.UnsafeShift (shiftL, shiftR)

4243import Data.Word (Word8, Word16, Word32)

4344import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)

4445import Foreign.Storable (pokeByteOff)

@@ -50,7 +51,7 @@ import qualified Data.Text.Encoding.Utf16 as U16

5051import qualified Data.Text.Encoding.Utf32 as U32

5152

5253streamASCII :: ByteString -> Stream Char

53−streamASCII bs = Stream next 0 l

54+streamASCII bs = Stream next 0 (maxSize l)

5455 where

5556 l = B.length bs

5657 {-# INLINE next #-}

@@ -64,7 +65,7 @@ streamASCII bs = Stream next 0 l

6465-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8

6566-- encoding.

6667streamUtf8 :: OnDecodeError -> ByteString -> Stream Char

67−streamUtf8 onErr bs = Stream next 0 l

68+streamUtf8 onErr bs = Stream next 0 (maxSize l)

6869 where

6970 l = B.length bs

7071 {-# INLINE next #-}

@@ -87,7 +88,7 @@ streamUtf8 onErr bs = Stream next 0 l

8788-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little

8889-- endian UTF-16 encoding.

8990streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char

90−streamUtf16LE onErr bs = Stream next 0 l

91+streamUtf16LE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))

9192 where

9293 l = B.length bs

9394 {-# INLINE next #-}

@@ -105,7 +106,7 @@ streamUtf16LE onErr bs = Stream next 0 l

105106-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big

106107-- endian UTF-16 encoding.

107108streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char

108−streamUtf16BE onErr bs = Stream next 0 l

109+streamUtf16BE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))

109110 where

110111 l = B.length bs

111112 {-# INLINE next #-}

@@ -123,7 +124,7 @@ streamUtf16BE onErr bs = Stream next 0 l

123124-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big

124125-- endian UTF-32 encoding.

125126streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char

126−streamUtf32BE onErr bs = Stream next 0 l

127+streamUtf32BE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))

127128 where

128129 l = B.length bs

129130 {-# INLINE next #-}

@@ -143,7 +144,7 @@ streamUtf32BE onErr bs = Stream next 0 l

143144-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little

144145-- endian UTF-32 encoding.

145146streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char

146−streamUtf32LE onErr bs = Stream next 0 l

147+streamUtf32LE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))

147148 where

148149 l = B.length bs

149150 {-# INLINE next #-}

@@ -163,7 +164,8 @@ streamUtf32LE onErr bs = Stream next 0 l

163164-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.

164165unstream :: Stream Word8 -> ByteString

165166unstream (Stream next s0 len) = unsafePerformIO $ do

166− mallocByteString len >>= loop len 0 s0

167+ let mlen = upperBound 4 len

168+ mallocByteString mlen >>= loop mlen 0 s0

167169 where

168170 loop !n !off !s fp = case next s of

169171 Done -> trimUp fp n off

Data/Text/Fusion.hs+11−9

@@ -47,7 +47,7 @@ module Data.Text.Fusion

4747 , countChar

4848 ) where

4949

50−import Prelude (Bool(..), Char, Eq(..), Maybe(..), Monad(..), Int,

50+import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,

5151 Num(..), Ord(..), ($), (&&),

5252 fromIntegral, otherwise)

5353import Data.Bits ((.&.))

@@ -58,6 +58,7 @@ import Data.Text.UnsafeShift (shiftR)

5858import qualified Data.Text.Array as A

5959import qualified Data.Text.Fusion.Common as S

6060import Data.Text.Fusion.Internal

61+import Data.Text.Fusion.Size

6162import qualified Data.Text.Internal as I

6263import qualified Data.Text.Encoding.Utf16 as U16

6364import qualified Prelude as P

@@ -66,7 +67,7 @@ default(Int)

6667

6768-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.

6869stream :: Text -> Stream Char

69−stream (Text arr off len) = Stream next off len

70+stream (Text arr off len) = Stream next off (maxSize len)

7071 where

7172 end = off+len

7273 {-# INLINE next #-}

@@ -82,7 +83,7 @@ stream (Text arr off len) = Stream next off len

8283-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate

8384-- backwards.

8485reverseStream :: Text -> Stream Char

85−reverseStream (Text arr off len) = Stream next (off+len-1) len

86+reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)

8687 where

8788 {-# INLINE next #-}

8889 next !i

@@ -97,10 +98,11 @@ reverseStream (Text arr off len) = Stream next (off+len-1) len

9798-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.

9899unstream :: Stream Char -> Text

99100unstream (Stream next0 s0 len)

100− | len == 0 = I.empty

101− | otherwise = I.textP (P.fst a) 0 (P.snd a)

101+ | isEmpty len = I.empty

102+ | otherwise = I.textP (P.fst a) 0 (P.snd a)

102103 where

103− a = A.run2 (A.unsafeNew len >>= (\arr -> loop arr len s0 0))

104+ mlen = upperBound 4 len

105+ a = A.run2 (A.unsafeNew mlen >>= (\arr -> loop arr mlen s0 0))

104106 loop arr !top !s !i

105107 | i + 1 >= top = case next0 s of

106108 Done -> return (arr, i)

@@ -125,10 +127,10 @@ length = S.lengthI

125127-- | /O(n)/ Reverse the characters of a string.

126128reverse :: Stream Char -> Text

127129reverse (Stream next s len0)

128− | len0 == 0 = I.empty

129− | otherwise = I.textP arr off' len'

130+ | isEmpty len0 = I.empty

131+ | otherwise = I.textP arr off' len'

130132 where

131− len0' = max len0 4

133+ len0' = upperBound 4 (larger len0 4)

132134 (arr, (off', len')) = A.run2 (A.unsafeNew len0' >>= loop s (len0'-1) len0')

133135 loop !s0 !i !len marr =

134136 case next s0 of

Data/Text/Fusion/Common.hs+20−21

@@ -108,9 +108,10 @@ import qualified Prelude as P

108108import Data.Int (Int64)

109109import Data.Text.Fusion.Internal

110110import Data.Text.Fusion.CaseMapping (foldMapping, lowerMapping, upperMapping)

111+import Data.Text.Fusion.Size

111112

112113singleton :: Char -> Stream Char

113−singleton c = Stream next False 1 -- HINT maybe too low

114+singleton c = Stream next False 1

114115 where next False = Yield c True

115116 next True = Done

116117{-# INLINE singleton #-}

@@ -118,10 +119,9 @@ singleton c = Stream next False 1 -- HINT maybe too low

118119streamList :: [a] -> Stream a

119120{-# INLINE [0] streamList #-}

120121streamList [] = empty

121−streamList s = Stream next s unknownLength

122+streamList s = Stream next s unknownSize

122123 where next [] = Done

123124 next (x:xs) = Yield x xs

124− unknownLength = 8 -- random HINT

125125

126126unstreamList :: Stream a -> [a]

127127{-# INLINE [0] unstreamList #-}

@@ -138,7 +138,7 @@ unstreamList (Stream next s0 _len) = unfold s0

138138

139139-- | /O(n)/ Adds a character to the front of a Stream Char.

140140cons :: Char -> Stream Char -> Stream Char

141−cons w (Stream next0 s0 len) = Stream next (S2 :!: s0) (len+2) -- HINT maybe too high

141+cons w (Stream next0 s0 len) = Stream next (S2 :!: s0) (len+1)

142142 where

143143 {-# INLINE next #-}

144144 next (S2 :!: s) = Yield w (S1 :!: s)

@@ -150,7 +150,7 @@ cons w (Stream next0 s0 len) = Stream next (S2 :!: s0) (len+2) -- HINT maybe too

150150

151151-- | /O(n)/ Adds a character to the end of a stream.

152152snoc :: Stream Char -> Char -> Stream Char

153−snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+2) -- HINT maybe too high

153+snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)

154154 where

155155 {-# INLINE next #-}

156156 next (J xs) = case next0 xs of

@@ -193,7 +193,7 @@ uncons :: Stream Char -> Maybe (Char, Stream Char)

193193uncons (Stream next s0 len) = loop_uncons s0

194194 where

195195 loop_uncons !s = case next s of

196− Yield x s1 -> Just (x, Stream next s1 (len-1)) -- HINT maybe too high

196+ Yield x s1 -> Just (x, Stream next s1 (len-1))

197197 Skip s' -> loop_uncons s'

198198 Done -> Nothing

199199{-# INLINE [0] uncons #-}

@@ -216,7 +216,7 @@ last (Stream next s0 _len) = loop0_last s0

216216-- | /O(1)/ Returns all characters after the head of a Stream Char, which must

217217-- be non-empty.

218218tail :: Stream Char -> Stream Char

219−tail (Stream next0 s0 len) = Stream next (False :!: s0) (len-1) -- HINT maybe too high

219+tail (Stream next0 s0 len) = Stream next (False :!: s0) (len-1)

220220 where

221221 {-# INLINE next #-}

222222 next (False :!: s) = case next0 s of

@@ -233,7 +233,7 @@ tail (Stream next0 s0 len) = Stream next (False :!: s0) (len-1) -- HINT maybe to

233233-- | /O(1)/ Returns all but the last character of a Stream Char, which

234234-- must be non-empty.

235235init :: Stream Char -> Stream Char

236−init (Stream next0 s0 len) = Stream next (N :!: s0) (len-1) -- HINT maybe too high

236+init (Stream next0 s0 len) = Stream next (N :!: s0) (len-1)

237237 where

238238 {-# INLINE next #-}

239239 next (N :!: s) = case next0 s of

@@ -269,10 +269,10 @@ lengthI (Stream next s0 _len) = loop_length 0 s0

269269-- ----------------------------------------------------------------------------

270270-- * Stream transformations

271271

272−-- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@ to each element of

273−-- @xs@.

272+-- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@

273+-- to each element of @xs@.

274274map :: (Char -> Char) -> Stream Char -> Stream Char

275−map f (Stream next0 s0 len) = Stream next s0 len -- HINT depends on f

275+map f (Stream next0 s0 len) = Stream next s0 len

276276 where

277277 {-# INLINE next #-}

278278 next !s = case next0 s of

@@ -289,7 +289,7 @@ map f (Stream next0 s0 len) = Stream next s0 len -- HINT depends on f

289289-- | /O(n)/ Take a character and place it between each of the

290290-- characters of a 'Stream Char'.

291291intersperse :: Char -> Stream Char -> Stream Char

292−intersperse c (Stream next0 s0 len) = Stream next (s0 :!: N :!: S1) len -- HINT maybe too low

292+intersperse c (Stream next0 s0 len) = Stream next (s0 :!: N :!: S1) len

293293 where

294294 {-# INLINE next #-}

295295 next (s :!: N :!: S1) = case next0 s of

@@ -364,11 +364,9 @@ toLower = caseConvert lowerMapping

364364{-# INLINE [0] toLower #-}

365365

366366justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char

367−justifyLeftI k c (Stream next0 s0 len) = Stream next (s0 :!: S1 :!: 0) newLen

367+justifyLeftI k c (Stream next0 s0 len) =

368+ Stream next (s0 :!: S1 :!: 0) (larger (fromIntegral k) len)

368369 where

369− j = fromIntegral k

370− newLen | j > len = j

371− | otherwise = len

372370 next (s :!: S1 :!: n) =

373371 case next0 s of

374372 Done -> next (s :!: S2 :!: n)

@@ -590,7 +588,7 @@ replicateCharI n c

590588

591589replicateI :: Int64 -> Stream Char -> Stream Char

592590replicateI n (Stream next0 s0 len) =

593− Stream next (0 :!: s0) (max 0 (fromIntegral n * len))

591+ Stream next (0 :!: s0) (fromIntegral (max 0 n) * len)

594592 where

595593 next (k :!: s)

596594 | k >= n = Done

@@ -638,7 +636,7 @@ unfoldrNI n f s0 | n < 0 = empty

638636-- length of the stream.

639637take :: Integral a => a -> Stream Char -> Stream Char

640638take n0 (Stream next0 s0 len) =

641− Stream next (n0 :!: s0) (max 0 (len - fromIntegral n0)) -- HINT maybe too high

639+ Stream next (n0 :!: s0) (smaller len (fromIntegral (max 0 n0)))

642640 where

643641 {-# INLINE next #-}

644642 next (n :!: s) | n <= 0 = Done

@@ -653,11 +651,11 @@ take n0 (Stream next0 s0 len) =

653651-- length of the stream.

654652drop :: Integral a => a -> Stream Char -> Stream Char

655653drop n0 (Stream next0 s0 len) =

656− Stream next (J (max 0 n0) :!: s0) (len - fromIntegral n0) -- HINT maybe too high

654+ Stream next (J n0 :!: s0) (len - fromIntegral (max 0 n0))

657655 where

658656 {-# INLINE next #-}

659657 next (J n :!: s)

660− | n == 0 = Skip (N :!: s)

658+ | n <= 0 = Skip (N :!: s)

661659 | otherwise = case next0 s of

662660 Done -> Done

663661 Skip s' -> Skip (J n :!: s')

@@ -806,7 +804,8 @@ findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0

806804-- | zipWith generalises 'zip' by zipping with the function given as

807805-- the first argument, instead of a tupling function.

808806zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b

809−zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) = Stream next (sa0 :!: sb0 :!: N) (min len1 len2)

807+zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =

808+ Stream next (sa0 :!: sb0 :!: N) (smaller len1 len2)

810809 where

811810 {-# INLINE next #-}

812811 next (sa :!: sb :!: N) = case next0 sa of

Data/Text/Fusion/Internal.hs+2−1

@@ -25,6 +25,7 @@ module Data.Text.Fusion.Internal

2525 , empty

2626 ) where

2727

28+import Data.Text.Fusion.Size

2829import Data.Word (Word8)

2930

3031-- | Specialised, strict Maybe-like type.

@@ -76,7 +77,7 @@ data Stream a =

7677 forall s. Stream

7778 (s -> Step s a) -- stepper function

7879 !s -- current state

79− {-# UNPACK #-}!Int -- length hint

80+ {-# UNPACK #-} !Size -- size hint

8081

8182-- | /O(n)/ Determines if two streams are equal.

8283eq :: (Eq a) => Stream a -> Stream a -> Bool

Data/Text/Fusion/Size.hsnew file+129

@@ -0,0 +1,129 @@

1+{-# OPTIONS_GHC -fno-warn-missing-methods #-}

2+-- |

3+-- Module : Data.Text.Fusion.Internal

4+-- Copyright : (c) Roman Leshchinskiy 2008,

5+-- (c) Bryan O'Sullivan 2009

6+--

7+-- License : BSD-style

8+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,

9+-- duncan@haskell.org

10+-- Stability : experimental

11+-- Portability : portable

12+--

13+-- Size hints.

14+

15+module Data.Text.Fusion.Size

16+ (

17+ Size

18+ , exactSize

19+ , maxSize

20+ , unknownSize

21+ , smaller

22+ , larger

23+ , toMax

24+ , upperBound

25+ , lowerBound

26+ , isEmpty

27+ ) where

28+

29+import Control.Exception (assert)

30+

31+data Size = Exact {-# UNPACK #-} !Int -- ^ Exact size.

32+ | Max {-# UNPACK #-} !Int -- ^ Upper bound on size.

33+ | Unknown -- ^ Unknown size.

34+ deriving (Eq, Show)

35+

36+exactSize :: Int -> Size

37+exactSize n = assert (n >= 0) Exact n

38+{-# INLINE exactSize #-}

39+

40+maxSize :: Int -> Size

41+maxSize n = assert (n >= 0) Max n

42+{-# INLINE maxSize #-}

43+

44+unknownSize :: Size

45+unknownSize = Unknown

46+{-# INLINE unknownSize #-}

47+

48+instance Num Size where

49+ (+) = addSize

50+ (-) = subtractSize

51+ (*) = mulSize

52+

53+ fromInteger = f where f = Exact . fromInteger

54+ {-# INLINE f #-}

55+

56+addSize :: Size -> Size -> Size

57+addSize (Exact m) (Exact n) = Exact (m+n)

58+addSize (Exact m) (Max n) = Max (m+n)

59+addSize (Max m) (Exact n) = Max (m+n)

60+addSize (Max m) (Max n) = Max (m+n)

61+addSize _ _ = Unknown

62+{-# INLINE addSize #-}

63+

64+subtractSize :: Size -> Size -> Size

65+subtractSize (Exact m) (Exact n) = Exact (max (m-n) 0)

66+subtractSize (Exact m) (Max _) = Max m

67+subtractSize (Max m) (Exact n) = Max (max (m-n) 0)

68+subtractSize a@(Max _) (Max _) = a

69+subtractSize a@(Max _) Unknown = a

70+subtractSize _ _ = Unknown

71+{-# INLINE subtractSize #-}

72+

73+mulSize :: Size -> Size -> Size

74+mulSize (Exact m) (Exact n) = Exact (m*n)

75+mulSize (Exact m) (Max n) = Max (m*n)

76+mulSize (Max m) (Exact n) = Max (m*n)

77+mulSize (Max m) (Max n) = Max (m*n)

78+mulSize _ _ = Unknown

79+{-# INLINE mulSize #-}

80+

81+-- | Minimum of two size hints.

82+smaller :: Size -> Size -> Size

83+smaller (Exact m) (Exact n) = Exact (m `min` n)

84+smaller (Exact m) (Max n) = Max (m `min` n)

85+smaller (Exact m) Unknown = Max m

86+smaller (Max m) (Exact n) = Max (m `min` n)

87+smaller (Max m) (Max n) = Max (m `min` n)

88+smaller a@(Max _) Unknown = a

89+smaller Unknown (Exact n) = Max n

90+smaller Unknown (Max n) = Max n

91+smaller Unknown Unknown = Unknown

92+{-# INLINE smaller #-}

93+

94+-- | Maximum of two size hints.

95+larger :: Size -> Size -> Size

96+larger (Exact m) (Exact n) = Exact (m `max` n)

97+larger a@(Exact m) b@(Max n) | m >= n = a

98+ | otherwise = b

99+larger a@(Max m) b@(Exact n) | n >= m = b

100+ | otherwise = a

101+larger (Max m) (Max n) = Max (m `max` n)

102+larger _ _ = Unknown

103+{-# INLINE larger #-}

104+

105+-- | Convert a size hint to an upper bound.

106+toMax :: Size -> Size

107+toMax (Exact n) = Max n

108+toMax a@(Max _) = a

109+toMax Unknown = Unknown

110+{-# INLINE toMax #-}

111+

112+-- | Compute the minimum size from a size hint.

113+lowerBound :: Size -> Int

114+lowerBound (Exact n) = n

115+lowerBound _ = 0

116+{-# INLINE lowerBound #-}

117+

118+-- | Compute the maximum size from a size hint, if possible.

119+upperBound :: Int -> Size -> Int

120+upperBound _ (Exact n) = n

121+upperBound _ (Max n) = n

122+upperBound k _ = k

123+{-# INLINE upperBound #-}

124+

125+isEmpty :: Size -> Bool

126+isEmpty (Exact n) = n <= 0

127+isEmpty (Max n) = n <= 0

128+isEmpty _ = False

129+{-# INLINE isEmpty #-}

Data/Text/Lazy/Encoding/Fusion.hs+4−6

@@ -36,6 +36,7 @@ import Data.Text.Encoding.Fusion.Common

3636import Data.Text.Encoding.Error

3737import Data.Text.Fusion (Step(..), Stream(..))

3838import Data.Text.Fusion.Internal (M(..), PairS(..), S(..))

39+import Data.Text.Fusion.Size

3940import Data.Text.UnsafeChar (unsafeChr8)

4041import Data.Word (Word8)

4142import qualified Data.Text.Encoding.Utf8 as U8

@@ -46,13 +47,10 @@ import Data.ByteString.Internal (mallocByteString, memcpy)

4647import Control.Exception (assert)

4748import qualified Data.ByteString.Internal as B

4849

49−unknownLength :: Int

50−unknownLength = 4

51−

5250-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using

5351-- UTF-8 encoding.

5452streamUtf8 :: OnDecodeError -> ByteString -> Stream Char

55−streamUtf8 onErr bs0 = Stream next (bs0 :!: empty :!: 0) unknownLength

53+streamUtf8 onErr bs0 = Stream next (bs0 :!: empty :!: 0) unknownSize

5654 where

5755 empty = S N N N N

5856 {-# INLINE next #-}

@@ -100,9 +98,9 @@ streamUtf8 onErr bs0 = Stream next (bs0 :!: empty :!: 0) unknownLength

10098

10199-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.

102100unstreamChunks :: Int -> Stream Word8 -> ByteString

103−unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 len0

101+unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)

104102 where chunk s1 len1 = unsafePerformIO $ do

105− let len = min (max len1 unknownLength) chunkSize

103+ let len = min len1 chunkSize

106104 mallocByteString len >>= loop len 0 s1

107105 where

108106 loop !n !off !s fp = case next s of

Data/Text/Lazy/Fusion.hs+3−2

@@ -28,6 +28,7 @@ module Data.Text.Lazy.Fusion

2828import Prelude hiding (length)

2929import qualified Data.Text.Fusion.Common as S

3030import Data.Text.Fusion.Internal

31+import Data.Text.Fusion.Size (isEmpty)

3132import Data.Text.Lazy.Internal

3233import qualified Data.Text.Internal as I

3334import qualified Data.Text.Array as A

@@ -52,8 +53,8 @@ stream text = Stream next (text :!: 0) 4 -- random HINT

5253-- chunk size.

5354unstreamChunks :: Int -> Stream Char -> Text

5455unstreamChunks chunkSize (Stream next s0 len0)

55− | len0 == 0 = Empty

56− | otherwise = outer s0

56+ | isEmpty len0 = Empty

57+ | otherwise = outer s0

5758 where

5859 outer s = case next s of

5960 Done -> Empty

tests/Makefile+2−1

@@ -3,7 +3,8 @@ ghc := ghc

33ghc-opt-flags = -O0

44ghc-base-flags := -funbox-strict-fields -package criterion \

55 -package bytestring -package QuickCheck -package test-framework \

6− -package test-framework-quickcheck -ignore-package text

6+ -package test-framework-quickcheck -ignore-package text \

7+ -fno-ignore-asserts

78ghc-base-flags += -Wall -fno-warn-orphans -fno-warn-missing-signatures

89ghc-flags := $(ghc-base-flags) -i../dist/build -package-name text-$(version)

910ghc-hpc-flags := $(ghc-base-flags) -fhpc -fno-ignore-asserts -odir hpcdir \

tests/Properties.hs+19−6

@@ -18,6 +18,7 @@ import qualified Data.Text.Encoding as E

1818import Control.Exception (SomeException, try)

1919import qualified Data.Text.Fusion as S

2020import qualified Data.Text.Fusion.Common as S

21+import Data.Text.Fusion.Size

2122import qualified Data.Text.Lazy.Encoding as EL

2223import qualified Data.Text.Lazy.Fusion as SL

2324import qualified Data.Text.UnsafeShift as U

@@ -28,7 +29,7 @@ import Test.Framework (defaultMain, testGroup)

2829import Test.Framework.Providers.QuickCheck (testProperty)

2930import Data.Text.Search

3031

31−import QuickCheckUtils (NotEmpty(..))

32+import QuickCheckUtils (NotEmpty(..), small)

3233

3334-- Ensure that two potentially bottom values (in the sense of crashing

3435-- for some inputs, not looping infinitely) either both crash, or both

@@ -118,8 +119,8 @@ eqP f g s w = eql "orig" (f s) (g t) &&

118119-- For tests that have O(n^2) running times or input sizes, resize

119120-- their inputs to the square root of the originals.

120121unsquare :: (Arbitrary a, Show a, Testable b) => (a -> b) -> Property

121−unsquare = forAll . sized $ \n -> resize (smaller n) arbitrary

122− where smaller = round . (sqrt :: Double -> Double) . fromIntegral

122+unsquare = forAll . sized $ \n -> resize (smallish n) arbitrary

123+ where smallish = round . (sqrt :: Double -> Double) . fromIntegral

123124

124125s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)

125126 where _types = s :: String

@@ -147,6 +148,7 @@ t_IsString = fromString `eqP` (T.unpack . fromString)

147148tl_IsString = fromString `eqP` (TL.unpack . fromString)

148149

149150s_cons x = (x:) `eqP` (unpackS . S.cons x)

151+s_cons_s x = (x:) `eqP` (unpackS . S.unstream . S.cons x)

150152sf_cons p x = ((x:) . L.filter p) `eqP` (unpackS . S.cons x . S.filter p)

151153t_cons x = (x:) `eqP` (unpackS . T.cons x)

152154tl_cons x = (x:) `eqP` (unpackS . TL.cons x)

@@ -338,14 +340,21 @@ unpack2 :: (Stringy s) => (s,s) -> (String,String)

338340unpack2 = unpackS *** unpackS

339341

340342s_take n = L.take n `eqP` (unpackS . S.take n)

343+s_take_s m = L.take n `eqP` (unpackS . S.unstream . S.take n)

344+ where n = small m

341345sf_take p n = (L.take n . L.filter p) `eqP` (unpackS . S.take n . S.filter p)

342346t_take n = L.take n `eqP` (unpackS . T.take n)

343347tl_take n = L.take n `eqP` (unpackS . TL.take (fromIntegral n))

344348s_drop n = L.drop n `eqP` (unpackS . S.drop n)

349+s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)

350+ where n = small m

345351sf_drop p n = (L.drop n . L.filter p) `eqP` (unpackS . S.drop n . S.filter p)

346352t_drop n = L.drop n `eqP` (unpackS . T.drop n)

347353tl_drop n = L.drop n `eqP` (unpackS . TL.drop (fromIntegral n))

348−s_take_drop n = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)

354+s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)

355+ where n = small m

356+s_take_drop_s m = (L.take n . L.drop n) `eqP` (unpackS . S.unstream . S.take n . S.drop n)

357+ where n = small m

349358s_takeWhile p = L.takeWhile p `eqP` (unpackS . S.takeWhile p)

350359sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP` (unpackS . S.takeWhile p . S.filter q)

351360t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)

@@ -517,8 +526,8 @@ s_filter_eq s = S.filter p t == S.streamList (filter p s)

517526-- themselves.

518527shorten :: Int -> S.Stream a -> S.Stream a

519528shorten n t@(S.Stream arr off len)

520− | n < len && n > 0 = S.Stream arr off n

521− | otherwise = t

529+ | n > 0 = S.Stream arr off (smaller (exactSize n) len)

530+ | otherwise = t

522531

523532main = defaultMain tests

524533

@@ -568,6 +577,7 @@ tests = [

568577

569578 testGroup "basics" [

570579 testProperty "s_cons" s_cons,

580+ testProperty "s_cons_s" s_cons_s,

571581 testProperty "sf_cons" sf_cons,

572582 testProperty "t_cons" t_cons,

573583 testProperty "tl_cons" tl_cons,

@@ -726,14 +736,17 @@ tests = [

726736 testGroup "substrings" [

727737 testGroup "breaking" [

728738 testProperty "s_take" s_take,

739+ testProperty "s_take_s" s_take_s,

729740 testProperty "sf_take" sf_take,

730741 testProperty "t_take" t_take,

731742 testProperty "tl_take" tl_take,

732743 testProperty "s_drop" s_drop,

744+ testProperty "s_drop_s" s_drop_s,

733745 testProperty "sf_drop" sf_drop,

734746 testProperty "t_drop" t_drop,

735747 testProperty "tl_drop" tl_drop,

736748 testProperty "s_take_drop" s_take_drop,

749+ testProperty "s_take_drop_s" s_take_drop_s,

737750 testProperty "s_takeWhile" s_takeWhile,

738751 testProperty "sf_takeWhile" sf_takeWhile,

739752 testProperty "t_takeWhile" t_takeWhile,

text.cabal+1

@@ -33,6 +33,7 @@ library

3333 Data.Text.Fusion.CaseMapping

3434 Data.Text.Fusion.Common

3535 Data.Text.Fusion.Internal

36+ Data.Text.Fusion.Size

3637 Data.Text.Internal

3738 Data.Text.Lazy.Encoding.Fusion

3839 Data.Text.Lazy.Fusion