bf8f0a1 · text · git.iko.soy

.hgignore+7−3

compare with master

unifiedsplit

@@ -1,8 +1,12 @@

1−^(?:dist|tests/benchmarks/dist|tests/tests/dist)$

1+^(?:dist|benchmarks/dist|tests/coverage|tests/dist)$

2−^tests/benchmarks/.*\.txt$

2+^benchmarks/.*\.txt$

3^tests/text-testdata.tar.bz2$

5−\.(?:aux|eventlog|h[ip]|log|[oa]|orig|prof|ps|rej|swp)$

5+\.(?:aux|eventlog|h[ip]|log|[oa]|orig|prof|ps|rej|swp|tix)$

6~$

7+

7syntax: glob

8syntax: glob

8.\#*

9.\#*

10+cabal-dev

11+cabal.sandbox.config

12+\.cabal-sandbox

.hgtags+6

@@ -36,3 +36,9 @@ b75d3041d275e8e76b26605b0d426a572ddf1249 0.11.1.3

36407937739e9e764f1ae0f1f9ca454c42dca38772 0.11.1.10

378b981edd27befa4c2dd334fcb7db22ac67e22b67 0.11.1.11

38204da16b5098531bdf858c388e2620238ef2aa5e 0.11.1.12

39+6a3d847a56a69d0514a79cb212cb218271ad0917 0.11.1.13

40+1d2c6fa9092c6a4000b2abdd9d01f3efcd477be5 0.11.2.0

41+78219784cf3652cc662805bf2971bd62d80210a9 0.11.2.1

42+4297307ebc11ad677cfba6b40319e7e5e2c0cfee 0.11.2.3

43+7fa79662b66aade97fe49394977213fe6432942e 0.11.3.0

44+d99cd091cdf71ce807a4255f6cc509c3154f51ea 0.11.3.1

Data/Text.hs+56−25

@@ -1,9 +1,12 @@

1−{-# LANGUAGE BangPatterns, CPP, Rank2Types, UnboxedTuples #-}

1+{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, UnboxedTuples #-}

2{-# OPTIONS_GHC -fno-warn-orphans #-}

3+#if __GLASGOW_HASKELL__ >= 702

4+{-# LANGUAGE Trustworthy #-}

5+#endif

3

6

4-- |

7-- |

5-- Module : Data.Text

8-- Module : Data.Text

9--

12--

@@ -167,26 +170,29 @@ module Data.Text

167 , partition

170 , partition

168

171

169 -- , findSubstring

172 -- , findSubstring

170−

173+

171 -- * Indexing

174 -- * Indexing

172 -- $index

175 -- $index

173 , index

176 , index

174 , findIndex

177 , findIndex

175 , count

178 , count

176

179

177− -- * Zipping and unzipping

180+ -- * Zipping

178 , zip

181 , zip

179 , zipWith

182 , zipWith

180

183

181 -- -* Ordered text

184 -- -* Ordered text

182 -- , sort

185 -- , sort

186+

187+ -- * Low level operations

188+ , copy

183 ) where

189 ) where

184

190

185import Prelude (Char, Bool(..), Int, Maybe(..), String,

191import Prelude (Char, Bool(..), Int, Maybe(..), String,

186 Eq(..), Ord(..), Ordering(..), (++),

192 Eq(..), Ord(..), Ordering(..), (++),

187 Read(..), Show(..),

193 Read(..), Show(..),

188 (&&), (||), (+), (-), (.), ($), ($!), (>>), (*),

194 (&&), (||), (+), (-), (.), ($), ($!), (>>), (*),

189− div, maxBound, not, return, otherwise)

195+ maxBound, not, return, otherwise, quot)

190#if defined(HAVE_DEEPSEQ)

196#if defined(HAVE_DEEPSEQ)

191import Control.DeepSeq (NFData)

197import Control.DeepSeq (NFData)

192#endif

198#endif

@@ -195,11 +201,7 @@ import Control.Exception (assert)

195#endif

201#endif

196import Data.Char (isSpace)

202import Data.Char (isSpace)

197import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))

203import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))

198−#if __GLASGOW_HASKELL__ >= 612

199import Data.Data (mkNoRepType)

204import Data.Data (mkNoRepType)

200−#else

201−import Data.Data (mkNorepType)

202−#endif

203import Control.Monad (foldM)

205import Control.Monad (foldM)

204import qualified Data.Text.Array as A

206import qualified Data.Text.Array as A

205import qualified Data.List as L

207import qualified Data.List as L

@@ -222,6 +224,12 @@ import Data.ByteString (ByteString)

222import qualified Data.Text.Lazy as L

224import qualified Data.Text.Lazy as L

223import Data.Int (Int64)

225import Data.Int (Int64)

224#endif

226#endif

227+#if __GLASGOW_HASKELL__ >= 702

228+import qualified GHC.CString as GHC

229+#else

230+import qualified GHC.Base as GHC

231+#endif

232+import GHC.Prim (Addr#)

225

233

226-- $strict

234-- $strict

227--

235--

@@ -324,7 +332,7 @@ instance NFData Text

324

332

325-- This instance preserves data abstraction at the cost of inefficiency.

333-- This instance preserves data abstraction at the cost of inefficiency.

326-- We omit reflection services for the sake of data abstraction.

334-- We omit reflection services for the sake of data abstraction.

327−--

335+--

328-- This instance was created by copying the behavior of Data.Set and

336-- This instance was created by copying the behavior of Data.Set and

329-- Data.Map. If you feel a mistake has been made, please feel free to

337-- Data.Map. If you feel a mistake has been made, please feel free to

330-- submit improvements.

338-- submit improvements.

@@ -338,11 +346,7 @@ instance Data Text where

338 gfoldl f z txt = z pack `f` (unpack txt)

346 gfoldl f z txt = z pack `f` (unpack txt)

339 toConstr _ = P.error "Data.Text.Text.toConstr"

347 toConstr _ = P.error "Data.Text.Text.toConstr"

340 gunfold _ _ = P.error "Data.Text.Text.gunfold"

348 gunfold _ _ = P.error "Data.Text.Text.gunfold"

341−#if __GLASGOW_HASKELL__ >= 612

342 dataTypeOf _ = mkNoRepType "Data.Text.Text"

349 dataTypeOf _ = mkNoRepType "Data.Text.Text"

343−#else

344− dataTypeOf _ = mkNorepType "Data.Text.Text"

345−#endif

346

350

347-- | /O(n)/ Compare two 'Text' values lexicographically.

351-- | /O(n)/ Compare two 'Text' values lexicographically.

348compareText :: Text -> Text -> Ordering

352compareText :: Text -> Text -> Ordering

@@ -364,7 +368,7 @@ compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)

364-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to

368-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to

365-- fusion. Performs replacement on invalid scalar values.

369-- fusion. Performs replacement on invalid scalar values.

366pack :: String -> Text

370pack :: String -> Text

367−pack = unstream . S.streamList . L.map safe

371+pack = unstream . S.map safe . S.streamList

