7ebbc06 · text · git.iko.soy

git.iko.soy/text

Merge branch 'master' of https://github.com/bos/text

commit7ebbc06bf4e8ef92388f6406192c08299b1b4bf9 authorSimon Meier <simon.meier@erudify.com> dateThu 21 Nov 2013, 23:30 (13 years ago) parent073662c e85fa59

89 files changed+1766−878

compare with master

unifiedsplit

.hgignore+7−3

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

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

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

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

2+^benchmarks/.*\.txt$

33^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)$

66~$

78syntax: glob

89.\#*

10+cabal-dev

11+cabal.sandbox.config

12+\.cabal-sandbox

.hgtags+6

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

3636407937739e9e764f1ae0f1f9ca454c42dca38772 0.11.1.10

37378b981edd27befa4c2dd334fcb7db22ac67e22b67 0.11.1.11

3838204da16b5098531bdf858c388e2620238ef2aa5e 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 #-}

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

3+#if __GLASGOW_HASKELL__ >= 702

4+{-# LANGUAGE Trustworthy #-}

5+#endif

47-- |

58-- Module : Data.Text

912--

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

167170 , partition

168171

169172 -- , findSubstring

170−

173+

171174 -- * Indexing

172175 -- $index

173176 , index

174177 , findIndex

175178 , count

176179

177− -- * Zipping and unzipping

180+ -- * Zipping

178181 , zip

179182 , zipWith

180183

181184 -- -* Ordered text

182185 -- , sort

186+

187+ -- * Low level operations

188+ , copy

183189 ) where

184190

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

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

187193 Read(..), Show(..),

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

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

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

190196#if defined(HAVE_DEEPSEQ)

191197import Control.DeepSeq (NFData)

192198#endif

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

195201#endif

196202import Data.Char (isSpace)

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

198−#if __GLASGOW_HASKELL__ >= 612

199204import Data.Data (mkNoRepType)

200−#else

201−import Data.Data (mkNorepType)

202−#endif

203205import Control.Monad (foldM)

204206import qualified Data.Text.Array as A

205207import qualified Data.List as L

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

222224import qualified Data.Text.Lazy as L

223225import Data.Int (Int64)

224226#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#)

225233

226234-- $strict

227235--

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

324332

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

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

327−--

335+--

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

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

330338-- submit improvements.

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

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

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

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

341−#if __GLASGOW_HASKELL__ >= 612

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

343−#else

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

345−#endif

346350

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

348352compareText :: Text -> Text -> Ordering

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

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

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

366370pack :: String -> Text

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

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

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

369373

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

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

372376unpack = S.unstreamList . stream

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

374378

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+

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

376393-- Performs replacement on invalid scalar values.

377394singleton :: Char -> Text

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

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

713730 where len = length t

714731 d = k - len

715− r = d `div` 2

732+ r = d `quot` 2

716733 l = d - r

