049278d...master · text

git.iko.soy/text

117 files changed+5245−2326

since splitsnapshots

unifiedsplit

.gitignorenew file+3

@@ -0,0 +1,3 @@

1+dist

2+cabal-dev

3+cabal.sandbox.config

.hgignore+9−3

@@ -1,8 +1,14 @@

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

13+scripts/CaseFolding.txt

14+scripts/SpecialCasing.txt

.hgtags+30

@@ -34,3 +34,33 @@ b75d3041d275e8e76b26605b0d426a572ddf1249 0.11.1.3

34349f47a2cfc9e51fd622d7553f08ad2ac1faad0438 0.11.1.10

35359f47a2cfc9e51fd622d7553f08ad2ac1faad0438 0.11.1.10

3636407937739e9e764f1ae0f1f9ca454c42dca38772 0.11.1.10

37+8b981edd27befa4c2dd334fcb7db22ac67e22b67 0.11.1.11

38+204da16b5098531bdf858c388e2620238ef2aa5e 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

45+31f57612fd425d1bb56352ce6b79e41ce6699a45 1.0.0.0

46+7cba97c86467c1881dfced68613891f3c65561b0 1.0.0.1

47+62674a9bbc83145d1d7be28a05d456ab6bb5ff89 1.1.0.0

48+68a32d80c0829da164d1e6b3acedcc3efeda0957 1.1.0.1

49+6d863daafbf0e1289ec0a0eb9b4be2a0a9cb8d3d 1.1.1.0

50+fb7299f22449750c653ac64dee4bd63c13ea6e4c 1.1.1.1

51+eb170cb533b63534d166b5fd5344b36676adf140 1.1.1.2

52+e749e05f715d02445803f653cd3d97d5395d7c6f 1.1.1.3

53+b0dff8ca1142595bab489a768ca62e6a6805aac4 1.1.1.4

54+f8a60279237c1c28e094868740d9188dd94fcc9e 1.2.0.0

55+6231451979b2d33e28038b75f2dab19c9731f5c3 1.2.0.1

56+99a3503b4ad001fc1894e90286e96d7dea1e9195 1.2.0.2

57+47f138edf15576b9adaeed64784e30811099f202 1.2.0.3

58+0b064b0c69106bbcd13cb0099e72ae5fa2347bf0 1.2.0.4

59+8bbb3e222a0037035d893f731b0a23be449f7346 1.2.0.5

60+18c7f8e19872762b7e28ee1871e72f70ea54e3cd 1.2.0.6

61+42f751b87b4a187db93f595a8166d51746ff57d4 1.2.1.0

62+78227a84740b70dcd4cf7a65f3bcf603d87e48e2 1.2.1.1

63+40f268e6735749ef36f487e1d928eaa957bb431d 1.2.1.2

64+631fd055e27fa10983e17e9ad36d1b285b85c661 1.2.1.3

65+8221a68ed5ec37028357df9c6c25f52320e54ad9 1.2.2.0

66+ce1c5ac65eb9f5580114b4e380092b05a485e95d 1.2.2.1

Data/Text.hs+370−176

@@ -1,15 +1,20 @@

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

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

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

3+#if __GLASGOW_HASKELL__ >= 702

4+{-# LANGUAGE Trustworthy #-}

5+#endif

6+#if __GLASGOW_HASKELL__ >= 708

7+{-# LANGUAGE TypeFamilies #-}

8+#endif

410-- |

511-- Module : Data.Text

915--

1016-- License : BSD-style

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

12−-- duncan@haskell.org

17+-- Maintainer : bos@serpentine.com

1318-- Stability : experimental

1419-- Portability : GHC

1520--

@@ -27,8 +32,8 @@

2732--

2833-- To use an extended and very rich family of functions for working

2934-- with Unicode text (including normalization, regular expressions,

30−-- non-standard encodings, text breaking, and locales), see the

31−-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>

35+-- non-standard encodings, text breaking, and locales), see

36+-- <http://hackage.haskell.org/package/text-icu the text-icu package >.

3237

3338module Data.Text

3439 (

@@ -76,6 +81,7 @@ module Data.Text

7681 , toCaseFold

7782 , toLower

7883 , toUpper

84+ , toTitle

7985

8086 -- ** Justification

8187 , justifyLeft

@@ -119,8 +125,11 @@ module Data.Text

119125

120126 -- ** Breaking strings

121127 , take

128+ , takeEnd

122129 , drop

130+ , dropEnd

123131 , takeWhile

132+ , takeWhileEnd

124133 , dropWhile

125134 , dropWhileEnd

126135 , dropAround

@@ -167,92 +176,110 @@ module Data.Text

167176 , partition

168177

169178 -- , findSubstring

170−

179+

171180 -- * Indexing

172181 -- $index

173182 , index

174183 , findIndex

175184 , count

176185

177− -- * Zipping and unzipping

186+ -- * Zipping

178187 , zip

179188 , zipWith

180189

181190 -- -* Ordered text

182191 -- , sort

192+

193+ -- * Low level operations

194+ , copy

195+ , unpackCString#

183196 ) where

184197

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

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

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

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

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

200+ Read(..),

201+ (&&), (||), (+), (-), (.), ($), ($!), (>>),

202+ not, return, otherwise, quot)

190203#if defined(HAVE_DEEPSEQ)

191−import Control.DeepSeq (NFData)

204+import Control.DeepSeq (NFData(rnf))

192205#endif

193206#if defined(ASSERTS)

194207import Control.Exception (assert)

195208#endif

196209import Data.Char (isSpace)

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

198−#if __GLASGOW_HASKELL__ >= 612

199−import Data.Data (mkNoRepType)

200−#else

201−import Data.Data (mkNorepType)

202−#endif

210+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,

211+ Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))

203212import Control.Monad (foldM)

213+import Control.Monad.ST (ST)

204214import qualified Data.Text.Array as A

205215import qualified Data.List as L

216+import Data.Binary (Binary(get, put))

206217import Data.Monoid (Monoid(..))

218+#if MIN_VERSION_base(4,9,0)

219+import Data.Semigroup (Semigroup(..))

220+#endif

207221import Data.String (IsString(..))

208−import qualified Data.Text.Fusion as S

209−import qualified Data.Text.Fusion.Common as S

210−import Data.Text.Fusion (stream, reverseStream, unstream)

211−import Data.Text.Internal (Text(..), empty, firstf, safe, text, textP)

222+import qualified Data.Text.Internal.Fusion as S

223+import qualified Data.Text.Internal.Fusion.Common as S

224+import Data.Text.Encoding (decodeUtf8', encodeUtf8)

225+import Data.Text.Internal.Fusion (stream, reverseStream, unstream)

226+import Data.Text.Internal.Private (span_)

227+import Data.Text.Internal (Text(..), empty, firstf, mul, safe, text)

228+import Data.Text.Show (singleton, unpack, unpackCString#)

212229import qualified Prelude as P

213230import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,

214− unsafeHead, unsafeTail)

215−import Data.Text.UnsafeChar (unsafeChr)

216−import qualified Data.Text.Util as U

217−import qualified Data.Text.Encoding.Utf16 as U16

218−import Data.Text.Search (indices)

231+ reverseIter_, unsafeHead, unsafeTail)

232+import Data.Text.Internal.Unsafe.Char (unsafeChr)

233+import qualified Data.Text.Internal.Functions as F

234+import qualified Data.Text.Internal.Encoding.Utf16 as U16

235+import Data.Text.Internal.Search (indices)

219236#if defined(__HADDOCK__)

220237import Data.ByteString (ByteString)

221238import qualified Data.Text.Lazy as L

222239import Data.Int (Int64)

223240#endif

241+import GHC.Base (eqInt, neInt, gtInt, geInt, ltInt, leInt)

242+#if __GLASGOW_HASKELL__ >= 708

243+import qualified GHC.Exts as Exts

244+#endif

245+#if MIN_VERSION_base(4,7,0)

246+import Text.Printf (PrintfArg, formatArg, formatString)

247+#endif

224248

225249-- $strict

226250--

227251-- This package provides both strict and lazy 'Text' types. The

228−-- strict type is provided by the 'Data.Text' package, while the lazy

229−-- type is provided by the 'Data.Text.Lazy' package. Internally, the

252+-- strict type is provided by the "Data.Text" module, while the lazy

253+-- type is provided by the "Data.Text.Lazy" module. Internally, the

230254-- lazy @Text@ type consists of a list of strict chunks.

231255--

232256-- The strict 'Text' type requires that an entire string fit into

233−-- memory at once. The lazy @Text@ type is capable of streaming

234−-- strings that are larger than memory using a small memory footprint.

235−-- In many cases, the overhead of chunked streaming makes the lazy

236−-- @Text@ type slower than its strict counterpart, but this is not

237−-- always the case. Sometimes, the time complexity of a function in

238−-- one module may be different from the other, due to their differing

239−-- internal structures.

257+-- memory at once. The lazy 'Data.Text.Lazy.Text' type is capable of

258+-- streaming strings that are larger than memory using a small memory

259+-- footprint. In many cases, the overhead of chunked streaming makes

260+-- the lazy 'Data.Text.Lazy.Text' type slower than its strict

261+-- counterpart, but this is not always the case. Sometimes, the time

262+-- complexity of a function in one module may be different from the

263+-- other, due to their differing internal structures.

240264--

241265-- Each module provides an almost identical API, with the main

242266-- difference being that the strict module uses 'Int' values for

243−-- lengths and counts, while the lazy module uses 'Int64' lengths.

267+-- lengths and counts, while the lazy module uses 'Data.Int.Int64'

268+-- lengths.

244269

245270-- $replacement

246271--

247272-- A 'Text' value is a sequence of Unicode scalar values, as defined

248−-- in §3.9, definition D76 of the Unicode 5.2 standard:

249−-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35>. As

250−-- such, a 'Text' cannot contain values in the range U+D800 to U+DFFF

251−-- inclusive. Haskell implementations admit all Unicode code points

252−-- (§3.4, definition D10) as 'Char' values, including code points

253−-- from this invalid range. This means that there are some 'Char'

254−-- values that are not valid Unicode scalar values, and the functions

255−-- in this module must handle those cases.

273+-- in

274+-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35 §3.9, definition D76 of the Unicode 5.2 standard >.

275+-- As such, a 'Text' cannot contain values in the range U+D800 to

276+-- U+DFFF inclusive. Haskell implementations admit all Unicode code

277+-- points

278+-- (<http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=13 §3.4, definition D10 >)

279+-- as 'Char' values, including code points from this invalid range.

280+-- This means that there are some 'Char' values that are not valid

281+-- Unicode scalar values, and the functions in this module must handle

282+-- those cases.

256283--

257284-- Within this module, many functions construct a 'Text' from one or

258285-- more 'Char' values. Those functions will substitute 'Char' values

@@ -266,8 +293,8 @@ import Data.Int (Int64)

266293-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate

267294-- code points, and so cannot be represented. The functions replace

268295-- invalid scalar values, instead of dropping them, as a security

269−-- measure. For details, see Unicode Technical Report 36, §3.5:

270−-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters>)

296+-- measure. For details, see

297+-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters Unicode Technical Report 36, §3.5 >.)

271298

272299-- $fusion

273300--

@@ -285,11 +312,11 @@ import Data.Int (Int64)

285312-- > countChars = T.length . T.toUpper . E.decodeUtf8

286313--

287314-- From the type signatures involved, this looks like it should

288−-- allocate one 'ByteString' value, and two 'Text' values. However,

289−-- when a module is compiled with optimisation enabled under GHC, the

290−-- two intermediate 'Text' values will be optimised away, and the

291−-- function will be compiled down to a single loop over the source

292−-- 'ByteString'.

315+-- allocate one 'Data.ByteString.ByteString' value, and two 'Text'

316+-- values. However, when a module is compiled with optimisation

317+-- enabled under GHC, the two intermediate 'Text' values will be

318+-- optimised away, and the function will be compiled down to a single

319+-- loop over the source 'Data.ByteString.ByteString'.

293320--

294321-- Functions that can be fused by the compiler are documented with the

295322-- phrase \"Subject to fusion\".

@@ -303,46 +330,83 @@ instance Eq Text where

303330instance Ord Text where

304331 compare = compareText

305332

306−instance Show Text where

307− showsPrec p ps r = showsPrec p (unpack ps) r

308−

309333instance Read Text where

310334 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]

311335

336+#if MIN_VERSION_base(4,9,0)

337+-- Semigroup orphan instances for older GHCs are provided by

338+-- 'semigroups` package

339+

340+instance Semigroup Text where

341+ (<>) = append

342+#endif

343+

312344instance Monoid Text where

313345 mempty = empty

346+#if MIN_VERSION_base(4,9,0)

347+ mappend = (<>) -- future-proof definition

348+#else

314349 mappend = append

350+#endif

315351 mconcat = concat

316352

317353instance IsString Text where

318354 fromString = pack

319355

356+#if __GLASGOW_HASKELL__ >= 708

357+instance Exts.IsList Text where

358+ type Item Text = Char

359+ fromList = pack

360+ toList = unpack

361+#endif

362+

320363#if defined(HAVE_DEEPSEQ)

321−instance NFData Text

364+instance NFData Text where rnf !_ = ()

322365#endif

323366

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

367+instance Binary Text where

368+ put t = put (encodeUtf8 t)

369+ get = do

370+ bs <- get

371+ case decodeUtf8' bs of

372+ P.Left exn -> P.fail (P.show exn)

373+ P.Right a -> P.return a

374+

375+-- | This instance preserves data abstraction at the cost of inefficiency.

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

326−--

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

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

329−-- submit improvements.

330377--

331−-- Original discussion is archived here:

332−

333−-- "could we get a Data instance for Data.Text.Text?"

334−-- http://groups.google.com/group/haskell-cafe/browse_thread/thread/b5bbb1b28a7e525d/0639d46852575b93

378+-- This instance was created by copying the updated behavior of

379+-- @"Data.Set".@'Data.Set.Set' and @"Data.Map".@'Data.Map.Map'. If you

380+-- feel a mistake has been made, please feel free to submit

381+-- improvements.

382+--

383+-- The original discussion is archived here:

384+-- <http://groups.google.com/group/haskell-cafe/browse_thread/thread/b5bbb1b28a7e525d/0639d46852575b93 could we get a Data instance for Data.Text.Text? >

385+--

386+-- The followup discussion that changed the behavior of 'Data.Set.Set'

387+-- and 'Data.Map.Map' is archived here:

388+-- <http://markmail.org/message/trovdc6zkphyi3cr#query:+page:1+mid:a46der3iacwjcf6n+state:results Proposal: Allow gunfold for Data.Map, ... >

335389

336390instance Data Text where

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

338− toConstr _ = P.error "Data.Text.Text.toConstr"

339− gunfold _ _ = P.error "Data.Text.Text.gunfold"

340−#if __GLASGOW_HASKELL__ >= 612

341− dataTypeOf _ = mkNoRepType "Data.Text.Text"

342−#else

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

392+ toConstr _ = packConstr

393+ gunfold k z c = case constrIndex c of

394+ 1 -> k (z pack)

395+ _ -> P.error "gunfold"

396+ dataTypeOf _ = textDataType

397+

398+#if MIN_VERSION_base(4,7,0)

399+-- | Only defined for @base-4.7.0.0@ and later

400+instance PrintfArg Text where

401+ formatArg txt = formatString $ unpack txt

344402#endif

345403

404+packConstr :: Constr

405+packConstr = mkConstr textDataType "pack" [] Prefix

406+

407+textDataType :: DataType

408+textDataType = mkDataType "Data.Text.Text" [packConstr]

409+

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

347411compareText :: Text -> Text -> Ordering

348412compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)

@@ -363,20 +427,9 @@ compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)

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

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

365429pack :: String -> Text

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

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

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

368432

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

370−unpack :: Text -> String

371−unpack = S.unstreamList . stream

372−{-# INLINE [1] unpack #-}

373−

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

375−-- Performs replacement on invalid scalar values.

376−singleton :: Char -> Text

377−singleton = unstream . S.singleton . safe

378−{-# INLINE [1] singleton #-}

379−

380433-- -----------------------------------------------------------------------------

381434-- * Basic functions

382435

@@ -407,12 +460,13 @@ append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)

407460 | otherwise = overflowError "append"

408461 where

409462 len = len1+len2

463+ x :: ST s (A.MArray s)

410464 x = do

411465 arr <- A.new len

412466 A.copyI arr 0 arr1 off1 len1

413467 A.copyI arr len1 arr2 off2 len

414468 return arr

415−{-# INLINE append #-}

469+{-# NOINLINE append #-}

416470

417471{-# RULES

418472"TEXT append -> fused" [~1] forall t1 t2.

@@ -432,8 +486,8 @@ head t = S.head (stream t)

432486uncons :: Text -> Maybe (Char, Text)

433487uncons t@(Text arr off len)

434488 | len <= 0 = Nothing

435− | otherwise = Just (c, textP arr (off+d) (len-d))

436− where Iter c d = iter t 0

489+ | otherwise = Just $ let !(Iter c d) = iter t 0

490+ in (c, text arr (off+d) (len-d))

437491{-# INLINE [1] uncons #-}

438492

439493-- | Lifted from Control.Arrow and specialized.

@@ -463,7 +517,7 @@ last (Text arr off len)

463517tail :: Text -> Text

464518tail t@(Text arr off len)

465519 | len <= 0 = emptyError "tail"

466− | otherwise = textP arr (off+d) (len-d)

520+ | otherwise = text arr (off+d) (len-d)

467521 where d = iter_ t 0

468522{-# INLINE [1] tail #-}

469523

@@ -478,8 +532,8 @@ tail t@(Text arr off len)

478532-- be non-empty. Subject to fusion.

479533init :: Text -> Text

480534init (Text arr off len) | len <= 0 = emptyError "init"

481− | n >= 0xDC00 && n <= 0xDFFF = textP arr off (len-2)

482− | otherwise = textP arr off (len-1)

535+ | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)

536+ | otherwise = text arr off (len-1)

483537 where

484538 n = A.unsafeIndex arr (off+len-1)

485539{-# INLINE [1] init #-}

@@ -518,7 +572,9 @@ isSingleton = S.isSingleton . stream

518572-- Subject to fusion.

519573length :: Text -> Int

520574length t = S.length (stream t)

521−{-# INLINE length #-}

575+{-# INLINE [0] length #-}

576+-- length needs to be phased after the compareN/length rules otherwise

577+-- it may inline before the rules have an opportunity to fire.

522578

523579-- | /O(n)/ Compare the count of characters in a 'Text' to a number.

524580-- Subject to fusion.

@@ -537,32 +593,32 @@ compareLength t n = S.compareLengthI (stream t) n

537593

538594{-# RULES

539595"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.

540− (==) (length t) n = compareLength t n == EQ

596+ eqInt (length t) n = compareLength t n == EQ

541597 #-}

542598

543599{-# RULES

544600"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.

545− (/=) (length t) n = compareLength t n /= EQ

601+ neInt (length t) n = compareLength t n /= EQ

546602 #-}

547603

548604{-# RULES

549605"TEXT <N/length -> compareLength/==LT" [~1] forall t n.

550− (<) (length t) n = compareLength t n == LT

606+ ltInt (length t) n = compareLength t n == LT

551607 #-}

552608

553609{-# RULES

554610"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.

555− (<=) (length t) n = compareLength t n /= GT

611+ leInt (length t) n = compareLength t n /= GT

556612 #-}

557613

558614{-# RULES

559615"TEXT >N/length -> compareLength/==GT" [~1] forall t n.

560− (>) (length t) n = compareLength t n == GT

616+ gtInt (length t) n = compareLength t n == GT

561617 #-}

562618

563619{-# RULES

564620"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.

565− (>=) (length t) n = compareLength t n /= LT

621+ geInt (length t) n = compareLength t n /= LT

566622 #-}

567623

568624-- -----------------------------------------------------------------------------

@@ -578,7 +634,7 @@ map f t = unstream (S.map (safe . f) (stream t))

578634-- 'Text's and concatenates the list after interspersing the first

579635-- argument between each element of the list.

580636intercalate :: Text -> [Text] -> Text

581−intercalate t = concat . (U.intersperse t)

637+intercalate t = concat . (F.intersperse t)

582638{-# INLINE intercalate #-}

583639

584640-- | /O(n)/ The 'intersperse' function takes a character and places it

@@ -593,16 +649,59 @@ reverse :: Text -> Text

593649reverse t = S.reverse (stream t)

594650{-# INLINE reverse #-}

595651

596−-- | /O(m+n)/ Replace every occurrence of one substring with another.

652+-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in

653+-- @haystack@ with @replacement@.

654+--

655+-- This function behaves as though it was defined as follows:

656+--

657+-- @

658+-- replace needle replacement haystack =

659+-- 'intercalate' replacement ('splitOn' needle haystack)

660+-- @

661+--

662+-- As this suggests, each occurrence is replaced exactly once. So if

663+-- @needle@ occurs in @replacement@, that occurrence will /not/ itself

664+-- be replaced recursively:

665+--

666+-- > replace "oo" "foo" "oo" == "foo"

667+--

668+-- In cases where several instances of @needle@ overlap, only the

669+-- first one will be replaced:

670+--

671+-- > replace "ofo" "bar" "ofofo" == "barfo"

597672--

598673-- In (unlikely) bad cases, this function's time complexity degrades

599674-- towards /O(n*m)/.

600−replace :: Text -- ^ Text to search for

601− -> Text -- ^ Replacement text

602− -> Text -- ^ Input text

675+replace :: Text

676+ -- ^ @needle@ to search for. If this string is empty, an

677+ -- error will occur.

678+ -> Text

679+ -- ^ @replacement@ to replace @needle@ with.

680+ -> Text

681+ -- ^ @haystack@ in which to search.

603682 -> Text

604−replace s d = intercalate d . splitOn s

605−{-# INLINE replace #-}

683+replace needle@(Text _ _ neeLen)

684+ (Text repArr repOff repLen)

685+ haystack@(Text hayArr hayOff hayLen)

686+ | neeLen == 0 = emptyError "replace"

687+ | L.null ixs = haystack

688+ | len > 0 = Text (A.run x) 0 len

689+ | otherwise = empty

690+ where

691+ ixs = indices needle haystack

692+ len = hayLen - (neeLen - repLen) `mul` L.length ixs

693+ x :: ST s (A.MArray s)

694+ x = do

695+ marr <- A.new len

696+ let loop (i:is) o d = do

697+ let d0 = d + i - o

698+ d1 = d0 + repLen

699+ A.copyI marr d hayArr (hayOff+o) d0

700+ A.copyI marr d0 repArr repOff d1

701+ loop is (i + neeLen) d1

702+ loop [] o d = A.copyI marr d hayArr (hayOff+o) len

703+ loop ixs 0 0

704+ return marr

606705

607706-- ----------------------------------------------------------------------------

608707-- ** Case conversions (folds)

@@ -621,13 +720,13 @@ replace s d = intercalate d . splitOn s

621720-- /Note/: In some languages, case conversion is a locale- and

622721-- context-dependent operation. The case conversion functions in this

623722-- module are /not/ locale sensitive. Programs that require locale

624−-- sensitivity should use appropriate versions of the case mapping

625−-- functions from the @text-icu@ package:

626−-- <http://hackage.haskell.org/package/text-icu>

723+-- sensitivity should use appropriate versions of the

724+-- <http://hackage.haskell.org/package/text-icu-0.6.3.7/docs/Data-Text-ICU.html#g:4 case mapping functions from the text-icu package >.

627725

628−-- | /O(n)/ Convert a string to folded case. This function is mainly

629−-- useful for performing caseless (also known as case insensitive)

630−-- string comparisons.

726+-- | /O(n)/ Convert a string to folded case. Subject to fusion.

727+--

728+-- This function is mainly useful for performing caseless (also known

729+-- as case insensitive) string comparisons.

631730--

632731-- A string @x@ is a caseless match for a string @y@ if and only if:

633732--

@@ -642,25 +741,51 @@ replace s d = intercalate d . splitOn s

642741-- instead of itself.

643742toCaseFold :: Text -> Text

644743toCaseFold t = unstream (S.toCaseFold (stream t))

645−{-# INLINE [0] toCaseFold #-}

744+{-# INLINE toCaseFold #-}

646745

647746-- | /O(n)/ Convert a string to lower case, using simple case

648−-- conversion. The result string may be longer than the input string.

649−-- For instance, \"İ\" (Latin capital letter I with dot above,

650−-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069) followed

651−-- by \" ̇\" (combining dot above, U+0307).

747+-- conversion. Subject to fusion.

748+--

749+-- The result string may be longer than the input string. For

750+-- instance, \"İ\" (Latin capital letter I with dot above,

751+-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)

752+-- followed by \" ̇\" (combining dot above, U+0307).

652753toLower :: Text -> Text

653754toLower t = unstream (S.toLower (stream t))

654755{-# INLINE toLower #-}

655756

656757-- | /O(n)/ Convert a string to upper case, using simple case

657−-- conversion. The result string may be longer than the input string.

658−-- For instance, the German \"ß\" (eszett, U+00DF) maps to the

758+-- conversion. Subject to fusion.

759+--

760+-- The result string may be longer than the input string. For

761+-- instance, the German \"ß\" (eszett, U+00DF) maps to the

659762-- two-letter sequence \"SS\".

660763toUpper :: Text -> Text

661764toUpper t = unstream (S.toUpper (stream t))

662765{-# INLINE toUpper #-}

663766

767+-- | /O(n)/ Convert a string to title case, using simple case

768+-- conversion. Subject to fusion.

769+--

770+-- The first letter of the input is converted to title case, as is

771+-- every subsequent letter that immediately follows a non-letter.

772+-- Every letter that immediately follows another letter is converted

773+-- to lower case.

774+--

775+-- The result string may be longer than the input string. For example,

776+-- the Latin small ligature ﬂ (U+FB02) is converted to the

777+-- sequence Latin capital letter F (U+0046) followed by Latin small

778+-- letter l (U+006C).

779+--

780+-- /Note/: this function does not take language or culture specific

781+-- rules into account. For instance, in English, different style

782+-- guides disagree on whether the book name \"The Hill of the Red

783+-- Fox\" is correctly title cased—but this function will

784+-- capitalize /every/ word.

785+toTitle :: Text -> Text

786+toTitle t = unstream (S.toTitle (stream t))

787+{-# INLINE toTitle #-}

788+

664789-- | /O(n)/ Left-justify a string to the given length, using the

665790-- specified fill character on the right. Subject to fusion.

666791-- Performs replacement on invalid scalar values.

@@ -711,7 +836,7 @@ center k c t

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

712837 where len = length t

713838 d = k - len

714− r = d `div` 2

839+ r = d `quot` 2

715840 l = d - r

716841{-# INLINE center #-}

717842

@@ -776,6 +901,7 @@ concat ts = case ts' of

776901 where

777902 ts' = L.filter (not . null) ts

778903 len = sumP "concat" $ L.map lengthWord16 ts'

904+ go :: ST s (A.MArray s)

779905 go = do

780906 arr <- A.new len

781907 let step i (Text a o l) =

@@ -789,13 +915,13 @@ concatMap f = concat . foldr ((:) . f) []

789915{-# INLINE concatMap #-}

790916

791917-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the

792−-- 'Text' @t@ satisifes the predicate @p@. Subject to fusion.

918+-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.

793919any :: (Char -> Bool) -> Text -> Bool

794920any p t = S.any p (stream t)

795921{-# INLINE any #-}

796922

797923-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the

798−-- 'Text' @t@ satisify the predicate @p@. Subject to fusion.

924+-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.

799925all :: (Char -> Bool) -> Text -> Bool

800926all p t = S.all p (stream t)

801927{-# INLINE all #-}

@@ -883,13 +1009,13 @@ mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream

8831009-- @t@ repeated @n@ times.

8841010replicate :: Int -> Text -> Text

8851011replicate n t@(Text a o l)

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

887− | n == 1 = t

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

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

890− | otherwise = overflowError "replicate"

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

1013+ | n == 1 = t

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

1015+ | otherwise = Text (A.run x) 0 len

8911016 where

892− len = l * n

1017+ len = l `mul` n

1018+ x :: ST s (A.MArray s)

8931019 x = do

8941020 arr <- A.new len

8951021 let loop !d !i | i >= n = return arr

@@ -940,14 +1066,16 @@ take :: Int -> Text -> Text

9401066take n t@(Text arr off len)

9411067 | n <= 0 = empty

9421068 | n >= len = t

943− | otherwise = Text arr off (loop 0 0)

944− where

945− loop !i !cnt

946− | i >= len || cnt >= n = i

947− | otherwise = loop (i+d) (cnt+1)

948− where d = iter_ t i

1069+ | otherwise = text arr off (iterN n t)

9491070{-# INLINE [1] take #-}

9501071

1072+iterN :: Int -> Text -> Int

1073+iterN n t@(Text _arr _off len) = loop 0 0

1074+ where loop !i !cnt

1075+ | i >= len || cnt >= n = i

1076+ | otherwise = loop (i+d) (cnt+1)

1077+ where d = iter_ t i

1078+

9511079{-# RULES

9521080"TEXT take -> fused" [~1] forall n t.

9531081 take n t = unstream (S.take n (stream t))

@@ -955,6 +1083,27 @@ take n t@(Text arr off len)

9551083 unstream (S.take n (stream t)) = take n t

9561084 #-}

9571085

1086+-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after

1087+-- taking @n@ characters from the end of @t@.

1088+--

1089+-- Examples:

1090+--

1091+-- > takeEnd 3 "foobar" == "bar"

1092+takeEnd :: Int -> Text -> Text

1093+takeEnd n t@(Text arr off len)

1094+ | n <= 0 = empty

1095+ | n >= len = t

1096+ | otherwise = text arr (off+i) (len-i)

1097+ where i = iterNEnd n t

1098+

1099+iterNEnd :: Int -> Text -> Int

1100+iterNEnd n t@(Text _arr _off len) = loop (len-1) n

1101+ where loop i !m

1102+ | i <= 0 = 0

1103+ | m <= 1 = i

1104+ | otherwise = loop (i+d) (m-1)

1105+ where d = reverseIter_ t i

1106+

9581107-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the

9591108-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@

9601109-- is greater than the length of the 'Text'. Subject to fusion.

@@ -962,11 +1111,8 @@ drop :: Int -> Text -> Text

9621111drop n t@(Text arr off len)

9631112 | n <= 0 = t

9641113 | n >= len = empty

965− | otherwise = loop 0 0

966− where loop !i !cnt

967− | i >= len || cnt >= n = Text arr (off+i) (len-i)

968− | otherwise = loop (i+d) (cnt+1)

969− where d = iter_ t i

1114+ | otherwise = text arr (off+i) (len-i)

1115+ where i = iterN n t

9701116{-# INLINE [1] drop #-}

9711117

9721118{-# RULES

@@ -976,6 +1122,18 @@ drop n t@(Text arr off len)

9761122 unstream (S.drop n (stream t)) = drop n t

9771123 #-}

9781124

1125+-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after

1126+-- dropping @n@ characters from the end of @t@.

1127+--

1128+-- Examples:

1129+--

1130+-- > dropEnd 3 "foobar" == "foo"

1131+dropEnd :: Int -> Text -> Text

1132+dropEnd n t@(Text arr off len)

1133+ | n <= 0 = t

1134+ | n >= len = empty

1135+ | otherwise = text arr off (iterNEnd n t)

1136+

9791137-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',

9801138-- returns the longest prefix (possibly empty) of elements that

9811139-- satisfy @p@. Subject to fusion.

@@ -983,7 +1141,7 @@ takeWhile :: (Char -> Bool) -> Text -> Text

9831141takeWhile p t@(Text arr off len) = loop 0

9841142 where loop !i | i >= len = t

9851143 | p c = loop (i+d)

986− | otherwise = textP arr off i

1144+ | otherwise = text arr off i

9871145 where Iter c d = iter t i

9881146{-# INLINE [1] takeWhile #-}

9891147

@@ -994,6 +1152,27 @@ takeWhile p t@(Text arr off len) = loop 0

9941152 unstream (S.takeWhile p (stream t)) = takeWhile p t

9951153 #-}

9961154

1155+-- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',

1156+-- returns the longest suffix (possibly empty) of elements that

1157+-- satisfy @p@. Subject to fusion.

1158+-- Examples:

1159+--

1160+-- > takeWhileEnd (=='o') "foo" == "oo"

1161+takeWhileEnd :: (Char -> Bool) -> Text -> Text

1162+takeWhileEnd p t@(Text arr off len) = loop (len-1) len

1163+ where loop !i !l | l <= 0 = t

1164+ | p c = loop (i+d) (l+d)

1165+ | otherwise = text arr (off+l) (len-l)

1166+ where (c,d) = reverseIter t i

1167+{-# INLINE [1] takeWhileEnd #-}

1168+

1169+{-# RULES

1170+"TEXT takeWhileEnd -> fused" [~1] forall p t.

1171+ takeWhileEnd p t = S.reverse (S.takeWhile p (S.reverseStream t))

1172+"TEXT takeWhileEnd -> unfused" [1] forall p t.

1173+ S.reverse (S.takeWhile p (S.reverseStream t)) = takeWhileEnd p t

1174+ #-}

1175+

9971176-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after

9981177-- 'takeWhile' @p@ @t@. Subject to fusion.

9991178dropWhile :: (Char -> Bool) -> Text -> Text

@@ -1012,8 +1191,9 @@ dropWhile p t@(Text arr off len) = loop 0 0

10121191 #-}

10131192

10141193-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after

1015−-- dropping characters that fail the predicate @p@ from the end of

1194+-- dropping characters that satisfy the predicate @p@ from the end of

10161195-- @t@. Subject to fusion.

1196+--

10171197-- Examples:

10181198--

10191199-- > dropWhileEnd (=='.') "foo..." == "foo"

@@ -1033,7 +1213,7 @@ dropWhileEnd p t@(Text arr off len) = loop (len-1) len

10331213 #-}

10341214

10351215-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after

1036−-- dropping characters that fail the predicate @p@ from both the

1216+-- dropping characters that satisfy the predicate @p@ from both the

10371217-- beginning and end of @t@. Subject to fusion.

10381218dropAround :: (Char -> Bool) -> Text -> Text

10391219dropAround p = dropWhile p . dropWhileEnd p

@@ -1068,24 +1248,16 @@ splitAt :: Int -> Text -> (Text, Text)

10681248splitAt n t@(Text arr off len)

10691249 | n <= 0 = (empty, t)

10701250 | n >= len = (t, empty)

1071− | otherwise = (Text arr off k, Text arr (off+k) (len-k))

1072− where k = loop 0 0

1073− loop !i !cnt

1074− | i >= len || cnt >= n = i

1075− | otherwise = loop (i+d) (cnt+1)

1076− where d = iter_ t i

1077−{-# INLINE splitAt #-}

1251+ | otherwise = let k = iterN n t

1252+ in (text arr off k, text arr (off+k) (len-k))

10781253

10791254-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns

10801255-- a pair whose first element is the longest prefix (possibly empty)

10811256-- of @t@ of elements that satisfy @p@, and whose second is the

10821257-- remainder of the list.

10831258span :: (Char -> Bool) -> Text -> (Text, Text)

1084−span p t@(Text arr off len) = (textP arr off k, textP arr (off+k) (len-k))

1085− where k = loop 0

1086− loop !i | i >= len || not (p c) = i

1087− | otherwise = loop (i+d)

1088− where Iter c d = iter t i

1259+span p t = case span_ p t of

1260+ (# hd,tl #) -> (hd,tl)

10891261{-# INLINE span #-}

10901262

10911263-- | /O(n)/ 'break' is like 'span', but the prefix returned is

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

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

11131285 | otherwise = go (i+d)

11141286 where Iter c d = iter t i

1115−

1287+

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

11171289group :: Text -> [Text]

11181290group = groupBy (==)

@@ -1136,31 +1308,38 @@ tails t | null t = [empty]

11361308-- copies to create substrings; they just construct new 'Text's that

11371309-- are slices of the original.

11381310

1139−-- | /O(m+n)/ Break a 'Text' into pieces separated by the first

1140−-- 'Text' argument, consuming the delimiter. An empty delimiter is

1141−-- invalid, and will cause an error to be raised.

1311+-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'

1312+-- argument (which cannot be empty), consuming the delimiter. An empty

1313+-- delimiter is invalid, and will cause an error to be raised.

11421314--

11431315-- Examples:

11441316--

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

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

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

1148−--

1320+--

11491321-- and

11501322--

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

11521324-- > splitOn (singleton c) == split (==c)

11531325--

1326+-- (Note: the string @s@ to split on above cannot be empty.)

1327+--

11541328-- In (unlikely) bad cases, this function's time complexity degrades

11551329-- towards /O(n*m)/.

1156−splitOn :: Text -> Text -> [Text]

1330+splitOn :: Text

1331+ -- ^ String to split on. If this string is empty, an error

1332+ -- will occur.

1333+ -> Text

1334+ -- ^ Input text.

1335+ -> [Text]

11571336splitOn pat@(Text _ _ l) src@(Text arr off len)

11581337 | l <= 0 = emptyError "splitOn"

11591338 | isSingleton pat = split (== unsafeHead pat) src

11601339 | otherwise = go 0 (indices pat src)

11611340 where

1162− go !s (x:xs) = textP arr (s+off) (x-s) : go (x+l) xs

1163− go s _ = [textP arr (s+off) (len-s)]

1341+ go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs

1342+ go s _ = [text arr (s+off) (len-s)]

11641343{-# INLINE [1] splitOn #-}

11651344

11661345{-# RULES

@@ -1180,7 +1359,7 @@ split _ t@(Text _off _arr 0) = [t]

11801359split p t = loop t

11811360 where loop s | null s' = [l]

11821361 | otherwise = l : loop (unsafeTail s')

1183− where (l, s') = break p s

1362+ where (# l, s' #) = span_ (not . p) s

11841363{-# INLINE split #-}

11851364

11861365-- | /O(n)/ Splits a 'Text' into components of length @k@. The last

@@ -1252,7 +1431,7 @@ breakOn pat src@(Text arr off len)

12521431 | null pat = emptyError "breakOn"

12531432 | otherwise = case indices pat src of

12541433 [] -> (src, empty)

1255− (x:_) -> (textP arr off x, textP arr (off+x) (len-x))

1434+ (x:_) -> (text arr off x, text arr (off+x) (len-x))

12561435{-# INLINE breakOn #-}

12571436

12581437-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the

@@ -1277,9 +1456,9 @@ breakOnEnd pat src = (reverse b, reverse a)

12771456--

12781457-- Examples:

12791458--

1280−-- > find "::" ""

1459+-- > breakOnAll "::" ""

12811460-- > ==> []

1282−-- > find "/" "a/b/c/"

1461+-- > breakOnAll "/" "a/b/c/"

12831462-- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]

12841463--

12851464-- In (unlikely) bad cases, this function's time complexity degrades

@@ -1294,7 +1473,7 @@ breakOnAll pat src@(Text arr off slen)

12941473 | otherwise = L.map step (indices pat src)

12951474 where

12961475 step x = (chunk 0 x, chunk x (slen-x))

1297− chunk !n !l = textP arr (n+off) l

1476+ chunk !n !l = text arr (n+off) l

12981477{-# INLINE breakOnAll #-}

12991478

13001479-------------------------------------------------------------------------------

@@ -1314,7 +1493,7 @@ breakOnAll pat src@(Text arr off slen)

13141493-- For example, suppose you have a string that you want to split on

13151494-- the substring @\"::\"@, such as @\"foo::bar::quux\"@. Instead of

13161495-- searching for the index of @\"::\"@ and taking the substrings

1317−-- before and after that index, you would instead use @find \"::\"@.

1496+-- before and after that index, you would instead use @breakOnAll \"::\"@.

13181497

13191498-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.

13201499index :: Text -> Int -> Char

@@ -1361,7 +1540,7 @@ countChar c t = S.countChar c (stream t)

13611540-- equivalent to a pair of 'unpack' operations.

13621541zip :: Text -> Text -> [(Char,Char)]

13631542zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)

1364−{-# INLINE [0] zip #-}

1543+{-# INLINE zip #-}

13651544

13661545-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function

13671546-- given as the first argument, instead of a tupling function.

@@ -1369,7 +1548,7 @@ zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)

13691548zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text

13701549zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))

13711550 where g a b = safe (f a b)

1372−{-# INLINE [0] zipWith #-}

1551+{-# INLINE zipWith #-}

13731552

13741553-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's

13751554-- representing white space.

@@ -1395,7 +1574,7 @@ lines ps | null ps = []

13951574 | otherwise = h : if null t

13961575 then []

13971576 else lines (unsafeTail t)

1398− where (h,t) = span (/= '\n') ps

1577+ where (# h,t #) = span_ (/= '\n') ps

13991578{-# INLINE lines #-}

14001579

14011580{-

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

14411620{-# RULES

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

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

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

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

14461623 #-}

14471624

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

@@ -1496,7 +1673,7 @@ isInfixOf needle haystack

14961673-- > fnordLength _ = -1

14971674stripPrefix :: Text -> Text -> Maybe Text

14981675stripPrefix p@(Text _arr _off plen) t@(Text arr off len)

1499− | p `isPrefixOf` t = Just $! textP arr (off+plen) (len-plen)

1676+ | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)

15001677 | otherwise = Nothing

15011678

15021679-- | /O(n)/ Find the longest non-empty common prefix of two strings

@@ -1516,8 +1693,8 @@ commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0

15161693 where

15171694 go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)

15181695 | i > 0 = Just (Text arr0 off0 i,

1519− textP arr0 (off0+i) (len0-i),

1520− textP arr1 (off1+j) (len1-j))

1696+ text arr0 (off0+i) (len0-i),

1697+ text arr1 (off1+j) (len1-j))

15211698 | otherwise = Nothing

15221699 where Iter a d0 = iter t0 i

15231700 Iter b d1 = iter t1 j

@@ -1542,7 +1719,7 @@ commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0

15421719-- > quuxLength _ = -1

15431720stripSuffix :: Text -> Text -> Maybe Text

15441721stripSuffix p@(Text _arr _off plen) t@(Text arr off len)

1545− | p `isSuffixOf` t = Just $! textP arr off (len-plen)

1722+ | p `isSuffixOf` t = Just $! text arr off (len-plen)

15461723 | otherwise = Nothing

15471724

15481725-- | Add a list of non-negative numbers. Errors out on overflow.

@@ -1559,3 +1736,20 @@ emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"

15591736

15601737overflowError :: String -> a

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

1739+

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

1741+-- storage with the original string.

1742+--

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

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

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

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

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

1748+copy :: Text -> Text

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

1750+ where

1751+ go :: ST s (A.MArray s)

1752+ go = do

1753+ marr <- A.new len

1754+ A.copyI marr 0 arr off len

1755+ return marr

Data/Text/Array.hs+15−11

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

77--

88-- License : BSD-style

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

10−-- duncan@haskell.org

9+-- Maintainer : bos@serpentine.com

1110-- Stability : experimental

1211-- Portability : portable

1312--

@@ -21,13 +20,13 @@

2120-- > import qualified Data.Text.Array as A

2221--

2322-- The names in this module resemble those in the 'Data.Array' family

24−-- of modules, but are shorter due to the assumption of qualifid

23+-- of modules, but are shorter due to the assumption of qualified

2524-- naming.

2625module Data.Text.Array

2726 (

2827 -- * Types

29− Array(aBA)

30− , MArray(maBA)

28+ Array(Array, aBA)

29+ , MArray(MArray, maBA)

3130

3231 -- * Functions

3332 , copyM

@@ -66,8 +65,8 @@ import Control.Monad.ST.Unsafe (unsafeIOToST)

6665import Control.Monad.ST (unsafeIOToST)

6766#endif

6867import Data.Bits ((.&.), xor)

69−import Data.Text.Unsafe.Base (inlinePerformIO)

70−import Data.Text.UnsafeShift (shiftL, shiftR)

68+import Data.Text.Internal.Unsafe (inlinePerformIO)

69+import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)

7170#if __GLASGOW_HASKELL__ >= 703

7271import Foreign.C.Types (CInt(CInt), CSize(CSize))

7372#else

@@ -75,7 +74,7 @@ import Foreign.C.Types (CInt, CSize)

7574#endif

7675import GHC.Base (ByteArray#, MutableByteArray#, Int(..),

7776 indexWord16Array#, newByteArray#,

78− unsafeCoerce#, writeWord16Array#)

77+ unsafeFreezeByteArray#, writeWord16Array#)

7978import GHC.ST (ST(..), runST)

8079import GHC.Word (Word16(..))

8180import Prelude hiding (length, read)

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

114113-- | Create an uninitialized mutable array.

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

116115new n

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

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

118117 | otherwise = ST $ \s1# ->

119118 case newByteArray# len# s1# of

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

@@ -126,10 +125,14 @@ new n

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

127126{-# INLINE new #-}

128127

128+array_size_error :: a

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

130+

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

130132unsafeFreeze :: MArray s -> ST s Array

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

132− (# s#, Array (unsafeCoerce# maBA)

133+unsafeFreeze MArray{..} = ST $ \s1# ->

134+ case unsafeFreezeByteArray# maBA s1# of

135+ (# s2#, ba# #) -> (# s2#, Array ba#

133136#if defined(ASSERTS)

134137 maLen

135138#endif

@@ -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+299−88

@@ -1,14 +1,16 @@

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

811--

912-- License : BSD-style

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

11−-- duncan@haskell.org

13+-- Maintainer : bos@serpentine.com

1214-- Stability : experimental

1315-- Portability : portable

1416--

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

2325 -- * Decoding ByteStrings to Text

2426 -- $strict

2527 decodeASCII

28+ , decodeLatin1

2629 , decodeUtf8

2730 , decodeUtf16LE

2831 , decodeUtf16BE

@@ -39,39 +42,59 @@ module Data.Text.Encoding

3942 , decodeUtf32LEWith

4043 , decodeUtf32BEWith

4144

45+ -- ** Stream oriented decoding

46+ -- $stream

47+ , streamDecodeUtf8

48+ , streamDecodeUtf8With

49+ , Decoding(..)

50+

4251 -- * Encoding Text to ByteStrings

4352 , encodeUtf8

4453 , encodeUtf16LE

4554 , encodeUtf16BE

4655 , encodeUtf32LE

4756 , encodeUtf32BE

57+

58+ -- * Encoding Text using ByteString Builders

59+ , encodeUtf8Builder

60+ , encodeUtf8BuilderEscaped

4861 ) where

4962

50−import Control.Exception (evaluate, try)

5163#if __GLASGOW_HASKELL__ >= 702

5264import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)

5365#else

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

5567#endif

68+

69+import Control.Exception (evaluate, try)

70+import Control.Monad.ST (runST)

5671import Data.Bits ((.&.))

5772import Data.ByteString as B

58−import Data.ByteString.Internal as B

73+import Data.ByteString.Internal as B hiding (c2w)

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

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

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

62−import Data.Text.UnsafeShift (shiftL, shiftR)

63−import Data.Word (Word8)

64−import Foreign.C.Types (CSize)

75+import Data.Text.Internal (Text(..), safe, text)

76+import Data.Text.Internal.Private (runText)

77+import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)

78+import Data.Text.Internal.Unsafe.Shift (shiftR)

79+import Data.Text.Show ()

80+import Data.Text.Unsafe (unsafeDupablePerformIO)

81+import Data.Word (Word8, Word32)

82+import Foreign.C.Types (CSize(..))

6583import Foreign.ForeignPtr (withForeignPtr)

6684import Foreign.Marshal.Utils (with)

67−import Foreign.Ptr (Ptr, plusPtr)

68−import Foreign.Storable (peek, poke)

69−import GHC.Base (MutableByteArray#)

70−import System.IO.Unsafe (unsafePerformIO)

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

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

87+import GHC.Base (ByteArray#, MutableByteArray#)

88+import qualified Data.ByteString.Builder as B

89+import qualified Data.ByteString.Builder.Internal as B hiding (empty, append)

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

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

7192import qualified Data.Text.Array as A

72−import qualified Data.Text.Encoding.Fusion as E

73−import qualified Data.Text.Encoding.Utf16 as U16

74−import qualified Data.Text.Fusion as F

93+import qualified Data.Text.Internal.Encoding.Fusion as E

94+import qualified Data.Text.Internal.Encoding.Utf16 as U16

95+import qualified Data.Text.Internal.Fusion as F

96+

97+#include "text_cbits.h"

7598

7699-- $strict

77100--

@@ -88,40 +111,181 @@ import qualified Data.Text.Fusion as F

88111

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

90113-- encoded text.

91−--

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

93114decodeASCII :: ByteString -> Text

94115decodeASCII = decodeUtf8

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

96117

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

119+--

120+-- 'decodeLatin1' is semantically equivalent to

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

122+decodeLatin1 :: ByteString -> Text

123+decodeLatin1 (PS fp off len) = text a 0 len

124+ where

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

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

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

128+ return dest

129+

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

98131decodeUtf8With :: OnDecodeError -> ByteString -> Text

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

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

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

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

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

136+ loop curPtr = do

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

138+ if curPtr' == end

139+ then do

140+ n <- peek destOffPtr

141+ unsafeSTToIO (done dest (fromIntegral n))

142+ else do

143+ x <- peek curPtr'

144+ case onErr desc (Just x) of

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

146+ Just c -> do

147+ destOff <- peek destOffPtr

148+ w <- unsafeSTToIO $

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

150+ poke destOffPtr (destOff + fromIntegral w)

151+ loop $ curPtr' `plusPtr` 1

152+ loop (ptr `plusPtr` off)

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

100154 where

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

102− 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)

155+ desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"

123156{- INLINE[0] decodeUtf8With #-}

124157

158+-- $stream

159+--

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

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

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

163+--

164+-- 1. The maximal prefix of 'Text' that could be decoded from the

165+-- given input.

166+--

167+-- 2. The suffix of the 'ByteString' that could not be decoded due to

168+-- insufficient input.

169+--

170+-- 3. A function that accepts another 'ByteString'. That string will

171+-- be assumed to directly follow the string that was passed as

172+-- input to the original function, and it will in turn be decoded.

173+--

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

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

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

177+--

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

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

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

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

182+-- as we receive each one.

183+--

184+-- @

185+-- ghci> let s0\@('Some' _ _ f0) = 'streamDecodeUtf8' \"hi \\xe2\"

186+-- ghci> s0

187+-- 'Some' \"hi \" \"\\xe2\" _

188+-- @

189+--

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

191+--

192+-- @

193+-- ghci> let s1\@('Some' _ _ f1) = f0 \"\\x98\"

194+-- ghci> s1

195+-- 'Some' \"\" \"\\xe2\\x98\"

196+-- @

197+--

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

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

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

201+--

202+-- @

203+-- ghci> let s2\@('Some' _ _ f2) = f1 \"\\x83\"

204+-- ghci> s2

205+-- 'Some' \"\\x2603\" \"\" _

206+-- @

207+--

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

209+-- or continuation where it is encountered.

210+

211+-- | A stream oriented decoding result.

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

213+

214+instance Show Decoding where

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

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

217+ showChar ' ' . showsPrec prec' bs .

218+ showString " _"

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

220+

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

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

223+

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

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

226+--

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

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

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

230+-- data, use 'streamDecodeUtf8With'.

231+streamDecodeUtf8 :: ByteString -> Decoding

232+streamDecodeUtf8 = streamDecodeUtf8With strictDecode

233+

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

235+-- encoded text.

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

237+streamDecodeUtf8With onErr = decodeChunk B.empty 0 0

238+ where

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

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

241+ decodeChunk :: ByteString -> CodePoint -> DecoderState -> ByteString

242+ -> Decoding

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

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

245+ where

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

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

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

249+ with codepoint0 $ \codepointPtr ->

250+ with state0 $ \statePtr ->

251+ with nullPtr $ \curPtrPtr ->

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

253+ loop curPtr = do

254+ poke curPtrPtr curPtr

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

256+ curPtrPtr end codepointPtr statePtr

257+ state <- peek statePtr

258+ case state of

259+ UTF8_REJECT -> do

260+ -- We encountered an encoding error

261+ x <- peek curPtr'

262+ poke statePtr 0

263+ case onErr desc (Just x) of

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

265+ Just c -> do

266+ destOff <- peek destOffPtr

267+ w <- unsafeSTToIO $

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

269+ poke destOffPtr (destOff + fromIntegral w)

270+ loop $ curPtr' `plusPtr` 1

271+

272+ _ -> do

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

274+ n <- peek destOffPtr

275+ codepoint <- peek codepointPtr

276+ chunkText <- unsafeSTToIO $ do

277+ arr <- A.unsafeFreeze dest

278+ return $! text arr 0 (fromIntegral n)

279+ lastPtr <- peek curPtrPtr

280+ let left = lastPtr `minusPtr` curPtr

281+ !undecoded = case state of

282+ UTF8_ACCEPT -> B.empty

283+ _ -> B.append undecoded0 (B.drop left bs)

284+ return $ Some chunkText undecoded

285+ (decodeChunk undecoded codepoint state)

286+ in loop (ptr `plusPtr` off)

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

288+

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

126290-- to be valid.

127291--

@@ -135,57 +299,93 @@ decodeUtf8 = decodeUtf8With strictDecode

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

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

137301

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

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

139303--

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

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

142306decodeUtf8' :: ByteString -> Either UnicodeException Text

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

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

144308{-# INLINE decodeUtf8' #-}

145309

310+-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.

311+encodeUtf8Builder :: Text -> B.Builder

312+encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)

313+

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

315+-- a 'BP.BoundedPrim'.

316+--

317+-- Use this function is to implement efficient encoders for text-based formats

318+-- like JSON or HTML.

319+{-# INLINE encodeUtf8BuilderEscaped #-}

320+-- TODO: Extend documentation with references to source code in @blaze-html@

321+-- or @aeson@ that uses this function.

322+encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder

323+encodeUtf8BuilderEscaped be =

324+ -- manual eta-expansion to ensure inlining works as expected

325+ \txt -> B.builder (mkBuildstep txt)

326+ where

327+ bound = max 4 $ BP.sizeBound be

328+

329+ mkBuildstep (Text arr off len) !k =

330+ outerLoop off

331+ where

332+ iend = off + len

333+

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

335+ | i0 >= iend = k br

336+ | outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining)

337+ -- TODO: Use a loop with an integrated bound's check if outRemaining

338+ -- is smaller than 8, as this will save on divisions.

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

340+ where

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

342+ inpRemaining = iend - i0

343+

344+ goPartial !iendTmp = go i0 op0

345+ where

346+ go !i !op

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

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

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

350+ | w <= 0x7FF -> do

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

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

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

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

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

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

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

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

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

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

361+ | otherwise -> do

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

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

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

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

366+ | otherwise =

367+ outerLoop i (B.BufferRange op ope)

368+ where

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

370+

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

147372encodeUtf8 :: Text -> ByteString

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

149− let size0 = max len 4

150− mallocByteString size0 >>= start size0 off 0

151− where

152− start size n0 m0 fp = withForeignPtr fp $ loop n0 m0

153− where

154− loop n1 m1 ptr = go n1 m1

155− where

156− go !n !m

157− | n-off == len = return (PS fp 0 m)

158− | otherwise = do

159− let poke8 k v = poke (ptr `plusPtr` k) (fromIntegral v :: Word8)

160− ensure k act

161− | size-m >= k = act

162− | otherwise = {-# SCC "resizeUtf8/ensure" #-} do

163− let newSize = size `shiftL` 1

164− fp' <- mallocByteString newSize

165− withForeignPtr fp' $ \ptr' ->

166− memcpy ptr' ptr (fromIntegral m)

167− start newSize n m fp'

168− {-# INLINE ensure #-}

169− case A.unsafeIndex arr n of

170− w| w <= 0x7F -> ensure 1 $ do

171− poke8 m w

172− go (n+1) (m+1)

173− | w <= 0x7FF -> ensure 2 $ do

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

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

176− go (n+1) (m+2)

177− | 0xD800 <= w && w <= 0xDBFF -> ensure 4 $ do

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

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

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

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

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

183− go (n+2) (m+4)

184− | otherwise -> ensure 3 $ do

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

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

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

188− go (n+1) (m+3)

373+encodeUtf8 (Text arr off len)

374+ | len == 0 = B.empty

375+ | otherwise = unsafeDupablePerformIO $ do

376+ fp <- mallocByteString (len*4)

377+ withForeignPtr fp $ \ptr ->

378+ with ptr $ \destPtr -> do

379+ c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)

380+ newDest <- peek destPtr

381+ let utf8len = newDest `minusPtr` ptr

382+ if utf8len >= len `shiftR` 1

383+ then return (PS fp 0 utf8len)

384+ else do

385+ fp' <- mallocByteString utf8len

386+ withForeignPtr fp' $ \ptr' -> do

387+ memcpy ptr' ptr (fromIntegral utf8len)

388+ return (PS fp' 0 utf8len)

189389

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

191391decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text

@@ -266,3 +466,14 @@ encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))

266466foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8

267467 :: MutableByteArray# s -> Ptr CSize

268468 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)

469+

470+foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state

471+ :: MutableByteArray# s -> Ptr CSize

472+ -> Ptr (Ptr Word8) -> Ptr Word8

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

474+

475+foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1

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

477+

478+foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8

479+ :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()

Data/Text/Encoding/Error.hs+16−7

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

11{-# LANGUAGE CPP, DeriveDataTypeable #-}

2+#if __GLASGOW_HASKELL__ >= 704

3+{-# LANGUAGE Safe #-}

4+#elif __GLASGOW_HASKELL__ >= 702

5+{-# LANGUAGE Trustworthy #-}

6+#endif

27-- |

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

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

510--

611-- License : BSD-style

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

8−-- duncan@haskell.org

12+-- Maintainer : bos@serpentine.com

913-- Stability : experimental

1014-- Portability : GHC

1115--

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

3539 , replace

3640 ) where

3741

38−#if __GLASGOW_HASKELL__ >= 610

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

3943import Control.Exception (Exception, throw)

40−#else

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

42−#endif

4344import Data.Typeable (Typeable)

4445import Data.Word (Word8)

4546import Numeric (showHex)

@@ -67,6 +68,7 @@ type OnError a b = String -> Maybe a -> Maybe b

6768type OnDecodeError = OnError Word8 Char

6869

6970-- | A handler for an encoding error.

71+{-# DEPRECATED OnEncodeError "This exception is never used in practice, and will be removed." #-}

7072type OnEncodeError = OnError Char Word8

7173

7274-- | An exception type for representing Unicode encoding errors.

@@ -79,6 +81,8 @@ data UnicodeException =

7981 -- under the given encoding, or ran out of input in mid-encode.

8082 deriving (Eq, Typeable)

8183

84+{-# DEPRECATED EncodeError "This constructor is never used, and will be removed." #-}

85+

8286showUnicodeException :: UnicodeException -> String

8387showUnicodeException (DecodeError desc (Just w))

8488 = "Cannot decode byte '\\x" ++ showHex w ("': " ++ desc)

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

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

8993showUnicodeException (EncodeError desc Nothing)

9094 = "Cannot encode input: " ++ desc

91−

95+

9296instance Show UnicodeException where

9397 show = showUnicodeException

9498

9599instance Exception UnicodeException

96100

101+instance NFData UnicodeException where

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

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

104+

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

98106strictDecode :: OnDecodeError

99107strictDecode desc c = throw (DecodeError desc c)

@@ -104,6 +112,7 @@ lenientDecode :: OnDecodeError

104112lenientDecode _ _ = Just '\xfffd'

105113

106114-- | Throw a 'UnicodeException' if encoding fails.

115+{-# DEPRECATED strictEncode "This function always throws an exception, and will be removed." #-}

107116strictEncode :: OnEncodeError

108117strictEncode desc c = throw (EncodeError desc c)

109118

Data/Text/Encoding/Fusion/Common.hsdeleted−162

@@ -1,162 +0,0 @@

1−{-# LANGUAGE BangPatterns #-}

2−

3−-- |

4−-- Module : Data.Text.Encoding.Fusion.Common

5−-- Copyright : (c) Tom Harper 2008-2009,

6−-- (c) Bryan O'Sullivan 2009,

7−-- (c) Duncan Coutts 2009

8−--

9−-- License : BSD-style

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

11−-- duncan@haskell.org

12−-- Stability : experimental

13−-- Portability : portable

14−--

15−-- Fusible 'Stream'-oriented functions for converting between 'Text'

16−-- and several common encodings.

17−

18−module Data.Text.Encoding.Fusion.Common

19− (

20− -- * Restreaming

21− -- Restreaming is the act of converting from one 'Stream'

22− -- representation to another.

23− restreamUtf8

24− , restreamUtf16LE

25− , restreamUtf16BE

26− , restreamUtf32LE

27− , restreamUtf32BE

28− ) where

29−

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

31−import Data.Text.Fusion (Step(..), Stream(..))

32−import Data.Text.Fusion.Internal (M(..), S(..))

33−import Data.Text.UnsafeChar (ord)

34−import Data.Text.UnsafeShift (shiftR)

35−import Data.Word (Word8)

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

37−

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

39−restreamUtf8 :: Stream Char -> Stream Word8

40−restreamUtf8 (Stream next0 s0 len) =

41− Stream next (S s0 N N N) (len*2)

42− where

43− {-# INLINE next #-}

44− next (S s N N N) = case next0 s of

45− Done -> Done

46− Skip s' -> Skip (S s' N N N)

47− Yield x xs

48− | n <= 0x7F -> Yield c (S xs N N N)

49− | n <= 0x07FF -> Yield a2 (S xs (J b2) N N)

50− | n <= 0xFFFF -> Yield a3 (S xs (J b3) (J c3) N)

51− | otherwise -> Yield a4 (S xs (J b4) (J c4) (J d4))

52− where

53− n = ord x

54− c = fromIntegral n

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

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

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

58− next (S s (J x2) N N) = Yield x2 (S s N N N)

59− next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)

60− next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)

61− next _ = internalError "restreamUtf8"

62−{-# INLINE restreamUtf8 #-}

63−

64−restreamUtf16BE :: Stream Char -> Stream Word8

65−restreamUtf16BE (Stream next0 s0 len) =

66− Stream next (S s0 N N N) (len*2)

67− where

68− {-# INLINE next #-}

69− next (S s N N N) = case next0 s of

70− Done -> Done

71− Skip s' -> Skip (S s' N N N)

72− Yield x xs

73− | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $

74− S xs (J $ fromIntegral n) N N

75− | otherwise -> Yield c1 $

76− S xs (J c2) (J c3) (J c4)

77− where

78− n = ord x

79− n1 = n - 0x10000

80− c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)

81− c2 = fromIntegral (n1 `shiftR` 10)

82− n2 = n1 .&. 0x3FF

83− c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)

84− c4 = fromIntegral n2

85− next (S s (J x2) N N) = Yield x2 (S s N N N)

86− next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)

87− next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)

88− next _ = internalError "restreamUtf16BE"

89−{-# INLINE restreamUtf16BE #-}

90−

91−restreamUtf16LE :: Stream Char -> Stream Word8

92−restreamUtf16LE (Stream next0 s0 len) =

93− Stream next (S s0 N N N) (len*2)

94− where

95− {-# INLINE next #-}

96− next (S s N N N) = case next0 s of

97− Done -> Done

98− Skip s' -> Skip (S s' N N N)

99− Yield x xs

100− | n < 0x10000 -> Yield (fromIntegral n) $

101− S xs (J (fromIntegral $ shiftR n 8)) N N

102− | otherwise -> Yield c1 $

103− S xs (J c2) (J c3) (J c4)

104− where

105− n = ord x

106− n1 = n - 0x10000

107− c2 = fromIntegral (shiftR n1 18 + 0xD8)

108− c1 = fromIntegral (shiftR n1 10)

109− n2 = n1 .&. 0x3FF

110− c4 = fromIntegral (shiftR n2 8 + 0xDC)

111− c3 = fromIntegral n2

112− next (S s (J x2) N N) = Yield x2 (S s N N N)

113− next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)

114− next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)

115− next _ = internalError "restreamUtf16LE"

116−{-# INLINE restreamUtf16LE #-}

117−

118−restreamUtf32BE :: Stream Char -> Stream Word8

119−restreamUtf32BE (Stream next0 s0 len) =

120− Stream next (S s0 N N N) (len*2)

121− where

122− {-# INLINE next #-}

123− next (S s N N N) = case next0 s of

124− Done -> Done

125− Skip s' -> Skip (S s' N N N)

126− Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))

127− where

128− n = ord x

129− c1 = fromIntegral $ shiftR n 24

130− c2 = fromIntegral $ shiftR n 16

131− c3 = fromIntegral $ shiftR n 8

132− c4 = fromIntegral n

133− next (S s (J x2) N N) = Yield x2 (S s N N N)

134− next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)

135− next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)

136− next _ = internalError "restreamUtf32BE"

137−{-# INLINE restreamUtf32BE #-}

138−

139−restreamUtf32LE :: Stream Char -> Stream Word8

140−restreamUtf32LE (Stream next0 s0 len) =

141− Stream next (S s0 N N N) (len*2)

142− where

143− {-# INLINE next #-}

144− next (S s N N N) = case next0 s of

145− Done -> Done

146− Skip s' -> Skip (S s' N N N)

147− Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))

148− where

149− n = ord x

150− c4 = fromIntegral $ shiftR n 24

151− c3 = fromIntegral $ shiftR n 16

152− c2 = fromIntegral $ shiftR n 8

153− c1 = fromIntegral n

154− next (S s (J x2) N N) = Yield x2 (S s N N N)

155− next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)

156− next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)

157− next _ = internalError "restreamUtf32LE"

158−{-# INLINE restreamUtf32LE #-}

159−

160−internalError :: String -> a

161−internalError func =

162− error $ "Data.Text.Encoding.Fusion.Common." ++ func ++ ": internal error"

Data/Text/Foreign.hs+27−4

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

55--

66-- License : BSD-style

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

8−-- duncan@haskell.org

7+-- Maintainer : bos@serpentine.com

98-- Stability : experimental

109-- Portability : GHC

1110--

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

2120 , fromPtr

2221 , useAsPtr

2322 , asForeignPtr

23+ -- ** Encoding as UTF-8

24+ , peekCStringLen

25+ , withCStringLen

2426 -- * Unsafe conversion code

2527 , lengthWord16

2628 , unsafeCopyToPtr

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

3840#else

3941import Control.Monad.ST (unsafeIOToST)

4042#endif

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

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

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

4246import Data.Text.Unsafe (lengthWord16)

43−import qualified Data.Text.Array as A

4447import Data.Word (Word16)

48+import Foreign.C.String (CStringLen)

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

4550import Foreign.Marshal.Alloc (allocaBytes)

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

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

4852import Foreign.Storable (peek, poke)

53+import qualified Data.Text.Array as A

4954

5055-- $interop

5156--

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

148153 fp <- mallocForeignPtrArray len

149154 withForeignPtr fp $ unsafeCopyToPtr t

150155 return (fp, I16 len)

156+

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

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

159+-- 'UnicodeException' is thrown.

160+peekCStringLen :: CStringLen -> IO Text

161+peekCStringLen cs = do

162+ bs <- unsafePackCStringLen cs

163+ return $! decodeUtf8 bs

164+

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

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

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

168+--

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

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

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

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

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

Data/Text/Fusion/Size.hsdeleted−146

@@ -1,146 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−{-# OPTIONS_GHC -fno-warn-missing-methods #-}

3−-- |

4−-- Module : Data.Text.Fusion.Internal

5−-- Copyright : (c) Roman Leshchinskiy 2008,

6−-- (c) Bryan O'Sullivan 2009

7−--

8−-- License : BSD-style

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

10−-- duncan@haskell.org

11−-- Stability : experimental

12−-- Portability : portable

13−--

14−-- Size hints.

15−

16−module Data.Text.Fusion.Size

17− (

18− Size

19− , exactly

20− , exactSize

21− , maxSize

22− , unknownSize

23− , smaller

24− , larger

25− , upperBound

26− , isEmpty

27− ) where

28−

29−#if defined(ASSERTS)

30−import Control.Exception (assert)

31−#endif

32−

33−data Size = Exact {-# UNPACK #-} !Int -- ^ Exact size.

34− | Max {-# UNPACK #-} !Int -- ^ Upper bound on size.

35− | Unknown -- ^ Unknown size.

36− deriving (Eq, Show)

37−

38−exactly :: Size -> Maybe Int

39−exactly (Exact n) = Just n

40−exactly _ = Nothing

41−{-# INLINE exactly #-}

42−

43−exactSize :: Int -> Size

44−exactSize n =

45−#if defined(ASSERTS)

46− assert (n >= 0)

47−#endif

48− Exact n

49−{-# INLINE exactSize #-}

50−

51−maxSize :: Int -> Size

52−maxSize n =

53−#if defined(ASSERTS)

54− assert (n >= 0)

55−#endif

56− Max n

57−{-# INLINE maxSize #-}

58−

59−unknownSize :: Size

60−unknownSize = Unknown

61−{-# INLINE unknownSize #-}

62−

63−instance Num Size where

64− (+) = addSize

65− (-) = subtractSize

66− (*) = mulSize

67−

68− fromInteger = f where f = Exact . fromInteger

69− {-# INLINE f #-}

70−

71−add :: Int -> Int -> Int

72−add m n | mn >= 0 = mn

73− | otherwise = overflowError

74− where mn = m + n

75−{-# INLINE add #-}

76−

77−addSize :: Size -> Size -> Size

78−addSize (Exact m) (Exact n) = Exact (add m n)

79−addSize (Exact m) (Max n) = Max (add m n)

80−addSize (Max m) (Exact n) = Max (add m n)

81−addSize (Max m) (Max n) = Max (add m n)

82−addSize _ _ = Unknown

83−{-# INLINE addSize #-}

84−

85−subtractSize :: Size -> Size -> Size

86−subtractSize (Exact m) (Exact n) = Exact (max (m-n) 0)

87−subtractSize (Exact m) (Max _) = Max m

88−subtractSize (Max m) (Exact n) = Max (max (m-n) 0)

89−subtractSize a@(Max _) (Max _) = a

90−subtractSize a@(Max _) Unknown = a

91−subtractSize _ _ = Unknown

92−{-# INLINE subtractSize #-}

93−

94−mul :: Int -> Int -> Int

95−mul m n

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

97− | otherwise = overflowError

98−{-# INLINE mul #-}

99−

100−mulSize :: Size -> Size -> Size

101−mulSize (Exact m) (Exact n) = Exact (mul m n)

102−mulSize (Exact m) (Max n) = Max (mul m n)

103−mulSize (Max m) (Exact n) = Max (mul m n)

104−mulSize (Max m) (Max n) = Max (mul m n)

105−mulSize _ _ = Unknown

106−{-# INLINE mulSize #-}

107−

108−-- | Minimum of two size hints.

109−smaller :: Size -> Size -> Size

110−smaller (Exact m) (Exact n) = Exact (m `min` n)

111−smaller (Exact m) (Max n) = Max (m `min` n)

112−smaller (Exact m) Unknown = Max m

113−smaller (Max m) (Exact n) = Max (m `min` n)

114−smaller (Max m) (Max n) = Max (m `min` n)

115−smaller a@(Max _) Unknown = a

116−smaller Unknown (Exact n) = Max n

117−smaller Unknown (Max n) = Max n

118−smaller Unknown Unknown = Unknown

119−{-# INLINE smaller #-}

120−

121−-- | Maximum of two size hints.

122−larger :: Size -> Size -> Size

123−larger (Exact m) (Exact n) = Exact (m `max` n)

124−larger a@(Exact m) b@(Max n) | m >= n = a

125− | otherwise = b

126−larger a@(Max m) b@(Exact n) | n >= m = b

127− | otherwise = a

128−larger (Max m) (Max n) = Max (m `max` n)

129−larger _ _ = Unknown

130−{-# INLINE larger #-}

131−

132−-- | Compute the maximum size from a size hint, if possible.

133−upperBound :: Int -> Size -> Int

134−upperBound _ (Exact n) = n

135−upperBound _ (Max n) = n

136−upperBound k _ = k

137−{-# INLINE upperBound #-}

138−

139−isEmpty :: Size -> Bool

140−isEmpty (Exact n) = n <= 0

141−isEmpty (Max n) = n <= 0

142−isEmpty _ = False

143−{-# INLINE isEmpty #-}

144−

145−overflowError :: Int

146−overflowError = error "Data.Text.Fusion.Size: size overflow"

Data/Text/IO.hs+42−38

@@ -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,21 +42,17 @@ 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

53−import Data.Text.Fusion (stream)

54−import Data.Text.Fusion.Internal (Step(..), Stream(..))

55−import Data.Text.IO.Internal (hGetLineWith, readChunk)

53+import Data.Text.Internal.Fusion (stream)

54+import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))

55+import Data.Text.Internal.IO (hGetLineWith, readChunk)

5656import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBufElem, CharBuffer,

5757 RawCharBuffer, emptyBuffer, isEmptyBuffer, newCharBuffer,

5858 writeCharBuf)

@@ -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/Internal.hs+102−17

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

1−{-# LANGUAGE CPP, DeriveDataTypeable #-}

1+{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples #-}

2+{-# OPTIONS_HADDOCK not-home #-}

34-- |

45-- Module : Data.Text.Internal

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

89--

910-- License : BSD-style

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

11−-- duncan@haskell.org

11+-- Maintainer : bos@serpentine.com

1212-- Stability : experimental

1313-- Portability : GHC

1414--

@@ -20,9 +20,14 @@

2020-- with the internals, as the functions here do just about nothing to

2121-- preserve data invariants. You have been warned!

2222

23+#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)

24+#include "MachDeps.h"

25+#endif

26+

2327module Data.Text.Internal

2428 (

2529 -- * Types

30+ -- $internals

2631 Text(..)

2732 -- * Construction

2833 , text

@@ -31,8 +36,13 @@ module Data.Text.Internal

3136 , safe

3237 -- * Code that must be here for accessibility

3338 , empty

39+ , empty_

3440 -- * Utilities

3541 , firstf

42+ -- * Checked multiplication

43+ , mul

44+ , mul32

45+ , mul64

3646 -- * Debugging

3747 , showText

3848 ) where

@@ -40,21 +50,22 @@ module Data.Text.Internal

4050#if defined(ASSERTS)

4151import Control.Exception (assert)

4252#endif

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

44−import qualified Data.Text.Array as A

45−import Data.Text.UnsafeChar (ord)

53+import Data.Bits

54+import Data.Int (Int32, Int64)

55+import Data.Text.Internal.Unsafe.Char (ord)

4656import Data.Typeable (Typeable)

57+import qualified Data.Text.Array as A

4758

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

4960data Text = Text

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

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

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

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

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

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

5364 deriving (Typeable)

5465

5566-- | Smart constructor.

56−text :: A.Array -> Int -> Int -> Text

57−text arr off len =

67+text_ :: A.Array -> Int -> Int -> Text

68+text_ arr off len =

5869#if defined(ASSERTS)

5970 let c = A.unsafeIndex arr off

6071 alen = A.length arr

@@ -64,19 +75,28 @@ text arr off len =

6475 assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $

6576#endif

6677 Text arr off len

67−{-# INLINE text #-}

78+{-# INLINE text_ #-}

6879

6980-- | /O(1)/ The empty 'Text'.

7081empty :: Text

7182empty = Text A.empty 0 0

7283{-# INLINE [1] empty #-}

7384

85+-- | A non-inlined version of 'empty'.

86+empty_ :: Text

87+empty_ = Text A.empty 0 0

88+{-# NOINLINE empty_ #-}

89+

7490-- | Construct a 'Text' without invisibly pinning its byte array in

7591-- memory if its length has dwindled to zero.

92+text :: A.Array -> Int -> Int -> Text

93+text arr off len | len == 0 = empty

94+ | otherwise = text_ arr off len

95+{-# INLINE text #-}

96+

7697textP :: A.Array -> Int -> Int -> Text

77−textP arr off len | len == 0 = empty

78− | otherwise = text arr off len

79−{-# INLINE textP #-}

98+{-# DEPRECATED textP "Use text instead" #-}

99+textP = text

80100

81101-- | A useful 'show'-like function for debugging purposes.

82102showText :: Text -> String

@@ -90,14 +110,79 @@ showText (Text arr off len) =

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

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

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

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

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

114+-- unchanged.

94115safe :: Char -> Char

95116safe c

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

97118 | otherwise = '\xfffd'

98−{-# INLINE safe #-}

119+{-# INLINE [0] safe #-}

99120

100121-- | Apply a function to the first element of an optional pair.

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

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

103124firstf _ Nothing = Nothing

125+

126+-- | Checked multiplication. Calls 'error' if the result would

127+-- overflow.

128+mul :: Int -> Int -> Int

129+#if WORD_SIZE_IN_BITS == 64

130+mul a b = fromIntegral $ fromIntegral a `mul64` fromIntegral b

131+#else

132+mul a b = fromIntegral $ fromIntegral a `mul32` fromIntegral b

133+#endif

134+{-# INLINE mul #-}

135+infixl 7 `mul`

136+

137+-- | Checked multiplication. Calls 'error' if the result would

138+-- overflow.

139+mul64 :: Int64 -> Int64 -> Int64

140+mul64 a b

141+ | a >= 0 && b >= 0 = mul64_ a b

142+ | a >= 0 = -mul64_ a (-b)

143+ | b >= 0 = -mul64_ (-a) b

144+ | otherwise = mul64_ (-a) (-b)

145+{-# INLINE mul64 #-}

146+infixl 7 `mul64`

147+

148+mul64_ :: Int64 -> Int64 -> Int64

149+mul64_ a b

150+ | ahi > 0 && bhi > 0 = error "overflow"

151+ | top > 0x7fffffff = error "overflow"

152+ | total < 0 = error "overflow"

153+ | otherwise = total

154+ where (# ahi, alo #) = (# a `shiftR` 32, a .&. 0xffffffff #)

155+ (# bhi, blo #) = (# b `shiftR` 32, b .&. 0xffffffff #)

156+ top = ahi * blo + alo * bhi

157+ total = (top `shiftL` 32) + alo * blo

158+{-# INLINE mul64_ #-}

159+

160+-- | Checked multiplication. Calls 'error' if the result would

161+-- overflow.

162+mul32 :: Int32 -> Int32 -> Int32

163+mul32 a b = case fromIntegral a * fromIntegral b of

164+ ab | ab < min32 || ab > max32 -> error "overflow"

165+ | otherwise -> fromIntegral ab

166+ where min32 = -0x80000000 :: Int64

167+ max32 = 0x7fffffff

168+{-# INLINE mul32 #-}

169+infixl 7 `mul32`

170+

171+-- $internals

172+--

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

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

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

176+--

177+-- Invariants that all functions must maintain:

178+--

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

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

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

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

183+-- \'�\').

184+--

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

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

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

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

Data/Text/Internal/Builder.hsnew file+329

@@ -0,0 +1,329 @@

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

2+{-# OPTIONS_HADDOCK not-home #-}

4+-----------------------------------------------------------------------------

5+-- |

6+-- Module : Data.Text.Internal.Builder

9+-- License : BSD-style (see LICENSE)

10+--

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

12+-- Stability : experimental

13+-- Portability : portable to Hugs and GHC

14+--

15+-- /Warning/: this is an internal module, and does not have a stable

16+-- API or name. Functions in this module may not check or enforce

17+-- preconditions expected by public modules. Use at your own risk!

18+--

19+-- Efficient construction of lazy @Text@ values. The principal

20+-- operations on a @Builder@ are @singleton@, @fromText@, and

21+-- @fromLazyText@, which construct new builders, and 'mappend', which

22+-- concatenates two builders.

23+--

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

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

26+-- prefer

27+--

28+-- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')

29+--

30+-- to

31+--

32+-- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'

33+--

34+-- as the latter associates @mappend@ to the left.

35+--

36+-----------------------------------------------------------------------------

37+

38+module Data.Text.Internal.Builder

39+ ( -- * Public API

40+ -- ** The Builder type

41+ Builder

42+ , toLazyText

43+ , toLazyTextWith

44+

45+ -- ** Constructing Builders

46+ , singleton

47+ , fromText

48+ , fromLazyText

49+ , fromString

50+

51+ -- ** Flushing the buffer state

52+ , flush

53+

54+ -- * Internal functions

55+ , append'

56+ , ensureFree

57+ , writeN

58+ ) where

59+

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

61+import Data.Monoid (Monoid(..))

62+#if MIN_VERSION_base(4,9,0)

63+import Data.Semigroup (Semigroup(..))

64+#endif

65+import Data.Text.Internal (Text(..))

66+import Data.Text.Internal.Lazy (smallChunkSize)

67+import Data.Text.Unsafe (inlineInterleaveST)

68+import Data.Text.Internal.Unsafe.Char (unsafeWrite)

69+import Prelude hiding (map, putChar)

70+

71+import qualified Data.String as String

72+import qualified Data.Text as S

73+import qualified Data.Text.Array as A

74+import qualified Data.Text.Lazy as L

75+

76+------------------------------------------------------------------------

77+

78+-- | A @Builder@ is an efficient way to build lazy @Text@ values.

79+-- There are several functions for constructing builders, but only one

80+-- to inspect them: to extract any data, you have to turn them into

81+-- lazy @Text@ values using @toLazyText@.

82+--

83+-- Internally, a builder constructs a lazy @Text@ by filling arrays

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

85+-- become a new chunk of the resulting lazy @Text@. All this is

86+-- hidden from the user of the @Builder@.

87+newtype Builder = Builder {

88+ -- Invariant (from Data.Text.Lazy):

89+ -- The lists include no null Texts.

90+ runBuilder :: forall s. (Buffer s -> ST s [S.Text])

91+ -> Buffer s

92+ -> ST s [S.Text]

93+ }

94+

95+#if MIN_VERSION_base(4,9,0)

96+instance Semigroup Builder where

97+ (<>) = append

98+ {-# INLINE (<>) #-}

99+#endif

100+

101+instance Monoid Builder where

102+ mempty = empty

103+ {-# INLINE mempty #-}

104+#if MIN_VERSION_base(4,9,0)

105+ mappend = (<>) -- future-proof definition

106+#else

107+ mappend = append

108+#endif

109+ {-# INLINE mappend #-}

110+ mconcat = foldr mappend Data.Monoid.mempty

111+ {-# INLINE mconcat #-}

112+

113+instance String.IsString Builder where

114+ fromString = fromString

115+ {-# INLINE fromString #-}

116+

117+instance Show Builder where

118+ show = show . toLazyText

119+

120+instance Eq Builder where

121+ a == b = toLazyText a == toLazyText b

122+

123+instance Ord Builder where

124+ a <= b = toLazyText a <= toLazyText b

125+

126+------------------------------------------------------------------------

127+

128+-- | /O(1)./ The empty @Builder@, satisfying

129+--

130+-- * @'toLazyText' 'empty' = 'L.empty'@

131+--

132+empty :: Builder

133+empty = Builder (\ k buf -> k buf)

134+{-# INLINE empty #-}

135+

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

137+--

138+-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@

139+--

140+singleton :: Char -> Builder

141+singleton c = writeAtMost 2 $ \ marr o -> unsafeWrite marr o c

142+{-# INLINE singleton #-}

143+

144+------------------------------------------------------------------------

145+

146+-- | /O(1)./ The concatenation of two builders, an associative

147+-- operation with identity 'empty', satisfying

148+--

149+-- * @'toLazyText' ('append' x y) = 'L.append' ('toLazyText' x) ('toLazyText' y)@

150+--

151+append :: Builder -> Builder -> Builder

152+append (Builder f) (Builder g) = Builder (f . g)

153+{-# INLINE [0] append #-}

154+

155+-- TODO: Experiment to find the right threshold.

156+copyLimit :: Int

157+copyLimit = 128

158+

159+-- This function attempts to merge small @Text@ values instead of

160+-- treating each value as its own chunk. We may not always want this.

161+

162+-- | /O(1)./ A @Builder@ taking a 'S.Text', satisfying

163+--

164+-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@

165+--

166+fromText :: S.Text -> Builder

167+fromText t@(Text arr off l)

168+ | S.null t = empty

169+ | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)

170+ | otherwise = flush `append` mapBuilder (t :)

171+{-# INLINE [1] fromText #-}

172+

173+{-# RULES

174+"fromText/pack" forall s .

175+ fromText (S.pack s) = fromString s

176+ #-}

177+

178+-- | /O(1)./ A Builder taking a @String@, satisfying

179+--

180+-- * @'toLazyText' ('fromString' s) = 'L.fromChunks' [S.pack s]@

181+--

182+fromString :: String -> Builder

183+fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->

184+ let loop !marr !o !u !l [] = k (Buffer marr o u l)

185+ loop marr o u l s@(c:cs)

186+ | l <= 1 = do

187+ arr <- A.unsafeFreeze marr

188+ let !t = Text arr o u

189+ marr' <- A.new chunkSize

190+ ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)

191+ return $ t : ts

192+ | otherwise = do

193+ n <- unsafeWrite marr (o+u) c

194+ loop marr o (u+n) (l-n) cs

195+ in loop p0 o0 u0 l0 str

196+ where

197+ chunkSize = smallChunkSize

198+{-# INLINE fromString #-}

199+

200+-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying

201+--

202+-- * @'toLazyText' ('fromLazyText' t) = t@

203+--

204+fromLazyText :: L.Text -> Builder

205+fromLazyText ts = flush `append` mapBuilder (L.toChunks ts ++)

206+{-# INLINE fromLazyText #-}

207+

208+------------------------------------------------------------------------

209+

210+-- Our internal buffer type

211+data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s)

212+ {-# UNPACK #-} !Int -- offset

213+ {-# UNPACK #-} !Int -- used units

214+ {-# UNPACK #-} !Int -- length left

215+

216+------------------------------------------------------------------------

217+

218+-- | /O(n)./ Extract a lazy @Text@ from a @Builder@ with a default

219+-- buffer size. The construction work takes place if and when the

220+-- relevant part of the lazy @Text@ is demanded.

221+toLazyText :: Builder -> L.Text

222+toLazyText = toLazyTextWith smallChunkSize

223+

224+-- | /O(n)./ Extract a lazy @Text@ from a @Builder@, using the given

225+-- size for the initial buffer. The construction work takes place if

226+-- and when the relevant part of the lazy @Text@ is demanded.

227+--

228+-- If the initial buffer is too small to hold all data, subsequent

229+-- buffers will be the default buffer size.

230+toLazyTextWith :: Int -> Builder -> L.Text

231+toLazyTextWith chunkSize m = L.fromChunks (runST $

232+ newBuffer chunkSize >>= runBuilder (m `append` flush) (const (return [])))

233+

234+-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,

235+-- yielding a new chunk in the result lazy @Text@.

236+flush :: Builder

237+flush = Builder $ \ k buf@(Buffer p o u l) ->

238+ if u == 0

239+ then k buf

240+ else do arr <- A.unsafeFreeze p

241+ let !b = Buffer p (o+u) 0 l

242+ !t = Text arr o u

243+ ts <- inlineInterleaveST (k b)

244+ return $! t : ts

245+{-# INLINE [1] flush #-}

246+-- defer inlining so that flush/flush rule may fire.

247+

248+------------------------------------------------------------------------

249+

250+-- | Sequence an ST operation on the buffer

251+withBuffer :: (forall s. Buffer s -> ST s (Buffer s)) -> Builder

252+withBuffer f = Builder $ \k buf -> f buf >>= k

253+{-# INLINE withBuffer #-}

254+

255+-- | Get the size of the buffer

256+withSize :: (Int -> Builder) -> Builder

257+withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->

258+ runBuilder (f l) k buf

259+{-# INLINE withSize #-}

260+

261+-- | Map the resulting list of texts.

262+mapBuilder :: ([S.Text] -> [S.Text]) -> Builder

263+mapBuilder f = Builder (fmap f .)

264+

265+------------------------------------------------------------------------

266+

267+-- | Ensure that there are at least @n@ many elements available.

268+ensureFree :: Int -> Builder

269+ensureFree !n = withSize $ \ l ->

270+ if n <= l

271+ then empty

272+ else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize)))

273+{-# INLINE [0] ensureFree #-}

274+

275+writeAtMost :: Int -> (forall s. A.MArray s -> Int -> ST s Int) -> Builder

276+writeAtMost n f = ensureFree n `append'` withBuffer (writeBuffer f)

277+{-# INLINE [0] writeAtMost #-}

278+

279+-- | Ensure that @n@ many elements are available, and then use @f@ to

280+-- write some elements into the memory.

281+writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder

282+writeN n f = writeAtMost n (\ p o -> f p o >> return n)

283+{-# INLINE writeN #-}

284+

285+writeBuffer :: (A.MArray s -> Int -> ST s Int) -> Buffer s -> ST s (Buffer s)

286+writeBuffer f (Buffer p o u l) = do

287+ n <- f p (o+u)

288+ return $! Buffer p o (u+n) (l-n)

289+{-# INLINE writeBuffer #-}

290+

291+newBuffer :: Int -> ST s (Buffer s)

292+newBuffer size = do

293+ arr <- A.new size

294+ return $! Buffer arr 0 0 size

295+{-# INLINE newBuffer #-}

296+

297+------------------------------------------------------------------------

298+-- Some nice rules for Builder

299+

300+-- This function makes GHC understand that 'writeN' and 'ensureFree'

301+-- are *not* recursive in the precense of the rewrite rules below.

302+-- This is not needed with GHC 7+.

303+append' :: Builder -> Builder -> Builder

304+append' (Builder f) (Builder g) = Builder (f . g)

305+{-# INLINE append' #-}

306+

307+{-# RULES

308+

309+"append/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)

310+ (g::forall s. A.MArray s -> Int -> ST s Int) ws.

311+ append (writeAtMost a f) (append (writeAtMost b g) ws) =

312+ append (writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->

313+ g marr (o+n) >>= \ m ->

314+ let s = n+m in s `seq` return s)) ws

315+

316+"writeAtMost/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)

317+ (g::forall s. A.MArray s -> Int -> ST s Int).

318+ append (writeAtMost a f) (writeAtMost b g) =

319+ writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->

320+ g marr (o+n) >>= \ m ->

321+ let s = n+m in s `seq` return s)

322+

323+"ensureFree/ensureFree" forall a b .

324+ append (ensureFree a) (ensureFree b) = ensureFree (max a b)

325+

326+"flush/flush"

327+ append flush flush = flush

328+

329+ #-}

Data/Text/Lazy/Builder/Functions.hs → Data/Text/Internal/Builder/Functions.hsrenamed+8−3

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

11{-# LANGUAGE MagicHash #-}

33-- |

4−-- Module : Data.Text.Lazy.Builder.Functions

4+-- Module : Data.Text.Internal.Builder.Functions

66--

77-- License : BSD-style

@@ -9,9 +9,13 @@

99-- Stability : experimental

1010-- Portability : GHC

1111--

12+-- /Warning/: this is an internal module, and does not have a stable

13+-- API or name. Functions in this module may not check or enforce

14+-- preconditions expected by public modules. Use at your own risk!

15+--

1216-- Useful functions and combinators.

1317

14−module Data.Text.Lazy.Builder.Functions

18+module Data.Text.Internal.Builder.Functions

1519 (

1620 (<>)

1721 , i2d

@@ -19,7 +23,8 @@ module Data.Text.Lazy.Builder.Functions

1923

2024import Data.Monoid (mappend)

2125import Data.Text.Lazy.Builder (Builder)

22−import GHC.Base

26+import GHC.Base (chr#,ord#,(+#),Int(I#),Char(C#))

27+import Prelude ()

2328

2429-- | Unsafe conversion for decimal digits.

2530{-# INLINE i2d #-}

Data/Text/Internal/Builder/Int/Digits.hsnew file+26

@@ -0,0 +1,26 @@

1+{-# LANGUAGE OverloadedStrings #-}

3+-- Module: Data.Text.Internal.Builder.Int.Digits

5+-- License: BSD-style

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

7+-- Stability: experimental

8+-- Portability: portable

9+--

10+-- /Warning/: this is an internal module, and does not have a stable

11+-- API or name. Functions in this module may not check or enforce

12+-- preconditions expected by public modules. Use at your own risk!

13+--

14+-- This module exists because the C preprocessor does things that we

15+-- shall not speak of when confronted with Haskell multiline strings.

16+

17+module Data.Text.Internal.Builder.Int.Digits (digits) where

18+

19+import Data.ByteString.Char8 (ByteString)

20+

21+digits :: ByteString

22+digits = "0001020304050607080910111213141516171819\

23+ \2021222324252627282930313233343536373839\

24+ \4041424344454647484950515253545556575859\

25+ \6061626364656667686970717273747576777879\

26+ \8081828384858687888990919293949596979899"

Data/Text/Internal/Builder/RealFloat/Functions.hsnew file+57

@@ -0,0 +1,57 @@

1+{-# LANGUAGE CPP #-}

3+-- |

4+-- Module: Data.Text.Internal.Builder.RealFloat.Functions

5+-- Copyright: (c) The University of Glasgow 1994-2002

6+-- License: see libraries/base/LICENSE

7+--

8+-- /Warning/: this is an internal module, and does not have a stable

9+-- API or name. Functions in this module may not check or enforce

10+-- preconditions expected by public modules. Use at your own risk!

11+

12+module Data.Text.Internal.Builder.RealFloat.Functions

13+ (

14+ roundTo

15+ ) where

16+

17+roundTo :: Int -> [Int] -> (Int,[Int])

18+

19+#if MIN_VERSION_base(4,6,0)

20+

21+roundTo d is =

22+ case f d True is of

23+ x@(0,_) -> x

24+ (1,xs) -> (1, 1:xs)

25+ _ -> error "roundTo: bad Value"

26+ where

27+ b2 = base `quot` 2

28+

29+ f n _ [] = (0, replicate n 0)

30+ f 0 e (x:xs) | x == b2 && e && all (== 0) xs = (0, []) -- Round to even when at exactly half the base

31+ | otherwise = (if x >= b2 then 1 else 0, [])

32+ f n _ (i:xs)

33+ | i' == base = (1,0:ds)

34+ | otherwise = (0,i':ds)

35+ where

36+ (c,ds) = f (n-1) (even i) xs

37+ i' = c + i

38+ base = 10

39+

40+#else

41+

42+roundTo d is =

43+ case f d is of

44+ x@(0,_) -> x

45+ (1,xs) -> (1, 1:xs)

46+ _ -> error "roundTo: bad Value"

47+ where

48+ f n [] = (0, replicate n 0)

49+ f 0 (x:_) = (if x >= 5 then 1 else 0, [])

50+ f n (i:xs)

51+ | i' == 10 = (1,0:ds)

52+ | otherwise = (0,i':ds)

53+ where

54+ (c,ds) = f (n-1) xs

55+ i' = c + i

56+

57+#endif

Data/Text/Encoding/Fusion.hs → Data/Text/Internal/Encoding/Fusion.hsrenamed+19−16

@@ -1,21 +1,24 @@

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

33-- |

4−-- Module : Data.Text.Encoding.Fusion

4+-- Module : Data.Text.Internal.Encoding.Fusion

55-- Copyright : (c) Tom Harper 2008-2009,

66-- (c) Bryan O'Sullivan 2009,

77-- (c) Duncan Coutts 2009

88--

99-- License : BSD-style

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

11−-- duncan@haskell.org

10+-- Maintainer : bos@serpentine.com

1211-- Stability : experimental

1312-- Portability : portable

1413--

14+-- /Warning/: this is an internal module, and does not have a stable

15+-- API or name. Functions in this module may not check or enforce

16+-- preconditions expected by public modules. Use at your own risk!

17+--

1518-- Fusible 'Stream'-oriented functions for converting between 'Text'

1619-- and several common encodings.

1720

18−module Data.Text.Encoding.Fusion

21+module Data.Text.Internal.Encoding.Fusion

1922 (

2023 -- * Streaming

2124 streamASCII

@@ -28,28 +31,28 @@ module Data.Text.Encoding.Fusion

2831 -- * Unstreaming

2932 , unstream

3033

31− , module Data.Text.Encoding.Fusion.Common

34+ , module Data.Text.Internal.Encoding.Fusion.Common

3235 ) where

3336

3437#if defined(ASSERTS)

3538import Control.Exception (assert)

3639#endif

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

38−import Data.Text.Fusion (Step(..), Stream(..))

39−import Data.Text.Fusion.Size

41+import Data.Text.Internal.Fusion (Step(..), Stream(..))

42+import Data.Text.Internal.Fusion.Size

4043import Data.Text.Encoding.Error

41−import Data.Text.Encoding.Fusion.Common

42−import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)

43−import Data.Text.UnsafeShift (shiftL, shiftR)

44+import Data.Text.Internal.Encoding.Fusion.Common

45+import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)

46+import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)

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

4548import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)

4649import Foreign.Storable (pokeByteOff)

47−import System.IO.Unsafe (unsafePerformIO)

4850import qualified Data.ByteString as B

4951import qualified Data.ByteString.Unsafe as B

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

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

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

52+import qualified Data.Text.Internal.Encoding.Utf8 as U8

53+import qualified Data.Text.Internal.Encoding.Utf16 as U16

54+import qualified Data.Text.Internal.Encoding.Utf32 as U32

55+import Data.Text.Unsafe (unsafeDupablePerformIO)

5356

5457streamASCII :: ByteString -> Stream Char

5558streamASCII bs = Stream next 0 (maxSize l)

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

163166

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

165168unstream :: Stream Word8 -> ByteString

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

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

167170 let mlen = upperBound 4 len

168171 mallocByteString mlen >>= loop mlen 0 s0

169172 where

@@ -201,5 +204,5 @@ decodeError func kind onErr mb i =

201204 case onErr desc mb of

202205 Nothing -> Skip i

203206 Just c -> Yield c i

204− where desc = "Data.Text.Encoding.Fusion." ++ func ++ ": Invalid " ++

207+ where desc = "Data.Text.Internal.Encoding.Fusion." ++ func ++ ": Invalid " ++

205208 kind ++ " stream"

Data/Text/Internal/Encoding/Fusion/Common.hsnew file+123

@@ -0,0 +1,123 @@

1+{-# LANGUAGE BangPatterns #-}

3+-- |

4+-- Module : Data.Text.Internal.Encoding.Fusion.Common

5+-- Copyright : (c) Tom Harper 2008-2009,

6+-- (c) Bryan O'Sullivan 2009,

7+-- (c) Duncan Coutts 2009,

8+-- (c) Jasper Van der Jeugt 2011

9+--

10+-- License : BSD-style

11+-- Maintainer : bos@serpentine.com

12+-- Stability : experimental

13+-- Portability : portable

14+--

15+-- /Warning/: this is an internal module, and does not have a stable

16+-- API or name. Use at your own risk!

17+--

18+-- Fusible 'Stream'-oriented functions for converting between 'Text'

19+-- and several common encodings.

20+

21+module Data.Text.Internal.Encoding.Fusion.Common

22+ (

23+ -- * Restreaming

24+ -- Restreaming is the act of converting from one 'Stream'

25+ -- representation to another.

26+ restreamUtf16LE

27+ , restreamUtf16BE

28+ , restreamUtf32LE

29+ , restreamUtf32BE

30+ ) where

31+

32+import Data.Bits ((.&.))

33+import Data.Text.Internal.Fusion (Step(..), Stream(..))

34+import Data.Text.Internal.Fusion.Types (RS(..))

35+import Data.Text.Internal.Unsafe.Char (ord)

36+import Data.Text.Internal.Unsafe.Shift (shiftR)

37+import Data.Word (Word8)

38+

39+restreamUtf16BE :: Stream Char -> Stream Word8

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

41+ where

42+ next (RS0 s) = case next0 s of

43+ Done -> Done

44+ Skip s' -> Skip (RS0 s')

45+ Yield x s'

46+ | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $

47+ RS1 s' (fromIntegral n)

48+ | otherwise -> Yield c1 $ RS3 s' c2 c3 c4

49+ where

50+ n = ord x

51+ n1 = n - 0x10000

52+ c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)

53+ c2 = fromIntegral (n1 `shiftR` 10)

54+ n2 = n1 .&. 0x3FF

55+ c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)

56+ c4 = fromIntegral n2

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

62+

63+restreamUtf16LE :: Stream Char -> Stream Word8

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

65+ where

66+ next (RS0 s) = case next0 s of

67+ Done -> Done

68+ Skip s' -> Skip (RS0 s')

69+ Yield x s'

70+ | n < 0x10000 -> Yield (fromIntegral n) $

71+ RS1 s' (fromIntegral $ shiftR n 8)

72+ | otherwise -> Yield c1 $ RS3 s' c2 c3 c4

73+ where

74+ n = ord x

75+ n1 = n - 0x10000

76+ c2 = fromIntegral (shiftR n1 18 + 0xD8)

77+ c1 = fromIntegral (shiftR n1 10)

78+ n2 = n1 .&. 0x3FF

79+ c4 = fromIntegral (shiftR n2 8 + 0xDC)

80+ c3 = fromIntegral n2

81+ next (RS1 s x2) = Yield x2 (RS0 s)

82+ next (RS2 s x2 x3) = Yield x2 (RS1 s x3)

83+ next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)

84+ {-# INLINE next #-}

85+{-# INLINE restreamUtf16LE #-}

86+

87+restreamUtf32BE :: Stream Char -> Stream Word8

88+restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

89+ where

90+ next (RS0 s) = case next0 s of

91+ Done -> Done

92+ Skip s' -> Skip (RS0 s')

93+ Yield x s' -> Yield c1 (RS3 s' c2 c3 c4)

94+ where

95+ n = ord x

96+ c1 = fromIntegral $ shiftR n 24

97+ c2 = fromIntegral $ shiftR n 16

98+ c3 = fromIntegral $ shiftR n 8

99+ c4 = fromIntegral n

100+ next (RS1 s x2) = Yield x2 (RS0 s)

101+ next (RS2 s x2 x3) = Yield x2 (RS1 s x3)

102+ next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)

103+ {-# INLINE next #-}

104+{-# INLINE restreamUtf32BE #-}

105+

106+restreamUtf32LE :: Stream Char -> Stream Word8

107+restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

108+ where

109+ next (RS0 s) = case next0 s of

110+ Done -> Done

111+ Skip s' -> Skip (RS0 s')

112+ Yield x s' -> Yield c1 (RS3 s' c2 c3 c4)

113+ where

114+ n = ord x

115+ c4 = fromIntegral $ shiftR n 24

116+ c3 = fromIntegral $ shiftR n 16

117+ c2 = fromIntegral $ shiftR n 8

118+ c1 = fromIntegral n

119+ next (RS1 s x2) = Yield x2 (RS0 s)

120+ next (RS2 s x2 x3) = Yield x2 (RS1 s x3)

121+ next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)

122+ {-# INLINE next #-}

123+{-# INLINE restreamUtf32LE #-}

Data/Text/Encoding/Utf16.hs → Data/Text/Internal/Encoding/Utf16.hsrenamed+7−4

@@ -1,19 +1,22 @@

11{-# LANGUAGE MagicHash, BangPatterns #-}

33-- |

4−-- Module : Data.Text.Encoding.Utf16

4+-- Module : Data.Text.Internal.Encoding.Utf16

88--

99-- License : BSD-style

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

11−-- duncan@haskell.org

10+-- Maintainer : bos@serpentine.com

1211-- Stability : experimental

1312-- Portability : GHC

1413--

14+-- /Warning/: this is an internal module, and does not have a stable

15+-- API or name. Functions in this module may not check or enforce

16+-- preconditions expected by public modules. Use at your own risk!

17+--

1518-- Basic UTF-16 validation and character manipulation.

16−module Data.Text.Encoding.Utf16

19+module Data.Text.Internal.Encoding.Utf16

1720 (

1821 chr2

1922 , validate1

Data/Text/Encoding/Utf32.hs → Data/Text/Internal/Encoding/Utf32.hsrenamed+7−4

@@ -1,17 +1,20 @@

11-- |

2−-- Module : Data.Text.Encoding.Utf32

2+-- Module : Data.Text.Internal.Encoding.Utf32

66--

77-- License : BSD-style

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

9−-- duncan@haskell.org

8+-- Maintainer : bos@serpentine.com

109-- Stability : experimental

1110-- Portability : portable

1211--

12+-- /Warning/: this is an internal module, and does not have a stable

13+-- API or name. Functions in this module may not check or enforce

14+-- preconditions expected by public modules. Use at your own risk!

15+--

1316-- Basic UTF-32 validation.

14−module Data.Text.Encoding.Utf32

17+module Data.Text.Internal.Encoding.Utf32

1518 (

1619 validate

1720 ) where

Data/Text/Encoding/Utf8.hs → Data/Text/Internal/Encoding/Utf8.hsrenamed+14−7

@@ -1,19 +1,22 @@

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

33-- |

4−-- Module : Data.Text.Encoding.Utf8

4+-- Module : Data.Text.Internal.Encoding.Utf8

88--

99-- License : BSD-style

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

11−-- duncan@haskell.org

10+-- Maintainer : bos@serpentine.com

1211-- Stability : experimental

1312-- Portability : GHC

1413--

14+-- /Warning/: this is an internal module, and does not have a stable

15+-- API or name. Functions in this module may not check or enforce

16+-- preconditions expected by public modules. Use at your own risk!

17+--

1518-- Basic UTF-8 validation and character manipulation.

16−module Data.Text.Encoding.Utf8

19+module Data.Text.Internal.Encoding.Utf8

1720 (

1821 -- Decomposition

1922 ord2

@@ -30,12 +33,16 @@ module Data.Text.Encoding.Utf8

3033 , validate4

3134 ) where

3235

36+#if defined(TEST_SUITE)

37+# undef ASSERTS

38+#endif

39+

3340#if defined(ASSERTS)

3441import Control.Exception (assert)

3542#endif

3643import Data.Bits ((.&.))

37−import Data.Text.UnsafeChar (ord)

38−import Data.Text.UnsafeShift (shiftR)

44+import Data.Text.Internal.Unsafe.Char (ord)

45+import Data.Text.Internal.Unsafe.Shift (shiftR)

3946import GHC.Exts

4047import GHC.Word (Word8(..))

4148

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

146153validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool

147154{-# INLINE validate4 #-}

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

149− where

156+ where

150157 validate4_1 = x1 == 0xF0 &&

151158 between x2 0x90 0xBF &&

152159 between x3 0x80 0xBF &&

Data/Text/Util.hs → Data/Text/Internal/Functions.hsrenamed+6−2

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

11{-# LANGUAGE CPP, DeriveDataTypeable #-}

33-- |

4−-- Module : Data.Text.Util

4+-- Module : Data.Text.Internal.Functions

55-- Copyright : 2010 Bryan O'Sullivan

66--

77-- License : BSD-style

@@ -9,9 +9,13 @@

99-- Stability : experimental

1010-- Portability : GHC

1111--

12+-- /Warning/: this is an internal module, and does not have a stable

13+-- API or name. Functions in this module may not check or enforce

14+-- preconditions expected by public modules. Use at your own risk!

15+--

1216-- Useful functions.

1317

14−module Data.Text.Util

18+module Data.Text.Internal.Functions

1519 (

1620 intersperse

1721 ) where

Data/Text/Fusion.hs → Data/Text/Internal/Fusion.hsrenamed+58−45

@@ -1,20 +1,23 @@

11{-# LANGUAGE BangPatterns, MagicHash #-}

33-- |

4−-- Module : Data.Text.Fusion

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

55-- Copyright : (c) Tom Harper 2008-2009,

66-- (c) Bryan O'Sullivan 2009-2010,

77-- (c) Duncan Coutts 2009

88--

99-- License : BSD-style

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

11−-- duncan@haskell.org

10+-- Maintainer : bos@serpentine.com

1211-- Stability : experimental

1312-- Portability : GHC

1413--

14+-- /Warning/: this is an internal module, and does not have a stable

15+-- API or name. Functions in this module may not check or enforce

16+-- preconditions expected by public modules. Use at your own risk!

17+--

1518-- Text manipulation functions represented as fusible operations over

1619-- streams.

17−module Data.Text.Fusion

20+module Data.Text.Internal.Fusion

1821 (

1922 -- * Types

2023 Stream(..)

@@ -51,21 +54,21 @@ import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,

5154 fromIntegral, otherwise)

5255import Data.Bits ((.&.))

5356import Data.Text.Internal (Text(..))

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

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

57+import Data.Text.Internal.Private (runText)

58+import Data.Text.Internal.Unsafe.Char (ord, unsafeChr, unsafeWrite)

59+import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)

5660import qualified Data.Text.Array as A

57−import qualified Data.Text.Fusion.Common as S

58−import Data.Text.Fusion.Internal

59−import Data.Text.Fusion.Size

61+import qualified Data.Text.Internal.Fusion.Common as S

62+import Data.Text.Internal.Fusion.Types

63+import Data.Text.Internal.Fusion.Size

6064import qualified Data.Text.Internal as I

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

62−import qualified Prelude as P

65+import qualified Data.Text.Internal.Encoding.Utf16 as U16

6366

6467default(Int)

6568

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

6770stream :: Text -> Stream Char

68−stream (Text arr off len) = Stream next off (maxSize len)

71+stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)

6972 where

7073 !end = off+len

7174 next !i

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

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

8184-- backwards.

8285reverseStream :: Text -> Stream Char

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

86+reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `shiftR` 1) len)

8487 where

8588 {-# INLINE next #-}

8689 next !i

@@ -94,26 +97,36 @@ reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)

9497

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

9699unstream :: 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

103− loop !s !i =

104− case next0 s of

105− Done -> return (arr, i)

106− Skip s' -> loop s' i

107− Yield x s'

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

109− let top' = (top + 1) `shiftL` 1

110− arr' <- A.new top'

111− A.copyM arr' 0 arr 0 top

112− outer arr' top' s i

113− | otherwise -> do d <- unsafeWrite arr i x

114− loop s' (i+d)

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

116− | otherwise = i + 1

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

101+ -- Before encoding each char we perform a buffer realloc check assuming

102+ -- worst case encoding size of two 16-bit units for the char. Just add an

103+ -- extra space to the buffer so that we do not end up reallocating even when

104+ -- all the chars are encoded as single unit.

105+ let mlen = upperBound 4 len + 1

106+ arr0 <- A.new mlen

107+ let outer !arr !maxi = encode

108+ where

109+ -- keep the common case loop as small as possible

110+ encode !si !di =

111+ case next0 si of

112+ Done -> done arr di

113+ Skip si' -> encode si' di

114+ Yield c si'

115+ -- simply check for the worst case

116+ | maxi < di + 1 -> realloc si di

117+ | otherwise -> do

118+ n <- unsafeWrite arr di c

119+ encode si' (di + n)

120+

121+ -- keep uncommon case separate from the common case code

122+ {-# NOINLINE realloc #-}

123+ realloc !si !di = do

124+ let newlen = (maxi + 1) * 2

125+ arr' <- A.new newlen

126+ A.copyM arr' 0 arr 0 di

127+ outer arr' (newlen - 1) si di

128+

129+ outer arr0 (mlen - 1) s0 0

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

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

119132

@@ -129,7 +142,7 @@ length = S.lengthI

129142reverse :: Stream Char -> Text

130143reverse (Stream next s len0)

131144 | isEmpty len0 = I.empty

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

145+ | otherwise = I.text arr off' len'

133146 where

134147 len0' = upperBound 4 (larger len0 4)

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

@@ -163,15 +176,15 @@ reverse (Stream next s len0)

163176-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with

164177-- the input and result reversed.

165178reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

166−reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low

179+reverseScanr f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low

167180 where

168181 {-# INLINE next #-}

169− next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)

170− next (S2 :*: z :*: s) = case next0 s of

171− Yield x s' -> let !x' = f x z

172− in Yield x' (S2 :*: x' :*: s')

173− Skip s' -> Skip (S2 :*: z :*: s')

174− Done -> Done

182+ next (Scan1 z s) = Yield z (Scan2 z s)

183+ next (Scan2 z s) = case next0 s of

184+ Yield x s' -> let !x' = f x z

185+ in Yield x' (Scan2 x' s')

186+ Skip s' -> Skip (Scan2 z s')

187+ Done -> Done

175188{-# INLINE reverseScanr #-}

176189

177190-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed

@@ -207,7 +220,7 @@ countChar = S.countCharI

207220-- function to each element of a 'Text', passing an accumulating

208221-- parameter from left to right, and returns a final 'Text'.

209222mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)

210−mapAccumL f z0 (Stream next0 s0 len) = (nz,I.textP na 0 nl)

223+mapAccumL f z0 (Stream next0 s0 len) = (nz, I.text na 0 nl)

211224 where

212225 (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)

213226 where mlen = upperBound 4 len

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

223236 arr' <- A.new top'

224237 A.copyM arr' 0 arr 0 top

225238 outer arr' top' z s i

226− | otherwise -> do let (z',c) = f z x

227− d <- unsafeWrite arr i c

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

228240 loop z' s' (i+d)

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

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

242+ j | ord c < 0x10000 = i

230243 | otherwise = i + 1

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

Data/Text/Fusion/CaseMapping.hs → Data/Text/Internal/Fusion/CaseMapping.hsrenamed+392−6

@@ -1,12 +1,17 @@

11{-# LANGUAGE Rank2Types #-}

22-- AUTOMATICALLY GENERATED - DO NOT EDIT

3−-- Generated by scripts/SpecialCasing.hs

4−module Data.Text.Fusion.CaseMapping where

3+-- Generated by scripts/CaseMapping.hs

4+-- CaseFolding-8.0.0.txt

5+-- Date: 2015-01-13, 18:16:36 GMT [MD]

6+-- SpecialCasing-8.0.0.txt

7+-- Date: 2014-12-16, 23:08:04 GMT [MD]

9+module Data.Text.Internal.Fusion.CaseMapping where

510import Data.Char

6−import Data.Text.Fusion.Internal

11+import Data.Text.Internal.Fusion.Types

712

813upperMapping :: forall s. Char -> s -> Step (CC s) Char

9−{-# INLINE upperMapping #-}

14+{-# NOINLINE upperMapping #-}

1015-- LATIN SMALL LETTER SHARP S

1116upperMapping '\x00df' s = Yield '\x0053' (CC s '\x0053' '\x0000')

1217-- LATIN SMALL LIGATURE FF

@@ -213,12 +218,111 @@ upperMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0399')

213218upperMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0399')

214219upperMapping c s = Yield (toUpper c) (CC s '\0' '\0')

215220lowerMapping :: forall s. Char -> s -> Step (CC s) Char

216−{-# INLINE lowerMapping #-}

221+{-# NOINLINE lowerMapping #-}

217222-- LATIN CAPITAL LETTER I WITH DOT ABOVE

218223lowerMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')

219224lowerMapping c s = Yield (toLower c) (CC s '\0' '\0')

225+titleMapping :: forall s. Char -> s -> Step (CC s) Char

226+{-# NOINLINE titleMapping #-}

227+-- LATIN SMALL LETTER SHARP S

228+titleMapping '\x00df' s = Yield '\x0053' (CC s '\x0073' '\x0000')

229+-- LATIN SMALL LIGATURE FF

230+titleMapping '\xfb00' s = Yield '\x0046' (CC s '\x0066' '\x0000')

231+-- LATIN SMALL LIGATURE FI

232+titleMapping '\xfb01' s = Yield '\x0046' (CC s '\x0069' '\x0000')

233+-- LATIN SMALL LIGATURE FL

234+titleMapping '\xfb02' s = Yield '\x0046' (CC s '\x006c' '\x0000')

235+-- LATIN SMALL LIGATURE FFI

236+titleMapping '\xfb03' s = Yield '\x0046' (CC s '\x0066' '\x0069')

237+-- LATIN SMALL LIGATURE FFL

238+titleMapping '\xfb04' s = Yield '\x0046' (CC s '\x0066' '\x006c')

239+-- LATIN SMALL LIGATURE LONG S T

240+titleMapping '\xfb05' s = Yield '\x0053' (CC s '\x0074' '\x0000')

241+-- LATIN SMALL LIGATURE ST

242+titleMapping '\xfb06' s = Yield '\x0053' (CC s '\x0074' '\x0000')

243+-- ARMENIAN SMALL LIGATURE ECH YIWN

244+titleMapping '\x0587' s = Yield '\x0535' (CC s '\x0582' '\x0000')

245+-- ARMENIAN SMALL LIGATURE MEN NOW

246+titleMapping '\xfb13' s = Yield '\x0544' (CC s '\x0576' '\x0000')

247+-- ARMENIAN SMALL LIGATURE MEN ECH

248+titleMapping '\xfb14' s = Yield '\x0544' (CC s '\x0565' '\x0000')

249+-- ARMENIAN SMALL LIGATURE MEN INI

250+titleMapping '\xfb15' s = Yield '\x0544' (CC s '\x056b' '\x0000')

251+-- ARMENIAN SMALL LIGATURE VEW NOW

252+titleMapping '\xfb16' s = Yield '\x054e' (CC s '\x0576' '\x0000')

253+-- ARMENIAN SMALL LIGATURE MEN XEH

254+titleMapping '\xfb17' s = Yield '\x0544' (CC s '\x056d' '\x0000')

255+-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE

256+titleMapping '\x0149' s = Yield '\x02bc' (CC s '\x004e' '\x0000')

257+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS

258+titleMapping '\x0390' s = Yield '\x0399' (CC s '\x0308' '\x0301')

259+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS

260+titleMapping '\x03b0' s = Yield '\x03a5' (CC s '\x0308' '\x0301')

261+-- LATIN SMALL LETTER J WITH CARON

262+titleMapping '\x01f0' s = Yield '\x004a' (CC s '\x030c' '\x0000')

263+-- LATIN SMALL LETTER H WITH LINE BELOW

264+titleMapping '\x1e96' s = Yield '\x0048' (CC s '\x0331' '\x0000')

265+-- LATIN SMALL LETTER T WITH DIAERESIS

266+titleMapping '\x1e97' s = Yield '\x0054' (CC s '\x0308' '\x0000')

267+-- LATIN SMALL LETTER W WITH RING ABOVE

268+titleMapping '\x1e98' s = Yield '\x0057' (CC s '\x030a' '\x0000')

269+-- LATIN SMALL LETTER Y WITH RING ABOVE

270+titleMapping '\x1e99' s = Yield '\x0059' (CC s '\x030a' '\x0000')

271+-- LATIN SMALL LETTER A WITH RIGHT HALF RING

272+titleMapping '\x1e9a' s = Yield '\x0041' (CC s '\x02be' '\x0000')

273+-- GREEK SMALL LETTER UPSILON WITH PSILI

274+titleMapping '\x1f50' s = Yield '\x03a5' (CC s '\x0313' '\x0000')

275+-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA

276+titleMapping '\x1f52' s = Yield '\x03a5' (CC s '\x0313' '\x0300')

277+-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA

278+titleMapping '\x1f54' s = Yield '\x03a5' (CC s '\x0313' '\x0301')

279+-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI

280+titleMapping '\x1f56' s = Yield '\x03a5' (CC s '\x0313' '\x0342')

281+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI

282+titleMapping '\x1fb6' s = Yield '\x0391' (CC s '\x0342' '\x0000')

283+-- GREEK SMALL LETTER ETA WITH PERISPOMENI

284+titleMapping '\x1fc6' s = Yield '\x0397' (CC s '\x0342' '\x0000')

285+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA

286+titleMapping '\x1fd2' s = Yield '\x0399' (CC s '\x0308' '\x0300')

287+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA

288+titleMapping '\x1fd3' s = Yield '\x0399' (CC s '\x0308' '\x0301')

289+-- GREEK SMALL LETTER IOTA WITH PERISPOMENI

290+titleMapping '\x1fd6' s = Yield '\x0399' (CC s '\x0342' '\x0000')

291+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI

292+titleMapping '\x1fd7' s = Yield '\x0399' (CC s '\x0308' '\x0342')

293+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA

294+titleMapping '\x1fe2' s = Yield '\x03a5' (CC s '\x0308' '\x0300')

295+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA

296+titleMapping '\x1fe3' s = Yield '\x03a5' (CC s '\x0308' '\x0301')

297+-- GREEK SMALL LETTER RHO WITH PSILI

298+titleMapping '\x1fe4' s = Yield '\x03a1' (CC s '\x0313' '\x0000')

299+-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI

300+titleMapping '\x1fe6' s = Yield '\x03a5' (CC s '\x0342' '\x0000')

301+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI

302+titleMapping '\x1fe7' s = Yield '\x03a5' (CC s '\x0308' '\x0342')

303+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI

304+titleMapping '\x1ff6' s = Yield '\x03a9' (CC s '\x0342' '\x0000')

305+-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI

306+titleMapping '\x1fb2' s = Yield '\x1fba' (CC s '\x0345' '\x0000')

307+-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI

308+titleMapping '\x1fb4' s = Yield '\x0386' (CC s '\x0345' '\x0000')

309+-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI

310+titleMapping '\x1fc2' s = Yield '\x1fca' (CC s '\x0345' '\x0000')

311+-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI

312+titleMapping '\x1fc4' s = Yield '\x0389' (CC s '\x0345' '\x0000')

313+-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI

314+titleMapping '\x1ff2' s = Yield '\x1ffa' (CC s '\x0345' '\x0000')

315+-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI

316+titleMapping '\x1ff4' s = Yield '\x038f' (CC s '\x0345' '\x0000')

317+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI

318+titleMapping '\x1fb7' s = Yield '\x0391' (CC s '\x0342' '\x0345')

319+-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI

320+titleMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0345')

321+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI

322+titleMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0345')

323+titleMapping c s = Yield (toTitle c) (CC s '\0' '\0')

220324foldMapping :: forall s. Char -> s -> Step (CC s) Char

221−{-# INLINE foldMapping #-}

325+{-# NOINLINE foldMapping #-}

222326-- MICRO SIGN

223327foldMapping '\x00b5' s = Yield '\x03bc' (CC s '\x0000' '\x0000')

224328-- LATIN SMALL LETTER SHARP S

@@ -255,6 +359,18 @@ foldMapping '\x03f1' s = Yield '\x03c1' (CC s '\x0000' '\x0000')

255359foldMapping '\x03f5' s = Yield '\x03b5' (CC s '\x0000' '\x0000')

256360-- ARMENIAN SMALL LIGATURE ECH YIWN

257361foldMapping '\x0587' s = Yield '\x0565' (CC s '\x0582' '\x0000')

362+-- CHEROKEE SMALL LETTER YE

363+foldMapping '\x13f8' s = Yield '\x13f0' (CC s '\x0000' '\x0000')

364+-- CHEROKEE SMALL LETTER YI

365+foldMapping '\x13f9' s = Yield '\x13f1' (CC s '\x0000' '\x0000')

366+-- CHEROKEE SMALL LETTER YO

367+foldMapping '\x13fa' s = Yield '\x13f2' (CC s '\x0000' '\x0000')

368+-- CHEROKEE SMALL LETTER YU

369+foldMapping '\x13fb' s = Yield '\x13f3' (CC s '\x0000' '\x0000')

370+-- CHEROKEE SMALL LETTER YV

371+foldMapping '\x13fc' s = Yield '\x13f4' (CC s '\x0000' '\x0000')

372+-- CHEROKEE SMALL LETTER MV

373+foldMapping '\x13fd' s = Yield '\x13f5' (CC s '\x0000' '\x0000')

258374-- LATIN SMALL LETTER H WITH LINE BELOW

259375foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')

260376-- LATIN SMALL LETTER T WITH DIAERESIS

@@ -429,6 +545,174 @@ foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')

429545foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')

430546-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI

431547foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')

548+-- LATIN CAPITAL LETTER J WITH CROSSED-TAIL

549+foldMapping '\xa7b2' s = Yield '\x029d' (CC s '\x0000' '\x0000')

550+-- LATIN CAPITAL LETTER CHI

551+foldMapping '\xa7b3' s = Yield '\xab53' (CC s '\x0000' '\x0000')

552+-- LATIN CAPITAL LETTER BETA

553+foldMapping '\xa7b4' s = Yield '\xa7b5' (CC s '\x0000' '\x0000')

554+-- LATIN CAPITAL LETTER OMEGA

555+foldMapping '\xa7b6' s = Yield '\xa7b7' (CC s '\x0000' '\x0000')

556+-- CHEROKEE SMALL LETTER A

557+foldMapping '\xab70' s = Yield '\x13a0' (CC s '\x0000' '\x0000')

558+-- CHEROKEE SMALL LETTER E

559+foldMapping '\xab71' s = Yield '\x13a1' (CC s '\x0000' '\x0000')

560+-- CHEROKEE SMALL LETTER I

561+foldMapping '\xab72' s = Yield '\x13a2' (CC s '\x0000' '\x0000')

562+-- CHEROKEE SMALL LETTER O

563+foldMapping '\xab73' s = Yield '\x13a3' (CC s '\x0000' '\x0000')

564+-- CHEROKEE SMALL LETTER U

565+foldMapping '\xab74' s = Yield '\x13a4' (CC s '\x0000' '\x0000')

566+-- CHEROKEE SMALL LETTER V

567+foldMapping '\xab75' s = Yield '\x13a5' (CC s '\x0000' '\x0000')

568+-- CHEROKEE SMALL LETTER GA

569+foldMapping '\xab76' s = Yield '\x13a6' (CC s '\x0000' '\x0000')

570+-- CHEROKEE SMALL LETTER KA

571+foldMapping '\xab77' s = Yield '\x13a7' (CC s '\x0000' '\x0000')

572+-- CHEROKEE SMALL LETTER GE

573+foldMapping '\xab78' s = Yield '\x13a8' (CC s '\x0000' '\x0000')

574+-- CHEROKEE SMALL LETTER GI

575+foldMapping '\xab79' s = Yield '\x13a9' (CC s '\x0000' '\x0000')

576+-- CHEROKEE SMALL LETTER GO

577+foldMapping '\xab7a' s = Yield '\x13aa' (CC s '\x0000' '\x0000')

578+-- CHEROKEE SMALL LETTER GU

579+foldMapping '\xab7b' s = Yield '\x13ab' (CC s '\x0000' '\x0000')

580+-- CHEROKEE SMALL LETTER GV

581+foldMapping '\xab7c' s = Yield '\x13ac' (CC s '\x0000' '\x0000')

582+-- CHEROKEE SMALL LETTER HA

583+foldMapping '\xab7d' s = Yield '\x13ad' (CC s '\x0000' '\x0000')

584+-- CHEROKEE SMALL LETTER HE

585+foldMapping '\xab7e' s = Yield '\x13ae' (CC s '\x0000' '\x0000')

586+-- CHEROKEE SMALL LETTER HI

587+foldMapping '\xab7f' s = Yield '\x13af' (CC s '\x0000' '\x0000')

588+-- CHEROKEE SMALL LETTER HO

589+foldMapping '\xab80' s = Yield '\x13b0' (CC s '\x0000' '\x0000')

590+-- CHEROKEE SMALL LETTER HU

591+foldMapping '\xab81' s = Yield '\x13b1' (CC s '\x0000' '\x0000')

592+-- CHEROKEE SMALL LETTER HV

593+foldMapping '\xab82' s = Yield '\x13b2' (CC s '\x0000' '\x0000')

594+-- CHEROKEE SMALL LETTER LA

595+foldMapping '\xab83' s = Yield '\x13b3' (CC s '\x0000' '\x0000')

596+-- CHEROKEE SMALL LETTER LE

597+foldMapping '\xab84' s = Yield '\x13b4' (CC s '\x0000' '\x0000')

598+-- CHEROKEE SMALL LETTER LI

599+foldMapping '\xab85' s = Yield '\x13b5' (CC s '\x0000' '\x0000')

600+-- CHEROKEE SMALL LETTER LO

601+foldMapping '\xab86' s = Yield '\x13b6' (CC s '\x0000' '\x0000')

602+-- CHEROKEE SMALL LETTER LU

603+foldMapping '\xab87' s = Yield '\x13b7' (CC s '\x0000' '\x0000')

604+-- CHEROKEE SMALL LETTER LV

605+foldMapping '\xab88' s = Yield '\x13b8' (CC s '\x0000' '\x0000')

606+-- CHEROKEE SMALL LETTER MA

607+foldMapping '\xab89' s = Yield '\x13b9' (CC s '\x0000' '\x0000')

608+-- CHEROKEE SMALL LETTER ME

609+foldMapping '\xab8a' s = Yield '\x13ba' (CC s '\x0000' '\x0000')

610+-- CHEROKEE SMALL LETTER MI

611+foldMapping '\xab8b' s = Yield '\x13bb' (CC s '\x0000' '\x0000')

612+-- CHEROKEE SMALL LETTER MO

613+foldMapping '\xab8c' s = Yield '\x13bc' (CC s '\x0000' '\x0000')

614+-- CHEROKEE SMALL LETTER MU

615+foldMapping '\xab8d' s = Yield '\x13bd' (CC s '\x0000' '\x0000')

616+-- CHEROKEE SMALL LETTER NA

617+foldMapping '\xab8e' s = Yield '\x13be' (CC s '\x0000' '\x0000')

618+-- CHEROKEE SMALL LETTER HNA

619+foldMapping '\xab8f' s = Yield '\x13bf' (CC s '\x0000' '\x0000')

620+-- CHEROKEE SMALL LETTER NAH

621+foldMapping '\xab90' s = Yield '\x13c0' (CC s '\x0000' '\x0000')

622+-- CHEROKEE SMALL LETTER NE

623+foldMapping '\xab91' s = Yield '\x13c1' (CC s '\x0000' '\x0000')

624+-- CHEROKEE SMALL LETTER NI

625+foldMapping '\xab92' s = Yield '\x13c2' (CC s '\x0000' '\x0000')

626+-- CHEROKEE SMALL LETTER NO

627+foldMapping '\xab93' s = Yield '\x13c3' (CC s '\x0000' '\x0000')

628+-- CHEROKEE SMALL LETTER NU

629+foldMapping '\xab94' s = Yield '\x13c4' (CC s '\x0000' '\x0000')

630+-- CHEROKEE SMALL LETTER NV

631+foldMapping '\xab95' s = Yield '\x13c5' (CC s '\x0000' '\x0000')

632+-- CHEROKEE SMALL LETTER QUA

633+foldMapping '\xab96' s = Yield '\x13c6' (CC s '\x0000' '\x0000')

634+-- CHEROKEE SMALL LETTER QUE

635+foldMapping '\xab97' s = Yield '\x13c7' (CC s '\x0000' '\x0000')

636+-- CHEROKEE SMALL LETTER QUI

637+foldMapping '\xab98' s = Yield '\x13c8' (CC s '\x0000' '\x0000')

638+-- CHEROKEE SMALL LETTER QUO

639+foldMapping '\xab99' s = Yield '\x13c9' (CC s '\x0000' '\x0000')

640+-- CHEROKEE SMALL LETTER QUU

641+foldMapping '\xab9a' s = Yield '\x13ca' (CC s '\x0000' '\x0000')

642+-- CHEROKEE SMALL LETTER QUV

643+foldMapping '\xab9b' s = Yield '\x13cb' (CC s '\x0000' '\x0000')

644+-- CHEROKEE SMALL LETTER SA

645+foldMapping '\xab9c' s = Yield '\x13cc' (CC s '\x0000' '\x0000')

646+-- CHEROKEE SMALL LETTER S

647+foldMapping '\xab9d' s = Yield '\x13cd' (CC s '\x0000' '\x0000')

648+-- CHEROKEE SMALL LETTER SE

649+foldMapping '\xab9e' s = Yield '\x13ce' (CC s '\x0000' '\x0000')

650+-- CHEROKEE SMALL LETTER SI

651+foldMapping '\xab9f' s = Yield '\x13cf' (CC s '\x0000' '\x0000')

652+-- CHEROKEE SMALL LETTER SO

653+foldMapping '\xaba0' s = Yield '\x13d0' (CC s '\x0000' '\x0000')

654+-- CHEROKEE SMALL LETTER SU

655+foldMapping '\xaba1' s = Yield '\x13d1' (CC s '\x0000' '\x0000')

656+-- CHEROKEE SMALL LETTER SV

657+foldMapping '\xaba2' s = Yield '\x13d2' (CC s '\x0000' '\x0000')

658+-- CHEROKEE SMALL LETTER DA

659+foldMapping '\xaba3' s = Yield '\x13d3' (CC s '\x0000' '\x0000')

660+-- CHEROKEE SMALL LETTER TA

661+foldMapping '\xaba4' s = Yield '\x13d4' (CC s '\x0000' '\x0000')

662+-- CHEROKEE SMALL LETTER DE

663+foldMapping '\xaba5' s = Yield '\x13d5' (CC s '\x0000' '\x0000')

664+-- CHEROKEE SMALL LETTER TE

665+foldMapping '\xaba6' s = Yield '\x13d6' (CC s '\x0000' '\x0000')

666+-- CHEROKEE SMALL LETTER DI

667+foldMapping '\xaba7' s = Yield '\x13d7' (CC s '\x0000' '\x0000')

668+-- CHEROKEE SMALL LETTER TI

669+foldMapping '\xaba8' s = Yield '\x13d8' (CC s '\x0000' '\x0000')

670+-- CHEROKEE SMALL LETTER DO

671+foldMapping '\xaba9' s = Yield '\x13d9' (CC s '\x0000' '\x0000')

672+-- CHEROKEE SMALL LETTER DU

673+foldMapping '\xabaa' s = Yield '\x13da' (CC s '\x0000' '\x0000')

674+-- CHEROKEE SMALL LETTER DV

675+foldMapping '\xabab' s = Yield '\x13db' (CC s '\x0000' '\x0000')

676+-- CHEROKEE SMALL LETTER DLA

677+foldMapping '\xabac' s = Yield '\x13dc' (CC s '\x0000' '\x0000')

678+-- CHEROKEE SMALL LETTER TLA

679+foldMapping '\xabad' s = Yield '\x13dd' (CC s '\x0000' '\x0000')

680+-- CHEROKEE SMALL LETTER TLE

681+foldMapping '\xabae' s = Yield '\x13de' (CC s '\x0000' '\x0000')

682+-- CHEROKEE SMALL LETTER TLI

683+foldMapping '\xabaf' s = Yield '\x13df' (CC s '\x0000' '\x0000')

684+-- CHEROKEE SMALL LETTER TLO

685+foldMapping '\xabb0' s = Yield '\x13e0' (CC s '\x0000' '\x0000')

686+-- CHEROKEE SMALL LETTER TLU

687+foldMapping '\xabb1' s = Yield '\x13e1' (CC s '\x0000' '\x0000')

688+-- CHEROKEE SMALL LETTER TLV

689+foldMapping '\xabb2' s = Yield '\x13e2' (CC s '\x0000' '\x0000')

690+-- CHEROKEE SMALL LETTER TSA

691+foldMapping '\xabb3' s = Yield '\x13e3' (CC s '\x0000' '\x0000')

692+-- CHEROKEE SMALL LETTER TSE

693+foldMapping '\xabb4' s = Yield '\x13e4' (CC s '\x0000' '\x0000')

694+-- CHEROKEE SMALL LETTER TSI

695+foldMapping '\xabb5' s = Yield '\x13e5' (CC s '\x0000' '\x0000')

696+-- CHEROKEE SMALL LETTER TSO

697+foldMapping '\xabb6' s = Yield '\x13e6' (CC s '\x0000' '\x0000')

698+-- CHEROKEE SMALL LETTER TSU

699+foldMapping '\xabb7' s = Yield '\x13e7' (CC s '\x0000' '\x0000')

700+-- CHEROKEE SMALL LETTER TSV

701+foldMapping '\xabb8' s = Yield '\x13e8' (CC s '\x0000' '\x0000')

702+-- CHEROKEE SMALL LETTER WA

703+foldMapping '\xabb9' s = Yield '\x13e9' (CC s '\x0000' '\x0000')

704+-- CHEROKEE SMALL LETTER WE

705+foldMapping '\xabba' s = Yield '\x13ea' (CC s '\x0000' '\x0000')

706+-- CHEROKEE SMALL LETTER WI

707+foldMapping '\xabbb' s = Yield '\x13eb' (CC s '\x0000' '\x0000')

708+-- CHEROKEE SMALL LETTER WO

709+foldMapping '\xabbc' s = Yield '\x13ec' (CC s '\x0000' '\x0000')

710+-- CHEROKEE SMALL LETTER WU

711+foldMapping '\xabbd' s = Yield '\x13ed' (CC s '\x0000' '\x0000')

712+-- CHEROKEE SMALL LETTER WV

713+foldMapping '\xabbe' s = Yield '\x13ee' (CC s '\x0000' '\x0000')

714+-- CHEROKEE SMALL LETTER YA

715+foldMapping '\xabbf' s = Yield '\x13ef' (CC s '\x0000' '\x0000')

432716-- LATIN SMALL LIGATURE FF

433717foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')

434718-- LATIN SMALL LIGATURE FI

@@ -453,4 +737,106 @@ foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')

453737foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')

454738-- ARMENIAN SMALL LIGATURE MEN XEH

455739foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')

740+-- OLD HUNGARIAN CAPITAL LETTER A

741+foldMapping '\x10c80' s = Yield '\x10cc0' (CC s '\x0000' '\x0000')

742+-- OLD HUNGARIAN CAPITAL LETTER AA

743+foldMapping '\x10c81' s = Yield '\x10cc1' (CC s '\x0000' '\x0000')

744+-- OLD HUNGARIAN CAPITAL LETTER EB

745+foldMapping '\x10c82' s = Yield '\x10cc2' (CC s '\x0000' '\x0000')

746+-- OLD HUNGARIAN CAPITAL LETTER AMB

747+foldMapping '\x10c83' s = Yield '\x10cc3' (CC s '\x0000' '\x0000')

748+-- OLD HUNGARIAN CAPITAL LETTER EC

749+foldMapping '\x10c84' s = Yield '\x10cc4' (CC s '\x0000' '\x0000')

750+-- OLD HUNGARIAN CAPITAL LETTER ENC

751+foldMapping '\x10c85' s = Yield '\x10cc5' (CC s '\x0000' '\x0000')

752+-- OLD HUNGARIAN CAPITAL LETTER ECS

753+foldMapping '\x10c86' s = Yield '\x10cc6' (CC s '\x0000' '\x0000')

754+-- OLD HUNGARIAN CAPITAL LETTER ED

755+foldMapping '\x10c87' s = Yield '\x10cc7' (CC s '\x0000' '\x0000')

756+-- OLD HUNGARIAN CAPITAL LETTER AND

757+foldMapping '\x10c88' s = Yield '\x10cc8' (CC s '\x0000' '\x0000')

758+-- OLD HUNGARIAN CAPITAL LETTER E

759+foldMapping '\x10c89' s = Yield '\x10cc9' (CC s '\x0000' '\x0000')

760+-- OLD HUNGARIAN CAPITAL LETTER CLOSE E

761+foldMapping '\x10c8a' s = Yield '\x10cca' (CC s '\x0000' '\x0000')

762+-- OLD HUNGARIAN CAPITAL LETTER EE

763+foldMapping '\x10c8b' s = Yield '\x10ccb' (CC s '\x0000' '\x0000')

764+-- OLD HUNGARIAN CAPITAL LETTER EF

765+foldMapping '\x10c8c' s = Yield '\x10ccc' (CC s '\x0000' '\x0000')

766+-- OLD HUNGARIAN CAPITAL LETTER EG

767+foldMapping '\x10c8d' s = Yield '\x10ccd' (CC s '\x0000' '\x0000')

768+-- OLD HUNGARIAN CAPITAL LETTER EGY

769+foldMapping '\x10c8e' s = Yield '\x10cce' (CC s '\x0000' '\x0000')

770+-- OLD HUNGARIAN CAPITAL LETTER EH

771+foldMapping '\x10c8f' s = Yield '\x10ccf' (CC s '\x0000' '\x0000')

772+-- OLD HUNGARIAN CAPITAL LETTER I

773+foldMapping '\x10c90' s = Yield '\x10cd0' (CC s '\x0000' '\x0000')

774+-- OLD HUNGARIAN CAPITAL LETTER II

775+foldMapping '\x10c91' s = Yield '\x10cd1' (CC s '\x0000' '\x0000')

776+-- OLD HUNGARIAN CAPITAL LETTER EJ

777+foldMapping '\x10c92' s = Yield '\x10cd2' (CC s '\x0000' '\x0000')

778+-- OLD HUNGARIAN CAPITAL LETTER EK

779+foldMapping '\x10c93' s = Yield '\x10cd3' (CC s '\x0000' '\x0000')

780+-- OLD HUNGARIAN CAPITAL LETTER AK

781+foldMapping '\x10c94' s = Yield '\x10cd4' (CC s '\x0000' '\x0000')

782+-- OLD HUNGARIAN CAPITAL LETTER UNK

783+foldMapping '\x10c95' s = Yield '\x10cd5' (CC s '\x0000' '\x0000')

784+-- OLD HUNGARIAN CAPITAL LETTER EL

785+foldMapping '\x10c96' s = Yield '\x10cd6' (CC s '\x0000' '\x0000')

786+-- OLD HUNGARIAN CAPITAL LETTER ELY

787+foldMapping '\x10c97' s = Yield '\x10cd7' (CC s '\x0000' '\x0000')

788+-- OLD HUNGARIAN CAPITAL LETTER EM

789+foldMapping '\x10c98' s = Yield '\x10cd8' (CC s '\x0000' '\x0000')

790+-- OLD HUNGARIAN CAPITAL LETTER EN

791+foldMapping '\x10c99' s = Yield '\x10cd9' (CC s '\x0000' '\x0000')

792+-- OLD HUNGARIAN CAPITAL LETTER ENY

793+foldMapping '\x10c9a' s = Yield '\x10cda' (CC s '\x0000' '\x0000')

794+-- OLD HUNGARIAN CAPITAL LETTER O

795+foldMapping '\x10c9b' s = Yield '\x10cdb' (CC s '\x0000' '\x0000')

796+-- OLD HUNGARIAN CAPITAL LETTER OO

797+foldMapping '\x10c9c' s = Yield '\x10cdc' (CC s '\x0000' '\x0000')

798+-- OLD HUNGARIAN CAPITAL LETTER NIKOLSBURG OE

799+foldMapping '\x10c9d' s = Yield '\x10cdd' (CC s '\x0000' '\x0000')

800+-- OLD HUNGARIAN CAPITAL LETTER RUDIMENTA OE

801+foldMapping '\x10c9e' s = Yield '\x10cde' (CC s '\x0000' '\x0000')

802+-- OLD HUNGARIAN CAPITAL LETTER OEE

803+foldMapping '\x10c9f' s = Yield '\x10cdf' (CC s '\x0000' '\x0000')

804+-- OLD HUNGARIAN CAPITAL LETTER EP

805+foldMapping '\x10ca0' s = Yield '\x10ce0' (CC s '\x0000' '\x0000')

806+-- OLD HUNGARIAN CAPITAL LETTER EMP

807+foldMapping '\x10ca1' s = Yield '\x10ce1' (CC s '\x0000' '\x0000')

808+-- OLD HUNGARIAN CAPITAL LETTER ER

809+foldMapping '\x10ca2' s = Yield '\x10ce2' (CC s '\x0000' '\x0000')

810+-- OLD HUNGARIAN CAPITAL LETTER SHORT ER

811+foldMapping '\x10ca3' s = Yield '\x10ce3' (CC s '\x0000' '\x0000')

812+-- OLD HUNGARIAN CAPITAL LETTER ES

813+foldMapping '\x10ca4' s = Yield '\x10ce4' (CC s '\x0000' '\x0000')

814+-- OLD HUNGARIAN CAPITAL LETTER ESZ

815+foldMapping '\x10ca5' s = Yield '\x10ce5' (CC s '\x0000' '\x0000')

816+-- OLD HUNGARIAN CAPITAL LETTER ET

817+foldMapping '\x10ca6' s = Yield '\x10ce6' (CC s '\x0000' '\x0000')

818+-- OLD HUNGARIAN CAPITAL LETTER ENT

819+foldMapping '\x10ca7' s = Yield '\x10ce7' (CC s '\x0000' '\x0000')

820+-- OLD HUNGARIAN CAPITAL LETTER ETY

821+foldMapping '\x10ca8' s = Yield '\x10ce8' (CC s '\x0000' '\x0000')

822+-- OLD HUNGARIAN CAPITAL LETTER ECH

823+foldMapping '\x10ca9' s = Yield '\x10ce9' (CC s '\x0000' '\x0000')

824+-- OLD HUNGARIAN CAPITAL LETTER U

825+foldMapping '\x10caa' s = Yield '\x10cea' (CC s '\x0000' '\x0000')

826+-- OLD HUNGARIAN CAPITAL LETTER UU

827+foldMapping '\x10cab' s = Yield '\x10ceb' (CC s '\x0000' '\x0000')

828+-- OLD HUNGARIAN CAPITAL LETTER NIKOLSBURG UE

829+foldMapping '\x10cac' s = Yield '\x10cec' (CC s '\x0000' '\x0000')

830+-- OLD HUNGARIAN CAPITAL LETTER RUDIMENTA UE

831+foldMapping '\x10cad' s = Yield '\x10ced' (CC s '\x0000' '\x0000')

832+-- OLD HUNGARIAN CAPITAL LETTER EV

833+foldMapping '\x10cae' s = Yield '\x10cee' (CC s '\x0000' '\x0000')

834+-- OLD HUNGARIAN CAPITAL LETTER EZ

835+foldMapping '\x10caf' s = Yield '\x10cef' (CC s '\x0000' '\x0000')

836+-- OLD HUNGARIAN CAPITAL LETTER EZS

837+foldMapping '\x10cb0' s = Yield '\x10cf0' (CC s '\x0000' '\x0000')

838+-- OLD HUNGARIAN CAPITAL LETTER ENT-SHAPED SIGN

839+foldMapping '\x10cb1' s = Yield '\x10cf1' (CC s '\x0000' '\x0000')

840+-- OLD HUNGARIAN CAPITAL LETTER US

841+foldMapping '\x10cb2' s = Yield '\x10cf2' (CC s '\x0000' '\x0000')

456842foldMapping c s = Yield (toLower c) (CC s '\0' '\0')

Data/Text/Fusion/Common.hs → Data/Text/Internal/Fusion/Common.hsrenamed+153−89

@@ -1,22 +1,26 @@

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

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

22-- |

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

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

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

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

55--

66-- License : BSD-style

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

8−-- duncan@haskell.org

7+-- Maintainer : bos@serpentine.com

98-- Stability : experimental

109-- Portability : GHC

1110--

11+-- /Warning/: this is an internal module, and does not have a stable

12+-- API or name. Functions in this module may not check or enforce

13+-- preconditions expected by public modules. Use at your own risk!

14+--

1215-- Common stream fusion functionality for text.

1316

14−module Data.Text.Fusion.Common

17+module Data.Text.Internal.Fusion.Common

1518 (

1619 -- * Creation and elimination

1720 singleton

1821 , streamList

1922 , unstreamList

23+ , streamCString#

2024

2125 -- * Basic interface

2226 , cons

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

4145 -- $case

4246 , toCaseFold

4347 , toLower

48+ , toTitle

4449 , toUpper

4550

4651 -- ** Justification

@@ -66,9 +71,6 @@ module Data.Text.Fusion.Common

6671 -- ** Scans

6772 , scanl

6873

69− -- ** Accumulating maps

70− -- , mapAccumL

71−

7274 -- ** Generation and unfolding

7375 , replicateCharI

7476 , replicateI

@@ -104,16 +106,21 @@ import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),

104106 (&&), fromIntegral, otherwise)

105107import qualified Data.List as L

106108import qualified Prelude as P

109+import Data.Bits (shiftL)

110+import Data.Char (isLetter)

107111import Data.Int (Int64)

108−import Data.Text.Fusion.Internal

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

110−import Data.Text.Fusion.Size

112+import Data.Text.Internal.Fusion.Types

113+import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,

114+ upperMapping)

115+import Data.Text.Internal.Fusion.Size

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

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

111118

112119singleton :: Char -> Stream Char

113120singleton c = Stream next False 1

114121 where next False = Yield c True

115122 next True = Done

116−{-# INLINE singleton #-}

123+{-# INLINE [0] singleton #-}

117124

118125streamList :: [a] -> Stream a

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

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

131138

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

133140

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

142+-- constant strings in generated code.

143+--

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

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

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

147+streamCString# addr = Stream step 0 unknownSize

148+ where

149+ step !i

150+ | b == 0 = Done

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

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

153+ in Yield c (i+2)

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

155+ (next 1 `shiftL` 6) +

156+ next 2

157+ in Yield c (i+3)

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

159+ (next 1 `shiftL` 12) +

160+ (next 2 `shiftL` 6) +

161+ next 3

162+ in Yield c (i+4)

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

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

165+ !b# = at# i

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

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

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

169+

134170-- ----------------------------------------------------------------------------

135171-- * Basic stream functions

136172

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

139175

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

141177cons :: Char -> Stream Char -> Stream Char

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

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

143179 where

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

145181 next (C0 s) = case next0 s of

@@ -148,6 +184,9 @@ cons w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)

148184 Yield x s' -> Yield x (C0 s')

149185{-# INLINE [0] cons #-}

150186

187+data Snoc a = N

188+ | J !a

189+

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

152191snoc :: Stream Char -> Char -> Stream Char

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

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

185224 loop_head !s = case next s of

186225 Yield x _ -> x

187226 Skip s' -> loop_head s'

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

227+ Done -> head_empty

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

190229

230+head_empty :: a

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

232+{-# NOINLINE head_empty #-}

233+

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

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

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

@@ -272,12 +315,13 @@ lengthI (Stream next s0 _len) = loop_length 0 s0

272315--

273316-- This function gives the same answer as comparing against the result

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

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

318+-- greater than the number or if the stream can't possibly be as long

319+-- as the number supplied, and hence be more efficient.

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

277−compareLengthI (Stream next s0 len) n =

278− case exactly len of

321+compareLengthI (Stream next s0 len) n =

322+ case compareSize len (fromIntegral n) of

323+ Just o -> o

279324 Nothing -> loop_cmp 0 s0

280− Just i -> compare (fromIntegral i) n

281325 where

282326 loop_cmp !z s = case next s of

283327 Done -> compare z n

@@ -395,17 +439,54 @@ toLower :: Stream Char -> Stream Char

395439toLower = caseConvert lowerMapping

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

397441

442+-- | /O(n)/ Convert a string to title case, using simple case

443+-- conversion.

444+--

445+-- The first letter of the input is converted to title case, as is

446+-- every subsequent letter that immediately follows a non-letter.

447+-- Every letter that immediately follows another letter is converted

448+-- to lower case.

449+--

450+-- The result string may be longer than the input string. For example,

451+-- the Latin small ligature ﬂ (U+FB02) is converted to the

452+-- sequence Latin capital letter F (U+0046) followed by Latin small

453+-- letter l (U+006C).

454+--

455+-- /Note/: this function does not take language or culture specific

456+-- rules into account. For instance, in English, different style

457+-- guides disagree on whether the book name \"The Hill of the Red

458+-- Fox\" is correctly title cased—but this function will

459+-- capitalize /every/ word.

460+toTitle :: Stream Char -> Stream Char

461+toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len

462+ where

463+ next (CC (letter :*: s) '\0' _) =

464+ case next0 s of

465+ Done -> Done

466+ Skip s' -> Skip (CC (letter :*: s') '\0' '\0')

467+ Yield c s'

468+ | letter' -> if letter

469+ then lowerMapping c (letter' :*: s')

470+ else titleMapping c (letter' :*: s')

471+ | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')

472+ where letter' = isLetter c

473+ next (CC s a b) = Yield a (CC s b '\0')

474+{-# INLINE [0] toTitle #-}

475+

476+data Justify i s = Just1 !i !s

477+ | Just2 !i !s

478+

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

399480justifyLeftI k c (Stream next0 s0 len) =

400− Stream next (s0 :*: S1 :*: 0) (larger (fromIntegral k) len)

481+ Stream next (Just1 0 s0) (larger (fromIntegral k) len)

401482 where

402− next (s :*: S1 :*: n) =

483+ next (Just1 n s) =

403484 case next0 s of

404− Done -> next (s :*: S2 :*: n)

405− Skip s' -> Skip (s' :*: S1 :*: n)

406− Yield x s' -> Yield x (s' :*: S1 :*: n+1)

407− next (s :*: S2 :*: n)

408− | n < k = Yield c (s :*: S2 :*: n+1)

485+ Done -> next (Just2 n s)

486+ Skip s' -> Skip (Just1 n s')

487+ Yield x s' -> Yield x (Just1 (n+1) s')

488+ next (Just2 n s)

489+ | n < k = Yield c (Just2 (n+1) s)

409490 | otherwise = Done

410491 {-# INLINE next #-}

411492{-# INLINE [0] justifyLeftI #-}

@@ -512,7 +593,7 @@ concatMap f = foldr (append . f) empty

512593{-# INLINE [0] concatMap #-}

513594

514595-- | /O(n)/ any @p @xs determines if any character in the stream

515−-- @xs@ satisifes the predicate @p@.

596+-- @xs@ satisfies the predicate @p@.

516597any :: (Char -> Bool) -> Stream Char -> Bool

517598any p (Stream next0 s0 _len) = loop_any s0

518599 where

@@ -524,7 +605,7 @@ any p (Stream next0 s0 _len) = loop_any s0

524605{-# INLINE [0] any #-}

525606

526607-- | /O(n)/ all @p @xs determines if all characters in the 'Text'

527−-- @xs@ satisify the predicate @p@.

608+-- @xs@ satisfy the predicate @p@.

528609all :: (Char -> Bool) -> Stream Char -> Bool

529610all p (Stream next0 s0 _len) = loop_all s0

530611 where

@@ -573,50 +654,27 @@ minimum (Stream next0 s0 _len) = loop0_minimum s0

573654-- * Building streams

574655

575656scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

576−scanl f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low

657+scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low

577658 where

578659 {-# INLINE next #-}

579− next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)

580− next (S2 :*: z :*: s) = case next0 s of

581− Yield x s' -> let !x' = f z x

582− in Yield x' (S2 :*: x' :*: s')

583− Skip s' -> Skip (S2 :*: z :*: s')

584− Done -> Done

660+ next (Scan1 z s) = Yield z (Scan2 z s)

661+ next (Scan2 z s) = case next0 s of

662+ Yield x s' -> let !x' = f z x

663+ in Yield x' (Scan2 x' s')

664+ Skip s' -> Skip (Scan2 z s')

665+ Done -> Done

585666{-# INLINE [0] scanl #-}

586667

587−-- -----------------------------------------------------------------------------

588−-- ** Accumulating maps

589−

590−{-

591−-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a

592−-- function to each element of a stream, passing an accumulating

593−-- parameter from left to right, and returns a final stream.

594−--

595−-- /Note/: Unlike the version over lists, this function does not

596−-- return a final value for the accumulator, because the nature of

597−-- streams precludes it.

598−mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b

599−mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :*: z0) len -- HINT depends on f

600− where

601− {-# INLINE next #-}

602− next (s :*: z) = case next0 s of

603− Yield x s' -> let (z',y) = f z x

604− in Yield y (s' :*: z')

605− Skip s' -> Skip (s' :*: z)

606− Done -> Done

607−{-# INLINE [0] mapAccumL #-}

608−-}

609−

610668-- -----------------------------------------------------------------------------

611669-- ** Generating and unfolding streams

612670

613671replicateCharI :: Integral a => a -> Char -> Stream Char

614−replicateCharI n c

672+replicateCharI !n !c

615673 | n < 0 = empty

616674 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low

617675 where

618− next i | i >= n = Done

619− | otherwise = Yield c (i + 1)

676+ next !i | i >= n = Done

677+ | otherwise = Yield c (i + 1)

620678{-# INLINE [0] replicateCharI #-}

621679

622680data RI s = RI !s {-# UNPACK #-} !Int64

@@ -681,24 +739,27 @@ take n0 (Stream next0 s0 len) =

681739 Yield x s' -> Yield x ((n-1) :*: s')

682740{-# INLINE [0] take #-}

683741

742+data Drop a s = NS !s

743+ | JS !a !s

744+

684745-- | /O(n)/ drop n, applied to a stream, returns the suffix of the

685746-- stream after the first @n@ characters, or the empty stream if @n@

686747-- is greater than the length of the stream.

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

688749drop n0 (Stream next0 s0 len) =

689− Stream next (J n0 :*: s0) (len - fromIntegral (max 0 n0))

750+ Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))

690751 where

691752 {-# INLINE next #-}

692− next (J n :*: s)

693− | n <= 0 = Skip (N :*: s)

753+ next (JS n s)

754+ | n <= 0 = Skip (NS s)

694755 | otherwise = case next0 s of

695756 Done -> Done

696− Skip s' -> Skip (J n :*: s')

697− Yield _ s' -> Skip (J (n-1) :*: s')

698− next (N :*: s) = case next0 s of

757+ Skip s' -> Skip (JS n s')

758+ Yield _ s' -> Skip (JS (n-1) s')

759+ next (NS s) = case next0 s of

699760 Done -> Done

700− Skip s' -> Skip (N :*: s')

701− Yield x s' -> Yield x (N :*: s')

761+ Skip s' -> Skip (NS s')

762+ Yield x s' -> Yield x (NS s')

702763{-# INLINE [0] drop #-}

703764

704765-- | takeWhile, applied to a predicate @p@ and a stream, returns the

@@ -716,18 +777,18 @@ takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

716777

717778-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.

718779dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char

719−dropWhile p (Stream next0 s0 len) = Stream next (S1 :*: s0) len -- HINT maybe too high

780+dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high

720781 where

721782 {-# INLINE next #-}

722− next (S1 :*: s) = case next0 s of

783+ next (L s) = case next0 s of

723784 Done -> Done

724− Skip s' -> Skip (S1 :*: s')

725− Yield x s' | p x -> Skip (S1 :*: s')

726− | otherwise -> Yield x (S2 :*: s')

727− next (S2 :*: s) = case next0 s of

785+ Skip s' -> Skip (L s')

786+ Yield x s' | p x -> Skip (L s')

787+ | otherwise -> Yield x (R s')

788+ next (R s) = case next0 s of

728789 Done -> Done

729− Skip s' -> Skip (S2 :*: s')

730− Yield x s' -> Yield x (S2 :*: s')

790+ Skip s' -> Skip (R s')

791+ Yield x s' -> Yield x (R s')

731792{-# INLINE [0] dropWhile #-}

732793

733794-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns

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

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

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

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

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

747807

748808-- ----------------------------------------------------------------------------

749809-- * Searching

@@ -835,21 +895,25 @@ findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0

835895-------------------------------------------------------------------------------

836896-- * Zipping

837897

898+-- | Strict triple.

899+data Zip a b m = Z1 !a !b

900+ | Z2 !a !b !m

901+

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

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

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

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

842− Stream next (sa0 :*: sb0 :*: N) (smaller len1 len2)

906+ Stream next (Z1 sa0 sb0) (smaller len1 len2)

843907 where

844− next (sa :*: sb :*: N) = case next0 sa of

845− Done -> Done

846− Skip sa' -> Skip (sa' :*: sb :*: N)

847− Yield a sa' -> Skip (sa' :*: sb :*: J a)

848−

849− next (sa' :*: sb :*: J a) = case next1 sb of

850− Done -> Done

851− Skip sb' -> Skip (sa' :*: sb' :*: J a)

852− Yield b sb' -> Yield (f a b) (sa' :*: sb' :*: N)

908+ next (Z1 sa sb) = case next0 sa of

909+ Done -> Done

910+ Skip sa' -> Skip (Z1 sa' sb)

911+ Yield a sa' -> Skip (Z2 sa' sb a)

912+

913+ next (Z2 sa' sb a) = case next1 sb of

914+ Done -> Done

915+ Skip sb' -> Skip (Z2 sa' sb' a)

916+ Yield b sb' -> Yield (f a b) (Z1 sa' sb')

853917{-# INLINE [0] zipWith #-}

854918

855919-- | /O(n)/ The 'countCharI' function returns the number of times the

@@ -865,7 +929,7 @@ countCharI a (Stream next s0 _len) = loop 0 s0

865929{-# INLINE [0] countCharI #-}

866930

867931streamError :: String -> String -> a

868−streamError func msg = P.error $ "Data.Text.Fusion.Common." ++ func ++ ": " ++ msg

932+streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg

869933

870934emptyError :: String -> a

871935emptyError func = internalError func "Empty input"

Data/Text/Internal/Fusion/Size.hsnew file+157

@@ -0,0 +1,157 @@

1+{-# LANGUAGE CPP #-}

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

3+-- |

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

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

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

7+--

8+-- License : BSD-style

9+-- Maintainer : bos@serpentine.com

10+-- Stability : experimental

11+-- Portability : portable

12+--

13+-- /Warning/: this is an internal module, and does not have a stable

14+-- API or name. Functions in this module may not check or enforce

15+-- preconditions expected by public modules. Use at your own risk!

16+--

17+-- Size hints.

18+

19+module Data.Text.Internal.Fusion.Size

20+ (

21+ Size

22+ , exactly

23+ , exactSize

24+ , maxSize

25+ , betweenSize

26+ , unknownSize

27+ , smaller

28+ , larger

29+ , upperBound

30+ , lowerBound

31+ , compareSize

32+ , isEmpty

33+ ) where

34+

35+import Data.Text.Internal (mul)

36+#if defined(ASSERTS)

37+import Control.Exception (assert)

38+#endif

39+

40+data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.

41+ | Unknown -- ^ Unknown size.

42+ deriving (Eq, Show)

43+

44+exactly :: Size -> Maybe Int

45+exactly (Between na nb) | na == nb = Just na

46+exactly _ = Nothing

47+{-# INLINE exactly #-}

48+

49+exactSize :: Int -> Size

50+exactSize n =

51+#if defined(ASSERTS)

52+ assert (n >= 0)

53+#endif

54+ Between n n

55+{-# INLINE exactSize #-}

56+

57+maxSize :: Int -> Size

58+maxSize n =

59+#if defined(ASSERTS)

60+ assert (n >= 0)

61+#endif

62+ Between 0 n

63+{-# INLINE maxSize #-}

64+

65+betweenSize :: Int -> Int -> Size

66+betweenSize m n =

67+#if defined(ASSERTS)

68+ assert (m >= 0)

69+ assert (n >= m)

70+#endif

71+ Between m n

72+{-# INLINE betweenSize #-}

73+

74+unknownSize :: Size

75+unknownSize = Unknown

76+{-# INLINE unknownSize #-}

77+

78+instance Num Size where

79+ (+) = addSize

80+ (-) = subtractSize

81+ (*) = mulSize

82+

83+ fromInteger = f where f = exactSize . fromInteger

84+ {-# INLINE f #-}

85+

86+add :: Int -> Int -> Int

87+add m n | mn >= 0 = mn

88+ | otherwise = overflowError

89+ where mn = m + n

90+{-# INLINE add #-}

91+

92+addSize :: Size -> Size -> Size

93+addSize (Between ma mb) (Between na nb) = Between (add ma na) (add mb nb)

94+addSize _ _ = Unknown

95+{-# INLINE addSize #-}

96+

97+subtractSize :: Size -> Size -> Size

98+subtractSize (Between ma mb) (Between na nb) = Between (max (ma-nb) 0) (max (mb-na) 0)

99+subtractSize a@(Between 0 _) Unknown = a

100+subtractSize (Between _ mb) Unknown = Between 0 mb

101+subtractSize _ _ = Unknown

102+{-# INLINE subtractSize #-}

103+

104+mulSize :: Size -> Size -> Size

105+mulSize (Between ma mb) (Between na nb) = Between (mul ma na) (mul mb nb)

106+mulSize _ _ = Unknown

107+{-# INLINE mulSize #-}

108+

109+-- | Minimum of two size hints.

110+smaller :: Size -> Size -> Size

111+smaller a@(Between ma mb) b@(Between na nb)

112+ | mb <= na = a

113+ | nb <= ma = b

114+ | otherwise = Between (ma `min` na) (mb `min` nb)

115+smaller a@(Between 0 _) Unknown = a

116+smaller (Between _ mb) Unknown = Between 0 mb

117+smaller Unknown b@(Between 0 _) = b

118+smaller Unknown (Between _ nb) = Between 0 nb

119+smaller Unknown Unknown = Unknown

120+{-# INLINE smaller #-}

121+

122+-- | Maximum of two size hints.

123+larger :: Size -> Size -> Size

124+larger a@(Between ma mb) b@(Between na nb)

125+ | ma >= nb = a

126+ | na >= mb = b

127+ | otherwise = Between (ma `max` na) (mb `max` nb)

128+larger _ _ = Unknown

129+{-# INLINE larger #-}

130+

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

132+upperBound :: Int -> Size -> Int

133+upperBound _ (Between _ n) = n

134+upperBound k _ = k

135+{-# INLINE upperBound #-}

136+

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

138+lowerBound :: Int -> Size -> Int

139+lowerBound _ (Between n _) = n

140+lowerBound k _ = k

141+{-# INLINE lowerBound #-}

142+

143+compareSize :: Size -> Int -> Maybe Ordering

144+compareSize (Between ma mb) n

145+ | mb < n = Just LT

146+ | ma > n = Just GT

147+ | ma == n && mb == n = Just EQ

148+compareSize _ _ = Nothing

149+

150+

151+isEmpty :: Size -> Bool

152+isEmpty (Between _ n) = n <= 0

153+isEmpty _ = False

154+{-# INLINE isEmpty #-}

155+

156+overflowError :: Int

157+overflowError = error "Data.Text.Internal.Fusion.Size: size overflow"

Data/Text/Fusion/Internal.hs → Data/Text/Internal/Fusion/Types.hsrenamed+24−23

@@ -1,53 +1,56 @@

11{-# LANGUAGE BangPatterns, ExistentialQuantification #-}

22-- |

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

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

44-- Copyright : (c) Tom Harper 2008-2009,

55-- (c) Bryan O'Sullivan 2009,

6−-- (c) Duncan Coutts 2009

6+-- (c) Duncan Coutts 2009,

7+-- (c) Jasper Van der Jeugt 2011

78--

89-- License : BSD-style

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

10−-- duncan@haskell.org

10+-- Maintainer : bos@serpentine.com

1111-- Stability : experimental

1212-- Portability : GHC

1313--

14+-- /Warning/: this is an internal module, and does not have a stable

15+-- API or name. Functions in this module may not check or enforce

16+-- preconditions expected by public modules. Use at your own risk!

17+--

1418-- Core stream fusion functionality for text.

1519

16−module Data.Text.Fusion.Internal

20+module Data.Text.Internal.Fusion.Types

1721 (

1822 CC(..)

19− , M(..)

20− , M8

2123 , PairS(..)

22− , S(..)

24+ , Scan(..)

25+ , RS(..)

2326 , Step(..)

2427 , Stream(..)

25− , Switch(..)

2628 , empty

2729 ) where

2830

29−import Data.Text.Fusion.Size

31+import Data.Text.Internal.Fusion.Size

3032import Data.Word (Word8)

3133

3234-- | Specialised tuple for case conversion.

3335data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char

3436

35−-- | Specialised, strict Maybe-like type.

36−data M a = N

37− | J !a

38−

39−type M8 = M Word8

40−

41−-- Restreaming state.

42−data S s = S !s !M8 !M8 !M8

37+-- | Restreaming state.

38+data RS s

39+ = RS0 !s

40+ | RS1 !s {-# UNPACK #-} !Word8

41+ | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

42+ | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

4343

44−infixl 2 :*:

44+-- | Strict pair.

4545data PairS a b = !a :*: !b

4646 -- deriving (Eq, Ord, Show)

47+infixl 2 :*:

4748

48−-- | Allow a function over a stream to switch between two states.

49−data Switch = S1 | S2

49+-- | An intermediate result in a scan.

50+data Scan s = Scan1 {-# UNPACK #-} !Char !s

51+ | Scan2 {-# UNPACK #-} !Char !s

5052

53+-- | Intermediate result in a processing pipeline.

5154data Step s a = Done

5255 | Skip !s

5356 | Yield !a !s

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

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

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

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

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

100102

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

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

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

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

113115 other -> other

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

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

116117

117118-- | The empty stream.

118119empty :: Stream a

Data/Text/IO/Internal.hs → Data/Text/Internal/IO.hsrenamed+13−14

@@ -1,6 +1,6 @@

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

22-- |

3−-- Module : Data.Text.IO.Internal

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

66-- License : BSD-style

@@ -8,23 +8,24 @@

88-- Stability : experimental

99-- Portability : GHC

1010--

11+-- /Warning/: this is an internal module, and does not have a stable

12+-- API or name. Functions in this module may not check or enforce

13+-- preconditions expected by public modules. Use at your own risk!

14+--

1115-- Low-level support for text I\/O.

1216

13−module Data.Text.IO.Internal

17+module Data.Text.Internal.IO

1418 (

15−#if __GLASGOW_HASKELL__ >= 612

1619 hGetLineWith

1720 , readChunk

18−#endif

1921 ) where

2022

21−#if __GLASGOW_HASKELL__ >= 612

22−import Control.Exception (catch)

23+import qualified Control.Exception as E

2324import Data.IORef (readIORef, writeIORef)

2425import Data.Text (Text)

25−import Data.Text.Fusion (unstream)

26−import Data.Text.Fusion.Internal (Step(..), Stream(..))

27−import Data.Text.Fusion.Size (exactSize, maxSize)

26+import Data.Text.Internal.Fusion (unstream)

27+import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))

28+import Data.Text.Internal.Fusion.Size (exactSize, maxSize)

2829import Data.Text.Unsafe (inlinePerformIO)

2930import Foreign.Storable (peekElemOff)

3031import GHC.IO.Buffer (Buffer(..), CharBuffer, RawCharBuffer, bufferAdjustL,

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

3233 withRawBuffer, writeCharBuf)

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

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

35−import Prelude hiding (catch)

3636import System.IO (Handle)

3737import System.IO.Error (isEOFError)

3838import qualified Data.Text as T

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

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

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

8686maybeFillReadBuffer handle_ buf

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

88− if isEOFError e

89− then return Nothing

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

88+ if isEOFError e

89+ then return Nothing

9090 else ioError e

9191

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

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

164164

165165sizeError :: String -> a

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

167−#endif

Data/Text/Internal/Lazy.hsnew file+119

@@ -0,0 +1,119 @@

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

2+{-# OPTIONS_HADDOCK not-home #-}

4+-- |

5+-- Module : Data.Text.Internal.Lazy

7+--

8+-- License : BSD-style

9+-- Maintainer : bos@serpentine.com

10+-- Stability : experimental

11+-- Portability : GHC

12+--

13+-- /Warning/: this is an internal module, and does not have a stable

14+-- API or name. Functions in this module may not check or enforce

15+-- preconditions expected by public modules. Use at your own risk!

16+--

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

18+-- 'Text' representation and low level construction functions.

19+-- Modules which extend the 'Text' system may need to use this module.

20+

21+module Data.Text.Internal.Lazy

22+ (

23+ Text(..)

24+ , chunk

25+ , empty

26+ , foldrChunks

27+ , foldlChunks

28+ -- * Data type invariant and abstraction functions

29+

30+ -- $invariant

31+ , strictInvariant

32+ , lazyInvariant

33+ , showStructure

34+

35+ -- * Chunk allocation sizes

36+ , defaultChunkSize

37+ , smallChunkSize

38+ , chunkOverhead

39+ ) where

40+

41+import Data.Text ()

42+import Data.Text.Internal.Unsafe.Shift (shiftL)

43+import Data.Typeable (Typeable)

44+import Foreign.Storable (sizeOf)

45+import qualified Data.Text.Internal as T

46+

47+data Text = Empty

48+ | Chunk {-# UNPACK #-} !T.Text Text

49+ deriving (Typeable)

50+

51+-- $invariant

52+--

53+-- The data type invariant for lazy 'Text': Every 'Text' is either 'Empty' or

54+-- consists of non-null 'T.Text's. All functions must preserve this,

55+-- and the QC properties must check this.

56+

57+-- | Check the invariant strictly.

58+strictInvariant :: Text -> Bool

59+strictInvariant Empty = True

60+strictInvariant x@(Chunk (T.Text _ _ len) cs)

61+ | len > 0 = strictInvariant cs

62+ | otherwise = error $ "Data.Text.Lazy: invariant violation: "

63+ ++ showStructure x

64+

65+-- | Check the invariant lazily.

66+lazyInvariant :: Text -> Text

67+lazyInvariant Empty = Empty

68+lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)

69+ | len > 0 = Chunk c (lazyInvariant cs)

70+ | otherwise = error $ "Data.Text.Lazy: invariant violation: "

71+ ++ showStructure x

72+

73+-- | Display the internal structure of a lazy 'Text'.

74+showStructure :: Text -> String

75+showStructure Empty = "Empty"

76+showStructure (Chunk t Empty) = "Chunk " ++ show t ++ " Empty"

77+showStructure (Chunk t ts) =

78+ "Chunk " ++ show t ++ " (" ++ showStructure ts ++ ")"

79+

80+-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.

81+chunk :: T.Text -> Text -> Text

82+{-# INLINE chunk #-}

83+chunk t@(T.Text _ _ len) ts | len == 0 = ts

84+ | otherwise = Chunk t ts

85+

86+-- | Smart constructor for 'Empty'.

87+empty :: Text

88+{-# INLINE [0] empty #-}

89+empty = Empty

90+

91+-- | Consume the chunks of a lazy 'Text' with a natural right fold.

92+foldrChunks :: (T.Text -> a -> a) -> a -> Text -> a

93+foldrChunks f z = go

94+ where go Empty = z

95+ go (Chunk c cs) = f c (go cs)

96+{-# INLINE foldrChunks #-}

97+

98+-- | Consume the chunks of a lazy 'Text' with a strict, tail-recursive,

99+-- accumulating left fold.

100+foldlChunks :: (a -> T.Text -> a) -> a -> Text -> a

101+foldlChunks f z = go z

102+ where go !a Empty = a

103+ go !a (Chunk c cs) = go (f a c) cs

104+{-# INLINE foldlChunks #-}

105+

106+-- | Currently set to 16 KiB, less the memory management overhead.

107+defaultChunkSize :: Int

108+defaultChunkSize = 16384 - chunkOverhead

109+{-# INLINE defaultChunkSize #-}

110+

111+-- | Currently set to 128 bytes, less the memory management overhead.

112+smallChunkSize :: Int

113+smallChunkSize = 128 - chunkOverhead

114+{-# INLINE smallChunkSize #-}

115+

116+-- | The memory management overhead. Currently this is tuned for GHC only.

117+chunkOverhead :: Int

118+chunkOverhead = sizeOf (undefined :: Int) `shiftL` 1

119+{-# INLINE chunkOverhead #-}

Data/Text/Lazy/Encoding/Fusion.hs → Data/Text/Internal/Lazy/Encoding/Fusion.hsrenamed+17−14

@@ -5,15 +5,18 @@

66--

77-- License : BSD-style

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

9−-- duncan@haskell.org

8+-- Maintainer : bos@serpentine.com

109-- Stability : experimental

1110-- Portability : portable

1211--

12+-- /Warning/: this is an internal module, and does not have a stable

13+-- API or name. Functions in this module may not check or enforce

14+-- preconditions expected by public modules. Use at your own risk!

15+--

1316-- Fusible 'Stream'-oriented functions for converting between lazy

1417-- 'Text' and several common encodings.

1518

16−module Data.Text.Lazy.Encoding.Fusion

19+module Data.Text.Internal.Lazy.Encoding.Fusion

1720 (

1821 -- * Streaming

1922 -- streamASCII

@@ -26,23 +29,23 @@ module Data.Text.Lazy.Encoding.Fusion

2629 -- * Unstreaming

2730 , unstream

2831

29− , module Data.Text.Encoding.Fusion.Common

32+ , module Data.Text.Internal.Encoding.Fusion.Common

3033 ) where

3134

3235import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)

3336import qualified Data.ByteString as B

3437import qualified Data.ByteString.Unsafe as B

35−import Data.Text.Encoding.Fusion.Common

38+import Data.Text.Internal.Encoding.Fusion.Common

3639import Data.Text.Encoding.Error

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

38−import Data.Text.Fusion.Size

39−import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)

40−import Data.Text.UnsafeShift (shiftL)

40+import Data.Text.Internal.Fusion (Step(..), Stream(..))

41+import Data.Text.Internal.Fusion.Size

42+import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)

43+import Data.Text.Internal.Unsafe.Shift (shiftL)

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

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

43−import qualified Data.Text.Encoding.Utf16 as U16

44−import qualified Data.Text.Encoding.Utf32 as U32

45−import System.IO.Unsafe (unsafePerformIO)

45+import qualified Data.Text.Internal.Encoding.Utf8 as U8

46+import qualified Data.Text.Internal.Encoding.Utf16 as U16

47+import qualified Data.Text.Internal.Encoding.Utf32 as U32

48+import Data.Text.Unsafe (unsafeDupablePerformIO)

4649import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)

4750import Foreign.Storable (pokeByteOff)

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

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

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

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

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

275− where chunk s1 len1 = unsafePerformIO $ do

278+ where chunk s1 len1 = unsafeDupablePerformIO $ do

276279 let len = max 4 (min len1 chunkSize)

277280 mallocByteString len >>= loop len 0 s1

278281 where

Data/Text/Lazy/Fusion.hs → Data/Text/Internal/Lazy/Fusion.hsrenamed+38−31

@@ -4,14 +4,17 @@

55--

66-- License : BSD-style

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

8−-- duncan@haskell.org

7+-- Maintainer : bos@serpentine.com

98-- Stability : experimental

109-- Portability : GHC

1110--

11+-- /Warning/: this is an internal module, and does not have a stable

12+-- API or name. Functions in this module may not check or enforce

13+-- preconditions expected by public modules. Use at your own risk!

14+--

1215-- Core stream fusion functionality for text.

1316

14−module Data.Text.Lazy.Fusion

17+module Data.Text.Internal.Lazy.Fusion

1518 (

1619 stream

1720 , unstream

@@ -23,14 +26,15 @@ module Data.Text.Lazy.Fusion

2326 ) where

2427

2528import Prelude hiding (length)

26−import qualified Data.Text.Fusion.Common as S

27−import Data.Text.Fusion.Internal

28−import Data.Text.Fusion.Size (isEmpty, unknownSize)

29−import Data.Text.Lazy.Internal

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

30+import Control.Monad.ST (runST)

31+import Data.Text.Internal.Fusion.Types

32+import Data.Text.Internal.Fusion.Size (isEmpty, unknownSize)

33+import Data.Text.Internal.Lazy

3034import qualified Data.Text.Internal as I

3135import qualified Data.Text.Array as A

32−import Data.Text.UnsafeChar (unsafeWrite)

33−import Data.Text.UnsafeShift (shiftL)

36+import Data.Text.Internal.Unsafe.Char (unsafeWrite)

37+import Data.Text.Internal.Unsafe.Shift (shiftL)

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

3539import Data.Int (Int64)

3640

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

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

5155-- chunk size.

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

53−unstreamChunks chunkSize (Stream next s0 len0)

57+unstreamChunks !chunkSize (Stream next s0 len0)

5458 | isEmpty len0 = Empty

5559 | otherwise = outer s0

5660 where

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

58− case next s of

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

62+ case next so of

5963 Done -> Empty

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

65+ Yield x s' -> runST $ do

66+ a <- A.new unknownLength

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

68+ where unknownLength = 4

69+ where

70+ inner marr !len s !i

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

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

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

74+ marr' <- A.new newLen

75+ A.copyM marr' 0 marr 0 len

76+ inner marr' newLen s i

77+ | otherwise =

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

79+ case next s of

80+ Done -> finish marr i s

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

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

83+ inner marr len s' (i+d)

84+ finish marr len s' = do

85+ arr <- A.unsafeFreeze marr

86+ return (I.Text arr 0 len `Chunk` outer s')

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

8188

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

Data/Text/Lazy/Search.hs → Data/Text/Internal/Lazy/Search.hsrenamed+9−6

@@ -5,16 +5,19 @@

66--

77-- License : BSD-style

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

9−-- duncan@haskell.org

8+-- Maintainer : bos@serpentine.com

109-- Stability : experimental

1110-- Portability : GHC

1211--

12+-- /Warning/: this is an internal module, and does not have a stable

13+-- API or name. Functions in this module may not check or enforce

14+-- preconditions expected by public modules. Use at your own risk!

15+--

1316-- Fast substring search for lazy 'Text', based on work by Boyer,

1417-- Moore, Horspool, Sunday, and Lundh. Adapted from the strict

1518-- implementation.

1619

17−module Data.Text.Lazy.Search

20+module Data.Text.Internal.Lazy.Search

1821 (

1922 indices

2023 ) where

@@ -23,10 +26,10 @@ import qualified Data.Text.Array as A

2326import Data.Int (Int64)

2427import Data.Word (Word16, Word64)

2528import qualified Data.Text.Internal as T

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

27−import Data.Text.Lazy.Internal (Text(..), foldlChunks)

29+import Data.Text.Internal.Fusion.Types (PairS(..))

30+import Data.Text.Internal.Lazy (Text(..), foldlChunks)

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

29−import Data.Text.UnsafeShift (shiftL)

32+import Data.Text.Internal.Unsafe.Shift (shiftL)

3033

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

3235-- @needle@ within @haystack@.

Data/Text/Internal/Private.hsnew file+37

@@ -0,0 +1,37 @@

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

3+-- |

4+-- Module : Data.Text.Internal.Private

6+--

7+-- License : BSD-style

8+-- Maintainer : bos@serpentine.com

9+-- Stability : experimental

10+-- Portability : GHC

11+

12+module Data.Text.Internal.Private

13+ (

14+ runText

15+ , span_

16+ ) where

17+

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

19+import Data.Text.Internal (Text(..), text)

20+import Data.Text.Unsafe (Iter(..), iter)

21+import qualified Data.Text.Array as A

22+

23+span_ :: (Char -> Bool) -> Text -> (# Text, Text #)

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

25+ where hd = text arr off k

26+ tl = text arr (off+k) (len-k)

27+ !k = loop 0

28+ loop !i | i < len && p c = loop (i+d)

29+ | otherwise = i

30+ where Iter c d = iter t i

31+{-# INLINE span_ #-}

32+

33+runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text

34+runText act = runST (act $ \ !marr !len -> do

35+ arr <- A.unsafeFreeze marr

36+ return $! text arr 0 len)

37+{-# INLINE runText #-}

Data/Text/Internal/Read.hsnew file+62

@@ -0,0 +1,62 @@

1+-- |

2+-- Module : Data.Text.Internal.Read

4+--

5+-- License : BSD-style

6+-- Maintainer : bos@serpentine.com

7+-- Stability : experimental

8+-- Portability : GHC

9+--

10+-- Common internal functions for reading textual data.

11+module Data.Text.Internal.Read

12+ (

13+ IReader

14+ , IParser(..)

15+ , T(..)

16+ , digitToInt

17+ , hexDigitToInt

18+ , perhaps

19+ ) where

20+

21+import Control.Applicative as App (Applicative(..))

22+import Control.Arrow (first)

23+import Control.Monad (ap)

24+import Data.Char (ord)

25+

26+type IReader t a = t -> Either String (a,t)

27+

28+newtype IParser t a = P {

29+ runP :: IReader t a

30+ }

31+

32+instance Functor (IParser t) where

33+ fmap f m = P $ fmap (first f) . runP m

34+

35+instance Applicative (IParser t) where

36+ pure a = P $ \t -> Right (a,t)

37+ {-# INLINE pure #-}

38+ (<*>) = ap

39+

40+instance Monad (IParser t) where

41+ return = App.pure

42+ m >>= k = P $ \t -> case runP m t of

43+ Left err -> Left err

44+ Right (a,t') -> runP (k a) t'

45+ {-# INLINE (>>=) #-}

46+ fail msg = P $ \_ -> Left msg

47+

48+data T = T !Integer !Int

49+

50+perhaps :: a -> IParser t a -> IParser t a

51+perhaps def m = P $ \t -> case runP m t of

52+ Left _ -> Right (def,t)

53+ r@(Right _) -> r

54+

55+hexDigitToInt :: Char -> Int

56+hexDigitToInt c

57+ | c >= '0' && c <= '9' = ord c - ord '0'

58+ | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)

59+ | otherwise = ord c - (ord 'A' - 10)

60+

61+digitToInt :: Char -> Int

62+digitToInt c = ord c - ord '0'

Data/Text/Search.hs → Data/Text/Internal/Search.hsrenamed+12−11

@@ -1,12 +1,11 @@

11{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}

33-- |

4−-- Module : Data.Text.Search

4+-- Module : Data.Text.Internal.Search

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

66--

77-- License : BSD-style

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

9−-- duncan@haskell.org

8+-- Maintainer : bos@serpentine.com

109-- Stability : experimental

1110-- Portability : GHC

1211--

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

1413-- Horspool, Sunday, and Lundh.

1514--

1615-- References:

17−--

16+--

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

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

2019--

@@ -27,7 +26,7 @@

2726-- * F. Lundh: The Fast Search Algorithm.

2827-- <http://effbot.org/zone/stringlib.htm> (2006)

2928

30−module Data.Text.Search

29+module Data.Text.Internal.Search

3130 (

3231 indices

3332 ) where

@@ -35,13 +34,15 @@ module Data.Text.Search

3534import qualified Data.Text.Array as A

3635import Data.Word (Word64)

3736import Data.Text.Internal (Text(..))

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

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

40−import Data.Text.UnsafeShift (shiftL)

38+import Data.Text.Internal.Unsafe.Shift (shiftL)

39+

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

4141

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

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

44−-- locations in the low-level array.

44+-- uncorrected indices in the low-level \"needle\" array, to which its

45+-- offset must be added.

4546--

4647-- In (unlikely) bad cases, this algorithm's complexity degrades

4748-- towards /O(n*m)/.

@@ -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/Base.hs → Data/Text/Internal/Unsafe.hsrenamed+12−11

@@ -1,28 +1,29 @@

11{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}

2+{-# OPTIONS_HADDOCK not-home #-}

24-- |

3−-- Module : Data.Text.Unsafe.Base

5+-- Module : Data.Text.Internal.Unsafe

57-- License : BSD-style

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

7−-- duncan@haskell.org

8+-- Maintainer : bos@serpentine.com

89-- Stability : experimental

910-- Portability : portable

1011--

11−-- A module containing unsafe operations, for very very careful use in

12−-- heavily tested code.

13−module Data.Text.Unsafe.Base

12+-- /Warning/: this is an internal module, and does not have a stable

13+-- API or name. Functions in this module may not check or enforce

14+-- preconditions expected by public modules. Use at your own risk!

15+--

16+-- A module containing /unsafe/ operations, for /very very careful/ use

17+-- in /heavily tested/ code.

18+module Data.Text.Internal.Unsafe

1419 (

1520 inlineInterleaveST

1621 , inlinePerformIO

1722 ) where

18−

23+

1924import GHC.ST (ST(..))

2025#if defined(__GLASGOW_HASKELL__)

21−# if __GLASGOW_HASKELL__ >= 611

2226import GHC.IO (IO(IO))

23−# else

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

25−# endif

2627import GHC.Base (realWorld#)

2728#endif

2829

Data/Text/UnsafeChar.hs → Data/Text/Internal/Unsafe/Char.hsrenamed+8−5

@@ -1,19 +1,22 @@

11{-# LANGUAGE CPP, MagicHash #-}

33-- |

4−-- Module : Data.Text.UnsafeChar

4+-- Module : Data.Text.Internal.Unsafe.Char

88--

99-- License : BSD-style

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

11−-- duncan@haskell.org

10+-- Maintainer : bos@serpentine.com

1211-- Stability : experimental

1312-- Portability : GHC

1413--

14+-- /Warning/: this is an internal module, and does not have a stable

15+-- API or name. Functions in this module may not check or enforce

16+-- preconditions expected by public modules. Use at your own risk!

17+--

1518-- Fast character manipulation functions.

16−module Data.Text.UnsafeChar

19+module Data.Text.Internal.Unsafe.Char

1720 (

1821 ord

1922 , unsafeChr

@@ -28,7 +31,7 @@ import Control.Exception (assert)

2831#endif

2932import Control.Monad.ST (ST)

3033import Data.Bits ((.&.))

31−import Data.Text.UnsafeShift (shiftR)

34+import Data.Text.Internal.Unsafe.Shift (shiftR)

3235import GHC.Exts (Char(..), Int(..), chr#, ord#, word2Int#)

3336import GHC.Word (Word8(..), Word16(..), Word32(..))

3437import qualified Data.Text.Array as A

Data/Text/UnsafeShift.hs → Data/Text/Internal/Unsafe/Shift.hsrenamed+7−4

@@ -1,18 +1,21 @@

11{-# LANGUAGE MagicHash #-}

33-- |

4−-- Module : Data.Text.UnsafeShift

4+-- Module : Data.Text.Internal.Unsafe.Shift

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

66--

77-- License : BSD-style

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

9−-- duncan@haskell.org

8+-- Maintainer : bos@serpentine.com

109-- Stability : experimental

1110-- Portability : GHC

1211--

12+-- /Warning/: this is an internal module, and does not have a stable

13+-- API or name. Functions in this module may not check or enforce

14+-- preconditions expected by public modules. Use at your own risk!

15+--

1316-- Fast, unchecked bit shifting functions.

1417

15−module Data.Text.UnsafeShift

18+module Data.Text.Internal.Unsafe.Shift

1619 (

1720 UnsafeShift(..)

1821 ) where

Data/Text/Lazy.hs+276−59

@@ -1,12 +1,18 @@

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

6+#if __GLASGOW_HASKELL__ >= 708

7+{-# LANGUAGE TypeFamilies #-}

8+#endif

310-- |

411-- Module : Data.Text.Lazy

613--

714-- License : BSD-style

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

9−-- duncan@haskell.org

15+-- Maintainer : bos@serpentine.com

1016-- Stability : experimental

1117-- Portability : GHC

1218--

@@ -83,6 +89,7 @@ module Data.Text.Lazy

8389 , toCaseFold

8490 , toLower

8591 , toUpper

92+ , toTitle

8693

8794 -- ** Justification

8895 , justifyLeft

@@ -118,7 +125,10 @@ module Data.Text.Lazy

118125 , mapAccumR

119126

120127 -- ** Generation and unfolding

128+ , repeat

121129 , replicate

130+ , cycle

131+ , iterate

122132 , unfoldr

123133 , unfoldrN

124134

@@ -126,8 +136,11 @@ module Data.Text.Lazy

126136

127137 -- ** Breaking strings

128138 , take

139+ , takeEnd

129140 , drop

141+ , dropEnd

130142 , takeWhile

143+ , takeWhileEnd

131144 , dropWhile

132145 , dropWhileEnd

133146 , dropAround

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

174187 , partition

175188

176189 -- , findSubstring

177−

190+

178191 -- * Indexing

179192 , index

180193 , count

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

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

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

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

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

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

194207import qualified Prelude as P

195208#if defined(HAVE_DEEPSEQ)

196209import Control.DeepSeq (NFData(..))

@@ -198,25 +211,39 @@ import Control.DeepSeq (NFData(..))

198211import Data.Int (Int64)

199212import qualified Data.List as L

200213import Data.Char (isSpace)

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

202−#if __GLASGOW_HASKELL__ >= 612

203−import Data.Data (mkNoRepType)

204−#else

205−import Data.Data (mkNorepType)

206−#endif

214+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,

215+ Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))

216+import Data.Binary (Binary(get, put))

207217import Data.Monoid (Monoid(..))

218+#if MIN_VERSION_base(4,9,0)

219+import Data.Semigroup (Semigroup(..))

220+#endif

208221import Data.String (IsString(..))

209222import qualified Data.Text as T

210223import qualified Data.Text.Internal as T

211−import qualified Data.Text.Fusion.Common as S

224+import qualified Data.Text.Internal.Fusion.Common as S

212225import qualified Data.Text.Unsafe as T

213−import qualified Data.Text.Lazy.Fusion as S

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

215−import Data.Text.Lazy.Fusion (stream, unstream)

216−import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldlChunks, foldrChunks)

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

218−import qualified Data.Text.Util as U

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

226+import qualified Data.Text.Internal.Lazy.Fusion as S

227+import Data.Text.Internal.Fusion.Types (PairS(..))

228+import Data.Text.Internal.Lazy.Fusion (stream, unstream)

229+import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks,

230+ foldrChunks, smallChunkSize)

231+import Data.Text.Internal (firstf, safe, text)

232+import Data.Text.Lazy.Encoding (decodeUtf8', encodeUtf8)

233+import qualified Data.Text.Internal.Functions as F

234+import Data.Text.Internal.Lazy.Search (indices)

235+#if __GLASGOW_HASKELL__ >= 702

236+import qualified GHC.CString as GHC

237+#else

238+import qualified GHC.Base as GHC

239+#endif

240+#if __GLASGOW_HASKELL__ >= 708

241+import qualified GHC.Exts as Exts

242+#endif

243+import GHC.Prim (Addr#)

244+#if MIN_VERSION_base(4,7,0)

245+import Text.Printf (PrintfArg, formatArg, formatString)

246+#endif

220247

221248-- $fusion

222249--

@@ -314,30 +341,72 @@ instance Show Text where

314341instance Read Text where

315342 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]

316343

344+#if MIN_VERSION_base(4,9,0)

345+-- Semigroup orphan instances for older GHCs are provided by

346+-- 'semigroups` package

347+

348+instance Semigroup Text where

349+ (<>) = append

350+#endif

351+

317352instance Monoid Text where

318353 mempty = empty

354+#if MIN_VERSION_base(4,9,0)

355+ mappend = (<>) -- future-proof definition

356+#else

319357 mappend = append

358+#endif

320359 mconcat = concat

321360

322361instance IsString Text where

323362 fromString = pack

324363

364+#if __GLASGOW_HASKELL__ >= 708

365+instance Exts.IsList Text where

366+ type Item Text = Char

367+ fromList = pack

368+ toList = unpack

369+#endif

370+

325371#if defined(HAVE_DEEPSEQ)

326372instance NFData Text where

327373 rnf Empty = ()

328374 rnf (Chunk _ ts) = rnf ts

329375#endif

330376

377+instance Binary Text where

378+ put t = put (encodeUtf8 t)

379+ get = do

380+ bs <- get

381+ case decodeUtf8' bs of

382+ P.Left exn -> P.fail (P.show exn)

383+ P.Right a -> P.return a

384+

385+-- | This instance preserves data abstraction at the cost of inefficiency.

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

387+--

388+-- This instance was created by copying the updated behavior of

389+-- @"Data.Text".@'Data.Text.Text'

331390instance Data Text where

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

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

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

335−#if __GLASGOW_HASKELL__ >= 612

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

337−#else

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

392+ toConstr _ = packConstr

393+ gunfold k z c = case constrIndex c of

394+ 1 -> k (z pack)

395+ _ -> error "Data.Text.Lazy.Text.gunfold"

396+ dataTypeOf _ = textDataType

397+

398+#if MIN_VERSION_base(4,7,0)

399+-- | Only defined for @base-4.7.0.0@ and later

400+instance PrintfArg Text where

401+ formatArg txt = formatString $ unpack txt

339402#endif

340403

404+packConstr :: Constr

405+packConstr = mkConstr textDataType "pack" [] Prefix

406+

407+textDataType :: DataType

408+textDataType = mkDataType "Data.Text.Lazy.Text" [packConstr]

409+

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

342411--

343412-- Subject to fusion. Performs replacement on invalid scalar values.

@@ -351,6 +420,27 @@ unpack :: Text -> String

351420unpack t = S.unstreamList (stream t)

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

353422

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

424+unpackCString# :: Addr# -> Text

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

426+{-# NOINLINE unpackCString# #-}

427+

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

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

430+ = unpackCString# a #-}

431+

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

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

434+ = unpackCString# a #-}

435+

436+{-# RULES "LAZY TEXT empty literal"

437+ unstream (S.streamList (L.map safe []))

438+ = Empty #-}

439+

440+{-# RULES "LAZY TEXT empty literal" forall a.

441+ unstream (S.streamList (L.map safe [a]))

442+ = Chunk (T.singleton a) Empty #-}

443+

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

355445-- Performs replacement on invalid scalar values.

356446singleton :: Char -> Text

@@ -455,7 +545,7 @@ tail Empty = emptyError "tail"

455545 unstream (S.tail (stream t)) = tail t

456546 #-}

457547

458−-- | /O(1)/ Returns all but the last character of a 'Text', which must

548+-- | /O(n\/c)/ Returns all but the last character of a 'Text', which must

459549-- be non-empty. Subject to fusion.

460550init :: Text -> Text

461551init (Chunk t0 ts0) = go t0 ts0

@@ -491,7 +581,7 @@ isSingleton :: Text -> Bool

491581isSingleton = S.isSingleton . stream

492582{-# INLINE isSingleton #-}

493583

494−-- | /O(1)/ Returns the last character of a 'Text', which must be

584+-- | /O(n\/c)/ Returns the last character of a 'Text', which must be

495585-- non-empty. Subject to fusion.

496586last :: Text -> Char

497587last Empty = emptyError "last"

@@ -546,7 +636,7 @@ map f t = unstream (S.map (safe . f) (stream t))

546636-- 'Text's and concatenates the list after interspersing the first

547637-- argument between each element of the list.

548638intercalate :: Text -> [Text] -> Text

549−intercalate t = concat . (U.intersperse t)

639+intercalate t = concat . (F.intersperse t)

550640{-# INLINE intercalate #-}

551641

552642-- | /O(n)/ The 'intersperse' function takes a character and places it

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

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

607697 where len = length t

608698 d = k - len

609− r = d `div` 2

699+ r = d `quot` 2

610700 l = d - r

611701{-# INLINE center #-}

612702

@@ -625,13 +715,36 @@ reverse = rev Empty

625715 where rev a Empty = a

626716 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts

627717

628−-- | /O(m+n)/ Replace every occurrence of one substring with another.

718+-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in

719+-- @haystack@ with @replacement@.

720+--

721+-- This function behaves as though it was defined as follows:

722+--

723+-- @

724+-- replace needle replacement haystack =

725+-- 'intercalate' replacement ('splitOn' needle haystack)

726+-- @

727+--

728+-- As this suggests, each occurrence is replaced exactly once. So if

729+-- @needle@ occurs in @replacement@, that occurrence will /not/ itself

730+-- be replaced recursively:

731+--

732+-- > replace "oo" "foo" "oo" == "foo"

733+--

734+-- In cases where several instances of @needle@ overlap, only the

735+-- first one will be replaced:

736+--

737+-- > replace "ofo" "bar" "ofofo" == "barfo"

629738--

630739-- In (unlikely) bad cases, this function's time complexity degrades

631740-- towards /O(n*m)/.

632−replace :: Text -- ^ Text to search for

633− -> Text -- ^ Replacement text

634− -> Text -- ^ Input text

741+replace :: Text

742+ -- ^ @needle@ to search for. If this string is empty, an

743+ -- error will occur.

744+ -> Text

745+ -- ^ @replacement@ to replace @needle@ with.

746+ -> Text

747+ -- ^ @haystack@ in which to search.

635748 -> Text

636749replace s d = intercalate d . splitOn s

637750{-# INLINE replace #-}

@@ -648,9 +761,10 @@ replace s d = intercalate d . splitOn s

648761-- functions may map one input character to two or three output

649762-- characters.

650763

651−-- | /O(n)/ Convert a string to folded case. This function is mainly

652−-- useful for performing caseless (or case insensitive) string

653−-- comparisons.

764+-- | /O(n)/ Convert a string to folded case. Subject to fusion.

765+--

766+-- This function is mainly useful for performing caseless (or case

767+-- insensitive) string comparisons.

654768--

655769-- A string @x@ is a caseless match for a string @y@ if and only if:

656770--

@@ -667,22 +781,49 @@ toCaseFold t = unstream (S.toCaseFold (stream t))

667781{-# INLINE [0] toCaseFold #-}

668782

669783-- | /O(n)/ Convert a string to lower case, using simple case

670−-- conversion. The result string may be longer than the input string.

671−-- For instance, the Latin capital letter I with dot above (U+0130)

672−-- maps to the sequence Latin small letter i (U+0069) followed by

673−-- combining dot above (U+0307).

784+-- conversion. Subject to fusion.

785+--

786+-- The result string may be longer than the input string. For

787+-- instance, the Latin capital letter I with dot above (U+0130) maps

788+-- to the sequence Latin small letter i (U+0069) followed by combining

789+-- dot above (U+0307).

674790toLower :: Text -> Text

675791toLower t = unstream (S.toLower (stream t))

676792{-# INLINE toLower #-}

677793

678794-- | /O(n)/ Convert a string to upper case, using simple case

679−-- conversion. The result string may be longer than the input string.

680−-- For instance, the German eszett (U+00DF) maps to the two-letter

795+-- conversion. Subject to fusion.

796+--

797+-- The result string may be longer than the input string. For

798+-- instance, the German eszett (U+00DF) maps to the two-letter

681799-- sequence SS.

682800toUpper :: Text -> Text

683801toUpper t = unstream (S.toUpper (stream t))

684802{-# INLINE toUpper #-}

685803

804+

805+-- | /O(n)/ Convert a string to title case, using simple case

806+-- conversion. Subject to fusion.

807+--

808+-- The first letter of the input is converted to title case, as is

809+-- every subsequent letter that immediately follows a non-letter.

810+-- Every letter that immediately follows another letter is converted

811+-- to lower case.

812+--

813+-- The result string may be longer than the input string. For example,

814+-- the Latin small ligature ﬂ (U+FB02) is converted to the

815+-- sequence Latin capital letter F (U+0046) followed by Latin small

816+-- letter l (U+006C).

817+--

818+-- /Note/: this function does not take language or culture specific

819+-- rules into account. For instance, in English, different style

820+-- guides disagree on whether the book name \"The Hill of the Red

821+-- Fox\" is correctly title cased—but this function will

822+-- capitalize /every/ word.

823+toTitle :: Text -> Text

824+toTitle t = unstream (S.toTitle (stream t))

825+{-# INLINE toTitle #-}

826+

686827-- | /O(n)/ 'foldl', applied to a binary operator, a starting value

687828-- (typically the left-identity of the operator), and a 'Text',

688829-- reduces the 'Text' using the binary operator, from left to right.

@@ -740,13 +881,13 @@ concatMap f = concat . foldr ((:) . f) []

740881{-# INLINE concatMap #-}

741882

742883-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the

743−-- 'Text' @t@ satisifes the predicate @p@. Subject to fusion.

884+-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.

744885any :: (Char -> Bool) -> Text -> Bool

745886any p t = S.any p (stream t)

746887{-# INLINE any #-}

747888

748889-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the

749−-- 'Text' @t@ satisify the predicate @p@. Subject to fusion.

890+-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.

750891all :: (Char -> Bool) -> Text -> Bool

751892all p t = S.all p (stream t)

752893{-# INLINE all #-}

@@ -829,6 +970,12 @@ mapAccumR f = go

829970 go z Empty = (z, Empty)

830971{-# INLINE mapAccumR #-}

831972

973+-- | @'repeat' x@ is an infinite 'Text', with @x@ the value of every

974+-- element.

975+repeat :: Char -> Text

976+repeat c = let t = Chunk (T.replicate smallChunkSize (T.singleton c)) t

977+ in t

978+

832979-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input

833980-- @t@ repeated @n@ times.

834981replicate :: Int64 -> Text -> Text

@@ -838,7 +985,22 @@ replicate n t

838985 | otherwise = concat (rep 0)

839986 where rep !i | i >= n = []

840987 | otherwise = t : rep (i+1)

841−{-# INLINE replicate #-}

988+{-# INLINE [1] replicate #-}

989+

990+-- | 'cycle' ties a finite, non-empty 'Text' into a circular one, or

991+-- equivalently, the infinite repetition of the original 'Text'.

992+cycle :: Text -> Text

993+cycle Empty = emptyError "cycle"

994+cycle t = let t' = foldrChunks Chunk t' t

995+ in t'

996+

997+-- | @'iterate' f x@ returns an infinite 'Text' of repeated applications

998+-- of @f@ to @x@:

999+--

1000+-- > iterate f x == [x, f x, f (f x), ...]

1001+iterate :: (Char -> Char) -> Char -> Text

1002+iterate f c = let t c' = Chunk (T.singleton c') (t (f c'))

1003+ in t c

8421004

8431005-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the

8441006-- value of every element. Subject to fusion.

@@ -893,6 +1055,22 @@ take i t0 = take' i t0

8931055 unstream (S.take n (stream t)) = take n t

8941056 #-}

8951057

1058+-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after

1059+-- taking @n@ characters from the end of @t@.

1060+--

1061+-- Examples:

1062+--

1063+-- > takeEnd 3 "foobar" == "bar"

1064+takeEnd :: Int64 -> Text -> Text

1065+takeEnd n t0

1066+ | n <= 0 = empty

1067+ | otherwise = takeChunk n empty . L.reverse . toChunks $ t0

1068+ where takeChunk _ acc [] = acc

1069+ takeChunk i acc (t:ts)

1070+ | i <= l = chunk (T.takeEnd (fromIntegral i) t) acc

1071+ | otherwise = takeChunk (i-l) (Chunk t acc) ts

1072+ where l = fromIntegral (T.length t)

1073+

8961074-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the

8971075-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@

8981076-- is greater than the length of the 'Text'. Subject to fusion.

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

9021080 | otherwise = drop' i t0

9031081 where drop' 0 ts = ts

9041082 drop' _ Empty = Empty

905− drop' n (Chunk t ts)

1083+ drop' n (Chunk t ts)

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

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

9081086 where len = fromIntegral (T.length t)

@@ -915,6 +1093,23 @@ drop i t0

9151093 unstream (S.drop n (stream t)) = drop n t

9161094 #-}

9171095

1096+-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after

1097+-- dropping @n@ characters from the end of @t@.

1098+--

1099+-- Examples:

1100+--

1101+-- > dropEnd 3 "foobar" == "foo"

1102+dropEnd :: Int64 -> Text -> Text

1103+dropEnd n t0

1104+ | n <= 0 = t0

1105+ | otherwise = dropChunk n . L.reverse . toChunks $ t0

1106+ where dropChunk _ [] = empty

1107+ dropChunk m (t:ts)

1108+ | m >= l = dropChunk (m-l) ts

1109+ | otherwise = fromChunks . L.reverse $

1110+ T.dropEnd (fromIntegral m) t : ts

1111+ where l = fromIntegral (T.length t)

1112+

9181113-- | /O(n)/ 'dropWords' @n@ returns the suffix with @n@ 'Word16'

9191114-- values dropped, or the empty 'Text' if @n@ is greater than the

9201115-- number of 'Word16' values present.

@@ -925,7 +1120,7 @@ dropWords i t0

9251120 where drop' 0 ts = ts

9261121 drop' _ Empty = Empty

9271122 drop' n (Chunk (T.Text arr off len) ts)

928− | n < len' = chunk (textP arr (off+n') (len-n')) ts

1123+ | n < len' = chunk (text arr (off+n') (len-n')) ts

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

9301125 where len' = fromIntegral len

9311126 n' = fromIntegral n

@@ -949,6 +1144,20 @@ takeWhile p t0 = takeWhile' t0

9491144"LAZY TEXT takeWhile -> unfused" [1] forall p t.

9501145 unstream (S.takeWhile p (stream t)) = takeWhile p t

9511146 #-}

1147+-- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',

1148+-- returns the longest suffix (possibly empty) of elements that

1149+-- satisfy @p@.

1150+-- Examples:

1151+--

1152+-- > takeWhileEnd (=='o') "foo" == "oo"

1153+takeWhileEnd :: (Char -> Bool) -> Text -> Text

1154+takeWhileEnd p = takeChunk empty . L.reverse . toChunks

1155+ where takeChunk acc [] = acc

1156+ takeChunk acc (t:ts) = if T.length t' < T.length t

1157+ then (Chunk t' acc)

1158+ else takeChunk (Chunk t' acc) ts

1159+ where t' = T.takeWhileEnd p t

1160+{-# INLINE takeWhileEnd #-}

9521161

9531162-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after

9541163-- 'takeWhile' @p@ @t@. Subject to fusion.

@@ -967,9 +1176,11 @@ dropWhile p t0 = dropWhile' t0

9671176"LAZY TEXT dropWhile -> unfused" [1] forall p t.

9681177 unstream (S.dropWhile p (stream t)) = dropWhile p t

9691178 #-}

1179+

9701180-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after

971−-- dropping characters that fail the predicate @p@ from the end of

1181+-- dropping characters that satisfy the predicate @p@ from the end of

9721182-- @t@.

1183+--

9731184-- Examples:

9741185--

9751186-- > dropWhileEnd (=='.') "foo..." == "foo"

@@ -986,7 +1197,7 @@ dropWhileEnd p = go

9861197{-# INLINE dropWhileEnd #-}

9871198

9881199-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after

989−-- dropping characters that fail the predicate @p@ from both the

1200+-- dropping characters that satisfy the predicate @p@ from both the

9901201-- beginning and end of @t@. Subject to fusion.

9911202dropAround :: (Char -> Bool) -> Text -> Text

9921203dropAround p = dropWhile p . dropWhileEnd p

@@ -1036,8 +1247,8 @@ splitAtWord _ Empty = empty :*: empty

10361247splitAtWord x (Chunk c@(T.Text arr off len) cs)

10371248 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs

10381249 in Chunk c h :*: t

1039− | otherwise = chunk (textP arr off y) empty :*:

1040− chunk (textP arr (off+y) (len-y)) cs

1250+ | otherwise = chunk (text arr off y) empty :*:

1251+ chunk (text arr (off+y) (len-y)) cs

10411252 where y = fromIntegral x

10421253

10431254-- | /O(n+m)/ Find the first instance of @needle@ (which must be

@@ -1056,7 +1267,7 @@ splitAtWord x (Chunk c@(T.Text arr off len) cs)

10561267-- > where (prefix, match) = breakOn needle haystack

10571268--

10581269-- If you need to break a string by a substring repeatedly (e.g. you

1059−-- want to break on every instance of a substring), use 'find'

1270+-- want to break on every instance of a substring), use 'breakOnAll'

10601271-- instead, as it has lower startup overhead.

10611272--

10621273-- This function is strict in its first argument, and lazy in its

@@ -1181,28 +1392,34 @@ tails ts@(Chunk t ts')

11811392-- copies to create substrings; they just construct new 'Text's that

11821393-- are slices of the original.

11831394

1184−-- | /O(m+n)/ Break a 'Text' into pieces separated by the first

1185−-- 'Text' argument, consuming the delimiter. An empty delimiter is

1186−-- invalid, and will cause an error to be raised.

1395+-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'

1396+-- argument (which cannot be an empty string), consuming the

1397+-- delimiter. An empty delimiter is invalid, and will cause an error

1398+-- to be raised.

11871399--

11881400-- Examples:

11891401--

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

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

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

1193−--

1405+--

11941406-- and

11951407--

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

11971409-- > splitOn (singleton c) == split (==c)

11981410--

1411+-- (Note: the string @s@ to split on above cannot be empty.)

1412+--

11991413-- This function is strict in its first argument, and lazy in its

12001414-- second.

12011415--

12021416-- In (unlikely) bad cases, this function's time complexity degrades

12031417-- towards /O(n*m)/.

1204−splitOn :: Text -- ^ Text to split on

1205− -> Text -- ^ Input text

1418+splitOn :: Text

1419+ -- ^ String to split on. If this string is empty, an error

1420+ -- will occur.

1421+ -> Text

1422+ -- ^ Input text.

12061423 -> [Text]

12071424splitOn pat src

12081425 | null pat = emptyError "splitOn"

Data/Text/Lazy/Builder.hs+18−272

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

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

8−--

11+-- License : BSD-style (see LICENSE)

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.Internal.Builder

Data/Text/Lazy/Builder/Int.hs+147−37

@@ -1,8 +1,13 @@

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

1+{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,

2+ UnboxedTuples #-}

3+#if __GLASGOW_HASKELL__ >= 702

4+{-# LANGUAGE Trustworthy #-}

5+#endif

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

5−-- License: BSD3

10+-- License: BSD-style

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

712-- Stability: experimental

813-- Portability: portable

@@ -17,45 +22,142 @@ module Data.Text.Lazy.Builder.Int

1722

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

1924import Data.Monoid (mempty)

20−import Data.Text.Lazy.Builder.Functions ((<>), i2d)

21−import Data.Text.Lazy.Builder

25+import qualified Data.ByteString.Unsafe as B

26+import Data.Text.Internal.Builder.Functions ((<>), i2d)

27+import Data.Text.Internal.Builder

28+import Data.Text.Internal.Builder.Int.Digits (digits)

29+import Data.Text.Array

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

2331import GHC.Base (quotInt, remInt)

2432import GHC.Num (quotRemInteger)

2533import GHC.Types (Int(..))

34+import Control.Monad.ST

2635

2736#ifdef __GLASGOW_HASKELL__

28−# if __GLASGOW_HASKELL__ < 611

29−import GHC.Integer.Internals

37+# if defined(INTEGER_GMP)

38+import GHC.Integer.GMP.Internals (Integer(S#))

39+# elif defined(INTEGER_SIMPLE)

40+import GHC.Integer

3041# else

31−import GHC.Integer.GMP.Internals

42+# error "You need to use either GMP or integer-simple."

3243# endif

3344#endif

3445

35−#ifdef INTEGER_GMP

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

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

3748#else

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

3950#endif

4051

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

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

43−{-# 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/Int8" decimal = boundedDecimal :: Int8 -> Builder #-}

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

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

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

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

58+{-# RULES "decimal/Word" decimal = positive :: Data.Word.Word -> Builder #-}

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

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

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

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

5263{-# 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)

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

65+{-# NOINLINE decimal #-}

66+

67+boundedDecimal :: (Integral a, Bounded a) => a -> Builder

68+{-# SPECIALIZE boundedDecimal :: Int -> Builder #-}

69+{-# SPECIALIZE boundedDecimal :: Int8 -> Builder #-}

70+{-# SPECIALIZE boundedDecimal :: Int16 -> Builder #-}

71+{-# SPECIALIZE boundedDecimal :: Int32 -> Builder #-}

72+{-# SPECIALIZE boundedDecimal :: Int64 -> Builder #-}

73+boundedDecimal i = decimal' (== minBound) i

74+

75+decimal' :: (Integral a) => (a -> Bool) -> a -> Builder

76+{-# INLINE decimal' #-}

77+decimal' p i

78+ | i < 0 = if p i

79+ then let (q, r) = i `quotRem` 10

80+ qq = -q

81+ !n = countDigits qq

82+ in writeN (n + 2) $ \marr off -> do

83+ unsafeWrite marr off minus

84+ posDecimal marr (off+1) n qq

85+ unsafeWrite marr (off+n+1) (i2w (-r))

86+ else let j = -i

87+ !n = countDigits j

88+ in writeN (n + 1) $ \marr off ->

89+ unsafeWrite marr off minus >> posDecimal marr (off+1) n j

90+ | otherwise = positive i

91+

92+positive :: (Integral a) => a -> Builder

93+{-# SPECIALIZE positive :: Int -> Builder #-}

94+{-# SPECIALIZE positive :: Int8 -> Builder #-}

95+{-# SPECIALIZE positive :: Int16 -> Builder #-}

96+{-# SPECIALIZE positive :: Int32 -> Builder #-}

97+{-# SPECIALIZE positive :: Int64 -> Builder #-}

98+{-# SPECIALIZE positive :: Word -> Builder #-}

99+{-# SPECIALIZE positive :: Word8 -> Builder #-}

100+{-# SPECIALIZE positive :: Word16 -> Builder #-}

101+{-# SPECIALIZE positive :: Word32 -> Builder #-}

102+{-# SPECIALIZE positive :: Word64 -> Builder #-}

103+positive i

104+ | i < 10 = writeN 1 $ \marr off -> unsafeWrite marr off (i2w i)

105+ | otherwise = let !n = countDigits i

106+ in writeN n $ \marr off -> posDecimal marr off n i

107+

108+posDecimal :: (Integral a) =>

109+ forall s. MArray s -> Int -> Int -> a -> ST s ()

110+{-# INLINE posDecimal #-}

111+posDecimal marr off0 ds v0 = go (off0 + ds - 1) v0

112+ where go off v

113+ | v >= 100 = do

114+ let (q, r) = v `quotRem` 100

115+ write2 off r

116+ go (off - 2) q

117+ | v < 10 = unsafeWrite marr off (i2w v)

118+ | otherwise = write2 off v

119+ write2 off i0 = do

120+ let i = fromIntegral i0; j = i + i

121+ unsafeWrite marr off $ get (j + 1)

122+ unsafeWrite marr (off - 1) $ get j

123+ get = fromIntegral . B.unsafeIndex digits

124+

125+minus, zero :: Word16

126+{-# INLINE minus #-}

127+{-# INLINE zero #-}

128+minus = 45

129+zero = 48

130+

131+i2w :: (Integral a) => a -> Word16

132+{-# INLINE i2w #-}

133+i2w v = zero + fromIntegral v

134+

135+countDigits :: (Integral a) => a -> Int

136+{-# INLINE countDigits #-}

137+countDigits v0

138+ | fromIntegral v64 == v0 = go 1 v64

139+ | otherwise = goBig 1 (fromIntegral v0)

140+ where v64 = fromIntegral v0

141+ goBig !k (v :: Integer)

142+ | v > big = goBig (k + 19) (v `quot` big)

143+ | otherwise = go k (fromIntegral v)

144+ big = 10000000000000000000

145+ go !k (v :: Word64)

146+ | v < 10 = k

147+ | v < 100 = k + 1

148+ | v < 1000 = k + 2

149+ | v < 1000000000000 =

150+ k + if v < 100000000

151+ then if v < 1000000

152+ then if v < 10000

153+ then 3

154+ else 4 + fin v 100000

155+ else 6 + fin v 10000000

156+ else if v < 10000000000

157+ then 8 + fin v 1000000000

158+ else 10 + fin v 100000000000

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

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

59161

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

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

@@ -68,17 +170,23 @@ hexadecimal :: Integral a => a -> Builder

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

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

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

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

173+{-# RULES "hexadecimal/Integer"

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

72175hexadecimal i

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

176+ | i < 0 = error hexErrMsg

74177 | otherwise = go i

75178 where

76179 go n | n < 16 = hexDigit n

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

181+{-# NOINLINE[0] hexadecimal #-}

182+

183+hexInteger :: Integer -> Builder

184+hexInteger i

185+ | i < 0 = error hexErrMsg

186+ | otherwise = integer 16 i

78187

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

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

81−{-# INLINE digit #-}

188+hexErrMsg :: String

189+hexErrMsg = "Data.Text.Lazy.Builder.Int.hexadecimal: applied to negative number"

82190

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

84192hexDigit n

@@ -86,15 +194,13 @@ hexDigit n

86194 | otherwise = singleton $! toEnum (fromIntegral n + 87)

87195{-# INLINE hexDigit #-}

88196

89−int :: Int -> Builder

90−int = decimal

91−{-# INLINE int #-}

92−

93197data T = T !Integer !Int

94198

95199integer :: Int -> Integer -> Builder

200+#ifdef INTEGER_GMP

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

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

203+#endif

98204integer base i

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

100206 | otherwise = go i

@@ -141,12 +247,16 @@ integer base i

141247 PAIR(x,y) -> pblock q <> pblock r <> putB ns

142248 where q = fromInteger x

143249 r = fromInteger y

144− putB _ = mempty

250+ putB _ = Data.Monoid.mempty

251+

252+ int :: Int -> Builder

253+ int x | base == 10 = decimal x

254+ | otherwise = hexadecimal x

145255

146256 pblock = loop maxDigits

147257 where

148258 loop !d !n

149− | d == 1 = digit n

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

259+ | d == 1 = hexDigit n

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

151261 where q = n `quotInt` base

152262 r = n `remInt` base

Data/Text/Lazy/Builder/RealFloat.hs+6−3

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

@@ -16,9 +19,9 @@ module Data.Text.Lazy.Builder.RealFloat

1619

1720import Data.Array.Base (unsafeAt)

1821import Data.Array.IArray

19−import Data.Text.Lazy.Builder.Functions ((<>), i2d)

22+import Data.Text.Internal.Builder.Functions ((<>), i2d)

2023import Data.Text.Lazy.Builder.Int (decimal)

21−import Data.Text.Lazy.Builder.RealFloat.Functions (roundTo)

24+import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)

2225import Data.Text.Lazy.Builder

2326import qualified Data.Text as T

2427

Data/Text/Lazy/Builder/RealFloat/Functions.hsdeleted−25

@@ -1,25 +0,0 @@

1−-- |

2−-- Module: Data.Text.Lazy.Builder.RealFloat.Functions

3−-- Copyright: (c) The University of Glasgow 1994-2002

4−-- License: see libraries/base/LICENSE

5−

6−module Data.Text.Lazy.Builder.RealFloat.Functions

7− (

8− roundTo

9− ) where

10−

11−roundTo :: Int -> [Int] -> (Int,[Int])

12−roundTo d is =

13− case f d is of

14− x@(0,_) -> x

15− (1,xs) -> (1, 1:xs)

16− _ -> error "roundTo: bad Value"

17− where

18− f n [] = (0, replicate n 0)

19− f 0 (x:_) = (if x >= 5 then 1 else 0, [])

20− f n (i:xs)

21− | i' == 10 = (1,0:ds)

22− | otherwise = (0,i':ds)

23− where

24− (c,ds) = f (n-1) xs

25− i' = c + i

Data/Text/Lazy/Encoding.hs+57−47

@@ -1,11 +1,13 @@

1−{-# LANGUAGE BangPatterns #-}

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

2+#if __GLASGOW_HASKELL__ >= 702

3+{-# LANGUAGE Trustworthy #-}

4+#endif

25-- |

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

58--

69-- License : BSD-style

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

8−-- duncan@haskell.org

10+-- Maintainer : bos@serpentine.com

911-- Stability : experimental

1012-- Portability : portable

1113--

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

2022 -- * Decoding ByteStrings to Text

2123 -- $strict

2224 decodeASCII

25+ , decodeLatin1

2326 , decodeUtf8

2427 , decodeUtf16LE

2528 , decodeUtf16BE

@@ -42,21 +45,29 @@ module Data.Text.Lazy.Encoding

4245 , encodeUtf16BE

4346 , encodeUtf32LE

4447 , encodeUtf32BE

48+

49+ -- * Encoding Text using ByteString Builders

50+ , encodeUtf8Builder

51+ , encodeUtf8BuilderEscaped

4552 ) where

4653

4754import Control.Exception (evaluate, try)

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

55+import Data.Monoid (Monoid(..))

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

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

51−import System.IO.Unsafe (unsafePerformIO)

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

58+import Data.Word (Word8)

5259import qualified Data.ByteString as S

60+import qualified Data.ByteString.Builder as B

61+import qualified Data.ByteString.Builder.Extra as B (safeStrategy, toLazyByteStringWith)

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

5363import qualified Data.ByteString.Lazy as B

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

55−import qualified Data.ByteString.Unsafe as S

65+import qualified Data.ByteString.Unsafe as B

5666import qualified Data.Text as T

5767import qualified Data.Text.Encoding as TE

58−import qualified Data.Text.Lazy.Encoding.Fusion as E

59−import qualified Data.Text.Lazy.Fusion as F

68+import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E

69+import qualified Data.Text.Internal.Lazy.Fusion as F

70+import Data.Text.Unsafe (unsafeDupablePerformIO)

6071

6172-- $strict

6273--

@@ -73,49 +84,30 @@ import qualified Data.Text.Lazy.Fusion as F

7384

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

7586-- encoded text.

76−--

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

7887decodeASCII :: B.ByteString -> Text

7988decodeASCII = decodeUtf8

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

8190

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

92+decodeLatin1 :: B.ByteString -> Text

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

94+

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

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

84−decodeUtf8With onErr bs0 = fast bs0

97+decodeUtf8With onErr (B.Chunk b0 bs0) =

98+ case TE.streamDecodeUtf8With onErr b0 of

99+ TE.Some t l f -> chunk t (go f l bs0)

85100 where

86− decode = TE.decodeUtf8With onErr

87− fast (B.Chunk p ps) | isComplete p = chunk (decode p) (fast ps)

88− | otherwise = chunk (decode h) (slow t ps)

89− where (h,t) = S.splitAt pivot p

90− pivot | at 1 = len-1

91− | at 2 = len-2

92− | otherwise = len-3

93− len = S.length p

94− at n = len >= n && S.unsafeIndex p (len-n) .&. 0xc0 == 0xc0

95− fast B.Empty = empty

96− slow i bs = {-# SCC "decodeUtf8With'/slow" #-}

97− case B.uncons bs of

98− Just (w,bs') | isComplete i' -> chunk (decode i') (fast bs')

99− | otherwise -> slow i' bs'

100− where i' = S.snoc i w

101− Nothing -> case S.uncons i of

102− Just (j,i') ->

103− case onErr desc (Just j) of

104− Nothing -> slow i' bs

105− Just c -> Chunk (T.singleton c) (slow i' bs)

106− Nothing ->

107− case onErr desc Nothing of

108− Nothing -> empty

109− Just c -> Chunk (T.singleton c) empty

110− isComplete bs = {-# SCC "decodeUtf8With'/isComplete" #-}

111− ix 1 .&. 0x80 == 0 ||

112− (len >= 2 && ix 2 .&. 0xe0 == 0xc0) ||

113− (len >= 3 && ix 3 .&. 0xf0 == 0xe0) ||

114− (len >= 4 && ix 4 .&. 0xf8 == 0xf0)

115− where len = S.length bs

116− ix n = S.unsafeIndex bs (len-n)

101+ go f0 _ (B.Chunk b bs) =

102+ case f0 b of

103+ TE.Some t l f -> chunk t (go f l bs)

104+ go _ l _

105+ | S.null l = empty

106+ | otherwise = case onErr desc (Just (B.unsafeHead l)) of

107+ Nothing -> empty

108+ Just c -> Chunk (T.singleton c) Empty

117109 desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"

118−{-# INLINE[0] decodeUtf8With #-}

110+decodeUtf8With _ _ = empty

119111

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

121113-- to be valid.

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

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

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

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

144−decodeUtf8' bs = unsafePerformIO $ do

136+decodeUtf8' bs = unsafeDupablePerformIO $ do

145137 let t = decodeUtf8 bs

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

147139 where

@@ -150,8 +142,26 @@ decodeUtf8' bs = unsafePerformIO $ do

150142{-# INLINE decodeUtf8' #-}

151143

152144encodeUtf8 :: Text -> B.ByteString

153−encodeUtf8 (Chunk c cs) = B.Chunk (TE.encodeUtf8 c) (encodeUtf8 cs)

154−encodeUtf8 Empty = B.Empty

145+encodeUtf8 Empty = B.empty

146+encodeUtf8 lt@(Chunk t _) =

147+ B.toLazyByteStringWith strategy B.empty $ encodeUtf8Builder lt

148+ where

149+ -- To improve our small string performance, we use a strategy that

150+ -- allocates a buffer that is guaranteed to be large enough for the

151+ -- encoding of the first chunk, but not larger than the default

152+ -- B.smallChunkSize. We clamp the firstChunkSize to ensure that we don't

153+ -- generate too large buffers which hamper streaming.

154+ firstChunkSize = min B.smallChunkSize (4 * (T.length t + 1))

155+ strategy = B.safeStrategy firstChunkSize B.defaultChunkSize

156+

157+encodeUtf8Builder :: Text -> B.Builder

158+encodeUtf8Builder =

159+ foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) Data.Monoid.mempty

160+

161+{-# INLINE encodeUtf8BuilderEscaped #-}

162+encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder

163+encodeUtf8BuilderEscaped prim =

164+ foldrChunks (\c b -> TE.encodeUtf8BuilderEscaped prim c `mappend` b) mempty

155165

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

157167decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text

Data/Text/Lazy/IO.hs+11−22

@@ -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,22 +41,17 @@ 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)

55−import Data.Text.IO.Internal (hGetLineWith, readChunk)

56−import Data.Text.Lazy.Internal (chunk, empty)

53+import Data.Text.Internal.IO (hGetLineWith, readChunk)

54+import Data.Text.Internal.Lazy (chunk, empty)

5755import GHC.IO.Buffer (isEmptyBuffer)

5856import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException)

5957import GHC.IO.Handle.Internals (augmentIOError, hClose_help,

@@ -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+7−105

@@ -1,118 +1,20 @@

11{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}

22-- |

33-- Module : Data.Text.Lazy.Internal

55--

66-- License : BSD-style

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

8−-- duncan@haskell.org

7+-- Maintainer : bos@serpentine.com

98-- Stability : experimental

109-- Portability : GHC

11−--

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

13−-- 'Text' representation and low level construction functions.

14−-- Modules which extend the 'Text' system may need to use this module.

1510--

16−-- You should not use this module unless you are determined to monkey

17−-- with the internals, as the functions here do just about nothing to

18−-- preserve data invariants. You have been warned!

11+-- This module has been renamed to 'Data.Text.Internal.Lazy'. This

12+-- name for the module will be removed in the next major release.

1913

2014module Data.Text.Lazy.Internal

15+ {-# DEPRECATED "Use Data.Text.Internal.Lazy instead" #-}

2116 (

22− Text(..)

23− , chunk

24− , empty

25− , foldrChunks

26− , foldlChunks

27− -- * Data type invariant and abstraction functions

28−

29− -- $invariant

30− , strictInvariant

31− , lazyInvariant

32− , showStructure

33−

34− -- * Chunk allocation sizes

35− , defaultChunkSize

36− , smallChunkSize

37− , chunkOverhead

17+ module Data.Text.Internal.Lazy

3818 ) where

3919

40−import Data.Text ()

41−import Data.Text.UnsafeShift (shiftL)

42−import Data.Typeable (Typeable)

43−import Foreign.Storable (sizeOf)

44−import qualified Data.Text.Internal as T

45−

46−data Text = Empty

47− | Chunk {-# UNPACK #-} !T.Text Text

48− deriving (Typeable)

49−

50−-- $invariant

51−--

52−-- The data type invariant for lazy 'Text': Every 'Text' is either 'Empty' or

53−-- consists of non-null 'T.Text's. All functions must preserve this,

54−-- and the QC properties must check this.

55−

56−-- | Check the invariant strictly.

57−strictInvariant :: Text -> Bool

58−strictInvariant Empty = True

59−strictInvariant x@(Chunk (T.Text _ _ len) cs)

60− | len > 0 = strictInvariant cs

61− | otherwise = error $ "Data.Text.Lazy: invariant violation: "

62− ++ showStructure x

63−

64−-- | Check the invariant lazily.

65−lazyInvariant :: Text -> Text

66−lazyInvariant Empty = Empty

67−lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)

68− | len > 0 = Chunk c (lazyInvariant cs)

69− | otherwise = error $ "Data.Text.Lazy: invariant violation: "

70− ++ showStructure x

71−

72−-- | Display the internal structure of a lazy 'Text'.

73−showStructure :: Text -> String

74−showStructure Empty = "Empty"

75−showStructure (Chunk t Empty) = "Chunk " ++ show t ++ " Empty"

76−showStructure (Chunk t ts) =

77− "Chunk " ++ show t ++ " (" ++ showStructure ts ++ ")"

78−

79−-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.

80−chunk :: T.Text -> Text -> Text

81−{-# INLINE chunk #-}

82−chunk t@(T.Text _ _ len) ts | len == 0 = ts

83− | otherwise = Chunk t ts

84−

85−-- | Smart constructor for 'Empty'.

86−empty :: Text

87−{-# INLINE [0] empty #-}

88−empty = Empty

89−

90−-- | Consume the chunks of a lazy 'Text' with a natural right fold.

91−foldrChunks :: (T.Text -> a -> a) -> a -> Text -> a

92−foldrChunks f z = go

93− where go Empty = z

94− go (Chunk c cs) = f c (go cs)

95−{-# INLINE foldrChunks #-}

96−

97−-- | Consume the chunks of a lazy 'Text' with a strict, tail-recursive,

98−-- accumulating left fold.

99−foldlChunks :: (a -> T.Text -> a) -> a -> Text -> a

100−foldlChunks f z = go z

101− where go !a Empty = a

102− go !a (Chunk c cs) = go (f a c) cs

103−{-# INLINE foldlChunks #-}

104−

105−-- | Currently set to 16 KiB, less the memory management overhead.

106−defaultChunkSize :: Int

107−defaultChunkSize = 16384 - chunkOverhead

108−{-# INLINE defaultChunkSize #-}

109−

110−-- | Currently set to 128 bytes, less the memory management overhead.

111−smallChunkSize :: Int

112−smallChunkSize = 128 - chunkOverhead

113−{-# INLINE smallChunkSize #-}

114−

115−-- | The memory management overhead. Currently this is tuned for GHC only.

116−chunkOverhead :: Int

117−chunkOverhead = sizeOf (undefined :: Int) `shiftL` 1

118−{-# INLINE chunkOverhead #-}

20+import Data.Text.Internal.Lazy

Data/Text/Lazy/Read.hs+40−39

@@ -1,12 +1,16 @@

1−{-# LANGUAGE OverloadedStrings #-}

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

2+#if __GLASGOW_HASKELL__ >= 704

3+{-# LANGUAGE Safe #-}

4+#elif __GLASGOW_HASKELL__ >= 702

5+{-# LANGUAGE Trustworthy #-}

6+#endif

38-- |

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

611--

712-- License : BSD-style

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

9−-- duncan@haskell.org

13+-- Maintainer : bos@serpentine.com

1014-- Stability : experimental

1115-- Portability : GHC

1216--

@@ -22,13 +26,17 @@ module Data.Text.Lazy.Read

2226 ) where

2327

2428import Control.Monad (liftM)

25−import Data.Char (isDigit, isHexDigit, ord)

29+import Data.Char (isDigit, isHexDigit)

30+import Data.Int (Int8, Int16, Int32, Int64)

2631import Data.Ratio ((%))

32+import Data.Text.Internal.Read

2733import Data.Text.Lazy as T

34+import Data.Word (Word, Word8, Word16, Word32, Word64)

2835

2936-- | Read some text. If the read succeeds, return its value and the

3037-- remaining text, otherwise an error message.

31−type Reader a = Text -> Either String (a,Text)

38+type Reader a = IReader Text a

39+type Parser = IParser Text

3240

3341-- | Read a decimal integer. The input must begin with at least one

3442-- decimal digit, and is consumed until a non-digit or end of string

@@ -43,7 +51,16 @@ type Reader a = Text -> Either String (a,Text)

4351-- 'Integer' for your result type.

4452decimal :: Integral a => Reader a

4553{-# SPECIALIZE decimal :: Reader Int #-}

54+{-# SPECIALIZE decimal :: Reader Int8 #-}

55+{-# SPECIALIZE decimal :: Reader Int16 #-}

56+{-# SPECIALIZE decimal :: Reader Int32 #-}

57+{-# SPECIALIZE decimal :: Reader Int64 #-}

4658{-# SPECIALIZE decimal :: Reader Integer #-}

59+{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}

60+{-# SPECIALIZE decimal :: Reader Word8 #-}

61+{-# SPECIALIZE decimal :: Reader Word16 #-}

62+{-# SPECIALIZE decimal :: Reader Word32 #-}

63+{-# SPECIALIZE decimal :: Reader Word64 #-}

4764decimal txt

4865 | T.null h = Left "input does not start with a digit"

4966 | otherwise = Right (T.foldl' go 0 h, t)

@@ -71,23 +88,23 @@ hexadecimal txt

7188 where (h,t) = T.splitAt 2 txt

7289

7390hex :: Integral a => Reader a

74−{-# SPECIALIZE hex :: Reader Int #-}

75−{-# SPECIALIZE hex :: Reader Integer #-}

91+{-# SPECIALIZE hexadecimal :: Reader Int #-}

92+{-# SPECIALIZE hexadecimal :: Reader Int8 #-}

93+{-# SPECIALIZE hexadecimal :: Reader Int16 #-}

94+{-# SPECIALIZE hexadecimal :: Reader Int32 #-}

95+{-# SPECIALIZE hexadecimal :: Reader Int64 #-}

96+{-# SPECIALIZE hexadecimal :: Reader Integer #-}

97+{-# SPECIALIZE hexadecimal :: Reader Word #-}

98+{-# SPECIALIZE hexadecimal :: Reader Word8 #-}

99+{-# SPECIALIZE hexadecimal :: Reader Word16 #-}

100+{-# SPECIALIZE hexadecimal :: Reader Word32 #-}

101+{-# SPECIALIZE hexadecimal :: Reader Word64 #-}

76102hex txt

77103 | T.null h = Left "input does not start with a hexadecimal digit"

78104 | otherwise = Right (T.foldl' go 0 h, t)

79105 where (h,t) = T.span isHexDigit txt

80106 go n d = (n * 16 + fromIntegral (hexDigitToInt d))

81107

82−hexDigitToInt :: Char -> Int

83−hexDigitToInt c

84− | c >= '0' && c <= '9' = ord c - ord '0'

85− | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)

86− | otherwise = ord c - (ord 'A' - 10)

87−

88−digitToInt :: Char -> Int

89−digitToInt c = ord c - ord '0'

90−

91108-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and

92109-- apply it to the result of applying the given reader.

93110signed :: Num a => Reader a -> Reader a

@@ -114,7 +131,7 @@ signed f = runP (signa (P f))

114131--

115132-- >rational "3.foo" == Right (3.0, ".foo")

116133-- >rational "3e" == Right (3.0, "e")

117−rational :: RealFloat a => Reader a

134+rational :: Fractional a => Reader a

118135{-# SPECIALIZE rational :: Reader Double #-}

119136rational = floaty $ \real frac fracDenom -> fromRational $

120137 real % 1 + frac % fracDenom

@@ -138,37 +155,21 @@ double = floaty $ \real frac fracDenom ->

138155

139156signa :: Num a => Parser a -> Parser a

140157{-# SPECIALIZE signa :: Parser Int -> Parser Int #-}

158+{-# SPECIALIZE signa :: Parser Int8 -> Parser Int8 #-}

159+{-# SPECIALIZE signa :: Parser Int16 -> Parser Int16 #-}

160+{-# SPECIALIZE signa :: Parser Int32 -> Parser Int32 #-}

161+{-# SPECIALIZE signa :: Parser Int64 -> Parser Int64 #-}

141162{-# SPECIALIZE signa :: Parser Integer -> Parser Integer #-}

142163signa p = do

143164 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')

144165 if sign == '+' then p else negate `liftM` p

145166

146−newtype Parser a = P {

147− runP :: Reader a

148− }

149−

150−instance Monad Parser where

151− return a = P $ \t -> Right (a,t)

152− {-# INLINE return #-}

153− m >>= k = P $ \t -> case runP m t of

154− Left err -> Left err

155− Right (a,t') -> runP (k a) t'

156− {-# INLINE (>>=) #-}

157− fail msg = P $ \_ -> Left msg

158−

159−perhaps :: a -> Parser a -> Parser a

160−perhaps def m = P $ \t -> case runP m t of

161− Left _ -> Right (def,t)

162− r@(Right _) -> r

163−

164167char :: (Char -> Bool) -> Parser Char

165168char p = P $ \t -> case T.uncons t of

166169 Just (c,t') | p c -> Right (c,t')

167170 _ -> Left "character does not match"

168171

169−data T = T !Integer !Int

170−

171−floaty :: RealFloat a => (Integer -> Integer -> Integer -> a) -> Reader a

172+floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a

172173{-# INLINE floaty #-}

173174floaty f = runP $ do

174175 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')

Data/Text/Read.hs+48−39

@@ -1,12 +1,14 @@

1−{-# LANGUAGE OverloadedStrings #-}

1+{-# LANGUAGE OverloadedStrings, UnboxedTuples, CPP #-}

2+#if __GLASGOW_HASKELL__ >= 702

3+{-# LANGUAGE Trustworthy #-}

4+#endif

36-- |

47-- Module : Data.Text.Read

69--

710-- License : BSD-style

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

9−-- duncan@haskell.org

11+-- Maintainer : bos@serpentine.com

1012-- Stability : experimental

1113-- Portability : GHC

1214--

@@ -22,13 +24,18 @@ module Data.Text.Read

2224 ) where

2325

2426import Control.Monad (liftM)

25−import Data.Char (isDigit, isHexDigit, ord)

27+import Data.Char (isDigit, isHexDigit)

28+import Data.Int (Int8, Int16, Int32, Int64)

2629import Data.Ratio ((%))

2730import Data.Text as T

31+import Data.Text.Internal.Private (span_)

32+import Data.Text.Internal.Read

33+import Data.Word (Word, Word8, Word16, Word32, Word64)

2834

2935-- | Read some text. If the read succeeds, return its value and the

3036-- remaining text, otherwise an error message.

31−type Reader a = Text -> Either String (a,Text)

37+type Reader a = IReader Text a

38+type Parser a = IParser Text a

3239

3340-- | Read a decimal integer. The input must begin with at least one

3441-- decimal digit, and is consumed until a non-digit or end of string

@@ -43,11 +50,20 @@ type Reader a = Text -> Either String (a,Text)

4350-- 'Integer' for your result type.

4451decimal :: Integral a => Reader a

4552{-# SPECIALIZE decimal :: Reader Int #-}

53+{-# SPECIALIZE decimal :: Reader Int8 #-}

54+{-# SPECIALIZE decimal :: Reader Int16 #-}

55+{-# SPECIALIZE decimal :: Reader Int32 #-}

56+{-# SPECIALIZE decimal :: Reader Int64 #-}

4657{-# SPECIALIZE decimal :: Reader Integer #-}

58+{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}

59+{-# SPECIALIZE decimal :: Reader Word8 #-}

60+{-# SPECIALIZE decimal :: Reader Word16 #-}

61+{-# SPECIALIZE decimal :: Reader Word32 #-}

62+{-# SPECIALIZE decimal :: Reader Word64 #-}

4763decimal txt

4864 | T.null h = Left "input does not start with a digit"

4965 | otherwise = Right (T.foldl' go 0 h, t)

50− where (h,t) = T.span isDigit txt

66+ where (# h,t #) = span_ isDigit txt

5167 go n d = (n * 10 + fromIntegral (digitToInt d))

5268

5369-- | Read a hexadecimal integer, consisting of an optional leading

@@ -64,7 +80,16 @@ decimal txt

6480-- 'Integer' for your result type.

6581hexadecimal :: Integral a => Reader a

6682{-# SPECIALIZE hexadecimal :: Reader Int #-}

83+{-# SPECIALIZE hexadecimal :: Reader Int8 #-}

84+{-# SPECIALIZE hexadecimal :: Reader Int16 #-}

85+{-# SPECIALIZE hexadecimal :: Reader Int32 #-}

86+{-# SPECIALIZE hexadecimal :: Reader Int64 #-}

6787{-# SPECIALIZE hexadecimal :: Reader Integer #-}

88+{-# SPECIALIZE hexadecimal :: Reader Word #-}

89+{-# SPECIALIZE hexadecimal :: Reader Word8 #-}

90+{-# SPECIALIZE hexadecimal :: Reader Word16 #-}

91+{-# SPECIALIZE hexadecimal :: Reader Word32 #-}

92+{-# SPECIALIZE hexadecimal :: Reader Word64 #-}

6893hexadecimal txt

6994 | h == "0x" || h == "0X" = hex t

7095 | otherwise = hex txt

@@ -72,22 +97,22 @@ hexadecimal txt

7297

7398hex :: Integral a => Reader a

7499{-# SPECIALIZE hex :: Reader Int #-}

100+{-# SPECIALIZE hex :: Reader Int8 #-}

101+{-# SPECIALIZE hex :: Reader Int16 #-}

102+{-# SPECIALIZE hex :: Reader Int32 #-}

103+{-# SPECIALIZE hex :: Reader Int64 #-}

75104{-# SPECIALIZE hex :: Reader Integer #-}

105+{-# SPECIALIZE hex :: Reader Word #-}

106+{-# SPECIALIZE hex :: Reader Word8 #-}

107+{-# SPECIALIZE hex :: Reader Word16 #-}

108+{-# SPECIALIZE hex :: Reader Word32 #-}

109+{-# SPECIALIZE hex :: Reader Word64 #-}

76110hex txt

77111 | T.null h = Left "input does not start with a hexadecimal digit"

78112 | otherwise = Right (T.foldl' go 0 h, t)

79− where (h,t) = T.span isHexDigit txt

113+ where (# h,t #) = span_ isHexDigit txt

80114 go n d = (n * 16 + fromIntegral (hexDigitToInt d))

81115

82−hexDigitToInt :: Char -> Int

83−hexDigitToInt c

84− | c >= '0' && c <= '9' = ord c - ord '0'

85− | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)

86− | otherwise = ord c - (ord 'A' - 10)

87−

88−digitToInt :: Char -> Int

89−digitToInt c = ord c - ord '0'

90−

91116-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and

92117-- apply it to the result of applying the given reader.

93118signed :: Num a => Reader a -> Reader a

@@ -114,7 +139,7 @@ signed f = runP (signa (P f))

114139--

115140-- >rational "3.foo" == Right (3.0, ".foo")

116141-- >rational "3e" == Right (3.0, "e")

117−rational :: RealFloat a => Reader a

142+rational :: Fractional a => Reader a

118143{-# SPECIALIZE rational :: Reader Double #-}

119144rational = floaty $ \real frac fracDenom -> fromRational $

120145 real % 1 + frac % fracDenom

@@ -138,37 +163,21 @@ double = floaty $ \real frac fracDenom ->

138163

139164signa :: Num a => Parser a -> Parser a

140165{-# SPECIALIZE signa :: Parser Int -> Parser Int #-}

166+{-# SPECIALIZE signa :: Parser Int8 -> Parser Int8 #-}

167+{-# SPECIALIZE signa :: Parser Int16 -> Parser Int16 #-}

168+{-# SPECIALIZE signa :: Parser Int32 -> Parser Int32 #-}

169+{-# SPECIALIZE signa :: Parser Int64 -> Parser Int64 #-}

141170{-# SPECIALIZE signa :: Parser Integer -> Parser Integer #-}

142171signa p = do

143172 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')

144173 if sign == '+' then p else negate `liftM` p

145174

146−newtype Parser a = P {

147− runP :: Reader a

148− }

149−

150−instance Monad Parser where

151− return a = P $ \t -> Right (a,t)

152− {-# INLINE return #-}

153− m >>= k = P $ \t -> case runP m t of

154− Left err -> Left err

155− Right (a,t') -> runP (k a) t'

156− {-# INLINE (>>=) #-}

157− fail msg = P $ \_ -> Left msg

158−

159−perhaps :: a -> Parser a -> Parser a

160−perhaps def m = P $ \t -> case runP m t of

161− Left _ -> Right (def,t)

162− r@(Right _) -> r

163−

164175char :: (Char -> Bool) -> Parser Char

165176char p = P $ \t -> case T.uncons t of

166177 Just (c,t') | p c -> Right (c,t')

167178 _ -> Left "character does not match"

168179

169−data T = T !Integer !Int

170−

171−floaty :: RealFloat a => (Integer -> Integer -> Integer -> a) -> Reader a

180+floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a

172181{-# INLINE floaty #-}

173182floaty f = runP $ do

174183 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')

Data/Text/Show.hsnew file+89

@@ -0,0 +1,89 @@

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

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

3+#if __GLASGOW_HASKELL__ >= 702

4+{-# LANGUAGE Trustworthy #-}

5+#endif

7+-- |

8+-- Module : Data.Text.Show

10+--

11+-- License : BSD-style

12+-- Maintainer : bos@serpentine.com

13+-- Stability : experimental

14+-- Portability : GHC

15+

16+module Data.Text.Show

17+ (

18+ singleton

19+ , unpack

20+ , unpackCString#

21+ ) where

22+

23+import Control.Monad.ST (ST)

24+import Data.Text.Internal (Text(..), empty_, safe)

25+import Data.Text.Internal.Fusion (stream, unstream)

26+import Data.Text.Internal.Unsafe.Char (unsafeWrite)

27+import GHC.Prim (Addr#)

28+import qualified Data.Text.Array as A

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

30+

31+#if __GLASGOW_HASKELL__ >= 702

32+import qualified GHC.CString as GHC

33+#else

34+import qualified GHC.Base as GHC

35+#endif

36+

37+instance Show Text where

38+ showsPrec p ps r = showsPrec p (unpack ps) r

39+

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

41+unpack :: Text -> String

42+unpack = S.unstreamList . stream

43+{-# INLINE [1] unpack #-}

44+

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

46+-- fusion.

47+--

48+-- This is exposed solely for people writing GHC rewrite rules.

49+unpackCString# :: Addr# -> Text

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

51+{-# NOINLINE unpackCString# #-}

52+

53+{-# RULES "TEXT literal" [1] forall a.

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

55+ = unpackCString# a #-}

56+

57+{-# RULES "TEXT literal UTF8" [1] forall a.

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

59+ = unpackCString# a #-}

60+

61+{-# RULES "TEXT empty literal" [1]

62+ unstream (S.map safe (S.streamList []))

63+ = empty_ #-}

64+

65+{-# RULES "TEXT singleton literal" [1] forall a.

66+ unstream (S.map safe (S.streamList [a]))

67+ = singleton_ a #-}

68+

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

70+-- Performs replacement on invalid scalar values.

71+singleton :: Char -> Text

72+singleton = unstream . S.singleton . safe

73+{-# INLINE [1] singleton #-}

74+

75+{-# RULES "TEXT singleton" forall a.

76+ unstream (S.singleton (safe a))

77+ = singleton_ a #-}

78+

79+-- This is intended to reduce inlining bloat.

80+singleton_ :: Char -> Text

81+singleton_ c = Text (A.run x) 0 len

82+ where x :: ST s (A.MArray s)

83+ x = do arr <- A.new len

84+ _ <- unsafeWrite arr 0 d

85+ return arr

86+ len | d < '\x10000' = 1

87+ | otherwise = 2

88+ d = safe c

89+{-# NOINLINE singleton_ #-}

Data/Text/Unsafe.hs+19−7

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

33-- Module : Data.Text.Unsafe

55-- License : BSD-style

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

7−-- duncan@haskell.org

6+-- Maintainer : bos@serpentine.com

87-- Stability : experimental

98-- Portability : portable

109--

@@ -14,25 +13,28 @@ module Data.Text.Unsafe

1413 (

1514 inlineInterleaveST

1615 , inlinePerformIO

16+ , unsafeDupablePerformIO

1717 , Iter(..)

1818 , iter

1919 , iter_

2020 , reverseIter

21+ , reverseIter_

2122 , unsafeHead

2223 , unsafeTail

2324 , lengthWord16

2425 , takeWord16

2526 , dropWord16

2627 ) where

27−

28+

2829#if defined(ASSERTS)

2930import Control.Exception (assert)

3031#endif

31−import Data.Text.Encoding.Utf16 (chr2)

32+import Data.Text.Internal.Encoding.Utf16 (chr2)

3233import Data.Text.Internal (Text(..))

33−import Data.Text.Unsafe.Base (inlineInterleaveST, inlinePerformIO)

34−import Data.Text.UnsafeChar (unsafeChr)

34+import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)

35+import Data.Text.Internal.Unsafe.Char (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

@@ -93,6 +95,16 @@ reverseIter (Text arr off _len) i

9395 k = j - 1

9496{-# INLINE reverseIter #-}

9597

98+-- | /O(1)/ Iterate one step backwards through a UTF-16 array,

99+-- returning the delta to add (i.e. a negative number) to give the

100+-- next offset to iterate at.

101+reverseIter_ :: Text -> Int -> Int

102+reverseIter_ (Text arr off _len) i

103+ | m < 0xDC00 || m > 0xDFFF = -1

104+ | otherwise = -2

105+ where m = A.unsafeIndex arr (off+i)

106+{-# INLINE reverseIter_ #-}

107+

96108-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This

97109-- is useful for sizing a target array appropriately before using

98110-- 'unsafeCopyToPtr'.

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+26−20

@@ -9,25 +9,26 @@ 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.Mul as Mul

19+import qualified Benchmarks.Pure as Pure

20+import qualified Benchmarks.ReadNumbers as ReadNumbers

21+import qualified Benchmarks.Replace as Replace

22+import qualified Benchmarks.Search as Search

23+import qualified Benchmarks.Stream as Stream

24+import qualified Benchmarks.WordFrequencies as WordFrequencies

2425

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

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

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

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

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

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

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

3132

3233main :: IO ()

3334main = benchmarks >>= defaultMain

@@ -49,7 +50,12 @@ benchmarks = do

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

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

5152 , FoldLines.benchmark (tf "russian.txt")

52− , Pure.benchmark (tf "japanese.txt")

53+ , Mul.benchmark

54+ , Pure.benchmark "tiny" (tf "tiny.txt")

55+ , Pure.benchmark "ascii" (tf "ascii-small.txt")

56+ -- , Pure.benchmark "france" (tf "france.html")

57+ , Pure.benchmark "russian" (tf "russian-small.txt")

58+ , Pure.benchmark "japanese" (tf "japanese.txt")

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

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

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

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

7076 return $ bs ++ [ps]

7177 where

7278 -- Location of a test file

73− tf = ("../text-test-data" </>)

79+ 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+13−5

@@ -14,17 +14,18 @@

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(..))

23+import Data.ByteString.Lazy.Internal (ByteString(..))

2324import Foreign.Ptr (Ptr, plusPtr)

2425import Foreign.ForeignPtr (withForeignPtr)

2526import Data.Word (Word8)

2627import qualified Criterion as C

27−import Criterion (Benchmark, bgroup, nf)

28+import Criterion (Benchmark, bgroup, nf, whnfIO)

2829import qualified Codec.Binary.UTF8.Generic as U8

2930import qualified Data.ByteString as B

3031import qualified Data.ByteString.Lazy as BL

@@ -38,9 +39,16 @@ benchmark kind fp = do

3839 bs <- B.readFile fp

3940 lbs <- BL.readFile fp

4041 let bench name = C.bench (name ++ "+" ++ kind)

42+ decodeStream (Chunk b0 bs0) = case T.streamDecodeUtf8 b0 of

43+ T.Some t0 _ f0 -> t0 : go f0 bs0

44+ where go f (Chunk b bs1) = case f b of

45+ T.Some t1 _ f1 -> t1 : go f1 bs1

46+ go _ _ = []

47+ decodeStream _ = []

4148 return $ bgroup "DecodeUtf8"

4249 [ bench "Strict" $ nf T.decodeUtf8 bs

43− , bench "IConv" $ iconv bs

50+ , bench "Stream" $ nf decodeStream lbs

51+ , bench "IConv" $ whnfIO $ iconv bs

4452 , bench "StrictLength" $ nf (T.length . T.decodeUtf8) bs

4553 , bench "StrictInitLength" $ nf (T.length . T.init . T.decodeUtf8) bs

4654 , bench "Lazy" $ nf TL.decodeUtf8 lbs

@@ -52,7 +60,7 @@ benchmark kind fp = do

5260 , bench "LazyStringUtf8Length" $ nf (length . U8.toString) lbs

5361 ]

5462

55−iconv :: ByteString -> IO CInt

63+iconv :: B.ByteString -> IO CInt

5664iconv (PS fp off len) = withForeignPtr fp $ \ptr ->

5765 time_iconv (ptr `plusPtr` off) (fromIntegral len)

5866

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

benchmarks/haskell/Benchmarks/FileRead.hsnew file+33

@@ -0,0 +1,33 @@

1+-- | Benchmarks simple file reading

2+--

3+-- Tested in this benchmark:

4+--

5+-- * Reading a file from the disk

6+--

7+module Benchmarks.FileRead

8+ ( benchmark

9+ ) where

10+

11+import Control.Applicative ((<$>))

12+import Criterion (Benchmark, bgroup, bench, whnfIO)

13+import qualified Data.ByteString as SB

14+import qualified Data.ByteString.Lazy as LB

15+import qualified Data.Text as T

16+import qualified Data.Text.Encoding as T

17+import qualified Data.Text.IO as T

18+import qualified Data.Text.Lazy as LT

19+import qualified Data.Text.Lazy.Encoding as LT

20+import qualified Data.Text.Lazy.IO as LT

21+

22+benchmark :: FilePath -> IO Benchmark

23+benchmark p = return $ bgroup "FileRead"

24+ [ bench "String" $ whnfIO $ length <$> readFile p

25+ , bench "ByteString" $ whnfIO $ SB.length <$> SB.readFile p

26+ , bench "LazyByteString" $ whnfIO $ LB.length <$> LB.readFile p

27+ , bench "Text" $ whnfIO $ T.length <$> T.readFile p

28+ , bench "LazyText" $ whnfIO $ LT.length <$> LT.readFile p

29+ , bench "TextByteString" $ whnfIO $

30+ (T.length . T.decodeUtf8) <$> SB.readFile p

31+ , bench "LazyTextByteString" $ whnfIO $

32+ (LT.length . LT.decodeUtf8) <$> LB.readFile p

33+ ]

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

@@ -6,11 +6,11 @@

66-- * Buffered, line-based IO

77--

88{-# LANGUAGE BangPatterns #-}

9−module Data.Text.Benchmarks.FoldLines

9+module Benchmarks.FoldLines

1010 ( benchmark

1111 ) where

1212

13−import Criterion (Benchmark, bgroup, bench)

13+import Criterion (Benchmark, bgroup, bench, whnfIO)

1414import System.IO

1515import qualified Data.ByteString as B

1616import qualified Data.Text as T

@@ -22,7 +22,7 @@ benchmark fp = return $ bgroup "ReadLines"

2222 , bench "ByteString" $ withHandle $ foldLinesB (\n _ -> n + 1) (0 :: Int)

2323 ]

2424 where

25− withHandle f = do

25+ withHandle f = whnfIO $ do

2626 h <- openFile fp ReadMode

2727 hSetBuffering h (BlockBuffering (Just 16384))

2828 x <- f h

benchmarks/haskell/Benchmarks/Mul.hsnew file+138

@@ -0,0 +1,138 @@

1+module Benchmarks.Mul (benchmark) where

3+import Control.Exception (evaluate)

4+import Criterion.Main

5+import Data.Int (Int32, Int64)

6+import Data.Text.Internal (mul32, mul64)

7+import qualified Data.Vector.Unboxed as U

9+oldMul :: Int64 -> Int64 -> Int64

10+oldMul m n

11+ | n == 0 = 0

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

13+ | otherwise = error "overflow"

14+

15+benchmark :: IO Benchmark

16+benchmark = do

17+ _ <- evaluate testVector32

18+ _ <- evaluate testVector64

19+ return $ bgroup "Mul" [

20+ bench "oldMul" $ whnf (U.map (uncurry oldMul)) testVector64

21+ , bench "mul64" $ whnf (U.map (uncurry mul64)) testVector64

22+ , bench "*64" $ whnf (U.map (uncurry (*))) testVector64

23+ , bench "mul32" $ whnf (U.map (uncurry mul32)) testVector32

24+ , bench "*32" $ whnf (U.map (uncurry (*))) testVector32

25+ ]

26+

27+testVector64 :: U.Vector (Int64,Int64)

28+testVector64 = U.fromList [

29+ (0,1248868987182846646),(169004623633872,24458),(482549039517835,7614),

30+ (372,8157063115504364),(27,107095594861148252),(3,63249878517962420),

31+ (4363,255694473572912),(86678474,1732634806),(1572453024,1800489338),

32+ (9384523143,77053781),(49024709555,75095046),(7,43457620410239131),

33+ (8,8201563008844571),(387719037,1520696708),(189869238220197,1423),

34+ (46788016849611,23063),(503077742109974359,0),(104,1502010908706487),

35+ (30478140346,207525518),(80961140129236192,14),(4283,368012829143675),

36+ (1028719181728108146,6),(318904,5874863049591),(56724427166898,110794),

37+ (234539368,31369110449),(2,251729663598178612),(103291548194451219,5),

38+ (76013,5345328755566),(1769631,2980846129318),(40898,60598477385754),

39+ (0,98931348893227155),(573555872156917492,3),(318821187115,4476566),

40+ (11152874213584,243582),(40274276,16636653248),(127,4249988676030597),

41+ (103543712111871836,5),(71,16954462148248238),(3963027173504,216570),

42+ (13000,503523808916753),(17038308,20018685905),(0,510350226577891549),

43+ (175898,3875698895405),(425299191292676,5651),(17223451323664536,50),

44+ (61755131,14247665326),(0,1018195131697569303),(36433751497238985,20),

45+ (3473607861601050,1837),(1392342328,1733971838),(225770297367,3249655),

46+ (14,127545244155254102),(1751488975299136,2634),(3949208,504190668767),

47+ (153329,831454434345),(1066212122928663658,2),(351224,2663633539556),

48+ (344565,53388869217),(35825609350446863,54),(276011553660081475,10),

49+ (1969754174790470349,3),(35,68088438338633),(506710,3247689556438),

50+ (11099382291,327739909),(105787303549,32824363),(210366111,14759049409),

51+ (688893241579,3102676),(8490,70047474429581),(152085,29923000251880),

52+ (5046974599257095,400),(4183167795,263434071),(10089728,502781960687),

53+ (44831977765,4725378),(91,8978094664238578),(30990165721,44053350),

54+ (1772377,149651820860),(243420621763408572,4),(32,5790357453815138),

55+ (27980806337993771,5),(47696295759774,20848),(1745874142313778,1098),

56+ (46869334770121,1203),(886995283,1564424789),(40679396544,76002479),

57+ (1,672849481568486995),(337656187205,3157069),(816980552858963,6003),

58+ (2271434085804831543,1),(0,1934521023868747186),(6266220038281,15825),

59+ (4160,107115946987394),(524,246808621791561),(0,1952519482439636339),

60+ (128,2865935904539691),(1044,3211982069426297),(16000511542473,88922),

61+ (1253596745404082,2226),(27041,56836278958002),(23201,49247489754471),

62+ (175906590497,21252392),(185163584757182295,24),(34742225226802197,150),

63+ (2363228,250824838408),(216327527109550,45),(24,81574076994520675),

64+ (28559899906542,15356),(10890139774837133,511),(2293,707179303654492),

65+ (2749366833,40703233),(0,4498229704622845986),(439,4962056468281937),

66+ (662,1453820621089921),(16336770612459631,220),(24282989393,74239137),

67+ (2724564648490195,3),(743672760,124992589),(4528103,704330948891),

68+ (6050483122491561,250),(13322953,13594265152),(181794,22268101450214),

69+ (25957941712,75384092),(43352,7322262295009),(32838,52609059549923),

70+ (33003585202001564,2),(103019,68430142267402),(129918230800,8742978),

71+ (0,2114347379589080688),(2548,905723041545274),(222745067962838382,0),

72+ (1671683850790425181,1),(455,4836932776795684),(794227702827214,6620),

73+ (212534135175874,1365),(96432431858,29784975),(466626763743380,3484),

74+ (29793949,53041519613),(8359,309952753409844),(3908960585331901,26),

75+ (45185288970365760,114),(10131829775,68110174),(58039242399640479,83),

76+ (628092278238719399,6),(1,196469106875361889),(302336625,16347502444),

77+ (148,3748088684181047),(1,1649096568849015456),(1019866864,2349753026),

78+ (8211344830,569363306),(65647579546873,34753),(2340190,1692053129069),

79+ (64263301,30758930355),(48681618072372209,110),(7074794736,47640197),

80+ (249634721521,7991792),(1162917363807215,232),(7446433349,420634045),

81+ (63398619383,60709817),(51359004508011,14200),(131788797028647,7072),

82+ (52079887791430043,7),(7,136277667582599838),(28582879735696,50327),

83+ (1404582800566278,833),(469164435,15017166943),(99567079957578263,49),

84+ (1015285971,3625801566),(321504843,4104079293),(5196954,464515406632),

85+ (114246832260876,7468),(8149664437,487119673),(12265299,378168974869),

86+ (37711995764,30766513),(3971137243,710996152),(483120070302,603162),

87+ (103009942,61645547145),(8476344625340,6987),(547948761229739,1446),

88+ (42234,18624767306301),(13486714173011,58948),(4,198309153268019840),

89+ (9913176974,325539248),(28246225540203,116822),(2882463945582154,18),

90+ (959,25504987505398),(3,1504372236378217710),(13505229956793,374987),

91+ (751661959,457611342),(27375926,36219151769),(482168869,5301952074),

92+ (1,1577425863241520640),(714116235611821,1164),(904492524250310488,0),

93+ (5983514941763398,68),(10759472423,23540686),(72539568471529,34919),

94+ (4,176090672310337473),(938702842110356453,1),(673652445,3335287382),

95+ (3111998893666122,917),(1568013,3168419765469)]

96+

97+testVector32 :: U.Vector (Int32,Int32)

98+testVector32 = U.fromList [

99+ (39242,410),(0,100077553),(2206,9538),(509400240,1),(38048,6368),

100+ (1789,651480),(2399,157032),(701,170017),(5241456,14),(11212,70449),

101+ (1,227804876),(749687254,1),(74559,2954),(1158,147957),(410604456,1),

102+ (170851,1561),(92643422,1),(6192,180509),(7,24202210),(3440,241481),

103+ (5753677,5),(294327,1622),(252,4454673),(127684121,11),(28315800,30),

104+ (340370905,0),(1,667887987),(592782090,1),(49023,27641),(750,290387),

105+ (72886,3847),(0,301047933),(3050276,473),(1,788366142),(59457,15813),

106+ (637726933,1),(1135,344317),(853616,264),(696816,493),(7038,12046),

107+ (125219574,4),(803694088,1),(107081726,1),(39294,21699),(16361,38191),

108+ (132561123,12),(1760,23499),(847543,484),(175687349,1),(2963,252678),

109+ (6248,224553),(27596,4606),(5422922,121),(1542,485890),(131,583035),

110+ (59096,4925),(3637115,132),(0,947225435),(86854,6794),(2984745,339),

111+ (760129569,1),(1,68260595),(380835652,2),(430575,2579),(54514,7211),

112+ (15550606,3),(9,27367402),(3007053,207),(7060988,60),(28560,27130),

113+ (1355,21087),(10880,53059),(14563646,4),(461886361,1),(2,169260724),

114+ (241454126,2),(406797,1),(61631630,16),(44473,5943),(63869104,12),

115+ (950300,1528),(2113,62333),(120817,9358),(100261456,1),(426764723,1),

116+ (119,12723684),(3,53358711),(4448071,18),(1,230278091),(238,232102),

117+ (8,57316440),(42437979,10),(6769,19555),(48590,22006),(11500585,79),

118+ (2808,97638),(42,26952545),(11,32104194),(23954638,1),(785427272,0),

119+ (513,81379),(31333960,37),(897772,1009),(4,25679692),(103027993,12),

120+ (104972702,11),(546,443401),(7,65137092),(88574269,3),(872139069,0),

121+ (2,97417121),(378802603,0),(141071401,4),(22613,10575),(2191743,118),

122+ (470,116119),(7062,38166),(231056,1847),(43901963,9),(2400,70640),

123+ (63553,1555),(34,11249573),(815174,1820),(997894011,0),(98881794,2),

124+ (5448,43132),(27956,9),(904926,1357),(112608626,3),(124,613021),

125+ (282086,1966),(99,10656881),(113799,1501),(433318,2085),(442,948171),

126+ (165380,1043),(28,14372905),(14880,50462),(2386,219918),(229,1797565),

127+ (1174961,298),(3925,41833),(3903515,299),(15690452,111),(360860521,3),

128+ (7440846,81),(2541026,507),(0,492448477),(6869,82469),(245,8322939),

129+ (3503496,253),(123495298,0),(150963,2299),(33,4408482),(1,200911107),

130+ (305,252121),(13,123369189),(215846,8181),(2440,65387),(776764401,1),

131+ (1241172,434),(8,15493155),(81953961,6),(17884993,5),(26,6893822),

132+ (0,502035190),(1,582451018),(2,514870139),(227,3625619),(49,12720258),

133+ (1456769,207),(94797661,10),(234407,893),(26843,5783),(15688,24547),

134+ (4091,86268),(4339448,151),(21360,6294),(397046497,2),(1227,205936),

135+ (9966,21959),(160046791,1),(0,159992224),(27,24974797),(19177,29334),

136+ (4136148,42),(21179785,53),(61256583,31),(385,344176),(7,11934915),

137+ (1,18992566),(3488065,5),(768021,224),(36288474,7),(8624,117561),

138+ (8,20341439),(5903,261475),(561,1007618),(1738,392327),(633049,1708)]

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

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

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

14−import Criterion (Benchmark, bench)

14+import Criterion (Benchmark, bench, whnfIO)

1515import Data.Monoid (mappend, mconcat)

1616import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)

1717import Data.Text.Lazy.IO (hPutStr)

@@ -19,7 +19,7 @@ import System.IO (Handle)

1919import qualified Data.Text as T

2020

2121benchmark :: Handle -> IO Benchmark

22−benchmark sink = return $ bench "BigTable" $ do

22+benchmark sink = return $ bench "BigTable" $ whnfIO $ do

2323 hPutStr sink "Content-Type: text/html\n\n<table>"

2424 hPutStr sink . toLazyText . makeTable =<< rows

2525 hPutStr sink "</table>"

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

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

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

19−import Criterion (Benchmark, bgroup, bench)

19+import Criterion (Benchmark, bgroup, bench, whnfIO)

2020import System.IO (Handle, hPutStr)

2121import qualified Data.ByteString as B

2222import qualified Data.ByteString.Char8 as BC

@@ -40,7 +40,7 @@ benchmark p sink from to = return $ bgroup "Cut"

4040 , bench' "LazyTextByteString" lazyTextByteString

4141 ]

4242 where

43− bench' n s = bench n (s p sink from to)

43+ bench' n s = bench n $ whnfIO (s p sink from to)

4444

4545string :: FilePath -> Handle -> Int -> Int -> IO ()

4646string fp sink from to = do

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

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

@@ -21,7 +21,7 @@ import Data.List (foldl')

2121import Data.List (intersperse)

2222import Data.Monoid (mempty, mappend, mconcat)

2323import System.IO (Handle)

24−import Criterion (Benchmark, bench)

24+import Criterion (Benchmark, bench, whnfIO)

2525import qualified Data.Text as T

2626import qualified Data.Text.IO as T

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

@@ -30,7 +30,7 @@ import qualified Data.Text.Lazy.IO as TL

3030

3131benchmark :: FilePath -> Handle -> IO Benchmark

3232benchmark i o = return $

33− bench "Fold" $ T.readFile i >>= TL.hPutStr o . fold 80

33+ bench "Fold" $ whnfIO $ T.readFile i >>= TL.hPutStr o . fold 80

3434

3535-- | We represent a paragraph by a word list

3636--

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

@@ -13,11 +13,11 @@

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

20−import Criterion (Benchmark, bgroup, bench)

20+import Criterion (Benchmark, bgroup, bench, whnfIO)

2121import Data.Monoid (mconcat)

2222import System.IO (Handle, hPutStr)

2323import qualified Data.ByteString as B

@@ -35,16 +35,17 @@ import qualified Data.Text.Lazy.IO as TL

3535

3636benchmark :: FilePath -> Handle -> IO Benchmark

3737benchmark i o = return $ bgroup "Sort"

38− [ bench "String" $ readFile i >>= hPutStr o . string

39− , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString

40− , bench "LazyByteString" $ BL.readFile i >>= BL.hPutStr o . lazyByteString

41− , bench "Text" $ T.readFile i >>= T.hPutStr o . text

42− , bench "LazyText" $ TL.readFile i >>= TL.hPutStr o . lazyText

43− , bench "TextByteString" $ B.readFile i >>=

38+ [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string

39+ , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString

40+ , bench "LazyByteString" $ whnfIO $

41+ BL.readFile i >>= BL.hPutStr o . lazyByteString

42+ , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text

43+ , bench "LazyText" $ whnfIO $ TL.readFile i >>= TL.hPutStr o . lazyText

44+ , bench "TextByteString" $ whnfIO $ B.readFile i >>=

4445 B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8

45− , bench "LazyTextByteString" $ BL.readFile i >>=

46+ , bench "LazyTextByteString" $ whnfIO $ BL.readFile i >>=

4647 BL.hPutStr o . TL.encodeUtf8 . lazyText . TL.decodeUtf8

47− , bench "TextBuilder" $ B.readFile i >>=

48+ , bench "TextBuilder" $ whnfIO $ B.readFile i >>=

4849 BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8

4950 ]

5051

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

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

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−

18−import Criterion (Benchmark, bgroup, bench)

17+

18+import Criterion (Benchmark, bgroup, bench, whnfIO)

1919import Data.List (mapAccumL)

2020import System.IO (Handle, hPutStr)

2121import qualified Data.ByteString as B

@@ -26,10 +26,10 @@ import qualified Data.Text.IO as T

2626

2727benchmark :: FilePath -> Handle -> IO Benchmark

2828benchmark i o = return $ bgroup "StripTags"

29− [ bench "String" $ readFile i >>= hPutStr o . string

30− , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString

31− , bench "Text" $ T.readFile i >>= T.hPutStr o . text

32− , bench "TextByteString" $

29+ [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string

30+ , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString

31+ , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text

32+ , bench "TextByteString" $ whnfIO $

3333 B.readFile i >>= B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8

3434 ]

3535

tests/benchmarks/src/Data/Text/Benchmarks/Programs/Throughput.hs → benchmarks/haskell/Benchmarks/Programs/Throughput.hsrenamed+9−9

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

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

21−import Criterion (Benchmark, bgroup, bench)

21+import Criterion (Benchmark, bgroup, bench, whnfIO)

2222import System.IO (Handle, hPutStr)

2323import qualified Data.ByteString as B

2424import qualified Data.ByteString.Lazy as BL

@@ -29,13 +29,13 @@ import qualified Data.Text.Lazy.IO as TL

2929

3030benchmark :: FilePath -> Handle -> IO Benchmark

3131benchmark fp sink = return $ bgroup "Throughput"

32− [ bench "String" $ readFile fp >>= hPutStr sink

33− , bench "ByteString" $ B.readFile fp >>= B.hPutStr sink

34− , bench "LazyByteString" $ BL.readFile fp >>= BL.hPutStr sink

35− , bench "Text" $ T.readFile fp >>= T.hPutStr sink

36− , bench "LazyText" $ TL.readFile fp >>= TL.hPutStr sink

37− , bench "TextByteString" $

32+ [ bench "String" $ whnfIO $ readFile fp >>= hPutStr sink

33+ , bench "ByteString" $ whnfIO $ B.readFile fp >>= B.hPutStr sink

34+ , bench "LazyByteString" $ whnfIO $ BL.readFile fp >>= BL.hPutStr sink

35+ , bench "Text" $ whnfIO $ T.readFile fp >>= T.hPutStr sink

36+ , bench "LazyText" $ whnfIO $ TL.readFile fp >>= TL.hPutStr sink

37+ , bench "TextByteString" $ whnfIO $

3838 B.readFile fp >>= B.hPutStr sink . T.encodeUtf8 . T.decodeUtf8

39− , bench "LazyTextByteString" $

39+ , bench "LazyTextByteString" $ whnfIO $

4040 BL.readFile fp >>= BL.hPutStr sink . TL.encodeUtf8 . TL.decodeUtf8

4141 ]

tests/benchmarks/src/Data/Text/Benchmarks/Pure.hs → benchmarks/haskell/Benchmarks/Pure.hsrenamed+22−10

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

@@ -18,7 +18,6 @@ import Data.Monoid (mappend, mempty)

1818import GHC.Base (Char (..), Int (..), chr#, ord#, (+#))

1919import qualified Data.ByteString.Char8 as BS

2020import qualified Data.ByteString.Lazy.Char8 as BL

21−import qualified Data.ByteString.Lazy.Internal as BL

2221import qualified Data.ByteString.UTF8 as UTF8

2322import qualified Data.List as L

2423import qualified Data.Text as T

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

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

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

2928

30−benchmark :: FilePath -> IO Benchmark

31−benchmark fp = do

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

30+benchmark kind fp = do

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

3332 -- count it here.

3433

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

10099 , benchBSL $ nf BL.unpack bla

101100 , benchS $ nf UTF8.toString bsa

102101 ]

102+ , bgroup "decode'"

103+ [ benchT $ nf T.decodeUtf8' bsa

104+ , benchTL $ nf TL.decodeUtf8' bla

105+ ]

103106 , bgroup "drop"

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

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

@@ -259,6 +262,13 @@ benchmark fp = do

259262 , benchBSL $ nf (BL.map toUpper) bla

260263 , benchS $ nf (L.map toUpper) sa

261264 ]

265+ , bgroup "uncons"

266+ [ benchT $ nf T.uncons ta

267+ , benchTL $ nf TL.uncons tla

268+ , benchBS $ nf BS.uncons bsa

269+ , benchBSL $ nf BL.uncons bla

270+ , benchS $ nf L.uncons sa

271+ ]

262272 , bgroup "words"

263273 [ benchT $ nf T.words ta

264274 , benchTL $ nf TL.words tla

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

405415 ]

406416 ]

407417 where

408− benchS = bench "String"

409− benchT = bench "Text"

410− benchTL = bench "LazyText"

411− benchBS = bench "ByteString"

412− benchBSL = bench "LazyByteString"

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

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

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

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

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

413423

414424 c = 'й'

415425 p0 = (== c)

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

425435 replicat n = concat . L.replicate n

426436 short = T.pack "short"

427437

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

428439instance NFData BS.ByteString

429440

430441instance NFData BL.ByteString where

431442 rnf BL.Empty = ()

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

444+#endif

433445

434446data B where

435447 B :: NFData a => a -> B

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

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

@@ -25,8 +25,7 @@ import Data.List (foldl')

2525import Numeric (readDec, readFloat, readHex)

2626import qualified Data.ByteString.Char8 as B

2727import qualified Data.ByteString.Lazy.Char8 as BL

28−import qualified Data.ByteString.Lex.Double as B

29−import qualified Data.ByteString.Lex.Lazy.Double as BL

28+import qualified Data.ByteString.Lex.Fractional as B

3029import qualified Data.Text as T

3130import qualified Data.Text.IO as T

3231import qualified Data.Text.Lazy as TL

@@ -63,12 +62,10 @@ benchmark fp = do

6362 whnf (double . text TL.rational) tl

6463

6564 , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b

66− , bench "DoubleByteString" $ whnf (double . byteString B.readDouble) b

65+ , bench "DoubleByteString" $ whnf (double . byteString B.readDecimal) b

6766

6867 , bench "DecimalLazyByteString" $

6968 whnf (int . byteString BL.readInt) bl

70− , bench "DoubleLazyByteString" $

71− whnf (double . byteString BL.readDouble) bl

7269 ]

7370 where

7471 -- Used for fixing types

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

8885 where

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

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

91−

88+

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

9390byteString reader = foldl' go 1000000

9491 where

benchmarks/haskell/Benchmarks/Replace.hsnew file+43

@@ -0,0 +1,43 @@

1+{-# LANGUAGE BangPatterns #-}

2+-- | Replace a string by another string

3+--

4+-- Tested in this benchmark:

5+--

6+-- * Search and replace of a pattern in a text

7+--

8+module Benchmarks.Replace

9+ ( benchmark

10+ ) where

11+

12+import Criterion (Benchmark, bgroup, bench, nf)

13+import qualified Data.ByteString.Char8 as B

14+import qualified Data.ByteString.Lazy as BL

15+import qualified Data.ByteString.Lazy.Search as BL

16+import qualified Data.ByteString.Search as B

17+import qualified Data.Text as T

18+import qualified Data.Text.Encoding as T

19+import qualified Data.Text.Lazy as TL

20+import qualified Data.Text.Lazy.Encoding as TL

21+import qualified Data.Text.Lazy.IO as TL

22+

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

24+benchmark fp pat sub = do

25+ tl <- TL.readFile fp

26+ bl <- BL.readFile fp

27+ let !t = TL.toStrict tl

28+ !b = T.encodeUtf8 t

29+ return $ bgroup "Replace" [

30+ bench "Text" $ nf (T.length . T.replace tpat tsub) t

31+ , bench "ByteString" $ nf (BL.length . B.replace bpat bsub) b

32+ , bench "LazyText" $ nf (TL.length . TL.replace tlpat tlsub) tl

33+ , bench "LazyByteString" $ nf (BL.length . BL.replace blpat blsub) bl

34+ ]

35+ where

36+ tpat = T.pack pat

37+ tsub = T.pack sub

38+ tlpat = TL.pack pat

39+ tlsub = TL.pack sub

40+ bpat = T.encodeUtf8 tpat

41+ bsub = T.encodeUtf8 tsub

42+ blpat = B.concat $ BL.toChunks $ TL.encodeUtf8 tlpat

43+ blsub = B.concat $ BL.toChunks $ TL.encodeUtf8 tlsub

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+21−11

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

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

1414import Control.DeepSeq (NFData (..))

1515import Criterion (Benchmark, bgroup, bench, nf)

16−import Data.Text.Fusion.Internal (Step (..), Stream (..))

16+import Data.Text.Internal.Fusion.Types (Step (..), Stream (..))

1717import qualified Data.Text.Encoding as T

1818import qualified Data.Text.Encoding.Error as E

19−import qualified Data.Text.Encoding.Fusion as T

20−import qualified Data.Text.Encoding.Fusion.Common as F

21−import qualified Data.Text.Fusion as T

19+import qualified Data.Text.Internal.Encoding.Fusion as T

20+import qualified Data.Text.Internal.Encoding.Fusion.Common as F

21+import qualified Data.Text.Internal.Fusion as F

2222import qualified Data.Text.IO as T

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

24−import qualified Data.Text.Lazy.Encoding.Fusion as TL

25−import qualified Data.Text.Lazy.Fusion as TL

24+import qualified Data.Text.Internal.Lazy.Encoding.Fusion as TL

25+import qualified Data.Text.Internal.Lazy.Fusion as FL

2626import qualified Data.Text.Lazy.IO as TL

2727

2828instance NFData a => NFData (Stream a) where

@@ -53,14 +53,25 @@ benchmark fp = do

5353 !utf32beL = TL.encodeUtf32BE tl

5454

5555 -- For the functions which operate on streams

56− let !s = T.stream t

56+ let !s = F.stream t

5757

5858 return $ bgroup "Stream"

5959

6060 -- Fusion

6161 [ bgroup "stream" $

62− [ bench "Text" $ nf T.stream t

63− , bench "LazyText" $ nf TL.stream tl

62+ [ bench "Text" $ nf F.stream t

63+ , bench "LazyText" $ nf FL.stream tl

64+ ]

65+ -- must perform exactly the same as stream above due to

66+ -- stream/unstream (i.e. stream after unstream) fusion

67+ , bgroup "stream-fusion" $

68+ [ bench "Text" $ nf (F.stream . F.unstream . F.stream) t

69+ , bench "LazyText" $ nf (FL.stream . FL.unstream . FL.stream) tl

70+ ]

71+ -- measure the overhead of unstream after stream

72+ , bgroup "stream-unstream" $

73+ [ bench "Text" $ nf (F.unstream . F.stream) t

74+ , bench "LazyText" $ nf (FL.unstream . FL.stream) tl

6475 ]

6576

6677 -- Encoding.Fusion

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

8697 ]

8798

8899 -- Encoding.Fusion.Common

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

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

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

92102 , 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+66

@@ -0,0 +1,66 @@

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: BSD2

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 bytestring-builder

19+ description: Depend on the bytestring-builder package for backwards compatibility.

20+ default: False

21+ manual: False

22+

23+flag llvm

24+ description: use LLVM

25+ default: False

26+ manual: True

27+

28+executable text-benchmarks

29+ hs-source-dirs: haskell ..

30+ c-sources: ../cbits/cbits.c

31+ cbits/time_iconv.c

32+ include-dirs: ../include

33+ main-is: Benchmarks.hs

34+ ghc-options: -Wall -O2 -rtsopts

35+ if flag(llvm)

36+ ghc-options: -fllvm

37+ cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP

38+ build-depends: base == 4.*,

39+ binary,

40+ blaze-builder,

41+ bytestring-lexing >= 0.5.0,

42+ containers,

43+ criterion >= 0.10.0.0,

44+ deepseq,

45+ directory,

46+ filepath,

47+ ghc-prim,

48+ integer-gmp,

49+ stringsearch,

50+ utf8-string,

51+ vector

52+

53+ if flag(bytestring-builder)

54+ build-depends: bytestring >= 0.9 && < 0.10.4,

55+ bytestring-builder >= 0.10.4

56+ else

57+ build-depends: bytestring >= 0.10.4

58+

59+executable text-multilang

60+ hs-source-dirs: haskell

61+ main-is: Multilang.hs

62+ ghc-options: -Wall -O2

63+ build-depends: base == 4.*,

64+ bytestring,

65+ text,

66+ time

cbits/cbits.c+192−14

@@ -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,90 @@ 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 *src,

72+ const uint8_t *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+#if defined(__GNUC__) || defined(__clang__)

131+static inline uint8_t const *

132+_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,

133+ const uint8_t **src, const uint8_t *srcend,

134+ uint32_t *codepoint0, uint32_t *state0)

135+ __attribute((always_inline));

136+#endif

137+

138+static inline uint8_t const *

139+_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,

140+ const uint8_t **src, const uint8_t *srcend,

141+ uint32_t *codepoint0, uint32_t *state0)

74142{

75143 uint16_t *d = dest + *destoff;

76− const uint8_t const *s = src;

77− uint32_t state = UTF8_ACCEPT;

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

145+ uint32_t state = *state0;

146+ uint32_t codepoint = *codepoint0;

78147

79148 while (s < srcend) {

80− uint32_t codepoint;

81−

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

83150 /*

84151 * This code will only work on a little-endian system that

@@ -106,6 +173,7 @@ _hs_text_decode_utf8(uint16_t *dest, size_t *destoff,

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

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

108175 }

176+ last = s;

109177 }

110178#endif

111179

@@ -121,13 +189,123 @@ _hs_text_decode_utf8(uint16_t *dest, size_t *destoff,

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

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

123191 }

192+ last = s;

124193 }

125194

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

127− if (state != UTF8_ACCEPT)

128− s -= 1;

129−

130195 *destoff = d - dest;

196+ *codepoint0 = codepoint;

197+ *state0 = state;

198+ *src = last;

131199

132200 return s;

133201}

202+

203+uint8_t const *

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

205+ const uint8_t **src,

206+ const uint8_t *srcend,

207+ uint32_t *codepoint0, uint32_t *state0)

208+{

209+ uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, src, srcend,

210+ codepoint0, state0);

211+ if (*state0 == UTF8_REJECT)

212+ ret -=1;

213+ return ret;

214+}

215+

216+/*

217+ * Helper to decode buffer and discard final decoder state

218+ */

219+const uint8_t *

220+_hs_text_decode_utf8(uint16_t *const dest, size_t *destoff,

221+ const uint8_t *src, const uint8_t *const srcend)

222+{

223+ uint32_t codepoint;

224+ uint32_t state = UTF8_ACCEPT;

225+ uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, &src, srcend,

226+ &codepoint, &state);

227+ /* Back up if we have an incomplete or invalid encoding */

228+ if (state != UTF8_ACCEPT)

229+ ret -= 1;

230+ return ret;

231+}

232+

233+void

234+_hs_text_encode_utf8(uint8_t **destp, const uint16_t *src, size_t srcoff,

235+ size_t srclen)

236+{

237+ const uint16_t *srcend;

238+ uint8_t *dest = *destp;

239+

240+ src += srcoff;

241+ srcend = src + srclen;

242+

243+ ascii:

244+#if defined(__x86_64__)

245+ while (srcend - src >= 4) {

246+ uint64_t w = *((uint64_t *) src);

247+

248+ if (w & 0xFF80FF80FF80FF80ULL) {

249+ if (!(w & 0x000000000000FF80ULL)) {

250+ *dest++ = w & 0xFFFF;

251+ src++;

252+ if (!(w & 0x00000000FF800000ULL)) {

253+ *dest++ = (w >> 16) & 0xFFFF;

254+ src++;

255+ if (!(w & 0x0000FF8000000000ULL)) {

256+ *dest++ = (w >> 32) & 0xFFFF;

257+ src++;

258+ }

259+ }

260+ }

261+ break;

262+ }

263+ *dest++ = w & 0xFFFF;

264+ *dest++ = (w >> 16) & 0xFFFF;

265+ *dest++ = (w >> 32) & 0xFFFF;

266+ *dest++ = w >> 48;

267+ src += 4;

268+ }

269+#endif

270+

271+#if defined(__i386__)

272+ while (srcend - src >= 2) {

273+ uint32_t w = *((uint32_t *) src);

274+

275+ if (w & 0xFF80FF80)

276+ break;

277+ *dest++ = w & 0xFFFF;

278+ *dest++ = w >> 16;

279+ src += 2;

280+ }

281+#endif

282+

283+ while (src < srcend) {

284+ uint16_t w = *src++;

285+

286+ if (w <= 0x7F) {

287+ *dest++ = w;

288+ /* An ASCII byte is likely to begin a run of ASCII bytes.

289+ Falling back into the fast path really helps performance. */

290+ goto ascii;

291+ }

292+ else if (w <= 0x7FF) {

293+ *dest++ = (w >> 6) | 0xC0;

294+ *dest++ = (w & 0x3f) | 0x80;

295+ }

296+ else if (w < 0xD800 || w > 0xDBFF) {

297+ *dest++ = (w >> 12) | 0xE0;

298+ *dest++ = ((w >> 6) & 0x3F) | 0x80;

299+ *dest++ = (w & 0x3F) | 0x80;

300+ } else {

301+ uint32_t c = ((((uint32_t) w) - 0xD800) << 10) +

302+ (((uint32_t) *src++) - 0xDC00) + 0x10000;

303+ *dest++ = (c >> 18) | 0xF0;

304+ *dest++ = ((c >> 12) & 0x3F) | 0x80;

305+ *dest++ = ((c >> 6) & 0x3F) | 0x80;

306+ *dest++ = (c & 0x3F) | 0x80;

307+ }

308+ }

309+

310+ *destp = dest;

311+}

changelog.mdnew file+164

@@ -0,0 +1,164 @@

1+1.2.2.1

3+* The switch to `integer-pure` in 1.2.2.0 was apparently mistaken.

4+ The build flag has been renamed accordingly. Your army of diligent

5+ maintainers apologizes for the churn.

7+* Spec compliance: toCaseFold now follows the Unicode 8.0 spec

8+ (updated from 7.0)

10+* An STG lint error has been fixed

11+

12+1.2.2.0

13+

14+* The `integer-simple` package, upon which this package optionally

15+ depended, has been replaced with `integer-pure`. The build flag has

16+ been renamed accordingly.

17+

18+* Bug fix: For the `Binary` instance, If UTF-8 decoding fails during a

19+ `get`, the error is propagated via `fail` instead of an uncatchable

20+ crash.

21+

22+* New function: `takeWhileEnd`

23+

24+* New instances for the `Text` types:

25+ * if `base` >= 4.7: `PrintfArg`

26+ * if `base` >= 4.9: `Semigroup`

27+

28+1.2.1.3

29+

30+* Bug fix: As it turns out, moving the literal rewrite rules to simplifier

31+ phase 2 does not prevent competition with the `unpack` rule, which is

32+ also active in this phase. Unfortunately this was hidden due to a silly

33+ test environment mistake. Moving literal rules back to phase 1 finally

34+ fixes GHC Trac #10528 correctly.

35+

36+1.2.1.2

37+

38+* Bug fix: Run literal rewrite rules in simplifier phase 2.

39+ The behavior of the simplifier changed in GHC 7.10.2,

40+ causing these rules to fail to fire, leading to poor code generation

41+ and long compilation times. See

42+ [GHC Trac #10528](https://ghc.haskell.org/trac/ghc/ticket/10528).

43+

44+1.2.1.1

45+

46+* Expose unpackCString#, which you should never use.

47+

48+1.2.1.0

49+

50+* Added Binary instances for both Text types. (If you have previously

51+ been using the text-binary package to get a Binary instance, it is

52+ now obsolete.)

53+

54+1.2.0.6

55+

56+* Fixed a space leak in UTF-8 decoding

57+

58+1.2.0.5

59+

60+* Feature parity: repeat, cycle, iterate are now implemented for lazy

61+ Text, and the Data instance is more complete

62+

63+* Build speed: an inliner space explosion has been fixed with toCaseFold

64+

65+* Bug fix: encoding Int to a Builder would infinite-loop if the

66+ integer-simple package was used

67+

68+* Deprecation: OnEncodeError and EncodeError are deprecated, as they

69+ are never used

70+

71+* Internals: some types that are used internally in fusion-related

72+ functions have moved around, been renamed, or been deleted (we don't

73+ bump the major version if .Internal modules change)

74+

75+* Spec compliance: toCaseFold now follows the Unicode 7.0 spec

76+ (updated from 6.3)

77+

78+1.2.0.4

79+

80+* Fixed an incompatibility with base < 4.5

81+

82+1.2.0.3

83+

84+* Update formatRealFloat to correspond to the definition in versions

85+ of base newer than 4.5 (https://github.com/bos/text/issues/105)

86+

87+1.2.0.2

88+

89+* Bumped lower bound on deepseq to 1.4 for compatibility with the

90+ upcoming GHC 7.10

91+

92+1.2.0.1

93+

94+* Fixed a buffer overflow in rendering of large Integers

95+ (https://github.com/bos/text/issues/99)

96+

97+1.2.0.0

98+

99+* Fixed an integer overflow in the replace function

100+ (https://github.com/bos/text/issues/81)

101+

102+* Fixed a hang in lazy decodeUtf8With

103+ (https://github.com/bos/text/issues/87)

104+

105+* Reduced codegen bloat caused by use of empty and single-character

106+ literals

107+

108+* Added an instance of IsList for GHC 7.8 and above

109+

110+1.1.1.0

111+

112+* The Data.Data instance now allows gunfold to work, via a virtual

113+ pack constructor

114+

115+* dropEnd, takeEnd: new functions

116+

117+* Comparing the length of a Text against a number can now

118+ short-circuit in more cases

119+

120+1.1.0.1

121+

122+* streamDecodeUtf8: fixed gh-70, did not return all unconsumed bytes

123+ in single-byte chunks

124+

125+1.1.0.0

126+

127+* encodeUtf8: Performance is improved by up to 4x.

128+

129+* encodeUtf8Builder, encodeUtf8BuilderEscaped: new functions,

130+ available only if bytestring >= 0.10.4.0 is installed, that allow

131+ very fast and flexible encoding of a Text value to a bytestring

132+ Builder.

133+

134+ As an example of the performance gain to be had, the

135+ encodeUtf8BuilderEscaped function helps to double the speed of JSON

136+ encoding in the latest version of aeson! (Note: if all you need is a

137+ plain ByteString, encodeUtf8 is still the faster way to go.)

138+

139+* All of the internal module hierarchy is now publicly exposed. If a

140+ module is in the .Internal hierarchy, or is documented as internal,

141+ use at your own risk - there are no API stability guarantees for

142+ internal modules!

143+

144+1.0.0.1

145+

146+* decodeUtf8: Fixed a regression that caused us to incorrectly

147+ identify truncated UTF-8 as valid (gh-61)

148+

149+1.0.0.0

150+

151+* Added support for Unicode 6.3.0 to case conversion functions

152+

153+* New function toTitle converts words in a string to title case

154+

155+* New functions peekCStringLen and withCStringLen simplify

156+ interoperability with C functionns

157+

158+* Added support for decoding UTF-8 in stream-friendly fashion

159+

160+* Fixed a bug in mapAccumL

161+

162+* Added trusted Haskell support

163+

164+* Removed support for GHC 6.10 (released in 2008) and older

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+4−9

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

11module Arsec

22 (

3− comment

3+ Comment

4+ , comment

45 , semi

56 , showC

67 , unichar

@@ -23,13 +24,7 @@ import Text.ParserCombinators.Parsec.Combinator hiding (optional)

2324import Text.ParserCombinators.Parsec.Error

2425import Text.ParserCombinators.Parsec.Prim hiding ((<|>), many)

2526

26−instance Applicative (GenParser s a) where

27− pure = return

28− (<*>) = ap

29−

30−instance Alternative (GenParser s a) where

31− empty = mzero

32− (<|>) = mplus

27+type Comment = String

3328

3429unichar :: Parser Char

3530unichar = chr . fst . head . readHex <$> many1 hexDigit

@@ -40,7 +35,7 @@ unichars = manyTill (unichar <* spaces) semi

4035semi :: Parser ()

4136semi = char ';' *> spaces *> pure ()

4237

43−comment :: Parser String

38+comment :: Parser Comment

4439comment = (char '#' *> manyTill anyToken (char '\n')) <|> string "\n"

4540

4641showC :: Char -> String

scripts/CaseFolding.hs+11−7

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

55module CaseFolding

66 (

7− Fold(..)

7+ CaseFolding(..)

8+ , Fold(..)

89 , parseCF

910 , mapCF

1011 ) where

@@ -18,22 +19,25 @@ data Fold = Fold {

1819 , name :: String

1920 } deriving (Eq, Ord, Show)

2021

21−entries :: Parser [Fold]

22−entries = many comment *> many (entry <* many comment)

22+data CaseFolding = CF { cfComments :: [Comment], cfFolding :: [Fold] }

23+ deriving (Show)

24+

25+entries :: Parser CaseFolding

26+entries = CF <$> many comment <*> many (entry <* many comment)

2327 where

2428 entry = Fold <$> unichar <* semi

2529 <*> oneOf "CFST" <* semi

2630 <*> unichars

2731 <*> (string "# " *> manyTill anyToken (char '\n'))

2832

29−parseCF :: FilePath -> IO (Either ParseError [Fold])

33+parseCF :: FilePath -> IO (Either ParseError CaseFolding)

3034parseCF name = parse entries name <$> readFile name

3135

32−mapCF :: [Fold] -> [String]

33−mapCF ms = typ ++ (map nice . filter p $ ms) ++ [last]

36+mapCF :: CaseFolding -> [String]

37+mapCF (CF _ ms) = typ ++ (map nice . filter p $ ms) ++ [last]

3438 where

3539 typ = ["foldMapping :: forall s. Char -> s -> Step (CC s) Char"

36− ,"{-# INLINE foldMapping #-}"]

40+ ,"{-# NOINLINE foldMapping #-}"]

3741 last = "foldMapping c s = Yield (toLower c) (CC s '\\0' '\\0')"

3842 nice c = "-- " ++ name c ++ "\n" ++

3943 "foldMapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"

scripts/CaseMapping.hs+11−5

@@ -8,7 +8,7 @@ import SpecialCasing

88main = do

99 args <- getArgs

1010 let oname = case args of

11− [] -> "../Data/Text/Fusion/CaseMapping.hs"

11+ [] -> "../Data/Text/Internal/Fusion/CaseMapping.hs"

1212 [o] -> o

1313 psc <- parseSC "SpecialCasing.txt"

1414 pcf <- parseCF "CaseFolding.txt"

@@ -19,14 +19,20 @@ main = do

1919 Left err -> print err >> return undefined

2020 Right ms -> return ms

2121 h <- openFile oname WriteMode

22− mapM_ (hPutStrLn h) ["{-# LANGUAGE Rank2Types #-}"

22+ let comments = map ("--" ++) $

23+ take 2 (cfComments cfs) ++ take 2 (scComments scs)

24+ mapM_ (hPutStrLn h) $

25+ ["{-# LANGUAGE Rank2Types #-}"

2326 ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"

24− ,"-- Generated by scripts/SpecialCasing.hs"

25− ,"module Data.Text.Fusion.CaseMapping where"

27+ ,"-- Generated by scripts/CaseMapping.hs"] ++

28+ comments ++

29+ [""

30+ ,"module Data.Text.Internal.Fusion.CaseMapping where"

2631 ,"import Data.Char"

27− ,"import Data.Text.Fusion.Internal"

32+ ,"import Data.Text.Internal.Fusion.Types"

2833 ,""]

2934 mapM_ (hPutStrLn h) (mapSC "upper" upper toUpper scs)

3035 mapM_ (hPutStrLn h) (mapSC "lower" lower toLower scs)

36+ mapM_ (hPutStrLn h) (mapSC "title" title toTitle scs)

3137 mapM_ (hPutStrLn h) (mapCF cfs)

3238 hClose h

scripts/SpecialCasing.hs+13−7

@@ -4,13 +4,17 @@

55module SpecialCasing

66 (

7− Case(..)

7+ SpecialCasing(..)

8+ , Case(..)

89 , parseSC

910 , mapSC

1011 ) where

1112

1213import Arsec

1314

15+data SpecialCasing = SC { scComments :: [Comment], scCasing :: [Case] }

16+ deriving (Show)

17+

1418data Case = Case {

1519 code :: Char

1620 , lower :: [Char]

@@ -20,8 +24,8 @@ data Case = Case {

2024 , name :: String

2125 } deriving (Eq, Ord, Show)

2226

23−entries :: Parser [Case]

24−entries = many comment *> many (entry <* many comment)

27+entries :: Parser SpecialCasing

28+entries = SC <$> many comment <*> many (entry <* many comment)

2529 where

2630 entry = Case <$> unichar <* semi

2731 <*> unichars

@@ -30,14 +34,16 @@ entries = many comment *> many (entry <* many comment)

3034 <*> manyTill anyToken (string "# ")

3135 <*> manyTill anyToken (char '\n')

3236

33−parseSC :: FilePath -> IO (Either ParseError [Case])

37+parseSC :: FilePath -> IO (Either ParseError SpecialCasing)

3438parseSC name = parse entries name <$> readFile name

3539

36−mapSC :: String -> (Case -> String) -> (Char -> Char) -> [Case] -> [String]

37−mapSC which access twiddle ms = typ ++ (map nice . filter p $ ms) ++ [last]

40+mapSC :: String -> (Case -> String) -> (Char -> Char) -> SpecialCasing

41+ -> [String]

42+mapSC which access twiddle (SC _ ms) =

43+ typ ++ (map nice . filter p $ ms) ++ [last]

3844 where

3945 typ = [which ++ "Mapping :: forall s. Char -> s -> Step (CC s) Char"

40− ,"{-# INLINE " ++ which ++ "Mapping #-}"]

46+ ,"{-# NOINLINE " ++ which ++ "Mapping #-}"]

4147 last = which ++ "Mapping c s = Yield (to" ++ ucFirst which ++ " c) (CC s '\\0' '\\0')"

4248 nice c = "-- " ++ name c ++ "\n" ++

4349 which ++ "Mapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"

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/LiteralRuleTest.hsnew file+21

@@ -0,0 +1,21 @@

1+{-# LANGUAGE OverloadedStrings #-}

3+module LiteralRuleTest where

5+import Data.Text (Text)

7+-- This should produce 8 firings of the "TEXT literal" rule

8+strings :: [Text]

9+strings = [ "abstime", "aclitem", "bit", "bool", "box", "bpchar", "bytea", "char" ]

10+

11+-- This should produce 7 firings of the "TEXT literal UTF8" rule

12+utf8Strings :: [Text]

13+utf8Strings = [ "\0abstime", "\0aclitem", "\xfefe bit", "\0bool", "\0box", "\0bpchar", "\0bytea" ]

14+

15+-- This should produce 4 firings of the "TEXT empty literal" rule

16+empties :: [Text]

17+empties = [ "", "", "", "" ]

18+

19+-- This should produce 5 firings of the "TEXT empty literal" rule

20+--singletons :: [Text]

21+--singletons = [ "a", "b", "c", "d", "e" ]

tests/tests/Makefile → tests/Makefilerenamed+14−3

@@ -1,12 +1,23 @@

1+count = 1000

3+all: coverage literal-rule-test

5+literal-rule-test:

6+ ./literal-rule-test.sh

18coverage: build coverage/hpc_index.html

3−build:

10+build: text-test-data

411 cabal configure -fhpc

512 cabal build

613

14+text-test-data:

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

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

17+

718coverage/text-tests.tix:

819 -mkdir -p coverage

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

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

1021 mv text-tests.tix $@

1122

1223coverage/text-tests-stdio.tix:

@@ -26,4 +37,4 @@ coverage/hpc_index.html: coverage/coverage.tix

2637clean:

2738 rm -rf dist coverage .hpc

2839

29−.PHONY: build coverage

40+.PHONY: build coverage all literal-rule-test

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+327−82

@@ -1,54 +1,60 @@

1−-- | General quicktest properties for the text library

2−--

1+-- | QuickCheck properties for the text library.

33{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,

4− ScopedTypeVariables, TypeSynonymInstances, CPP #-}

5−{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}

6−{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

7−module Data.Text.Tests.Properties

4+ ScopedTypeVariables, TypeSynonymInstances #-}

5+{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}

6+module Tests.Properties

87 (

98 tests

109 ) where

1110

12−import Test.QuickCheck

13−import Test.QuickCheck.Monadic

14−import Text.Show.Functions ()

15−

11+import Control.Applicative ((<$>), (<*>))

1612import Control.Arrow ((***), second)

17−import Control.Exception (catch)

13+import Data.Bits ((.&.))

1814import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)

15+import Data.Int (Int8, Int16, Int32, Int64)

1916import Data.Monoid (Monoid(..))

20−import Data.String (fromString)

17+import Data.String (IsString(fromString))

2118import Data.Text.Encoding.Error

2219import Data.Text.Foreign

23−import Data.Text.Fusion.Size

20+import Data.Text.Internal.Encoding.Utf8

21+import Data.Text.Internal.Fusion.Size

22+import Data.Text.Internal.Search (indices)

2423import Data.Text.Lazy.Read as TL

2524import Data.Text.Read as T

26−import Data.Text.Search (indices)

27−import Data.Word (Word8, Word16, Word32)

28−import Numeric (showHex)

29−import Prelude hiding (catch, replicate)

25+import Data.Word (Word, Word8, Word16, Word32, Word64)

26+import Numeric (showEFloat, showFFloat, showGFloat, showHex)

27+import Prelude hiding (replicate)

3028import Test.Framework (Test, testGroup)

3129import Test.Framework.Providers.QuickCheck2 (testProperty)

30+import Test.QuickCheck hiding ((.&.))

31+import Test.QuickCheck.Monadic

32+import Test.QuickCheck.Property (Property(..))

33+import Tests.QuickCheckUtils

34+import Tests.Utils

35+import Text.Show.Functions ()

36+import qualified Control.Exception as Exception

3237import qualified Data.Bits as Bits (shiftL, shiftR)

3338import qualified Data.ByteString as B

39+import qualified Data.ByteString.Lazy as BL

3440import qualified Data.List as L

3541import qualified Data.Text as T

3642import qualified Data.Text.Encoding as E

37−import qualified Data.Text.Fusion as S

38−import qualified Data.Text.Fusion.Common as S

3943import qualified Data.Text.IO as T

44+import qualified Data.Text.Internal.Fusion as S

45+import qualified Data.Text.Internal.Fusion.Common as S

46+import qualified Data.Text.Internal.Lazy.Fusion as SL

47+import qualified Data.Text.Internal.Lazy.Search as S (indices)

48+import qualified Data.Text.Internal.Unsafe.Shift as U

4049import qualified Data.Text.Lazy as TL

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

51+import qualified Data.Text.Lazy.Builder.Int as TB

52+import qualified Data.Text.Lazy.Builder.RealFloat as TB

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

43−import qualified Data.Text.Lazy.Fusion as SL

4454import qualified Data.Text.Lazy.IO as TL

45−import qualified Data.Text.Lazy.Search as S (indices)

46−import qualified Data.Text.UnsafeShift as U

4755import qualified System.IO as IO

48−

49−import Data.Text.Tests.QuickCheckUtils

50−import Data.Text.Tests.Utils

51−import qualified Data.Text.Tests.SlowFunctions as Slow

56+import qualified Tests.Properties.Mul as Mul

57+import qualified Tests.SlowFunctions as Slow

5258

5359t_pack_unpack = (T.unpack . T.pack) `eq` id

5460tl_pack_unpack = (TL.unpack . TL.pack) `eq` id

@@ -62,10 +68,20 @@ tl_unstreamChunks x = f 11 x == f 1000 x

6268tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id

6369tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id

6470

71+-- Note: this silently truncates code-points > 255 to 8-bit due to 'B.pack'

72+encodeL1 :: T.Text -> B.ByteString

73+encodeL1 = B.pack . map (fromIntegral . fromEnum) . T.unpack

74+encodeLazyL1 :: TL.Text -> BL.ByteString

75+encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks

76+

6577t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a

6678 where a = T.map (\c -> chr (ord c `mod` 128)) t

6779tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a

6880 where a = TL.map (\c -> chr (ord c `mod` 128)) t

81+t_latin1 t = E.decodeLatin1 (encodeL1 a) == a

82+ where a = T.map (\c -> chr (ord c `mod` 256)) t

83+tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) == a

84+ where a = TL.map (\c -> chr (ord c `mod` 256)) t

6985t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id

7086t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)

7187tl_utf8 = forAll genUnicode $ (EL.decodeUtf8 . EL.encodeUtf8) `eq` id

@@ -79,23 +95,88 @@ tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id

7995t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id

8096tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id

8197

82−-- This is a poor attempt to ensure that the error handling paths on

83−-- decode are exercised in some way. Proper testing would be rather

84−-- more involved.

85−t_utf8_err :: DecodeErr -> B.ByteString -> Property

86−t_utf8_err (DE _ de) bs = monadicIO $ do

87− l <- run $ let len = T.length (E.decodeUtf8With de bs)

88− in (len `seq` return (Right len)) `catch`

89− (\(e::UnicodeException) -> return (Left e))

90− case l of

91− Left err -> assert $ length (show err) >= 0

92− Right n -> assert $ n >= 0

98+t_utf8_incr = forAll genUnicode $ \s (Positive n) -> (recode n `eq` id) s

99+ where recode n = T.concat . map fst . feedChunksOf n E.streamDecodeUtf8 .

100+ E.encodeUtf8

101+

102+feedChunksOf :: Int -> (B.ByteString -> E.Decoding) -> B.ByteString

103+ -> [(T.Text, B.ByteString)]

104+feedChunksOf n f bs

105+ | B.null bs = []

106+ | otherwise = let (x,y) = B.splitAt n bs

107+ E.Some t b f' = f x

108+ in (t,b) : feedChunksOf n f' y

109+

110+t_utf8_undecoded = forAll genUnicode $ \t ->

111+ let b = E.encodeUtf8 t

112+ ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t

113+ leftover = (++ [B.empty]) . init . tail . B.inits

114+ in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b == ls

115+

116+data Badness = Solo | Leading | Trailing

117+ deriving (Eq, Show)

118+

119+instance Arbitrary Badness where

120+ arbitrary = elements [Solo, Leading, Trailing]

121+

122+t_utf8_err :: Badness -> DecodeErr -> Property

123+t_utf8_err bad de = do

124+ let gen = case bad of

125+ Solo -> genInvalidUTF8

126+ Leading -> B.append <$> genInvalidUTF8 <*> genUTF8

127+ Trailing -> B.append <$> genUTF8 <*> genInvalidUTF8

128+ genUTF8 = E.encodeUtf8 <$> genUnicode

129+ forAll gen $ \bs -> MkProperty $ do

130+ onErr <- genDecodeErr de

131+ unProperty . monadicIO $ do

132+ l <- run $ let len = T.length (E.decodeUtf8With onErr bs)

133+ in (len `seq` return (Right len)) `Exception.catch`

134+ (\(e::UnicodeException) -> return (Left e))

135+ assert $ case l of

136+ Left err -> length (show err) >= 0

137+ Right _ -> de /= Strict

93138

94139t_utf8_err' :: B.ByteString -> Property

95140t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of

96141 Left err -> length (show err) >= 0

97142 Right t -> T.length t >= 0

98143

144+genInvalidUTF8 :: Gen B.ByteString

145+genInvalidUTF8 = B.pack <$> oneof [

146+ -- invalid leading byte of a 2-byte sequence

147+ (:) <$> choose (0xC0, 0xC1) <*> upTo 1 contByte

148+ -- invalid leading byte of a 4-byte sequence

149+ , (:) <$> choose (0xF5, 0xFF) <*> upTo 3 contByte

150+ -- 4-byte sequence greater than U+10FFFF

151+ , do k <- choose (0x11, 0x13)

152+ let w0 = 0xF0 + (k `Bits.shiftR` 2)

153+ w1 = 0x80 + ((k .&. 3) `Bits.shiftL` 4)

154+ ([w0,w1]++) <$> vectorOf 2 contByte

155+ -- continuation bytes without a start byte

156+ , listOf1 contByte

157+ -- short 2-byte sequence

158+ , (:[]) <$> choose (0xC2, 0xDF)

159+ -- short 3-byte sequence

160+ , (:) <$> choose (0xE0, 0xEF) <*> upTo 1 contByte

161+ -- short 4-byte sequence

162+ , (:) <$> choose (0xF0, 0xF4) <*> upTo 2 contByte

163+ -- overlong encoding

164+ , do k <- choose (0,0xFFFF)

165+ let c = chr k

166+ case k of

167+ _ | k < 0x80 -> oneof [ let (w,x) = ord2 c in return [w,x]

168+ , let (w,x,y) = ord3 c in return [w,x,y]

169+ , let (w,x,y,z) = ord4 c in return [w,x,y,z] ]

170+ | k < 0x7FF -> oneof [ let (w,x,y) = ord3 c in return [w,x,y]

171+ , let (w,x,y,z) = ord4 c in return [w,x,y,z] ]

172+ | otherwise -> let (w,x,y,z) = ord4 c in return [w,x,y,z]

173+ ]

174+ where

175+ contByte = (0x80 +) <$> choose (0, 0x3f)

176+ upTo n gen = do

177+ k <- choose (0,n)

178+ vectorOf k gen

179+

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

100181 where _types = s :: String

101182sf_Eq p s =

@@ -116,8 +197,10 @@ t_Show = show `eq` (show . T.pack)

116197tl_Show = show `eq` (show . TL.pack)

117198t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))

118199tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))

119−t_mconcat = mconcat `eq` (unpackS . mconcat . L.map T.pack)

120−tl_mconcat = mconcat `eq` (unpackS . mconcat . L.map TL.pack)

200+t_mconcat = unsquare $

201+ mconcat `eq` (unpackS . mconcat . L.map T.pack)

202+tl_mconcat = unsquare $

203+ mconcat `eq` (unpackS . mconcat . L.map TL.pack)

121204t_mempty = mempty == (unpackS (mempty :: T.Text))

122205tl_mempty = mempty == (unpackS (mempty :: TL.Text))

123206t_IsString = fromString `eqP` (T.unpack . fromString)

@@ -181,11 +264,14 @@ s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)

181264sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)

182265t_map f = map f `eqP` (unpackS . T.map f)

183266tl_map f = map f `eqP` (unpackS . TL.map f)

184−s_intercalate c = L.intercalate c `eq`

267+s_intercalate c = unsquare $

268+ L.intercalate c `eq`

185269 (unpackS . S.intercalate (packS c) . map packS)

186−t_intercalate c = L.intercalate c `eq`

270+t_intercalate c = unsquare $

271+ L.intercalate c `eq`

187272 (unpackS . T.intercalate (packS c) . map packS)

188−tl_intercalate c = L.intercalate c `eq`

273+tl_intercalate c = unsquare $

274+ L.intercalate c `eq`

189275 (unpackS . TL.intercalate (TL.pack c) . map TL.pack)

190276s_intersperse c = L.intersperse c `eqP`

191277 (unpackS . S.intersperse c)

@@ -193,10 +279,14 @@ s_intersperse_s c = L.intersperse c `eqP`

193279 (unpackS . S.unstream . S.intersperse c)

194280sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`

195281 (unpackS . S.intersperse c . S.filter p)

196−t_intersperse c = L.intersperse c `eqP` (unpackS . T.intersperse c)

197−tl_intersperse c = L.intersperse c `eqP` (unpackS . TL.intersperse c)

198−t_transpose = L.transpose `eq` (map unpackS . T.transpose . map packS)

199−tl_transpose = L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)

282+t_intersperse c = unsquare $

283+ L.intersperse c `eqP` (unpackS . T.intersperse c)

284+tl_intersperse c = unsquare $

285+ L.intersperse c `eqP` (unpackS . TL.intersperse c)

286+t_transpose = unsquare $

287+ L.transpose `eq` (map unpackS . T.transpose . map packS)

288+tl_transpose = unsquare $

289+ L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)

200290t_reverse = L.reverse `eqP` (unpackS . T.reverse)

201291tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)

202292t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)

@@ -208,7 +298,7 @@ tl_replace s d = (L.intercalate d . splitOn s) `eqP`

208298

209299splitOn :: (Eq a) => [a] -> [a] -> [[a]]

210300splitOn pat src0

211− | l == 0 = error "empty"

301+ | l == 0 = error "splitOn: empty"

212302 | otherwise = go src0

213303 where

214304 l = length pat

@@ -293,17 +383,24 @@ sf_foldr p f z = (L.foldr f z . L.filter p) `eqP` (S.foldr f z . S.filter p)

293383 where _types = f :: Char -> Char -> Char

294384t_foldr f z = L.foldr f z `eqP` T.foldr f z

295385 where _types = f :: Char -> Char -> Char

296−tl_foldr f z = L.foldr f z `eqP` TL.foldr f z

386+tl_foldr f z = unsquare $

387+ L.foldr f z `eqP` TL.foldr f z

297388 where _types = f :: Char -> Char -> Char

298−sf_foldr1 p f = (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)

389+sf_foldr1 p f = unsquare $

390+ (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)

299391t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f

300−tl_foldr1 f = L.foldr1 f `eqP` TL.foldr1 f

392+tl_foldr1 f = unsquare $

393+ L.foldr1 f `eqP` TL.foldr1 f

301394

302−s_concat_s = L.concat `eq` (unpackS . S.unstream . S.concat . map packS)

303−sf_concat p = (L.concat . map (L.filter p)) `eq`

395+s_concat_s = unsquare $

396+ L.concat `eq` (unpackS . S.unstream . S.concat . map packS)

397+sf_concat p = unsquare $

398+ (L.concat . map (L.filter p)) `eq`

304399 (unpackS . S.concat . map (S.filter p . packS))

305−t_concat = L.concat `eq` (unpackS . T.concat . map packS)

306−tl_concat = L.concat `eq` (unpackS . TL.concat . map TL.pack)

400+t_concat = unsquare $

401+ L.concat `eq` (unpackS . T.concat . map packS)

402+tl_concat = unsquare $

403+ L.concat `eq` (unpackS . TL.concat . map TL.pack)

307404sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`

308405 (unpackS . S.concatMap (packS . f) . S.filter p)

309406t_concatMap f = unsquare $

@@ -343,6 +440,10 @@ t_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z)

343440tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)

344441 where _types = f :: Int -> Char -> (Int,Char)

345442

443+tl_repeat n = (L.take m . L.repeat) `eq`

444+ (unpackS . TL.take (fromIntegral m) . TL.repeat)

445+ where m = fromIntegral (n :: Word8)

446+

346447replicate n l = concat (L.replicate n l)

347448

348449s_replicate n = replicate m `eq`

@@ -354,6 +455,14 @@ tl_replicate n = replicate m `eq`

354455 (unpackS . TL.replicate (fromIntegral m) . packS)

355456 where m = fromIntegral (n :: Word8)

356457

458+tl_cycle n = (L.take m . L.cycle) `eq`

459+ (unpackS . TL.take (fromIntegral m) . TL.cycle . packS)

460+ where m = fromIntegral (n :: Word8)

461+

462+tl_iterate f n = (L.take m . L.iterate f) `eq`

463+ (unpackS . TL.take (fromIntegral m) . TL.iterate f)

464+ where m = fromIntegral (n :: Word8)

465+

357466unf :: Int -> Char -> Maybe (Char, Char)

358467unf n c | fromEnum c * 100 > n = Nothing

359468 | otherwise = Just (c, succ c)

@@ -380,14 +489,22 @@ s_take_s m = L.take n `eqP` (unpackS . S.unstream . S.take n)

380489sf_take p n = (L.take n . L.filter p) `eqP`

381490 (unpackS . S.take n . S.filter p)

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

492+t_takeEnd n = (L.reverse . L.take n . L.reverse) `eqP`

493+ (unpackS . T.takeEnd n)

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

495+tl_takeEnd n = (L.reverse . L.take (fromIntegral n) . L.reverse) `eqP`

496+ (unpackS . TL.takeEnd n)

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

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

386499 where n = small m

387500sf_drop p n = (L.drop n . L.filter p) `eqP`

388501 (unpackS . S.drop n . S.filter p)

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

503+t_dropEnd n = (L.reverse . L.drop n . L.reverse) `eqP`

504+ (unpackS . T.dropEnd n)

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

506+tl_dropEnd n = (L.reverse . L.drop n . L.reverse) `eqP`

507+ (unpackS . TL.dropEnd (fromIntegral n))

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

392509 where n = small m

393510s_take_drop_s m = (L.take n . L.drop n) `eqP`

@@ -399,6 +516,10 @@ sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`

399516 (unpackS . S.takeWhile p . S.filter q)

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

401518tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)

519+t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`

520+ (unpackS . T.takeWhileEnd p)

521+tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`

522+ (unpackS . TL.takeWhileEnd p)

402523s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)

403524s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)

404525sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`

@@ -451,24 +572,27 @@ tl_groupBy p = L.groupBy p `eqP` (map unpackS . TL.groupBy p)

451572t_inits = L.inits `eqP` (map unpackS . T.inits)

452573tl_inits = L.inits `eqP` (map unpackS . TL.inits)

453574t_tails = L.tails `eqP` (map unpackS . T.tails)

454−tl_tails = L.tails `eqP` (map unpackS . TL.tails)

455−t_findAppendId (NotEmpty s) = unsquare $ \ts ->

575+tl_tails = unsquare $

576+ L.tails `eqP` (map unpackS . TL.tails)

577+t_findAppendId = unsquare $ \(NotEmpty s) ts ->

456578 let t = T.intercalate s ts

457579 in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)

458−tl_findAppendId (NotEmpty s) = unsquare $ \ts ->

580+tl_findAppendId = unsquare $ \(NotEmpty s) ts ->

459581 let t = TL.intercalate s ts

460582 in all (==t) $ map (uncurry TL.append) (TL.breakOnAll s t)

461−t_findContains (NotEmpty s) = all (T.isPrefixOf s . snd) . T.breakOnAll s .

462− T.intercalate s

463−tl_findContains (NotEmpty s) = all (TL.isPrefixOf s . snd) .

583+t_findContains = unsquare $ \(NotEmpty s) ->

584+ all (T.isPrefixOf s . snd) . T.breakOnAll s . T.intercalate s

585+tl_findContains = unsquare $ \(NotEmpty s) -> all (TL.isPrefixOf s . snd) .

464586 TL.breakOnAll s . TL.intercalate s

465587sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c

466588t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s

467589tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s

468590

469−t_splitOn_split s = (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s

470−tl_splitOn_split s = ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`

471− (map TL.fromStrict . T.splitOn s)) . T.intercalate s

591+t_splitOn_split s = unsquare $

592+ (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s

593+tl_splitOn_split s = unsquare $

594+ ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`

595+ (map TL.fromStrict . T.splitOn s)) . T.intercalate s

472596t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)

473597tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)

474598

@@ -510,10 +634,14 @@ t_lines' = lines' `eqP` (map unpackS . T.lines')

510634t_words = L.words `eqP` (map unpackS . T.words)

511635

512636tl_words = L.words `eqP` (map unpackS . TL.words)

513−t_unlines = L.unlines `eq` (unpackS . T.unlines . map packS)

514−tl_unlines = L.unlines `eq` (unpackS . TL.unlines . map packS)

515−t_unwords = L.unwords `eq` (unpackS . T.unwords . map packS)

516−tl_unwords = L.unwords `eq` (unpackS . TL.unwords . map packS)

637+t_unlines = unsquare $

638+ L.unlines `eq` (unpackS . T.unlines . map packS)

639+tl_unlines = unsquare $

640+ L.unlines `eq` (unpackS . TL.unlines . map packS)

641+t_unwords = unsquare $

642+ L.unwords `eq` (unpackS . T.unwords . map packS)

643+tl_unwords = unsquare $

644+ L.unwords `eq` (unpackS . TL.unwords . map packS)

517645

518646s_isPrefixOf s = L.isPrefixOf s `eqP`

519647 (S.isPrefixOf (S.stream $ packS s) . S.stream)

@@ -590,8 +718,9 @@ t_indices (NotEmpty s) = Slow.indices s `eq` indices s

590718tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s

591719 where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)

592720 conc = T.concat . TL.toChunks

593−t_indices_occurs (NotEmpty t) ts = let s = T.intercalate t ts

594− in Slow.indices t s == indices t s

721+t_indices_occurs = unsquare $ \(NotEmpty t) ts ->

722+ let s = T.intercalate t ts

723+ in Slow.indices t s == indices t s

595724

596725-- Bit shifts.

597726shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k

@@ -610,17 +739,76 @@ shiftR_Word32 = shiftR :: Word32 -> Property

610739

611740-- Builder.

612741

613−t_builderSingleton = id `eqP`

614− (unpackS . TB.toLazyText . mconcat . map TB.singleton)

615−t_builderFromText = L.concat `eq` (unpackS . TB.toLazyText . mconcat .

742+tb_singleton = id `eqP`

743+ (unpackS . TB.toLazyText . mconcat . map TB.singleton)

744+tb_fromText = L.concat `eq` (unpackS . TB.toLazyText . mconcat .

616745 map (TB.fromText . packS))

617−t_builderAssociative s1 s2 s3 =

746+tb_associative s1 s2 s3 =

618747 TB.toLazyText (b1 `mappend` (b2 `mappend` b3)) ==

619748 TB.toLazyText ((b1 `mappend` b2) `mappend` b3)

620749 where b1 = TB.fromText (packS s1)

621750 b2 = TB.fromText (packS s2)

622751 b3 = TB.fromText (packS s3)

623752

753+-- Numeric builder stuff.

754+

755+tb_decimal :: (Integral a, Show a) => a -> Bool

756+tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)

757+

758+tb_decimal_integer (a::Integer) = tb_decimal a

759+tb_decimal_integer_big (Big a) = tb_decimal a

760+tb_decimal_int (a::Int) = tb_decimal a

761+tb_decimal_int8 (a::Int8) = tb_decimal a

762+tb_decimal_int16 (a::Int16) = tb_decimal a

763+tb_decimal_int32 (a::Int32) = tb_decimal a

764+tb_decimal_int64 (a::Int64) = tb_decimal a

765+tb_decimal_word (a::Word) = tb_decimal a

766+tb_decimal_word8 (a::Word8) = tb_decimal a

767+tb_decimal_word16 (a::Word16) = tb_decimal a

768+tb_decimal_word32 (a::Word32) = tb_decimal a

769+tb_decimal_word64 (a::Word64) = tb_decimal a

770+

771+tb_decimal_big_int (BigBounded (a::Int)) = tb_decimal a

772+tb_decimal_big_int64 (BigBounded (a::Int64)) = tb_decimal a

773+tb_decimal_big_word (BigBounded (a::Word)) = tb_decimal a

774+tb_decimal_big_word64 (BigBounded (a::Word64)) = tb_decimal a

775+

776+tb_hex :: (Integral a, Show a) => a -> Bool

777+tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")

778+

779+tb_hexadecimal_integer (a::Integer) = tb_hex a

780+tb_hexadecimal_int (a::Int) = tb_hex a

781+tb_hexadecimal_int8 (a::Int8) = tb_hex a

782+tb_hexadecimal_int16 (a::Int16) = tb_hex a

783+tb_hexadecimal_int32 (a::Int32) = tb_hex a

784+tb_hexadecimal_int64 (a::Int64) = tb_hex a

785+tb_hexadecimal_word (a::Word) = tb_hex a

786+tb_hexadecimal_word8 (a::Word8) = tb_hex a

787+tb_hexadecimal_word16 (a::Word16) = tb_hex a

788+tb_hexadecimal_word32 (a::Word32) = tb_hex a

789+tb_hexadecimal_word64 (a::Word64) = tb_hex a

790+

791+tb_realfloat :: (RealFloat a, Show a) => a -> Bool

792+tb_realfloat = (TB.toLazyText . TB.realFloat) `eq` (TL.pack . show)

793+

794+tb_realfloat_float (a::Float) = tb_realfloat a

795+tb_realfloat_double (a::Double) = tb_realfloat a

796+

797+showFloat :: (RealFloat a) => TB.FPFormat -> Maybe Int -> a -> ShowS

798+showFloat TB.Exponent = showEFloat

799+showFloat TB.Fixed = showFFloat

800+showFloat TB.Generic = showGFloat

801+

802+tb_formatRealFloat :: (RealFloat a, Show a) =>

803+ a -> TB.FPFormat -> Precision a -> Property

804+tb_formatRealFloat a fmt prec =

805+ TB.formatRealFloat fmt p a ===

806+ TB.fromString (showFloat fmt p a "")

807+ where p = precision a prec

808+

809+tb_formatRealFloat_float (a::Float) = tb_formatRealFloat a

810+tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a

811+

624812-- Reading.

625813

626814t_decimal (n::Int) s =

@@ -629,16 +817,18 @@ t_decimal (n::Int) s =

629817tl_decimal (n::Int) s =

630818 TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)

631819 where t = TL.dropWhile isDigit s

632−t_hexadecimal (n::Positive Int) s ox =

820+t_hexadecimal m s ox =

633821 T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)

634822 where t = T.dropWhile isHexDigit s

635823 p = if ox then "0x" else ""

636−tl_hexadecimal (n::Positive Int) s ox =

824+ n = getPositive m :: Int

825+tl_hexadecimal m s ox =

637826 TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)

638827 where t = TL.dropWhile isHexDigit s

639828 p = if ox then "0x" else ""

829+ n = getPositive m :: Int

640830

641−isFloaty c = c `elem` "+-.0123456789eE"

831+isFloaty c = c `elem` ("+-.0123456789eE" :: String)

642832

643833t_read_rational p tol (n::Double) s =

644834 case p (T.pack (show n) `T.append` t) of

@@ -681,6 +871,8 @@ t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) == t

681871 where n = small m

682872t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)

683873

874+t_copy t = T.copy t == t

875+

684876-- Regression tests.

685877s_filter_eq s = S.filter p t == S.streamList (filter p s)

686878 where p = (/= S.last t)

@@ -691,7 +883,7 @@ s_filter_eq s = S.filter p t == S.streamList (filter p s)

691883-- themselves.

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

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

694− | n > 0 = S.Stream arr off (smaller (exactSize n) len)

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

695887 | otherwise = t

696888

697889tests :: Test

@@ -713,8 +905,12 @@ tests =

713905 testGroup "transcoding" [

714906 testProperty "t_ascii" t_ascii,

715907 testProperty "tl_ascii" tl_ascii,

908+ testProperty "t_latin1" t_latin1,

909+ testProperty "tl_latin1" tl_latin1,

716910 testProperty "t_utf8" t_utf8,

717911 testProperty "t_utf8'" t_utf8',

912+ testProperty "t_utf8_incr" t_utf8_incr,

913+ testProperty "t_utf8_undecoded" t_utf8_undecoded,

718914 testProperty "tl_utf8" tl_utf8,

719915 testProperty "tl_utf8'" tl_utf8',

720916 testProperty "t_utf16LE" t_utf16LE,

@@ -914,9 +1110,12 @@ tests =

9141110 ],

9151111

9161112 testGroup "unfolds" [

1113+ testProperty "tl_repeat" tl_repeat,

9171114 testProperty "s_replicate" s_replicate,

9181115 testProperty "t_replicate" t_replicate,

9191116 testProperty "tl_replicate" tl_replicate,

1117+ testProperty "tl_cycle" tl_cycle,

1118+ testProperty "tl_iterate" tl_iterate,

9201119 testProperty "t_unfoldr" t_unfoldr,

9211120 testProperty "tl_unfoldr" tl_unfoldr,

9221121 testProperty "t_unfoldrN" t_unfoldrN,

@@ -930,12 +1129,16 @@ tests =

9301129 testProperty "s_take_s" s_take_s,

9311130 testProperty "sf_take" sf_take,

9321131 testProperty "t_take" t_take,

1132+ testProperty "t_takeEnd" t_takeEnd,

9331133 testProperty "tl_take" tl_take,

1134+ testProperty "tl_takeEnd" tl_takeEnd,

9341135 testProperty "s_drop" s_drop,

9351136 testProperty "s_drop_s" s_drop_s,

9361137 testProperty "sf_drop" sf_drop,

9371138 testProperty "t_drop" t_drop,

1139+ testProperty "t_dropEnd" t_dropEnd,

9381140 testProperty "tl_drop" tl_drop,

1141+ testProperty "tl_dropEnd" tl_dropEnd,

9391142 testProperty "s_take_drop" s_take_drop,

9401143 testProperty "s_take_drop_s" s_take_drop_s,

9411144 testProperty "s_takeWhile" s_takeWhile,

@@ -943,6 +1146,8 @@ tests =

9431146 testProperty "sf_takeWhile" sf_takeWhile,

9441147 testProperty "t_takeWhile" t_takeWhile,

9451148 testProperty "tl_takeWhile" tl_takeWhile,

1149+ testProperty "t_takeWhileEnd" t_takeWhileEnd,

1150+ testProperty "tl_takeWhileEnd" tl_takeWhileEnd,

9461151 testProperty "sf_dropWhile" sf_dropWhile,

9471152 testProperty "s_dropWhile" s_dropWhile,

9481153 testProperty "s_dropWhile_s" s_dropWhile_s,

@@ -1080,9 +1285,46 @@ tests =

10801285 ],

10811286

10821287 testGroup "builder" [

1083− testProperty "t_builderSingleton" t_builderSingleton,

1084− testProperty "t_builderFromText" t_builderFromText,

1085− testProperty "t_builderAssociative" t_builderAssociative

1288+ testProperty "tb_associative" tb_associative,

1289+ testGroup "decimal" [

1290+ testProperty "tb_decimal_int" tb_decimal_int,

1291+ testProperty "tb_decimal_int8" tb_decimal_int8,

1292+ testProperty "tb_decimal_int16" tb_decimal_int16,

1293+ testProperty "tb_decimal_int32" tb_decimal_int32,

1294+ testProperty "tb_decimal_int64" tb_decimal_int64,

1295+ testProperty "tb_decimal_integer" tb_decimal_integer,

1296+ testProperty "tb_decimal_integer_big" tb_decimal_integer_big,

1297+ testProperty "tb_decimal_word" tb_decimal_word,

1298+ testProperty "tb_decimal_word8" tb_decimal_word8,

1299+ testProperty "tb_decimal_word16" tb_decimal_word16,

1300+ testProperty "tb_decimal_word32" tb_decimal_word32,

1301+ testProperty "tb_decimal_word64" tb_decimal_word64,

1302+ testProperty "tb_decimal_big_int" tb_decimal_big_int,

1303+ testProperty "tb_decimal_big_word" tb_decimal_big_word,

1304+ testProperty "tb_decimal_big_int64" tb_decimal_big_int64,

1305+ testProperty "tb_decimal_big_word64" tb_decimal_big_word64

1306+ ],

1307+ testGroup "hexadecimal" [

1308+ testProperty "tb_hexadecimal_int" tb_hexadecimal_int,

1309+ testProperty "tb_hexadecimal_int8" tb_hexadecimal_int8,

1310+ testProperty "tb_hexadecimal_int16" tb_hexadecimal_int16,

1311+ testProperty "tb_hexadecimal_int32" tb_hexadecimal_int32,

1312+ testProperty "tb_hexadecimal_int64" tb_hexadecimal_int64,

1313+ testProperty "tb_hexadecimal_integer" tb_hexadecimal_integer,

1314+ testProperty "tb_hexadecimal_word" tb_hexadecimal_word,

1315+ testProperty "tb_hexadecimal_word8" tb_hexadecimal_word8,

1316+ testProperty "tb_hexadecimal_word16" tb_hexadecimal_word16,

1317+ testProperty "tb_hexadecimal_word32" tb_hexadecimal_word32,

1318+ testProperty "tb_hexadecimal_word64" tb_hexadecimal_word64

1319+ ],

1320+ testGroup "realfloat" [

1321+ testProperty "tb_realfloat_double" tb_realfloat_double,

1322+ testProperty "tb_realfloat_float" tb_realfloat_float,

1323+ testProperty "tb_formatRealFloat_float" tb_formatRealFloat_float,

1324+ testProperty "tb_formatRealFloat_double" tb_formatRealFloat_double

1325+ ],

1326+ testProperty "tb_fromText" tb_fromText,

1327+ testProperty "tb_singleton" tb_singleton

10861328 ],

10871329

10881330 testGroup "read" [

@@ -1113,6 +1355,9 @@ tests =

11131355 testProperty "t_dropWord16" t_dropWord16,

11141356 testProperty "t_takeWord16" t_takeWord16,

11151357 testProperty "t_take_drop_16" t_take_drop_16,

1116− testProperty "t_use_from" t_use_from

1117− ]

1358+ testProperty "t_use_from" t_use_from,

1359+ testProperty "t_copy" t_copy

1360+ ],

1361+

1362+ testGroup "mul" Mul.tests

11181363 ]

tests/Tests/Properties/Mul.hsnew file+40

@@ -0,0 +1,40 @@

1+{-# LANGUAGE ScopedTypeVariables #-}

3+module Tests.Properties.Mul (tests) where

5+import Control.Applicative ((<$>), pure)

6+import Control.Exception as E (SomeException, catch, evaluate)

7+import Data.Int (Int32, Int64)

8+import Data.Text.Internal (mul, mul32, mul64)

9+import System.IO.Unsafe (unsafePerformIO)

10+import Test.Framework (Test)

11+import Test.Framework.Providers.QuickCheck2 (testProperty)

12+import Test.QuickCheck hiding ((.&.))

13+

14+mulRef :: (Integral a, Bounded a) => a -> a -> Maybe a

15+mulRef a b

16+ | ab < bot || ab > top = Nothing

17+ | otherwise = Just (fromIntegral ab)

18+ where ab = fromIntegral a * fromIntegral b

19+ top = fromIntegral (maxBound `asTypeOf` a) :: Integer

20+ bot = fromIntegral (minBound `asTypeOf` a) :: Integer

21+

22+eval :: (a -> b -> c) -> a -> b -> Maybe c

23+eval f a b = unsafePerformIO $

24+ (Just <$> evaluate (f a b)) `E.catch` (\(_::SomeException) -> pure Nothing)

25+

26+t_mul32 :: Int32 -> Int32 -> Property

27+t_mul32 a b = mulRef a b === eval mul32 a b

28+

29+t_mul64 :: Int64 -> Int64 -> Property

30+t_mul64 a b = mulRef a b === eval mul64 a b

31+

32+t_mul :: Int -> Int -> Property

33+t_mul a b = mulRef a b === eval mul a b

34+

35+tests :: [Test]

36+tests = [

37+ testProperty "t_mul" t_mul

38+ , testProperty "t_mul32" t_mul32

39+ , testProperty "t_mul64" t_mul64

40+ ]

tests/tests/src/Data/Text/Tests/QuickCheckUtils.hs → tests/Tests/QuickCheckUtils.hsrenamed+110−87

@@ -1,116 +1,100 @@

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

1111 , smallArbitrary

1212

13− , NotEmpty (..)

13+ , BigBounded(..)

14+ , BigInt(..)

15+ , NotEmpty(..)

1416

15− , Small (..)

17+ , Small(..)

1618 , small

1719

20+ , Precision(..)

21+ , precision

22+

1823 , integralRandomR

1924

20− , DecodeErr (..)

25+ , DecodeErr(..)

26+ , genDecodeErr

2127

22− , Stringy (..)

28+ , Stringy(..)

2329 , eq

2430 , eqP

2531

26− , Encoding (..)

27−

32+ , Encoding(..)

33+

2834 , write_read

2935 ) where

3036

37+import Control.Applicative ((<$>))

3138import Control.Arrow (first, (***))

3239import Control.DeepSeq (NFData (..), deepseq)

3340import Control.Exception (bracket)

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

35−import Data.Char (chr)

36−import Data.Word (Word8, Word16)

3741import Data.String (IsString, fromString)

3842import Data.Text.Foreign (I16)

43+import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))

44+import Data.Word (Word8, Word16)

3945import Debug.Trace (trace)

40−import System.Random (Random (..), RandomGen)

41−import Test.QuickCheck hiding ((.&.))

46+import System.Random (Random(..), RandomGen)

47+import Test.QuickCheck hiding (Fixed(..), Small (..), (.&.))

4248import Test.QuickCheck.Monadic (assert, monadicIO, run)

49+import Test.QuickCheck.Unicode (string)

50+import Tests.Utils

4351import qualified Data.ByteString as B

4452import qualified Data.Text as T

4553import qualified Data.Text.Encoding.Error as T

46−import qualified Data.Text.Fusion as TF

47−import qualified Data.Text.Fusion.Common as TF

54+import qualified Data.Text.Internal.Fusion as TF

55+import qualified Data.Text.Internal.Fusion.Common as TF

56+import qualified Data.Text.Internal.Lazy as TL

57+import qualified Data.Text.Internal.Lazy.Fusion as TLF

4858import qualified Data.Text.Lazy as TL

49−import qualified Data.Text.Lazy.Fusion as TLF

50−import qualified Data.Text.Lazy.Internal as TL

5159import qualified System.IO as IO

5260

53−import Data.Text.Tests.Utils

61+#if !MIN_VERSION_base(4,4,0)

62+import Data.Int (Int64)

63+import Data.Word (Word, Word64)

64+#endif

65+

66+genUnicode :: IsString a => Gen a

67+genUnicode = fromString <$> string

5468

5569instance Random I16 where

5670 randomR = integralRandomR

5771 random = randomR (minBound,maxBound)

5872

5973instance Arbitrary I16 where

60− arbitrary = choose (minBound,maxBound)

74+ arbitrary = arbitrarySizedIntegral

75+ shrink = shrinkIntegral

6176

6277instance Arbitrary B.ByteString where

6378 arbitrary = B.pack `fmap` arbitrary

79+ shrink = map B.pack . shrink . B.unpack

6480

65−genUnicode :: IsString a => Gen a

66−genUnicode = fmap fromString string where

67− string = sized $ \n ->

68− do k <- choose (0,n)

69− sequence [ char | _ <- [1..k] ]

70−

71− excluding :: [a -> Bool] -> Gen a -> Gen a

72− excluding bad gen = loop

73− where

74− loop = do

75− x <- gen

76− if or (map ($ x) bad)

77− then loop

78− else return x

79−

80− reserved = [lowSurrogate, highSurrogate, noncharacter]

81− lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF

82− highSurrogate c = c >= 0xD800 && c <= 0xDBFF

83− noncharacter c = masked == 0xFFFE || masked == 0xFFFF

84− where

85− masked = c .&. 0xFFFF

86−

87− ascii = choose (0,0x7F)

88− plane0 = choose (0xF0, 0xFFFF)

89− plane1 = oneof [ choose (0x10000, 0x10FFF)

90− , choose (0x11000, 0x11FFF)

91− , choose (0x12000, 0x12FFF)

92− , choose (0x13000, 0x13FFF)

93− , choose (0x1D000, 0x1DFFF)

94− , choose (0x1F000, 0x1FFFF)

95− ]

96− plane2 = oneof [ choose (0x20000, 0x20FFF)

97− , choose (0x21000, 0x21FFF)

98− , choose (0x22000, 0x22FFF)

99− , choose (0x23000, 0x23FFF)

100− , choose (0x24000, 0x24FFF)

101− , choose (0x25000, 0x25FFF)

102− , choose (0x26000, 0x26FFF)

103− , choose (0x27000, 0x27FFF)

104− , choose (0x28000, 0x28FFF)

105− , choose (0x29000, 0x29FFF)

106− , choose (0x2A000, 0x2AFFF)

107− , choose (0x2B000, 0x2BFFF)

108− , choose (0x2F000, 0x2FFFF)

109− ]

110− plane14 = choose (0xE0000, 0xE0FFF)

111− planes = [ascii, plane0, plane1, plane2, plane14]

112−

113− char = chr `fmap` excluding reserved (oneof planes)

81+#if !MIN_VERSION_base(4,4,0)

82+instance Random Int64 where

83+ randomR = integralRandomR

84+ random = randomR (minBound,maxBound)

85+

86+instance Random Word where

87+ randomR = integralRandomR

88+ random = randomR (minBound,maxBound)

89+

90+instance Random Word8 where

91+ randomR = integralRandomR

92+ random = randomR (minBound,maxBound)

93+

94+instance Random Word64 where

95+ randomR = integralRandomR

96+ random = randomR (minBound,maxBound)

97+#endif

11498

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

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

@@ -123,9 +107,25 @@ smallArbitrary = sized $ \n -> resize (smallish n) arbitrary

123107

124108instance Arbitrary T.Text where

125109 arbitrary = T.pack `fmap` arbitrary

110+ shrink = map T.pack . shrink . T.unpack

126111

127112instance Arbitrary TL.Text where

128113 arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary

114+ shrink = map TL.pack . shrink . TL.unpack

115+

116+newtype BigInt = Big Integer

117+ deriving (Eq, Show)

118+

119+instance Arbitrary BigInt where

120+ arbitrary = choose (1::Int,200) >>= \e -> Big <$> choose (10^(e-1),10^e)

121+ shrink (Big a) = [Big (a `div` 2^(l-e)) | e <- shrink l]

122+ where l = truncate (log (fromIntegral a) / log 2 :: Double) :: Integer

123+

124+newtype BigBounded a = BigBounded a

125+ deriving (Eq, Show)

126+

127+instance (Bounded a, Random a, Arbitrary a) => Arbitrary (BigBounded a) where

128+ arbitrary = BigBounded <$> choose (minBound, maxBound)

129129

130130newtype NotEmpty a = NotEmpty { notEmpty :: a }

131131 deriving (Eq, Ord)

@@ -138,15 +138,23 @@ instance Functor NotEmpty where

138138

139139instance Arbitrary a => Arbitrary (NotEmpty [a]) where

140140 arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))

141+ shrink = shrinkNotEmpty null

141142

142143instance Arbitrary (NotEmpty T.Text) where

143144 arbitrary = (fmap T.pack) `fmap` arbitrary

145+ shrink = shrinkNotEmpty T.null

144146

145147instance Arbitrary (NotEmpty TL.Text) where

146148 arbitrary = (fmap TL.pack) `fmap` arbitrary

149+ shrink = shrinkNotEmpty TL.null

147150

148151instance Arbitrary (NotEmpty B.ByteString) where

149152 arbitrary = (fmap B.pack) `fmap` arbitrary

153+ shrink = shrinkNotEmpty B.null

154+

155+shrinkNotEmpty :: Arbitrary a => (a -> Bool) -> NotEmpty a -> [NotEmpty a]

156+shrinkNotEmpty isNull (NotEmpty xs) =

157+ [ NotEmpty xs' | xs' <- shrink xs, not (isNull xs') ]

150158

151159data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7

152160 | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15

@@ -187,23 +195,25 @@ instance Random Small where

187195 random = randomR (minBound,maxBound)

188196

189197instance Arbitrary Small where

190− arbitrary = choose (minBound,maxBound)

198+ arbitrary = choose (minBound, maxBound)

199+ shrink = shrinkIntegral

191200

192201integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)

193202integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,

194203 fromIntegral b :: Integer) g of

195204 (x,h) -> (fromIntegral x, h)

196205

197−data DecodeErr = DE String T.OnDecodeError

206+data DecodeErr = Lenient | Ignore | Strict | Replace

207+ deriving (Show, Eq)

198208

199−instance Show DecodeErr where

200− show (DE d _) = "DE " ++ d

209+genDecodeErr :: DecodeErr -> Gen T.OnDecodeError

210+genDecodeErr Lenient = return T.lenientDecode

211+genDecodeErr Ignore = return T.ignore

212+genDecodeErr Strict = return T.strictDecode

213+genDecodeErr Replace = arbitrary

201214

202215instance Arbitrary DecodeErr where

203− arbitrary = oneof [ return $ DE "lenient" T.lenientDecode

204− , return $ DE "ignore" T.ignore

205− , return $ DE "strict" T.strictDecode

206− , DE "replace" `fmap` arbitrary ]

216+ arbitrary = elements [Lenient, Ignore, Strict, Replace]

207217

208218class Stringy s where

209219 packS :: String -> s

@@ -257,6 +267,30 @@ eqP f g s w = eql "orig" (f s) (g t) &&

257267 | a =^= b = True

258268 | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False

259269

270+instance Arbitrary FPFormat where

271+ arbitrary = elements [Exponent, Fixed, Generic]

272+

273+newtype Precision a = Precision (Maybe Int)

274+ deriving (Eq, Show)

275+

276+precision :: a -> Precision a -> Maybe Int

277+precision _ (Precision prec) = prec

278+

279+arbitraryPrecision :: Int -> Gen (Precision a)

280+arbitraryPrecision maxDigits = Precision <$> do

281+ n <- choose (-1,maxDigits)

282+ return $ if n == -1

283+ then Nothing

284+ else Just n

285+

286+instance Arbitrary (Precision Float) where

287+ arbitrary = arbitraryPrecision 11

288+ shrink = map Precision . shrink . precision undefined

289+

290+instance Arbitrary (Precision Double) where

291+ arbitrary = arbitraryPrecision 22

292+ shrink = map Precision . shrink . precision undefined

293+

260294-- Work around lack of Show instance for TextEncoding.

261295data Encoding = E String IO.TextEncoding

262296

@@ -274,17 +308,6 @@ windowsNewlineMode = IO.NewlineMode

274308 { IO.inputNL = IO.CRLF, IO.outputNL = IO.CRLF

275309 }

276310

277−-- Newline and NewlineMode have standard Show instance from GHC 7 onwards

278−#if __GLASGOW_HASKELL__ < 700

279−instance Show IO.Newline where

280− show IO.CRLF = "CRLF"

281− show IO.LF = "LF"

282−

283−instance Show IO.NewlineMode where

284− show (IO.NewlineMode i o) = "NewlineMode { inputNL = " ++ show i ++

285− ", outputNL = " ++ show o ++ " }"

286−# endif

287−

288311instance Arbitrary IO.NewlineMode where

289312 arbitrary = oneof . map return $

290313 [ IO.noNewlineTranslation, IO.universalNewlineMode, IO.nativeNewlineMode

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/src/Data/Text/Benchmarks/FileRead.hsdeleted−33

@@ -1,33 +0,0 @@

1−-- | Benchmarks simple file reading

2−--

3−-- Tested in this benchmark:

4−--

5−-- * Reading a file from the disk

6−--

7−module Data.Text.Benchmarks.FileRead

8− ( benchmark

9− ) where

10−

11−import Control.Exception (evaluate)

12−import Criterion (Benchmark, bgroup, bench)

13−import qualified Data.ByteString as SB

14−import qualified Data.ByteString.Lazy as LB

15−import qualified Data.Text as T

16−import qualified Data.Text.Encoding as T

17−import qualified Data.Text.IO as T

18−import qualified Data.Text.Lazy as LT

19−import qualified Data.Text.Lazy.Encoding as LT

20−import qualified Data.Text.Lazy.IO as LT

21−

22−benchmark :: FilePath -> IO Benchmark

23−benchmark p = return $ bgroup "FileRead"

24− [ bench "String" $ readFile p >>= evaluate . length

25− , bench "ByteString" $ SB.readFile p >>= evaluate . SB.length

26− , bench "LazyByteString" $ LB.readFile p >>= evaluate . LB.length

27− , bench "Text" $ T.readFile p >>= evaluate . T.length

28− , bench "LazyText" $ LT.readFile p >>= evaluate . LT.length

29− , bench "TextByteString" $

30− SB.readFile p >>= evaluate . T.length . T.decodeUtf8

31− , bench "LazyTextByteString" $

32− LB.readFile p >>= evaluate . LT.length . LT.decodeUtf8

33− ]

tests/benchmarks/src/Data/Text/Benchmarks/Replace.hsdeleted−31

@@ -1,31 +0,0 @@

1−-- | Replace a string by another string

2−--

3−-- Tested in this benchmark:

4−--

5−-- * Search and replace of a pattern in a text

6−--

7−module Data.Text.Benchmarks.Replace

8− ( benchmark

9− ) where

10−

11−import Criterion (Benchmark, bgroup, bench, nf)

12−import qualified Data.ByteString.Char8 as B

13−import qualified Data.ByteString.Lazy as BL

14−import qualified Data.ByteString.Lazy.Search as BL

15−import qualified Data.Text.Lazy as TL

16−import qualified Data.Text.Lazy.Encoding as TL

17−import qualified Data.Text.Lazy.IO as TL

18−

19−benchmark :: FilePath -> String -> String -> IO Benchmark

20−benchmark fp pat sub = do

21− tl <- TL.readFile fp

22− bl <- BL.readFile fp

23− return $ bgroup "Replace"

24− [ bench "LazyText" $ nf (TL.length . TL.replace tpat tsub) tl

25− , bench "LazyByteString" $ nf (BL.length . BL.replace bpat bsub) bl

26− ]

27− where

28− tpat = TL.pack pat

29− tsub = TL.pack sub

30− bpat = B.concat $ BL.toChunks $ TL.encodeUtf8 tpat

31− bsub = B.concat $ BL.toChunks $ TL.encodeUtf8 tsub

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/cabal.confignew file+6

@@ -0,0 +1,6 @@

1+-- These flags help to speed up building the test suite.

3+documentation: False

4+executable-stripping: False

5+flags: developer

6+library-profiling: False

tests/literal-rule-test.shnew file+29

@@ -0,0 +1,29 @@

1+#!/bin/bash -e

3+failed=0

5+function check_firings() {

6+ rule=$1

7+ expected=$2

8+ build="ghc -O -ddump-rule-firings LiteralRuleTest.hs"

9+ build="$build -i.. -I../include"

10+ touch LiteralRuleTest.hs

11+ echo -n "Want to see $expected firings of rule $rule... " >&2

12+ firings=$($build 2>&1 | grep "Rule fired: $rule\$" | wc -l)

13+ rm -f LiteralRuleTest.{o.hi}

14+

15+ if [ $firings != $expected ]; then

16+ echo "failed, saw $firings" >&2

17+ failed=1

18+ else

19+ echo "pass" >&2

20+ fi

21+}

22+

23+check_firings "TEXT literal" 8

24+check_firings "TEXT literal UTF8" 7

25+check_firings "TEXT empty literal" 4

26+# This is broken at the moment. "TEXT literal" rule fires instead.

27+#check_firings "TEXT singleton literal" 5

28+

29+exit $failed

tests/tests/scripts/cover-stdio.sh → tests/scripts/cover-stdio.shrenamed

The content is the same.

tests/tests/text-tests.cabaldeleted−124

@@ -1,124 +0,0 @@

1−name: text-tests

2−version: 0.0.0.0

3−synopsis: Functional tests for the text package

4−description: Functional tests 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: Bryan O'Sullivan <bos@serpentine.com>

13−category: Text

14−build-type: Simple

15−

16−cabal-version: >=1.8

17−

18−flag hpc

19− description: Enable HPC to generate coverage reports

20− default: False

21−

22−executable text-tests

23− hs-source-dirs: src

24− main-is: Data/Text/Tests.hs

25−

26− ghc-options:

27− -Wall -threaded -O0 -rtsopts

28−

29− if flag(hpc)

30− ghc-options:

31− -fhpc

32−

33− cpp-options:

34− -DASSERTS

35− -DHAVE_DEEPSEQ

36−

37− 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

49−

50−executable text-tests-stdio

51− hs-source-dirs: src

52− main-is: Data/Text/Tests/IO.hs

53−

54− ghc-options:

55− -Wall -threaded -rtsopts

56−

57− -- Optional HPC support

58− if flag(hpc)

59− ghc-options:

60− -fhpc

61−

62− build-depends:

63− text-tests,

64− base >= 4 && < 5

65−

66−library

67− hs-source-dirs: ../..

68− c-sources: ../../cbits/cbits.c

69− exposed-modules:

70− Data.Text

71− Data.Text.Array

72− Data.Text.Encoding

73− Data.Text.Encoding.Error

74− Data.Text.Foreign

75− Data.Text.IO

76− Data.Text.Internal

77− Data.Text.Lazy

78− Data.Text.Lazy.Builder

79− Data.Text.Lazy.Builder.Int

80− Data.Text.Lazy.Builder.RealFloat

81− Data.Text.Lazy.Encoding

82− Data.Text.Lazy.IO

83− Data.Text.Lazy.Internal

84− Data.Text.Lazy.Read

85− Data.Text.Read

86− Data.Text.Encoding.Fusion

87− Data.Text.Encoding.Fusion.Common

88− Data.Text.Encoding.Utf16

89− Data.Text.Encoding.Utf32

90− Data.Text.Encoding.Utf8

91− Data.Text.Fusion

92− Data.Text.Fusion.CaseMapping

93− Data.Text.Fusion.Common

94− Data.Text.Fusion.Internal

95− Data.Text.Fusion.Size

96− Data.Text.IO.Internal

97− Data.Text.Lazy.Builder.Functions

98− Data.Text.Lazy.Builder.RealFloat.Functions

99− Data.Text.Lazy.Encoding.Fusion

100− Data.Text.Lazy.Fusion

101− Data.Text.Lazy.Search

102− Data.Text.Search

103− Data.Text.Unsafe

104− Data.Text.Unsafe.Base

105− Data.Text.UnsafeChar

106− Data.Text.UnsafeShift

107− Data.Text.Util

108−

109− if flag(hpc)

110− ghc-options:

111− -fhpc

112−

113− cpp-options:

114− -DHAVE_DEEPSEQ

115− -DASSERTS

116− -DINTEGER_GMP

117−

118− build-depends:

119− 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

tests/text-tests.cabalnew file+143

@@ -0,0 +1,143 @@

1+name: text-tests

2+version: 0.0.0.0

3+synopsis: Functional tests for the text package

4+description: Functional tests for the text package

5+homepage: https://github.com/bos/text

6+license: BSD2

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: Bryan O'Sullivan <bos@serpentine.com>

13+category: Text

14+build-type: Simple

15+

16+cabal-version: >=1.8

17+

18+flag hpc

19+ description: Enable HPC to generate coverage reports

20+ default: False

21+ manual: True

22+

23+executable text-tests

24+ main-is: Tests.hs

25+

26+ other-modules:

27+ Tests.IO

28+ Tests.Properties

29+ Tests.Properties.Mul

30+ Tests.QuickCheckUtils

31+ Tests.Regressions

32+ Tests.SlowFunctions

33+ Tests.Utils

34+

35+ ghc-options:

36+ -Wall -threaded -O0 -rtsopts

37+

38+ if flag(hpc)

39+ ghc-options:

40+ -fhpc

41+

42+ cpp-options:

43+ -DTEST_SUITE

44+ -DASSERTS

45+ -DHAVE_DEEPSEQ

46+

47+ build-depends:

48+ HUnit >= 1.2,

49+ QuickCheck >= 2.7,

50+ base == 4.*,

51+ bytestring,

52+ deepseq,

53+ directory,

54+ quickcheck-unicode,

55+ random,

56+ test-framework >= 0.4,

57+ test-framework-hunit >= 0.2,

58+ test-framework-quickcheck2 >= 0.2,

59+ text-tests

60+

61+executable text-tests-stdio

62+ main-is: Tests/IO.hs

63+

64+ ghc-options:

65+ -Wall -threaded -rtsopts

66+

67+ -- Optional HPC support

68+ if flag(hpc)

69+ ghc-options:

70+ -fhpc

71+

72+ build-depends:

73+ text-tests,

74+ base >= 4 && < 5

75+

76+library

77+ hs-source-dirs: ..

78+ c-sources: ../cbits/cbits.c

79+ include-dirs: ../include

80+ ghc-options: -Wall

81+ exposed-modules:

82+ Data.Text

83+ Data.Text.Array

84+ Data.Text.Encoding

85+ Data.Text.Encoding.Error

86+ Data.Text.Internal.Encoding.Fusion

87+ Data.Text.Internal.Encoding.Fusion.Common

88+ Data.Text.Internal.Encoding.Utf16

89+ Data.Text.Internal.Encoding.Utf32

90+ Data.Text.Internal.Encoding.Utf8

91+ Data.Text.Foreign

92+ Data.Text.Internal.Fusion

93+ Data.Text.Internal.Fusion.CaseMapping

94+ Data.Text.Internal.Fusion.Common

95+ Data.Text.Internal.Fusion.Size

96+ Data.Text.Internal.Fusion.Types

97+ Data.Text.IO

98+ Data.Text.Internal.IO

99+ Data.Text.Internal

100+ Data.Text.Lazy

101+ Data.Text.Lazy.Builder

102+ Data.Text.Internal.Builder.Functions

103+ Data.Text.Lazy.Builder.Int

104+ Data.Text.Internal.Builder.Int.Digits

105+ Data.Text.Internal.Builder

106+ Data.Text.Lazy.Builder.RealFloat

107+ Data.Text.Internal.Builder.RealFloat.Functions

108+ Data.Text.Lazy.Encoding

109+ Data.Text.Internal.Lazy.Encoding.Fusion

110+ Data.Text.Internal.Lazy.Fusion

111+ Data.Text.Lazy.IO

112+ Data.Text.Internal.Lazy

113+ Data.Text.Lazy.Read

114+ Data.Text.Internal.Lazy.Search

115+ Data.Text.Internal.Private

116+ Data.Text.Read

117+ Data.Text.Show

118+ Data.Text.Internal.Read

119+ Data.Text.Internal.Search

120+ Data.Text.Unsafe

121+ Data.Text.Internal.Unsafe

122+ Data.Text.Internal.Unsafe.Char

123+ Data.Text.Internal.Unsafe.Shift

124+ Data.Text.Internal.Functions

125+

126+ if flag(hpc)

127+ ghc-options:

128+ -fhpc

129+

130+ cpp-options:

131+ -DTEST_SUITE

132+ -DHAVE_DEEPSEQ

133+ -DASSERTS

134+ -DINTEGER_GMP

135+

136+ build-depends:

137+ array,

138+ base == 4.*,

139+ binary,

140+ bytestring,

141+ deepseq,

142+ ghc-prim,

143+ integer-gmp

text.cabal+113−73

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

11name: text

2−version: 0.11.1.10

2+version: 1.2.2.1

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.

@@ -30,8 +30,8 @@ description:

3030 non-standard encodings, text breaking, and locales), see

3131 the @text-icu@ package:

3232 <http://hackage.haskell.org/package/text-icu>

33− .

34−license: BSD3

33+

34+license: BSD2

3535license-file: LICENSE

3636author: Bryan O'Sullivan <bos@serpentine.com>

3737maintainer: Bryan O'Sullivan <bos@serpentine.com>

@@ -40,31 +40,48 @@ category: Data, Text

4040build-type: Simple

4141cabal-version: >= 1.8

4242extra-source-files:

43− README.markdown

4443 -- scripts/CaseFolding.txt

4544 -- scripts/SpecialCasing.txt

45+ README.markdown

46+ benchmarks/Setup.hs

47+ benchmarks/cbits/*.c

48+ benchmarks/haskell/*.hs

49+ benchmarks/haskell/Benchmarks/*.hs

50+ benchmarks/haskell/Benchmarks/Programs/*.hs

51+ benchmarks/python/*.py

52+ benchmarks/ruby/*.rb

53+ benchmarks/text-benchmarks.cabal

54+ changelog.md

55+ include/*.h

4656 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

57+ tests-and-benchmarks.markdown

58+ tests/*.hs

59+ tests/.ghci

60+ tests/Makefile

61+ tests/Tests/*.hs

62+ tests/Tests/Properties/*.hs

63+ tests/cabal.config

64+ tests/scripts/*.sh

65+ tests/text-tests.cabal

66+

67+flag bytestring-builder

68+ description: Depend on the bytestring-builder package for backwards compatibility.

69+ default: False

70+ manual: False

6171

6272flag developer

6373 description: operate in developer mode

6474 default: False

75+ manual: True

76+

77+flag integer-simple

78+ description: Use the simple integer library instead of GMP

79+ default: False

80+ manual: False

6581

6682library

67− c-sources: cbits/cbits.c

83+ c-sources: cbits/cbits.c

84+ include-dirs: include

6885

6986 exposed-modules:

7087 Data.Text

@@ -74,6 +91,32 @@ library

7491 Data.Text.Foreign

7592 Data.Text.IO

7693 Data.Text.Internal

94+ Data.Text.Internal.Builder

95+ Data.Text.Internal.Builder.Functions

96+ Data.Text.Internal.Builder.Int.Digits

97+ Data.Text.Internal.Builder.RealFloat.Functions

98+ Data.Text.Internal.Encoding.Fusion

99+ Data.Text.Internal.Encoding.Fusion.Common

100+ Data.Text.Internal.Encoding.Utf16

101+ Data.Text.Internal.Encoding.Utf32

102+ Data.Text.Internal.Encoding.Utf8

103+ Data.Text.Internal.Functions

104+ Data.Text.Internal.Fusion

105+ Data.Text.Internal.Fusion.CaseMapping

106+ Data.Text.Internal.Fusion.Common

107+ Data.Text.Internal.Fusion.Size

108+ Data.Text.Internal.Fusion.Types

109+ Data.Text.Internal.IO

110+ Data.Text.Internal.Lazy

111+ Data.Text.Internal.Lazy.Encoding.Fusion

112+ Data.Text.Internal.Lazy.Fusion

113+ Data.Text.Internal.Lazy.Search

114+ Data.Text.Internal.Private

115+ Data.Text.Internal.Read

116+ Data.Text.Internal.Search

117+ Data.Text.Internal.Unsafe

118+ Data.Text.Internal.Unsafe.Char

119+ Data.Text.Internal.Unsafe.Shift

77120 Data.Text.Lazy

78121 Data.Text.Lazy.Builder

79122 Data.Text.Lazy.Builder.Int

@@ -83,81 +126,78 @@ library

83126 Data.Text.Lazy.Internal

84127 Data.Text.Lazy.Read

85128 Data.Text.Read

86− other-modules:

87− Data.Text.Encoding.Fusion

88− Data.Text.Encoding.Fusion.Common

89− Data.Text.Encoding.Utf16

90− Data.Text.Encoding.Utf32

91− Data.Text.Encoding.Utf8

92− Data.Text.Fusion

93− Data.Text.Fusion.CaseMapping

94− Data.Text.Fusion.Common

95− Data.Text.Fusion.Internal

96− Data.Text.Fusion.Size

97− Data.Text.IO.Internal

98− Data.Text.Lazy.Builder.Functions

99− Data.Text.Lazy.Builder.RealFloat.Functions

100− Data.Text.Lazy.Encoding.Fusion

101− Data.Text.Lazy.Fusion

102− Data.Text.Lazy.Search

103− Data.Text.Search

104129 Data.Text.Unsafe

105− Data.Text.Unsafe.Base

106− Data.Text.UnsafeChar

107− Data.Text.UnsafeShift

108− Data.Text.Util

130+

131+ other-modules:

132+ Data.Text.Show

109133

110134 build-depends:

111− array,

112− base < 5,

113− bytestring >= 0.9 && < 1.0

114− if impl(ghc >= 6.10)

115− build-depends:

116− ghc-prim, base >= 4, deepseq >= 1.1.0.0

117− cpp-options: -DHAVE_DEEPSEQ

135+ array >= 0.3,

136+ base >= 4.2 && < 5,

137+ binary,

138+ deepseq >= 1.1.0.0,

139+ ghc-prim >= 0.2

140+

141+ if flag(bytestring-builder)

142+ build-depends: bytestring >= 0.9 && < 0.10.4,

143+ bytestring-builder >= 0.10.4

118144 else

119− build-depends: extensible-exceptions

120− extensions: PatternSignatures

145+ build-depends: bytestring >= 0.10.4

121146

122− ghc-options: -Wall -funbox-strict-fields -O2

123− if impl(ghc >= 6.8)

124− ghc-options: -fwarn-tabs

147+ cpp-options: -DHAVE_DEEPSEQ

148+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2

125149 if flag(developer)

126150 ghc-prof-options: -auto-all

127151 ghc-options: -Werror

128152 cpp-options: -DASSERTS

129153

130− if impl(ghc >= 6.11)

131− cpp-options: -DINTEGER_GMP

132− build-depends: integer-gmp >= 0.2 && < 0.5

133−

134− if impl(ghc >= 6.9) && impl(ghc < 6.11)

154+ if flag(integer-simple)

155+ cpp-options: -DINTEGER_SIMPLE

156+ build-depends: integer-simple >= 0.1 && < 0.5

157+ else

135158 cpp-options: -DINTEGER_GMP

136− build-depends: integer >= 0.1 && < 0.2

159+ build-depends: integer-gmp >= 0.2

137160

138161test-suite tests

139162 type: exitcode-stdio-1.0

140− hs-source-dirs: . tests/tests/src

141− main-is: Data/Text/Tests.hs

163+ hs-source-dirs: tests .

164+ main-is: Tests.hs

142165 c-sources: cbits/cbits.c

166+ include-dirs: include

143167

144168 ghc-options:

145169 -Wall -threaded -O0 -rtsopts

146170

147171 cpp-options:

148− -DASSERTS -DHAVE_DEEPSEQ

172+ -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE

149173

150174 build-depends:

151− base >= 4 && < 5,

152− bytestring >= 0.9 && < 0.10,

153− deepseq >= 1.1,

154− directory >= 1.0 && < 1.2,

155− random >= 1.0 && < 1.1,

156− QuickCheck >= 2.4 && < 2.5,

157− HUnit >= 1.2 && < 1.3,

158− test-framework >= 0.4 && < 0.5,

159− test-framework-quickcheck2 >= 0.2 && < 0.3,

160− test-framework-hunit >= 0.2 && < 0.3

175+ HUnit >= 1.2,

176+ QuickCheck >= 2.7,

177+ array,

178+ base,

179+ binary,

180+ deepseq,

181+ directory,

182+ ghc-prim,

183+ quickcheck-unicode,

184+ random,

185+ test-framework >= 0.4,

186+ test-framework-hunit >= 0.2,

187+ test-framework-quickcheck2 >= 0.2

188+

189+ if flag(bytestring-builder)

190+ build-depends: bytestring >= 0.9 && < 0.10.4,

191+ bytestring-builder >= 0.10.4

192+ else

193+ build-depends: bytestring >= 0.10.4

194+

195+ if flag(integer-simple)

196+ cpp-options: -DINTEGER_SIMPLE

197+ build-depends: integer-simple >= 0.1 && < 0.5

198+ else

199+ cpp-options: -DINTEGER_GMP

200+ build-depends: integer-gmp >= 0.2

161201

162202source-repository head

163203 type: git