d2e7cbe · text · git.iko.soy

git.iko.soy/text

on master help sign in

ZOMG size isn't everything.

d2e7cbeBryan O'Sullivan17 years ago

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

compare with master

unifiedsplit

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

35import Data.ByteString as B

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

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

38+import Data.Text.Fusion.Size

38import Data.Text.Encoding.Error

39import Data.Text.Encoding.Error

39import Data.Text.Encoding.Fusion.Common

40import Data.Text.Encoding.Fusion.Common

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

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

41−import Data.Text.UnsafeShift (shiftL)

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

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

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

43import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)

44import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)

44import Foreign.Storable (pokeByteOff)

45import Foreign.Storable (pokeByteOff)

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

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

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

52streamASCII :: ByteString -> Stream Char

53streamASCII :: ByteString -> Stream Char

53−streamASCII bs = Stream next 0 l

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

54 where

55 where

55 l = B.length bs

56 l = B.length bs

56 {-# INLINE next #-}

57 {-# INLINE next #-}

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

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

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

65-- encoding.

66-- encoding.

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

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

67−streamUtf8 onErr bs = Stream next 0 l

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

68 where

69 where

69 l = B.length bs

70 l = B.length bs

70 {-# INLINE next #-}

71 {-# INLINE next #-}

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

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

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

88-- endian UTF-16 encoding.

89-- endian UTF-16 encoding.

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

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

90−streamUtf16LE onErr bs = Stream next 0 l

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

91 where

92 where

92 l = B.length bs

93 l = B.length bs

93 {-# INLINE next #-}

94 {-# INLINE next #-}

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

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

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

106-- endian UTF-16 encoding.

107-- endian UTF-16 encoding.

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

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

108−streamUtf16BE onErr bs = Stream next 0 l

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

109 where

110 where

110 l = B.length bs

111 l = B.length bs

111 {-# INLINE next #-}

112 {-# INLINE next #-}

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

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

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

124-- endian UTF-32 encoding.

125-- endian UTF-32 encoding.

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

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

126−streamUtf32BE onErr bs = Stream next 0 l

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

127 where

128 where

128 l = B.length bs

129 l = B.length bs

129 {-# INLINE next #-}

130 {-# INLINE next #-}

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

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

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

144-- endian UTF-32 encoding.

145-- endian UTF-32 encoding.

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

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

146−streamUtf32LE onErr bs = Stream next 0 l

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

147 where

148 where

148 l = B.length bs

149 l = B.length bs

149 {-# INLINE next #-}

150 {-# INLINE next #-}

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

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

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

164unstream :: Stream Word8 -> ByteString

165unstream :: Stream Word8 -> ByteString

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

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

167+ let mlen = upperBound 4 len

166− mallocByteString len >>= loop len 0 s0

168+ mallocByteString mlen >>= loop mlen 0 s0

167 where

169 where

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

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

169 Done -> trimUp fp n off

171 Done -> trimUp fp n off

Data/Text/Fusion.hs+11−9

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

47 , countChar

48 ) where

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

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

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

52 fromIntegral, otherwise)

53import Data.Bits ((.&.))

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

58import qualified Data.Text.Array as A

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

60import Data.Text.Fusion.Internal

61+import Data.Text.Fusion.Size

61import qualified Data.Text.Internal as I

62import qualified Data.Text.Internal as I

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

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

63import qualified Prelude as P

64import qualified Prelude as P

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

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

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

68stream :: Text -> Stream Char

69stream :: Text -> Stream Char

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

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

70 where

71 where

71 end = off+len

72 end = off+len

72 {-# INLINE next #-}

73 {-# INLINE next #-}

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

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

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

83-- backwards.

84-- backwards.

84reverseStream :: Text -> Stream Char

85reverseStream :: 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)

86 where

87 where

87 {-# INLINE next #-}

88 {-# INLINE next #-}

88 next !i

89 next !i

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

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

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

98unstream :: Stream Char -> Text

99unstream :: Stream Char -> Text

99unstream (Stream next0 s0 len)

100unstream (Stream next0 s0 len)

100− | len == 0 = I.empty

101+ | isEmpty len = I.empty

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

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

102 where

103 where

104+ mlen = upperBound 4 len

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

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

104 loop arr !top !s !i

106 loop arr !top !s !i

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

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

106 Done -> return (arr, i)

108 Done -> return (arr, i)

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

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

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

126reverse :: Stream Char -> Text

128reverse :: Stream Char -> Text

127reverse (Stream next s len0)

129reverse (Stream next s len0)

128− | len0 == 0 = I.empty

130+ | isEmpty len0 = I.empty

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

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

130 where

132 where

131− len0' = max len0 4

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

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

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

133 loop !s0 !i !len marr =

135 loop !s0 !i !len marr =

134 case next s0 of

136 case next s0 of

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

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

108import Data.Int (Int64)

109import Data.Text.Fusion.Internal

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

111+import Data.Text.Fusion.Size

111

112

112singleton :: Char -> Stream Char

113singleton :: Char -> Stream Char

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

114+singleton c = Stream next False 1

114 where next False = Yield c True

115 where next False = Yield c True

115 next True = Done

116 next True = Done

116{-# INLINE singleton #-}

117{-# INLINE singleton #-}

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

118streamList :: [a] -> Stream a

119streamList :: [a] -> Stream a

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

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

120streamList [] = empty

121streamList [] = empty

121−streamList s = Stream next s unknownLength

122+streamList s = Stream next s unknownSize

122 where next [] = Done

123 where next [] = Done

123 next (x:xs) = Yield x xs

124 next (x:xs) = Yield x xs

124− unknownLength = 8 -- random HINT

125

126unstreamList :: Stream a -> [a]

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

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

138

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

140cons :: 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)

142 where

143 {-# INLINE next #-}

144 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

150

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

152snoc :: 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)

154 where

155 {-# INLINE next #-}

156 next (J xs) = case next0 xs of

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

193uncons (Stream next s0 len) = loop_uncons s0

194 where

195 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))

197 Skip s' -> loop_uncons s'

198 Done -> Nothing

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

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

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

217-- be non-empty.

218tail :: 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)

220 where

221 {-# INLINE next #-}

222 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

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

234-- must be non-empty.

235init :: 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)

237 where

238 {-# INLINE next #-}

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

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

269-- ----------------------------------------------------------------------------

270-- * Stream transformations

271

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

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

273−-- @xs@.

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

274map :: (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

276 where

277 {-# INLINE next #-}

278 next !s = case next0 s of

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

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

290-- characters of a 'Stream Char'.

291intersperse :: 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

293 where

294 {-# INLINE next #-}

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

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

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

365

366justifyLeftI :: 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)

368 where

369 where

369− j = fromIntegral k

370− newLen | j > len = j

371− | otherwise = len

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

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

373 case next0 s of

371 case next0 s of

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

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

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

590

588

591replicateI :: Int64 -> Stream Char -> Stream Char

589replicateI :: Int64 -> Stream Char -> Stream Char

592replicateI n (Stream next0 s0 len) =

590replicateI 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)

594 where

592 where

595 next (k :!: s)

593 next (k :!: s)

596 | k >= n = Done

594 | k >= n = Done

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

638-- length of the stream.

636-- length of the stream.

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

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

640take n0 (Stream next0 s0 len) =

638take 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)))

642 where

640 where

643 {-# INLINE next #-}

641 {-# INLINE next #-}

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

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

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

653-- length of the stream.

651-- length of the stream.

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

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

655drop n0 (Stream next0 s0 len) =

653drop 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))

657 where

655 where

658 {-# INLINE next #-}

656 {-# INLINE next #-}

659 next (J n :!: s)

657 next (J n :!: s)

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

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

661 | otherwise = case next0 s of

659 | otherwise = case next0 s of

662 Done -> Done

660 Done -> Done

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

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

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

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

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

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

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

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

806zipWith :: (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)

810 where

809 where

811 {-# INLINE next #-}

810 {-# INLINE next #-}

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

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

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

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

25 , empty

26 ) where

28+import Data.Text.Fusion.Size

28import Data.Word (Word8)

29import Data.Word (Word8)

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

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

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

76 forall s. Stream

77 forall s. Stream

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

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

78 !s -- current state

79 !s -- current state

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

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

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

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

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

83eq :: (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

36import Data.Text.Encoding.Error

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

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

39+import Data.Text.Fusion.Size

39import Data.Text.UnsafeChar (unsafeChr8)

40import Data.Text.UnsafeChar (unsafeChr8)

40import Data.Word (Word8)

41import Data.Word (Word8)

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

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

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

46import Control.Exception (assert)

47import Control.Exception (assert)

47import qualified Data.ByteString.Internal as B

48import qualified Data.ByteString.Internal as B

49−unknownLength :: Int

50−unknownLength = 4

51−

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

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

53-- UTF-8 encoding.

51-- UTF-8 encoding.

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

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

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

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

56 where

54 where

57 empty = S N N N N

55 empty = S N N N N

58 {-# INLINE next #-}

56 {-# INLINE next #-}

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

100

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

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

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

100unstreamChunks :: 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)

104 where chunk s1 len1 = unsafePerformIO $ do

102 where chunk s1 len1 = unsafePerformIO $ do

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

103+ let len = min len1 chunkSize

106 mallocByteString len >>= loop len 0 s1

104 mallocByteString len >>= loop len 0 s1

107 where

105 where

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

106 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

28import Prelude hiding (length)

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

30import Data.Text.Fusion.Internal

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

31import Data.Text.Lazy.Internal

32import Data.Text.Lazy.Internal

32import qualified Data.Text.Internal as I

33import qualified Data.Text.Internal as I

33import qualified Data.Text.Array as A

34import qualified Data.Text.Array as A

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

52-- chunk size.

53-- chunk size.

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

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

54unstreamChunks chunkSize (Stream next s0 len0)

55unstreamChunks chunkSize (Stream next s0 len0)

55− | len0 == 0 = Empty

56+ | isEmpty len0 = Empty

56− | otherwise = outer s0

57+ | otherwise = outer s0

57 where

58 where

58 outer s = case next s of

59 outer s = case next s of

59 Done -> Empty

60 Done -> Empty

tests/Makefile+2−1

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

3ghc-opt-flags = -O0

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

5 -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

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

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

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

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

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

10ghc-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

18import Control.Exception (SomeException, try)

19import qualified Data.Text.Fusion as S

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

21+import Data.Text.Fusion.Size

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

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

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

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

23import qualified Data.Text.UnsafeShift as U

24import qualified Data.Text.UnsafeShift as U

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

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

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

29import Data.Text.Search

30import Data.Text.Search

31−import QuickCheckUtils (NotEmpty(..))

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

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

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

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

35-- 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) &&

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

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

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

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

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

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

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

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

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

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

123

124

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

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

125 where _types = s :: String

126 where _types = s :: String

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

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

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

148

149

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

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

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

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

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

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

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

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

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

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

338unpack2 = unpackS *** unpackS

340unpack2 = unpackS *** unpackS

339

341

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

342s_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

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

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

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

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

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

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

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

348s_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

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

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

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

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

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

353tl_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

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

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

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

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

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

360t_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)

517-- themselves.

526-- themselves.

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

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

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

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

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

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

521− | otherwise = t

530+ | otherwise = t

522

531

523main = defaultMain tests

532main = defaultMain tests

524

533

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

568

577

569 testGroup "basics" [

578 testGroup "basics" [

570 testProperty "s_cons" s_cons,

579 testProperty "s_cons" s_cons,

580+ testProperty "s_cons_s" s_cons_s,

571 testProperty "sf_cons" sf_cons,

581 testProperty "sf_cons" sf_cons,

572 testProperty "t_cons" t_cons,

582 testProperty "t_cons" t_cons,

573 testProperty "tl_cons" tl_cons,

583 testProperty "tl_cons" tl_cons,

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

726 testGroup "substrings" [

736 testGroup "substrings" [

727 testGroup "breaking" [

737 testGroup "breaking" [

728 testProperty "s_take" s_take,

738 testProperty "s_take" s_take,

739+ testProperty "s_take_s" s_take_s,

729 testProperty "sf_take" sf_take,

740 testProperty "sf_take" sf_take,

730 testProperty "t_take" t_take,

741 testProperty "t_take" t_take,

731 testProperty "tl_take" tl_take,

742 testProperty "tl_take" tl_take,

732 testProperty "s_drop" s_drop,

743 testProperty "s_drop" s_drop,

744+ testProperty "s_drop_s" s_drop_s,

733 testProperty "sf_drop" sf_drop,

745 testProperty "sf_drop" sf_drop,

734 testProperty "t_drop" t_drop,

746 testProperty "t_drop" t_drop,

735 testProperty "tl_drop" tl_drop,

747 testProperty "tl_drop" tl_drop,

736 testProperty "s_take_drop" s_take_drop,

748 testProperty "s_take_drop" s_take_drop,

749+ testProperty "s_take_drop_s" s_take_drop_s,

737 testProperty "s_takeWhile" s_takeWhile,

750 testProperty "s_takeWhile" s_takeWhile,

738 testProperty "sf_takeWhile" sf_takeWhile,

751 testProperty "sf_takeWhile" sf_takeWhile,

739 testProperty "t_takeWhile" t_takeWhile,

752 testProperty "t_takeWhile" t_takeWhile,

text.cabal+1

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

33 Data.Text.Fusion.CaseMapping

34 Data.Text.Fusion.Common

35 Data.Text.Fusion.Internal

36+ Data.Text.Fusion.Size

36 Data.Text.Internal

37 Data.Text.Internal

37 Data.Text.Lazy.Encoding.Fusion

38 Data.Text.Lazy.Encoding.Fusion

38 Data.Text.Lazy.Fusion

39 Data.Text.Lazy.Fusion