717734{-# INLINE center #-}

718735

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

884901-- @t@ repeated @n@ times.

885902replicate :: Int -> Text -> Text

886903replicate n t@(Text a o l)

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

888− | n == 1 = t

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

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

891− | otherwise = overflowError "replicate"

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

905+ | n == 1 = t

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

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

908+ | otherwise = overflowError "replicate"

892909 where

893910 len = l * n

894911 x = do

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

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

11111128 | otherwise = go (i+d)

11121129 where Iter c d = iter t i

1113−

1130+

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

11151132group :: Text -> [Text]

11161133group = groupBy (==)

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

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

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

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

1146−--

1163+--

11471164-- and

11481165--

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

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

14391456{-# RULES

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

14411458 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

14441459 #-}

14451460

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

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

15571572

15581573overflowError :: String -> a

15591574overflowError 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

114114-- | Create an uninitialized mutable array.

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

116116new n

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

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

118118 | otherwise = ST $ \s1# ->

119119 case newByteArray# len# s1# of

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

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

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

127127{-# INLINE new #-}

128128

129+array_size_error :: a

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

131+

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

130133unsafeFreeze :: MArray s -> ST s Array

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

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

181184 (marr,b) <- k

182185 arr <- unsafeFreeze marr

183186 return (arr,b))

187+{-# INLINE run2 #-}

184188

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

186190copyM :: MArray s -- ^ Destination

Data/Text/Encoding.hs+187−32

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

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

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

22 UnliftedFFITypes #-}

3+#if __GLASGOW_HASKELL__ >= 702

4+{-# LANGUAGE Trustworthy #-}

5+#endif

36-- |

47-- Module : Data.Text.Encoding

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

2326 -- * Decoding ByteStrings to Text

2427 -- $strict

2528 decodeASCII

29+ , decodeLatin1

2630 , decodeUtf8

2731 , decodeUtf16LE

2832 , decodeUtf16BE

@@ -39,6 +43,12 @@ module Data.Text.Encoding

3943 , decodeUtf32LEWith

4044 , decodeUtf32BEWith

4145

46+ -- ** Stream oriented decoding

47+ -- $stream

48+ , streamDecodeUtf8

49+ , streamDecodeUtf8With

50+ , Decoding(..)

51+

4252 -- * Encoding Text to ByteStrings

4353 , encodeUtf8

4454 , encodeUtf16LE

@@ -53,25 +63,30 @@ import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)

5363#else

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

5565#endif

66+import Control.Monad.ST (runST)

5667import Data.Bits ((.&.))

5768import Data.ByteString as B

5869import Data.ByteString.Internal as B

70+import Data.Text ()

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

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

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

73+import Data.Text.Private (runText)

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

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

63−import Data.Word (Word8)

76+import Data.Word (Word8, Word32)

6477import Foreign.C.Types (CSize)

6578import Foreign.ForeignPtr (withForeignPtr)

6679import Foreign.Marshal.Utils (with)

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

68−import Foreign.Storable (peek, poke)

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

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

6982import GHC.Base (MutableByteArray#)

70−import System.IO.Unsafe (unsafePerformIO)

7183import qualified Data.Text.Array as A

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

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

7486import qualified Data.Text.Fusion as F

87+import Data.Text.Unsafe (unsafeDupablePerformIO)

88+

89+#include "text_cbits.h"

7590

7691-- $strict

7792--

@@ -89,39 +104,171 @@ import qualified Data.Text.Fusion as F

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

90105-- encoded text.

91106--

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

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

93108decodeASCII :: ByteString -> Text

94109decodeASCII = decodeUtf8

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

96111

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

113+--

114+-- 'decodeLatin1' is semantically equivalent to

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

116+decodeLatin1 :: ByteString -> Text

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

118+ where

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

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

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

122+ return dest

123+

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

98125decodeUtf8With :: OnDecodeError -> ByteString -> Text

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

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

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

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

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

130+ loop curPtr = do

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

132+ if curPtr' == end

133+ then do

134+ n <- peek destOffPtr

135+ unsafeSTToIO (done dest (fromIntegral n))

136+ else do

137+ x <- peek curPtr'

138+ case onErr desc (Just x) of

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

140+ Just c -> do

141+ destOff <- peek destOffPtr

142+ w <- unsafeSTToIO $

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

144+ poke destOffPtr (destOff + fromIntegral w)

145+ loop $ curPtr' `plusPtr` 1

146+ loop (ptr `plusPtr` off)

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

100148 where

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

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

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

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

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

106− loop curPtr = do

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

108− if curPtr' == end

109− then do

110− n <- peek destOffPtr

111− return (dest,fromIntegral n)

112− else do

113− x <- peek curPtr'

114− case onErr desc (Just x) of

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

116− Just c -> do

117− destOff <- peek destOffPtr

118− w <- unsafeSTToIO $

119− unsafeWrite dest (fromIntegral destOff) c

120− poke destOffPtr (destOff + fromIntegral w)

121− loop $ curPtr' `plusPtr` 1

122− loop (ptr `plusPtr` off)

123150{- INLINE[0] decodeUtf8With #-}

124151

152+-- $stream

153+--

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

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

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

157+--

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

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

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

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

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

163+--

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

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

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

167+--

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

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

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

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

172+-- as we receive each one.

173+--

174+-- @

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

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

177+-- @

178+--

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

180+--

181+-- @

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

183+-- t1 == \"\"

184+-- @

185+--

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

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

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

189+--

190+-- @

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

192+-- t2 == \"☃\"

193+-- @

194+--

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

196+-- or continuation where it is encountered.

197+

198+-- | A stream oriented decoding result.

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

200+

201+instance Show Decoding where

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

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

204+ showChar ' ' . showsPrec prec' bs .

205+ showString " _"

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

207+

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

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

210+

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

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

213+--

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

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

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

217+-- data, use 'streamDecodeUtf8With'.

218+streamDecodeUtf8 :: ByteString -> Decoding

219+streamDecodeUtf8 = streamDecodeUtf8With strictDecode

220+

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

222+-- encoded text.

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

224+streamDecodeUtf8With onErr = decodeChunk 0 0

225+ where

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

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

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

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

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

231+ where

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

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

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

235+ with codepoint0 $ \codepointPtr ->

236+ with state0 $ \statePtr ->

237+ with nullPtr $ \curPtrPtr ->

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

239+ loop curPtr = do

240+ poke curPtrPtr curPtr

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

242+ curPtrPtr end codepointPtr statePtr

243+ state <- peek statePtr

244+ case state of

245+ UTF8_REJECT -> do

246+ -- We encountered an encoding error

247+ x <- peek curPtr'

248+ case onErr desc (Just x) of

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

250+ Just c -> do

251+ destOff <- peek destOffPtr

252+ w <- unsafeSTToIO $

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

254+ poke destOffPtr (destOff + fromIntegral w)

255+ poke statePtr 0

256+ loop $ curPtr' `plusPtr` 1

257+

258+ _ -> do

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

260+ n <- peek destOffPtr

261+ codepoint <- peek codepointPtr

262+ chunkText <- unsafeSTToIO $ do

263+ arr <- A.unsafeFreeze dest

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

265+ lastPtr <- peek curPtrPtr

266+ let left = lastPtr `minusPtr` curPtr

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

268+ (decodeChunk codepoint state)

269+ in loop (ptr `plusPtr` off)

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

271+

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

126273-- to be valid.

127274--

@@ -135,17 +282,17 @@ decodeUtf8 = decodeUtf8With strictDecode

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

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

137284

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

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

139286--

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

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

142289decodeUtf8' :: ByteString -> Either UnicodeException Text

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

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

144291{-# INLINE decodeUtf8' #-}

145292

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

147294encodeUtf8 :: Text -> ByteString

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

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

149296 let size0 = max len 4

150297 mallocByteString size0 >>= start size0 off 0

151298 where

@@ -278,3 +425,11 @@ encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))

278425foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8

279426 :: MutableByteArray# s -> Ptr CSize

280427 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)

428+

429+foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state

430+ :: MutableByteArray# s -> Ptr CSize

431+ -> Ptr (Ptr Word8) -> Ptr Word8

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

433+

434+foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1

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

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

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

11{-# LANGUAGE CPP, DeriveDataTypeable #-}

2+#if __GLASGOW_HASKELL__ >= 702

3+{-# LANGUAGE Trustworthy #-}

4+#endif

25-- |

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

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

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

3538 , replace

3639 ) where

3740

38−#if __GLASGOW_HASKELL__ >= 610

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

3942import Control.Exception (Exception, throw)

40−#else

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

42−#endif

4343import Data.Typeable (Typeable)

4444import Data.Word (Word8)

4545import Numeric (showHex)

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

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

8989showUnicodeException (EncodeError desc Nothing)

9090 = "Cannot encode input: " ++ desc

91−

91+

9292instance Show UnicodeException where

9393 show = showUnicodeException

9494

9595instance Exception UnicodeException

9696

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+

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

98102strictDecode :: OnDecodeError

99103strictDecode desc c = throw (DecodeError desc c)

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

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

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

4545import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)

4646import Foreign.Storable (pokeByteOff)

47−import System.IO.Unsafe (unsafePerformIO)

4847import qualified Data.ByteString as B

4948import qualified Data.ByteString.Unsafe as B

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

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

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

52+import Data.Text.Unsafe (unsafeDupablePerformIO)

5353

5454streamASCII :: ByteString -> Stream Char

5555streamASCII bs = Stream next 0 (maxSize l)

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

163163

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

165165unstream :: Stream Word8 -> ByteString

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

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

167167 let mlen = upperBound 4 len

168168 mallocByteString mlen >>= loop mlen 0 s0

169169 where

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

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

2121 -- * Restreaming

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

2323 -- representation to another.

24− restreamUtf8

25− , restreamUtf16LE

24+ restreamUtf16LE

2625 , restreamUtf16BE

2726 , restreamUtf32LE

2827 , restreamUtf32BE

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

3433import Data.Text.UnsafeChar (ord)

3534import Data.Text.UnsafeShift (shiftR)

3635import 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 #-}

6236

6337restreamUtf16BE :: Stream Char -> Stream Word8

6438restreamUtf16BE (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

146146validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool

147147{-# INLINE validate4 #-}

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

149− where

149+ where

150150 validate4_1 = x1 == 0xF0 &&

151151 between x2 0x90 0xBF &&

152152 between x3 0x80 0xBF &&

Data/Text/Foreign.hs+26−2

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

2121 , fromPtr

2222 , useAsPtr

2323 , asForeignPtr

24+ -- ** Encoding as UTF-8

25+ , peekCStringLen

26+ , withCStringLen

2427 -- * Unsafe conversion code

2528 , lengthWord16

2629 , unsafeCopyToPtr

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

3841#else

3942import Control.Monad.ST (unsafeIOToST)

4043#endif

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

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

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

4247import Data.Text.Unsafe (lengthWord16)

43−import qualified Data.Text.Array as A

4448import Data.Word (Word16)

49+import Foreign.C.String (CStringLen)

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

4551import Foreign.Marshal.Alloc (allocaBytes)

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

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

4853import Foreign.Storable (peek, poke)

54+import qualified Data.Text.Array as A

4955

5056-- $interop

5157--

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

148154 fp <- mallocForeignPtrArray len

149155 withForeignPtr fp $ unsafeCopyToPtr t

150156 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,

5151 fromIntegral, otherwise)

5252import Data.Bits ((.&.))

5353import Data.Text.Internal (Text(..))

54+import Data.Text.Private (runText)

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

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

5657import qualified Data.Text.Array as A

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

5960import Data.Text.Fusion.Size

6061import qualified Data.Text.Internal as I

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

62−import qualified Prelude as P

6363

6464default(Int)

6565

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

9494

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

9696unstream :: Stream Char -> Text

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

98− where

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

100− where mlen = upperBound 4 len

101− outer arr top = loop

102− where

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

98+ let mlen = upperBound 4 len

99+ arr0 <- A.new mlen

100+ let outer arr top = loop

101+ where

103102 loop !s !i =

104103 case next0 s of

105− Done -> return (arr, i)

104+ Done -> done arr i

106105 Skip s' -> loop s' i

107106 Yield x s'

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

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

114113 loop s' (i+d)

115114 where j | ord x < 0x10000 = i

116115 | otherwise = i + 1

116+ outer arr0 mlen s0 0

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

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

119119

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

223223 arr' <- A.new top'

224224 A.copyM arr' 0 arr 0 top

225225 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

228227 loop z' s' (i+d)

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

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

229+ j | ord c < 0x10000 = i

230230 | otherwise = i + 1

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

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

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

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

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

22-- |

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

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

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

55--

66-- License : BSD-style

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

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

1717 singleton

1818 , streamList

1919 , unstreamList

20+ , streamCString#

2021

2122 -- * Basic interface

2223 , cons

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

104105 (&&), fromIntegral, otherwise)

105106import qualified Data.List as L

106107import qualified Prelude as P

108+import Data.Bits (shiftL)

107109import Data.Int (Int64)

108110import Data.Text.Fusion.Internal

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

110112import Data.Text.Fusion.Size

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

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

111115

112116singleton :: Char -> Stream Char

113117singleton c = Stream next False 1

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

131135

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

133137

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+

134167-- ----------------------------------------------------------------------------

135168-- * Basic stream functions

136169

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

139172

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

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

143176 where

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

145178 next (C0 s) = case next0 s of

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

185218 loop_head !s = case next s of

186219 Yield x _ -> x

187220 Skip s' -> loop_head s'

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

221+ Done -> head_empty

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

190223

224+head_empty :: a

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

226+{-# NOINLINE head_empty #-}

227+

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

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

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

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

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

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

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

277−compareLengthI (Stream next s0 len) n =

314+compareLengthI (Stream next s0 len) n =

278315 case exactly len of

279316 Nothing -> loop_cmp 0 s0

280317 Just i -> compare (fromIntegral i) n

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

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

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

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

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

747783

748784-- ----------------------------------------------------------------------------

749785-- * Searching

Data/Text/Fusion/Internal.hs−2

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

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

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

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

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

105104

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

107106cmp (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)

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

118117 other -> other

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

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

121119

122120-- | The empty stream.

123121empty :: Stream a

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

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

9393

9494mul :: Int -> Int -> Int

9595mul m n

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

97− | otherwise = overflowError

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

97+ | otherwise = overflowError

9898{-# INLINE mul #-}

9999

100100mulSize :: Size -> Size -> Size

Data/Text/IO.hs+39−35

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

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

2+#if __GLASGOW_HASKELL__ >= 702

3+{-# LANGUAGE Trustworthy #-}

4+#endif

25-- |

36-- Module : Data.Text.IO

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

1619module Data.Text.IO

1720 (

1821 -- * Performance

19− -- $performance

22+ -- $performance

2023

2124 -- * Locale support

2225 -- $locale

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

2629 , appendFile

2730 -- * Operations on handles

2831 , hGetContents

32+ , hGetChunk

2933 , hGetLine

3034 , hPutStr

3135 , hPutStrLn

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

3842 ) where

3943

4044import Data.Text (Text)

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

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

4246 putStr, putStrLn, readFile, writeFile)

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

4448 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

5050import Control.Monad (liftM2, when)

5151import Data.IORef (readIORef, writeIORef)

5252import qualified Data.Text as T

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

6464 HandleType(..), Newline(..))

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

6666import System.IO.Error (isEOFError)

67−#endif

6867

6968-- $performance

7069-- #performance#

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

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

9897appendFile p = withFile p AppendMode . flip hPutStr

9998

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+

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

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

102125-- exception is thrown.

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

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

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

111134hGetContents :: Handle -> IO Text

112−#if __GLASGOW_HASKELL__ <= 610

113−hGetContents = fmap decodeUtf8 . B.hGetContents

114−#else

115135hGetContents h = do

116136 chooseGoodBuffering h

117137 wantReadableHandle "hGetContents" h readAll

118138 where

119139 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

128141 buf <- readIORef haCharBuffer

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

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

130143 if T.null t

131144 then return [t]

132145 else (t:) `fmap` readChunks

133146 ts <- readChunks

134147 (hh', _) <- hClose_help hh

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

136−

149+

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

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

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

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

144157 bufMode <- hGetBuffering h

145158 case bufMode of

146159 BlockBuffering Nothing -> do

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

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

148161 if ioe_type e == InappropriateType

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

150− else throwIO e

163+ else E.throwIO e

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

152165 _ -> return ()

153−#endif

154166

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

156168hGetLine :: Handle -> IO Text

157−#if __GLASGOW_HASKELL__ <= 610

158−hGetLine = fmap decodeUtf8 . B.hGetLine

159−#else

160169hGetLine = hGetLineWith T.concat

161−#endif

162170

163171-- | Write a string to a handle.

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

165−#if __GLASGOW_HASKELL__ <= 610

166−hPutStr h = B.hPutStr h . encodeUtf8

167−#else

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

169174hPutStr h t = do

170− (buffer_mode, nl) <-

175+ (buffer_mode, nl) <-

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

172177 bmode <- getSpareBuffer h_

173178 return (bmode, haOutputNL h_)

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

249254

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

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

252−getSpareBuffer Handle__{haCharBuffer=ref,

257+getSpareBuffer Handle__{haCharBuffer=ref,

253258 haBuffers=spare_ref,

254259 haBufferMode=mode}

255260 = do

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

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

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

272277 -> IO CharBuffer

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

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

274279 wantWritableHandle "commitAndReleaseBuffer" hdl $

275280 commitBuffer' raw sz count flush release

276281{-# INLINE commitBuffer #-}

277−#endif

278282

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

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

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

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

1212

1313module Data.Text.IO.Internal

1414 (

15−#if __GLASGOW_HASKELL__ >= 612

1615 hGetLineWith

1716 , readChunk

18−#endif

1917 ) where

2018

21−#if __GLASGOW_HASKELL__ >= 612

22−import Control.Exception (catch)

19+import qualified Control.Exception as E

2320import Data.IORef (readIORef, writeIORef)

2421import Data.Text (Text)

2522import Data.Text.Fusion (unstream)

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

3229 withRawBuffer, writeCharBuf)

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

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

35−import Prelude hiding (catch)

3632import System.IO (Handle)

3733import System.IO.Error (isEOFError)

3834import qualified Data.Text as T

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

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

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

8682maybeFillReadBuffer handle_ buf

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

88− if isEOFError e

89− then return Nothing

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

84+ if isEOFError e

85+ then return Nothing

9086 else ioError e

9187

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

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

164160

165161sizeError :: String -> a

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

167−#endif

Data/Text/Internal.hs+25−4

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

2323module Data.Text.Internal

2424 (

2525 -- * Types

26+ -- $internals

2627 Text(..)

2728 -- * Construction

2829 , text

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

4748

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

4950data Text = Text

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

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

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

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

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

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

5354 deriving (Typeable)

5455

5556-- | Smart constructor.

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

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

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

9293-- 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.

9496safe :: Char -> Char

9597safe c

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

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

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

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

103105firstf _ 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 @@

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

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

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

3+#if __GLASGOW_HASKELL__ >= 702

4+{-# LANGUAGE Trustworthy #-}

5+#endif

36-- |

47-- Module : Data.Text.Lazy

69--

710-- License : BSD-style

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

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

174177 , partition

175178

176179 -- , findSubstring

177−

180+

178181 -- * Indexing

179182 , index

180183 , count

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

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

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

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

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

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

194197import qualified Prelude as P

195198#if defined(HAVE_DEEPSEQ)

196199import Control.DeepSeq (NFData(..))

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

199202import qualified Data.List as L

200203import Data.Char (isSpace)

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

202−#if __GLASGOW_HASKELL__ >= 612

203205import Data.Data (mkNoRepType)

204−#else

205−import Data.Data (mkNorepType)

206−#endif

207206import Data.Monoid (Monoid(..))

208207import Data.String (IsString(..))

209208import qualified Data.Text as T

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

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

218217import qualified Data.Text.Util as U

219218import 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#)

220225

221226-- $fusion

222227--

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

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

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

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

335−#if __GLASGOW_HASKELL__ >= 612

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

337−#else

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

339−#endif

340341

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

342343--

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

351352unpack t = S.unstreamList (stream t)

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

353354

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+

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

355369-- Performs replacement on invalid scalar values.

356370singleton :: Char -> Text

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

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

607621 where len = length t

608622 d = k - len

609− r = d `div` 2

623+ r = d `quot` 2

610624 l = d - r

611625{-# INLINE center #-}

612626

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

902916 | otherwise = drop' i t0

903917 where drop' 0 ts = ts

904918 drop' _ Empty = Empty

905− drop' n (Chunk t ts)

919+ drop' n (Chunk t ts)

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

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

908922 where len = fromIntegral (T.length t)

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

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

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

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

1193−--

1207+--

11941208-- and

11951209--

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

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

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

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

2+#if __GLASGOW_HASKELL__ >= 702

3+{-# LANGUAGE Trustworthy #-}

4+#endif

36-----------------------------------------------------------------------------

47-- |

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

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

8−--

12+--

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

1014-- Stability : experimental

1115-- Portability : portable to Hugs and GHC

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

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

1620-- concatenates two builders.

1721--

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

1925--

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

2127--

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

2329--

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

2531--

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'

2736--

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

38+-- to the right.

39+

2840-----------------------------------------------------------------------------

2941

3042module Data.Text.Lazy.Builder

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

4355 , flush

4456 ) where

4557

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

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− #-}

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

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

36-- Module: Data.Text.Lazy.Builder.Int

59-- License: BSD3

610-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>

711-- Stability: experimental

@@ -17,45 +21,134 @@ module Data.Text.Lazy.Builder.Int

1721

1822import Data.Int (Int8, Int16, Int32, Int64)

1923import Data.Monoid (mempty)

24+import qualified Data.ByteString.Unsafe as B

2025import 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

2229import Data.Word (Word, Word8, Word16, Word32, Word64)

2330import GHC.Base (quotInt, remInt)

2431import GHC.Num (quotRemInteger)

2532import GHC.Types (Int(..))

33+import Control.Monad.ST

2634

2735#ifdef __GLASGOW_HASKELL__

28−# if __GLASGOW_HASKELL__ < 611

29−import GHC.Integer.Internals

30−# else

36+# if defined(INTEGER_GMP)

3137import 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."

3242# endif

3343#endif

3444

35−#ifdef INTEGER_GMP

45+#if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE)

3646# define PAIR(a,b) (# a,b #)

3747#else

3848# define PAIR(a,b) (a,b)

3949#endif

4050

4151decimal :: Integral a => a -> Builder

42−{-# SPECIALIZE decimal :: Int -> Builder #-}

4352{-# SPECIALIZE decimal :: Int8 -> Builder #-}

44−{-# SPECIALIZE decimal :: Int16 -> Builder #-}

45−{-# SPECIALIZE decimal :: Int32 -> Builder #-}

46−{-# SPECIALIZE decimal :: Int64 -> Builder #-}

47−{-# SPECIALIZE decimal :: Word -> Builder #-}

48−{-# SPECIALIZE decimal :: Word8 -> Builder #-}

49−{-# SPECIALIZE decimal :: Word16 -> Builder #-}

50−{-# SPECIALIZE decimal :: Word32 -> Builder #-}

51−{-# SPECIALIZE decimal :: Word64 -> Builder #-}

53+{-# RULES "decimal/Int" decimal = boundedDecimal :: Int -> Builder #-}

54+{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}

55+{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}

56+{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}

57+{-# RULES "decimal/Word" decimal = positive :: Word -> Builder #-}

58+{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}

59+{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}

60+{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}

61+{-# RULES "decimal/Word64" decimal = positive :: Word64 -> Builder #-}

5262{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}

53−decimal i

54− | i < 0 = singleton '-' <> go (-i)

55− | otherwise = go i

56− where

57− go n | n < 10 = digit n

58− | otherwise = go (n `quot` 10) <> digit (n `rem` 10)

63+decimal i = decimal' (<= -128) i

64+

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)

136+ where go !k v

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

150+ | otherwise = go (k + 12) (v `quot` 1000000000000)

151+ fin v n = if v >= n then 1 else 0

59152

60153hexadecimal :: Integral a => a -> Builder

61154{-# SPECIALIZE hexadecimal :: Int -> Builder #-}

@@ -68,17 +161,22 @@ hexadecimal :: Integral a => a -> Builder

68161{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-}

69162{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-}

70163{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-}

71−{-# RULES "hexadecimal/Integer" hexadecimal = integer 16 :: Integer -> Builder #-}

164+{-# RULES "hexadecimal/Integer"

165+ hexadecimal = hexInteger :: Integer -> Builder #-}

72166hexadecimal i

73− | i < 0 = singleton '-' <> go (-i)

167+ | i < 0 = error hexErrMsg

74168 | otherwise = go i

75169 where

76170 go n | n < 16 = hexDigit n

77171 | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)

78172

79−digit :: Integral a => a -> Builder

80−digit n = singleton $! i2d (fromIntegral n)

81−{-# INLINE digit #-}

173+hexInteger :: Integer -> Builder

174+hexInteger i

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"

82180

83181hexDigit :: Integral a => a -> Builder

84182hexDigit n

@@ -93,8 +191,13 @@ int = decimal

93191data T = T !Integer !Int

94192

95193integer :: Int -> Integer -> Builder

194+#ifdef INTEGER_GMP

96195integer 10 (S# i#) = decimal (I# i#)

97196integer 16 (S# i#) = hexadecimal (I# i#)

197+#else

198+integer 10 i = decimal i

199+integer 16 i = hexadecimal i

200+#endif

98201integer base i

99202 | i < 0 = singleton '-' <> go (-i)

100203 | otherwise = go i

@@ -146,7 +249,7 @@ integer base i

146249 pblock = loop maxDigits

147250 where

148251 loop !d !n

149− | d == 1 = digit n

150− | otherwise = loop (d-1) q <> digit r

252+ | d == 1 = hexDigit n

253+ | otherwise = loop (d-1) q <> hexDigit r

151254 where q = n `quotInt` base

152255 r = n `remInt` base

Data/Text/Lazy/Builder/Int/Digits.hsnew file+22

@@ -0,0 +1,22 @@

1+{-# LANGUAGE OverloadedStrings #-}

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 #-}

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

36-- |

47-- Module: Data.Text.Lazy.Builder.RealFloat

Data/Text/Lazy/Encoding.hs+12−4

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

1−{-# LANGUAGE BangPatterns #-}

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

2+#if __GLASGOW_HASKELL__ >= 702

3+{-# LANGUAGE Trustworthy #-}

4+#endif

25-- |

36-- Module : Data.Text.Lazy.Encoding

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

2023 -- * Decoding ByteStrings to Text

2124 -- $strict

2225 decodeASCII

26+ , decodeLatin1

2327 , decodeUtf8

2428 , decodeUtf16LE

2529 , decodeUtf16BE

@@ -48,7 +52,6 @@ import Control.Exception (evaluate, try)

4852import Data.Bits ((.&.))

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

5054import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldrChunks)

51−import System.IO.Unsafe (unsafePerformIO)

5255import qualified Data.ByteString as S

5356import qualified Data.ByteString.Lazy as B

5457import qualified Data.ByteString.Lazy.Internal as B

@@ -57,6 +60,7 @@ import qualified Data.Text as T

5760import qualified Data.Text.Encoding as TE

5861import qualified Data.Text.Lazy.Encoding.Fusion as E

5962import qualified Data.Text.Lazy.Fusion as F

63+import Data.Text.Unsafe (unsafeDupablePerformIO)

6064

6165-- $strict

6266--

@@ -74,11 +78,15 @@ import qualified Data.Text.Lazy.Fusion as F

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

7579-- encoded text.

7680--

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

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

7882decodeASCII :: B.ByteString -> Text

7983decodeASCII = decodeUtf8

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

8185

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

87+decodeLatin1 :: B.ByteString -> Text

88+decodeLatin1 = foldr (chunk . TE.decodeLatin1) empty . B.toChunks

89+

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

8391decodeUtf8With :: OnDecodeError -> B.ByteString -> Text

8492decodeUtf8With onErr bs0 = fast bs0

@@ -141,7 +149,7 @@ decodeUtf8 = decodeUtf8With strictDecode

141149-- input before it can return a result. If you need lazy (streaming)

142150-- decoding, use 'decodeUtf8With' in lenient mode.

143151decodeUtf8' :: B.ByteString -> Either UnicodeException Text

144−decodeUtf8' bs = unsafePerformIO $ do

152+decodeUtf8' bs = unsafeDupablePerformIO $ do

145153 let t = decodeUtf8 bs

146154 try (evaluate (rnf t `seq` t))

147155 where

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

@@ -5,7 +5,7 @@

66--

77-- License : BSD-style

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

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

99-- duncan@haskell.org

1010-- Stability : experimental

1111-- Portability : portable

@@ -42,7 +42,7 @@ import Data.Word (Word8, Word16, Word32)

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

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

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

45−import System.IO.Unsafe (unsafePerformIO)

45+import Data.Text.Unsafe (unsafeDupablePerformIO)

4646import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)

4747import Foreign.Storable (pokeByteOff)

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

@@ -272,7 +272,7 @@ streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

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

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

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

275− where chunk s1 len1 = unsafePerformIO $ do

275+ where chunk s1 len1 = unsafeDupablePerformIO $ do

276276 let len = max 4 (min len1 chunkSize)

277277 mallocByteString len >>= loop len 0 s1

278278 where

Data/Text/Lazy/Fusion.hs+26−22

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

2424

2525import Prelude hiding (length)

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

27+import Control.Monad.ST (runST)

2728import Data.Text.Fusion.Internal

2829import Data.Text.Fusion.Size (isEmpty, unknownSize)

2930import Data.Text.Lazy.Internal

@@ -50,33 +51,36 @@ stream text = Stream next (text :*: 0) unknownSize

5051-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given

5152-- chunk size.

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

53−unstreamChunks chunkSize (Stream next s0 len0)

54+unstreamChunks !chunkSize (Stream next s0 len0)

5455 | isEmpty len0 = Empty

5556 | otherwise = outer s0

5657 where

57− outer s = {-# SCC "unstreamChunks/outer" #-}

58− case next s of

58+ outer so = {-# SCC "unstreamChunks/outer" #-}

59+ case next so of

5960 Done -> Empty

6061 Skip s' -> outer s'

61− Yield x s' -> I.Text arr 0 len `chunk` outer s''

62− where (arr,(s'',len)) = A.run2 fill

63− fill = do a <- A.new unknownLength

64− unsafeWrite a 0 x >>= inner a unknownLength s'

65− unknownLength = 4

66− inner marr len s !i

67− | i + 1 >= chunkSize = return (marr, (s,i))

68− | i + 1 >= len = {-# SCC "unstreamChunks/resize" #-} do

69− let newLen = min (len `shiftL` 1) chunkSize

70− marr' <- A.new newLen

71− A.copyM marr' 0 marr 0 len

72− inner marr' newLen s i

73− | otherwise =

74− {-# SCC "unstreamChunks/inner" #-}

75− case next s of

76− Done -> return (marr,(s,i))

77− Skip s' -> inner marr len s' i

78− Yield x s' -> do d <- unsafeWrite marr i x

79− inner marr len s' (i+d)

62+ Yield x s' -> runST $ do

63+ a <- A.new unknownLength

64+ unsafeWrite a 0 x >>= inner a unknownLength s'

65+ where unknownLength = 4

66+ where

67+ inner marr !len s !i

68+ | i + 1 >= chunkSize = finish marr i s

69+ | i + 1 >= len = {-# SCC "unstreamChunks/resize" #-} do

70+ let newLen = min (len `shiftL` 1) chunkSize

71+ marr' <- A.new newLen

72+ A.copyM marr' 0 marr 0 len

73+ inner marr' newLen s i

74+ | otherwise =

75+ {-# SCC "unstreamChunks/inner" #-}

76+ case next s of

77+ Done -> finish marr i s

78+ Skip s' -> inner marr len s' i

79+ Yield x s' -> do d <- unsafeWrite marr i x

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

8084{-# INLINE [0] unstreamChunks #-}

8185

8286-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using

Data/Text/Lazy/IO.hs+9−20

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

11{-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}

2+#if __GLASGOW_HASKELL__ >= 702

3+{-# LANGUAGE Trustworthy #-}

4+#endif

25-- |

36-- Module : Data.Text.Lazy.IO

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

1619module Data.Text.Lazy.IO

1720 (

1821 -- * Performance

19− -- $performance

22+ -- $performance

2023

2124 -- * Locale support

2225 -- $locale

@@ -38,18 +41,13 @@ module Data.Text.Lazy.IO

3841 ) where

3942

4043import Data.Text.Lazy (Text)

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

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

4245 putStr, putStrLn, readFile, writeFile)

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

4447 withFile)

4548import qualified Data.Text.IO as T

4649import 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

5351import Control.Monad (when)

5452import Data.IORef (readIORef)

5553import Data.Text.IO.Internal (hGetLineWith, readChunk)

@@ -62,7 +60,6 @@ import GHC.IO.Handle.Types (Handle__(..), HandleType(..))

6260import System.IO (BufferMode(..), hGetBuffering, hSetBuffering)

6361import System.IO.Error (isEOFError)

6462import System.IO.Unsafe (unsafeInterleaveIO)

65−#endif

6663

6764-- $performance

6865--

@@ -96,9 +93,6 @@ appendFile p = withFile p AppendMode . flip hPutStr

9693-- | Lazily read the remaining contents of a 'Handle'. The 'Handle'

9794-- will be closed after the read completes, or on error.

9895hGetContents :: Handle -> IO Text

99−#if __GLASGOW_HASKELL__ <= 610

100−hGetContents = fmap decodeUtf8 . L8.hGetContents

101−#else

10296hGetContents h = do

10397 chooseGoodBuffering h

10498 wantReadableHandle "hGetContents" h $ \hh -> do

@@ -119,7 +113,7 @@ lazyRead h = unsafeInterleaveIO $

119113 case haType hh of

120114 ClosedHandle -> return (hh, L.empty)

121115 SemiClosedHandle -> lazyReadBuffered h hh

122− _ -> ioException

116+ _ -> ioException

123117 (IOError (Just h) IllegalOperation "hGetContents"

124118 "illegal handle type" Nothing Nothing)

125119

@@ -128,22 +122,17 @@ lazyReadBuffered h hh@Handle__{..} = do

128122 buf <- readIORef haCharBuffer

129123 (do t <- readChunk hh buf

130124 ts <- lazyRead h

131− return (hh, chunk t ts)) `catch` \e -> do

125+ return (hh, chunk t ts)) `E.catch` \e -> do

132126 (hh', _) <- hClose_help hh

133127 if isEOFError e

134128 then return $ if isEmptyBuffer buf

135129 then (hh', empty)

136130 else (hh', L.singleton '\r')

137− else throwIO (augmentIOError e "hGetContents" h)

138−#endif

131+ else E.throwIO (augmentIOError e "hGetContents" h)

139132

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

141134hGetLine :: Handle -> IO Text

142−#if __GLASGOW_HASKELL__ <= 610

143−hGetLine = fmap (decodeUtf8 . L8.fromChunks . (:[])) . S8.hGetLine

144−#else

145135hGetLine = hGetLineWith L.fromChunks

146−#endif

147136

148137-- | Write a string to a handle.

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

Data/Text/Lazy/Internal.hs+1−1

@@ -8,7 +8,7 @@

88-- duncan@haskell.org

99-- Stability : experimental

1010-- Portability : GHC

11−--

11+--

1212-- A module containing private 'Text' internals. This exposes the

1313-- 'Text' representation and low level construction functions.

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

36-- |

47-- Module : Data.Text.Lazy.Read

Data/Text/Private.hs+11−2

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

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

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

33-- |

44-- Module : Data.Text.Private

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

1111

1212module Data.Text.Private

1313 (

14− span_

14+ runText

15+ , span_

1516 ) where

1617

18+import Control.Monad.ST (ST, runST)

1719import Data.Text.Internal (Text(..), textP)

1820import Data.Text.Unsafe (Iter(..), iter)

21+import qualified Data.Text.Array as A

1922

2023span_ :: (Char -> Bool) -> Text -> (# Text, Text #)

2124span_ p t@(Text arr off len) = (# hd,tl #)

@@ -26,3 +29,9 @@ span_ p t@(Text arr off len) = (# hd,tl #)

2629 | otherwise = i

2730 where Iter c d = iter t i

2831{-# 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

36-- |

47-- Module : Data.Text.Read

Data/Text/Search.hs+6−5

@@ -14,7 +14,7 @@

1414-- Horspool, Sunday, and Lundh.

1515--

1616-- References:

17−--

17+--

1818-- * R. S. Boyer, J. S. Moore: A Fast String Searching Algorithm.

1919-- Communications of the ACM, 20, 10, 762-772 (1977)

2020--

@@ -35,10 +35,11 @@ module Data.Text.Search

3535import qualified Data.Text.Array as A

3636import Data.Word (Word64)

3737import Data.Text.Internal (Text(..))

38−import Data.Text.Fusion.Internal (PairS(..))

3938import Data.Bits ((.|.), (.&.))

4039import Data.Text.UnsafeShift (shiftL)

4140

41+data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int

42+

4243-- | /O(n+m)/ Find the offsets of all non-overlapping indices of

4344-- @needle@ within @haystack@. The offsets returned represent

4445-- locations in the low-level array.

@@ -60,9 +61,8 @@ indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)

6061 hindex k = A.unsafeIndex harr (hoff+k)

6162 hindex' k | k == hlen = 0

6263 | otherwise = A.unsafeIndex harr (hoff+k)

63− (mask :: Word64) :*: skip = buildTable 0 0 (nlen-2)

6464 buildTable !i !msk !skp

65− | i >= nlast = (msk .|. swizzle z) :*: skp

65+ | i >= nlast = (msk .|. swizzle z) :* skp

6666 | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'

6767 where c = nindex i

6868 skp' | c == z = nlen - i - 2

@@ -80,7 +80,8 @@ indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)

8080 delta | nextInPattern = nlen + 1

8181 | c == z = skip + 1

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

8485 scanOne c = loop 0

8586 where loop !i | i >= hlen = []

8687 | hindex i == c = i : loop (i+1)

Data/Text/Unsafe.hs+4−2

@@ -14,6 +14,7 @@ module Data.Text.Unsafe

1414 (

1515 inlineInterleaveST

1616 , inlinePerformIO

17+ , unsafeDupablePerformIO

1718 , Iter(..)

1819 , iter

1920 , iter_

@@ -24,7 +25,7 @@ module Data.Text.Unsafe

2425 , takeWord16

2526 , dropWord16

2627 ) where

27−

28+

2829#if defined(ASSERTS)

2930import Control.Exception (assert)

3031#endif

@@ -33,6 +34,7 @@ import Data.Text.Internal (Text(..))

3334import Data.Text.Unsafe.Base (inlineInterleaveST, inlinePerformIO)

3435import Data.Text.UnsafeChar (unsafeChr)

3536import qualified Data.Text.Array as A

37+import GHC.IO (unsafeDupablePerformIO)

3638

3739-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'

3840-- omits the check for the empty case, so there is an obligation on

@@ -45,7 +47,7 @@ unsafeHead (Text arr off _len)

4547 n = A.unsafeIndex arr (off+1)

4648{-# INLINE unsafeHead #-}

4749

48−-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeHead'

50+-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'

4951-- omits the check for the empty case, so there is an obligation on

5052-- the programmer to provide a proof that the 'Text' is non-empty.

5153unsafeTail :: Text -> Text

Data/Text/Unsafe/Base.hs+1−5

@@ -15,14 +15,10 @@ module Data.Text.Unsafe.Base

1515 inlineInterleaveST

1616 , inlinePerformIO

1717 ) where

18−

18+

1919import GHC.ST (ST(..))

2020#if defined(__GLASGOW_HASKELL__)

21−# if __GLASGOW_HASKELL__ >= 611

2221import GHC.IO (IO(IO))

23−# else

24−import GHC.IOBase (IO(IO))

25−# endif

2622import GHC.Base (realWorld#)

2723#endif

2824

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)

99import System.FilePath ((</>))

1010import System.IO (IOMode (WriteMode), openFile, hSetEncoding, utf8)

1111

12−import qualified Data.Text.Benchmarks.Builder as Builder

13−import qualified Data.Text.Benchmarks.DecodeUtf8 as DecodeUtf8

14−import qualified Data.Text.Benchmarks.EncodeUtf8 as EncodeUtf8

15−import qualified Data.Text.Benchmarks.Equality as Equality

16−import qualified Data.Text.Benchmarks.FileRead as FileRead

17−import qualified Data.Text.Benchmarks.FoldLines as FoldLines

18−import qualified Data.Text.Benchmarks.Pure as Pure

19−import qualified Data.Text.Benchmarks.ReadNumbers as ReadNumbers

20−import qualified Data.Text.Benchmarks.Replace as Replace

21−import qualified Data.Text.Benchmarks.Search as Search

22−import qualified Data.Text.Benchmarks.Stream as Stream

23−import qualified Data.Text.Benchmarks.WordFrequencies as WordFrequencies

12+import qualified Benchmarks.Builder as Builder

13+import qualified Benchmarks.DecodeUtf8 as DecodeUtf8

14+import qualified Benchmarks.EncodeUtf8 as EncodeUtf8

15+import qualified Benchmarks.Equality as Equality

16+import qualified Benchmarks.FileRead as FileRead

17+import qualified Benchmarks.FoldLines as FoldLines

18+import qualified Benchmarks.Pure as Pure

19+import qualified Benchmarks.ReadNumbers as ReadNumbers

20+import qualified Benchmarks.Replace as Replace

21+import qualified Benchmarks.Search as Search

22+import qualified Benchmarks.Stream as Stream

23+import qualified Benchmarks.WordFrequencies as WordFrequencies

2424

25−import qualified Data.Text.Benchmarks.Programs.BigTable as Programs.BigTable

26−import qualified Data.Text.Benchmarks.Programs.Cut as Programs.Cut

27−import qualified Data.Text.Benchmarks.Programs.Fold as Programs.Fold

28−import qualified Data.Text.Benchmarks.Programs.Sort as Programs.Sort

29−import qualified Data.Text.Benchmarks.Programs.StripTags as Programs.StripTags

30−import qualified Data.Text.Benchmarks.Programs.Throughput as Programs.Throughput

25+import qualified Benchmarks.Programs.BigTable as Programs.BigTable

26+import qualified Benchmarks.Programs.Cut as Programs.Cut

27+import qualified Benchmarks.Programs.Fold as Programs.Fold

28+import qualified Benchmarks.Programs.Sort as Programs.Sort

29+import qualified Benchmarks.Programs.StripTags as Programs.StripTags

30+import qualified Benchmarks.Programs.Throughput as Programs.Throughput

3131

3232main :: IO ()

3333main = benchmarks >>= defaultMain

@@ -49,7 +49,8 @@ benchmarks = do

4949 , Equality.benchmark (tf "japanese.txt")

5050 , FileRead.benchmark (tf "russian.txt")

5151 , 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")

5354 , ReadNumbers.benchmark (tf "numbers.txt")

5455 , Replace.benchmark (tf "russian.txt") "принимая" "своем"

5556 , Search.benchmark (tf "russian.txt") "принимая"

@@ -70,4 +71,4 @@ benchmarks = do

7071 return $ bs ++ [ps]

7172 where

7273 -- 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 @@

1414--

1515-- The latter are used for testing stream fusion.

1616--

17−module Data.Text.Benchmarks.DecodeUtf8

17+module Benchmarks.DecodeUtf8

1818 ( benchmark

1919 ) where

2020

21−import Foreign.C.Types (CInt, CSize)

21+import Foreign.C.Types

2222import Data.ByteString.Internal (ByteString(..))

2323import Foreign.Ptr (Ptr, plusPtr)

2424import Foreign.ForeignPtr (withForeignPtr)

tests/benchmarks/src/Data/Text/Benchmarks/EncodeUtf8.hs → benchmarks/haskell/Benchmarks/EncodeUtf8.hsrenamed+1−1

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

66--

77-- * UTF-8 encoding it

88--

9−module Data.Text.Benchmarks.EncodeUtf8

9+module Benchmarks.EncodeUtf8

1010 ( benchmark

1111 ) where

1212

tests/benchmarks/src/Data/Text/Benchmarks/Equality.hs → benchmarks/haskell/Benchmarks/Equality.hsrenamed+1−1

@@ -5,7 +5,7 @@

55--

66-- * Comparison of strings (Eq instance)

77--

8−module Data.Text.Benchmarks.Equality

8+module Benchmarks.Equality

99 ( benchmark

1010 ) where

1111

tests/benchmarks/src/Data/Text/Benchmarks/FileRead.hs → benchmarks/haskell/Benchmarks/FileRead.hsrenamed+1−1

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

44--

55-- * Reading a file from the disk

66--

7−module Data.Text.Benchmarks.FileRead

7+module Benchmarks.FileRead

88 ( benchmark

99 ) where

1010

tests/benchmarks/src/Data/Text/Benchmarks/FoldLines.hs → benchmarks/haskell/Benchmarks/FoldLines.hsrenamed+1−1

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

66-- * Buffered, line-based IO

77--

88{-# LANGUAGE BangPatterns #-}

9−module Data.Text.Benchmarks.FoldLines

9+module Benchmarks.FoldLines

1010 ( benchmark

1111 ) where

1212

tests/benchmarks/src/Data/Text/Benchmarks/Programs/BigTable.hs → benchmarks/haskell/Benchmarks/Programs/BigTable.hsrenamed+1−1

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

77-- * Writing to a handle

88--

99{-# LANGUAGE OverloadedStrings #-}

10−module Data.Text.Benchmarks.Programs.BigTable

10+module Benchmarks.Programs.BigTable

1111 ( benchmark

1212 ) where

1313

tests/benchmarks/src/Data/Text/Benchmarks/Programs/Cut.hs → benchmarks/haskell/Benchmarks/Programs/Cut.hsrenamed+1−1

@@ -12,7 +12,7 @@

1212--

1313-- * Writing back to a handle

1414--

15−module Data.Text.Benchmarks.Programs.Cut

15+module Benchmarks.Programs.Cut

1616 ( benchmark

1717 ) where

1818

tests/benchmarks/src/Data/Text/Benchmarks/Programs/Fold.hs → benchmarks/haskell/Benchmarks/Programs/Fold.hsrenamed+1−1

@@ -13,7 +13,7 @@

1313-- * Writing back to a handle

1414--

1515{-# LANGUAGE OverloadedStrings #-}

16−module Data.Text.Benchmarks.Programs.Fold

16+module Benchmarks.Programs.Fold

1717 ( benchmark

1818 ) where

1919

tests/benchmarks/src/Data/Text/Benchmarks/Programs/Sort.hs → benchmarks/haskell/Benchmarks/Programs/Sort.hsrenamed+1−1

@@ -13,7 +13,7 @@

1313-- * Writing back to a handle

1414--

1515{-# LANGUAGE OverloadedStrings #-}

16−module Data.Text.Benchmarks.Programs.Sort

16+module Benchmarks.Programs.Sort

1717 ( benchmark

1818 ) where

1919

tests/benchmarks/src/Data/Text/Benchmarks/Programs/StripTags.hs → benchmarks/haskell/Benchmarks/Programs/StripTags.hsrenamed+2−2

@@ -11,10 +11,10 @@

1111-- * Writing back to a handle

1212--

1313{-# OPTIONS_GHC -fspec-constr-count=5 #-}

14−module Data.Text.Benchmarks.Programs.StripTags

14+module Benchmarks.Programs.StripTags

1515 ( benchmark

1616 ) where

17−

17+

1818import Criterion (Benchmark, bgroup, bench)

1919import Data.List (mapAccumL)

2020import 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 @@

1414--

1515-- * Writing back to a handle

1616--

17−module Data.Text.Benchmarks.Programs.Throughput

17+module Benchmarks.Programs.Throughput

1818 ( benchmark

1919 ) where

2020

tests/benchmarks/src/Data/Text/Benchmarks/Pure.hs → benchmarks/haskell/Benchmarks/Pure.hsrenamed+15−9

@@ -4,9 +4,9 @@

44--

55-- * Most pure functions defined the string types

66--

7−{-# LANGUAGE BangPatterns, GADTs, MagicHash #-}

7+{-# LANGUAGE BangPatterns, CPP, GADTs, MagicHash #-}

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

9−module Data.Text.Benchmarks.Pure

9+module Benchmarks.Pure

1010 ( benchmark

1111 ) where

1212

@@ -27,8 +27,8 @@ import qualified Data.Text.Lazy as TL

2727import qualified Data.Text.Lazy.Builder as TB

2828import qualified Data.Text.Lazy.Encoding as TL

2929

30−benchmark :: FilePath -> IO Benchmark

31−benchmark fp = do

30+benchmark :: String -> FilePath -> IO Benchmark

31+benchmark kind fp = do

3232 -- Evaluate stuff before actually running the benchmark, we don't want to

3333 -- count it here.

3434

@@ -100,6 +100,10 @@ benchmark fp = do

100100 , benchBSL $ nf BL.unpack bla

101101 , benchS $ nf UTF8.toString bsa

102102 ]

103+ , bgroup "decode'"

104+ [ benchT $ nf T.decodeUtf8' bsa

105+ , benchTL $ nf TL.decodeUtf8' bla

106+ ]

103107 , bgroup "drop"

104108 [ benchT $ nf (T.drop (ta_len `div` 3)) ta

105109 , benchTL $ nf (TL.drop (tla_len `div` 3)) tla

@@ -405,11 +409,11 @@ benchmark fp = do

405409 ]

406410 ]

407411 where

408− benchS = bench "String"

409− benchT = bench "Text"

410− benchTL = bench "LazyText"

411− benchBS = bench "ByteString"

412− benchBSL = bench "LazyByteString"

412+ benchS = bench ("String+" ++ kind)

413+ benchT = bench ("Text+" ++ kind)

414+ benchTL = bench ("LazyText+" ++ kind)

415+ benchBS = bench ("ByteString+" ++ kind)

416+ benchBSL = bench ("LazyByteString+" ++ kind)

413417

414418 c = 'й'

415419 p0 = (== c)

@@ -425,11 +429,13 @@ benchmark fp = do

425429 replicat n = concat . L.replicate n

426430 short = T.pack "short"

427431

432+#if !MIN_VERSION_bytestring(0,10,0)

428433instance NFData BS.ByteString

429434

430435instance NFData BL.ByteString where

431436 rnf BL.Empty = ()

432437 rnf (BL.Chunk _ ts) = rnf ts

438+#endif

433439

434440data B where

435441 B :: NFData a => a -> B

tests/benchmarks/src/Data/Text/Benchmarks/ReadNumbers.hs → benchmarks/haskell/Benchmarks/ReadNumbers.hsrenamed+2−2

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

1616--

1717-- * Lexing/parsing of different numerical types

1818--

19−module Data.Text.Benchmarks.ReadNumbers

19+module Benchmarks.ReadNumbers

2020 ( benchmark

2121 ) where

2222

@@ -88,7 +88,7 @@ text reader = foldl' go 1000000

8888 where

8989 go z t = case reader t of Left _ -> z

9090 Right (n, _) -> min n z

91−

91+

9292byteString :: (Ord a, Num a) => (t -> Maybe (a,t)) -> [t] -> a

9393byteString reader = foldl' go 1000000

9494 where

tests/benchmarks/src/Data/Text/Benchmarks/Replace.hs → benchmarks/haskell/Benchmarks/Replace.hsrenamed+1−1

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

44--

55-- * Search and replace of a pattern in a text

66--

7−module Data.Text.Benchmarks.Replace

7+module Benchmarks.Replace

88 ( benchmark

99 ) where

1010

tests/benchmarks/src/Data/Text/Benchmarks/Search.hs → benchmarks/haskell/Benchmarks/Search.hsrenamed+1−1

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

44--

55-- * Searching all occurences of a pattern using library routines

66--

7−module Data.Text.Benchmarks.Search

7+module Benchmarks.Search

88 ( benchmark

99 ) where

1010

tests/benchmarks/src/Data/Text/Benchmarks/Stream.hs → benchmarks/haskell/Benchmarks/Stream.hsrenamed+1−2

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

77--

88{-# LANGUAGE BangPatterns #-}

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

10−module Data.Text.Benchmarks.Stream

10+module Benchmarks.Stream

1111 ( benchmark

1212 ) where

1313

@@ -86,7 +86,6 @@ benchmark fp = do

8686 ]

8787

8888 -- Encoding.Fusion.Common

89− , bench "restreamUtf8" $ nf F.restreamUtf8 s

9089 , bench "restreamUtf16LE" $ nf F.restreamUtf16LE s

9190 , bench "restreamUtf16BE" $ nf F.restreamUtf16BE s

9291 , 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 @@

88--

99-- * Comparing: Eq/Ord instances

1010--

11−module Data.Text.Benchmarks.WordFrequencies

11+module Benchmarks.WordFrequencies

1212 ( benchmark

1313 ) where

1414

benchmarks/haskell/Multilang.hsnew file+32

@@ -0,0 +1,32 @@

1+{-# LANGUAGE BangPatterns, OverloadedStrings, RankNTypes #-}

3+module Main (

4+ main

5+ ) where

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 #-}

3+module Timer (timer) where

5+import Control.Exception (evaluate)

6+import Data.Time.Clock.POSIX (getPOSIXTime)

7+import GHC.Float (FFFormat(..), formatRealFloat)

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

3+import math

4+import sys

5+import time

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,

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

99#include <string.h>

1010#include <stdint.h>

1111#include <stdio.h>

12+#include "text_cbits.h"

1213

1314void _hs_text_memcpy(void *dest, size_t doff, const void *src, size_t soff,

1415 size_t n)

@@ -47,7 +48,7 @@ static const uint8_t utf8d[] = {

4748 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12,

4849 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12,

4950 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,

5152};

5253

5354static inline uint32_t

@@ -61,24 +62,83 @@ decode(uint32_t *state, uint32_t* codep, uint32_t byte) {

6162 return *state = utf8d[256 + *state + type];

6263}

6364

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+

64103/*

65104 * A best-effort decoder. Runs until it hits either end of input or

66105 * the start of an invalid byte sequence.

67106 *

68− * At exit, updates *destoff with the next offset to write to, and

69− * returns the next source offset to read from.

107+ * At exit, we update *destoff with the next offset to write to, *src

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+ *

70129 */

71−uint8_t const *

72−_hs_text_decode_utf8(uint16_t *dest, size_t *destoff,

73− const uint8_t const *src, const uint8_t const *srcend)

130+const uint8_t *

131+_hs_text_decode_utf8_state(uint16_t *const dest, size_t *destoff,

132+ const uint8_t **const src,

133+ const uint8_t *const srcend,

134+ uint32_t *codepoint0, uint32_t *state0)

74135{

75136 uint16_t *d = dest + *destoff;

76− const uint8_t const *s = src;

77− uint32_t state = UTF8_ACCEPT;

137+ const uint8_t *s = *src, *last = *src;

138+ uint32_t state = *state0;

139+ uint32_t codepoint = *codepoint0;

78140

79141 while (s < srcend) {

80− uint32_t codepoint;

81−

82142#if defined(__i386__) || defined(__x86_64__)

83143 /*

84144 * 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,

106166 *d++ = (uint16_t) ((codepoint >> 16) & 0xff);

107167 *d++ = (uint16_t) ((codepoint >> 24) & 0xff);

108168 }

169+ last = s;

109170 }

110171#endif

111172

@@ -121,13 +182,29 @@ _hs_text_decode_utf8(uint16_t *dest, size_t *destoff,

121182 *d++ = (uint16_t) (0xD7C0 + (codepoint >> 10));

122183 *d++ = (uint16_t) (0xDC00 + (codepoint & 0x3FF));

123184 }

185+ last = s;

124186 }

125187

126− /* Error recovery - if we're not in a valid finishing state, back up. */

127− if (state != UTF8_ACCEPT)

188+ /* Invalid encoding, back up to the errant character */

189+ if (state == UTF8_REJECT)

128190 s -= 1;

129191

130192 *destoff = d - dest;

193+ *codepoint0 = codepoint;

194+ *state0 = state;

195+ *src = last;

131196

132197 return s;

133198}

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+ */

5+#ifndef _text_cbits_h

6+#define _text_cbits_h

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)

2626instance Applicative (GenParser s a) where

2727 pure = return

2828 (<*>) = ap

29−

29+

3030instance Alternative (GenParser s a) where

3131 empty = mzero

3232 (<|>) = mplus

tests-and-benchmarks.markdownnew file+63

@@ -0,0 +1,63 @@

1+Tests and benchmarks

2+====================

4+Prerequisites

5+-------------

7+To run the tests and benchmarks, you will need the test data, which

8+you can clone from one of the following locations:

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

13coverage: build coverage/hpc_index.html

3−build:

5+build: text-test-data

46 cabal configure -fhpc

57 cabal build

9+text-test-data:

10+ hg clone https://bitbucket.org/bos/text-test-data

11+ $(MAKE) -C text-test-data

12+

713coverage/text-tests.tix:

814 -mkdir -p coverage

9− ./dist/build/text-tests/text-tests

15+ ./dist/build/text-tests/text-tests -a $(count)

1016 mv text-tests.tix $@

1117

1218coverage/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

77import Test.Framework (defaultMain)

9−import qualified Data.Text.Tests.Properties as Properties

10−import qualified Data.Text.Tests.Regressions as Regressions

9+import qualified Tests.Properties as Properties

10+import qualified Tests.Regressions as Regressions

1111

1212main :: IO ()

1313main = 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 @@

11-- | General quicktest properties for the text library

22--

3−{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,

4− ScopedTypeVariables, TypeSynonymInstances, CPP #-}

3+{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, OverloadedStrings,

4+ ScopedTypeVariables, TypeSynonymInstances #-}

55{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}

66{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

7−module Data.Text.Tests.Properties

7+module Tests.Properties

88 (

99 tests

1010 ) where

@@ -16,6 +16,7 @@ import Text.Show.Functions ()

1616import Control.Arrow ((***), second)

1717import Control.Exception (catch)

1818import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)

19+import Data.Int (Int8, Int16, Int32, Int64)

1920import Data.Monoid (Monoid(..))

2021import Data.String (fromString)

2122import Data.Text.Encoding.Error

@@ -24,13 +25,13 @@ import Data.Text.Fusion.Size

2425import Data.Text.Lazy.Read as TL

2526import Data.Text.Read as T

2627import Data.Text.Search (indices)

27−import Data.Word (Word8, Word16, Word32)

28+import Data.Word (Word, Word8, Word16, Word32, Word64)

2829import Numeric (showHex)

29−import Prelude hiding (catch, replicate)

3030import Test.Framework (Test, testGroup)

3131import Test.Framework.Providers.QuickCheck2 (testProperty)

3232import qualified Data.Bits as Bits (shiftL, shiftR)

3333import qualified Data.ByteString as B

34+import qualified Data.ByteString.Lazy as BL

3435import qualified Data.List as L

3536import qualified Data.Text as T

3637import qualified Data.Text.Encoding as E

@@ -39,6 +40,8 @@ import qualified Data.Text.Fusion.Common as S

3940import qualified Data.Text.IO as T

4041import qualified Data.Text.Lazy as TL

4142import 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

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

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

4447import qualified Data.Text.Lazy.IO as TL

@@ -46,9 +49,15 @@ import qualified Data.Text.Lazy.Search as S (indices)

4649import qualified Data.Text.UnsafeShift as U

4750import qualified System.IO as IO

4851

49−import Data.Text.Tests.QuickCheckUtils

50−import Data.Text.Tests.Utils

51−import qualified Data.Text.Tests.SlowFunctions as Slow

52+import Tests.QuickCheckUtils

53+import Tests.Utils

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

5261

5362t_pack_unpack = (T.unpack . T.pack) `eq` id

5463tl_pack_unpack = (TL.unpack . TL.pack) `eq` id

@@ -62,10 +71,20 @@ tl_unstreamChunks x = f 11 x == f 1000 x

6271tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id

6372tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id

6473

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+

6580t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a

6681 where a = T.map (\c -> chr (ord c `mod` 128)) t

6782tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a

6883 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

6988t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id

7089t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)

7190tl_utf8 = forAll genUnicode $ (EL.decodeUtf8 . EL.encodeUtf8) `eq` id

@@ -79,6 +98,18 @@ tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id

7998t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id

8099tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id

81100

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+

82113-- This is a poor attempt to ensure that the error handling paths on

83114-- decode are exercised in some way. Proper testing would be rather

84115-- more involved.

@@ -610,17 +641,55 @@ shiftR_Word32 = shiftR :: Word32 -> Property

610641

611642-- Builder.

612643

613−t_builderSingleton = id `eqP`

614− (unpackS . TB.toLazyText . mconcat . map TB.singleton)

615−t_builderFromText = L.concat `eq` (unpackS . TB.toLazyText . mconcat .

644+tb_singleton = id `eqP`

645+ (unpackS . TB.toLazyText . mconcat . map TB.singleton)

646+tb_fromText = L.concat `eq` (unpackS . TB.toLazyText . mconcat .

616647 map (TB.fromText . packS))

617−t_builderAssociative s1 s2 s3 =

648+tb_associative s1 s2 s3 =

618649 TB.toLazyText (b1 `mappend` (b2 `mappend` b3)) ==

619650 TB.toLazyText ((b1 `mappend` b2) `mappend` b3)

620651 where b1 = TB.fromText (packS s1)

621652 b2 = TB.fromText (packS s2)

622653 b3 = TB.fromText (packS s3)

623654

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+

624693-- Reading.

625694

626695t_decimal (n::Int) s =

@@ -681,6 +750,8 @@ t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) == t

681750 where n = small m

682751t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)

683752

753+t_copy t = T.copy t == t

754+

684755-- Regression tests.

685756s_filter_eq s = S.filter p t == S.streamList (filter p s)

686757 where p = (/= S.last t)

@@ -691,7 +762,7 @@ s_filter_eq s = S.filter p t == S.streamList (filter p s)

691762-- themselves.

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

693764shorten 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)

695766 | otherwise = t

696767

697768tests :: Test

@@ -713,8 +784,11 @@ tests =

713784 testGroup "transcoding" [

714785 testProperty "t_ascii" t_ascii,

715786 testProperty "tl_ascii" tl_ascii,

787+ testProperty "t_latin1" t_latin1,

788+ testProperty "tl_latin1" tl_latin1,

716789 testProperty "t_utf8" t_utf8,

717790 testProperty "t_utf8'" t_utf8',

791+ testProperty "t_utf8_incr" t_utf8_incr,

718792 testProperty "tl_utf8" tl_utf8,

719793 testProperty "tl_utf8'" tl_utf8',

720794 testProperty "t_utf16LE" t_utf16LE,

@@ -1080,9 +1154,39 @@ tests =

10801154 ],

10811155

10821156 testGroup "builder" [

1083− testProperty "t_builderSingleton" t_builderSingleton,

1084− testProperty "t_builderFromText" t_builderFromText,

1085− testProperty "t_builderAssociative" t_builderAssociative

1157+ testProperty "tb_associative" tb_associative,

1158+ testGroup "decimal" [

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

10861190 ],

10871191

10881192 testGroup "read" [

@@ -1113,6 +1217,7 @@ tests =

11131217 testProperty "t_dropWord16" t_dropWord16,

11141218 testProperty "t_takeWord16" t_takeWord16,

11151219 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

11171222 ]

11181223 ]

tests/tests/src/Data/Text/Tests/QuickCheckUtils.hs → tests/Tests/QuickCheckUtils.hsrenamed+9−9

@@ -1,10 +1,10 @@

11-- | This module provides quickcheck utilities, e.g. arbitrary and show

22-- 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.

44--

55{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-}

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

7−module Data.Text.Tests.QuickCheckUtils

7+module Tests.QuickCheckUtils

88 (

99 genUnicode

1010 , unsquare

@@ -24,7 +24,7 @@ module Data.Text.Tests.QuickCheckUtils

2424 , eqP

2525

2626 , Encoding (..)

27−

27+

2828 , write_read

2929 ) where

3030

@@ -50,7 +50,7 @@ import qualified Data.Text.Lazy.Fusion as TLF

5050import qualified Data.Text.Lazy.Internal as TL

5151import qualified System.IO as IO

5252

53−import Data.Text.Tests.Utils

53+import Tests.Utils

5454

5555instance Random I16 where

5656 randomR = integralRandomR

@@ -67,7 +67,7 @@ genUnicode = fmap fromString string where

6767 string = sized $ \n ->

6868 do k <- choose (0,n)

6969 sequence [ char | _ <- [1..k] ]

70−

70+

7171 excluding :: [a -> Bool] -> Gen a -> Gen a

7272 excluding bad gen = loop

7373 where

@@ -76,14 +76,14 @@ genUnicode = fmap fromString string where

7676 if or (map ($ x) bad)

7777 then loop

7878 else return x

79−

79+

8080 reserved = [lowSurrogate, highSurrogate, noncharacter]

8181 lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF

8282 highSurrogate c = c >= 0xD800 && c <= 0xDBFF

8383 noncharacter c = masked == 0xFFFE || masked == 0xFFFF

8484 where

85− masked = c .&. 0xFFFF

86−

85+ masked = c .&. 0xFFFF

86+

8787 ascii = choose (0,0x7F)

8888 plane0 = choose (0xF0, 0xFFFF)

8989 plane1 = oneof [ choose (0x10000, 0x10FFF)

@@ -109,7 +109,7 @@ genUnicode = fmap fromString string where

109109 ]

110110 plane14 = choose (0xE0000, 0xE0FFF)

111111 planes = [ascii, plane0, plane1, plane2, plane14]

112−

112+

113113 char = chr `fmap` excluding reserved (oneof planes)

114114

115115-- 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 @@

11-- | Regression tests for specific bugs.

22--

33{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}

4−module Data.Text.Tests.Regressions

4+module Tests.Regressions

55 (

66 tests

77 ) where

99import Control.Exception (SomeException, handle)

1010import System.IO

11−import Test.HUnit (assertFailure)

11+import Test.HUnit (assertBool, assertEqual, assertFailure)

1212import qualified Data.ByteString as B

13+import Data.ByteString.Char8 ()

1314import qualified Data.ByteString.Lazy as LB

1415import qualified Data.Text as T

16+import qualified Data.Text.Encoding as TE

1517import qualified Data.Text.IO as T

1618import qualified Data.Text.Lazy as LT

1719import qualified Data.Text.Lazy.Encoding as LE

20+import qualified Data.Text.Unsafe as T

1821import qualified Test.Framework as F

1922import qualified Test.Framework.Providers.HUnit as F

2023

21−import Data.Text.Tests.Utils (withTempFile)

24+import Tests.Utils (withTempFile)

2225

2326-- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring

2427-- caused either a segfault or attempt to allocate a negative number

@@ -49,9 +52,31 @@ replicate_crash = handle (\(_::SomeException) -> return ()) $

4952 power | maxBound == (2147483647::Int) = 28

5053 | otherwise = 60 :: Int

5154

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+

5275tests :: F.Test

5376tests = F.testGroup "Regressions"

5477 [ F.testCase "hGetContents_crash" hGetContents_crash

5578 , F.testCase "lazy_encode_crash" lazy_encode_crash

79+ , F.testCase "mapAccumL_resize" mapAccumL_resize

5680 , F.testCase "replicate_crash" replicate_crash

81+ , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe

5782 ]

tests/tests/src/Data/Text/Tests/SlowFunctions.hs → tests/Tests/SlowFunctions.hsrenamed+1−1

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

11{-# LANGUAGE BangPatterns #-}

2−module Data.Text.Tests.SlowFunctions

2+module Tests.SlowFunctions

33 (

44 indices

55 , splitOn

tests/tests/src/Data/Text/Tests/Utils.hs → tests/Tests/Utils.hsrenamed+1−1

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

11-- | Miscellaneous testing utilities

22--

33{-# LANGUAGE ScopedTypeVariables #-}

4−module Data.Text.Tests.Utils

4+module Tests.Utils

55 (

66 (=^=)

77 , 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

44description: Functional tests for the text package

55homepage: https://bitbucket.org/bos/text

66license: BSD3

7−license-file: ../../LICENSE

7+license-file: ../LICENSE

88author: Jasper Van der Jeugt <jaspervdj@gmail.com>,

99 Bryan O'Sullivan <bos@serpentine.com>,

1010 Tom Harper <rtomharper@googlemail.com>,

@@ -20,8 +20,7 @@ flag hpc

2020 default: False

2121

2222executable text-tests

23− hs-source-dirs: src

24− main-is: Data/Text/Tests.hs

23+ main-is: Tests.hs

2524

2625 ghc-options:

2726 -Wall -threaded -O0 -rtsopts

@@ -35,21 +34,20 @@ executable text-tests

3534 -DHAVE_DEEPSEQ

3635

3736 build-depends:

38− text-tests,

39− base >= 4 && < 5,

40− bytestring >= 0.9 && < 0.10,

41− deepseq >= 1.1,

42− directory >= 1.1 && < 1.2,

43− random >= 1.0 && < 1.1,

44− QuickCheck >= 2.4 && < 2.5,

45− HUnit >= 1.2 && < 1.3,

46− test-framework >= 0.4 && < 0.5,

47− test-framework-quickcheck2 >= 0.2 && < 0.3,

48− test-framework-hunit >= 0.2 && < 0.3

37+ HUnit >= 1.2,

38+ QuickCheck >= 2.4,

39+ base == 4.*,

40+ bytestring,

41+ deepseq,

42+ directory,

43+ random,

44+ test-framework >= 0.4,

45+ test-framework-hunit >= 0.2,

46+ test-framework-quickcheck2 >= 0.2,

47+ text-tests

4948

5049executable text-tests-stdio

51− hs-source-dirs: src

52− main-is: Data/Text/Tests/IO.hs

50+ main-is: Tests/IO.hs

5351

5452 ghc-options:

5553 -Wall -threaded -rtsopts

@@ -64,41 +62,45 @@ executable text-tests-stdio

6462 base >= 4 && < 5

6563

6664library

67− hs-source-dirs: ../..

68− c-sources: ../../cbits/cbits.c

65+ hs-source-dirs: ..

66+ c-sources: ../cbits/cbits.c

67+ include-dirs: ../include

6968 exposed-modules:

7069 Data.Text

7170 Data.Text.Array

7271 Data.Text.Encoding

7372 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

8673 Data.Text.Encoding.Fusion

8774 Data.Text.Encoding.Fusion.Common

8875 Data.Text.Encoding.Utf16

8976 Data.Text.Encoding.Utf32

9077 Data.Text.Encoding.Utf8

78+ Data.Text.Foreign

9179 Data.Text.Fusion

9280 Data.Text.Fusion.CaseMapping

9381 Data.Text.Fusion.Common

9482 Data.Text.Fusion.Internal

9583 Data.Text.Fusion.Size

84+ Data.Text.IO

9685 Data.Text.IO.Internal

86+ Data.Text.Internal

87+ Data.Text.Lazy

88+ Data.Text.Lazy.Builder

9789 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

9894 Data.Text.Lazy.Builder.RealFloat.Functions

95+ Data.Text.Lazy.Encoding

9996 Data.Text.Lazy.Encoding.Fusion

10097 Data.Text.Lazy.Fusion

98+ Data.Text.Lazy.IO

99+ Data.Text.Lazy.Internal

100+ Data.Text.Lazy.Read

101101 Data.Text.Lazy.Search

102+ Data.Text.Private

103+ Data.Text.Read

102104 Data.Text.Search

103105 Data.Text.Unsafe

104106 Data.Text.Unsafe.Base

@@ -117,8 +119,8 @@ library

117119

118120 build-depends:

119121 array,

120− base >= 4 && < 5,

121− bytestring >= 0.9 && < 1.0,

122− deepseq >= 1.1,

123− integer-gmp >= 0.2 && < 0.3,

124− ghc-prim >= 0.2 && < 0.3

122+ base == 4.*,

123+ bytestring,

124+ deepseq,

125+ ghc-prim,

126+ integer-gmp

text.cabal+69−50

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

11name: text

2−version: 0.11.1.12

2+version: 0.11.4.0

33homepage: https://github.com/bos/text

44bug-reports: https://github.com/bos/text/issues

55synopsis: An efficient packed Unicode text type.

6−description:

6+description:

77 .

88 An efficient packed, immutable Unicode text type (both strict and

99 lazy), with a powerful loop fusion optimization framework.

@@ -31,6 +31,15 @@ description:

3131 the @text-icu@ package:

3232 <http://hackage.haskell.org/package/text-icu>

3333 .

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+ .

3443license: BSD3

3544license-file: LICENSE

3645author: Bryan O'Sullivan <bos@serpentine.com>

@@ -40,31 +49,36 @@ category: Data, Text

4049build-type: Simple

4150cabal-version: >= 1.8

4251extra-source-files:

43− README.markdown

4452 -- scripts/CaseFolding.txt

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

4662 scripts/*.hs

47− tests/README.markdown

48− tests/benchmarks/Setup.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

56− tests/tests/Makefile

57− tests/tests/scripts/*.sh

58− tests/tests/src/Data/Text/*.hs

59− tests/tests/src/Data/Text/Tests/*.hs

60− tests/tests/text-tests.cabal

63+ tests-and-benchmarks.markdown

64+ tests/*.hs

65+ tests/.ghci

66+ tests/Makefile

67+ tests/Tests/*.hs

68+ tests/scripts/*.sh

69+ tests/text-tests.cabal

6170

6271flag developer

6372 description: operate in developer mode

6473 default: False

6574

75+flag integer-simple

76+ description: Use the simple integer library instead of GMP

77+ default: False

78+

6679library

67− c-sources: cbits/cbits.c

80+ c-sources: cbits/cbits.c

81+ include-dirs: include

6882

6983 exposed-modules:

7084 Data.Text

@@ -83,6 +97,7 @@ library

8397 Data.Text.Lazy.Internal

8498 Data.Text.Lazy.Read

8599 Data.Text.Read

100+ Data.Text.Unsafe

86101 other-modules:

87102 Data.Text.Encoding.Fusion

88103 Data.Text.Encoding.Fusion.Common

@@ -96,51 +111,46 @@ library

96111 Data.Text.Fusion.Size

97112 Data.Text.IO.Internal

98113 Data.Text.Lazy.Builder.Functions

114+ Data.Text.Lazy.Builder.Int.Digits

115+ Data.Text.Lazy.Builder.Internal

99116 Data.Text.Lazy.Builder.RealFloat.Functions

100117 Data.Text.Lazy.Encoding.Fusion

101118 Data.Text.Lazy.Fusion

102119 Data.Text.Lazy.Search

103120 Data.Text.Private

104121 Data.Text.Search

105− Data.Text.Unsafe

106122 Data.Text.Unsafe.Base

107123 Data.Text.UnsafeChar

108124 Data.Text.UnsafeShift

109125 Data.Text.Util

110126

111127 build-depends:

112− array,

113− base < 5,

114− bytestring >= 0.9 && < 1.0

115− if impl(ghc >= 6.10)

116− build-depends:

117− ghc-prim, base >= 4, deepseq >= 1.1.0.0

118− cpp-options: -DHAVE_DEEPSEQ

119− else

120− build-depends: extensible-exceptions

121− extensions: PatternSignatures

128+ array >= 0.3,

129+ base >= 4.2 && < 5,

130+ bytestring >= 0.9,

131+ deepseq >= 1.1.0.0,

132+ ghc-prim >= 0.2

122133

123− ghc-options: -Wall -funbox-strict-fields -O2

124− if impl(ghc >= 6.8)

125− ghc-options: -fwarn-tabs

134+ cpp-options: -DHAVE_DEEPSEQ

135+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2

126136 if flag(developer)

127137 ghc-prof-options: -auto-all

128138 ghc-options: -Werror

129139 cpp-options: -DASSERTS

130140

131− if impl(ghc >= 6.11)

132− cpp-options: -DINTEGER_GMP

133− build-depends: integer-gmp >= 0.2 && < 0.5

134−

135− if impl(ghc >= 6.9) && impl(ghc < 6.11)

141+ if flag(integer-simple)

142+ cpp-options: -DINTEGER_SIMPLE

143+ build-depends: integer-simple >= 0.1 && < 0.5

144+ else

136145 cpp-options: -DINTEGER_GMP

137− build-depends: integer >= 0.1 && < 0.2

146+ build-depends: integer-gmp >= 0.2

138147

139148test-suite tests

140149 type: exitcode-stdio-1.0

141− hs-source-dirs: . tests/tests/src

142− main-is: Data/Text/Tests.hs

150+ hs-source-dirs: tests .

151+ main-is: Tests.hs

143152 c-sources: cbits/cbits.c

153+ include-dirs: include

144154

145155 ghc-options:

146156 -Wall -threaded -O0 -rtsopts

@@ -149,16 +159,25 @@ test-suite tests

149159 -DASSERTS -DHAVE_DEEPSEQ

150160

151161 build-depends:

152− base >= 4 && < 5,

153− bytestring >= 0.9 && < 0.10,

154− deepseq >= 1.1,

155− directory >= 1.0 && < 1.2,

156− random >= 1.0 && < 1.1,

157− QuickCheck >= 2.4 && < 2.5,

158− HUnit >= 1.2 && < 1.3,

159− test-framework >= 0.4 && < 0.5,

160− test-framework-quickcheck2 >= 0.2 && < 0.3,

161− test-framework-hunit >= 0.2 && < 0.3

162+ HUnit >= 1.2,

163+ QuickCheck >= 2.4,

164+ array,

165+ base,

166+ bytestring,

167+ deepseq,

168+ directory,

169+ ghc-prim,

170+ random,

171+ test-framework >= 0.4,

172+ test-framework-hunit >= 0.2,

173+ test-framework-quickcheck2 >= 0.2

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

162181

163182source-repository head

164183 type: git