368{-# INLINE [1] pack #-}

372{-# INLINE [1] pack #-}

369

373

370-- | /O(n)/ Convert a Text into a String. Subject to fusion.

374-- | /O(n)/ Convert a Text into a String. Subject to fusion.

@@ -372,6 +376,19 @@ unpack :: Text -> String

372unpack = S.unstreamList . stream

376unpack = S.unstreamList . stream

373{-# INLINE [1] unpack #-}

377{-# INLINE [1] unpack #-}

374

378

379+-- | /O(n)/ Convert a literal string into a Text. Subject to fusion.

380+unpackCString# :: Addr# -> Text

381+unpackCString# addr# = unstream (S.streamCString# addr#)

382+{-# NOINLINE unpackCString# #-}

383+

384+{-# RULES "TEXT literal" forall a.

385+ unstream (S.map safe (S.streamList (GHC.unpackCString# a)))

386+ = unpackCString# a #-}

387+

388+{-# RULES "TEXT literal UTF8" forall a.

389+ unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))

390+ = unpackCString# a #-}

391+

375-- | /O(1)/ Convert a character into a Text. Subject to fusion.

392-- | /O(1)/ Convert a character into a Text. Subject to fusion.

376-- Performs replacement on invalid scalar values.

393-- Performs replacement on invalid scalar values.

377singleton :: Char -> Text

394singleton :: Char -> Text

@@ -712,7 +729,7 @@ center k c t

712 | otherwise = replicateChar l c `append` t `append` replicateChar r c

729 | otherwise = replicateChar l c `append` t `append` replicateChar r c

713 where len = length t

730 where len = length t

714 d = k - len

731 d = k - len

715− r = d `div` 2

732+ r = d `quot` 2

716 l = d - r

733 l = d - r

717{-# INLINE center #-}

734{-# INLINE center #-}

718

735

@@ -884,11 +901,11 @@ mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream

884-- @t@ repeated @n@ times.

901-- @t@ repeated @n@ times.

885replicate :: Int -> Text -> Text

902replicate :: Int -> Text -> Text

886replicate n t@(Text a o l)

903replicate n t@(Text a o l)

887− | n <= 0 || l <= 0 = empty

904+ | n <= 0 || l <= 0 = empty

888− | n == 1 = t

905+ | n == 1 = t

889− | isSingleton t = replicateChar n (unsafeHead t)

906+ | isSingleton t = replicateChar n (unsafeHead t)

890− | n <= maxBound `div` l = Text (A.run x) 0 len

907+ | n <= maxBound `quot` l = Text (A.run x) 0 len

891− | otherwise = overflowError "replicate"

908+ | otherwise = overflowError "replicate"

892 where

909 where

893 len = l * n

910 len = l * n

894 x = do

911 x = do

@@ -1110,7 +1127,7 @@ findAIndexOrEnd q t@(Text _arr _off len) = go 0

1110 where go !i | i >= len || q c = i

1127 where go !i | i >= len || q c = i

1111 | otherwise = go (i+d)

1128 | otherwise = go (i+d)

1112 where Iter c d = iter t i

1129 where Iter c d = iter t i

1113−

1130+

1114-- | /O(n)/ Group characters in a string by equality.

1131-- | /O(n)/ Group characters in a string by equality.

1115group :: Text -> [Text]

1132group :: Text -> [Text]

1116group = groupBy (==)

1133group = groupBy (==)

@@ -1143,7 +1160,7 @@ tails t | null t = [empty]

1143-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]

1160-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]

1144-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]

1161-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]

1145-- > splitOn "x" "x" == ["",""]

1162-- > splitOn "x" "x" == ["",""]

1146−--

1163+--

1147-- and

1164-- and

1148--

1165--

1149-- > intercalate s . splitOn s == id

1166-- > intercalate s . splitOn s == id

@@ -1439,8 +1456,6 @@ isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =

1439{-# RULES

1456{-# RULES

1440"TEXT isPrefixOf -> fused" [~1] forall s t.

1457"TEXT isPrefixOf -> fused" [~1] forall s t.

1441 isPrefixOf s t = S.isPrefixOf (stream s) (stream t)

1458 isPrefixOf s t = S.isPrefixOf (stream s) (stream t)

1442−"TEXT isPrefixOf -> unfused" [1] forall s t.

1443− S.isPrefixOf (stream s) (stream t) = isPrefixOf s t

1444 #-}

1459 #-}

1445

1460

1446-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns

1461-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns

@@ -1557,3 +1572,19 @@ emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"

1557

1572

1558overflowError :: String -> a

1573overflowError :: String -> a

1559overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"

1574overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"

1575+

1576+-- | /O(n)/ Make a distinct copy of the given string, sharing no

1577+-- storage with the original string.

1578+--

1579+-- As an example, suppose you read a large string, of which you need

1580+-- only a small portion. If you do not use 'copy', the entire original

1581+-- array will be kept alive in memory by the smaller string. Making a

1582+-- copy \"breaks the link\" to the original array, allowing it to be

1583+-- garbage collected if there are no other live references to it.

1584+copy :: Text -> Text

1585+copy (Text arr off len) = Text (A.run go) 0 len

1586+ where

1587+ go = do

1588+ marr <- A.new len

1589+ A.copyI marr 0 arr off len

1590+ return marr

Data/Text/Array.hs+5−1

@@ -114,7 +114,7 @@ instance IArray (MArray s) where

114-- | Create an uninitialized mutable array.

115new :: forall s. Int -> ST s (MArray s)

116new n

117− | n < 0 || n .&. highBit /= 0 = error $ "Data.Text.Array.new: size overflow"

117+ | n < 0 || n .&. highBit /= 0 = array_size_error

118 | otherwise = ST $ \s1# ->

119 case newByteArray# len# s1# of

120 (# s2#, marr# #) -> (# s2#, MArray marr#

@@ -126,6 +126,9 @@ new n

126 highBit = maxBound `xor` (maxBound `shiftR` 1)

127{-# INLINE new #-}

128

129+array_size_error :: a

130+array_size_error = error "Data.Text.Array.new: size overflow"

131+

129-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!

132-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!

130unsafeFreeze :: MArray s -> ST s Array

133unsafeFreeze :: MArray s -> ST s Array

131unsafeFreeze MArray{..} = ST $ \s# ->

134unsafeFreeze MArray{..} = ST $ \s# ->

@@ -181,6 +184,7 @@ run2 k = runST (do

181 (marr,b) <- k

184 (marr,b) <- k

182 arr <- unsafeFreeze marr

185 arr <- unsafeFreeze marr

183 return (arr,b))

186 return (arr,b))

187+{-# INLINE run2 #-}

184

188

185-- | Copy some elements of a mutable array.

189-- | Copy some elements of a mutable array.

186copyM :: MArray s -- ^ Destination

190copyM :: MArray s -- ^ Destination

Data/Text/Encoding.hs+257−89

@@ -1,5 +1,8 @@

1−{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash,

1+{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, GeneralizedNewtypeDeriving, MagicHash,

2 UnliftedFFITypes #-}

3+#if __GLASGOW_HASKELL__ >= 702

4+{-# LANGUAGE Trustworthy #-}

5+#endif

3-- |

6-- |

4-- Module : Data.Text.Encoding

7-- Module : Data.Text.Encoding

@@ -23,6 +26,7 @@ module Data.Text.Encoding

23 -- * Decoding ByteStrings to Text

26 -- * Decoding ByteStrings to Text

24 -- $strict

27 -- $strict

25 decodeASCII

28 decodeASCII

29+ , decodeLatin1

26 , decodeUtf8

30 , decodeUtf8

27 , decodeUtf16LE

31 , decodeUtf16LE

28 , decodeUtf16BE

32 , decodeUtf16BE

@@ -39,17 +43,23 @@ module Data.Text.Encoding

39 , decodeUtf32LEWith

43 , decodeUtf32LEWith

40 , decodeUtf32BEWith

44 , decodeUtf32BEWith

41

45

46+ -- ** Stream oriented decoding

47+ -- $stream

48+ , streamDecodeUtf8

49+ , streamDecodeUtf8With

50+ , Decoding(..)

51+

42 -- * Encoding Text to ByteStrings

52 -- * Encoding Text to ByteStrings

43 , encodeUtf8

53 , encodeUtf8

44 , encodeUtf16LE

54 , encodeUtf16LE

45 , encodeUtf16BE

55 , encodeUtf16BE

46 , encodeUtf32LE

56 , encodeUtf32LE

47 , encodeUtf32BE

57 , encodeUtf32BE

48−

58+

49 -- * Generic encoding of Text

59 -- * Generic encoding of Text

50− , encodeStreamWithB

60+ -- , encodeStreamWithB

51− , encodeTextWithB

61+ -- , encodeTextWithB

52− , encodeUtf8Builder

62+ -- , encodeUtf8Builder

53 , encodeUtf8Escaped

63 , encodeUtf8Escaped

54 ) where

64 ) where

55

65

@@ -59,28 +69,35 @@ import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)

59#else

69#else

60import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)

70import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)

61#endif

71#endif

72+import Control.Monad.ST (runST)

62import Data.Bits ((.&.))

73import Data.Bits ((.&.))

63import Data.ByteString as B

74import Data.ByteString as B

64import Data.ByteString.Internal as B

75import Data.ByteString.Internal as B

65−import Data.ByteString.Lazy.Builder.Internal as B

76+import qualified Data.ByteString.Lazy as BL

77+import qualified Data.ByteString.Builder as B

78+import qualified Data.ByteString.Builder.Internal as B

66−import qualified Data.ByteString.Lazy.Builder.BasicEncoding.Internal as B

79+import qualified Data.ByteString.Builder.Prim.Internal as BP

67−import qualified Data.ByteString.Lazy.Builder.BasicEncoding as B

80+import qualified Data.ByteString.Builder.Prim as BP

81+import Data.Text ()

68import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)

82import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)

69−import Data.Text.Internal (Text(..), textP)

83+import Data.Text.Internal (Text(..), safe, textP)

84+import Data.Text.Private (runText)

70import Data.Text.UnsafeChar (ord, unsafeWrite)

85import Data.Text.UnsafeChar (ord, unsafeWrite)

71import Data.Text.UnsafeShift (shiftL, shiftR)

86import Data.Text.UnsafeShift (shiftL, shiftR)

72−import Data.Word (Word8)

87+import Data.Word (Word8, Word32)

73import Foreign.C.Types (CSize)

88import Foreign.C.Types (CSize)

74import Foreign.ForeignPtr (withForeignPtr)

89import Foreign.ForeignPtr (withForeignPtr)

75import Foreign.Marshal.Utils (with)

90import Foreign.Marshal.Utils (with)

76−import Foreign.Ptr (Ptr, minusPtr, plusPtr)

91+import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)

77−import Foreign.Storable (peek, poke)

92+import Foreign.Storable (Storable, peek, poke)

78import GHC.Base (MutableByteArray#)

93import GHC.Base (MutableByteArray#)

79−import System.IO.Unsafe (unsafePerformIO)

80import qualified Data.Text.Array as A

94import qualified Data.Text.Array as A

81import qualified Data.Text.Encoding.Fusion as E

95import qualified Data.Text.Encoding.Fusion as E

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

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

83import qualified Data.Text.Fusion as F

97import qualified Data.Text.Fusion as F

98+import Data.Text.Unsafe (unsafeDupablePerformIO)

99+

100+#include "text_cbits.h"

84

101

85-- $strict

102-- $strict

86--

103--

@@ -98,39 +115,171 @@ import qualified Data.Text.Fusion as F

98-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII

115-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII

99-- encoded text.

116-- encoded text.

100--

117--

101−-- This function is deprecated. Use 'decodeUtf8' instead.

118+-- This function is deprecated. Use 'decodeLatin1' instead.

102decodeASCII :: ByteString -> Text

119decodeASCII :: ByteString -> Text

103decodeASCII = decodeUtf8

120decodeASCII = decodeUtf8

104{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}

121{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}

105

122

123+-- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.

124+--

125+-- 'decodeLatin1' is semantically equivalent to

126+-- @Data.Text.pack . Data.ByteString.Char8.unpack@

127+decodeLatin1 :: ByteString -> Text

128+decodeLatin1 (PS fp off len) = textP a 0 len

129+ where

130+ a = A.run (A.new len >>= unsafeIOToST . go)

131+ go dest = withForeignPtr fp $ \ptr -> do

132+ c_decode_latin1 (A.maBA dest) (ptr `plusPtr` off) (ptr `plusPtr` (off+len))

133+ return dest

134+

106-- | Decode a 'ByteString' containing UTF-8 encoded text.

135-- | Decode a 'ByteString' containing UTF-8 encoded text.

107decodeUtf8With :: OnDecodeError -> ByteString -> Text

136decodeUtf8With :: OnDecodeError -> ByteString -> Text

108−decodeUtf8With onErr (PS fp off len) = textP (fst a) 0 (snd a)

137+decodeUtf8With onErr (PS fp off len) = runText $ \done -> do

138+ let go dest = withForeignPtr fp $ \ptr ->

139+ with (0::CSize) $ \destOffPtr -> do

140+ let end = ptr `plusPtr` (off + len)

141+ loop curPtr = do

142+ curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end

143+ if curPtr' == end

144+ then do

145+ n <- peek destOffPtr

146+ unsafeSTToIO (done dest (fromIntegral n))

147+ else do

148+ x <- peek curPtr'

149+ case onErr desc (Just x) of

150+ Nothing -> loop $ curPtr' `plusPtr` 1

151+ Just c -> do

152+ destOff <- peek destOffPtr

153+ w <- unsafeSTToIO $

154+ unsafeWrite dest (fromIntegral destOff) (safe c)

155+ poke destOffPtr (destOff + fromIntegral w)

156+ loop $ curPtr' `plusPtr` 1

157+ loop (ptr `plusPtr` off)

158+ (unsafeIOToST . go) =<< A.new len

109 where

159 where

110− a = A.run2 (A.new len >>= unsafeIOToST . go)

111 desc = "Data.Text.Encoding.decodeUtf8: Invalid UTF-8 stream"

160 desc = "Data.Text.Encoding.decodeUtf8: Invalid UTF-8 stream"

112− go dest = withForeignPtr fp $ \ptr ->

113− with (0::CSize) $ \destOffPtr -> do

114− let end = ptr `plusPtr` (off + len)

115− loop curPtr = do

116− curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end

117− if curPtr' == end

118− then do

119− n <- peek destOffPtr

120− return (dest,fromIntegral n)

121− else do

122− x <- peek curPtr'

123− case onErr desc (Just x) of

124− Nothing -> loop $ curPtr' `plusPtr` 1

125− Just c -> do

126− destOff <- peek destOffPtr

127− w <- unsafeSTToIO $

128− unsafeWrite dest (fromIntegral destOff) c

129− poke destOffPtr (destOff + fromIntegral w)

130− loop $ curPtr' `plusPtr` 1

131− loop (ptr `plusPtr` off)

132{- INLINE[0] decodeUtf8With #-}

161{- INLINE[0] decodeUtf8With #-}

133

162

163+-- $stream

164+--

165+-- The 'streamDecodeUtf8' and 'streamDecodeUtf8With' functions accept

166+-- a 'ByteString' that represents a possibly incomplete input (e.g. a

167+-- packet from a network stream) that may not end on a UTF-8 boundary.

168+--

169+-- The first element of the result is the maximal chunk of 'Text' that

170+-- can be decoded from the given input. The second is a function which

171+-- accepts another 'ByteString'. That string will be assumed to

172+-- directly follow the string that was passed as input to the original

173+-- function, and it will in turn be decoded.

174+--

175+-- To help understand the use of these functions, consider the Unicode

176+-- string @\"hi ☃\"@. If encoded as UTF-8, this becomes @\"hi

177+-- \\xe2\\x98\\x83\"@; the final @\'☃\'@ is encoded as 3 bytes.

178+--

179+-- Now suppose that we receive this encoded string as 3 packets that

180+-- are split up on untidy boundaries: @[\"hi \\xe2\", \"\\x98\",

181+-- \"\\x83\"]@. We cannot decode the entire Unicode string until we

182+-- have received all three packets, but we would like to make progress

183+-- as we receive each one.

184+--

185+-- @

186+-- let 'Some' t0 f0 = 'streamDecodeUtf8' \"hi \\xe2\"

187+-- t0 == \"hi \" :: 'Text'

188+-- @

189+--

190+-- We use the continuation @f0@ to decode our second packet.

191+--

192+-- @

193+-- let 'Some' t1 f1 = f0 \"\\x98\"

194+-- t1 == \"\"

195+-- @

196+--

197+-- We could not give @f0@ enough input to decode anything, so it

198+-- returned an empty string. Once we feed our second continuation @f1@

199+-- the last byte of input, it will make progress.

200+--

201+-- @

202+-- let 'Some' t2 f2 = f1 \"\\x83\"

203+-- t2 == \"☃\"

204+-- @

205+--

206+-- If given invalid input, an exception will be thrown by the function

207+-- or continuation where it is encountered.

208+

209+-- | A stream oriented decoding result.

210+data Decoding = Some Text ByteString (ByteString -> Decoding)

211+

212+instance Show Decoding where

213+ showsPrec d (Some t bs _) = showParen (d > prec) $

214+ showString "Some " . showsPrec prec' t .

215+ showChar ' ' . showsPrec prec' bs .

216+ showString " _"

217+ where prec = 10; prec' = prec + 1

218+

219+newtype CodePoint = CodePoint Word32 deriving (Eq, Show, Num, Storable)

220+newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable)

221+

222+-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8

223+-- encoded text that is known to be valid.

224+--

225+-- If the input contains any invalid UTF-8 data, an exception will be

226+-- thrown (either by this function or a continuation) that cannot be

227+-- caught in pure code. For more control over the handling of invalid

228+-- data, use 'streamDecodeUtf8With'.

229+streamDecodeUtf8 :: ByteString -> Decoding

230+streamDecodeUtf8 = streamDecodeUtf8With strictDecode

231+

232+-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8

233+-- encoded text.

234+streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding

235+streamDecodeUtf8With onErr = decodeChunk 0 0

236+ where

237+ -- We create a slightly larger than necessary buffer to accommodate a

238+ -- potential surrogate pair started in the last buffer

239+ decodeChunk :: CodePoint -> DecoderState -> ByteString -> Decoding

240+ decodeChunk codepoint0 state0 bs@(PS fp off len) =

241+ runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)

242+ where

243+ decodeChunkToBuffer :: A.MArray s -> IO Decoding

244+ decodeChunkToBuffer dest = withForeignPtr fp $ \ptr ->

245+ with (0::CSize) $ \destOffPtr ->

246+ with codepoint0 $ \codepointPtr ->

247+ with state0 $ \statePtr ->

248+ with nullPtr $ \curPtrPtr ->

249+ let end = ptr `plusPtr` (off + len)

250+ loop curPtr = do

251+ poke curPtrPtr curPtr

252+ curPtr' <- c_decode_utf8_with_state (A.maBA dest) destOffPtr

253+ curPtrPtr end codepointPtr statePtr

254+ state <- peek statePtr

255+ case state of

256+ UTF8_REJECT -> do

257+ -- We encountered an encoding error

258+ x <- peek curPtr'

259+ case onErr desc (Just x) of

260+ Nothing -> loop $ curPtr' `plusPtr` 1

261+ Just c -> do

262+ destOff <- peek destOffPtr

263+ w <- unsafeSTToIO $

264+ unsafeWrite dest (fromIntegral destOff) (safe c)

265+ poke destOffPtr (destOff + fromIntegral w)

266+ poke statePtr 0

267+ loop $ curPtr' `plusPtr` 1

268+

269+ _ -> do

270+ -- We encountered the end of the buffer while decoding

271+ n <- peek destOffPtr

272+ codepoint <- peek codepointPtr

273+ chunkText <- unsafeSTToIO $ do

274+ arr <- A.unsafeFreeze dest

275+ return $! textP arr 0 (fromIntegral n)

276+ lastPtr <- peek curPtrPtr

277+ let left = lastPtr `minusPtr` curPtr

278+ return $ Some chunkText (B.drop left bs)

279+ (decodeChunk codepoint state)

280+ in loop (ptr `plusPtr` off)

281+ desc = "Data.Text.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"

282+

134-- | Decode a 'ByteString' containing UTF-8 encoded text that is known

283-- | Decode a 'ByteString' containing UTF-8 encoded text that is known

135-- to be valid.

284-- to be valid.

136--

285--

@@ -144,17 +293,22 @@ decodeUtf8 = decodeUtf8With strictDecode

144{-# RULES "STREAM stream/decodeUtf8 fusion" [1]

293{-# RULES "STREAM stream/decodeUtf8 fusion" [1]

145 forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}

294 forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}

146

295

147−-- | Decode a 'ByteString' containing UTF-8 encoded text..

296+-- | Decode a 'ByteString' containing UTF-8 encoded text.

148--

297--

149-- If the input contains any invalid UTF-8 data, the relevant

298-- If the input contains any invalid UTF-8 data, the relevant

150-- exception will be returned, otherwise the decoded text.

299-- exception will be returned, otherwise the decoded text.

151decodeUtf8' :: ByteString -> Either UnicodeException Text

300decodeUtf8' :: ByteString -> Either UnicodeException Text

152−decodeUtf8' = unsafePerformIO . try . evaluate . decodeUtf8With strictDecode

301+decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode

153{-# INLINE decodeUtf8' #-}

302{-# INLINE decodeUtf8' #-}

154

303

155-- | Encode text using UTF-8 encoding.

304-- | Encode text using UTF-8 encoding.

156encodeUtf8 :: Text -> ByteString

305encodeUtf8 :: Text -> ByteString

157−encodeUtf8 (Text arr off len) = unsafePerformIO $ do

306+encodeUtf8 =

307+ BL.toStrict . B.toLazyByteString

308+ . encodeUtf8Escaped (BP.liftFixedToBounded BP.word8)

309+

310+{-

311+encodeUtf8 (Text arr off len) = unsafeDupablePerformIO $ do

158 let size0 = max len 4

312 let size0 = max len 4

159 mallocByteString size0 >>= start size0 off 0

313 mallocByteString size0 >>= start size0 off 0

160 where

314 where

@@ -207,6 +361,55 @@ encodeUtf8 (Text arr off len) = unsafePerformIO $ do

207 poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80

361 poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80

208 poke8 (m+2) $ (w .&. 0x3F) + 0x80

362 poke8 (m+2) $ (w .&. 0x3F) + 0x80

209 go (n+1) (m+3)

363 go (n+1) (m+3)

364+-}

365+

366+-- | Encode text using UTF-8 encoding and escape the ASCII characters using

367+-- a 'BP.PrimBounded'.

368+encodeUtf8Escaped :: BP.BoundedPrim Word8 -> Text -> B.Builder

369+encodeUtf8Escaped be (Text arr off len) =

370+ B.builder step

371+ where

372+ bound = max 4 $ BP.sizeBound be

373+ iend = off + len

374+ step !k =

375+ outerLoop off

376+ where

377+ outerLoop !i0 !br@(B.BufferRange op0 ope)

378+ | i0 >= iend = k br

379+ | op0 `plusPtr` bound < ope =

380+ goPartial (i0 + min outRemaining inpRemaining)

381+ | otherwise = return $ B.bufferFull bound op0 (outerLoop i0)

382+ where

383+ outRemaining = (ope `minusPtr` op0) `div` bound

384+ inpRemaining = iend - i0

385+

386+ goPartial !iendTmp = go i0 op0

387+ where

388+ go !i !op

389+ | i < iendTmp = case A.unsafeIndex arr i of

390+ w | w <= 0x7F -> do

391+ BP.runB be (fromIntegral w) op >>= go (i + 1)

392+ | w <= 0x7FF -> do

393+ poke8 0 $ (w `shiftR` 6) + 0xC0

394+ poke8 1 $ (w .&. 0x3f) + 0x80

395+ go (i + 1) (op `plusPtr` 2)

396+ | 0xD800 <= w && w <= 0xDBFF -> do

397+ let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))

398+ poke8 0 $ (c `shiftR` 18) + 0xF0

399+ poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80

400+ poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80

401+ poke8 3 $ (c .&. 0x3F) + 0x80

402+ go (i + 2) (op `plusPtr` 4)

403+ | otherwise -> do

404+ poke8 0 $ (w `shiftR` 12) + 0xE0

405+ poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80

406+ poke8 2 $ (w .&. 0x3F) + 0x80

407+ go (i + 1) (op `plusPtr` 3)

408+ | otherwise =

409+ outerLoop i (B.BufferRange op ope)

410+ where

411+ poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)

412+

210

413

211-- | Decode text from little endian UTF-16 encoding.

414-- | Decode text from little endian UTF-16 encoding.

212decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text

415decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text

@@ -288,14 +491,24 @@ foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8

288 :: MutableByteArray# s -> Ptr CSize

491 :: MutableByteArray# s -> Ptr CSize

289 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)

492 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)

290

493

494+foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state

495+ :: MutableByteArray# s -> Ptr CSize

496+ -> Ptr (Ptr Word8) -> Ptr Word8

497+ -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)

498+

499+foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1

500+ :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()

501+

502+

503+{-

291-- | Encode all elements of a 'F.Stream' using a 'B.BoundedEncoding'.

504-- | Encode all elements of a 'F.Stream' using a 'B.BoundedEncoding'.

292{-# INLINE encodeStreamWithB #-}

505{-# INLINE encodeStreamWithB #-}

293encodeStreamWithB :: B.BoundedEncoding a -> F.Stream a -> B.Builder

506encodeStreamWithB :: B.BoundedEncoding a -> F.Stream a -> B.Builder

294−encodeStreamWithB be =

507+encodeStreamWithB be =

295 \(F.Stream next s0 _) -> B.builder $ step next s0

508 \(F.Stream next s0 _) -> B.builder $ step next s0

296 where

509 where

297 bound = B.sizeBound be

510 bound = B.sizeBound be

298− step next s0 k (B.BufferRange op0 ope0) =

511+ step next s0 k (B.BufferRange op0 ope0) =

299 go s0 op0

512 go s0 op0

300 where

513 where

301 go s !op = case next s of

514 go s !op = case next s of

@@ -303,11 +516,11 @@ encodeStreamWithB be =

303 F.Skip s' -> go s' op

516 F.Skip s' -> go s' op

304 F.Yield x s'

517 F.Yield x s'

305 | op `plusPtr` bound <= ope0 -> B.runB be x op >>= go s'

518 | op `plusPtr` bound <= ope0 -> B.runB be x op >>= go s'

306− | otherwise ->

519+ | otherwise ->

307 return $ B.bufferFull bound op (step next s k)

520 return $ B.bufferFull bound op (step next s k)

308

521

309

522

310−-- |

523+-- |

311-- | /Subject to fusion./

524-- | /Subject to fusion./

312-- Encode all 'Char's of a 'T.Text' using a 'B.BoundedEncoding'.

525-- Encode all 'Char's of a 'T.Text' using a 'B.BoundedEncoding'.

313{-# INLINE encodeTextWithB #-}

526{-# INLINE encodeTextWithB #-}

@@ -317,51 +530,6 @@ encodeTextWithB be = encodeStreamWithB be . F.stream

317-- | Encode text using UTF-8 encoding.

530-- | Encode text using UTF-8 encoding.

318encodeUtf8Builder :: Text -> B.Builder

531encodeUtf8Builder :: Text -> B.Builder

319encodeUtf8Builder = encodeUtf8Escaped (B.fromF B.word8)

532encodeUtf8Builder = encodeUtf8Escaped (B.fromF B.word8)

533+-}

320

534

321−-- | Encode text using UTF-8 encoding and escape the ASCII characters using

322−-- a 'BoundedEncoding'.

323−encodeUtf8Escaped :: B.BoundedEncoding Word8 -> Text -> B.Builder

324−encodeUtf8Escaped be (Text arr off len) =

325− B.builder step

326− where

327− bound = max 4 $ B.sizeBound be

328− iend = off + len

329− step !k =

330− outerLoop off

331− where

332− outerLoop !i0 !br@(BufferRange op0 ope)

333− | i0 >= iend = k br

334− | op0 `plusPtr` bound < ope =

335− goPartial (i0 + min outRemaining inpRemaining)

336− | otherwise = return $ bufferFull bound op0 (outerLoop i0)

337− where

338− outRemaining = (ope `minusPtr` op0) `div` bound

339− inpRemaining = iend - i0

340−

341− goPartial !iendTmp = go i0 op0

342− where

343− go !i !op

344− | i < iendTmp = case A.unsafeIndex arr i of

345− w | w <= 0x7F -> do

346− B.runB be (fromIntegral w) op >>= go (i + 1)

347− | w <= 0x7FF -> do

348− poke8 0 $ (w `shiftR` 6) + 0xC0

349− poke8 1 $ (w .&. 0x3f) + 0x80

350− go (i + 1) (op `plusPtr` 2)

351− | 0xD800 <= w && w <= 0xDBFF -> do

352− let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))

353− poke8 0 $ (c `shiftR` 18) + 0xF0

354− poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80

355− poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80

356− poke8 3 $ (c .&. 0x3F) + 0x80

357− go (i + 2) (op `plusPtr` 4)

358− | otherwise -> do

359− poke8 0 $ (w `shiftR` 12) + 0xE0

360− poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80

361− poke8 2 $ (w .&. 0x3F) + 0x80

362− go (i + 1) (op `plusPtr` 3)

363− | otherwise =

364− outerLoop i (BufferRange op ope)

365− where

366− poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)

367

535

Data/Text/Encoding/Error.hs+9−5

@@ -1,4 +1,7 @@

1{-# LANGUAGE CPP, DeriveDataTypeable #-}

2+#if __GLASGOW_HASKELL__ >= 702

3+{-# LANGUAGE Trustworthy #-}

4+#endif

2-- |

5-- |

3-- Module : Data.Text.Encoding.Error

6-- Module : Data.Text.Encoding.Error

4-- Copyright : (c) Bryan O'Sullivan 2009

7-- Copyright : (c) Bryan O'Sullivan 2009

@@ -35,11 +38,8 @@ module Data.Text.Encoding.Error

35 , replace

38 , replace

36 ) where

39 ) where

37

40

38−#if __GLASGOW_HASKELL__ >= 610

41+import Control.DeepSeq (NFData (..))

39import Control.Exception (Exception, throw)

42import Control.Exception (Exception, throw)

40−#else

41−import Control.Exception.Extensible (Exception, throw)

42−#endif

43import Data.Typeable (Typeable)

44import Data.Word (Word8)

45import Numeric (showHex)

@@ -88,12 +88,16 @@ showUnicodeException (EncodeError desc (Just c))

88 = "Cannot encode character '\\x" ++ showHex (fromEnum c) ("': " ++ desc)

89showUnicodeException (EncodeError desc Nothing)

90 = "Cannot encode input: " ++ desc

91−

91+

92instance Show UnicodeException where

93 show = showUnicodeException

94

95instance Exception UnicodeException

96

97+instance NFData UnicodeException where

98+ rnf (DecodeError desc w) = rnf desc `seq` rnf w `seq` ()

99+ rnf (EncodeError desc c) = rnf desc `seq` rnf c `seq` ()

100+

97-- | Throw a 'UnicodeException' if decoding fails.

101-- | Throw a 'UnicodeException' if decoding fails.

98strictDecode :: OnDecodeError

102strictDecode :: OnDecodeError

99strictDecode desc c = throw (DecodeError desc c)

103strictDecode desc c = throw (DecodeError desc c)

Data/Text/Encoding/Fusion.hs+2−2

@@ -44,12 +44,12 @@ import Data.Text.UnsafeShift (shiftL, shiftR)

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

45import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)

46import Foreign.Storable (pokeByteOff)

47−import System.IO.Unsafe (unsafePerformIO)

48import qualified Data.ByteString as B

47import qualified Data.ByteString as B

49import qualified Data.ByteString.Unsafe as B

48import qualified Data.ByteString.Unsafe as B

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

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

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

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

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

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

52+import Data.Text.Unsafe (unsafeDupablePerformIO)

53

54streamASCII :: ByteString -> Stream Char

55streamASCII bs = Stream next 0 (maxSize l)

@@ -163,7 +163,7 @@ streamUtf32LE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))

163

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

165unstream :: Stream Word8 -> ByteString

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

166+unstream (Stream next s0 len) = unsafeDupablePerformIO $ do

167 let mlen = upperBound 4 len

168 mallocByteString mlen >>= loop mlen 0 s0

169 where

Data/Text/Encoding/Fusion/Common.hs+1−27

@@ -21,8 +21,7 @@ module Data.Text.Encoding.Fusion.Common

21 -- * Restreaming

22 -- Restreaming is the act of converting from one 'Stream'

23 -- representation to another.

24− restreamUtf8

25− , restreamUtf16LE

24+ restreamUtf16LE

26 , restreamUtf16BE

25 , restreamUtf16BE

27 , restreamUtf32LE

26 , restreamUtf32LE

28 , restreamUtf32BE

27 , restreamUtf32BE

@@ -34,31 +33,6 @@ import Data.Text.Fusion.Internal (RS(..))

34import Data.Text.UnsafeChar (ord)

33import Data.Text.UnsafeChar (ord)

35import Data.Text.UnsafeShift (shiftR)

34import Data.Text.UnsafeShift (shiftR)

36import Data.Word (Word8)

35import Data.Word (Word8)

37−import qualified Data.Text.Encoding.Utf8 as U8

38−

39−-- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.

40−restreamUtf8 :: Stream Char -> Stream Word8

41−restreamUtf8 (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

42− where

43− next (RS0 s) = case next0 s of

44− Done -> Done

45− Skip s' -> Skip (RS0 s')

46− Yield x s'

47− | n <= 0x7F -> Yield c (RS0 s')

48− | n <= 0x07FF -> Yield a2 (RS1 s' b2)

49− | n <= 0xFFFF -> Yield a3 (RS2 s' b3 c3)

50− | otherwise -> Yield a4 (RS3 s' b4 c4 d4)

51− where

52− n = ord x

53− c = fromIntegral n

54− (a2,b2) = U8.ord2 x

55− (a3,b3,c3) = U8.ord3 x

56− (a4,b4,c4,d4) = U8.ord4 x

57− next (RS1 s x2) = Yield x2 (RS0 s)

58− next (RS2 s x2 x3) = Yield x2 (RS1 s x3)

59− next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)

60− {-# INLINE next #-}

61−{-# INLINE restreamUtf8 #-}

62

36

63restreamUtf16BE :: Stream Char -> Stream Word8

37restreamUtf16BE :: Stream Char -> Stream Word8

64restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

38restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

Data/Text/Encoding/Utf8.hs+1−1

@@ -146,7 +146,7 @@ validate3 x1 x2 x3 = validate3_1 || validate3_2 || validate3_3 || validate3_4

146validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool

147{-# INLINE validate4 #-}

148validate4 x1 x2 x3 x4 = validate4_1 || validate4_2 || validate4_3

149− where

149+ where

150 validate4_1 = x1 == 0xF0 &&

151 between x2 0x90 0xBF &&

152 between x3 0x80 0xBF &&

Data/Text/Foreign.hs+26−2

@@ -21,6 +21,9 @@ module Data.Text.Foreign

21 , fromPtr

22 , useAsPtr

23 , asForeignPtr

24+ -- ** Encoding as UTF-8

25+ , peekCStringLen

26+ , withCStringLen

24 -- * Unsafe conversion code

27 -- * Unsafe conversion code

25 , lengthWord16

28 , lengthWord16

26 , unsafeCopyToPtr

29 , unsafeCopyToPtr

@@ -38,14 +41,17 @@ import Control.Monad.ST.Unsafe (unsafeIOToST)

38#else

41#else

39import Control.Monad.ST (unsafeIOToST)

42import Control.Monad.ST (unsafeIOToST)

40#endif

43#endif

44+import Data.ByteString.Unsafe (unsafePackCStringLen, unsafeUseAsCStringLen)

45+import Data.Text.Encoding (decodeUtf8, encodeUtf8)

41import Data.Text.Internal (Text(..), empty)

46import Data.Text.Internal (Text(..), empty)

42import Data.Text.Unsafe (lengthWord16)

47import Data.Text.Unsafe (lengthWord16)

43−import qualified Data.Text.Array as A

44import Data.Word (Word16)

48import Data.Word (Word16)

49+import Foreign.C.String (CStringLen)

50+import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray, withForeignPtr)

45import Foreign.Marshal.Alloc (allocaBytes)

51import Foreign.Marshal.Alloc (allocaBytes)

46import Foreign.Ptr (Ptr, castPtr, plusPtr)

52import Foreign.Ptr (Ptr, castPtr, plusPtr)

47−import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray, withForeignPtr)

48import Foreign.Storable (peek, poke)

53import Foreign.Storable (peek, poke)

54+import qualified Data.Text.Array as A

49

55

50-- $interop

56-- $interop

51--

57--

@@ -148,3 +154,21 @@ asForeignPtr t@(Text _arr _off len) = do

148 fp <- mallocForeignPtrArray len

154 fp <- mallocForeignPtrArray len

149 withForeignPtr fp $ unsafeCopyToPtr t

155 withForeignPtr fp $ unsafeCopyToPtr t

150 return (fp, I16 len)

156 return (fp, I16 len)

157+

158+-- | /O(n)/ Decode a C string with explicit length, which is assumed

159+-- to have been encoded as UTF-8. If decoding fails, a

160+-- 'UnicodeException' is thrown.

161+peekCStringLen :: CStringLen -> IO Text

162+peekCStringLen cs = do

163+ bs <- unsafePackCStringLen cs

164+ return $! decodeUtf8 bs

165+

166+-- | Marshal a 'Text' into a C string encoded as UTF-8 in temporary

167+-- storage, with explicit length information. The encoded string may

168+-- contain NUL bytes, and is not followed by a trailing NUL byte.

169+--

170+-- The temporary storage is freed when the subcomputation terminates

171+-- (either normally or via an exception), so the pointer to the

172+-- temporary storage must /not/ be used after this function returns.

173+withCStringLen :: Text -> (CStringLen -> IO a) -> IO a

174+withCStringLen t act = unsafeUseAsCStringLen (encodeUtf8 t) act

Data/Text/Fusion.hs+11−11

@@ -51,6 +51,7 @@ import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,

51 fromIntegral, otherwise)

52import Data.Bits ((.&.))

53import Data.Text.Internal (Text(..))

54+import Data.Text.Private (runText)

54import Data.Text.UnsafeChar (ord, unsafeChr, unsafeWrite)

55import Data.Text.UnsafeChar (ord, unsafeChr, unsafeWrite)

55import Data.Text.UnsafeShift (shiftL, shiftR)

56import Data.Text.UnsafeShift (shiftL, shiftR)

56import qualified Data.Text.Array as A

57import qualified Data.Text.Array as A

@@ -59,7 +60,6 @@ import Data.Text.Fusion.Internal

59import Data.Text.Fusion.Size

60import Data.Text.Fusion.Size

60import qualified Data.Text.Internal as I

61import qualified Data.Text.Internal as I

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

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

62−import qualified Prelude as P

63

64default(Int)

65

@@ -94,15 +94,14 @@ reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)

94

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

96unstream :: Stream Char -> Text

97−unstream (Stream next0 s0 len) = I.textP (P.fst a) 0 (P.snd a)

97+unstream (Stream next0 s0 len) = runText $ \done -> do

98− where

99− a = A.run2 (A.new mlen >>= \arr -> outer arr mlen s0 0)

100− where mlen = upperBound 4 len

98+ let mlen = upperBound 4 len

99+ arr0 <- A.new mlen

101− outer arr top = loop

100+ let outer arr top = loop

102− where

101+ where

103 loop !s !i =

102 loop !s !i =

104 case next0 s of

103 case next0 s of

105− Done -> return (arr, i)

104+ Done -> done arr i

106 Skip s' -> loop s' i

105 Skip s' -> loop s' i

107 Yield x s'

106 Yield x s'

108 | j >= top -> {-# SCC "unstream/resize" #-} do

107 | j >= top -> {-# SCC "unstream/resize" #-} do

@@ -114,6 +113,7 @@ unstream (Stream next0 s0 len) = I.textP (P.fst a) 0 (P.snd a)

114 loop s' (i+d)

113 loop s' (i+d)

115 where j | ord x < 0x10000 = i

114 where j | ord x < 0x10000 = i

116 | otherwise = i + 1

115 | otherwise = i + 1

116+ outer arr0 mlen s0 0

117{-# INLINE [0] unstream #-}

118{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}

119

@@ -223,9 +223,9 @@ mapAccumL f z0 (Stream next0 s0 len) = (nz,I.textP na 0 nl)

223 arr' <- A.new 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

226+ | otherwise -> do d <- unsafeWrite arr i c

228 loop z' s' (i+d)

227 loop z' s' (i+d)

228+ where (z',c) = f z x

229− where j | ord x < 0x10000 = i

229+ j | ord c < 0x10000 = i

230 | otherwise = i + 1

231{-# INLINE [0] mapAccumL #-}

Data/Text/Fusion/Common.hs+42−6

@@ -1,7 +1,7 @@

1−{-# LANGUAGE BangPatterns, Rank2Types #-}

1+{-# LANGUAGE BangPatterns, MagicHash, Rank2Types #-}

2-- |

3-- Module : Data.Text.Fusion.Common

4−-- Copyright : (c) Bryan O'Sullivan 2009

4+-- Copyright : (c) Bryan O'Sullivan 2009, 2012

5--

6-- License : BSD-style

7-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

@@ -17,6 +17,7 @@ module Data.Text.Fusion.Common

17 singleton

18 , streamList

19 , unstreamList

20+ , streamCString#

20

21

21 -- * Basic interface

22 -- * Basic interface

22 , cons

23 , cons

@@ -104,10 +105,13 @@ import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),

104 (&&), fromIntegral, otherwise)

105 (&&), fromIntegral, otherwise)

105import qualified Data.List as L

106import qualified Data.List as L

106import qualified Prelude as P

107import qualified Prelude as P

108+import Data.Bits (shiftL)

107import Data.Int (Int64)

109import Data.Int (Int64)

108import Data.Text.Fusion.Internal

110import Data.Text.Fusion.Internal

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

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

110import Data.Text.Fusion.Size

112import Data.Text.Fusion.Size

113+import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)

114+import GHC.Types (Char(..), Int(..))

111

115

112singleton :: Char -> Stream Char

116singleton :: Char -> Stream Char

113singleton c = Stream next False 1

117singleton c = Stream next False 1

@@ -131,6 +135,35 @@ unstreamList (Stream next s0 _len) = unfold s0

131

135

132{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}

136{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}

133

137

138+-- | Stream the UTF-8-like packed encoding used by GHC to represent

139+-- constant strings in generated code.

140+--

141+-- This encoding uses the byte sequence "\xc0\x80" to represent NUL,

142+-- and the string is NUL-terminated.

143+streamCString# :: Addr# -> Stream Char

144+streamCString# addr = Stream step 0 unknownSize

145+ where

146+ step !i

147+ | b == 0 = Done

148+ | b <= 0x7f = Yield (C# b#) (i+1)

149+ | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1

150+ in Yield c (i+2)

151+ | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +

152+ (next 1 `shiftL` 6) +

153+ next 2

154+ in Yield c (i+3)

155+ | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +

156+ (next 1 `shiftL` 12) +

157+ (next 2 `shiftL` 6) +

158+ next 3

159+ in Yield c (i+4)

160+ where b = I# (ord# b#)

161+ next n = I# (ord# (at# (i+n))) - 0x80

162+ !b# = at# i

163+ at# (I# i#) = indexCharOffAddr# addr i#

164+ chr (I# i#) = C# (chr# i#)

165+{-# INLINE [0] streamCString# #-}

166+

134-- ----------------------------------------------------------------------------

167-- ----------------------------------------------------------------------------

135-- * Basic stream functions

168-- * Basic stream functions

136

169

@@ -139,7 +172,7 @@ data C s = C0 !s

139

172

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

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

141cons :: Char -> Stream Char -> Stream Char

174cons :: Char -> Stream Char -> Stream Char

142−cons w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)

175+cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)

143 where

176 where

144 next (C1 s) = Yield w (C0 s)

177 next (C1 s) = Yield w (C0 s)

145 next (C0 s) = case next0 s of

178 next (C0 s) = case next0 s of

@@ -185,9 +218,13 @@ head (Stream next s0 _len) = loop_head s0

185 loop_head !s = case next s of

218 loop_head !s = case next s of

186 Yield x _ -> x

219 Yield x _ -> x

187 Skip s' -> loop_head s'

220 Skip s' -> loop_head s'

188− Done -> streamError "head" "Empty stream"

221+ Done -> head_empty

189{-# INLINE [0] head #-}

222{-# INLINE [0] head #-}

190

223

224+head_empty :: a

225+head_empty = streamError "head" "Empty stream"

226+{-# NOINLINE head_empty #-}

227+

191-- | /O(1)/ Returns the first character and remainder of a 'Stream

228-- | /O(1)/ Returns the first character and remainder of a 'Stream

192-- Char', or 'Nothing' if empty. Subject to array fusion.

229-- Char', or 'Nothing' if empty. Subject to array fusion.

193uncons :: Stream Char -> Maybe (Char, Stream Char)

230uncons :: Stream Char -> Maybe (Char, Stream Char)

@@ -274,7 +311,7 @@ lengthI (Stream next s0 _len) = loop_length 0 s0

274-- of 'lengthI', but can short circuit if the count of characters is

311-- of 'lengthI', but can short circuit if the count of characters is

275-- greater than the number, and hence be more efficient.

312-- greater than the number, and hence be more efficient.

276compareLengthI :: Integral a => Stream Char -> a -> Ordering

313compareLengthI :: Integral a => Stream Char -> a -> Ordering

277−compareLengthI (Stream next s0 len) n =

314+compareLengthI (Stream next s0 len) n =

278 case exactly len of

315 case exactly len of

279 Nothing -> loop_cmp 0 s0

316 Nothing -> loop_cmp 0 s0

280 Just i -> compare (fromIntegral i) n

317 Just i -> compare (fromIntegral i) n

@@ -743,7 +780,6 @@ isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

743 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&

780 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&

744 loop (next1 s1') (next2 s2')

781 loop (next1 s1') (next2 s2')

745{-# INLINE [0] isPrefixOf #-}

782{-# INLINE [0] isPrefixOf #-}

746−{-# SPECIALISE isPrefixOf :: Stream Char -> Stream Char -> Bool #-}

747

783

748-- ----------------------------------------------------------------------------

784-- ----------------------------------------------------------------------------

749-- * Searching

785-- * Searching

Data/Text/Fusion/Internal.hs−2

@@ -101,7 +101,6 @@ eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

101 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&

102 loop (next1 s1') (next2 s2')

103{-# INLINE [0] eq #-}

104−{-# SPECIALISE eq :: Stream Char -> Stream Char -> Bool #-}

105

104

106cmp :: (Ord a) => Stream a -> Stream a -> Ordering

105cmp :: (Ord a) => Stream a -> Stream a -> Ordering

107cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

106cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

@@ -117,7 +116,6 @@ cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

117 EQ -> loop (next1 s1') (next2 s2')

116 EQ -> loop (next1 s1') (next2 s2')

118 other -> other

117 other -> other

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

118{-# INLINE [0] cmp #-}

120−{-# SPECIALISE cmp :: Stream Char -> Stream Char -> Ordering #-}

121

119

122-- | The empty stream.

120-- | The empty stream.

123empty :: Stream a

121empty :: Stream a

Data/Text/Fusion/Size.hs+2−2

@@ -93,8 +93,8 @@ subtractSize _ _ = Unknown

93

94mul :: Int -> Int -> Int

95mul m n

96− | m <= maxBound `div` n = m * n

96+ | m <= maxBound `quot` n = m * n

97− | otherwise = overflowError

97+ | otherwise = overflowError

98{-# INLINE mul #-}

99

100mulSize :: Size -> Size -> Size

Data/Text/IO.hs+39−35

@@ -1,4 +1,7 @@

1{-# LANGUAGE BangPatterns, CPP, RecordWildCards, ScopedTypeVariables #-}

2+#if __GLASGOW_HASKELL__ >= 702

3+{-# LANGUAGE Trustworthy #-}

4+#endif

2-- |

5-- |

3-- Module : Data.Text.IO

6-- Module : Data.Text.IO

@@ -16,7 +19,7 @@

16module Data.Text.IO

19module Data.Text.IO

17 (

20 (

18 -- * Performance

21 -- * Performance

19− -- $performance

22+ -- $performance

20

23

21 -- * Locale support

24 -- * Locale support

22 -- $locale

25 -- $locale

@@ -26,6 +29,7 @@ module Data.Text.IO

26 , appendFile

29 , appendFile

27 -- * Operations on handles

30 -- * Operations on handles

28 , hGetContents

31 , hGetContents

32+ , hGetChunk

29 , hGetLine

33 , hGetLine

30 , hPutStr

34 , hPutStr

31 , hPutStrLn

35 , hPutStrLn

@@ -38,15 +42,11 @@ module Data.Text.IO

38 ) where

42 ) where

39

43

40import Data.Text (Text)

44import Data.Text (Text)

41−import Prelude hiding (appendFile, catch, getContents, getLine, interact,

45+import Prelude hiding (appendFile, getContents, getLine, interact,

42 putStr, putStrLn, readFile, writeFile)

46 putStr, putStrLn, readFile, writeFile)

43import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,

47import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,

44 withFile)

48 withFile)

45−#if __GLASGOW_HASKELL__ <= 610

46−import qualified Data.ByteString.Char8 as B

47−import Data.Text.Encoding (decodeUtf8, encodeUtf8)

48−#else

49−import Control.Exception (catch, throwIO)

49+import qualified Control.Exception as E

50import Control.Monad (liftM2, when)

51import Data.IORef (readIORef, writeIORef)

52import qualified Data.Text as T

@@ -64,7 +64,6 @@ import GHC.IO.Handle.Types (BufferList(..), BufferMode(..), Handle__(..),

64 HandleType(..), Newline(..))

65import System.IO (hGetBuffering, hFileSize, hSetBuffering, hTell)

66import System.IO.Error (isEOFError)

67−#endif

68

67

69-- $performance

68-- $performance

70-- #performance#

69-- #performance#

@@ -97,6 +96,30 @@ writeFile p = withFile p WriteMode . flip hPutStr

97appendFile :: FilePath -> Text -> IO ()

96appendFile :: FilePath -> Text -> IO ()

98appendFile p = withFile p AppendMode . flip hPutStr

97appendFile p = withFile p AppendMode . flip hPutStr

99

98

99+catchError :: String -> Handle -> Handle__ -> IOError -> IO Text

100+catchError caller h Handle__{..} err

101+ | isEOFError err = do

102+ buf <- readIORef haCharBuffer

103+ return $ if isEmptyBuffer buf

104+ then T.empty

105+ else T.singleton '\r'

106+ | otherwise = E.throwIO (augmentIOError err caller h)

107+

108+-- | /Experimental./ Read a single chunk of strict text from a

109+-- 'Handle'. The size of the chunk depends on the amount of input

110+-- currently buffered.

111+--

112+-- This function blocks only if there is no data available, and EOF

113+-- has not yet been reached. Once EOF is reached, this function

114+-- returns an empty string instead of throwing an exception.

115+hGetChunk :: Handle -> IO Text

116+hGetChunk h = wantReadableHandle "hGetChunk" h readSingleChunk

117+ where

118+ readSingleChunk hh@Handle__{..} = do

119+ buf <- readIORef haCharBuffer

120+ t <- readChunk hh buf `E.catch` catchError "hGetChunk" h hh

121+ return (hh, t)

122+

100-- | Read the remaining contents of a 'Handle' as a string. The

123-- | Read the remaining contents of a 'Handle' as a string. The

101-- 'Handle' is closed once the contents have been read, or if an

124-- 'Handle' is closed once the contents have been read, or if an

102-- exception is thrown.

125-- exception is thrown.

@@ -109,31 +132,21 @@ appendFile p = withFile p AppendMode . flip hPutStr

109-- result to construct its result. For files more than a half of

132-- result to construct its result. For files more than a half of

110-- available RAM in size, this may result in memory exhaustion.

133-- available RAM in size, this may result in memory exhaustion.

111hGetContents :: Handle -> IO Text

134hGetContents :: Handle -> IO Text

112−#if __GLASGOW_HASKELL__ <= 610

113−hGetContents = fmap decodeUtf8 . B.hGetContents

114−#else

115hGetContents h = do

135hGetContents h = do

116 chooseGoodBuffering h

136 chooseGoodBuffering h

117 wantReadableHandle "hGetContents" h readAll

137 wantReadableHandle "hGetContents" h readAll

118 where

138 where

119 readAll hh@Handle__{..} = do

139 readAll hh@Handle__{..} = do

120− let catchError e

121− | isEOFError e = do

122− buf <- readIORef haCharBuffer

123− return $ if isEmptyBuffer buf

124− then T.empty

125− else T.singleton '\r'

126− | otherwise = throwIO (augmentIOError e "hGetContents" h)

127− readChunks = do

140+ let readChunks = do

128 buf <- readIORef haCharBuffer

141 buf <- readIORef haCharBuffer

129− t <- readChunk hh buf `catch` catchError

142+ t <- readChunk hh buf `E.catch` catchError "hGetContents" h hh

130 if T.null t

143 if T.null t

131 then return [t]

144 then return [t]

132 else (t:) `fmap` readChunks

145 else (t:) `fmap` readChunks

133 ts <- readChunks

146 ts <- readChunks

134 (hh', _) <- hClose_help hh

147 (hh', _) <- hClose_help hh

135 return (hh'{haType=ClosedHandle}, T.concat ts)

148 return (hh'{haType=ClosedHandle}, T.concat ts)

136−

149+

137-- | Use a more efficient buffer size if we're reading in

150-- | Use a more efficient buffer size if we're reading in

138-- block-buffered mode with the default buffer size. When we can

151-- block-buffered mode with the default buffer size. When we can

139-- determine the size of the handle we're reading, set the buffer size

152-- determine the size of the handle we're reading, set the buffer size

@@ -144,30 +157,22 @@ chooseGoodBuffering h = do

144 bufMode <- hGetBuffering h

157 bufMode <- hGetBuffering h

145 case bufMode of

158 case bufMode of

146 BlockBuffering Nothing -> do

159 BlockBuffering Nothing -> do

147− d <- catch (liftM2 (-) (hFileSize h) (hTell h)) $ \(e::IOException) ->

160+ d <- E.catch (liftM2 (-) (hFileSize h) (hTell h)) $ \(e::IOException) ->

148 if ioe_type e == InappropriateType

161 if ioe_type e == InappropriateType

149 then return 16384 -- faster than the 2KB default

162 then return 16384 -- faster than the 2KB default

150− else throwIO e

163+ else E.throwIO e

151 when (d > 0) . hSetBuffering h . BlockBuffering . Just . fromIntegral $ d

164 when (d > 0) . hSetBuffering h . BlockBuffering . Just . fromIntegral $ d

152 _ -> return ()

165 _ -> return ()

153−#endif

154

166

155-- | Read a single line from a handle.

167-- | Read a single line from a handle.

156hGetLine :: Handle -> IO Text

168hGetLine :: Handle -> IO Text

157−#if __GLASGOW_HASKELL__ <= 610

158−hGetLine = fmap decodeUtf8 . B.hGetLine

159−#else

160hGetLine = hGetLineWith T.concat

169hGetLine = hGetLineWith T.concat

161−#endif

162

170

163-- | Write a string to a handle.

171-- | Write a string to a handle.

164hPutStr :: Handle -> Text -> IO ()

172hPutStr :: Handle -> Text -> IO ()

165−#if __GLASGOW_HASKELL__ <= 610

166−hPutStr h = B.hPutStr h . encodeUtf8

167−#else

168-- This function is lifted almost verbatim from GHC.IO.Handle.Text.

173-- This function is lifted almost verbatim from GHC.IO.Handle.Text.

169hPutStr h t = do

174hPutStr h t = do

170− (buffer_mode, nl) <-

175+ (buffer_mode, nl) <-

171 wantWritableHandle "hPutStr" h $ \h_ -> do

176 wantWritableHandle "hPutStr" h $ \h_ -> do

172 bmode <- getSpareBuffer h_

177 bmode <- getSpareBuffer h_

173 return (bmode, haOutputNL h_)

178 return (bmode, haOutputNL h_)

@@ -249,7 +254,7 @@ writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0

249

254

250-- This function is completely lifted from GHC.IO.Handle.Text.

255-- This function is completely lifted from GHC.IO.Handle.Text.

251getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)

256getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)

252−getSpareBuffer Handle__{haCharBuffer=ref,

257+getSpareBuffer Handle__{haCharBuffer=ref,

253 haBuffers=spare_ref,

258 haBuffers=spare_ref,

254 haBufferMode=mode}

259 haBufferMode=mode}

255 = do

260 = do

@@ -270,11 +275,10 @@ getSpareBuffer Handle__{haCharBuffer=ref,

270-- This function is completely lifted from GHC.IO.Handle.Text.

275-- This function is completely lifted from GHC.IO.Handle.Text.

271commitBuffer :: Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool

276commitBuffer :: Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool

272 -> IO CharBuffer

277 -> IO CharBuffer

273−commitBuffer hdl !raw !sz !count flush release =

278+commitBuffer hdl !raw !sz !count flush release =

274 wantWritableHandle "commitAndReleaseBuffer" hdl $

279 wantWritableHandle "commitAndReleaseBuffer" hdl $

275 commitBuffer' raw sz count flush release

280 commitBuffer' raw sz count flush release

276{-# INLINE commitBuffer #-}

281{-# INLINE commitBuffer #-}

277−#endif

278

282

279-- | Write a string to a handle, followed by a newline.

283-- | Write a string to a handle, followed by a newline.

280hPutStrLn :: Handle -> Text -> IO ()

284hPutStrLn :: Handle -> Text -> IO ()

Data/Text/IO/Internal.hs+4−9

@@ -12,14 +12,11 @@

12

13module Data.Text.IO.Internal

14 (

15−#if __GLASGOW_HASKELL__ >= 612

16 hGetLineWith

15 hGetLineWith

17 , readChunk

16 , readChunk

18−#endif

19 ) where

17 ) where

20

18

21−#if __GLASGOW_HASKELL__ >= 612

22−import Control.Exception (catch)

19+import qualified Control.Exception as E

23import Data.IORef (readIORef, writeIORef)

20import Data.IORef (readIORef, writeIORef)

24import Data.Text (Text)

21import Data.Text (Text)

25import Data.Text.Fusion (unstream)

22import Data.Text.Fusion (unstream)

@@ -32,7 +29,6 @@ import GHC.IO.Buffer (Buffer(..), CharBuffer, RawCharBuffer, bufferAdjustL,

32 withRawBuffer, writeCharBuf)

29 withRawBuffer, writeCharBuf)

33import GHC.IO.Handle.Internals (ioe_EOF, readTextDevice, wantReadableHandle_)

30import GHC.IO.Handle.Internals (ioe_EOF, readTextDevice, wantReadableHandle_)

34import GHC.IO.Handle.Types (Handle__(..), Newline(..))

31import GHC.IO.Handle.Types (Handle__(..), Newline(..))

35−import Prelude hiding (catch)

36import System.IO (Handle)

32import System.IO (Handle)

37import System.IO.Error (isEOFError)

33import System.IO.Error (isEOFError)

38import qualified Data.Text as T

34import qualified Data.Text as T

@@ -84,9 +80,9 @@ hGetLineLoop hh@Handle__{..} = go where

84-- This function is lifted almost verbatim from GHC.IO.Handle.Text.

80-- This function is lifted almost verbatim from GHC.IO.Handle.Text.

85maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)

81maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)

86maybeFillReadBuffer handle_ buf

82maybeFillReadBuffer handle_ buf

87− = catch (Just `fmap` getSomeCharacters handle_ buf) $ \e ->

83+ = E.catch (Just `fmap` getSomeCharacters handle_ buf) $ \e ->

88− if isEOFError e

84+ if isEOFError e

89− then return Nothing

85+ then return Nothing

90 else ioError e

86 else ioError e

91

87

92unpack :: RawCharBuffer -> Int -> Int -> IO Text

88unpack :: RawCharBuffer -> Int -> Int -> IO Text

@@ -164,4 +160,3 @@ readChunk hh@Handle__{..} buf = do

164

160

165sizeError :: String -> a

161sizeError :: String -> a

166sizeError loc = error $ "Data.Text.IO." ++ loc ++ ": bad internal buffer size"

162sizeError loc = error $ "Data.Text.IO." ++ loc ++ ": bad internal buffer size"

167−#endif

Data/Text/Internal.hs+25−4

@@ -23,6 +23,7 @@

23module Data.Text.Internal

24 (

25 -- * Types

26+ -- $internals

26 Text(..)

27 Text(..)

27 -- * Construction

28 -- * Construction

28 , text

29 , text

@@ -47,9 +48,9 @@ import Data.Typeable (Typeable)

47

48

48-- | A space efficient, packed, unboxed Unicode text type.

49-- | A space efficient, packed, unboxed Unicode text type.

49data Text = Text

50data Text = Text

50− {-# UNPACK #-} !A.Array -- payload

51+ {-# UNPACK #-} !A.Array -- payload (Word16 elements)

51− {-# UNPACK #-} !Int -- offset

52+ {-# UNPACK #-} !Int -- offset (units of Word16, not Char)

52− {-# UNPACK #-} !Int -- length

53+ {-# UNPACK #-} !Int -- length (units of Word16, not Char)

53 deriving (Typeable)

54 deriving (Typeable)

54

55

55-- | Smart constructor.

56-- | Smart constructor.

@@ -90,7 +91,8 @@ showText (Text arr off len) =

90-- scalar values, but are unfortunately admitted as valid 'Char'

91-- scalar values, but are unfortunately admitted as valid 'Char'

91-- values by Haskell. They cannot be represented in a 'Text'. This

92-- values by Haskell. They cannot be represented in a 'Text'. This

92-- function remaps those code points to the Unicode replacement

93-- function remaps those code points to the Unicode replacement

93−-- character \"�\", and leaves other code points unchanged.

94+-- character (U+FFFD, \'�\'), and leaves other code points

95+-- unchanged.

94safe :: Char -> Char

96safe :: Char -> Char

95safe c

97safe c

96 | ord c .&. 0x1ff800 /= 0xd800 = c

98 | ord c .&. 0x1ff800 /= 0xd800 = c

@@ -101,3 +103,22 @@ safe c

101firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)

103firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)

102firstf f (Just (a, b)) = Just (f a, b)

104firstf f (Just (a, b)) = Just (f a, b)

103firstf _ Nothing = Nothing

105firstf _ Nothing = Nothing

106+

107+-- $internals

108+--

109+-- Internally, the 'Text' type is represented as an array of 'Word16'

110+-- UTF-16 code units. The offset and length fields in the constructor

111+-- are in these units, /not/ units of 'Char'.

112+--

113+-- Invariants that all functions must maintain:

114+--

115+-- * Since the 'Text' type uses UTF-16 internally, it cannot represent

116+-- characters in the reserved surrogate code point range U+D800 to

117+-- U+DFFF. To maintain this invariant, the 'safe' function maps

118+-- 'Char' values in this range to the replacement character (U+FFFD,

119+-- \'�\').

120+--

121+-- * A leading (or \"high\") surrogate code unit (0xD800–0xDBFF) must

122+-- always be followed by a trailing (or \"low\") surrogate code unit

123+-- (0xDC00-0xDFFF). A trailing surrogate code unit must always be

124+-- preceded by a leading surrogate code unit.

Data/Text/Lazy.hs+29−15

@@ -1,8 +1,11 @@

1{-# OPTIONS_GHC -fno-warn-orphans #-}

2−{-# LANGUAGE BangPatterns, CPP #-}

2+{-# LANGUAGE BangPatterns, MagicHash, CPP #-}

3+#if __GLASGOW_HASKELL__ >= 702

4+{-# LANGUAGE Trustworthy #-}

5+#endif

3-- |

6-- |

4-- Module : Data.Text.Lazy

7-- Module : Data.Text.Lazy

6--

9--

7-- License : BSD-style

10-- License : BSD-style

8-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

11-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

@@ -174,7 +177,7 @@ module Data.Text.Lazy

174 , partition

177 , partition

175

178

176 -- , findSubstring

179 -- , findSubstring

177−

180+

178 -- * Indexing

181 -- * Indexing

179 , index

182 , index

180 , count

183 , count

@@ -190,7 +193,7 @@ module Data.Text.Lazy

190import Prelude (Char, Bool(..), Maybe(..), String,

193import Prelude (Char, Bool(..), Maybe(..), String,

191 Eq(..), Ord(..), Ordering(..), Read(..), Show(..),

194 Eq(..), Ord(..), Ordering(..), Read(..), Show(..),

192 (&&), (||), (+), (-), (.), ($), (++),

195 (&&), (||), (+), (-), (.), ($), (++),

193− div, error, flip, fmap, fromIntegral, not, otherwise)

196+ error, flip, fmap, fromIntegral, not, otherwise, quot)

194import qualified Prelude as P

197import qualified Prelude as P

195#if defined(HAVE_DEEPSEQ)

198#if defined(HAVE_DEEPSEQ)

196import Control.DeepSeq (NFData(..))

199import Control.DeepSeq (NFData(..))

@@ -199,11 +202,7 @@ import Data.Int (Int64)

199import qualified Data.List as L

202import qualified Data.List as L

200import Data.Char (isSpace)

203import Data.Char (isSpace)

201import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))

204import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))

202−#if __GLASGOW_HASKELL__ >= 612

203import Data.Data (mkNoRepType)

205import Data.Data (mkNoRepType)

204−#else

205−import Data.Data (mkNorepType)

206−#endif

207import Data.Monoid (Monoid(..))

206import Data.Monoid (Monoid(..))

208import Data.String (IsString(..))

207import Data.String (IsString(..))

209import qualified Data.Text as T

208import qualified Data.Text as T

@@ -217,6 +216,12 @@ import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldlChunks, foldrChunks

217import Data.Text.Internal (firstf, safe, textP)

216import Data.Text.Internal (firstf, safe, textP)

218import qualified Data.Text.Util as U

217import qualified Data.Text.Util as U

219import Data.Text.Lazy.Search (indices)

218import Data.Text.Lazy.Search (indices)

219+#if __GLASGOW_HASKELL__ >= 702

220+import qualified GHC.CString as GHC

221+#else

222+import qualified GHC.Base as GHC

223+#endif

224+import GHC.Prim (Addr#)

220

225

221-- $fusion

226-- $fusion

222--

227--

@@ -332,11 +337,7 @@ instance Data Text where

332 gfoldl f z txt = z pack `f` (unpack txt)

337 gfoldl f z txt = z pack `f` (unpack txt)

333 toConstr _ = error "Data.Text.Lazy.Text.toConstr"

338 toConstr _ = error "Data.Text.Lazy.Text.toConstr"

334 gunfold _ _ = error "Data.Text.Lazy.Text.gunfold"

339 gunfold _ _ = error "Data.Text.Lazy.Text.gunfold"

335−#if __GLASGOW_HASKELL__ >= 612

336 dataTypeOf _ = mkNoRepType "Data.Text.Lazy.Text"

340 dataTypeOf _ = mkNoRepType "Data.Text.Lazy.Text"

337−#else

338− dataTypeOf _ = mkNorepType "Data.Text.Lazy.Text"

339−#endif

340

341

341-- | /O(n)/ Convert a 'String' into a 'Text'.

342-- | /O(n)/ Convert a 'String' into a 'Text'.

342--

343--

@@ -351,6 +352,19 @@ unpack :: Text -> String

351unpack t = S.unstreamList (stream t)

352unpack t = S.unstreamList (stream t)

352{-# INLINE [1] unpack #-}

353{-# INLINE [1] unpack #-}

353

354

355+-- | /O(n)/ Convert a literal string into a Text.

356+unpackCString# :: Addr# -> Text

357+unpackCString# addr# = unstream (S.streamCString# addr#)

358+{-# NOINLINE unpackCString# #-}

359+

360+{-# RULES "TEXT literal" forall a.

361+ unstream (S.streamList (L.map safe (GHC.unpackCString# a)))

362+ = unpackCString# a #-}

363+

364+{-# RULES "TEXT literal UTF8" forall a.

365+ unstream (S.streamList (L.map safe (GHC.unpackCStringUtf8# a)))

366+ = unpackCString# a #-}

367+

354-- | /O(1)/ Convert a character into a Text. Subject to fusion.

368-- | /O(1)/ Convert a character into a Text. Subject to fusion.

355-- Performs replacement on invalid scalar values.

369-- Performs replacement on invalid scalar values.

356singleton :: Char -> Text

370singleton :: Char -> Text

@@ -606,7 +620,7 @@ center k c t

606 | otherwise = replicateChar l c `append` t `append` replicateChar r c

620 | otherwise = replicateChar l c `append` t `append` replicateChar r c

607 where len = length t

621 where len = length t

608 d = k - len

622 d = k - len

609− r = d `div` 2

623+ r = d `quot` 2

610 l = d - r

624 l = d - r

611{-# INLINE center #-}

625{-# INLINE center #-}

612

626

@@ -902,7 +916,7 @@ drop i t0

902 | otherwise = drop' i t0

916 | otherwise = drop' i t0

903 where drop' 0 ts = ts

917 where drop' 0 ts = ts

904 drop' _ Empty = Empty

918 drop' _ Empty = Empty

905− drop' n (Chunk t ts)

919+ drop' n (Chunk t ts)

906 | n < len = Chunk (T.drop (fromIntegral n) t) ts

920 | n < len = Chunk (T.drop (fromIntegral n) t) ts

907 | otherwise = drop' (n - len) ts

921 | otherwise = drop' (n - len) ts

908 where len = fromIntegral (T.length t)

922 where len = fromIntegral (T.length t)

@@ -1190,7 +1204,7 @@ tails ts@(Chunk t ts')

1190-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]

1204-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]

1191-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]

1205-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]

1192-- > splitOn "x" "x" == ["",""]

1206-- > splitOn "x" "x" == ["",""]

1193−--

1207+--

1194-- and

1208-- and

1195--

1209--

1196-- > intercalate s . splitOn s == id

1210-- > intercalate s . splitOn s == id

Data/Text/Lazy/Builder.hs+17−271

@@ -1,11 +1,15 @@

1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}

2+#if __GLASGOW_HASKELL__ >= 702

3+{-# LANGUAGE Trustworthy #-}

4+#endif

2

5

3-----------------------------------------------------------------------------

6-----------------------------------------------------------------------------

4-- |

7-- |

5-- Module : Data.Text.Lazy.Builder

8-- Module : Data.Text.Lazy.Builder

7-- License : BSD3-style (see LICENSE)

11-- License : BSD3-style (see LICENSE)

8−--

12+--

9-- Maintainer : Johan Tibell <johan.tibell@gmail.com>

13-- Maintainer : Johan Tibell <johan.tibell@gmail.com>

10-- Stability : experimental

14-- Stability : experimental

11-- Portability : portable to Hugs and GHC

15-- Portability : portable to Hugs and GHC

@@ -15,7 +19,9 @@

15-- @fromLazyText@, which construct new builders, and 'mappend', which

19-- @fromLazyText@, which construct new builders, and 'mappend', which

16-- concatenates two builders.

20-- concatenates two builders.

17--

21--

18−-- To get maximum performance when building lazy @Text@ values using a builder, associate @mappend@ calls to the right. For example, prefer

22+-- To get maximum performance when building lazy @Text@ values using a

23+-- builder, associate @mappend@ calls to the right. For example,

24+-- prefer

19--

25--

20-- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')

26-- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')

21--

27--

@@ -23,8 +29,14 @@

23--

29--

24-- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'

30-- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'

25--

31--

26−-- as the latter associates @mappend@ to the left.

32+-- as the latter associates @mappend@ to the left. Or, equivalently,

33+-- prefer

34+--

35+-- > singleton 'a' <> singleton 'b' <> singleton 'c'

27--

36--

37+-- since the '<>' from recent versions of 'Data.Monoid' associates

38+-- to the right.

39+

28-----------------------------------------------------------------------------

40-----------------------------------------------------------------------------

29

41

30module Data.Text.Lazy.Builder

42module Data.Text.Lazy.Builder

@@ -43,270 +55,4 @@ module Data.Text.Lazy.Builder

43 , flush

55 , flush

44 ) where

56 ) where

45

57

46−import Control.Monad.ST (ST, runST)

58+import Data.Text.Lazy.Builder.Internal

47−import Data.Bits ((.&.))

48−import Data.Monoid (Monoid(..))

49−import Data.Text.Internal (Text(..))

50−import Data.Text.Lazy.Internal (smallChunkSize)

51−import Data.Text.Unsafe (inlineInterleaveST)

52−import Data.Text.UnsafeChar (ord, unsafeWrite)

53−import Data.Text.UnsafeShift (shiftR)

54−import Prelude hiding (map, putChar)

55−

56−import qualified Data.String as String

57−import qualified Data.Text as S

58−import qualified Data.Text.Array as A

59−import qualified Data.Text.Lazy as L

60−

61−------------------------------------------------------------------------

62−

63−-- | A @Builder@ is an efficient way to build lazy @Text@ values.

64−-- There are several functions for constructing builders, but only one

65−-- to inspect them: to extract any data, you have to turn them into

66−-- lazy @Text@ values using @toLazyText@.

67−--

68−-- Internally, a builder constructs a lazy @Text@ by filling arrays

69−-- piece by piece. As each buffer is filled, it is \'popped\' off, to

70−-- become a new chunk of the resulting lazy @Text@. All this is

71−-- hidden from the user of the @Builder@.

72−newtype Builder = Builder {

73− -- Invariant (from Data.Text.Lazy):

74− -- The lists include no null Texts.

75− runBuilder :: forall s. (Buffer s -> ST s [S.Text])

76− -> Buffer s

77− -> ST s [S.Text]

78− }

79−

80−instance Monoid Builder where

81− mempty = empty

82− {-# INLINE mempty #-}

83− mappend = append

84− {-# INLINE mappend #-}

85− mconcat = foldr mappend mempty

86− {-# INLINE mconcat #-}

87−

88−instance String.IsString Builder where

89− fromString = fromString

90− {-# INLINE fromString #-}

91−

92−instance Show Builder where

93− show = show . toLazyText

94−

95−instance Eq Builder where

96− a == b = toLazyText a == toLazyText b

97−

98−instance Ord Builder where

99− a <= b = toLazyText a <= toLazyText b

100−

101−------------------------------------------------------------------------

102−

103−-- | /O(1)./ The empty @Builder@, satisfying

104−--

105−-- * @'toLazyText' 'empty' = 'L.empty'@

106−--

107−empty :: Builder

108−empty = Builder (\ k buf -> k buf)

109−{-# INLINE empty #-}

110−

111−-- | /O(1)./ A @Builder@ taking a single character, satisfying

112−--

113−-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@

114−--

115−singleton :: Char -> Builder

116−singleton c = writeAtMost 2 $ \ marr o ->

117− if n < 0x10000

118− then A.unsafeWrite marr o (fromIntegral n) >> return 1

119− else do

120− A.unsafeWrite marr o lo

121− A.unsafeWrite marr (o+1) hi

122− return 2

123− where n = ord c

124− m = n - 0x10000

125− lo = fromIntegral $ (m `shiftR` 10) + 0xD800

126− hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00

127−{-# INLINE singleton #-}

128−

129−------------------------------------------------------------------------

130−

131−-- | /O(1)./ The concatenation of two builders, an associative

132−-- operation with identity 'empty', satisfying

133−--

134−-- * @'toLazyText' ('append' x y) = 'L.append' ('toLazyText' x) ('toLazyText' y)@

135−--

136−append :: Builder -> Builder -> Builder

137−append (Builder f) (Builder g) = Builder (f . g)

138−{-# INLINE [0] append #-}

139−

140−-- TODO: Experiment to find the right threshold.

141−copyLimit :: Int

142−copyLimit = 128

143−

144−-- This function attempts to merge small @Text@ values instead of

145−-- treating each value as its own chunk. We may not always want this.

146−

147−-- | /O(1)./ A @Builder@ taking a 'S.Text', satisfying

148−--

149−-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@

150−--

151−fromText :: S.Text -> Builder

152−fromText t@(Text arr off l)

153− | S.null t = empty

154− | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)

155− | otherwise = flush `append` mapBuilder (t :)

156−{-# INLINE [1] fromText #-}

157−

158−{-# RULES

159−"fromText/pack" forall s .

160− fromText (S.pack s) = fromString s

161− #-}

162−

163−-- | /O(1)./ A Builder taking a @String@, satisfying

164−--

165−-- * @'toLazyText' ('fromString' s) = 'L.fromChunks' [S.pack s]@

166−--

167−fromString :: String -> Builder

168−fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->

169− let loop !marr !o !u !l [] = k (Buffer marr o u l)

170− loop marr o u l s@(c:cs)

171− | l <= 1 = do

172− arr <- A.unsafeFreeze marr

173− let !t = Text arr o u

174− marr' <- A.new chunkSize

175− ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)

176− return $ t : ts

177− | otherwise = do

178− n <- unsafeWrite marr (o+u) c

179− loop marr o (u+n) (l-n) cs

180− in loop p0 o0 u0 l0 str

181− where

182− chunkSize = smallChunkSize

183−{-# INLINE fromString #-}

184−

185−-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying

186−--

187−-- * @'toLazyText' ('fromLazyText' t) = t@

188−--

189−fromLazyText :: L.Text -> Builder

190−fromLazyText ts = flush `append` mapBuilder (L.toChunks ts ++)

191−{-# INLINE fromLazyText #-}

192−

193−------------------------------------------------------------------------

194−

195−-- Our internal buffer type

196−data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s)

197− {-# UNPACK #-} !Int -- offset

198− {-# UNPACK #-} !Int -- used units

199− {-# UNPACK #-} !Int -- length left

200−

201−------------------------------------------------------------------------

202−

203−-- | /O(n)./ Extract a lazy @Text@ from a @Builder@ with a default

204−-- buffer size. The construction work takes place if and when the

205−-- relevant part of the lazy @Text@ is demanded.

206−toLazyText :: Builder -> L.Text

207−toLazyText = toLazyTextWith smallChunkSize

208−

209−-- | /O(n)./ Extract a lazy @Text@ from a @Builder@, using the given

210−-- size for the initial buffer. The construction work takes place if

211−-- and when the relevant part of the lazy @Text@ is demanded.

212−--

213−-- If the initial buffer is too small to hold all data, subsequent

214−-- buffers will be the default buffer size.

215−toLazyTextWith :: Int -> Builder -> L.Text

216−toLazyTextWith chunkSize m = L.fromChunks (runST $

217− newBuffer chunkSize >>= runBuilder (m `append` flush) (const (return [])))

218−

219−-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,

220−-- yielding a new chunk in the result lazy @Text@.

221−flush :: Builder

222−flush = Builder $ \ k buf@(Buffer p o u l) ->

223− if u == 0

224− then k buf

225− else do arr <- A.unsafeFreeze p

226− let !b = Buffer p (o+u) 0 l

227− !t = Text arr o u

228− ts <- inlineInterleaveST (k b)

229− return $! t : ts

230−

231−------------------------------------------------------------------------

232−

233−-- | Sequence an ST operation on the buffer

234−withBuffer :: (forall s. Buffer s -> ST s (Buffer s)) -> Builder

235−withBuffer f = Builder $ \k buf -> f buf >>= k

236−{-# INLINE withBuffer #-}

237−

238−-- | Get the size of the buffer

239−withSize :: (Int -> Builder) -> Builder

240−withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->

241− runBuilder (f l) k buf

242−{-# INLINE withSize #-}

243−

244−-- | Map the resulting list of texts.

245−mapBuilder :: ([S.Text] -> [S.Text]) -> Builder

246−mapBuilder f = Builder (fmap f .)

247−

248−------------------------------------------------------------------------

249−

250−-- | Ensure that there are at least @n@ many elements available.

251−ensureFree :: Int -> Builder

252−ensureFree !n = withSize $ \ l ->

253− if n <= l

254− then empty

255− else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize)))

256−{-# INLINE [0] ensureFree #-}

257−

258−writeAtMost :: Int -> (forall s. A.MArray s -> Int -> ST s Int) -> Builder

259−writeAtMost n f = ensureFree n `append'` withBuffer (writeBuffer f)

260−{-# INLINE [0] writeAtMost #-}

261−

262−-- | Ensure that @n@ many elements are available, and then use @f@ to

263−-- write some elements into the memory.

264−writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder

265−writeN n f = writeAtMost n (\ p o -> f p o >> return n)

266−{-# INLINE writeN #-}

267−

268−writeBuffer :: (A.MArray s -> Int -> ST s Int) -> Buffer s -> ST s (Buffer s)

269−writeBuffer f (Buffer p o u l) = do

270− n <- f p (o+u)

271− return $! Buffer p o (u+n) (l-n)

272−{-# INLINE writeBuffer #-}

273−

274−newBuffer :: Int -> ST s (Buffer s)

275−newBuffer size = do

276− arr <- A.new size

277− return $! Buffer arr 0 0 size

278−{-# INLINE newBuffer #-}

279−

280−------------------------------------------------------------------------

281−-- Some nice rules for Builder

282−

283−-- This function makes GHC understand that 'writeN' and 'ensureFree'

284−-- are *not* recursive in the precense of the rewrite rules below.

285−-- This is not needed with GHC 7+.

286−append' :: Builder -> Builder -> Builder

287−append' (Builder f) (Builder g) = Builder (f . g)

288−{-# INLINE append' #-}

289−

290−{-# RULES

291−

292−"append/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)

293− (g::forall s. A.MArray s -> Int -> ST s Int) ws.

294− append (writeAtMost a f) (append (writeAtMost b g) ws) =

295− append (writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->

296− g marr (o+n) >>= \ m ->

297− let s = n+m in s `seq` return s)) ws

298−

299−"writeAtMost/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)

300− (g::forall s. A.MArray s -> Int -> ST s Int).

301− append (writeAtMost a f) (writeAtMost b g) =

302− writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->

303− g marr (o+n) >>= \ m ->

304− let s = n+m in s `seq` return s)

305−

306−"ensureFree/ensureFree" forall a b .

307− append (ensureFree a) (ensureFree b) = ensureFree (max a b)

308−

309−"flush/flush"

310− append flush flush = flush

311−

312− #-}

Data/Text/Lazy/Builder/Int.hs+132−29

@@ -1,7 +1,11 @@

1−{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}

1+{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, UnboxedTuples #-}

2+#if __GLASGOW_HASKELL__ >= 702

3+{-# LANGUAGE Trustworthy #-}

4+#endif

2

5

3-- Module: Data.Text.Lazy.Builder.Int

6-- Module: Data.Text.Lazy.Builder.Int

5-- License: BSD3

9-- License: BSD3

6-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>

10-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>

7-- Stability: experimental

11-- Stability: experimental

@@ -17,45 +21,134 @@ module Data.Text.Lazy.Builder.Int

17

21

18import Data.Int (Int8, Int16, Int32, Int64)

22import Data.Int (Int8, Int16, Int32, Int64)

19import Data.Monoid (mempty)

23import Data.Monoid (mempty)

24+import qualified Data.ByteString.Unsafe as B

20import Data.Text.Lazy.Builder.Functions ((<>), i2d)

25import Data.Text.Lazy.Builder.Functions ((<>), i2d)

21−import Data.Text.Lazy.Builder

26+import Data.Text.Lazy.Builder.Internal

27+import Data.Text.Lazy.Builder.Int.Digits (digits)

28+import Data.Text.Array

22import Data.Word (Word, Word8, Word16, Word32, Word64)

29import Data.Word (Word, Word8, Word16, Word32, Word64)

23import GHC.Base (quotInt, remInt)

30import GHC.Base (quotInt, remInt)

24import GHC.Num (quotRemInteger)

31import GHC.Num (quotRemInteger)

25import GHC.Types (Int(..))

32import GHC.Types (Int(..))

33+import Control.Monad.ST

26

34

27#ifdef __GLASGOW_HASKELL__

35#ifdef __GLASGOW_HASKELL__

28−# if __GLASGOW_HASKELL__ < 611

36+# if defined(INTEGER_GMP)

29−import GHC.Integer.Internals

30−# else

31import GHC.Integer.GMP.Internals

37import GHC.Integer.GMP.Internals

38+# elif defined(INTEGER_SIMPLE)

39+import GHC.Integer

40+# else

41+# error "You need to use either GMP or integer-simple."

32# endif

42# endif

33#endif

43#endif

34

44

35−#ifdef INTEGER_GMP

45+#if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE)

36# define PAIR(a,b) (# a,b #)

46# define PAIR(a,b) (# a,b #)

37#else

47#else

38# define PAIR(a,b) (a,b)

48# define PAIR(a,b) (a,b)

39#endif

49#endif

40

50

41decimal :: Integral a => a -> Builder

51decimal :: Integral a => a -> Builder

42−{-# SPECIALIZE decimal :: Int -> Builder #-}

43{-# SPECIALIZE decimal :: Int8 -> Builder #-}

52{-# SPECIALIZE decimal :: Int8 -> Builder #-}

44−{-# SPECIALIZE decimal :: Int16 -> Builder #-}

53+{-# RULES "decimal/Int" decimal = boundedDecimal :: Int -> Builder #-}

54+{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}

45−{-# SPECIALIZE decimal :: Int32 -> Builder #-}

55+{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}

46−{-# SPECIALIZE decimal :: Int64 -> Builder #-}

56+{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}

47−{-# SPECIALIZE decimal :: Word -> Builder #-}

57+{-# RULES "decimal/Word" decimal = positive :: Word -> Builder #-}

48−{-# SPECIALIZE decimal :: Word8 -> Builder #-}

58+{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}

49−{-# SPECIALIZE decimal :: Word16 -> Builder #-}

59+{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}

50−{-# SPECIALIZE decimal :: Word32 -> Builder #-}

60+{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}

51−{-# SPECIALIZE decimal :: Word64 -> Builder #-}

61+{-# RULES "decimal/Word64" decimal = positive :: Word64 -> Builder #-}

52{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}

62{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}

53−decimal i

63+decimal i = decimal' (<= -128) i

54− | i < 0 = singleton '-' <> go (-i)

64+

55− | otherwise = go i

65+boundedDecimal :: (Integral a, Bounded a) => a -> Builder

66+{-# SPECIALIZE boundedDecimal :: Int -> Builder #-}

67+{-# SPECIALIZE boundedDecimal :: Int8 -> Builder #-}

68+{-# SPECIALIZE boundedDecimal :: Int16 -> Builder #-}

69+{-# SPECIALIZE boundedDecimal :: Int32 -> Builder #-}

70+{-# SPECIALIZE boundedDecimal :: Int64 -> Builder #-}

71+boundedDecimal i = decimal' (== minBound) i

72+

73+decimal' :: (Integral a) => (a -> Bool) -> a -> Builder

74+{-# INLINE decimal' #-}

75+decimal' p i

76+ | i < 0 = if p i

77+ then let (q, r) = i `quotRem` 10

78+ qq = -q

79+ !n = countDigits qq

80+ in writeN (n + 2) $ \marr off -> do

81+ unsafeWrite marr off minus

82+ posDecimal marr (off+1) n qq

83+ unsafeWrite marr (off+n+1) (i2w (-r))

84+ else let j = -i

85+ !n = countDigits j

86+ in writeN (n + 1) $ \marr off ->

87+ unsafeWrite marr off minus >> posDecimal marr (off+1) n j

88+ | otherwise = positive i

89+

90+positive :: (Integral a) => a -> Builder

91+{-# SPECIALIZE positive :: Int -> Builder #-}

92+{-# SPECIALIZE positive :: Int8 -> Builder #-}

93+{-# SPECIALIZE positive :: Int16 -> Builder #-}

94+{-# SPECIALIZE positive :: Int32 -> Builder #-}

95+{-# SPECIALIZE positive :: Int64 -> Builder #-}

96+{-# SPECIALIZE positive :: Word -> Builder #-}

97+{-# SPECIALIZE positive :: Word8 -> Builder #-}

98+{-# SPECIALIZE positive :: Word16 -> Builder #-}

99+{-# SPECIALIZE positive :: Word32 -> Builder #-}

100+{-# SPECIALIZE positive :: Word64 -> Builder #-}

101+positive i

102+ | i < 10 = writeN 1 $ \marr off -> unsafeWrite marr off (i2w i)

103+ | otherwise = let !n = countDigits i

104+ in writeN n $ \marr off -> posDecimal marr off n i

105+

106+posDecimal :: (Integral a) =>

107+ forall s. MArray s -> Int -> Int -> a -> ST s ()

108+{-# INLINE posDecimal #-}

109+posDecimal marr off0 ds v0 = go (off0 + ds - 1) v0

110+ where go off v

111+ | v >= 100 = do

112+ let (q, r) = v `quotRem` 100

113+ write2 off r

114+ go (off - 2) q

115+ | v < 10 = unsafeWrite marr off (i2w v)

116+ | otherwise = write2 off v

117+ write2 off i0 = do

118+ let i = fromIntegral i0; j = i + i

119+ unsafeWrite marr off $ get (j + 1)

120+ unsafeWrite marr (off - 1) $ get j

121+ get = fromIntegral . B.unsafeIndex digits

122+

123+minus, zero :: Word16

124+{-# INLINE minus #-}

125+{-# INLINE zero #-}

126+minus = 45

127+zero = 48

128+

129+i2w :: (Integral a) => a -> Word16

130+{-# INLINE i2w #-}

131+i2w v = zero + fromIntegral v

132+

133+countDigits :: (Integral a) => a -> Int

134+{-# INLINE countDigits #-}

135+countDigits v0 = go 1 (fromIntegral v0 :: Word64)

56− where

136+ where go !k v

57− go n | n < 10 = digit n

137+ | v < 10 = k

138+ | v < 100 = k + 1

139+ | v < 1000 = k + 2

140+ | v < 1000000000000 =

141+ k + if v < 100000000

142+ then if v < 1000000

143+ then if v < 10000

144+ then 3

145+ else 4 + fin v 100000

146+ else 6 + fin v 10000000

147+ else if v < 10000000000

148+ then 8 + fin v 1000000000

149+ else 10 + fin v 100000000000

58− | otherwise = go (n `quot` 10) <> digit (n `rem` 10)

150+ | otherwise = go (k + 12) (v `quot` 1000000000000)

151+ fin v n = if v >= n then 1 else 0

59

152

60hexadecimal :: Integral a => a -> Builder

153hexadecimal :: Integral a => a -> Builder

61{-# SPECIALIZE hexadecimal :: Int -> Builder #-}

154{-# SPECIALIZE hexadecimal :: Int -> Builder #-}

@@ -68,17 +161,22 @@ hexadecimal :: Integral a => a -> Builder

68{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-}

161{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-}

69{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-}

162{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-}

70{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-}

163{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-}

71−{-# RULES "hexadecimal/Integer" hexadecimal = integer 16 :: Integer -> Builder #-}

164+{-# RULES "hexadecimal/Integer"

165+ hexadecimal = hexInteger :: Integer -> Builder #-}

72hexadecimal i

166hexadecimal i

73− | i < 0 = singleton '-' <> go (-i)

167+ | i < 0 = error hexErrMsg

74 | otherwise = go i

168 | otherwise = go i

75 where

169 where

76 go n | n < 16 = hexDigit n

170 go n | n < 16 = hexDigit n

77 | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)

171 | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)

78

172

79−digit :: Integral a => a -> Builder

173+hexInteger :: Integer -> Builder

80−digit n = singleton $! i2d (fromIntegral n)

174+hexInteger i

81−{-# INLINE digit #-}

175+ | i < 0 = error hexErrMsg

176+ | otherwise = integer 16 i

177+

178+hexErrMsg :: String

179+hexErrMsg = "Data.Text.Lazy.Builder.Int.hexadecimal: applied to negative number"

82

180

83hexDigit :: Integral a => a -> Builder

181hexDigit :: Integral a => a -> Builder

84hexDigit n

182hexDigit n

@@ -93,8 +191,13 @@ int = decimal

93data T = T !Integer !Int

191data T = T !Integer !Int

94

192

95integer :: Int -> Integer -> Builder

193integer :: Int -> Integer -> Builder

194+#ifdef INTEGER_GMP

96integer 10 (S# i#) = decimal (I# i#)

195integer 10 (S# i#) = decimal (I# i#)

97integer 16 (S# i#) = hexadecimal (I# i#)

196integer 16 (S# i#) = hexadecimal (I# i#)

197+#else

198+integer 10 i = decimal i

199+integer 16 i = hexadecimal i

200+#endif

98integer base i

201integer base i

99 | i < 0 = singleton '-' <> go (-i)

202 | i < 0 = singleton '-' <> go (-i)

100 | otherwise = go i

203 | otherwise = go i

@@ -146,7 +249,7 @@ integer base i

146 pblock = loop maxDigits

249 pblock = loop maxDigits

147 where

250 where

148 loop !d !n

251 loop !d !n

149− | d == 1 = digit n

252+ | d == 1 = hexDigit n

150− | otherwise = loop (d-1) q <> digit r

253+ | otherwise = loop (d-1) q <> hexDigit r

151 where q = n `quotInt` base

254 where q = n `quotInt` base

152 r = n `remInt` base

255 r = n `remInt` base

Data/Text/Lazy/Builder/Int/Digits.hsnew file+22

@@ -0,0 +1,22 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+

3+-- Module: Data.Text.Lazy.Builder.Int.Digits

5+-- License: BSD3

6+-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>

7+-- Stability: experimental

8+-- Portability: portable

9+--

10+-- This module exists because the C preprocessor does things that we

11+-- shall not speak of when confronted with Haskell multiline strings.

12+

13+module Data.Text.Lazy.Builder.Int.Digits (digits) where

14+

15+import Data.ByteString.Char8 (ByteString)

16+

17+digits :: ByteString

18+digits = "0001020304050607080910111213141516171819\

19+ \2021222324252627282930313233343536373839\

20+ \4041424344454647484950515253545556575859\

21+ \6061626364656667686970717273747576777879\

22+ \8081828384858687888990919293949596979899"

Data/Text/Lazy/Builder/Internal.hsnew file+321

@@ -0,0 +1,321 @@

1+{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}

2+

3+-----------------------------------------------------------------------------

4+-- |

5+-- Module : Data.Text.Lazy.Builder.Internal

8+-- License : BSD3-style (see LICENSE)

9+--

10+-- Maintainer : Johan Tibell <johan.tibell@gmail.com>

11+-- Stability : experimental

12+-- Portability : portable to Hugs and GHC

13+--

14+-- Efficient construction of lazy @Text@ values. The principal

15+-- operations on a @Builder@ are @singleton@, @fromText@, and

16+-- @fromLazyText@, which construct new builders, and 'mappend', which

17+-- concatenates two builders.

18+--

19+-- To get maximum performance when building lazy @Text@ values using a

20+-- builder, associate @mappend@ calls to the right. For example,

21+-- prefer

22+--

23+-- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')

24+--

25+-- to

26+--

27+-- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'

28+--

29+-- as the latter associates @mappend@ to the left.

30+--

31+-----------------------------------------------------------------------------

32+

33+module Data.Text.Lazy.Builder.Internal

34+ ( -- * Public API

35+ -- ** The Builder type

36+ Builder

37+ , toLazyText

38+ , toLazyTextWith

39+

40+ -- ** Constructing Builders

41+ , singleton

42+ , fromText

43+ , fromLazyText

44+ , fromString

45+

46+ -- ** Flushing the buffer state

47+ , flush

48+

49+ -- * Internal functions

50+ , append'

51+ , ensureFree

52+ , writeN

53+ ) where

54+

55+import Control.Monad.ST (ST, runST)

56+import Data.Bits ((.&.))

57+import Data.Monoid (Monoid(..))

58+import Data.Text.Internal (Text(..))

59+import Data.Text.Lazy.Internal (smallChunkSize)

60+import Data.Text.Unsafe (inlineInterleaveST)

61+import Data.Text.UnsafeChar (ord, unsafeWrite)

62+import Data.Text.UnsafeShift (shiftR)

63+import Prelude hiding (map, putChar)

64+

65+import qualified Data.String as String

66+import qualified Data.Text as S

67+import qualified Data.Text.Array as A

68+import qualified Data.Text.Lazy as L

69+

70+------------------------------------------------------------------------

71+

72+-- | A @Builder@ is an efficient way to build lazy @Text@ values.

73+-- There are several functions for constructing builders, but only one

74+-- to inspect them: to extract any data, you have to turn them into

75+-- lazy @Text@ values using @toLazyText@.

76+--

77+-- Internally, a builder constructs a lazy @Text@ by filling arrays

78+-- piece by piece. As each buffer is filled, it is \'popped\' off, to

79+-- become a new chunk of the resulting lazy @Text@. All this is

80+-- hidden from the user of the @Builder@.

81+newtype Builder = Builder {

82+ -- Invariant (from Data.Text.Lazy):

83+ -- The lists include no null Texts.

84+ runBuilder :: forall s. (Buffer s -> ST s [S.Text])

85+ -> Buffer s

86+ -> ST s [S.Text]

87+ }

88+

89+instance Monoid Builder where

90+ mempty = empty

91+ {-# INLINE mempty #-}

92+ mappend = append

93+ {-# INLINE mappend #-}

94+ mconcat = foldr mappend mempty

95+ {-# INLINE mconcat #-}

96+

97+instance String.IsString Builder where

98+ fromString = fromString

99+ {-# INLINE fromString #-}

100+

101+instance Show Builder where

102+ show = show . toLazyText

103+

104+instance Eq Builder where

105+ a == b = toLazyText a == toLazyText b

106+

107+instance Ord Builder where

108+ a <= b = toLazyText a <= toLazyText b

109+

110+------------------------------------------------------------------------

111+

112+-- | /O(1)./ The empty @Builder@, satisfying

113+--

114+-- * @'toLazyText' 'empty' = 'L.empty'@

115+--

116+empty :: Builder

117+empty = Builder (\ k buf -> k buf)

118+{-# INLINE empty #-}

119+

120+-- | /O(1)./ A @Builder@ taking a single character, satisfying

121+--

122+-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@

123+--

124+singleton :: Char -> Builder

125+singleton c = writeAtMost 2 $ \ marr o ->

126+ if n < 0x10000

127+ then A.unsafeWrite marr o (fromIntegral n) >> return 1

128+ else do

129+ A.unsafeWrite marr o lo

130+ A.unsafeWrite marr (o+1) hi

131+ return 2

132+ where n = ord c

133+ m = n - 0x10000

134+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800

135+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00

136+{-# INLINE singleton #-}

137+

138+------------------------------------------------------------------------

139+

140+-- | /O(1)./ The concatenation of two builders, an associative

141+-- operation with identity 'empty', satisfying

142+--

143+-- * @'toLazyText' ('append' x y) = 'L.append' ('toLazyText' x) ('toLazyText' y)@

144+--

145+append :: Builder -> Builder -> Builder

146+append (Builder f) (Builder g) = Builder (f . g)

147+{-# INLINE [0] append #-}

148+

149+-- TODO: Experiment to find the right threshold.

150+copyLimit :: Int

151+copyLimit = 128

152+

153+-- This function attempts to merge small @Text@ values instead of

154+-- treating each value as its own chunk. We may not always want this.

155+

156+-- | /O(1)./ A @Builder@ taking a 'S.Text', satisfying

157+--

158+-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@

159+--

160+fromText :: S.Text -> Builder

161+fromText t@(Text arr off l)

162+ | S.null t = empty

163+ | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)

164+ | otherwise = flush `append` mapBuilder (t :)

165+{-# INLINE [1] fromText #-}

166+

167+{-# RULES

168+"fromText/pack" forall s .

169+ fromText (S.pack s) = fromString s

170+ #-}

171+

172+-- | /O(1)./ A Builder taking a @String@, satisfying

173+--

174+-- * @'toLazyText' ('fromString' s) = 'L.fromChunks' [S.pack s]@

175+--

176+fromString :: String -> Builder

177+fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->

178+ let loop !marr !o !u !l [] = k (Buffer marr o u l)

179+ loop marr o u l s@(c:cs)

180+ | l <= 1 = do

181+ arr <- A.unsafeFreeze marr

182+ let !t = Text arr o u

183+ marr' <- A.new chunkSize

184+ ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)

185+ return $ t : ts

186+ | otherwise = do

187+ n <- unsafeWrite marr (o+u) c

188+ loop marr o (u+n) (l-n) cs

189+ in loop p0 o0 u0 l0 str

190+ where

191+ chunkSize = smallChunkSize

192+{-# INLINE fromString #-}

193+

194+-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying

195+--

196+-- * @'toLazyText' ('fromLazyText' t) = t@

197+--

198+fromLazyText :: L.Text -> Builder

199+fromLazyText ts = flush `append` mapBuilder (L.toChunks ts ++)

200+{-# INLINE fromLazyText #-}

201+

202+------------------------------------------------------------------------

203+

204+-- Our internal buffer type

205+data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s)

206+ {-# UNPACK #-} !Int -- offset

207+ {-# UNPACK #-} !Int -- used units

208+ {-# UNPACK #-} !Int -- length left

209+

210+------------------------------------------------------------------------

211+

212+-- | /O(n)./ Extract a lazy @Text@ from a @Builder@ with a default

213+-- buffer size. The construction work takes place if and when the

214+-- relevant part of the lazy @Text@ is demanded.

215+toLazyText :: Builder -> L.Text

216+toLazyText = toLazyTextWith smallChunkSize

217+

218+-- | /O(n)./ Extract a lazy @Text@ from a @Builder@, using the given

219+-- size for the initial buffer. The construction work takes place if

220+-- and when the relevant part of the lazy @Text@ is demanded.

221+--

222+-- If the initial buffer is too small to hold all data, subsequent

223+-- buffers will be the default buffer size.

224+toLazyTextWith :: Int -> Builder -> L.Text

225+toLazyTextWith chunkSize m = L.fromChunks (runST $

226+ newBuffer chunkSize >>= runBuilder (m `append` flush) (const (return [])))

227+

228+-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,

229+-- yielding a new chunk in the result lazy @Text@.

230+flush :: Builder

231+flush = Builder $ \ k buf@(Buffer p o u l) ->

232+ if u == 0

233+ then k buf

234+ else do arr <- A.unsafeFreeze p

235+ let !b = Buffer p (o+u) 0 l

236+ !t = Text arr o u

237+ ts <- inlineInterleaveST (k b)

238+ return $! t : ts

239+

240+------------------------------------------------------------------------

241+

242+-- | Sequence an ST operation on the buffer

243+withBuffer :: (forall s. Buffer s -> ST s (Buffer s)) -> Builder

244+withBuffer f = Builder $ \k buf -> f buf >>= k

245+{-# INLINE withBuffer #-}

246+

247+-- | Get the size of the buffer

248+withSize :: (Int -> Builder) -> Builder

249+withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->

250+ runBuilder (f l) k buf

251+{-# INLINE withSize #-}

252+

253+-- | Map the resulting list of texts.

254+mapBuilder :: ([S.Text] -> [S.Text]) -> Builder

255+mapBuilder f = Builder (fmap f .)

256+

257+------------------------------------------------------------------------

258+

259+-- | Ensure that there are at least @n@ many elements available.

260+ensureFree :: Int -> Builder

261+ensureFree !n = withSize $ \ l ->

262+ if n <= l

263+ then empty

264+ else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize)))

265+{-# INLINE [0] ensureFree #-}

266+

267+writeAtMost :: Int -> (forall s. A.MArray s -> Int -> ST s Int) -> Builder

268+writeAtMost n f = ensureFree n `append'` withBuffer (writeBuffer f)

269+{-# INLINE [0] writeAtMost #-}

270+

271+-- | Ensure that @n@ many elements are available, and then use @f@ to

272+-- write some elements into the memory.

273+writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder

274+writeN n f = writeAtMost n (\ p o -> f p o >> return n)

275+{-# INLINE writeN #-}

276+

277+writeBuffer :: (A.MArray s -> Int -> ST s Int) -> Buffer s -> ST s (Buffer s)

278+writeBuffer f (Buffer p o u l) = do

279+ n <- f p (o+u)

280+ return $! Buffer p o (u+n) (l-n)

281+{-# INLINE writeBuffer #-}

282+

283+newBuffer :: Int -> ST s (Buffer s)

284+newBuffer size = do

285+ arr <- A.new size

286+ return $! Buffer arr 0 0 size

287+{-# INLINE newBuffer #-}

288+

289+------------------------------------------------------------------------

290+-- Some nice rules for Builder

291+

292+-- This function makes GHC understand that 'writeN' and 'ensureFree'

293+-- are *not* recursive in the precense of the rewrite rules below.

294+-- This is not needed with GHC 7+.

295+append' :: Builder -> Builder -> Builder

296+append' (Builder f) (Builder g) = Builder (f . g)

297+{-# INLINE append' #-}

298+

299+{-# RULES

300+

301+"append/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)

302+ (g::forall s. A.MArray s -> Int -> ST s Int) ws.

303+ append (writeAtMost a f) (append (writeAtMost b g) ws) =

304+ append (writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->

305+ g marr (o+n) >>= \ m ->

306+ let s = n+m in s `seq` return s)) ws

307+

308+"writeAtMost/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)

309+ (g::forall s. A.MArray s -> Int -> ST s Int).

310+ append (writeAtMost a f) (writeAtMost b g) =

311+ writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->

312+ g marr (o+n) >>= \ m ->

313+ let s = n+m in s `seq` return s)

314+

315+"ensureFree/ensureFree" forall a b .

316+ append (ensureFree a) (ensureFree b) = ensureFree (max a b)

317+

318+"flush/flush"

319+ append flush flush = flush

320+

321+ #-}

Data/Text/Lazy/Builder/RealFloat.hs+4−1

@@ -1,4 +1,7 @@

1−{-# LANGUAGE OverloadedStrings #-}

1+{-# LANGUAGE CPP, OverloadedStrings #-}

2+#if __GLASGOW_HASKELL__ >= 702

3+{-# LANGUAGE Trustworthy #-}

4+#endif

2

5

3-- |

6-- |

4-- Module: Data.Text.Lazy.Builder.RealFloat

7-- Module: Data.Text.Lazy.Builder.RealFloat

Data/Text/Lazy/Encoding.hs+22−6

@@ -1,4 +1,7 @@

1−{-# LANGUAGE BangPatterns #-}

1+{-# LANGUAGE BangPatterns,CPP #-}

2+#if __GLASGOW_HASKELL__ >= 702

3+{-# LANGUAGE Trustworthy #-}

4+#endif

2-- |

5-- |

3-- Module : Data.Text.Lazy.Encoding

6-- Module : Data.Text.Lazy.Encoding

@@ -20,6 +23,7 @@ module Data.Text.Lazy.Encoding

20 -- * Decoding ByteStrings to Text

23 -- * Decoding ByteStrings to Text

21 -- $strict

24 -- $strict

22 decodeASCII

25 decodeASCII

26+ , decodeLatin1

23 , decodeUtf8

27 , decodeUtf8

24 , decodeUtf16LE

28 , decodeUtf16LE

25 , decodeUtf16BE

29 , decodeUtf16BE

@@ -46,17 +50,20 @@ module Data.Text.Lazy.Encoding

46

50

47import Control.Exception (evaluate, try)

51import Control.Exception (evaluate, try)

48import Data.Bits ((.&.))

52import Data.Bits ((.&.))

53+import Data.Monoid (mempty, (<>))

49import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)

54import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)

50import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldrChunks)

55import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldrChunks)

51−import System.IO.Unsafe (unsafePerformIO)

52import qualified Data.ByteString as S

56import qualified Data.ByteString as S

53import qualified Data.ByteString.Lazy as B

57import qualified Data.ByteString.Lazy as B

54import qualified Data.ByteString.Lazy.Internal as B

58import qualified Data.ByteString.Lazy.Internal as B

55import qualified Data.ByteString.Unsafe as S

59import qualified Data.ByteString.Unsafe as S

60+import qualified Data.ByteString.Builder as B

61+import qualified Data.ByteString.Builder.Prim as BP

56import qualified Data.Text as T

62import qualified Data.Text as T

57import qualified Data.Text.Encoding as TE

63import qualified Data.Text.Encoding as TE

58import qualified Data.Text.Lazy.Encoding.Fusion as E

64import qualified Data.Text.Lazy.Encoding.Fusion as E

59import qualified Data.Text.Lazy.Fusion as F

65import qualified Data.Text.Lazy.Fusion as F

66+import Data.Text.Unsafe (unsafeDupablePerformIO)

60

67

61-- $strict

68-- $strict

62--

69--

@@ -74,11 +81,15 @@ import qualified Data.Text.Lazy.Fusion as F

74-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII

81-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII

75-- encoded text.

82-- encoded text.

76--

83--

77−-- This function is deprecated. Use 'decodeUtf8' instead.

84+-- This function is deprecated. Use 'decodeLatin1' instead.

78decodeASCII :: B.ByteString -> Text

85decodeASCII :: B.ByteString -> Text

79decodeASCII = decodeUtf8

86decodeASCII = decodeUtf8

80{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}

87{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}

81

88

89+-- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.

90+decodeLatin1 :: B.ByteString -> Text

91+decodeLatin1 = foldr (chunk . TE.decodeLatin1) empty . B.toChunks

92+

82-- | Decode a 'ByteString' containing UTF-8 encoded text.

93-- | Decode a 'ByteString' containing UTF-8 encoded text.

83decodeUtf8With :: OnDecodeError -> B.ByteString -> Text

94decodeUtf8With :: OnDecodeError -> B.ByteString -> Text

84decodeUtf8With onErr bs0 = fast bs0

95decodeUtf8With onErr bs0 = fast bs0

@@ -141,7 +152,7 @@ decodeUtf8 = decodeUtf8With strictDecode

141-- input before it can return a result. If you need lazy (streaming)

152-- input before it can return a result. If you need lazy (streaming)

142-- decoding, use 'decodeUtf8With' in lenient mode.

153-- decoding, use 'decodeUtf8With' in lenient mode.

143decodeUtf8' :: B.ByteString -> Either UnicodeException Text

154decodeUtf8' :: B.ByteString -> Either UnicodeException Text

144−decodeUtf8' bs = unsafePerformIO $ do

155+decodeUtf8' bs = unsafeDupablePerformIO $ do

145 let t = decodeUtf8 bs

156 let t = decodeUtf8 bs

146 try (evaluate (rnf t `seq` t))

157 try (evaluate (rnf t `seq` t))

147 where

158 where

@@ -150,8 +161,13 @@ decodeUtf8' bs = unsafePerformIO $ do

150{-# INLINE decodeUtf8' #-}

161{-# INLINE decodeUtf8' #-}

151

162

152encodeUtf8 :: Text -> B.ByteString

163encodeUtf8 :: Text -> B.ByteString

153−encodeUtf8 (Chunk c cs) = B.Chunk (TE.encodeUtf8 c) (encodeUtf8 cs)

164+encodeUtf8 =

154−encodeUtf8 Empty = B.Empty

165+ B.toLazyByteString . go

166+ where

167+ go Empty = mempty

168+ go (Chunk c cs) =

169+ TE.encodeUtf8Escaped (BP.liftFixedToBounded BP.word8) c <> go cs

170+

155

171

156-- | Decode text from little endian UTF-16 encoding.

172-- | Decode text from little endian UTF-16 encoding.

157decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text

173decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text

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

@@ -5,7 +5,7 @@

6--

7-- License : BSD-style

8−-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

9-- duncan@haskell.org

10-- Stability : experimental

11-- Portability : portable

@@ -42,7 +42,7 @@ import Data.Word (Word8, Word16, Word32)

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

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

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

45−import System.IO.Unsafe (unsafePerformIO)

45+import Data.Text.Unsafe (unsafeDupablePerformIO)

46import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)

47import Foreign.Storable (pokeByteOff)

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

@@ -272,7 +272,7 @@ streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

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

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

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

275− where chunk s1 len1 = unsafePerformIO $ do

275+ where chunk s1 len1 = unsafeDupablePerformIO $ do

276 let len = max 4 (min len1 chunkSize)

277 mallocByteString len >>= loop len 0 s1

278 where

Data/Text/Lazy/Fusion.hs+26−22

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

24

25import Prelude hiding (length)

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

27+import Control.Monad.ST (runST)

27import Data.Text.Fusion.Internal

28import Data.Text.Fusion.Internal

28import Data.Text.Fusion.Size (isEmpty, unknownSize)

29import Data.Text.Fusion.Size (isEmpty, unknownSize)

29import Data.Text.Lazy.Internal

30import Data.Text.Lazy.Internal

@@ -50,33 +51,36 @@ stream text = Stream next (text :*: 0) unknownSize

50-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given

51-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given

51-- chunk size.

52-- chunk size.

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

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

53−unstreamChunks chunkSize (Stream next s0 len0)

54+unstreamChunks !chunkSize (Stream next s0 len0)

54 | isEmpty len0 = Empty

55 | isEmpty len0 = Empty

55 | otherwise = outer s0

56 | otherwise = outer s0

56 where

57 where

57− outer s = {-# SCC "unstreamChunks/outer" #-}

58+ outer so = {-# SCC "unstreamChunks/outer" #-}

58− case next s of

59+ case next so of

59 Done -> Empty

60 Done -> Empty

60 Skip s' -> outer s'

61 Skip s' -> outer s'

61− Yield x s' -> I.Text arr 0 len `chunk` outer s''

62+ Yield x s' -> runST $ do

62− where (arr,(s'',len)) = A.run2 fill

63− fill = do a <- A.new unknownLength

63+ a <- A.new unknownLength

64− unsafeWrite a 0 x >>= inner a unknownLength s'

64+ unsafeWrite a 0 x >>= inner a unknownLength s'

65− unknownLength = 4

65+ where unknownLength = 4

66+ where

66− inner marr len s !i

67+ inner marr !len s !i

67− | i + 1 >= chunkSize = return (marr, (s,i))

68+ | i + 1 >= chunkSize = finish marr i s

68− | i + 1 >= len = {-# SCC "unstreamChunks/resize" #-} do

69+ | i + 1 >= len = {-# SCC "unstreamChunks/resize" #-} do

69− let newLen = min (len `shiftL` 1) chunkSize

70+ let newLen = min (len `shiftL` 1) chunkSize

70− marr' <- A.new newLen

71+ marr' <- A.new newLen

71− A.copyM marr' 0 marr 0 len

72+ A.copyM marr' 0 marr 0 len

72− inner marr' newLen s i

73+ inner marr' newLen s i

73− | otherwise =

74+ | otherwise =

74− {-# SCC "unstreamChunks/inner" #-}

75+ {-# SCC "unstreamChunks/inner" #-}

75− case next s of

76+ case next s of

76− Done -> return (marr,(s,i))

77+ Done -> finish marr i s

77− Skip s' -> inner marr len s' i

78+ Skip s' -> inner marr len s' i

78− Yield x s' -> do d <- unsafeWrite marr i x

79+ Yield x s' -> do d <- unsafeWrite marr i x

79− inner marr len s' (i+d)

80+ inner marr len s' (i+d)

81+ finish marr len s' = do

82+ arr <- A.unsafeFreeze marr

83+ return (I.Text arr 0 len `Chunk` outer s')

80{-# INLINE [0] unstreamChunks #-}

84{-# INLINE [0] unstreamChunks #-}

81

85

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

86-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using

Data/Text/Lazy/IO.hs+9−20

@@ -1,4 +1,7 @@

1{-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}

2+#if __GLASGOW_HASKELL__ >= 702

3+{-# LANGUAGE Trustworthy #-}

4+#endif

2-- |

5-- |

3-- Module : Data.Text.Lazy.IO

6-- Module : Data.Text.Lazy.IO

@@ -16,7 +19,7 @@

16module Data.Text.Lazy.IO

19module Data.Text.Lazy.IO

17 (

20 (

18 -- * Performance

21 -- * Performance

19− -- $performance

22+ -- $performance

20

23

21 -- * Locale support

24 -- * Locale support

22 -- $locale

25 -- $locale

@@ -38,18 +41,13 @@ module Data.Text.Lazy.IO

38 ) where

41 ) where

39

42

40import Data.Text.Lazy (Text)

43import Data.Text.Lazy (Text)

41−import Prelude hiding (appendFile, catch, getContents, getLine, interact,

44+import Prelude hiding (appendFile, getContents, getLine, interact,

42 putStr, putStrLn, readFile, writeFile)

45 putStr, putStrLn, readFile, writeFile)

43import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,

46import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,

44 withFile)

47 withFile)

45import qualified Data.Text.IO as T

48import qualified Data.Text.IO as T

46import qualified Data.Text.Lazy as L

49import qualified Data.Text.Lazy as L

47−#if __GLASGOW_HASKELL__ <= 610

48−import Data.Text.Lazy.Encoding (decodeUtf8)

49−import qualified Data.ByteString.Char8 as S8

50−import qualified Data.ByteString.Lazy.Char8 as L8

51−#else

52−import Control.Exception (catch, throwIO)

50+import qualified Control.Exception as E

53import Control.Monad (when)

51import Control.Monad (when)

54import Data.IORef (readIORef)

52import Data.IORef (readIORef)

55import Data.Text.IO.Internal (hGetLineWith, readChunk)

53import Data.Text.IO.Internal (hGetLineWith, readChunk)

@@ -62,7 +60,6 @@ import GHC.IO.Handle.Types (Handle__(..), HandleType(..))

62import System.IO (BufferMode(..), hGetBuffering, hSetBuffering)

60import System.IO (BufferMode(..), hGetBuffering, hSetBuffering)

63import System.IO.Error (isEOFError)

61import System.IO.Error (isEOFError)

64import System.IO.Unsafe (unsafeInterleaveIO)

62import System.IO.Unsafe (unsafeInterleaveIO)

65−#endif

66

63

67-- $performance

64-- $performance

68--

65--

@@ -96,9 +93,6 @@ appendFile p = withFile p AppendMode . flip hPutStr

96-- | Lazily read the remaining contents of a 'Handle'. The 'Handle'

93-- | Lazily read the remaining contents of a 'Handle'. The 'Handle'

97-- will be closed after the read completes, or on error.

94-- will be closed after the read completes, or on error.

98hGetContents :: Handle -> IO Text

95hGetContents :: Handle -> IO Text

99−#if __GLASGOW_HASKELL__ <= 610

100−hGetContents = fmap decodeUtf8 . L8.hGetContents

101−#else

102hGetContents h = do

96hGetContents h = do

103 chooseGoodBuffering h

97 chooseGoodBuffering h

104 wantReadableHandle "hGetContents" h $ \hh -> do

98 wantReadableHandle "hGetContents" h $ \hh -> do

@@ -119,7 +113,7 @@ lazyRead h = unsafeInterleaveIO $

119 case haType hh of

113 case haType hh of

120 ClosedHandle -> return (hh, L.empty)

114 ClosedHandle -> return (hh, L.empty)

121 SemiClosedHandle -> lazyReadBuffered h hh

115 SemiClosedHandle -> lazyReadBuffered h hh

122− _ -> ioException

116+ _ -> ioException

123 (IOError (Just h) IllegalOperation "hGetContents"

117 (IOError (Just h) IllegalOperation "hGetContents"

124 "illegal handle type" Nothing Nothing)

118 "illegal handle type" Nothing Nothing)

125

119

@@ -128,22 +122,17 @@ lazyReadBuffered h hh@Handle__{..} = do

128 buf <- readIORef haCharBuffer

122 buf <- readIORef haCharBuffer

129 (do t <- readChunk hh buf

123 (do t <- readChunk hh buf

130 ts <- lazyRead h

124 ts <- lazyRead h

131− return (hh, chunk t ts)) `catch` \e -> do

125+ return (hh, chunk t ts)) `E.catch` \e -> do

132 (hh', _) <- hClose_help hh

126 (hh', _) <- hClose_help hh

133 if isEOFError e

127 if isEOFError e

134 then return $ if isEmptyBuffer buf

128 then return $ if isEmptyBuffer buf

135 then (hh', empty)

129 then (hh', empty)

136 else (hh', L.singleton '\r')

130 else (hh', L.singleton '\r')

137− else throwIO (augmentIOError e "hGetContents" h)

131+ else E.throwIO (augmentIOError e "hGetContents" h)

138−#endif

139

132

140-- | Read a single line from a handle.

133-- | Read a single line from a handle.

141hGetLine :: Handle -> IO Text

134hGetLine :: Handle -> IO Text

142−#if __GLASGOW_HASKELL__ <= 610

143−hGetLine = fmap (decodeUtf8 . L8.fromChunks . (:[])) . S8.hGetLine

144−#else

145hGetLine = hGetLineWith L.fromChunks

135hGetLine = hGetLineWith L.fromChunks

146−#endif

147

136

148-- | Write a string to a handle.

137-- | Write a string to a handle.

149hPutStr :: Handle -> Text -> IO ()

138hPutStr :: Handle -> Text -> IO ()

Data/Text/Lazy/Internal.hs+1−1

@@ -8,7 +8,7 @@

8-- duncan@haskell.org

9-- Stability : experimental

10-- Portability : GHC

11−--

11+--

12-- A module containing private 'Text' internals. This exposes the

13-- 'Text' representation and low level construction functions.

14-- Modules which extend the 'Text' system may need to use this module.

Data/Text/Lazy/Read.hs+4−1

@@ -1,4 +1,7 @@

1−{-# LANGUAGE OverloadedStrings #-}

1+{-# LANGUAGE OverloadedStrings, CPP #-}

2+#if __GLASGOW_HASKELL__ >= 702

3+{-# LANGUAGE Trustworthy #-}

4+#endif

2

5

3-- |

6-- |

4-- Module : Data.Text.Lazy.Read

7-- Module : Data.Text.Lazy.Read

Data/Text/Private.hs+11−2

@@ -1,4 +1,4 @@

1−{-# LANGUAGE BangPatterns, UnboxedTuples #-}

1+{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples #-}

2

3-- |

4-- Module : Data.Text.Private

@@ -11,11 +11,14 @@

11

12module Data.Text.Private

13 (

14+ runText

14− span_

15+ , span_

15 ) where

16 ) where

16

17

18+import Control.Monad.ST (ST, runST)

17import Data.Text.Internal (Text(..), textP)

19import Data.Text.Internal (Text(..), textP)

18import Data.Text.Unsafe (Iter(..), iter)

20import Data.Text.Unsafe (Iter(..), iter)

21+import qualified Data.Text.Array as A

19

22

20span_ :: (Char -> Bool) -> Text -> (# Text, Text #)

23span_ :: (Char -> Bool) -> Text -> (# Text, Text #)

21span_ p t@(Text arr off len) = (# hd,tl #)

24span_ p t@(Text arr off len) = (# hd,tl #)

@@ -26,3 +29,9 @@ span_ p t@(Text arr off len) = (# hd,tl #)

26 | otherwise = i

29 | otherwise = i

27 where Iter c d = iter t i

30 where Iter c d = iter t i

28{-# INLINE span_ #-}

31{-# INLINE span_ #-}

32+

33+runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text

34+runText act = runST (act $ \ !marr !len -> do

35+ arr <- A.unsafeFreeze marr

36+ return $! textP arr 0 len)

37+{-# INLINE runText #-}

Data/Text/Read.hs+4−1

@@ -1,4 +1,7 @@

1−{-# LANGUAGE OverloadedStrings, UnboxedTuples #-}

1+{-# LANGUAGE OverloadedStrings, UnboxedTuples, CPP #-}

2+#if __GLASGOW_HASKELL__ >= 702

3+{-# LANGUAGE Trustworthy #-}

4+#endif

2

5

3-- |

6-- |

4-- Module : Data.Text.Read

7-- Module : Data.Text.Read

Data/Text/Search.hs+6−5

@@ -14,7 +14,7 @@

14-- Horspool, Sunday, and Lundh.

15--

16-- References:

17−--

17+--

18-- * R. S. Boyer, J. S. Moore: A Fast String Searching Algorithm.

19-- Communications of the ACM, 20, 10, 762-772 (1977)

20--

@@ -35,10 +35,11 @@ module Data.Text.Search

35import qualified Data.Text.Array as A

36import Data.Word (Word64)

37import Data.Text.Internal (Text(..))

38−import Data.Text.Fusion.Internal (PairS(..))

39import Data.Bits ((.|.), (.&.))

38import Data.Bits ((.|.), (.&.))

40import Data.Text.UnsafeShift (shiftL)

39import Data.Text.UnsafeShift (shiftL)

41

40

41+data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int

42+

42-- | /O(n+m)/ Find the offsets of all non-overlapping indices of

43-- | /O(n+m)/ Find the offsets of all non-overlapping indices of

43-- @needle@ within @haystack@. The offsets returned represent

44-- @needle@ within @haystack@. The offsets returned represent

44-- locations in the low-level array.

45-- locations in the low-level array.

@@ -60,9 +61,8 @@ indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)

60 hindex k = A.unsafeIndex harr (hoff+k)

61 hindex k = A.unsafeIndex harr (hoff+k)

61 hindex' k | k == hlen = 0

62 hindex' k | k == hlen = 0

62 | otherwise = A.unsafeIndex harr (hoff+k)

63 | otherwise = A.unsafeIndex harr (hoff+k)

63− (mask :: Word64) :*: skip = buildTable 0 0 (nlen-2)

64 buildTable !i !msk !skp

65− | i >= nlast = (msk .|. swizzle z) :*: skp

65+ | i >= nlast = (msk .|. swizzle z) :* skp

66 | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'

67 where c = nindex i

68 skp' | c == z = nlen - i - 2

@@ -80,7 +80,8 @@ indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)

80 delta | nextInPattern = nlen + 1

81 | c == z = skip + 1

82 | otherwise = 1

83− nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0

83+ where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0

84+ !(mask :* skip) = buildTable 0 0 (nlen-2)

84 scanOne c = loop 0

85 scanOne c = loop 0

85 where loop !i | i >= hlen = []

86 where loop !i | i >= hlen = []

86 | hindex i == c = i : loop (i+1)

87 | hindex i == c = i : loop (i+1)

Data/Text/Unsafe.hs+4−2

@@ -14,6 +14,7 @@ module Data.Text.Unsafe

14 (

15 inlineInterleaveST

16 , inlinePerformIO

17+ , unsafeDupablePerformIO

17 , Iter(..)

18 , Iter(..)

18 , iter

19 , iter

19 , iter_

20 , iter_

@@ -24,7 +25,7 @@ module Data.Text.Unsafe

24 , takeWord16

25 , takeWord16

25 , dropWord16

26 , dropWord16

26 ) where

27 ) where

27−

28+

28#if defined(ASSERTS)

29#if defined(ASSERTS)

29import Control.Exception (assert)

30import Control.Exception (assert)

30#endif

31#endif

@@ -33,6 +34,7 @@ import Data.Text.Internal (Text(..))

33import Data.Text.Unsafe.Base (inlineInterleaveST, inlinePerformIO)

34import Data.Text.Unsafe.Base (inlineInterleaveST, inlinePerformIO)

34import Data.Text.UnsafeChar (unsafeChr)

35import Data.Text.UnsafeChar (unsafeChr)

35import qualified Data.Text.Array as A

36import qualified Data.Text.Array as A

37+import GHC.IO (unsafeDupablePerformIO)

36

38

37-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'

39-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'

38-- omits the check for the empty case, so there is an obligation on

40-- omits the check for the empty case, so there is an obligation on

@@ -45,7 +47,7 @@ unsafeHead (Text arr off _len)

45 n = A.unsafeIndex arr (off+1)

47 n = A.unsafeIndex arr (off+1)

46{-# INLINE unsafeHead #-}

48{-# INLINE unsafeHead #-}

47

49

48−-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeHead'

50+-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'

49-- omits the check for the empty case, so there is an obligation on

51-- omits the check for the empty case, so there is an obligation on

50-- the programmer to provide a proof that the 'Text' is non-empty.

52-- the programmer to provide a proof that the 'Text' is non-empty.

51unsafeTail :: Text -> Text

53unsafeTail :: Text -> Text

Data/Text/Unsafe/Base.hs+1−5

@@ -15,14 +15,10 @@ module Data.Text.Unsafe.Base

15 inlineInterleaveST

16 , inlinePerformIO

17 ) where

18−

18+

19import GHC.ST (ST(..))

20#if defined(__GLASGOW_HASKELL__)

21−# if __GLASGOW_HASKELL__ >= 611

22import GHC.IO (IO(IO))

21import GHC.IO (IO(IO))

23−# else

24−import GHC.IOBase (IO(IO))

25−# endif

26import GHC.Base (realWorld#)

22import GHC.Base (realWorld#)

27#endif

23#endif

28

24

tests/benchmarks/.gitignore → benchmarks/.gitignorerenamed

The content is the same.

tests/benchmarks/Setup.hs → benchmarks/Setup.hsrenamed

The content is the same.

tests/benchmarks/cbits/time_iconv.c → benchmarks/cbits/time_iconv.crenamed

The content is the same.

tests/benchmarks/src/Data/Text/Benchmarks.hs → benchmarks/haskell/Benchmarks.hsrenamed+21−20

@@ -9,25 +9,25 @@ import Criterion.Main (Benchmark, defaultMain, bgroup)

9import System.FilePath ((</>))

10import System.IO (IOMode (WriteMode), openFile, hSetEncoding, utf8)

11

12−import qualified Data.Text.Benchmarks.Builder as Builder

12+import qualified Benchmarks.Builder as Builder

13−import qualified Data.Text.Benchmarks.DecodeUtf8 as DecodeUtf8

13+import qualified Benchmarks.DecodeUtf8 as DecodeUtf8

14−import qualified Data.Text.Benchmarks.EncodeUtf8 as EncodeUtf8

14+import qualified Benchmarks.EncodeUtf8 as EncodeUtf8

15−import qualified Data.Text.Benchmarks.Equality as Equality

15+import qualified Benchmarks.Equality as Equality

16−import qualified Data.Text.Benchmarks.FileRead as FileRead

16+import qualified Benchmarks.FileRead as FileRead

17−import qualified Data.Text.Benchmarks.FoldLines as FoldLines

17+import qualified Benchmarks.FoldLines as FoldLines

18−import qualified Data.Text.Benchmarks.Pure as Pure

18+import qualified Benchmarks.Pure as Pure

19−import qualified Data.Text.Benchmarks.ReadNumbers as ReadNumbers

19+import qualified Benchmarks.ReadNumbers as ReadNumbers

20−import qualified Data.Text.Benchmarks.Replace as Replace

20+import qualified Benchmarks.Replace as Replace

21−import qualified Data.Text.Benchmarks.Search as Search

21+import qualified Benchmarks.Search as Search

22−import qualified Data.Text.Benchmarks.Stream as Stream

22+import qualified Benchmarks.Stream as Stream

23−import qualified Data.Text.Benchmarks.WordFrequencies as WordFrequencies

23+import qualified Benchmarks.WordFrequencies as WordFrequencies

24

25−import qualified Data.Text.Benchmarks.Programs.BigTable as Programs.BigTable

25+import qualified Benchmarks.Programs.BigTable as Programs.BigTable

26−import qualified Data.Text.Benchmarks.Programs.Cut as Programs.Cut

26+import qualified Benchmarks.Programs.Cut as Programs.Cut

27−import qualified Data.Text.Benchmarks.Programs.Fold as Programs.Fold

27+import qualified Benchmarks.Programs.Fold as Programs.Fold

28−import qualified Data.Text.Benchmarks.Programs.Sort as Programs.Sort

28+import qualified Benchmarks.Programs.Sort as Programs.Sort

29−import qualified Data.Text.Benchmarks.Programs.StripTags as Programs.StripTags

29+import qualified Benchmarks.Programs.StripTags as Programs.StripTags

30−import qualified Data.Text.Benchmarks.Programs.Throughput as Programs.Throughput

30+import qualified Benchmarks.Programs.Throughput as Programs.Throughput

31

32main :: IO ()

33main = benchmarks >>= defaultMain

@@ -49,7 +49,8 @@ benchmarks = do

49 , Equality.benchmark (tf "japanese.txt")

50 , FileRead.benchmark (tf "russian.txt")

51 , FoldLines.benchmark (tf "russian.txt")

52− , Pure.benchmark (tf "japanese.txt")

52+ , Pure.benchmark "tiny "(tf "tiny.txt")

53+ , Pure.benchmark "japanese" (tf "japanese.txt")

53 , ReadNumbers.benchmark (tf "numbers.txt")

54 , ReadNumbers.benchmark (tf "numbers.txt")

54 , Replace.benchmark (tf "russian.txt") "принимая" "своем"

55 , Replace.benchmark (tf "russian.txt") "принимая" "своем"

55 , Search.benchmark (tf "russian.txt") "принимая"

56 , Search.benchmark (tf "russian.txt") "принимая"

@@ -70,4 +71,4 @@ benchmarks = do

70 return $ bs ++ [ps]

71 return $ bs ++ [ps]

71 where

72 where

72 -- Location of a test file

73 -- Location of a test file

73− tf = ("../text-test-data" </>)

74+ tf = ("../tests/text-test-data" </>)

benchmarks/haskell/Benchmarks/Builder.hsnew file+75

@@ -0,0 +1,75 @@

1+-- | Testing the internal builder monoid

2+--

3+-- Tested in this benchmark:

4+--

5+-- * Concatenating many small strings using a builder

6+--

7+{-# LANGUAGE OverloadedStrings #-}

8+module Benchmarks.Builder

9+ ( benchmark

10+ ) where

11+

12+import Criterion (Benchmark, bgroup, bench, nf)

13+import Data.Binary.Builder as B

14+import Data.ByteString.Char8 ()

15+import Data.Monoid (mconcat, mempty)

16+import qualified Blaze.ByteString.Builder as Blaze

17+import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze

18+import qualified Data.ByteString as SB

19+import qualified Data.ByteString.Lazy as LB

20+import qualified Data.Text as T

21+import qualified Data.Text.Lazy as LT

22+import qualified Data.Text.Lazy.Builder as LTB

23+import qualified Data.Text.Lazy.Builder.Int as Int

24+import Data.Int (Int64)

25+

26+benchmark :: IO Benchmark

27+benchmark = return $ bgroup "Builder"

28+ [ bgroup "Comparison"

29+ [ bench "LazyText" $ nf

30+ (LT.length . LTB.toLazyText . mconcat . map LTB.fromText) texts

31+ , bench "Binary" $ nf

32+ (LB.length . B.toLazyByteString . mconcat . map B.fromByteString)

33+ byteStrings

34+ , bench "Blaze" $ nf

35+ (LB.length . Blaze.toLazyByteString . mconcat . map Blaze.fromString)

36+ strings

37+ ]

38+ , bgroup "Int"

39+ [ bgroup "Decimal"

40+ [ bgroup "Positive" .

41+ flip map numbers $ \n ->

42+ (bench (show (length (show n))) $ nf (LTB.toLazyText . Int.decimal) n)

43+ , bgroup "Negative" .

44+ flip map numbers $ \m ->

45+ let n = negate m in

46+ (bench (show (length (show n))) $ nf (LTB.toLazyText . Int.decimal) n)

47+ , bench "Empty" $ nf LTB.toLazyText mempty

48+ , bgroup "Show" .

49+ flip map numbers $ \n ->

50+ (bench (show (length (show n))) $ nf show n)

51+ ]

52+ ]

53+ ]

54+ where

55+ numbers :: [Int64]

56+ numbers = [

57+ 6, 14, 500, 9688, 10654, 620735, 5608880, 37010612,

58+ 731223504, 5061580596, 24596952933, 711732309084, 2845910093839,

59+ 54601756118340, 735159434806159, 3619097625502435, 95777227510267124,

60+ 414944309510675693, 8986407456998704019

61+ ]

62+

63+texts :: [T.Text]

64+texts = take 200000 $ cycle ["foo", "λx", "由の"]

65+{-# NOINLINE texts #-}

66+

67+-- Note that the non-ascii characters will be chopped

68+byteStrings :: [SB.ByteString]

69+byteStrings = take 200000 $ cycle ["foo", "λx", "由の"]

70+{-# NOINLINE byteStrings #-}

71+

72+-- Note that the non-ascii characters will be chopped

73+strings :: [String]

74+strings = take 200000 $ cycle ["foo", "λx", "由の"]

75+{-# NOINLINE strings #-}

tests/benchmarks/src/Data/Text/Benchmarks/DecodeUtf8.hs → benchmarks/haskell/Benchmarks/DecodeUtf8.hsrenamed+2−2

@@ -14,11 +14,11 @@

14--

15-- The latter are used for testing stream fusion.

16--

17−module Data.Text.Benchmarks.DecodeUtf8

17+module Benchmarks.DecodeUtf8

18 ( benchmark

19 ) where

20

21−import Foreign.C.Types (CInt, CSize)

21+import Foreign.C.Types

22import Data.ByteString.Internal (ByteString(..))

23import Foreign.Ptr (Ptr, plusPtr)

24import Foreign.ForeignPtr (withForeignPtr)

tests/benchmarks/src/Data/Text/Benchmarks/EncodeUtf8.hs → benchmarks/haskell/Benchmarks/EncodeUtf8.hsrenamed+1−1

@@ -6,7 +6,7 @@

6--

7-- * UTF-8 encoding it

8--

9−module Data.Text.Benchmarks.EncodeUtf8

9+module Benchmarks.EncodeUtf8

10 ( benchmark

11 ) where

12

tests/benchmarks/src/Data/Text/Benchmarks/Equality.hs → benchmarks/haskell/Benchmarks/Equality.hsrenamed+1−1

@@ -5,7 +5,7 @@

5--

6-- * Comparison of strings (Eq instance)

7--

8−module Data.Text.Benchmarks.Equality

8+module Benchmarks.Equality

9 ( benchmark

10 ) where

11

tests/benchmarks/src/Data/Text/Benchmarks/FileRead.hs → benchmarks/haskell/Benchmarks/FileRead.hsrenamed+1−1

@@ -4,7 +4,7 @@

4--

5-- * Reading a file from the disk

6--

7−module Data.Text.Benchmarks.FileRead

7+module Benchmarks.FileRead

8 ( benchmark

9 ) where

10

tests/benchmarks/src/Data/Text/Benchmarks/FoldLines.hs → benchmarks/haskell/Benchmarks/FoldLines.hsrenamed+1−1

@@ -6,7 +6,7 @@

6-- * Buffered, line-based IO

7--

8{-# LANGUAGE BangPatterns #-}

9−module Data.Text.Benchmarks.FoldLines

9+module Benchmarks.FoldLines

10 ( benchmark

11 ) where

12

tests/benchmarks/src/Data/Text/Benchmarks/Programs/BigTable.hs → benchmarks/haskell/Benchmarks/Programs/BigTable.hsrenamed+1−1

@@ -7,7 +7,7 @@

7-- * Writing to a handle

8--

9{-# LANGUAGE OverloadedStrings #-}

10−module Data.Text.Benchmarks.Programs.BigTable

10+module Benchmarks.Programs.BigTable

11 ( benchmark

12 ) where

13

tests/benchmarks/src/Data/Text/Benchmarks/Programs/Cut.hs → benchmarks/haskell/Benchmarks/Programs/Cut.hsrenamed+1−1

@@ -12,7 +12,7 @@

12--

13-- * Writing back to a handle

14--

15−module Data.Text.Benchmarks.Programs.Cut

15+module Benchmarks.Programs.Cut

16 ( benchmark

17 ) where

18

tests/benchmarks/src/Data/Text/Benchmarks/Programs/Fold.hs → benchmarks/haskell/Benchmarks/Programs/Fold.hsrenamed+1−1

@@ -13,7 +13,7 @@

13-- * Writing back to a handle

14--

15{-# LANGUAGE OverloadedStrings #-}

16−module Data.Text.Benchmarks.Programs.Fold

16+module Benchmarks.Programs.Fold

17 ( benchmark

18 ) where

19

tests/benchmarks/src/Data/Text/Benchmarks/Programs/Sort.hs → benchmarks/haskell/Benchmarks/Programs/Sort.hsrenamed+1−1

@@ -13,7 +13,7 @@

13-- * Writing back to a handle

14--

15{-# LANGUAGE OverloadedStrings #-}

16−module Data.Text.Benchmarks.Programs.Sort

16+module Benchmarks.Programs.Sort

17 ( benchmark

18 ) where

19

tests/benchmarks/src/Data/Text/Benchmarks/Programs/StripTags.hs → benchmarks/haskell/Benchmarks/Programs/StripTags.hsrenamed+2−2

@@ -11,10 +11,10 @@

11-- * Writing back to a handle

12--

13{-# OPTIONS_GHC -fspec-constr-count=5 #-}

14−module Data.Text.Benchmarks.Programs.StripTags

14+module Benchmarks.Programs.StripTags

15 ( benchmark

16 ) where

17−

17+

18import Criterion (Benchmark, bgroup, bench)

19import Data.List (mapAccumL)

20import System.IO (Handle, hPutStr)

tests/benchmarks/src/Data/Text/Benchmarks/Programs/Throughput.hs → benchmarks/haskell/Benchmarks/Programs/Throughput.hsrenamed+1−1

@@ -14,7 +14,7 @@

14--

15-- * Writing back to a handle

16--

17−module Data.Text.Benchmarks.Programs.Throughput

17+module Benchmarks.Programs.Throughput

18 ( benchmark

19 ) where

20

tests/benchmarks/src/Data/Text/Benchmarks/Pure.hs → benchmarks/haskell/Benchmarks/Pure.hsrenamed+15−9

@@ -4,9 +4,9 @@

4--

5-- * Most pure functions defined the string types

6--

7−{-# LANGUAGE BangPatterns, GADTs, MagicHash #-}

7+{-# LANGUAGE BangPatterns, CPP, GADTs, MagicHash #-}

8{-# OPTIONS_GHC -fno-warn-orphans #-}

9−module Data.Text.Benchmarks.Pure

9+module Benchmarks.Pure

10 ( benchmark

11 ) where

12

@@ -27,8 +27,8 @@ import qualified Data.Text.Lazy as TL

27import qualified Data.Text.Lazy.Builder as TB

28import qualified Data.Text.Lazy.Encoding as TL

29

30−benchmark :: FilePath -> IO Benchmark

30+benchmark :: String -> FilePath -> IO Benchmark

31−benchmark fp = do

31+benchmark kind fp = do

32 -- Evaluate stuff before actually running the benchmark, we don't want to

33 -- count it here.

34

@@ -100,6 +100,10 @@ benchmark fp = do

100 , benchBSL $ nf BL.unpack bla

101 , benchS $ nf UTF8.toString bsa

102 ]

103+ , bgroup "decode'"

104+ [ benchT $ nf T.decodeUtf8' bsa

105+ , benchTL $ nf TL.decodeUtf8' bla

106+ ]

103 , bgroup "drop"

107 , bgroup "drop"

104 [ benchT $ nf (T.drop (ta_len `div` 3)) ta

108 [ benchT $ nf (T.drop (ta_len `div` 3)) ta

105 , benchTL $ nf (TL.drop (tla_len `div` 3)) tla

109 , benchTL $ nf (TL.drop (tla_len `div` 3)) tla

@@ -405,11 +409,11 @@ benchmark fp = do

405 ]

409 ]

406 ]

410 ]

407 where

411 where

408− benchS = bench "String"

412+ benchS = bench ("String+" ++ kind)

409− benchT = bench "Text"

413+ benchT = bench ("Text+" ++ kind)

410− benchTL = bench "LazyText"

414+ benchTL = bench ("LazyText+" ++ kind)

411− benchBS = bench "ByteString"

415+ benchBS = bench ("ByteString+" ++ kind)

412− benchBSL = bench "LazyByteString"

416+ benchBSL = bench ("LazyByteString+" ++ kind)

413

417

414 c = 'й'

418 c = 'й'

415 p0 = (== c)

419 p0 = (== c)

@@ -425,11 +429,13 @@ benchmark fp = do

425 replicat n = concat . L.replicate n

429 replicat n = concat . L.replicate n

426 short = T.pack "short"

430 short = T.pack "short"

427

431

432+#if !MIN_VERSION_bytestring(0,10,0)

428instance NFData BS.ByteString

433instance NFData BS.ByteString

429

434

430instance NFData BL.ByteString where

435instance NFData BL.ByteString where

431 rnf BL.Empty = ()

436 rnf BL.Empty = ()

432 rnf (BL.Chunk _ ts) = rnf ts

437 rnf (BL.Chunk _ ts) = rnf ts

438+#endif

433

439

434data B where

440data B where

435 B :: NFData a => a -> B

441 B :: NFData a => a -> B

tests/benchmarks/src/Data/Text/Benchmarks/ReadNumbers.hs → benchmarks/haskell/Benchmarks/ReadNumbers.hsrenamed+2−2

@@ -16,7 +16,7 @@

16--

17-- * Lexing/parsing of different numerical types

18--

19−module Data.Text.Benchmarks.ReadNumbers

19+module Benchmarks.ReadNumbers

20 ( benchmark

21 ) where

22

@@ -88,7 +88,7 @@ text reader = foldl' go 1000000

88 where

89 go z t = case reader t of Left _ -> z

90 Right (n, _) -> min n z

91−

91+

92byteString :: (Ord a, Num a) => (t -> Maybe (a,t)) -> [t] -> a

93byteString reader = foldl' go 1000000

94 where

tests/benchmarks/src/Data/Text/Benchmarks/Replace.hs → benchmarks/haskell/Benchmarks/Replace.hsrenamed+1−1

@@ -4,7 +4,7 @@

4--

5-- * Search and replace of a pattern in a text

6--

7−module Data.Text.Benchmarks.Replace

7+module Benchmarks.Replace

8 ( benchmark

9 ) where

10

tests/benchmarks/src/Data/Text/Benchmarks/Search.hs → benchmarks/haskell/Benchmarks/Search.hsrenamed+1−1

@@ -4,7 +4,7 @@

4--

5-- * Searching all occurences of a pattern using library routines

6--

7−module Data.Text.Benchmarks.Search

7+module Benchmarks.Search

8 ( benchmark

9 ) where

10

tests/benchmarks/src/Data/Text/Benchmarks/Stream.hs → benchmarks/haskell/Benchmarks/Stream.hsrenamed+1−2

@@ -7,7 +7,7 @@

7--

8{-# LANGUAGE BangPatterns #-}

9{-# OPTIONS_GHC -fno-warn-orphans #-}

10−module Data.Text.Benchmarks.Stream

10+module Benchmarks.Stream

11 ( benchmark

12 ) where

13

@@ -86,7 +86,6 @@ benchmark fp = do

86 ]

87

88 -- Encoding.Fusion.Common

89− , bench "restreamUtf8" $ nf F.restreamUtf8 s

90 , bench "restreamUtf16LE" $ nf F.restreamUtf16LE s

89 , bench "restreamUtf16LE" $ nf F.restreamUtf16LE s

91 , bench "restreamUtf16BE" $ nf F.restreamUtf16BE s

90 , bench "restreamUtf16BE" $ nf F.restreamUtf16BE s

92 , bench "restreamUtf32LE" $ nf F.restreamUtf32LE s

91 , bench "restreamUtf32LE" $ nf F.restreamUtf32LE s

tests/benchmarks/src/Data/Text/Benchmarks/WordFrequencies.hs → benchmarks/haskell/Benchmarks/WordFrequencies.hsrenamed+1−1

@@ -8,7 +8,7 @@

8--

9-- * Comparing: Eq/Ord instances

10--

11−module Data.Text.Benchmarks.WordFrequencies

11+module Benchmarks.WordFrequencies

12 ( benchmark

13 ) where

14

benchmarks/haskell/Multilang.hsnew file+32

@@ -0,0 +1,32 @@

1+{-# LANGUAGE BangPatterns, OverloadedStrings, RankNTypes #-}

2+

3+module Main (

4+ main

5+ ) where

6+

7+import Control.Monad (forM_)

8+import qualified Data.ByteString as B

9+import qualified Data.Text as Text

10+import Data.Text.Encoding (decodeUtf8)

11+import Data.Text (Text)

12+import System.IO (hFlush, stdout)

13+import Timer (timer)

14+

15+type BM = Text -> ()

16+

17+bm :: forall a. (Text -> a) -> BM

18+bm f t = f t `seq` ()

19+

20+benchmarks :: [(String, Text.Text -> ())]

21+benchmarks = [

22+ ("find_first", bm $ Text.isInfixOf "en:Benin")

23+ , ("find_index", bm $ Text.findIndex (=='c'))

24+ ]

25+

26+main :: IO ()

27+main = do

28+ !contents <- decodeUtf8 `fmap` B.readFile "../tests/text-test-data/yiwiki.xml"

29+ forM_ benchmarks $ \(name, bmark) -> do

30+ putStr $ name ++ " "

31+ hFlush stdout

32+ putStrLn =<< (timer 100 contents bmark)

benchmarks/haskell/Timer.hsnew file+30

@@ -0,0 +1,30 @@

1+{-# LANGUAGE BangPatterns #-}

2+

3+module Timer (timer) where

4+

5+import Control.Exception (evaluate)

6+import Data.Time.Clock.POSIX (getPOSIXTime)

7+import GHC.Float (FFFormat(..), formatRealFloat)

8+

9+ickyRound :: Int -> Double -> String

10+ickyRound k = formatRealFloat FFFixed (Just k)

11+

12+timer :: Int -> a -> (a -> b) -> IO String

13+timer count a0 f = do

14+ let loop !k !fastest

15+ | k <= 0 = return fastest

16+ | otherwise = do

17+ start <- getPOSIXTime

18+ let inner a i

19+ | i <= 0 = return ()

20+ | otherwise = evaluate (f a) >> inner a (i-1)

21+ inner a0 count

22+ end <- getPOSIXTime

23+ let elapsed = end - start

24+ loop (k-1) (min fastest (elapsed / fromIntegral count))

25+ t <- loop (3::Int) 1e300

26+ let log10 x = log x / log 10

27+ ft = realToFrac t

28+ prec = round (log10 (fromIntegral count) - log10 ft)

29+ return $! ickyRound prec ft

30+{-# NOINLINE timer #-}

tests/benchmarks/python/.gitignore → benchmarks/python/.gitignorerenamed

The content is the same.

tests/benchmarks/python/cut.py → benchmarks/python/cut.pyrenamed

The content is the same.

benchmarks/python/multilang.pynew file+50

@@ -0,0 +1,50 @@

1+#!/usr/bin/env python

2+

3+import math

4+import sys

5+import time

6+

7+def find_first():

8+ cf = contents.find

9+ return timer(lambda: cf("en:Benin"))

10+

11+def timer(f, count=100):

12+ a = 1e300

13+ def g():

14+ return

15+ for i in xrange(3):

16+ start = time.time()

17+ for j in xrange(count):

18+ g()

19+ a = min(a, (time.time() - start) / count)

20+

21+ b = 1e300

22+ for i in xrange(3):

23+ start = time.time()

24+ for j in xrange(count):

25+ f()

26+ b = min(b, (time.time() - start) / count)

27+

28+ return round(b - a, int(round(math.log(count, 10) - math.log(b - a, 10))))

29+

30+contents = open('../../tests/text-test-data/yiwiki.xml', 'r').read()

31+contents = contents.decode('utf-8')

32+

33+benchmarks = (

34+ find_first,

35+ )

36+

37+to_run = sys.argv[1:]

38+bms = []

39+if to_run:

40+ for r in to_run:

41+ for b in benchmarks:

42+ if b.__name__.startswith(r):

43+ bms.append(b)

44+else:

45+ bms = benchmarks

46+

47+for b in bms:

48+ sys.stdout.write(b.__name__ + ' ')

49+ sys.stdout.flush()

50+ print b()

tests/benchmarks/python/sort.py → benchmarks/python/sort.pyrenamed

The content is the same.

tests/benchmarks/python/strip_tags.py → benchmarks/python/strip_tags.pyrenamed

The content is the same.

tests/benchmarks/python/utils.py → benchmarks/python/utils.pyrenamed

The content is the same.

tests/benchmarks/ruby/cut.rb → benchmarks/ruby/cut.rbrenamed

The content is the same.

tests/benchmarks/ruby/fold.rb → benchmarks/ruby/fold.rbrenamed

The content is the same.

tests/benchmarks/ruby/sort.rb → benchmarks/ruby/sort.rbrenamed

The content is the same.

tests/benchmarks/ruby/strip_tags.rb → benchmarks/ruby/strip_tags.rbrenamed

The content is the same.

tests/benchmarks/ruby/utils.rb → benchmarks/ruby/utils.rbrenamed

The content is the same.

benchmarks/text-benchmarks.cabalnew file+54

@@ -0,0 +1,54 @@

1+name: text-benchmarks

2+version: 0.0.0.0

3+synopsis: Benchmarks for the text package

4+description: Benchmarks for the text package

5+homepage: https://bitbucket.org/bos/text

6+license: BSD3

7+license-file: ../LICENSE

8+author: Jasper Van der Jeugt <jaspervdj@gmail.com>,

9+ Bryan O'Sullivan <bos@serpentine.com>,

10+ Tom Harper <rtomharper@googlemail.com>,

11+ Duncan Coutts <duncan@haskell.org>

12+maintainer: jaspervdj@gmail.com

13+category: Text

14+build-type: Simple

15+

16+cabal-version: >=1.2

17+

18+flag llvm

19+ description: use LLVM

20+ default: False

21+

22+executable text-benchmarks

23+ hs-source-dirs: haskell ..

24+ c-sources: ../cbits/cbits.c

25+ cbits/time_iconv.c

26+ include-dirs: ../include

27+ main-is: Benchmarks.hs

28+ ghc-options: -Wall -O2

29+ if flag(llvm)

30+ ghc-options: -fllvm

31+ cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP

32+ build-depends: base == 4.*,

33+ binary,

34+ blaze-builder,

35+ bytestring >= 0.10.4.0,

36+ bytestring-lexing,

37+ containers,

38+ criterion >= 0.6.0.1,

39+ deepseq,

40+ directory,

41+ filepath,

42+ ghc-prim,

43+ integer-gmp,

44+ stringsearch,

45+ utf8-string

46+

47+executable text-multilang

48+ hs-source-dirs: haskell

49+ main-is: Multilang.hs

50+ ghc-options: -Wall -O2

51+ build-depends: base == 4.*,

52+ bytestring,

53+ text,

54+ time

cbits/cbits.c+89−12

@@ -9,6 +9,7 @@

9#include <string.h>

10#include <stdint.h>

11#include <stdio.h>

12+#include "text_cbits.h"

12

13

13void _hs_text_memcpy(void *dest, size_t doff, const void *src, size_t soff,

14void _hs_text_memcpy(void *dest, size_t doff, const void *src, size_t soff,

14 size_t n)

15 size_t n)

@@ -47,7 +48,7 @@ static const uint8_t utf8d[] = {

47 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12,

48 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12,

48 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12,

49 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12,

49 12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12,

50 12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12,

50− 12,36,12,12,12,12,12,12,12,12,12,12,

51+ 12,36,12,12,12,12,12,12,12,12,12,12,

51};

52};

52

53

53static inline uint32_t

54static inline uint32_t

@@ -61,24 +62,83 @@ decode(uint32_t *state, uint32_t* codep, uint32_t byte) {

61 return *state = utf8d[256 + *state + type];

62 return *state = utf8d[256 + *state + type];

62}

63}

63

64

65+/*

66+ * The ISO 8859-1 (aka latin-1) code points correspond exactly to the first 256 unicode

67+ * code-points, therefore we can trivially convert from a latin-1 encoded bytestring to

68+ * an UTF16 array

69+ */

70+void

71+_hs_text_decode_latin1(uint16_t *dest, const uint8_t const *src,

72+ const uint8_t const *srcend)

73+{

74+ const uint8_t *p = src;

75+

76+#if defined(__i386__) || defined(__x86_64__)

77+ /* This optimization works on a little-endian systems by using

78+ (aligned) 32-bit loads instead of 8-bit loads

79+ */

80+

81+ /* consume unaligned prefix */

82+ while (p != srcend && (uintptr_t)p & 0x3)

83+ *dest++ = *p++;

84+

85+ /* iterate over 32-bit aligned loads */

86+ while (p < srcend - 3) {

87+ const uint32_t w = *((const uint32_t *)p);

88+

89+ *dest++ = w & 0xff;

90+ *dest++ = (w >> 8) & 0xff;

91+ *dest++ = (w >> 16) & 0xff;

92+ *dest++ = (w >> 24) & 0xff;

93+

94+ p += 4;

95+ }

96+#endif

97+

98+ /* handle unaligned suffix */

99+ while (p != srcend)

100+ *dest++ = *p++;

101+}

102+

64/*

103/*

65 * A best-effort decoder. Runs until it hits either end of input or

104 * A best-effort decoder. Runs until it hits either end of input or

66 * the start of an invalid byte sequence.

105 * the start of an invalid byte sequence.

67 *

106 *

68− * At exit, updates *destoff with the next offset to write to, and

107+ * At exit, we update *destoff with the next offset to write to, *src

69− * returns the next source offset to read from.

108+ * with the next source location past the last one successfully

109+ * decoded, and return the next source location to read from.

110+ *

111+ * Moreover, we expose the internal decoder state (state0 and

112+ * codepoint0), allowing one to restart the decoder after it

113+ * terminates (say, due to a partial codepoint).

114+ *

115+ * In particular, there are a few possible outcomes,

116+ *

117+ * 1) We decoded the buffer entirely:

118+ * In this case we return srcend

119+ * state0 == UTF8_ACCEPT

120+ *

121+ * 2) We met an invalid encoding

122+ * In this case we return the address of the first invalid byte

123+ * state0 == UTF8_REJECT

124+ *

125+ * 3) We reached the end of the buffer while decoding a codepoint

126+ * In this case we return a pointer to the first byte of the partial codepoint

127+ * state0 != UTF8_ACCEPT, UTF8_REJECT

128+ *

70 */

129 */

71−uint8_t const *

130+const uint8_t *

72−_hs_text_decode_utf8(uint16_t *dest, size_t *destoff,

131+_hs_text_decode_utf8_state(uint16_t *const dest, size_t *destoff,

132+ const uint8_t **const src,

73− const uint8_t const *src, const uint8_t const *srcend)

133+ const uint8_t *const srcend,

134+ uint32_t *codepoint0, uint32_t *state0)

74{

135{

75 uint16_t *d = dest + *destoff;

136 uint16_t *d = dest + *destoff;

76− const uint8_t const *s = src;

137+ const uint8_t *s = *src, *last = *src;

77− uint32_t state = UTF8_ACCEPT;

138+ uint32_t state = *state0;

139+ uint32_t codepoint = *codepoint0;

78

140

79 while (s < srcend) {

141 while (s < srcend) {

80− uint32_t codepoint;

81−

82#if defined(__i386__) || defined(__x86_64__)

142#if defined(__i386__) || defined(__x86_64__)

83 /*

143 /*

84 * This code will only work on a little-endian system that

144 * This code will only work on a little-endian system that

@@ -106,6 +166,7 @@ _hs_text_decode_utf8(uint16_t *dest, size_t *destoff,

106 *d++ = (uint16_t) ((codepoint >> 16) & 0xff);

166 *d++ = (uint16_t) ((codepoint >> 16) & 0xff);

107 *d++ = (uint16_t) ((codepoint >> 24) & 0xff);

167 *d++ = (uint16_t) ((codepoint >> 24) & 0xff);

108 }

168 }

169+ last = s;

109 }

170 }

110#endif

171#endif

111

172

@@ -121,13 +182,29 @@ _hs_text_decode_utf8(uint16_t *dest, size_t *destoff,

121 *d++ = (uint16_t) (0xD7C0 + (codepoint >> 10));

182 *d++ = (uint16_t) (0xD7C0 + (codepoint >> 10));

122 *d++ = (uint16_t) (0xDC00 + (codepoint & 0x3FF));

183 *d++ = (uint16_t) (0xDC00 + (codepoint & 0x3FF));

123 }

184 }

185+ last = s;

124 }

186 }

125

187

126− /* Error recovery - if we're not in a valid finishing state, back up. */

188+ /* Invalid encoding, back up to the errant character */

127− if (state != UTF8_ACCEPT)

189+ if (state == UTF8_REJECT)

128 s -= 1;

190 s -= 1;

129

191

130 *destoff = d - dest;

192 *destoff = d - dest;

193+ *codepoint0 = codepoint;

194+ *state0 = state;

195+ *src = last;

131

196

132 return s;

197 return s;

133}

198}

199+

200+/*

201+ * Helper to decode buffer and discard final decoder state

202+ */

203+const uint8_t *

204+_hs_text_decode_utf8(uint16_t *const dest, size_t *destoff,

205+ const uint8_t *src, const uint8_t *const srcend)

206+{

207+ uint32_t codepoint;

208+ uint32_t state = UTF8_ACCEPT;

209+ return _hs_text_decode_utf8_state(dest, destoff, &src, srcend, &codepoint, &state);

210+}

include/text_cbits.hnew file+11

@@ -0,0 +1,11 @@

1+/*

3+ */

4+

5+#ifndef _text_cbits_h

6+#define _text_cbits_h

7+

8+#define UTF8_ACCEPT 0

9+#define UTF8_REJECT 12

10+

11+#endif

scripts/Arsec.hs+1−1

@@ -26,7 +26,7 @@ import Text.ParserCombinators.Parsec.Prim hiding ((<|>), many)

26instance Applicative (GenParser s a) where

27 pure = return

28 (<*>) = ap

29−

29+

30instance Alternative (GenParser s a) where

31 empty = mzero

32 (<|>) = mplus

tests-and-benchmarks.markdownnew file+63

@@ -0,0 +1,63 @@

1+Tests and benchmarks

2+====================

3+

4+Prerequisites

5+-------------

6+

7+To run the tests and benchmarks, you will need the test data, which

8+you can clone from one of the following locations:

9+

10+* Mercurial master repository:

11+ [bitbucket.org/bos/text-test-data](https://bitbucket.org/bos/text-test-data)

12+

13+* Git mirror repository:

14+ [github.com/bos/text-test-data](https://github.com/bos/text-test-data)

15+

16+You should clone that repository into the `tests` subdirectory (your

17+clone must be named `text-test-data` locally), then run `make -C

18+tests/text-test-data` to uncompress the test files. Many tests and

19+benchmarks will fail if the test files are missing.

20+

21+Functional tests

22+----------------

23+

24+The functional tests are located in the `tests` subdirectory. An overview of

25+what's in that directory:

26+

27+ Makefile Has targets for common tasks

28+ Tests Source files of the testing code

29+ scripts Various utility scripts

30+ text-tests.cabal Cabal file that compiles all benchmarks

31+

32+The `text-tests.cabal` builds:

33+

34+- A copy of the text library, sharing the source code, but exposing all internal

35+ modules, for testing purposes

36+- The different test suites

37+

38+To compile, run all tests, and generate a coverage report, simply use `make`.

39+

40+Benchmarks

41+----------

42+

43+The benchmarks are located in the `benchmarks` subdirectory. An overview of

44+what's in that directory:

45+

46+ Makefile Has targets for common tasks

47+ haskell Source files of the haskell benchmarks

48+ python Python implementations of some benchmarks

49+ ruby Ruby implementations of some benchmarks

50+ text-benchmarks.cabal Cabal file which compiles all benchmarks

51+

52+To compile the benchmarks, navigate to the `benchmarks` subdirectory and run

53+`cabal configure && cabal build`. Then, you can run the benchmarks using:

54+

55+ ./dist/build/text-benchmarks/text-benchmarks

56+

57+However, since there's quite a lot of benchmarks, you usually don't want to

58+run them all. Instead, use the `-l` flag to get a list of benchmarks:

59+

60+ ./dist/build/text-benchmarks/text-benchmarks

61+

62+And run the ones you want to inspect. If you want to configure the benchmarks

63+further, the exact parameters can be changed in `Benchmarks.hs`.

tests/tests/.ghci → tests/.ghcirenamed

The content is the same.

tests/tests/Makefile → tests/Makefilerenamed+8−2

@@ -1,12 +1,18 @@

1+count = 1000

2+

1coverage: build coverage/hpc_index.html

3coverage: build coverage/hpc_index.html

2

4

3−build:

5+build: text-test-data

4 cabal configure -fhpc

6 cabal configure -fhpc

5 cabal build

7 cabal build

6

8

9+text-test-data:

10+ hg clone https://bitbucket.org/bos/text-test-data

11+ $(MAKE) -C text-test-data

12+

7coverage/text-tests.tix:

13coverage/text-tests.tix:

8 -mkdir -p coverage

14 -mkdir -p coverage

9− ./dist/build/text-tests/text-tests

15+ ./dist/build/text-tests/text-tests -a $(count)

10 mv text-tests.tix $@

16 mv text-tests.tix $@

11

17

12coverage/text-tests-stdio.tix:

18coverage/text-tests-stdio.tix:

tests/README.markdowndeleted−63

@@ -1,63 +0,0 @@

1−Tests

2−=====

3−

4−This directory contains the tests for the Text library. To run these

5−tests, you will need the test data from one of the following

6−locations:

7−

8−* Mercurial master repository:

9− [bitbucket.org/bos/text-test-data](https://bitbucket.org/bos/text-test-data)

10−

11−* Git mirror repository:

12− [github.com/bos/text-test-data](https://github.com/bos/text-test-data)

13−

14−You should clone that repository to the same directory as this `README`

15−file, then run `make` to uncompress the test files. Many tests will

16−fail if the test files are missing.

17−

18−There are two categories of tests: functional tests (including QuickCheck

19−properties), and benchmarks.

20−

21−Functional tests

22−----------------

23−

24−The functional tests are located in the `tests` subdirectory. An overview of

25−what's in that directory:

26−

27− scripts Various utility scripts

28− src Source files of the testing code

29− text-tests.cabal Cabal file which compiles all benchmarks

30− Makefile Has targets for common tasks

31−

32−The `text-tests.cabal` builds:

33−

34−- A copy of the text library, sharing the source code, but exposing all internal

35− modules, for testing purposes

36−- The different test suites

37−

38−To compile, run all tests, and generate a coverage report, simply use `make`.

39−

40−Benchmarks

41−----------

42−

43−The benchmarks are located in the `benchmarks` subdirectory. An overview of

44−what's in that directory:

45−

46− python Python implementations of some benchmarks

47− ruby Ruby implementations of some benchmarks

48− src Source files of the haskell benchmarks

49− benchmarks.cabal Cabal file which compiles all benchmarks

50− Makefile Has targets for common tasks

51−

52−To compile the benchmarks, navigate to the `benchmarks` subdirectory and run

53−`cabal configure && cabal build`. Then, you can run the benchmarks using:

54−

55− ./dist/build/benchmarks/benchmarks

56−

57−However, since there quite a lot of benchmarks, you usually don't want to run

58−them all. Instead, use the `-l` flag to get a list of benchmarks:

59−

60− ./dist/build/benchmarks/benchmarks

61−

62−And run the ones you want to inspect. If you want to configure the benchmarks

63−further, the exact parameters can be changed in `src/Data/Text/Benchmarks.hs`.

tests/tests/src/Data/Text/Tests.hs → tests/Tests.hsrenamed+2−2

@@ -6,8 +6,8 @@ module Main

6

7import Test.Framework (defaultMain)

8

9−import qualified Data.Text.Tests.Properties as Properties

9+import qualified Tests.Properties as Properties

10−import qualified Data.Text.Tests.Regressions as Regressions

10+import qualified Tests.Regressions as Regressions

11

12main :: IO ()

13main = defaultMain [Properties.tests, Regressions.tests]

tests/tests/src/Data/Text/Tests/IO.hs → tests/Tests/IO.hsrenamed

The content is the same.

tests/tests/src/Data/Text/Tests/Properties.hs → tests/Tests/Properties.hsrenamed+122−17

@@ -1,10 +1,10 @@

1-- | General quicktest properties for the text library

2--

3−{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,

3+{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, OverloadedStrings,

4− ScopedTypeVariables, TypeSynonymInstances, CPP #-}

4+ ScopedTypeVariables, TypeSynonymInstances #-}

5{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}

6{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

7−module Data.Text.Tests.Properties

7+module Tests.Properties

8 (

9 tests

10 ) where

@@ -16,6 +16,7 @@ import Text.Show.Functions ()

16import Control.Arrow ((***), second)

17import Control.Exception (catch)

18import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)

19+import Data.Int (Int8, Int16, Int32, Int64)

19import Data.Monoid (Monoid(..))

20import Data.Monoid (Monoid(..))

20import Data.String (fromString)

21import Data.String (fromString)

21import Data.Text.Encoding.Error

22import Data.Text.Encoding.Error

@@ -24,13 +25,13 @@ import Data.Text.Fusion.Size

24import Data.Text.Lazy.Read as TL

25import Data.Text.Lazy.Read as TL

25import Data.Text.Read as T

26import Data.Text.Read as T

26import Data.Text.Search (indices)

27import Data.Text.Search (indices)

27−import Data.Word (Word8, Word16, Word32)

28+import Data.Word (Word, Word8, Word16, Word32, Word64)

28import Numeric (showHex)

29import Numeric (showHex)

29−import Prelude hiding (catch, replicate)

30import Test.Framework (Test, testGroup)

31import Test.Framework.Providers.QuickCheck2 (testProperty)

32import qualified Data.Bits as Bits (shiftL, shiftR)

33import qualified Data.ByteString as B

34+import qualified Data.ByteString.Lazy as BL

34import qualified Data.List as L

35import qualified Data.List as L

35import qualified Data.Text as T

36import qualified Data.Text as T

36import qualified Data.Text.Encoding as E

37import qualified Data.Text.Encoding as E

@@ -39,6 +40,8 @@ import qualified Data.Text.Fusion.Common as S

39import qualified Data.Text.IO as T

40import qualified Data.Text.IO as T

40import qualified Data.Text.Lazy as TL

41import qualified Data.Text.Lazy as TL

41import qualified Data.Text.Lazy.Builder as TB

42import qualified Data.Text.Lazy.Builder as TB

43+import qualified Data.Text.Lazy.Builder.Int as TB

44+import qualified Data.Text.Lazy.Builder.RealFloat as TB

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

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

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

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

44import qualified Data.Text.Lazy.IO as TL

47import qualified Data.Text.Lazy.IO as TL

@@ -46,9 +49,15 @@ import qualified Data.Text.Lazy.Search as S (indices)

46import qualified Data.Text.UnsafeShift as U

49import qualified Data.Text.UnsafeShift as U

47import qualified System.IO as IO

50import qualified System.IO as IO

48

51

49−import Data.Text.Tests.QuickCheckUtils

52+import Tests.QuickCheckUtils

50−import Data.Text.Tests.Utils

53+import Tests.Utils

51−import qualified Data.Text.Tests.SlowFunctions as Slow

54+import qualified Tests.SlowFunctions as Slow

55+

56+#if MIN_VERSION_base(4,6,0)

57+import Prelude hiding (replicate)

58+#else

59+import Prelude hiding (catch, replicate)

60+#endif

52

61

53t_pack_unpack = (T.unpack . T.pack) `eq` id

62t_pack_unpack = (T.unpack . T.pack) `eq` id

54tl_pack_unpack = (TL.unpack . TL.pack) `eq` id

63tl_pack_unpack = (TL.unpack . TL.pack) `eq` id

@@ -62,10 +71,20 @@ tl_unstreamChunks x = f 11 x == f 1000 x

62tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id

71tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id

63tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id

72tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id

64

73

74+-- Note: this silently truncates code-points > 255 to 8-bit due to 'B.pack'

75+encodeL1 :: T.Text -> B.ByteString

76+encodeL1 = B.pack . map (fromIntegral . fromEnum) . T.unpack

77+encodeLazyL1 :: TL.Text -> BL.ByteString

78+encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks

79+

65t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a

80t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a

66 where a = T.map (\c -> chr (ord c `mod` 128)) t

81 where a = T.map (\c -> chr (ord c `mod` 128)) t

67tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a

82tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a

68 where a = TL.map (\c -> chr (ord c `mod` 128)) t

83 where a = TL.map (\c -> chr (ord c `mod` 128)) t

84+t_latin1 t = E.decodeLatin1 (encodeL1 a) == a

85+ where a = T.map (\c -> chr (ord c `mod` 256)) t

86+tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) == a

87+ where a = TL.map (\c -> chr (ord c `mod` 256)) t

69t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id

88t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id

70t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)

89t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)

71tl_utf8 = forAll genUnicode $ (EL.decodeUtf8 . EL.encodeUtf8) `eq` id

90tl_utf8 = forAll genUnicode $ (EL.decodeUtf8 . EL.encodeUtf8) `eq` id

@@ -79,6 +98,18 @@ tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id

79t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id

98t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id

80tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id

99tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id

81

100

101+t_utf8_incr = do

102+ Positive n <- arbitrary

103+ forAll genUnicode $ recode n `eq` id

104+ where recode n = T.concat . feedChunksOf n E.streamDecodeUtf8 . E.encodeUtf8

105+ feedChunksOf :: Int -> (B.ByteString -> E.Decoding) -> B.ByteString

106+ -> [T.Text]

107+ feedChunksOf n f bs

108+ | B.null bs = []

109+ | otherwise = let (a,b) = B.splitAt n bs

110+ E.Some t _ f' = f a

111+ in t : feedChunksOf n f' b

112+

82-- This is a poor attempt to ensure that the error handling paths on

113-- This is a poor attempt to ensure that the error handling paths on

83-- decode are exercised in some way. Proper testing would be rather

114-- decode are exercised in some way. Proper testing would be rather

84-- more involved.

115-- more involved.

@@ -610,17 +641,55 @@ shiftR_Word32 = shiftR :: Word32 -> Property

610

641

611-- Builder.

642-- Builder.

612

643

613−t_builderSingleton = id `eqP`

644+tb_singleton = id `eqP`

614− (unpackS . TB.toLazyText . mconcat . map TB.singleton)

645+ (unpackS . TB.toLazyText . mconcat . map TB.singleton)

615−t_builderFromText = L.concat `eq` (unpackS . TB.toLazyText . mconcat .

646+tb_fromText = L.concat `eq` (unpackS . TB.toLazyText . mconcat .

616 map (TB.fromText . packS))

647 map (TB.fromText . packS))

617−t_builderAssociative s1 s2 s3 =

648+tb_associative s1 s2 s3 =

618 TB.toLazyText (b1 `mappend` (b2 `mappend` b3)) ==

649 TB.toLazyText (b1 `mappend` (b2 `mappend` b3)) ==

619 TB.toLazyText ((b1 `mappend` b2) `mappend` b3)

650 TB.toLazyText ((b1 `mappend` b2) `mappend` b3)

620 where b1 = TB.fromText (packS s1)

651 where b1 = TB.fromText (packS s1)

621 b2 = TB.fromText (packS s2)

652 b2 = TB.fromText (packS s2)

622 b3 = TB.fromText (packS s3)

653 b3 = TB.fromText (packS s3)

623

654

655+-- Numeric builder stuff.

656+

657+tb_decimal :: (Integral a, Show a) => a -> Bool

658+tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)

659+

660+tb_decimal_integer (a::Integer) = tb_decimal a

661+tb_decimal_int (a::Int) = tb_decimal a

662+tb_decimal_int8 (a::Int8) = tb_decimal a

663+tb_decimal_int16 (a::Int16) = tb_decimal a

664+tb_decimal_int32 (a::Int32) = tb_decimal a

665+tb_decimal_int64 (a::Int64) = tb_decimal a

666+tb_decimal_word (a::Word) = tb_decimal a

667+tb_decimal_word8 (a::Word8) = tb_decimal a

668+tb_decimal_word16 (a::Word16) = tb_decimal a

669+tb_decimal_word32 (a::Word32) = tb_decimal a

670+tb_decimal_word64 (a::Word64) = tb_decimal a

671+

672+tb_hex :: (Integral a, Show a) => a -> Bool

673+tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")

674+

675+tb_hexadecimal_integer (a::Integer) = tb_hex a

676+tb_hexadecimal_int (a::Int) = tb_hex a

677+tb_hexadecimal_int8 (a::Int8) = tb_hex a

678+tb_hexadecimal_int16 (a::Int16) = tb_hex a

679+tb_hexadecimal_int32 (a::Int32) = tb_hex a

680+tb_hexadecimal_int64 (a::Int64) = tb_hex a

681+tb_hexadecimal_word (a::Word) = tb_hex a

682+tb_hexadecimal_word8 (a::Word8) = tb_hex a

683+tb_hexadecimal_word16 (a::Word16) = tb_hex a

684+tb_hexadecimal_word32 (a::Word32) = tb_hex a

685+tb_hexadecimal_word64 (a::Word64) = tb_hex a

686+

687+tb_realfloat :: (RealFloat a, Show a) => a -> Bool

688+tb_realfloat = (TB.toLazyText . TB.realFloat) `eq` (TL.pack . show)

689+

690+tb_realfloat_float (a::Float) = tb_realfloat a

691+tb_realfloat_double (a::Double) = tb_realfloat a

692+

624-- Reading.

693-- Reading.

625

694

626t_decimal (n::Int) s =

695t_decimal (n::Int) s =

@@ -681,6 +750,8 @@ t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) == t

681 where n = small m

750 where n = small m

682t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)

751t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)

683

752

753+t_copy t = T.copy t == t

754+

684-- Regression tests.

755-- Regression tests.

685s_filter_eq s = S.filter p t == S.streamList (filter p s)

756s_filter_eq s = S.filter p t == S.streamList (filter p s)

686 where p = (/= S.last t)

757 where p = (/= S.last t)

@@ -691,7 +762,7 @@ s_filter_eq s = S.filter p t == S.streamList (filter p s)

691-- themselves.

762-- themselves.

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

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

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

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

694− | n > 0 = S.Stream arr off (smaller (exactSize n) len)

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

695 | otherwise = t

766 | otherwise = t

696

767

697tests :: Test

768tests :: Test

@@ -713,8 +784,11 @@ tests =

713 testGroup "transcoding" [

784 testGroup "transcoding" [

714 testProperty "t_ascii" t_ascii,

785 testProperty "t_ascii" t_ascii,

715 testProperty "tl_ascii" tl_ascii,

786 testProperty "tl_ascii" tl_ascii,

787+ testProperty "t_latin1" t_latin1,

788+ testProperty "tl_latin1" tl_latin1,

716 testProperty "t_utf8" t_utf8,

789 testProperty "t_utf8" t_utf8,

717 testProperty "t_utf8'" t_utf8',

790 testProperty "t_utf8'" t_utf8',

791+ testProperty "t_utf8_incr" t_utf8_incr,

718 testProperty "tl_utf8" tl_utf8,

792 testProperty "tl_utf8" tl_utf8,

719 testProperty "tl_utf8'" tl_utf8',

793 testProperty "tl_utf8'" tl_utf8',

720 testProperty "t_utf16LE" t_utf16LE,

794 testProperty "t_utf16LE" t_utf16LE,

@@ -1080,9 +1154,39 @@ tests =

1080 ],

1154 ],

1081

1155

1082 testGroup "builder" [

1156 testGroup "builder" [

1083− testProperty "t_builderSingleton" t_builderSingleton,

1157+ testProperty "tb_associative" tb_associative,

1084− testProperty "t_builderFromText" t_builderFromText,

1158+ testGroup "decimal" [

1085− testProperty "t_builderAssociative" t_builderAssociative

1159+ testProperty "tb_decimal_int" tb_decimal_int,

1160+ testProperty "tb_decimal_int8" tb_decimal_int8,

1161+ testProperty "tb_decimal_int16" tb_decimal_int16,

1162+ testProperty "tb_decimal_int32" tb_decimal_int32,

1163+ testProperty "tb_decimal_int64" tb_decimal_int64,

1164+ testProperty "tb_decimal_integer" tb_decimal_integer,

1165+ testProperty "tb_decimal_word" tb_decimal_word,

1166+ testProperty "tb_decimal_word8" tb_decimal_word8,

1167+ testProperty "tb_decimal_word16" tb_decimal_word16,

1168+ testProperty "tb_decimal_word32" tb_decimal_word32,

1169+ testProperty "tb_decimal_word64" tb_decimal_word64

1170+ ],

1171+ testGroup "hexadecimal" [

1172+ testProperty "tb_hexadecimal_int" tb_hexadecimal_int,

1173+ testProperty "tb_hexadecimal_int8" tb_hexadecimal_int8,

1174+ testProperty "tb_hexadecimal_int16" tb_hexadecimal_int16,

1175+ testProperty "tb_hexadecimal_int32" tb_hexadecimal_int32,

1176+ testProperty "tb_hexadecimal_int64" tb_hexadecimal_int64,

1177+ testProperty "tb_hexadecimal_integer" tb_hexadecimal_integer,

1178+ testProperty "tb_hexadecimal_word" tb_hexadecimal_word,

1179+ testProperty "tb_hexadecimal_word8" tb_hexadecimal_word8,

1180+ testProperty "tb_hexadecimal_word16" tb_hexadecimal_word16,

1181+ testProperty "tb_hexadecimal_word32" tb_hexadecimal_word32,

1182+ testProperty "tb_hexadecimal_word64" tb_hexadecimal_word64

1183+ ],

1184+ testGroup "realfloat" [

1185+ testProperty "tb_realfloat_double" tb_realfloat_double,

1186+ testProperty "tb_realfloat_float" tb_realfloat_float

1187+ ],

1188+ testProperty "tb_fromText" tb_fromText,

1189+ testProperty "tb_singleton" tb_singleton

1086 ],

1190 ],

1087

1191

1088 testGroup "read" [

1192 testGroup "read" [

@@ -1113,6 +1217,7 @@ tests =

1113 testProperty "t_dropWord16" t_dropWord16,

1217 testProperty "t_dropWord16" t_dropWord16,

1114 testProperty "t_takeWord16" t_takeWord16,

1218 testProperty "t_takeWord16" t_takeWord16,

1115 testProperty "t_take_drop_16" t_take_drop_16,

1219 testProperty "t_take_drop_16" t_take_drop_16,

1116− testProperty "t_use_from" t_use_from

1220+ testProperty "t_use_from" t_use_from,

1221+ testProperty "t_copy" t_copy

1117 ]

1222 ]

1118 ]

1223 ]

tests/tests/src/Data/Text/Tests/QuickCheckUtils.hs → tests/Tests/QuickCheckUtils.hsrenamed+9−9

@@ -1,10 +1,10 @@

1-- | This module provides quickcheck utilities, e.g. arbitrary and show

2-- instances, and comparison functions, so we can focus on the actual properties

3−-- in the 'Data.Text.Tests.Properties' module.

3+-- in the 'Tests.Properties' module.

4--

5{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-}

6{-# OPTIONS_GHC -fno-warn-orphans #-}

7−module Data.Text.Tests.QuickCheckUtils

7+module Tests.QuickCheckUtils

8 (

9 genUnicode

10 , unsquare

@@ -24,7 +24,7 @@ module Data.Text.Tests.QuickCheckUtils

24 , eqP

25

26 , Encoding (..)

27−

27+

28 , write_read

29 ) where

30

@@ -50,7 +50,7 @@ import qualified Data.Text.Lazy.Fusion as TLF

50import qualified Data.Text.Lazy.Internal as TL

51import qualified System.IO as IO

52

53−import Data.Text.Tests.Utils

53+import Tests.Utils

54

55instance Random I16 where

56 randomR = integralRandomR

@@ -67,7 +67,7 @@ genUnicode = fmap fromString string where

67 string = sized $ \n ->

68 do k <- choose (0,n)

69 sequence [ char | _ <- [1..k] ]

70−

70+

71 excluding :: [a -> Bool] -> Gen a -> Gen a

72 excluding bad gen = loop

73 where

@@ -76,14 +76,14 @@ genUnicode = fmap fromString string where

76 if or (map ($ x) bad)

77 then loop

78 else return x

79−

79+

80 reserved = [lowSurrogate, highSurrogate, noncharacter]

81 lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF

82 highSurrogate c = c >= 0xD800 && c <= 0xDBFF

83 noncharacter c = masked == 0xFFFE || masked == 0xFFFF

84 where

85− masked = c .&. 0xFFFF

85+ masked = c .&. 0xFFFF

86−

86+

87 ascii = choose (0,0x7F)

88 plane0 = choose (0xF0, 0xFFFF)

89 plane1 = oneof [ choose (0x10000, 0x10FFF)

@@ -109,7 +109,7 @@ genUnicode = fmap fromString string where

109 ]

110 plane14 = choose (0xE0000, 0xE0FFF)

111 planes = [ascii, plane0, plane1, plane2, plane14]

112−

112+

113 char = chr `fmap` excluding reserved (oneof planes)

114

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

tests/tests/src/Data/Text/Tests/Regressions.hs → tests/Tests/Regressions.hsrenamed+28−3

@@ -1,24 +1,27 @@

1-- | Regression tests for specific bugs.

2--

3{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}

4−module Data.Text.Tests.Regressions

4+module Tests.Regressions

5 (

6 tests

7 ) where

8

9import Control.Exception (SomeException, handle)

10import System.IO

11−import Test.HUnit (assertFailure)

11+import Test.HUnit (assertBool, assertEqual, assertFailure)

12import qualified Data.ByteString as B

13+import Data.ByteString.Char8 ()

13import qualified Data.ByteString.Lazy as LB

14import qualified Data.ByteString.Lazy as LB

14import qualified Data.Text as T

15import qualified Data.Text as T

16+import qualified Data.Text.Encoding as TE

15import qualified Data.Text.IO as T

17import qualified Data.Text.IO as T

16import qualified Data.Text.Lazy as LT

18import qualified Data.Text.Lazy as LT

17import qualified Data.Text.Lazy.Encoding as LE

19import qualified Data.Text.Lazy.Encoding as LE

20+import qualified Data.Text.Unsafe as T

18import qualified Test.Framework as F

21import qualified Test.Framework as F

19import qualified Test.Framework.Providers.HUnit as F

22import qualified Test.Framework.Providers.HUnit as F

20

23

21−import Data.Text.Tests.Utils (withTempFile)

24+import Tests.Utils (withTempFile)

22

25

23-- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring

26-- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring

24-- caused either a segfault or attempt to allocate a negative number

27-- caused either a segfault or attempt to allocate a negative number

@@ -49,9 +52,31 @@ replicate_crash = handle (\(_::SomeException) -> return ()) $

49 power | maxBound == (2147483647::Int) = 28

52 power | maxBound == (2147483647::Int) = 28

50 | otherwise = 60 :: Int

53 | otherwise = 60 :: Int

51

54

55+-- Reported by John Millikin: a UTF-8 decode error handler could

56+-- return a bogus substitution character, which we would write without

57+-- checking.

58+utf8_decode_unsafe :: IO ()

59+utf8_decode_unsafe = do

60+ let t = TE.decodeUtf8With (\_ _ -> Just '\xdc00') "\x80"

61+ assertBool "broken error recovery shouldn't break us" (t == "\xfffd")

62+

63+-- Reported by Eric Seidel: we mishandled mapping Chars that fit in a

64+-- single Word16 to Chars that require two.

65+mapAccumL_resize :: IO ()

66+mapAccumL_resize = do

67+ let f a _ = (a, '\65536')

68+ count = 5

69+ val = T.mapAccumL f (0::Int) (T.replicate count "a")

70+ assertEqual "mapAccumL should correctly fill buffers for two-word results"

71+ (0, T.replicate count "\65536") val

72+ assertEqual "mapAccumL should correctly size buffers for two-word results"

73+ (count * 2) (T.lengthWord16 (snd val))

74+

52tests :: F.Test

75tests :: F.Test

53tests = F.testGroup "Regressions"

76tests = F.testGroup "Regressions"

54 [ F.testCase "hGetContents_crash" hGetContents_crash

77 [ F.testCase "hGetContents_crash" hGetContents_crash

55 , F.testCase "lazy_encode_crash" lazy_encode_crash

78 , F.testCase "lazy_encode_crash" lazy_encode_crash

79+ , F.testCase "mapAccumL_resize" mapAccumL_resize

56 , F.testCase "replicate_crash" replicate_crash

80 , F.testCase "replicate_crash" replicate_crash

81+ , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe

57 ]

82 ]

tests/tests/src/Data/Text/Tests/SlowFunctions.hs → tests/Tests/SlowFunctions.hsrenamed+1−1

@@ -1,5 +1,5 @@

1{-# LANGUAGE BangPatterns #-}

2−module Data.Text.Tests.SlowFunctions

2+module Tests.SlowFunctions

3 (

4 indices

5 , splitOn

tests/tests/src/Data/Text/Tests/Utils.hs → tests/Tests/Utils.hsrenamed+1−1

@@ -1,7 +1,7 @@

1-- | Miscellaneous testing utilities

2--

3{-# LANGUAGE ScopedTypeVariables #-}

4−module Data.Text.Tests.Utils

4+module Tests.Utils

5 (

6 (=^=)

7 , withRedirect

tests/benchmarks/src/Data/Text/Benchmarks/Builder.hsdeleted−48

@@ -1,48 +0,0 @@

1−-- | Testing the internal builder monoid

2−--

3−-- Tested in this benchmark:

4−--

5−-- * Concatenating many small strings using a builder

6−--

7−{-# LANGUAGE OverloadedStrings #-}

8−module Data.Text.Benchmarks.Builder

9− ( benchmark

10− ) where

11−

12−import Criterion (Benchmark, bgroup, bench, nf)

13−import Data.Binary.Builder as B

14−import Data.ByteString.Char8 ()

15−import Data.Monoid (mconcat)

16−import qualified Blaze.ByteString.Builder as Blaze

17−import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze

18−import qualified Data.ByteString as SB

19−import qualified Data.ByteString.Lazy as LB

20−import qualified Data.Text as T

21−import qualified Data.Text.Lazy as LT

22−import qualified Data.Text.Lazy.Builder as LTB

23−

24−benchmark :: IO Benchmark

25−benchmark = return $ bgroup "Builder"

26− [ bench "LazyText" $ nf

27− (LT.length . LTB.toLazyText . mconcat . map LTB.fromText) texts

28− , bench "Binary" $ nf

29− (LB.length . B.toLazyByteString . mconcat . map B.fromByteString)

30− byteStrings

31− , bench "Blaze" $ nf

32− (LB.length . Blaze.toLazyByteString . mconcat . map Blaze.fromString)

33− strings

34− ]

35−

36−texts :: [T.Text]

37−texts = take 200000 $ cycle ["foo", "λx", "由の"]

38−{-# NOINLINE texts #-}

39−

40−-- Note that the non-ascii characters will be chopped

41−byteStrings :: [SB.ByteString]

42−byteStrings = take 200000 $ cycle ["foo", "λx", "由の"]

43−{-# NOINLINE byteStrings #-}

44−

45−-- Note that the non-ascii characters will be chopped

46−strings :: [String]

47−strings = take 200000 $ cycle ["foo", "λx", "由の"]

48−{-# NOINLINE strings #-}

tests/benchmarks/text-benchmarks.cabaldeleted−36

@@ -1,36 +0,0 @@

1−name: text-benchmarks

2−version: 0.0.0.0

3−synopsis: Benchmarks for the text package

4−description: Benchmarks for the text package

5−homepage: https://bitbucket.org/bos/text

6−license: BSD3

7−license-file: ../../LICENSE

8−author: Jasper Van der Jeugt <jaspervdj@gmail.com>,

9− Bryan O'Sullivan <bos@serpentine.com>,

10− Tom Harper <rtomharper@googlemail.com>,

11− Duncan Coutts <duncan@haskell.org>

12−maintainer: jaspervdj@gmail.com

13−category: Text

14−build-type: Simple

15−

16−cabal-version: >=1.2

17−

18−executable text-benchmarks

19− hs-source-dirs: src ../..

20− c-sources: ../../cbits/cbits.c

21− cbits/time_iconv.c

22− main-is: Data/Text/Benchmarks.hs

23− ghc-options: -Wall -O2

24− cpp-options: -DHAVE_DEEPSEQ

25− build-depends: base >= 4 && < 5,

26− criterion >= 0.5 && < 0.7,

27− bytestring >= 0.9 && < 0.10,

28− deepseq >= 1.1 && < 1.2,

29− filepath >= 1.1 && < 1.3,

30− directory >= 1.1 && < 1.2,

31− containers >= 0.3 && < 0.5,

32− binary >= 0.5 && < 0.6,

33− utf8-string >= 0.3 && < 0.4,

34− blaze-builder >= 0.3 && < 0.4,

35− bytestring-lexing >= 0.2 && < 0.3,

36− stringsearch >= 0.3 && < 0.4

tests/tests/scripts/cover-stdio.sh → tests/scripts/cover-stdio.shrenamed

The content is the same.

tests/tests/text-tests.cabal → tests/text-tests.cabalrenamed+37−35

@@ -4,7 +4,7 @@ synopsis: Functional tests for the text package

4description: Functional tests for the text package

5homepage: https://bitbucket.org/bos/text

6license: BSD3

7−license-file: ../../LICENSE

7+license-file: ../LICENSE

8author: Jasper Van der Jeugt <jaspervdj@gmail.com>,

9 Bryan O'Sullivan <bos@serpentine.com>,

10 Tom Harper <rtomharper@googlemail.com>,

@@ -20,8 +20,7 @@ flag hpc

20 default: False

21

22executable text-tests

23− hs-source-dirs: src

24− main-is: Data/Text/Tests.hs

23+ main-is: Tests.hs

25

24

26 ghc-options:

25 ghc-options:

27 -Wall -threaded -O0 -rtsopts

26 -Wall -threaded -O0 -rtsopts

@@ -35,21 +34,20 @@ executable text-tests

35 -DHAVE_DEEPSEQ

34 -DHAVE_DEEPSEQ

36

35

37 build-depends:

36 build-depends:

38− text-tests,

37+ HUnit >= 1.2,

38+ QuickCheck >= 2.4,

39− base >= 4 && < 5,

39+ base == 4.*,

40− bytestring >= 0.9 && < 0.10,

40+ bytestring,

41− deepseq >= 1.1,

41+ deepseq,

42− directory >= 1.1 && < 1.2,

42+ directory,

43− random >= 1.0 && < 1.1,

43+ random,

44− QuickCheck >= 2.4 && < 2.5,

45− HUnit >= 1.2 && < 1.3,

46− test-framework >= 0.4 && < 0.5,

44+ test-framework >= 0.4,

47− test-framework-quickcheck2 >= 0.2 && < 0.3,

48− test-framework-hunit >= 0.2 && < 0.3

45+ test-framework-hunit >= 0.2,

46+ test-framework-quickcheck2 >= 0.2,

47+ text-tests

49

48

50executable text-tests-stdio

49executable text-tests-stdio

51− hs-source-dirs: src

52− main-is: Data/Text/Tests/IO.hs

50+ main-is: Tests/IO.hs

53

51

54 ghc-options:

52 ghc-options:

55 -Wall -threaded -rtsopts

53 -Wall -threaded -rtsopts

@@ -64,41 +62,45 @@ executable text-tests-stdio

64 base >= 4 && < 5

62 base >= 4 && < 5

65

63

66library

64library

67− hs-source-dirs: ../..

65+ hs-source-dirs: ..

68− c-sources: ../../cbits/cbits.c

66+ c-sources: ../cbits/cbits.c

67+ include-dirs: ../include

69 exposed-modules:

68 exposed-modules:

70 Data.Text

69 Data.Text

71 Data.Text.Array

70 Data.Text.Array

72 Data.Text.Encoding

71 Data.Text.Encoding

73 Data.Text.Encoding.Error

72 Data.Text.Encoding.Error

74− Data.Text.Foreign

75− Data.Text.IO

76− Data.Text.Internal

77− Data.Text.Lazy

78− Data.Text.Lazy.Builder

79− Data.Text.Lazy.Builder.Int

80− Data.Text.Lazy.Builder.RealFloat

81− Data.Text.Lazy.Encoding

82− Data.Text.Lazy.IO

83− Data.Text.Lazy.Internal

84− Data.Text.Lazy.Read

85− Data.Text.Read

86 Data.Text.Encoding.Fusion

73 Data.Text.Encoding.Fusion

87 Data.Text.Encoding.Fusion.Common

74 Data.Text.Encoding.Fusion.Common

88 Data.Text.Encoding.Utf16

75 Data.Text.Encoding.Utf16

89 Data.Text.Encoding.Utf32

76 Data.Text.Encoding.Utf32

90 Data.Text.Encoding.Utf8

77 Data.Text.Encoding.Utf8

78+ Data.Text.Foreign

91 Data.Text.Fusion

79 Data.Text.Fusion

92 Data.Text.Fusion.CaseMapping

80 Data.Text.Fusion.CaseMapping

93 Data.Text.Fusion.Common

81 Data.Text.Fusion.Common

94 Data.Text.Fusion.Internal

82 Data.Text.Fusion.Internal

95 Data.Text.Fusion.Size

83 Data.Text.Fusion.Size

84+ Data.Text.IO

96 Data.Text.IO.Internal

85 Data.Text.IO.Internal

86+ Data.Text.Internal

87+ Data.Text.Lazy

88+ Data.Text.Lazy.Builder

97 Data.Text.Lazy.Builder.Functions

89 Data.Text.Lazy.Builder.Functions

90+ Data.Text.Lazy.Builder.Int

91+ Data.Text.Lazy.Builder.Int.Digits

92+ Data.Text.Lazy.Builder.Internal

93+ Data.Text.Lazy.Builder.RealFloat

98 Data.Text.Lazy.Builder.RealFloat.Functions

94 Data.Text.Lazy.Builder.RealFloat.Functions

95+ Data.Text.Lazy.Encoding

99 Data.Text.Lazy.Encoding.Fusion

96 Data.Text.Lazy.Encoding.Fusion

100 Data.Text.Lazy.Fusion

97 Data.Text.Lazy.Fusion

98+ Data.Text.Lazy.IO

99+ Data.Text.Lazy.Internal

100+ Data.Text.Lazy.Read

101 Data.Text.Lazy.Search

102+ Data.Text.Private

103+ Data.Text.Read

102 Data.Text.Search

104 Data.Text.Search

103 Data.Text.Unsafe

105 Data.Text.Unsafe

104 Data.Text.Unsafe.Base

106 Data.Text.Unsafe.Base

@@ -117,8 +119,8 @@ library

117

119

118 build-depends:

120 build-depends:

119 array,

121 array,

120− base >= 4 && < 5,

122+ base == 4.*,

121− bytestring >= 0.9 && < 1.0,

123+ bytestring,

122− deepseq >= 1.1,

124+ deepseq,

125+ ghc-prim,

123− integer-gmp >= 0.2 && < 0.3,

126+ integer-gmp

124− ghc-prim >= 0.2 && < 0.3

text.cabal+69−50

@@ -1,9 +1,9 @@

1name: text

2−version: 0.11.2.0

2+version: 0.11.5.0

3homepage: https://github.com/bos/text

4bug-reports: https://github.com/bos/text/issues

5synopsis: An efficient packed Unicode text type.

6−description:

6+description:

7 .

8 An efficient packed, immutable Unicode text type (both strict and

9 lazy), with a powerful loop fusion optimization framework.

@@ -31,6 +31,15 @@ description:

31 the @text-icu@ package:

32 <http://hackage.haskell.org/package/text-icu>

33 .

34+ —— RELEASE NOTES ——

35+ .

36+ Changes in 0.11.2.0:

37+ .

38+ * String literals are now converted directly from the format in

39+ which GHC stores them into 'Text', without an intermediate

40+ transformation through 'String', and without inlining of

41+ conversion code at each site where a string literal is declared.

42+ .

34license: BSD3

43license: BSD3

35license-file: LICENSE

44license-file: LICENSE

36author: Bryan O'Sullivan <bos@serpentine.com>

45author: Bryan O'Sullivan <bos@serpentine.com>

@@ -40,31 +49,36 @@ category: Data, Text

40build-type: Simple

49build-type: Simple

41cabal-version: >= 1.8

50cabal-version: >= 1.8

42extra-source-files:

51extra-source-files:

43− README.markdown

44 -- scripts/CaseFolding.txt

52 -- scripts/CaseFolding.txt

45 -- scripts/SpecialCasing.txt

53 -- scripts/SpecialCasing.txt

54+ README.markdown

55+ benchmarks/Setup.hs

56+ benchmarks/cbits/*.c

57+ benchmarks/haskell/*.hs

58+ benchmarks/haskell/Benchmarks/*.hs

59+ benchmarks/python/*.py

60+ benchmarks/ruby/*.rb

61+ benchmarks/text-benchmarks.cabal

46 scripts/*.hs

62 scripts/*.hs

47− tests/README.markdown

63+ tests-and-benchmarks.markdown

48− tests/benchmarks/Setup.hs

64+ tests/*.hs

49− tests/benchmarks/cbits/*.c

50− tests/benchmarks/python/*.py

51− tests/benchmarks/ruby/*.rb

52− tests/benchmarks/src/Data/Text/*.hs

53− tests/benchmarks/src/Data/Text/Benchmarks/*.hs

54− tests/benchmarks/text-benchmarks.cabal

55− tests/tests/.ghci

65+ tests/.ghci

56− tests/tests/Makefile

66+ tests/Makefile

67+ tests/Tests/*.hs

57− tests/tests/scripts/*.sh

68+ tests/scripts/*.sh

58− tests/tests/src/Data/Text/*.hs

59− tests/tests/src/Data/Text/Tests/*.hs

60− tests/tests/text-tests.cabal

69+ tests/text-tests.cabal

61

70

62flag developer

71flag developer

63 description: operate in developer mode

72 description: operate in developer mode

64 default: False

73 default: False

65

74

75+flag integer-simple

76+ description: Use the simple integer library instead of GMP

77+ default: False

78+

66library

79library

67− c-sources: cbits/cbits.c

80+ c-sources: cbits/cbits.c

81+ include-dirs: include

68

82

69 exposed-modules:

83 exposed-modules:

70 Data.Text

84 Data.Text

@@ -83,6 +97,7 @@ library

83 Data.Text.Lazy.Internal

97 Data.Text.Lazy.Internal

84 Data.Text.Lazy.Read

98 Data.Text.Lazy.Read

85 Data.Text.Read

99 Data.Text.Read

100+ Data.Text.Unsafe

86 other-modules:

101 other-modules:

87 Data.Text.Encoding.Fusion

102 Data.Text.Encoding.Fusion

88 Data.Text.Encoding.Fusion.Common

103 Data.Text.Encoding.Fusion.Common

@@ -96,51 +111,46 @@ library

96 Data.Text.Fusion.Size

111 Data.Text.Fusion.Size

97 Data.Text.IO.Internal

112 Data.Text.IO.Internal

98 Data.Text.Lazy.Builder.Functions

113 Data.Text.Lazy.Builder.Functions

114+ Data.Text.Lazy.Builder.Int.Digits

115+ Data.Text.Lazy.Builder.Internal

99 Data.Text.Lazy.Builder.RealFloat.Functions

116 Data.Text.Lazy.Builder.RealFloat.Functions

100 Data.Text.Lazy.Encoding.Fusion

117 Data.Text.Lazy.Encoding.Fusion

101 Data.Text.Lazy.Fusion

118 Data.Text.Lazy.Fusion

102 Data.Text.Lazy.Search

119 Data.Text.Lazy.Search

103 Data.Text.Private

120 Data.Text.Private

104 Data.Text.Search

121 Data.Text.Search

105− Data.Text.Unsafe

106 Data.Text.Unsafe.Base

122 Data.Text.Unsafe.Base

107 Data.Text.UnsafeChar

123 Data.Text.UnsafeChar

108 Data.Text.UnsafeShift

124 Data.Text.UnsafeShift

109 Data.Text.Util

125 Data.Text.Util

110

126

111 build-depends:

127 build-depends:

112− array,

128+ array >= 0.3,

113− base < 5,

129+ base >= 4.2 && < 5,

114− bytestring >= 0.10 && < 1.0

130+ bytestring >= 0.10.4.0,

115− if impl(ghc >= 6.10)

116− build-depends:

117− ghc-prim, base >= 4, deepseq >= 1.1.0.0

131+ deepseq >= 1.1.0.0,

118− cpp-options: -DHAVE_DEEPSEQ

132+ ghc-prim >= 0.2

119− else

120− build-depends: extensible-exceptions

121− extensions: PatternSignatures

122

133

134+ cpp-options: -DHAVE_DEEPSEQ

123− ghc-options: -Wall -funbox-strict-fields -O2

135+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2

124− if impl(ghc >= 6.8)

125− ghc-options: -fwarn-tabs

126 if flag(developer)

136 if flag(developer)

127 ghc-prof-options: -auto-all

137 ghc-prof-options: -auto-all

128 ghc-options: -Werror

138 ghc-options: -Werror

129 cpp-options: -DASSERTS

139 cpp-options: -DASSERTS

130

140

131− if impl(ghc >= 6.11)

141+ if flag(integer-simple)

132− cpp-options: -DINTEGER_GMP

142+ cpp-options: -DINTEGER_SIMPLE

133− build-depends: integer-gmp >= 0.2 && < 0.5

143+ build-depends: integer-simple >= 0.1 && < 0.5

134−

144+ else

135− if impl(ghc >= 6.9) && impl(ghc < 6.11)

136 cpp-options: -DINTEGER_GMP

145 cpp-options: -DINTEGER_GMP

137− build-depends: integer >= 0.1 && < 0.2

146+ build-depends: integer-gmp >= 0.2

138

147

139test-suite tests

148test-suite tests

140 type: exitcode-stdio-1.0

149 type: exitcode-stdio-1.0

141− hs-source-dirs: . tests/tests/src

150+ hs-source-dirs: tests .

142− main-is: Data/Text/Tests.hs

151+ main-is: Tests.hs

143 c-sources: cbits/cbits.c

152 c-sources: cbits/cbits.c

153+ include-dirs: include

144

154

145 ghc-options:

155 ghc-options:

146 -Wall -threaded -O0 -rtsopts

156 -Wall -threaded -O0 -rtsopts

@@ -149,16 +159,25 @@ test-suite tests

149 -DASSERTS -DHAVE_DEEPSEQ

159 -DASSERTS -DHAVE_DEEPSEQ

150

160

151 build-depends:

161 build-depends:

162+ HUnit >= 1.2,

163+ QuickCheck >= 2.4,

164+ array,

152− base >= 4 && < 5,

165+ base,

153− bytestring >= 0.10 && < 1.0,

166+ bytestring,

154− deepseq >= 1.1,

167+ deepseq,

155− directory >= 1.0 && < 1.2,

168+ directory,

169+ ghc-prim,

156− random >= 1.0 && < 1.1,

170+ random,

157− QuickCheck >= 2.4 && < 2.5,

171+ test-framework >= 0.4,

158− HUnit >= 1.2 && < 1.3,

159− test-framework >= 0.4 && < 0.5,

172+ test-framework-hunit >= 0.2,

160− test-framework-quickcheck2 >= 0.2 && < 0.3,

173+ test-framework-quickcheck2 >= 0.2

161− test-framework-hunit >= 0.2 && < 0.3

174+

175+ if flag(integer-simple)

176+ cpp-options: -DINTEGER_SIMPLE

177+ build-depends: integer-simple >= 0.1 && < 0.5

178+ else

179+ cpp-options: -DINTEGER_GMP

180+ build-depends: integer-gmp >= 0.2

162

181

163source-repository head

182source-repository head

164 type: git

183 type: git