c6015dc...master · text

git.iko.soy/text

on master help sign in

.gitignore+1

since splitsnapshots

unifiedsplit

@@ -1,2 +1,3 @@

1dist

2cabal-dev

3+cabal.sandbox.config

.hgtags+20

@@ -44,3 +44,23 @@ b75d3041d275e8e76b26605b0d426a572ddf1249 0.11.1.3

44d99cd091cdf71ce807a4255f6cc509c3154f51ea 0.11.3.1

4531f57612fd425d1bb56352ce6b79e41ce6699a45 1.0.0.0

467cba97c86467c1881dfced68613891f3c65561b0 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+261−140

@@ -3,6 +3,9 @@

3#if __GLASGOW_HASKELL__ >= 702

4{-# LANGUAGE Trustworthy #-}

5#endif

6+#if __GLASGOW_HASKELL__ >= 708

7+{-# LANGUAGE TypeFamilies #-}

8+#endif

7-- |

10-- |

8-- Module : Data.Text

11-- Module : Data.Text

@@ -29,8 +32,8 @@

29--

32--

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

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

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

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

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

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

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

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

35module Data.Text

38module Data.Text

36 (

39 (

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

122

125

123 -- ** Breaking strings

126 -- ** Breaking strings

124 , take

127 , take

128+ , takeEnd

125 , drop

129 , drop

130+ , dropEnd

126 , takeWhile

131 , takeWhile

132+ , takeWhileEnd

127 , dropWhile

133 , dropWhile

128 , dropWhileEnd

134 , dropWhileEnd

129 , dropAround

135 , dropAround

@@ -186,35 +192,43 @@ module Data.Text

186

192

187 -- * Low level operations

193 -- * Low level operations

188 , copy

194 , copy

195+ , unpackCString#

189 ) where

196 ) where

190

197

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

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

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

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

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

200+ Read(..),

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

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

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

202+ not, return, otherwise, quot)

196#if defined(HAVE_DEEPSEQ)

203#if defined(HAVE_DEEPSEQ)

197−import Control.DeepSeq (NFData)

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

198#endif

205#endif

199#if defined(ASSERTS)

206#if defined(ASSERTS)

200import Control.Exception (assert)

207import Control.Exception (assert)

201#endif

208#endif

202import Data.Char (isSpace)

209import Data.Char (isSpace)

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

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

204−import Data.Data (mkNoRepType)

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

205import Control.Monad (foldM)

212import Control.Monad (foldM)

213+import Control.Monad.ST (ST)

206import qualified Data.Text.Array as A

214import qualified Data.Text.Array as A

207import qualified Data.List as L

215import qualified Data.List as L

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

208import Data.Monoid (Monoid(..))

217import Data.Monoid (Monoid(..))

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

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

220+#endif

209import Data.String (IsString(..))

221import Data.String (IsString(..))

210import qualified Data.Text.Internal.Fusion as S

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

211import qualified Data.Text.Internal.Fusion.Common as S

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

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

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

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

213import Data.Text.Internal.Private (span_)

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

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

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

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

215import qualified Prelude as P

229import qualified Prelude as P

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

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

217− unsafeHead, unsafeTail)

231+ reverseIter_, unsafeHead, unsafeTail)

218import Data.Text.Internal.Unsafe.Char (unsafeChr)

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

219import qualified Data.Text.Internal.Functions as F

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

220import qualified Data.Text.Internal.Encoding.Utf16 as U16

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

@@ -224,44 +238,48 @@ import Data.ByteString (ByteString)

224import qualified Data.Text.Lazy as L

238import qualified Data.Text.Lazy as L

225import Data.Int (Int64)

239import Data.Int (Int64)

226#endif

240#endif

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

227−#if __GLASGOW_HASKELL__ >= 702

242+#if __GLASGOW_HASKELL__ >= 708

228−import qualified GHC.CString as GHC

243+import qualified GHC.Exts as Exts

229−#else

244+#endif

230−import qualified GHC.Base as GHC

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

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

231#endif

247#endif

232−import GHC.Prim (Addr#)

233

248

234-- $strict

249-- $strict

235--

250--

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

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

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

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

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

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

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

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

240--

255--

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

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

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

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

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

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

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

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

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

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

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

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

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

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

248−-- internal structures.

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

249--

264--

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

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

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

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

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

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

268+-- lengths.

253

269

254-- $replacement

270-- $replacement

255--

271--

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

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

273+-- in

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

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

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

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

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

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

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

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

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

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

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

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

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

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

282+-- those cases.

265--

283--

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

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

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

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

@@ -275,8 +293,8 @@ import GHC.Prim (Addr#)

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

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

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

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

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

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

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

296+-- measure. For details, see

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

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

280

298

281-- $fusion

299-- $fusion

282--

300--

@@ -294,11 +312,11 @@ import GHC.Prim (Addr#)

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

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

295--

313--

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

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

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

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

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

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

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

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

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

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

301−-- 'ByteString'.

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

302--

320--

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

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

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

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

@@ -312,41 +330,82 @@ instance Eq Text where

312instance Ord Text where

330instance Ord Text where

313 compare = compareText

331 compare = compareText

314

332

315−instance Show Text where

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

317−

318instance Read Text where

333instance Read Text where

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

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

320

335

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+

321instance Monoid Text where

344instance Monoid Text where

322 mempty = empty

345 mempty = empty

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

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

348+#else

323 mappend = append

349 mappend = append

350+#endif

324 mconcat = concat

351 mconcat = concat

325

352

326instance IsString Text where

353instance IsString Text where

327 fromString = pack

354 fromString = pack

328

355

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+

329#if defined(HAVE_DEEPSEQ)

363#if defined(HAVE_DEEPSEQ)

330−instance NFData Text

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

331#endif

365#endif

332

366

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+

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

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

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

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

335--

377--

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

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

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

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

338−-- submit improvements.

381+-- improvements.

339--

382--

340−-- Original discussion is archived here:

383+-- The original discussion is archived here:

341−

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

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

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

344

389

345instance Data Text where

390instance Data Text where

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

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

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

392+ toConstr _ = packConstr

393+ gunfold k z c = case constrIndex c of

394+ 1 -> k (z pack)

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

395+ _ -> P.error "gunfold"

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

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

402+#endif

403+

404+packConstr :: Constr

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

406+

407+textDataType :: DataType

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

350

409

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

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

352compareText :: Text -> Text -> Ordering

411compareText :: Text -> Text -> Ordering

@@ -371,30 +430,6 @@ pack :: String -> Text

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

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

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

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

373

432

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

375−unpack :: Text -> String

376−unpack = S.unstreamList . stream

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

378−

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

380−unpackCString# :: Addr# -> Text

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

382−{-# NOINLINE unpackCString# #-}

383−

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

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

386− = unpackCString# a #-}

387−

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

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

390− = unpackCString# a #-}

391−

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

393−-- Performs replacement on invalid scalar values.

394−singleton :: Char -> Text

395−singleton = unstream . S.singleton . safe

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

397−

398-- -----------------------------------------------------------------------------

433-- -----------------------------------------------------------------------------

399-- * Basic functions

434-- * Basic functions

400

435

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

425 | otherwise = overflowError "append"

460 | otherwise = overflowError "append"

426 where

461 where

427 len = len1+len2

462 len = len1+len2

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

428 x = do

464 x = do

429 arr <- A.new len

465 arr <- A.new len

430 A.copyI arr 0 arr1 off1 len1

466 A.copyI arr 0 arr1 off1 len1

431 A.copyI arr len1 arr2 off2 len

467 A.copyI arr len1 arr2 off2 len

432 return arr

468 return arr

433−{-# INLINE append #-}

469+{-# NOINLINE append #-}

434

470

435{-# RULES

471{-# RULES

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

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

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

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

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

451uncons t@(Text arr off len)

487uncons t@(Text arr off len)

452 | len <= 0 = Nothing

488 | len <= 0 = Nothing

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

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

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

454− where Iter c d = iter t 0

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

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

456

492

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

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

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

481tail :: Text -> Text

517tail :: Text -> Text

482tail t@(Text arr off len)

518tail t@(Text arr off len)

483 | len <= 0 = emptyError "tail"

519 | len <= 0 = emptyError "tail"

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

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

485 where d = iter_ t 0

521 where d = iter_ t 0

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

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

487

523

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

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

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

497init :: Text -> Text

533init :: Text -> Text

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

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

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

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

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

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

501 where

537 where

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

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

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

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

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

536-- Subject to fusion.

572-- Subject to fusion.

537length :: Text -> Int

573length :: Text -> Int

538length t = S.length (stream t)

574length t = S.length (stream t)

539−{-# 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.

540

578

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

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

542-- Subject to fusion.

580-- Subject to fusion.

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

555

593

556{-# RULES

594{-# RULES

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

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

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

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

559 #-}

597 #-}

560

598

561{-# RULES

599{-# RULES

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

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

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

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

564 #-}

602 #-}

565

603

566{-# RULES

604{-# RULES

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

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

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

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

569 #-}

607 #-}

570

608

571{-# RULES

609{-# RULES

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

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

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

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

574 #-}

612 #-}

575

613

576{-# RULES

614{-# RULES

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

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

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

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

579 #-}

617 #-}

580

618

581{-# RULES

619{-# RULES

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

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

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

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

584 #-}

622 #-}

585

623

586-- -----------------------------------------------------------------------------

624-- -----------------------------------------------------------------------------

@@ -611,22 +649,48 @@ reverse :: Text -> Text

611reverse t = S.reverse (stream t)

649reverse t = S.reverse (stream t)

612{-# INLINE reverse #-}

650{-# INLINE reverse #-}

613

651

614−-- | /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"

615--

672--

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

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

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

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

618−replace :: Text -> Text -> Text -> 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.

682+ -> Text

619replace needle@(Text _ _ neeLen)

683replace needle@(Text _ _ neeLen)

620 (Text repArr repOff repLen)

684 (Text repArr repOff repLen)

621 haystack@(Text hayArr hayOff hayLen)

685 haystack@(Text hayArr hayOff hayLen)

622 | neeLen == 0 = emptyError "replace"

686 | neeLen == 0 = emptyError "replace"

623 | L.null ixs = haystack

687 | L.null ixs = haystack

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

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

625− | len < 0 = overflowError "replace"

626 | otherwise = empty

689 | otherwise = empty

627 where

690 where

628 ixs = indices needle haystack

691 ixs = indices needle haystack

629− len = hayLen - (neeLen - repLen) * L.length ixs

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

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

630 x = do

694 x = do

631 marr <- A.new len

695 marr <- A.new len

632 let loop (i:is) o d = do

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

@@ -656,9 +720,8 @@ replace needle@(Text _ _ neeLen)

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

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

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

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

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

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

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

723+-- sensitivity should use appropriate versions of the

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

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

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

662

725

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

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

664--

727--

@@ -678,7 +741,7 @@ replace needle@(Text _ _ neeLen)

678-- instead of itself.

741-- instead of itself.

679toCaseFold :: Text -> Text

742toCaseFold :: Text -> Text

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

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

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

744+{-# INLINE toCaseFold #-}

682

745

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

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

684-- conversion. Subject to fusion.

747-- conversion. Subject to fusion.

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

838 where

901 where

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

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

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

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

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

841 go = do

905 go = do

842 arr <- A.new len

906 arr <- A.new len

843 let step i (Text a o l) =

907 let step i (Text a o l) =

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

851{-# INLINE concatMap #-}

915{-# INLINE concatMap #-}

852

916

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

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

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

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

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

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

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

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

857{-# INLINE any #-}

921{-# INLINE any #-}

858

922

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

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

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

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

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

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

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

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

863{-# INLINE all #-}

927{-# INLINE all #-}

@@ -948,10 +1012,10 @@ replicate n t@(Text a o l)

948 | n <= 0 || l <= 0 = empty

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

949 | n == 1 = t

1013 | n == 1 = t

950 | isSingleton t = replicateChar n (unsafeHead t)

1014 | isSingleton t = replicateChar n (unsafeHead t)

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

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

952− | otherwise = overflowError "replicate"

953 where

1016 where

954− len = l * n

1017+ len = l `mul` n

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

955 x = do

1019 x = do

956 arr <- A.new len

1020 arr <- A.new len

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

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

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

1002take n t@(Text arr off len)

1066take n t@(Text arr off len)

1003 | n <= 0 = empty

1067 | n <= 0 = empty

1004 | n >= len = t

1068 | n >= len = t

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

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

1006− where

1007− loop !i !cnt

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

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

1010− where d = iter_ t i

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

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

1012

1071

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+

1013{-# RULES

1079{-# RULES

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

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

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

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

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

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

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

1018 #-}

1084 #-}

1019

1085

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+

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

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

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

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

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

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

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

1024drop n t@(Text arr off len)

1111drop n t@(Text arr off len)

1025 | n <= 0 = t

1112 | n <= 0 = t

1026 | n >= len = empty

1113 | n >= len = empty

1027− | otherwise = loop 0 0

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

1028− where loop !i !cnt

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

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

1031− where d = iter_ t i

1115+ where i = iterN n t

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

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

1033

1117

1034{-# RULES

1118{-# RULES

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

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

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

1039 #-}

1123 #-}

1040

1124

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+

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

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

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

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

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

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

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

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

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

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

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

1047 | p c = loop (i+d)

1143 | p c = loop (i+d)

1048− | otherwise = textP arr off i

1144+ | otherwise = text arr off i

1049 where Iter c d = iter t i

1145 where Iter c d = iter t i

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

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

1051

1147

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

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

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

1057 #-}

1153 #-}

1058

1154

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+

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

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

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

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

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

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

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

1074 #-}

1191 #-}

1075

1192

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

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

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

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

1078-- @t@. Subject to fusion.

1195-- @t@. Subject to fusion.

1196+--

1079-- Examples:

1197-- Examples:

1080--

1198--

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

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

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

1095 #-}

1213 #-}

1096

1214

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

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

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

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

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

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

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

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

1101dropAround p = dropWhile p . dropWhileEnd p

1219dropAround p = dropWhile p . dropWhileEnd p

@@ -1130,13 +1248,8 @@ splitAt :: Int -> Text -> (Text, Text)

1130splitAt n t@(Text arr off len)

1248splitAt n t@(Text arr off len)

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

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

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

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

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

1251+ | otherwise = let k = iterN n t

1134− where k = loop 0 0

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

1135− loop !i !cnt

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

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

1138− where d = iter_ t i

1139−{-# INLINE splitAt #-}

1140

1253

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

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

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

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

@@ -1195,9 +1308,9 @@ tails t | null t = [empty]

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

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

1196-- are slices of the original.

1309-- are slices of the original.

1197

1310

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

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

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

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

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

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

1201--

1314--

1202-- Examples:

1315-- Examples:

1203--

1316--

@@ -1210,16 +1323,23 @@ tails t | null t = [empty]

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

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

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

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

1212--

1325--

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

1327+--

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

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

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

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

1215−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]

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

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

1217 | l <= 0 = emptyError "splitOn"

1337 | l <= 0 = emptyError "splitOn"

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

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

1219 | otherwise = go 0 (indices pat src)

1339 | otherwise = go 0 (indices pat src)

1220 where

1340 where

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

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

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

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

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

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

1224

1344

1225{-# RULES

1345{-# RULES

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

1311 | null pat = emptyError "breakOn"

1431 | null pat = emptyError "breakOn"

1312 | otherwise = case indices pat src of

1432 | otherwise = case indices pat src of

1313 [] -> (src, empty)

1433 [] -> (src, empty)

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

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

1315{-# INLINE breakOn #-}

1435{-# INLINE breakOn #-}

1316

1436

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

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

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

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

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

1354 where

1474 where

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

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

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

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

1357{-# INLINE breakOnAll #-}

1477{-# INLINE breakOnAll #-}

1358

1478

1359-------------------------------------------------------------------------------

1479-------------------------------------------------------------------------------

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

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

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

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

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

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

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

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

1543+{-# INLINE zip #-}

1424

1544

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

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

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

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

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

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

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

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

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

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

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

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

1551+{-# INLINE zipWith #-}

1432

1552

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

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

1434-- representing white space.

1554-- representing white space.

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

1553-- > fnordLength _ = -1

1673-- > fnordLength _ = -1

1554stripPrefix :: Text -> Text -> Maybe Text

1674stripPrefix :: Text -> Text -> Maybe Text

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

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

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

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

1557 | otherwise = Nothing

1677 | otherwise = Nothing

1558

1678

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

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

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

1573 where

1693 where

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

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

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

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

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

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

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

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

1578 | otherwise = Nothing

1698 | otherwise = Nothing

1579 where Iter a d0 = iter t0 i

1699 where Iter a d0 = iter t0 i

1580 Iter b d1 = iter t1 j

1700 Iter b d1 = iter t1 j

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

1599-- > quuxLength _ = -1

1719-- > quuxLength _ = -1

1600stripSuffix :: Text -> Text -> Maybe Text

1720stripSuffix :: Text -> Text -> Maybe Text

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

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

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

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

1603 | otherwise = Nothing

1723 | otherwise = Nothing

1604

1724

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

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

@@ -1628,6 +1748,7 @@ overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"

1628copy :: Text -> Text

1748copy :: Text -> Text

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

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

1630 where

1750 where

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

1631 go = do

1752 go = do

1632 marr <- A.new len

1753 marr <- A.new len

1633 A.copyI marr 0 arr off len

1754 A.copyI marr 0 arr off len

Data/Text/Array.hs+7−6

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

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

21--

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

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

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

24-- naming.

25module Data.Text.Array

26 (

27 -- * Types

28− Array(aBA)

28+ Array(Array, aBA)

29− , MArray(maBA)

29+ , MArray(MArray, maBA)

31 -- * Functions

32 , copyM

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

74#endif

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

76 indexWord16Array#, newByteArray#,

77− unsafeCoerce#, writeWord16Array#)

77+ unsafeFreezeByteArray#, writeWord16Array#)

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

79import GHC.Word (Word16(..))

80import Prelude hiding (length, read)

@@ -130,8 +130,9 @@ array_size_error = error "Data.Text.Array.new: size overflow"

130

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

132unsafeFreeze :: MArray s -> ST s Array

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

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

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

134+ case unsafeFreezeByteArray# maBA s1# of

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

135#if defined(ASSERTS)

136#if defined(ASSERTS)

136 maLen

137 maLen

137#endif

138#endif

Data/Text/Encoding.hs+39−42

@@ -55,13 +55,9 @@ module Data.Text.Encoding

55 , encodeUtf32LE

56 , encodeUtf32BE

58−#if MIN_VERSION_bytestring(0,10,4)

59 -- * Encoding Text using ByteString Builders

58 -- * Encoding Text using ByteString Builders

60− -- | /Note/ that these functions are only available if built against

61− -- @bytestring >= 0.10.4.0@.

62 , encodeUtf8Builder

59 , encodeUtf8Builder

63 , encodeUtf8BuilderEscaped

60 , encodeUtf8BuilderEscaped

64−#endif

65 ) where

61 ) where

67#if __GLASGOW_HASKELL__ >= 702

63#if __GLASGOW_HASKELL__ >= 702

@@ -70,27 +66,17 @@ import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)

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

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

71#endif

67#endif

73−#if MIN_VERSION_bytestring(0,10,4)

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

75−import Data.Text.Internal.Unsafe.Char (ord)

76−import qualified Data.ByteString.Builder as B

77−import qualified Data.ByteString.Builder.Extra as B

78−import qualified Data.ByteString.Builder.Internal as B hiding (empty)

79−import qualified Data.ByteString.Builder.Prim as BP

80−import qualified Data.ByteString.Builder.Prim.Internal as BP

81−import qualified Data.Text.Internal.Encoding.Utf16 as U16

82−#endif

83−

84import Control.Exception (evaluate, try)

69import Control.Exception (evaluate, try)

85import Control.Monad.ST (runST)

70import Control.Monad.ST (runST)

71+import Data.Bits ((.&.))

86import Data.ByteString as B

72import Data.ByteString as B

87import Data.ByteString.Internal as B hiding (c2w)

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

88−import Data.Text ()

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

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

90−import Data.Text.Internal (Text(..), safe, textP)

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

91import Data.Text.Internal.Private (runText)

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

92−import Data.Text.Internal.Unsafe.Char (unsafeWrite)

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

93import Data.Text.Internal.Unsafe.Shift (shiftR)

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

79+import Data.Text.Show ()

94import Data.Text.Unsafe (unsafeDupablePerformIO)

80import Data.Text.Unsafe (unsafeDupablePerformIO)

95import Data.Word (Word8, Word32)

81import Data.Word (Word8, Word32)

96import Foreign.C.Types (CSize(..))

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

@@ -99,8 +85,13 @@ import Foreign.Marshal.Utils (with)

99import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)

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

100import Foreign.Storable (Storable, peek, poke)

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

101import GHC.Base (ByteArray#, MutableByteArray#)

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

102import qualified Data.Text.Array as A

92import qualified Data.Text.Array as A

103import qualified Data.Text.Internal.Encoding.Fusion as E

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

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

104import qualified Data.Text.Internal.Fusion as F

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

105

106#include "text_cbits.h"

97#include "text_cbits.h"

@@ -120,8 +111,6 @@ import qualified Data.Text.Internal.Fusion as F

120

111

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

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

122-- encoded text.

113-- encoded text.

123−--

124−-- This function is deprecated. Use 'decodeLatin1' instead.

125decodeASCII :: ByteString -> Text

114decodeASCII :: ByteString -> Text

126decodeASCII = decodeUtf8

115decodeASCII = decodeUtf8

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

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

@@ -131,7 +120,7 @@ decodeASCII = decodeUtf8

131-- 'decodeLatin1' is semantically equivalent to

120-- 'decodeLatin1' is semantically equivalent to

132-- @Data.Text.pack . Data.ByteString.Char8.unpack@

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

133decodeLatin1 :: ByteString -> Text

122decodeLatin1 :: ByteString -> Text

134−decodeLatin1 (PS fp off len) = textP a 0 len

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

135 where

124 where

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

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

137 go dest = withForeignPtr fp $ \ptr -> do

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

@@ -172,11 +161,15 @@ decodeUtf8With onErr (PS fp off len) = runText $ \done -> do

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

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

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

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

174--

163--

175−-- The first element of the result is the maximal chunk of 'Text' that

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

176−-- can be decoded from the given input. The second is a function which

165+-- given input.

166+--

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

168+-- insufficient input.

169+--

177−-- accepts another 'ByteString'. That string will be assumed to

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

178−-- directly follow the string that was passed as input to the original

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

179−-- function, and it will in turn be decoded.

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

180--

173--

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

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

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

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

@@ -189,15 +182,17 @@ decodeUtf8With onErr (PS fp off len) = runText $ \done -> do

189-- as we receive each one.

182-- as we receive each one.

190--

183--

191-- @

184-- @

192−-- let 'Some' t0 f0 = 'streamDecodeUtf8' \"hi \\xe2\"

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

193−-- t0 == \"hi \" :: 'Text'

186+-- ghci> s0

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

194-- @

188-- @

195--

189--

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

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

197--

191--

198-- @

192-- @

199−-- let 'Some' t1 f1 = f0 \"\\x98\"

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

200−-- t1 == \"\"

194+-- ghci> s1

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

201-- @

196-- @

202--

197--

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

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

@@ -205,8 +200,9 @@ decodeUtf8With onErr (PS fp off len) = runText $ \done -> do

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

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

206--

201--

207-- @

202-- @

208−-- let 'Some' t2 f2 = f1 \"\\x83\"

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

209−-- t2 == \"☃\"

204+-- ghci> s2

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

210-- @

206-- @

211--

207--

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

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

@@ -238,12 +234,13 @@ streamDecodeUtf8 = streamDecodeUtf8With strictDecode

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

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

239-- encoded text.

235-- encoded text.

240streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding

236streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding

241−streamDecodeUtf8With onErr = decodeChunk 0 0

237+streamDecodeUtf8With onErr = decodeChunk B.empty 0 0

242 where

238 where

243 -- We create a slightly larger than necessary buffer to accommodate a

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

244 -- potential surrogate pair started in the last buffer

240 -- potential surrogate pair started in the last buffer

245− decodeChunk :: CodePoint -> DecoderState -> ByteString -> Decoding

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

242+ -> Decoding

246− decodeChunk codepoint0 state0 bs@(PS fp off len) =

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

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

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

248 where

245 where

249 decodeChunkToBuffer :: A.MArray s -> IO Decoding

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

@@ -262,6 +259,7 @@ streamDecodeUtf8With onErr = decodeChunk 0 0

262 UTF8_REJECT -> do

259 UTF8_REJECT -> do

263 -- We encountered an encoding error

260 -- We encountered an encoding error

264 x <- peek curPtr'

261 x <- peek curPtr'

262+ poke statePtr 0

265 case onErr desc (Just x) of

263 case onErr desc (Just x) of

266 Nothing -> loop $ curPtr' `plusPtr` 1

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

267 Just c -> do

265 Just c -> do

@@ -269,7 +267,6 @@ streamDecodeUtf8With onErr = decodeChunk 0 0

269 w <- unsafeSTToIO $

267 w <- unsafeSTToIO $

270 unsafeWrite dest (fromIntegral destOff) (safe c)

268 unsafeWrite dest (fromIntegral destOff) (safe c)

271 poke destOffPtr (destOff + fromIntegral w)

269 poke destOffPtr (destOff + fromIntegral w)

272− poke statePtr 0

273 loop $ curPtr' `plusPtr` 1

270 loop $ curPtr' `plusPtr` 1

274

271

275 _ -> do

272 _ -> do

@@ -278,11 +275,14 @@ streamDecodeUtf8With onErr = decodeChunk 0 0

278 codepoint <- peek codepointPtr

275 codepoint <- peek codepointPtr

279 chunkText <- unsafeSTToIO $ do

276 chunkText <- unsafeSTToIO $ do

280 arr <- A.unsafeFreeze dest

277 arr <- A.unsafeFreeze dest

281− return $! textP arr 0 (fromIntegral n)

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

282 lastPtr <- peek curPtrPtr

279 lastPtr <- peek curPtrPtr

283 let left = lastPtr `minusPtr` curPtr

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 (B.drop left bs)

284+ return $ Some chunkText undecoded

285− (decodeChunk codepoint state)

285+ (decodeChunk undecoded codepoint state)

286 in loop (ptr `plusPtr` off)

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

288

@@ -307,8 +307,6 @@ decodeUtf8' :: ByteString -> Either UnicodeException Text

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

308{-# INLINE decodeUtf8' #-}

309

310−#if MIN_VERSION_bytestring(0,10,4)

311−

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

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

313encodeUtf8Builder :: Text -> B.Builder

311encodeUtf8Builder :: Text -> B.Builder

314encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)

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

@@ -369,7 +367,6 @@ encodeUtf8BuilderEscaped be =

369 outerLoop i (B.BufferRange op ope)

367 outerLoop i (B.BufferRange op ope)

370 where

368 where

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

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

372−#endif

373

370

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

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

375encodeUtf8 :: Text -> ByteString

372encodeUtf8 :: Text -> ByteString

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

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

1{-# LANGUAGE CPP, DeriveDataTypeable #-}

2−#if __GLASGOW_HASKELL__ >= 702

2+#if __GLASGOW_HASKELL__ >= 704

3+{-# LANGUAGE Safe #-}

4+#elif __GLASGOW_HASKELL__ >= 702

3{-# LANGUAGE Trustworthy #-}

5{-# LANGUAGE Trustworthy #-}

4#endif

6#endif

5-- |

7-- |

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

66type OnDecodeError = OnError Word8 Char

68type OnDecodeError = OnError Word8 Char

68-- | A handler for an encoding error.

70-- | A handler for an encoding error.

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

69type OnEncodeError = OnError Char Word8

72type OnEncodeError = OnError Char Word8

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

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

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

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

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

79 deriving (Eq, Typeable)

82 deriving (Eq, Typeable)

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

85+

81showUnicodeException :: UnicodeException -> String

86showUnicodeException :: UnicodeException -> String

82showUnicodeException (DecodeError desc (Just w))

87showUnicodeException (DecodeError desc (Just w))

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

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

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

107lenientDecode _ _ = Just '\xfffd'

112lenientDecode _ _ = Just '\xfffd'

108

113

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

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

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

110strictEncode :: OnEncodeError

116strictEncode :: OnEncodeError

111strictEncode desc c = throw (EncodeError desc c)

117strictEncode desc c = throw (EncodeError desc c)

112

118

Data/Text/Internal.hs+75−10

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

1−{-# LANGUAGE CPP, DeriveDataTypeable #-}

1+{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples #-}

2+{-# OPTIONS_HADDOCK not-home #-}

3-- |

4-- |

4-- Module : Data.Text.Internal

5-- Module : Data.Text.Internal

@@ -19,6 +20,10 @@

19-- with the internals, as the functions here do just about nothing to

20-- with the internals, as the functions here do just about nothing to

20-- preserve data invariants. You have been warned!

21-- preserve data invariants. You have been warned!

23+#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)

24+#include "MachDeps.h"

25+#endif

26+

22module Data.Text.Internal

27module Data.Text.Internal

23 (

28 (

24 -- * Types

29 -- * Types

@@ -31,8 +36,13 @@ module Data.Text.Internal

31 , safe

36 , safe

32 -- * Code that must be here for accessibility

37 -- * Code that must be here for accessibility

33 , empty

38 , empty

39+ , empty_

34 -- * Utilities

40 -- * Utilities

35 , firstf

41 , firstf

42+ -- * Checked multiplication

43+ , mul

44+ , mul32

45+ , mul64

36 -- * Debugging

46 -- * Debugging

37 , showText

47 , showText

38 ) where

48 ) where

@@ -40,10 +50,11 @@ module Data.Text.Internal

40#if defined(ASSERTS)

50#if defined(ASSERTS)

41import Control.Exception (assert)

51import Control.Exception (assert)

42#endif

52#endif

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

53+import Data.Bits

44−import qualified Data.Text.Array as A

54+import Data.Int (Int32, Int64)

45import Data.Text.Internal.Unsafe.Char (ord)

55import Data.Text.Internal.Unsafe.Char (ord)

46import Data.Typeable (Typeable)

56import Data.Typeable (Typeable)

57+import qualified Data.Text.Array as A

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

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

49data Text = Text

60data Text = Text

@@ -53,8 +64,8 @@ data Text = Text

53 deriving (Typeable)

64 deriving (Typeable)

55-- | Smart constructor.

66-- | Smart constructor.

56−text :: A.Array -> Int -> Int -> Text

67+text_ :: A.Array -> Int -> Int -> Text

57−text arr off len =

68+text_ arr off len =

58#if defined(ASSERTS)

69#if defined(ASSERTS)

59 let c = A.unsafeIndex arr off

70 let c = A.unsafeIndex arr off

60 alen = A.length arr

71 alen = A.length arr

@@ -64,19 +75,28 @@ text arr off len =

64 assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $

75 assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $

65#endif

76#endif

66 Text arr off len

77 Text arr off len

67−{-# INLINE text #-}

78+{-# INLINE text_ #-}

69-- | /O(1)/ The empty 'Text'.

80-- | /O(1)/ The empty 'Text'.

70empty :: Text

81empty :: Text

71empty = Text A.empty 0 0

82empty = Text A.empty 0 0

72{-# INLINE [1] empty #-}

83{-# INLINE [1] empty #-}

85+-- | A non-inlined version of 'empty'.

86+empty_ :: Text

87+empty_ = Text A.empty 0 0

88+{-# NOINLINE empty_ #-}

89+

74-- | Construct a 'Text' without invisibly pinning its byte array in

90-- | Construct a 'Text' without invisibly pinning its byte array in

75-- memory if its length has dwindled to zero.

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

76textP :: A.Array -> Int -> Int -> Text

97textP :: A.Array -> Int -> Int -> Text

77−textP arr off len | len == 0 = empty

98+{-# DEPRECATED textP "Use text instead" #-}

78− | otherwise = text arr off len

99+textP = text

79−{-# INLINE textP #-}

100

81-- | A useful 'show'-like function for debugging purposes.

101-- | A useful 'show'-like function for debugging purposes.

82showText :: Text -> String

102showText :: Text -> String

@@ -96,13 +116,58 @@ safe :: Char -> Char

96safe c

116safe c

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

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

98 | otherwise = '\xfffd'

118 | otherwise = '\xfffd'

99−{-# INLINE safe #-}

119+{-# INLINE [0] safe #-}

100

120

101-- | Apply a function to the first element of an optional pair.

121-- | Apply a function to the first element of an optional pair.

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

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

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

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

104firstf _ Nothing = Nothing

124firstf _ Nothing = Nothing

105

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+

106-- $internals

171-- $internals

107--

172--

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

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

Data/Text/Internal/Builder.hs+20−16

@@ -1,11 +1,12 @@

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

2+{-# OPTIONS_HADDOCK not-home #-}

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

4-----------------------------------------------------------------------------

4-- |

5-- |

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

6-- Module : Data.Text.Internal.Builder

8−-- License : BSD3-style (see LICENSE)

9+-- License : BSD-style (see LICENSE)

9--

10--

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

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

11-- Stability : experimental

12-- Stability : experimental

@@ -57,13 +58,14 @@ module Data.Text.Internal.Builder

57 ) where

58 ) where

59import Control.Monad.ST (ST, runST)

60import Control.Monad.ST (ST, runST)

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

61import Data.Monoid (Monoid(..))

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

63+import Data.Semigroup (Semigroup(..))

64+#endif

62import Data.Text.Internal (Text(..))

65import Data.Text.Internal (Text(..))

63import Data.Text.Internal.Lazy (smallChunkSize)

66import Data.Text.Internal.Lazy (smallChunkSize)

64import Data.Text.Unsafe (inlineInterleaveST)

67import Data.Text.Unsafe (inlineInterleaveST)

65−import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)

68+import Data.Text.Internal.Unsafe.Char (unsafeWrite)

66−import Data.Text.Internal.Unsafe.Shift (shiftR)

67import Prelude hiding (map, putChar)

69import Prelude hiding (map, putChar)

69import qualified Data.String as String

71import qualified Data.String as String

@@ -90,12 +92,22 @@ newtype Builder = Builder {

90 -> ST s [S.Text]

92 -> ST s [S.Text]

91 }

93 }

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

96+instance Semigroup Builder where

97+ (<>) = append

98+ {-# INLINE (<>) #-}

99+#endif

100+

93instance Monoid Builder where

101instance Monoid Builder where

94 mempty = empty

102 mempty = empty

95 {-# INLINE mempty #-}

103 {-# INLINE mempty #-}

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

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

106+#else

96 mappend = append

107 mappend = append

108+#endif

97 {-# INLINE mappend #-}

109 {-# INLINE mappend #-}

98− mconcat = foldr mappend mempty

110+ mconcat = foldr mappend Data.Monoid.mempty

99 {-# INLINE mconcat #-}

111 {-# INLINE mconcat #-}

100

112

101instance String.IsString Builder where

113instance String.IsString Builder where

@@ -126,17 +138,7 @@ empty = Builder (\ k buf -> k buf)

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

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

127--

139--

128singleton :: Char -> Builder

140singleton :: Char -> Builder

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

141+singleton c = writeAtMost 2 $ \ marr o -> unsafeWrite marr o c

130− if n < 0x10000

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

132− else do

133− A.unsafeWrite marr o lo

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

135− return 2

136− where n = ord c

137− m = n - 0x10000

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

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

140{-# INLINE singleton #-}

142{-# INLINE singleton #-}

141

143

142------------------------------------------------------------------------

144------------------------------------------------------------------------

@@ -240,6 +242,8 @@ flush = Builder $ \ k buf@(Buffer p o u l) ->

240 !t = Text arr o u

242 !t = Text arr o u

241 ts <- inlineInterleaveST (k b)

243 ts <- inlineInterleaveST (k b)

242 return $! t : ts

244 return $! t : ts

245+{-# INLINE [1] flush #-}

246+-- defer inlining so that flush/flush rule may fire.

243

247

244------------------------------------------------------------------------

248------------------------------------------------------------------------

245

249

Data/Text/Internal/Builder/Functions.hs+2−1

@@ -23,7 +23,8 @@ module Data.Text.Internal.Builder.Functions

24import Data.Monoid (mappend)

25import Data.Text.Lazy.Builder (Builder)

26−import GHC.Base

26+import GHC.Base (chr#,ord#,(+#),Int(I#),Char(C#))

27+import Prelude ()

28-- | Unsafe conversion for decimal digits.

29-- | Unsafe conversion for decimal digits.

29{-# INLINE i2d #-}

30{-# INLINE i2d #-}

Data/Text/Internal/Builder/Int/Digits.hs+1−1

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

3-- Module: Data.Text.Internal.Builder.Int.Digits

5−-- License: BSD3

5+-- License: BSD-style

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

7-- Stability: experimental

8-- Portability: portable

Data/Text/Internal/Builder/RealFloat/Functions.hs+28

@@ -1,3 +1,5 @@

1+{-# LANGUAGE CPP #-}

1-- |

3-- |

2-- Module: Data.Text.Internal.Builder.RealFloat.Functions

4-- Module: Data.Text.Internal.Builder.RealFloat.Functions

3-- Copyright: (c) The University of Glasgow 1994-2002

5-- Copyright: (c) The University of Glasgow 1994-2002

@@ -13,6 +15,30 @@ module Data.Text.Internal.Builder.RealFloat.Functions

13 ) where

15 ) where

15roundTo :: Int -> [Int] -> (Int,[Int])

17roundTo :: 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+

16roundTo d is =

42roundTo d is =

17 case f d is of

43 case f d is of

18 x@(0,_) -> x

44 x@(0,_) -> x

@@ -27,3 +53,5 @@ roundTo d is =

27 where

53 where

28 (c,ds) = f (n-1) xs

54 (c,ds) = f (n-1) xs

29 i' = c + i

55 i' = c + i

56+

57+#endif

Data/Text/Internal/Fusion.hs+38−28

@@ -68,7 +68,7 @@ default(Int)

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

70stream :: Text -> Stream Char

71−stream (Text arr off len) = Stream next off (maxSize len)

71+stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)

72 where

73 !end = off+len

74 next !i

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

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

84-- backwards.

85reverseStream :: Text -> Stream Char

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

87 where

88 {-# INLINE next #-}

89 next !i

@@ -98,25 +98,35 @@ reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)

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

99unstream :: Stream Char -> Text

100unstream (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.

101− let mlen = upperBound 4 len

105+ let mlen = upperBound 4 len + 1

102 arr0 <- A.new mlen

106 arr0 <- A.new mlen

103− let outer arr top = loop

107+ let outer !arr !maxi = encode

104 where

108 where

105− loop !s !i =

109+ -- keep the common case loop as small as possible

110+ encode !si !di =

106− case next0 s of

111+ case next0 si of

107− Done -> done arr i

112+ Done -> done arr di

108− Skip s' -> loop s' i

113+ Skip si' -> encode si' di

109− Yield x s'

114+ Yield c si'

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

115+ -- simply check for the worst case

111− let top' = (top + 1) `shiftL` 1

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

112− arr' <- A.new top'

125+ arr' <- A.new newlen

113− A.copyM arr' 0 arr 0 top

126+ A.copyM arr' 0 arr 0 di

114− outer arr' top' s i

127+ outer arr' (newlen - 1) si di

115− | otherwise -> do d <- unsafeWrite arr i x

128+

116− loop s' (i+d)

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

118− | otherwise = i + 1

119− outer arr0 mlen s0 0

129+ outer arr0 (mlen - 1) s0 0

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

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

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

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

122

132

@@ -132,7 +142,7 @@ length = S.lengthI

132reverse :: Stream Char -> Text

142reverse :: Stream Char -> Text

133reverse (Stream next s len0)

143reverse (Stream next s len0)

134 | isEmpty len0 = I.empty

144 | isEmpty len0 = I.empty

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

145+ | otherwise = I.text arr off' len'

136 where

146 where

137 len0' = upperBound 4 (larger len0 4)

147 len0' = upperBound 4 (larger len0 4)

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

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

@@ -166,15 +176,15 @@ reverse (Stream next s len0)

166-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with

176-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with

167-- the input and result reversed.

177-- the input and result reversed.

168reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

178reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

169−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

170 where

180 where

171 {-# INLINE next #-}

181 {-# INLINE next #-}

172− next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)

182+ next (Scan1 z s) = Yield z (Scan2 z s)

173− next (S2 :*: z :*: s) = case next0 s of

183+ next (Scan2 z s) = case next0 s of

174− Yield x s' -> let !x' = f x z

184+ Yield x s' -> let !x' = f x z

175− in Yield x' (S2 :*: x' :*: s')

185+ in Yield x' (Scan2 x' s')

176− Skip s' -> Skip (S2 :*: z :*: s')

186+ Skip s' -> Skip (Scan2 z s')

177− Done -> Done

187+ Done -> Done

178{-# INLINE reverseScanr #-}

188{-# INLINE reverseScanr #-}

179

189

180-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed

190-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed

@@ -210,7 +220,7 @@ countChar = S.countCharI

210-- function to each element of a 'Text', passing an accumulating

220-- function to each element of a 'Text', passing an accumulating

211-- parameter from left to right, and returns a final 'Text'.

221-- parameter from left to right, and returns a final 'Text'.

212mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)

222mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)

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

214 where

224 where

215 (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)

225 (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)

216 where mlen = upperBound 4 len

226 where mlen = upperBound 4 len

Data/Text/Internal/Fusion/CaseMapping.hs+291−19

@@ -1,17 +1,17 @@

1{-# LANGUAGE Rank2Types #-}

2-- AUTOMATICALLY GENERATED - DO NOT EDIT

3−-- Generated by scripts/SpecialCasing.hs

3+-- Generated by scripts/CaseMapping.hs

4−-- CaseFolding-6.3.0.txt

4+-- CaseFolding-8.0.0.txt

5−-- Date: 2012-12-20, 22:14:35 GMT [MD]

5+-- Date: 2015-01-13, 18:16:36 GMT [MD]

6−-- SpecialCasing-6.3.0.txt

6+-- SpecialCasing-8.0.0.txt

7−-- Date: 2013-05-08, 13:54:51 GMT [MD]

7+-- Date: 2014-12-16, 23:08:04 GMT [MD]

9module Data.Text.Internal.Fusion.CaseMapping where

10import Data.Char

11import Data.Text.Internal.Fusion.Types

13upperMapping :: forall s. Char -> s -> Step (CC s) Char

14−{-# INLINE upperMapping #-}

14+{-# NOINLINE upperMapping #-}

15-- LATIN SMALL LETTER SHARP S

16upperMapping '\x00df' s = Yield '\x0053' (CC s '\x0053' '\x0000')

17-- LATIN SMALL LIGATURE FF

@@ -218,12 +218,12 @@ upperMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0399')

218upperMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0399')

219upperMapping c s = Yield (toUpper c) (CC s '\0' '\0')

220lowerMapping :: forall s. Char -> s -> Step (CC s) Char

221−{-# INLINE lowerMapping #-}

221+{-# NOINLINE lowerMapping #-}

222-- LATIN CAPITAL LETTER I WITH DOT ABOVE

223lowerMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')

224lowerMapping c s = Yield (toLower c) (CC s '\0' '\0')

225titleMapping :: forall s. Char -> s -> Step (CC s) Char

226−{-# INLINE titleMapping #-}

226+{-# NOINLINE titleMapping #-}

227-- LATIN SMALL LETTER SHARP S

228titleMapping '\x00df' s = Yield '\x0053' (CC s '\x0073' '\x0000')

229-- LATIN SMALL LIGATURE FF

@@ -322,7 +322,7 @@ titleMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0345')

322titleMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0345')

323titleMapping c s = Yield (toTitle c) (CC s '\0' '\0')

324foldMapping :: forall s. Char -> s -> Step (CC s) Char

325−{-# INLINE foldMapping #-}

325+{-# NOINLINE foldMapping #-}

326-- MICRO SIGN

327foldMapping '\x00b5' s = Yield '\x03bc' (CC s '\x0000' '\x0000')

328-- LATIN SMALL LETTER SHARP S

@@ -359,10 +359,18 @@ foldMapping '\x03f1' s = Yield '\x03c1' (CC s '\x0000' '\x0000')

359foldMapping '\x03f5' s = Yield '\x03b5' (CC s '\x0000' '\x0000')

360-- ARMENIAN SMALL LIGATURE ECH YIWN

361foldMapping '\x0587' s = Yield '\x0565' (CC s '\x0582' '\x0000')

362−-- GEORGIAN CAPITAL LETTER YN

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

363−foldMapping '\x10c7' s = Yield '\x2d27' (CC s '\x0000' '\x0000')

371+foldMapping '\x13fc' s = Yield '\x13f4' (CC s '\x0000' '\x0000')

364−-- GEORGIAN CAPITAL LETTER AEN

372+-- CHEROKEE SMALL LETTER MV

365−foldMapping '\x10cd' s = Yield '\x2d2d' (CC s '\x0000' '\x0000')

373+foldMapping '\x13fd' s = Yield '\x13f5' (CC s '\x0000' '\x0000')

366-- LATIN SMALL LETTER H WITH LINE BELOW

374-- LATIN SMALL LETTER H WITH LINE BELOW

367foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')

375foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')

368-- LATIN SMALL LETTER T WITH DIAERESIS

376-- LATIN SMALL LETTER T WITH DIAERESIS

@@ -537,12 +545,174 @@ foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')

537foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')

545foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')

538-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI

546-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI

539foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')

547foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')

540−-- COPTIC CAPITAL LETTER BOHAIRIC KHEI

548+-- LATIN CAPITAL LETTER J WITH CROSSED-TAIL

541−foldMapping '\x2cf2' s = Yield '\x2cf3' (CC s '\x0000' '\x0000')

549+foldMapping '\xa7b2' s = Yield '\x029d' (CC s '\x0000' '\x0000')

542−-- LATIN CAPITAL LETTER C WITH BAR

550+-- LATIN CAPITAL LETTER CHI

551+foldMapping '\xa7b3' s = Yield '\xab53' (CC s '\x0000' '\x0000')

552+-- LATIN CAPITAL LETTER BETA

543−foldMapping '\xa792' s = Yield '\xa793' (CC s '\x0000' '\x0000')

553+foldMapping '\xa7b4' s = Yield '\xa7b5' (CC s '\x0000' '\x0000')

544−-- LATIN CAPITAL LETTER H WITH HOOK

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

545−foldMapping '\xa7aa' s = Yield '\x0266' (CC s '\x0000' '\x0000')

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

546-- LATIN SMALL LIGATURE FF

716-- LATIN SMALL LIGATURE FF

547foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')

717foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')

548-- LATIN SMALL LIGATURE FI

718-- LATIN SMALL LIGATURE FI

@@ -567,4 +737,106 @@ foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')

567foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')

737foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')

568-- ARMENIAN SMALL LIGATURE MEN XEH

738-- ARMENIAN SMALL LIGATURE MEN XEH

569foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')

739foldMapping '\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')

570foldMapping c s = Yield (toLower c) (CC s '\0' '\0')

842foldMapping c s = Yield (toLower c) (CC s '\0' '\0')

Data/Text/Internal/Fusion/Common.hs+64−76

@@ -71,9 +71,6 @@ module Data.Text.Internal.Fusion.Common

71 -- ** Scans

72 , scanl

74− -- ** Accumulating maps

75− -- , mapAccumL

76−

77 -- ** Generation and unfolding

74 -- ** Generation and unfolding

78 , replicateCharI

75 , replicateCharI

79 , replicateI

76 , replicateI

@@ -106,7 +103,7 @@ module Data.Text.Internal.Fusion.Common

106

103

107import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),

104import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),

108 Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),

105 Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),

109− (&&), fromIntegral, not, otherwise)

106+ (&&), fromIntegral, otherwise)

110import qualified Data.List as L

107import qualified Data.List as L

111import qualified Prelude as P

108import qualified Prelude as P

112import Data.Bits (shiftL)

109import Data.Bits (shiftL)

@@ -123,7 +120,7 @@ singleton :: Char -> Stream Char

123singleton c = Stream next False 1

120singleton c = Stream next False 1

124 where next False = Yield c True

121 where next False = Yield c True

125 next True = Done

122 next True = Done

126−{-# INLINE singleton #-}

123+{-# INLINE [0] singleton #-}

127

124

128streamList :: [a] -> Stream a

125streamList :: [a] -> Stream a

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

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

@@ -187,6 +184,9 @@ cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)

187 Yield x s' -> Yield x (C0 s')

184 Yield x s' -> Yield x (C0 s')

188{-# INLINE [0] cons #-}

185{-# INLINE [0] cons #-}

189

186

187+data Snoc a = N

188+ | J !a

189+

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

191snoc :: Stream Char -> Char -> Stream Char

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

@@ -315,12 +315,13 @@ lengthI (Stream next s0 _len) = loop_length 0 s0

315--

316-- This function gives the same answer as comparing against the result

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

318+-- greater than the number or if the stream can't possibly be as long

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

319+-- as the number supplied, and hence be more efficient.

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

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

320compareLengthI (Stream next s0 len) n =

321compareLengthI (Stream next s0 len) n =

321− case exactly len of

322+ case compareSize len (fromIntegral n) of

323+ Just o -> o

322 Nothing -> loop_cmp 0 s0

324 Nothing -> loop_cmp 0 s0

323− Just i -> compare (fromIntegral i) n

324 where

325 where

325 loop_cmp !z s = case next s of

326 loop_cmp !z s = case next s of

326 Done -> compare z n

327 Done -> compare z n

@@ -472,17 +473,20 @@ toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len

472 next (CC s a b) = Yield a (CC s b '\0')

473 next (CC s a b) = Yield a (CC s b '\0')

473{-# INLINE [0] toTitle #-}

474{-# INLINE [0] toTitle #-}

474

475

476+data Justify i s = Just1 !i !s

477+ | Just2 !i !s

478+

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

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

476justifyLeftI k c (Stream next0 s0 len) =

480justifyLeftI k c (Stream next0 s0 len) =

477− Stream next (s0 :*: S1 :*: 0) (larger (fromIntegral k) len)

481+ Stream next (Just1 0 s0) (larger (fromIntegral k) len)

478 where

482 where

479− next (s :*: S1 :*: n) =

483+ next (Just1 n s) =

480 case next0 s of

484 case next0 s of

481− Done -> next (s :*: S2 :*: n)

485+ Done -> next (Just2 n s)

482− Skip s' -> Skip (s' :*: S1 :*: n)

486+ Skip s' -> Skip (Just1 n s')

483− Yield x s' -> Yield x (s' :*: S1 :*: n+1)

487+ Yield x s' -> Yield x (Just1 (n+1) s')

484− next (s :*: S2 :*: n)

488+ next (Just2 n s)

485− | n < k = Yield c (s :*: S2 :*: n+1)

489+ | n < k = Yield c (Just2 (n+1) s)

486 | otherwise = Done

490 | otherwise = Done

487 {-# INLINE next #-}

491 {-# INLINE next #-}

488{-# INLINE [0] justifyLeftI #-}

492{-# INLINE [0] justifyLeftI #-}

@@ -589,7 +593,7 @@ concatMap f = foldr (append . f) empty

589{-# INLINE [0] concatMap #-}

593{-# INLINE [0] concatMap #-}

590

594

591-- | /O(n)/ any @p @xs determines if any character in the stream

595-- | /O(n)/ any @p @xs determines if any character in the stream

592−-- @xs@ satisifes the predicate @p@.

596+-- @xs@ satisfies the predicate @p@.

593any :: (Char -> Bool) -> Stream Char -> Bool

597any :: (Char -> Bool) -> Stream Char -> Bool

594any p (Stream next0 s0 _len) = loop_any s0

598any p (Stream next0 s0 _len) = loop_any s0

595 where

599 where

@@ -601,7 +605,7 @@ any p (Stream next0 s0 _len) = loop_any s0

601{-# INLINE [0] any #-}

605{-# INLINE [0] any #-}

602

606

603-- | /O(n)/ all @p @xs determines if all characters in the 'Text'

607-- | /O(n)/ all @p @xs determines if all characters in the 'Text'

604−-- @xs@ satisify the predicate @p@.

608+-- @xs@ satisfy the predicate @p@.

605all :: (Char -> Bool) -> Stream Char -> Bool

609all :: (Char -> Bool) -> Stream Char -> Bool

606all p (Stream next0 s0 _len) = loop_all s0

610all p (Stream next0 s0 _len) = loop_all s0

607 where

611 where

@@ -650,50 +654,27 @@ minimum (Stream next0 s0 _len) = loop0_minimum s0

650-- * Building streams

654-- * Building streams

651

655

652scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

656scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

653−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

654 where

658 where

655 {-# INLINE next #-}

659 {-# INLINE next #-}

656− next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)

660+ next (Scan1 z s) = Yield z (Scan2 z s)

657− next (S2 :*: z :*: s) = case next0 s of

661+ next (Scan2 z s) = case next0 s of

658− Yield x s' -> let !x' = f z x

662+ Yield x s' -> let !x' = f z x

659− in Yield x' (S2 :*: x' :*: s')

663+ in Yield x' (Scan2 x' s')

660− Skip s' -> Skip (S2 :*: z :*: s')

664+ Skip s' -> Skip (Scan2 z s')

661− Done -> Done

665+ Done -> Done

662{-# INLINE [0] scanl #-}

666{-# INLINE [0] scanl #-}

663

667

664−-- -----------------------------------------------------------------------------

665−-- ** Accumulating maps

666−

667−{-

668−-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a

669−-- function to each element of a stream, passing an accumulating

670−-- parameter from left to right, and returns a final stream.

671−--

672−-- /Note/: Unlike the version over lists, this function does not

673−-- return a final value for the accumulator, because the nature of

674−-- streams precludes it.

675−mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b

676−mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :*: z0) len -- HINT depends on f

677− where

678− {-# INLINE next #-}

679− next (s :*: z) = case next0 s of

680− Yield x s' -> let (z',y) = f z x

681− in Yield y (s' :*: z')

682− Skip s' -> Skip (s' :*: z)

683− Done -> Done

684−{-# INLINE [0] mapAccumL #-}

685−-}

686−

687-- -----------------------------------------------------------------------------

668-- -----------------------------------------------------------------------------

688-- ** Generating and unfolding streams

669-- ** Generating and unfolding streams

689

670

690replicateCharI :: Integral a => a -> Char -> Stream Char

671replicateCharI :: Integral a => a -> Char -> Stream Char

691−replicateCharI n c

672+replicateCharI !n !c

692 | n < 0 = empty

673 | n < 0 = empty

693 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low

674 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low

694 where

675 where

695− next i | i >= n = Done

676+ next !i | i >= n = Done

696− | otherwise = Yield c (i + 1)

677+ | otherwise = Yield c (i + 1)

697{-# INLINE [0] replicateCharI #-}

678{-# INLINE [0] replicateCharI #-}

698

679

699data RI s = RI !s {-# UNPACK #-} !Int64

680data RI s = RI !s {-# UNPACK #-} !Int64

@@ -758,24 +739,27 @@ take n0 (Stream next0 s0 len) =

758 Yield x s' -> Yield x ((n-1) :*: s')

739 Yield x s' -> Yield x ((n-1) :*: s')

759{-# INLINE [0] take #-}

740{-# INLINE [0] take #-}

760

741

742+data Drop a s = NS !s

743+ | JS !a !s

744+

761-- | /O(n)/ drop n, applied to a stream, returns the suffix of the

745-- | /O(n)/ drop n, applied to a stream, returns the suffix of the

762-- stream after the first @n@ characters, or the empty stream if @n@

746-- stream after the first @n@ characters, or the empty stream if @n@

763-- is greater than the length of the stream.

747-- is greater than the length of the stream.

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

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

765drop n0 (Stream next0 s0 len) =

749drop n0 (Stream next0 s0 len) =

766− Stream next (J n0 :*: s0) (len - fromIntegral (max 0 n0))

750+ Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))

767 where

751 where

768 {-# INLINE next #-}

752 {-# INLINE next #-}

769− next (J n :*: s)

753+ next (JS n s)

770− | n <= 0 = Skip (N :*: s)

754+ | n <= 0 = Skip (NS s)

771 | otherwise = case next0 s of

755 | otherwise = case next0 s of

772 Done -> Done

756 Done -> Done

773− Skip s' -> Skip (J n :*: s')

757+ Skip s' -> Skip (JS n s')

774− Yield _ s' -> Skip (J (n-1) :*: s')

758+ Yield _ s' -> Skip (JS (n-1) s')

775− next (N :*: s) = case next0 s of

759+ next (NS s) = case next0 s of

776 Done -> Done

760 Done -> Done

777− Skip s' -> Skip (N :*: s')

761+ Skip s' -> Skip (NS s')

778− Yield x s' -> Yield x (N :*: s')

762+ Yield x s' -> Yield x (NS s')

779{-# INLINE [0] drop #-}

763{-# INLINE [0] drop #-}

780

764

781-- | takeWhile, applied to a predicate @p@ and a stream, returns the

765-- | takeWhile, applied to a predicate @p@ and a stream, returns the

@@ -793,18 +777,18 @@ takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

793

777

794-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.

778-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.

795dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char

779dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char

796−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

797 where

781 where

798 {-# INLINE next #-}

782 {-# INLINE next #-}

799− next (S1 :*: s) = case next0 s of

783+ next (L s) = case next0 s of

800 Done -> Done

784 Done -> Done

801− Skip s' -> Skip (S1 :*: s')

785+ Skip s' -> Skip (L s')

802− Yield x s' | p x -> Skip (S1 :*: s')

786+ Yield x s' | p x -> Skip (L s')

803− | otherwise -> Yield x (S2 :*: s')

787+ | otherwise -> Yield x (R s')

804− next (S2 :*: s) = case next0 s of

788+ next (R s) = case next0 s of

805 Done -> Done

789 Done -> Done

806− Skip s' -> Skip (S2 :*: s')

790+ Skip s' -> Skip (R s')

807− Yield x s' -> Yield x (S2 :*: s')

791+ Yield x s' -> Yield x (R s')

808{-# INLINE [0] dropWhile #-}

792{-# INLINE [0] dropWhile #-}

809

793

810-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns

794-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns

@@ -911,21 +895,25 @@ findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0

911-------------------------------------------------------------------------------

895-------------------------------------------------------------------------------

912-- * Zipping

896-- * Zipping

913

897

898+-- | Strict triple.

899+data Zip a b m = Z1 !a !b

900+ | Z2 !a !b !m

901+

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

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

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

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

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

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

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

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

918− Stream next (sa0 :*: sb0 :*: N) (smaller len1 len2)

906+ Stream next (Z1 sa0 sb0) (smaller len1 len2)

919 where

907 where

920− next (sa :*: sb :*: N) = case next0 sa of

908+ next (Z1 sa sb) = case next0 sa of

921− Done -> Done

909+ Done -> Done

922− Skip sa' -> Skip (sa' :*: sb :*: N)

910+ Skip sa' -> Skip (Z1 sa' sb)

923− Yield a sa' -> Skip (sa' :*: sb :*: J a)

911+ Yield a sa' -> Skip (Z2 sa' sb a)

924−

912+

925− next (sa' :*: sb :*: J a) = case next1 sb of

913+ next (Z2 sa' sb a) = case next1 sb of

926− Done -> Done

914+ Done -> Done

927− Skip sb' -> Skip (sa' :*: sb' :*: J a)

915+ Skip sb' -> Skip (Z2 sa' sb' a)

928− Yield b sb' -> Yield (f a b) (sa' :*: sb' :*: N)

916+ Yield b sb' -> Yield (f a b) (Z1 sa' sb')

929{-# INLINE [0] zipWith #-}

917{-# INLINE [0] zipWith #-}

930

918

931-- | /O(n)/ The 'countCharI' function returns the number of times the

919-- | /O(n)/ The 'countCharI' function returns the number of times the

Data/Text/Internal/Fusion/Size.hs+60−52

@@ -22,25 +22,28 @@ module Data.Text.Internal.Fusion.Size

22 , exactly

23 , exactSize

24 , maxSize

25+ , betweenSize

25 , unknownSize

26 , unknownSize

26 , smaller

27 , smaller

27 , larger

28 , larger

28 , upperBound

29 , upperBound

30+ , lowerBound

31+ , compareSize

29 , isEmpty

32 , isEmpty

30 ) where

33 ) where

35+import Data.Text.Internal (mul)

32#if defined(ASSERTS)

36#if defined(ASSERTS)

33import Control.Exception (assert)

37import Control.Exception (assert)

34#endif

38#endif

36−data Size = Exact {-# UNPACK #-} !Int -- ^ Exact size.

40+data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.

37− | Max {-# UNPACK #-} !Int -- ^ Upper bound on size.

38− | Unknown -- ^ Unknown size.

41+ | Unknown -- ^ Unknown size.

39 deriving (Eq, Show)

42 deriving (Eq, Show)

41exactly :: Size -> Maybe Int

44exactly :: Size -> Maybe Int

42−exactly (Exact n) = Just n

45+exactly (Between na nb) | na == nb = Just na

43−exactly _ = Nothing

46+exactly _ = Nothing

44{-# INLINE exactly #-}

47{-# INLINE exactly #-}

46exactSize :: Int -> Size

49exactSize :: Int -> Size

@@ -48,7 +51,7 @@ exactSize n =

48#if defined(ASSERTS)

51#if defined(ASSERTS)

49 assert (n >= 0)

52 assert (n >= 0)

50#endif

53#endif

51− Exact n

54+ Between n n

52{-# INLINE exactSize #-}

55{-# INLINE exactSize #-}

54maxSize :: Int -> Size

57maxSize :: Int -> Size

@@ -56,9 +59,18 @@ maxSize n =

56#if defined(ASSERTS)

59#if defined(ASSERTS)

57 assert (n >= 0)

60 assert (n >= 0)

58#endif

61#endif

59− Max n

62+ Between 0 n

60{-# INLINE maxSize #-}

63{-# INLINE maxSize #-}

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+

62unknownSize :: Size

74unknownSize :: Size

63unknownSize = Unknown

75unknownSize = Unknown

64{-# INLINE unknownSize #-}

76{-# INLINE unknownSize #-}

@@ -68,7 +80,7 @@ instance Num Size where

68 (-) = subtractSize

80 (-) = subtractSize

69 (*) = mulSize

81 (*) = mulSize

71− fromInteger = f where f = Exact . fromInteger

83+ fromInteger = f where f = exactSize . fromInteger

72 {-# INLINE f #-}

84 {-# INLINE f #-}

74add :: Int -> Int -> Int

86add :: Int -> Int -> Int

@@ -78,71 +90,67 @@ add m n | mn >= 0 = mn

78{-# INLINE add #-}

90{-# INLINE add #-}

80addSize :: Size -> Size -> Size

92addSize :: Size -> Size -> Size

81−addSize (Exact m) (Exact n) = Exact (add m n)

93+addSize (Between ma mb) (Between na nb) = Between (add ma na) (add mb nb)

82−addSize (Exact m) (Max n) = Max (add m n)

83−addSize (Max m) (Exact n) = Max (add m n)

84−addSize (Max m) (Max n) = Max (add m n)

85−addSize _ _ = Unknown

94+addSize _ _ = Unknown

86{-# INLINE addSize #-}

95{-# INLINE addSize #-}

88subtractSize :: Size -> Size -> Size

97subtractSize :: Size -> Size -> Size

89−subtractSize (Exact m) (Exact n) = Exact (max (m-n) 0)

98+subtractSize (Between ma mb) (Between na nb) = Between (max (ma-nb) 0) (max (mb-na) 0)

90−subtractSize (Exact m) (Max _) = Max m

91−subtractSize (Max m) (Exact n) = Max (max (m-n) 0)

92−subtractSize a@(Max _) (Max _) = a

99+subtractSize a@(Between 0 _) Unknown = a

93−subtractSize a@(Max _) Unknown = a

100+subtractSize (Between _ mb) Unknown = Between 0 mb

94−subtractSize _ _ = Unknown

101+subtractSize _ _ = Unknown

95{-# INLINE subtractSize #-}

102{-# INLINE subtractSize #-}

103

97−mul :: Int -> Int -> Int

98−mul m n

99− | m <= maxBound `quot` n = m * n

100− | otherwise = overflowError

101−{-# INLINE mul #-}

102−

103mulSize :: Size -> Size -> Size

104mulSize :: Size -> Size -> Size

104−mulSize (Exact m) (Exact n) = Exact (mul m n)

105+mulSize (Between ma mb) (Between na nb) = Between (mul ma na) (mul mb nb)

105−mulSize (Exact m) (Max n) = Max (mul m n)

106−mulSize (Max m) (Exact n) = Max (mul m n)

107−mulSize (Max m) (Max n) = Max (mul m n)

108−mulSize _ _ = Unknown

106+mulSize _ _ = Unknown

109{-# INLINE mulSize #-}

107{-# INLINE mulSize #-}

110

108

111-- | Minimum of two size hints.

109-- | Minimum of two size hints.

112smaller :: Size -> Size -> Size

110smaller :: Size -> Size -> Size

113−smaller (Exact m) (Exact n) = Exact (m `min` n)

111+smaller a@(Between ma mb) b@(Between na nb)

114−smaller (Exact m) (Max n) = Max (m `min` n)

112+ | mb <= na = a

115−smaller (Exact m) Unknown = Max m

113+ | nb <= ma = b

116−smaller (Max m) (Exact n) = Max (m `min` n)

114+ | otherwise = Between (ma `min` na) (mb `min` nb)

117−smaller (Max m) (Max n) = Max (m `min` n)

118−smaller a@(Max _) Unknown = a

115+smaller a@(Between 0 _) Unknown = a

119−smaller Unknown (Exact n) = Max n

116+smaller (Between _ mb) Unknown = Between 0 mb

117+smaller Unknown b@(Between 0 _) = b

120−smaller Unknown (Max n) = Max n

118+smaller Unknown (Between _ nb) = Between 0 nb

121−smaller Unknown Unknown = Unknown

119+smaller Unknown Unknown = Unknown

122{-# INLINE smaller #-}

120{-# INLINE smaller #-}

123

121

124-- | Maximum of two size hints.

122-- | Maximum of two size hints.

125larger :: Size -> Size -> Size

123larger :: Size -> Size -> Size

126−larger (Exact m) (Exact n) = Exact (m `max` n)

124+larger a@(Between ma mb) b@(Between na nb)

127−larger a@(Exact m) b@(Max n) | m >= n = a

125+ | ma >= nb = a

128− | otherwise = b

126+ | na >= mb = b

129−larger a@(Max m) b@(Exact n) | n >= m = b

130− | otherwise = a

127+ | otherwise = Between (ma `max` na) (mb `max` nb)

131−larger (Max m) (Max n) = Max (m `max` n)

132−larger _ _ = Unknown

128+larger _ _ = Unknown

133{-# INLINE larger #-}

129{-# INLINE larger #-}

134

130

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

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

136upperBound :: Int -> Size -> Int

132upperBound :: Int -> Size -> Int

137−upperBound _ (Exact n) = n

133+upperBound _ (Between _ n) = n

138−upperBound _ (Max n) = n

139−upperBound k _ = k

134+upperBound k _ = k

140{-# INLINE upperBound #-}

135{-# INLINE upperBound #-}

141

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+

142isEmpty :: Size -> Bool

151isEmpty :: Size -> Bool

143−isEmpty (Exact n) = n <= 0

152+isEmpty (Between _ n) = n <= 0

144−isEmpty (Max n) = n <= 0

145−isEmpty _ = False

153+isEmpty _ = False

146{-# INLINE isEmpty #-}

154{-# INLINE isEmpty #-}

147

155

148overflowError :: Int

156overflowError :: Int

Data/Text/Internal/Fusion/Types.hs+8−13

@@ -20,13 +20,11 @@

20module Data.Text.Internal.Fusion.Types

21 (

22 CC(..)

23− , M(..)

24− , M8

25 , PairS(..)

23 , PairS(..)

24+ , Scan(..)

26 , RS(..)

25 , RS(..)

27 , Step(..)

26 , Step(..)

28 , Stream(..)

27 , Stream(..)

29− , Switch(..)

30 , empty

28 , empty

31 ) where

29 ) where

@@ -36,26 +34,23 @@ import Data.Word (Word8)

36-- | Specialised tuple for case conversion.

34-- | Specialised tuple for case conversion.

37data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char

35data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char

39−-- | Specialised, strict Maybe-like type.

40−data M a = N

41− | J !a

42−

43−type M8 = M Word8

44−

45−-- Restreaming state.

37+-- | Restreaming state.

46data RS s

38data RS s

47 = RS0 !s

39 = RS0 !s

48 | RS1 !s {-# UNPACK #-} !Word8

40 | RS1 !s {-# UNPACK #-} !Word8

49 | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

41 | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

50 | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

42 | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

52−infixl 2 :*:

44+-- | Strict pair.

53data PairS a b = !a :*: !b

45data PairS a b = !a :*: !b

54 -- deriving (Eq, Ord, Show)

46 -- deriving (Eq, Ord, Show)

47+infixl 2 :*:

56−-- | Allow a function over a stream to switch between two states.

49+-- | An intermediate result in a scan.

57−data Switch = S1 | S2

50+data Scan s = Scan1 {-# UNPACK #-} !Char !s

51+ | Scan2 {-# UNPACK #-} !Char !s

53+-- | Intermediate result in a processing pipeline.

59data Step s a = Done

54data Step s a = Done

60 | Skip !s

55 | Skip !s

61 | Yield !a !s

56 | Yield !a !s

Data/Text/Internal/Lazy.hs+2

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

1{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}

2+{-# OPTIONS_HADDOCK not-home #-}

2-- |

4-- |

3-- Module : Data.Text.Internal.Lazy

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

Data/Text/Internal/Private.hs+4−4

@@ -16,14 +16,14 @@ module Data.Text.Internal.Private

16 ) where

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

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

19+import Data.Text.Internal (Text(..), text)

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

21import qualified Data.Text.Array as A

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

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

25− where hd = textP arr off k

25+ where hd = text arr off k

26− tl = textP arr (off+k) (len-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

@@ -33,5 +33,5 @@ span_ p t@(Text arr off len) = (# hd,tl #)

33runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text

34runText act = runST (act $ \ !marr !len -> do

35 arr <- A.unsafeFreeze marr

36− return $! textP arr 0 len)

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/Internal/Unsafe.hs+2

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

1{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}

2+{-# OPTIONS_HADDOCK not-home #-}

2-- |

4-- |

3-- Module : Data.Text.Internal.Unsafe

5-- Module : Data.Text.Internal.Unsafe

Data/Text/Lazy.hs+201−26

@@ -3,6 +3,10 @@

3#if __GLASGOW_HASKELL__ >= 702

4{-# LANGUAGE Trustworthy #-}

5#endif

6+#if __GLASGOW_HASKELL__ >= 708

7+{-# LANGUAGE TypeFamilies #-}

8+#endif

6-- |

10-- |

7-- Module : Data.Text.Lazy

11-- Module : Data.Text.Lazy

@@ -121,7 +125,10 @@ module Data.Text.Lazy

121 , mapAccumR

125 , mapAccumR

122

126

123 -- ** Generation and unfolding

127 -- ** Generation and unfolding

128+ , repeat

124 , replicate

129 , replicate

130+ , cycle

131+ , iterate

125 , unfoldr

132 , unfoldr

126 , unfoldrN

133 , unfoldrN

127

134

@@ -129,8 +136,11 @@ module Data.Text.Lazy

129

136

130 -- ** Breaking strings

137 -- ** Breaking strings

131 , take

138 , take

139+ , takeEnd

132 , drop

140 , drop

141+ , dropEnd

133 , takeWhile

142 , takeWhile

143+ , takeWhileEnd

134 , dropWhile

144 , dropWhile

135 , dropWhileEnd

145 , dropWhileEnd

136 , dropAround

146 , dropAround

@@ -201,9 +211,13 @@ import Control.DeepSeq (NFData(..))

201import Data.Int (Int64)

211import Data.Int (Int64)

202import qualified Data.List as L

212import qualified Data.List as L

203import Data.Char (isSpace)

213import Data.Char (isSpace)

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

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

205−import Data.Data (mkNoRepType)

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

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

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

217import Data.Monoid (Monoid(..))

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

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

220+#endif

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

221import Data.String (IsString(..))

208import qualified Data.Text as T

222import qualified Data.Text as T

209import qualified Data.Text.Internal as T

223import qualified Data.Text.Internal as T

@@ -212,8 +226,10 @@ import qualified Data.Text.Unsafe as T

212import qualified Data.Text.Internal.Lazy.Fusion as S

226import qualified Data.Text.Internal.Lazy.Fusion as S

213import Data.Text.Internal.Fusion.Types (PairS(..))

227import Data.Text.Internal.Fusion.Types (PairS(..))

214import Data.Text.Internal.Lazy.Fusion (stream, unstream)

228import Data.Text.Internal.Lazy.Fusion (stream, unstream)

215−import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks, foldrChunks)

229+import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks,

230+ foldrChunks, smallChunkSize)

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

231+import Data.Text.Internal (firstf, safe, text)

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

217import qualified Data.Text.Internal.Functions as F

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

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

234import Data.Text.Internal.Lazy.Search (indices)

219#if __GLASGOW_HASKELL__ >= 702

235#if __GLASGOW_HASKELL__ >= 702

@@ -221,7 +237,13 @@ import qualified GHC.CString as GHC

221#else

237#else

222import qualified GHC.Base as GHC

238import qualified GHC.Base as GHC

223#endif

239#endif

240+#if __GLASGOW_HASKELL__ >= 708

241+import qualified GHC.Exts as Exts

242+#endif

224import GHC.Prim (Addr#)

243import GHC.Prim (Addr#)

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

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

246+#endif

225

247

226-- $fusion

248-- $fusion

227--

249--

@@ -319,25 +341,71 @@ instance Show Text where

319instance Read Text where

341instance Read Text where

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

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

321

343

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+

322instance Monoid Text where

352instance Monoid Text where

323 mempty = empty

353 mempty = empty

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

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

356+#else

324 mappend = append

357 mappend = append

358+#endif

325 mconcat = concat

359 mconcat = concat

326

360

327instance IsString Text where

361instance IsString Text where

328 fromString = pack

362 fromString = pack

329

363

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+

330#if defined(HAVE_DEEPSEQ)

371#if defined(HAVE_DEEPSEQ)

331instance NFData Text where

372instance NFData Text where

332 rnf Empty = ()

373 rnf Empty = ()

333 rnf (Chunk _ ts) = rnf ts

374 rnf (Chunk _ ts) = rnf ts

334#endif

375#endif

335

376

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'

336instance Data Text where

390instance Data Text where

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

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

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

392+ toConstr _ = packConstr

393+ gunfold k z c = case constrIndex c of

394+ 1 -> k (z pack)

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

395+ _ -> error "Data.Text.Lazy.Text.gunfold"

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

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

402+#endif

403+

404+packConstr :: Constr

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

406+

407+textDataType :: DataType

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

341

409

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

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

343--

411--

@@ -365,6 +433,14 @@ unpackCString# addr# = unstream (S.streamCString# addr#)

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

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

366 = unpackCString# a #-}

434 = unpackCString# a #-}

367

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+

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

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

369-- Performs replacement on invalid scalar values.

445-- Performs replacement on invalid scalar values.

370singleton :: Char -> Text

446singleton :: Char -> Text

@@ -469,7 +545,7 @@ tail Empty = emptyError "tail"

469 unstream (S.tail (stream t)) = tail t

545 unstream (S.tail (stream t)) = tail t

470 #-}

546 #-}

471

547

472−-- | /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

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

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

474init :: Text -> Text

550init :: Text -> Text

475init (Chunk t0 ts0) = go t0 ts0

551init (Chunk t0 ts0) = go t0 ts0

@@ -505,7 +581,7 @@ isSingleton :: Text -> Bool

505isSingleton = S.isSingleton . stream

581isSingleton = S.isSingleton . stream

506{-# INLINE isSingleton #-}

582{-# INLINE isSingleton #-}

507

583

508−-- | /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

509-- non-empty. Subject to fusion.

585-- non-empty. Subject to fusion.

510last :: Text -> Char

586last :: Text -> Char

511last Empty = emptyError "last"

587last Empty = emptyError "last"

@@ -639,13 +715,36 @@ reverse = rev Empty

639 where rev a Empty = a

715 where rev a Empty = a

640 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts

716 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts

641

717

642−-- | /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"

643--

738--

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

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

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

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

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

741+replace :: Text

647− -> Text -- ^ Replacement text

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

743+ -- error will occur.

744+ -> Text

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

648− -> Text -- ^ Input text

746+ -> Text

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

649 -> Text

748 -> Text

650replace s d = intercalate d . splitOn s

749replace s d = intercalate d . splitOn s

651{-# INLINE replace #-}

750{-# INLINE replace #-}

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

782{-# INLINE concatMap #-}

881{-# INLINE concatMap #-}

783

882

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

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

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

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

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

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

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

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

788{-# INLINE any #-}

887{-# INLINE any #-}

789

888

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

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

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

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

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

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

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

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

794{-# INLINE all #-}

893{-# INLINE all #-}

@@ -871,6 +970,12 @@ mapAccumR f = go

871 go z Empty = (z, Empty)

970 go z Empty = (z, Empty)

872{-# INLINE mapAccumR #-}

971{-# INLINE mapAccumR #-}

873

972

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+

874-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input

979-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input

875-- @t@ repeated @n@ times.

980-- @t@ repeated @n@ times.

876replicate :: Int64 -> Text -> Text

981replicate :: Int64 -> Text -> Text

@@ -880,7 +985,22 @@ replicate n t

880 | otherwise = concat (rep 0)

985 | otherwise = concat (rep 0)

881 where rep !i | i >= n = []

986 where rep !i | i >= n = []

882 | otherwise = t : rep (i+1)

987 | otherwise = t : rep (i+1)

883−{-# 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

884

1004

885-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the

1005-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the

886-- value of every element. Subject to fusion.

1006-- value of every element. Subject to fusion.

@@ -935,6 +1055,22 @@ take i t0 = take' i t0

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

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

936 #-}

1056 #-}

937

1057

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+

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

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

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

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

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

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

@@ -957,6 +1093,23 @@ drop i t0

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

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

958 #-}

1094 #-}

959

1095

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+

960-- | /O(n)/ 'dropWords' @n@ returns the suffix with @n@ 'Word16'

1113-- | /O(n)/ 'dropWords' @n@ returns the suffix with @n@ 'Word16'

961-- values dropped, or the empty 'Text' if @n@ is greater than the

1114-- values dropped, or the empty 'Text' if @n@ is greater than the

962-- number of 'Word16' values present.

1115-- number of 'Word16' values present.

@@ -967,7 +1120,7 @@ dropWords i t0

967 where drop' 0 ts = ts

1120 where drop' 0 ts = ts

968 drop' _ Empty = Empty

1121 drop' _ Empty = Empty

969 drop' n (Chunk (T.Text arr off len) ts)

1122 drop' n (Chunk (T.Text arr off len) ts)

970− | n < len' = chunk (textP arr (off+n') (len-n')) ts

1123+ | n < len' = chunk (text arr (off+n') (len-n')) ts

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

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

972 where len' = fromIntegral len

1125 where len' = fromIntegral len

973 n' = fromIntegral n

1126 n' = fromIntegral n

@@ -991,6 +1144,20 @@ takeWhile p t0 = takeWhile' t0

991"LAZY TEXT takeWhile -> unfused" [1] forall p t.

1144"LAZY TEXT takeWhile -> unfused" [1] forall p t.

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

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

993 #-}

1146 #-}

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

994

1161

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

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

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

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

@@ -1009,9 +1176,11 @@ dropWhile p t0 = dropWhile' t0

1009"LAZY TEXT dropWhile -> unfused" [1] forall p t.

1176"LAZY TEXT dropWhile -> unfused" [1] forall p t.

1010 unstream (S.dropWhile p (stream t)) = dropWhile p t

1177 unstream (S.dropWhile p (stream t)) = dropWhile p t

1011 #-}

1178 #-}

1179+

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

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

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

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

1014-- @t@.

1182-- @t@.

1183+--

1015-- Examples:

1184-- Examples:

1016--

1185--

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

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

@@ -1028,7 +1197,7 @@ dropWhileEnd p = go

1028{-# INLINE dropWhileEnd #-}

1197{-# INLINE dropWhileEnd #-}

1029

1198

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

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

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

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

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

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

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

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

1034dropAround p = dropWhile p . dropWhileEnd p

1203dropAround p = dropWhile p . dropWhileEnd p

@@ -1078,8 +1247,8 @@ splitAtWord _ Empty = empty :*: empty

1078splitAtWord x (Chunk c@(T.Text arr off len) cs)

1247splitAtWord x (Chunk c@(T.Text arr off len) cs)

1079 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs

1248 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs

1080 in Chunk c h :*: t

1249 in Chunk c h :*: t

1081− | otherwise = chunk (textP arr off y) empty :*:

1250+ | otherwise = chunk (text arr off y) empty :*:

1082− chunk (textP arr (off+y) (len-y)) cs

1251+ chunk (text arr (off+y) (len-y)) cs

1083 where y = fromIntegral x

1252 where y = fromIntegral x

1084

1253

1085-- | /O(n+m)/ Find the first instance of @needle@ (which must be

1254-- | /O(n+m)/ Find the first instance of @needle@ (which must be

@@ -1223,9 +1392,10 @@ tails ts@(Chunk t ts')

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

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

1224-- are slices of the original.

1393-- are slices of the original.

1225

1394

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

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

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

1396+-- argument (which cannot be an empty string), consuming the

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

1397+-- delimiter. An empty delimiter is invalid, and will cause an error

1398+-- to be raised.

1229--

1399--

1230-- Examples:

1400-- Examples:

1231--

1401--

@@ -1238,13 +1408,18 @@ tails ts@(Chunk t ts')

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

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

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

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

1240--

1410--

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

1412+--

1241-- This function is strict in its first argument, and lazy in its

1413-- This function is strict in its first argument, and lazy in its

1242-- second.

1414-- second.

1243--

1415--

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

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

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

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

1246−splitOn :: Text -- ^ Text to split on

1418+splitOn :: Text

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

1420+ -- will occur.

1421+ -> Text

1247− -> Text -- ^ Input text

1422+ -- ^ Input text.

1248 -> [Text]

1423 -> [Text]

1249splitOn pat src

1424splitOn pat src

1250 | null pat = emptyError "splitOn"

1425 | null pat = emptyError "splitOn"

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

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

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

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

11+-- License : BSD-style (see LICENSE)

12--

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

14-- Stability : experimental

Data/Text/Lazy/Builder/Int.hs+22−15

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

1−{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, UnboxedTuples #-}

1+{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,

2+ UnboxedTuples #-}

2#if __GLASGOW_HASKELL__ >= 702

3#if __GLASGOW_HASKELL__ >= 702

3{-# LANGUAGE Trustworthy #-}

4{-# LANGUAGE Trustworthy #-}

4#endif

5#endif

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

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

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

9−-- License: BSD3

10+-- License: BSD-style

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

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

11-- Stability: experimental

12-- Stability: experimental

12-- Portability: portable

13-- Portability: portable

@@ -34,7 +35,7 @@ import Control.Monad.ST

35#ifdef __GLASGOW_HASKELL__

36#ifdef __GLASGOW_HASKELL__

36# if defined(INTEGER_GMP)

37# if defined(INTEGER_GMP)

37−import GHC.Integer.GMP.Internals

38+import GHC.Integer.GMP.Internals (Integer(S#))

38# elif defined(INTEGER_SIMPLE)

39# elif defined(INTEGER_SIMPLE)

39import GHC.Integer

40import GHC.Integer

40# else

41# else

@@ -49,18 +50,19 @@ import GHC.Integer

49#endif

50#endif

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

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

52−{-# SPECIALIZE decimal :: Int8 -> Builder #-}

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

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

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

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

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

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

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

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

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

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

58+{-# RULES "decimal/Word" decimal = positive :: Data.Word.Word -> Builder #-}

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

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

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

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

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

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

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

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

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

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

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

64decimal i = decimal' (<= -128) i

65+{-# NOINLINE decimal #-}

65boundedDecimal :: (Integral a, Bounded a) => a -> Builder

67boundedDecimal :: (Integral a, Bounded a) => a -> Builder

66{-# SPECIALIZE boundedDecimal :: Int -> Builder #-}

68{-# SPECIALIZE boundedDecimal :: Int -> Builder #-}

@@ -132,8 +134,15 @@ i2w v = zero + fromIntegral v

132

134

133countDigits :: (Integral a) => a -> Int

135countDigits :: (Integral a) => a -> Int

134{-# INLINE countDigits #-}

136{-# INLINE countDigits #-}

135−countDigits v0 = go 1 (fromIntegral v0 :: Word64)

137+countDigits v0

136− where go !k v

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)

137 | v < 10 = k

146 | v < 10 = k

138 | v < 100 = k + 1

147 | v < 100 = k + 1

139 | v < 1000 = k + 2

148 | v < 1000 = k + 2

@@ -169,6 +178,7 @@ hexadecimal i

169 where

178 where

170 go n | n < 16 = hexDigit n

179 go n | n < 16 = hexDigit n

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

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

181+{-# NOINLINE[0] hexadecimal #-}

172

182

173hexInteger :: Integer -> Builder

183hexInteger :: Integer -> Builder

174hexInteger i

184hexInteger i

@@ -184,19 +194,12 @@ hexDigit n

184 | otherwise = singleton $! toEnum (fromIntegral n + 87)

194 | otherwise = singleton $! toEnum (fromIntegral n + 87)

185{-# INLINE hexDigit #-}

195{-# INLINE hexDigit #-}

186

196

187−int :: Int -> Builder

188−int = decimal

189−{-# INLINE int #-}

190−

191data T = T !Integer !Int

197data T = T !Integer !Int

192

198

193integer :: Int -> Integer -> Builder

199integer :: Int -> Integer -> Builder

194#ifdef INTEGER_GMP

200#ifdef INTEGER_GMP

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

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

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

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

197−#else

198−integer 10 i = decimal i

199−integer 16 i = hexadecimal i

200#endif

203#endif

201integer base i

204integer base i

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

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

@@ -244,7 +247,11 @@ integer base i

244 PAIR(x,y) -> pblock q <> pblock r <> putB ns

247 PAIR(x,y) -> pblock q <> pblock r <> putB ns

245 where q = fromInteger x

248 where q = fromInteger x

246 r = fromInteger y

249 r = fromInteger y

247− putB _ = mempty

250+ putB _ = Data.Monoid.mempty

251+

252+ int :: Int -> Builder

253+ int x | base == 10 = decimal x

254+ | otherwise = hexadecimal x

248

255

249 pblock = loop maxDigits

256 pblock = loop maxDigits

250 where

257 where

Data/Text/Lazy/Encoding.hs+9−21

@@ -46,30 +46,25 @@ module Data.Text.Lazy.Encoding

46 , encodeUtf32LE

47 , encodeUtf32BE

49−#if MIN_VERSION_bytestring(0,10,4)

50 -- * Encoding Text using ByteString Builders

49 -- * Encoding Text using ByteString Builders

51 , encodeUtf8Builder

50 , encodeUtf8Builder

52 , encodeUtf8BuilderEscaped

51 , encodeUtf8BuilderEscaped

53−#endif

54 ) where

52 ) where

56import Control.Exception (evaluate, try)

54import Control.Exception (evaluate, try)

55+import Data.Monoid (Monoid(..))

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

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

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

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

59−import qualified Data.ByteString as S

60−import qualified Data.ByteString.Lazy as B

61−import qualified Data.ByteString.Lazy.Internal as B

62−import qualified Data.ByteString.Unsafe as B

63−#if MIN_VERSION_bytestring(0,10,4)

64import Data.Word (Word8)

58import Data.Word (Word8)

65−import Data.Monoid (mempty, (<>))

59+import qualified Data.ByteString as S

66import qualified Data.ByteString.Builder as B

60import qualified Data.ByteString.Builder as B

67import qualified Data.ByteString.Builder.Extra as B (safeStrategy, toLazyByteStringWith)

61import qualified Data.ByteString.Builder.Extra as B (safeStrategy, toLazyByteStringWith)

68import qualified Data.ByteString.Builder.Prim as BP

62import qualified Data.ByteString.Builder.Prim as BP

63+import qualified Data.ByteString.Lazy as B

64+import qualified Data.ByteString.Lazy.Internal as B

65+import qualified Data.ByteString.Unsafe as B

69import qualified Data.Text as T

66import qualified Data.Text as T

70−#endif

71import qualified Data.Text.Encoding as TE

67import qualified Data.Text.Encoding as TE

72−import qualified Data.Text.Lazy as L

73import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E

68import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E

74import qualified Data.Text.Internal.Lazy.Fusion as F

69import qualified Data.Text.Internal.Lazy.Fusion as F

75import Data.Text.Unsafe (unsafeDupablePerformIO)

70import Data.Text.Unsafe (unsafeDupablePerformIO)

@@ -89,8 +84,6 @@ import Data.Text.Unsafe (unsafeDupablePerformIO)

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

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

91-- encoded text.

86-- encoded text.

92−--

93−-- This function is deprecated. Use 'decodeLatin1' instead.

94decodeASCII :: B.ByteString -> Text

87decodeASCII :: B.ByteString -> Text

95decodeASCII = decodeUtf8

88decodeASCII = decodeUtf8

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

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

@@ -112,7 +105,7 @@ decodeUtf8With onErr (B.Chunk b0 bs0) =

112 | S.null l = empty

105 | S.null l = empty

113 | otherwise = case onErr desc (Just (B.unsafeHead l)) of

106 | otherwise = case onErr desc (Just (B.unsafeHead l)) of

114 Nothing -> empty

107 Nothing -> empty

115− Just c -> L.singleton c

108+ Just c -> Chunk (T.singleton c) Empty

116 desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"

109 desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"

117decodeUtf8With _ _ = empty

110decodeUtf8With _ _ = empty

118

111

@@ -149,7 +142,6 @@ decodeUtf8' bs = unsafeDupablePerformIO $ do

149{-# INLINE decodeUtf8' #-}

142{-# INLINE decodeUtf8' #-}

150

143

151encodeUtf8 :: Text -> B.ByteString

144encodeUtf8 :: Text -> B.ByteString

152−#if MIN_VERSION_bytestring(0,10,4)

153encodeUtf8 Empty = B.empty

145encodeUtf8 Empty = B.empty

154encodeUtf8 lt@(Chunk t _) =

146encodeUtf8 lt@(Chunk t _) =

155 B.toLazyByteStringWith strategy B.empty $ encodeUtf8Builder lt

147 B.toLazyByteStringWith strategy B.empty $ encodeUtf8Builder lt

@@ -163,17 +155,13 @@ encodeUtf8 lt@(Chunk t _) =

163 strategy = B.safeStrategy firstChunkSize B.defaultChunkSize

155 strategy = B.safeStrategy firstChunkSize B.defaultChunkSize

164

156

165encodeUtf8Builder :: Text -> B.Builder

157encodeUtf8Builder :: Text -> B.Builder

158+encodeUtf8Builder =

166−encodeUtf8Builder = foldrChunks (\c b -> TE.encodeUtf8Builder c <> b) mempty

159+ foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) Data.Monoid.mempty

167

160

168{-# INLINE encodeUtf8BuilderEscaped #-}

161{-# INLINE encodeUtf8BuilderEscaped #-}

169encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder

162encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder

170encodeUtf8BuilderEscaped prim =

163encodeUtf8BuilderEscaped prim =

171− foldrChunks (\c b -> TE.encodeUtf8BuilderEscaped prim c <> b) mempty

164+ foldrChunks (\c b -> TE.encodeUtf8BuilderEscaped prim c `mappend` b) mempty

172−

173−#else

174−encodeUtf8 (Chunk c cs) = B.Chunk (TE.encodeUtf8 c) (encodeUtf8 cs)

175−encodeUtf8 Empty = B.Empty

176−#endif

177

165

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

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

179decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text

167decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text

Data/Text/Lazy/Read.hs+8−33

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

1{-# LANGUAGE OverloadedStrings, CPP #-}

2−#if __GLASGOW_HASKELL__ >= 702

2+#if __GLASGOW_HASKELL__ >= 704

3+{-# LANGUAGE Safe #-}

4+#elif __GLASGOW_HASKELL__ >= 702

3{-# LANGUAGE Trustworthy #-}

5{-# LANGUAGE Trustworthy #-}

4#endif

6#endif

@@ -24,15 +26,17 @@ module Data.Text.Lazy.Read

24 ) where

26 ) where

26import Control.Monad (liftM)

28import Control.Monad (liftM)

27−import Data.Char (isDigit, isHexDigit, ord)

29+import Data.Char (isDigit, isHexDigit)

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

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

29import Data.Ratio ((%))

31import Data.Ratio ((%))

32+import Data.Text.Internal.Read

30import Data.Text.Lazy as T

33import Data.Text.Lazy as T

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

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

33-- | Read some text. If the read succeeds, return its value and the

36-- | Read some text. If the read succeeds, return its value and the

34-- remaining text, otherwise an error message.

37-- remaining text, otherwise an error message.

35−type Reader a = Text -> Either String (a,Text)

38+type Reader a = IReader Text a

39+type Parser = IParser Text

37-- | Read a decimal integer. The input must begin with at least one

41-- | Read a decimal integer. The input must begin with at least one

38-- decimal digit, and is consumed until a non-digit or end of string

42-- decimal digit, and is consumed until a non-digit or end of string

@@ -52,7 +56,7 @@ decimal :: Integral a => Reader a

52{-# SPECIALIZE decimal :: Reader Int32 #-}

56{-# SPECIALIZE decimal :: Reader Int32 #-}

53{-# SPECIALIZE decimal :: Reader Int64 #-}

57{-# SPECIALIZE decimal :: Reader Int64 #-}

54{-# SPECIALIZE decimal :: Reader Integer #-}

58{-# SPECIALIZE decimal :: Reader Integer #-}

55−{-# SPECIALIZE decimal :: Reader Word #-}

59+{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}

56{-# SPECIALIZE decimal :: Reader Word8 #-}

60{-# SPECIALIZE decimal :: Reader Word8 #-}

57{-# SPECIALIZE decimal :: Reader Word16 #-}

61{-# SPECIALIZE decimal :: Reader Word16 #-}

58{-# SPECIALIZE decimal :: Reader Word32 #-}

62{-# SPECIALIZE decimal :: Reader Word32 #-}

@@ -101,15 +105,6 @@ hex txt

101 where (h,t) = T.span isHexDigit txt

105 where (h,t) = T.span isHexDigit txt

102 go n d = (n * 16 + fromIntegral (hexDigitToInt d))

106 go n d = (n * 16 + fromIntegral (hexDigitToInt d))

103

107

104−hexDigitToInt :: Char -> Int

105−hexDigitToInt c

106− | c >= '0' && c <= '9' = ord c - ord '0'

107− | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)

108− | otherwise = ord c - (ord 'A' - 10)

109−

110−digitToInt :: Char -> Int

111−digitToInt c = ord c - ord '0'

112−

113-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and

108-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and

114-- apply it to the result of applying the given reader.

109-- apply it to the result of applying the given reader.

115signed :: Num a => Reader a -> Reader a

110signed :: Num a => Reader a -> Reader a

@@ -169,31 +164,11 @@ signa p = do

169 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')

164 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')

170 if sign == '+' then p else negate `liftM` p

165 if sign == '+' then p else negate `liftM` p

171

166

172−newtype Parser a = P {

173− runP :: Reader a

174− }

175−

176−instance Monad Parser where

177− return a = P $ \t -> Right (a,t)

178− {-# INLINE return #-}

179− m >>= k = P $ \t -> case runP m t of

180− Left err -> Left err

181− Right (a,t') -> runP (k a) t'

182− {-# INLINE (>>=) #-}

183− fail msg = P $ \_ -> Left msg

184−

185−perhaps :: a -> Parser a -> Parser a

186−perhaps def m = P $ \t -> case runP m t of

187− Left _ -> Right (def,t)

188− r@(Right _) -> r

189−

190char :: (Char -> Bool) -> Parser Char

167char :: (Char -> Bool) -> Parser Char

191char p = P $ \t -> case T.uncons t of

168char p = P $ \t -> case T.uncons t of

192 Just (c,t') | p c -> Right (c,t')

169 Just (c,t') | p c -> Right (c,t')

193 _ -> Left "character does not match"

170 _ -> Left "character does not match"

194

171

195−data T = T !Integer !Int

196−

197floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a

172floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a

198{-# INLINE floaty #-}

173{-# INLINE floaty #-}

199floaty f = runP $ do

174floaty f = runP $ do

Data/Text/Read.hs+5−32

@@ -24,16 +24,18 @@ module Data.Text.Read

24 ) where

26import Control.Monad (liftM)

27−import Data.Char (isDigit, isHexDigit, ord)

27+import Data.Char (isDigit, isHexDigit)

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

29import Data.Ratio ((%))

30import Data.Text as T

31import Data.Text.Internal.Private (span_)

32+import Data.Text.Internal.Read

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

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

34-- | Read some text. If the read succeeds, return its value and the

35-- | Read some text. If the read succeeds, return its value and the

35-- remaining text, otherwise an error message.

36-- remaining text, otherwise an error message.

36−type Reader a = Text -> Either String (a,Text)

37+type Reader a = IReader Text a

38+type Parser a = IParser Text a

38-- | Read a decimal integer. The input must begin with at least one

40-- | Read a decimal integer. The input must begin with at least one

39-- decimal digit, and is consumed until a non-digit or end of string

41-- decimal digit, and is consumed until a non-digit or end of string

@@ -53,7 +55,7 @@ decimal :: Integral a => Reader a

53{-# SPECIALIZE decimal :: Reader Int32 #-}

55{-# SPECIALIZE decimal :: Reader Int32 #-}

54{-# SPECIALIZE decimal :: Reader Int64 #-}

56{-# SPECIALIZE decimal :: Reader Int64 #-}

55{-# SPECIALIZE decimal :: Reader Integer #-}

57{-# SPECIALIZE decimal :: Reader Integer #-}

56−{-# SPECIALIZE decimal :: Reader Word #-}

58+{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}

57{-# SPECIALIZE decimal :: Reader Word8 #-}

59{-# SPECIALIZE decimal :: Reader Word8 #-}

58{-# SPECIALIZE decimal :: Reader Word16 #-}

60{-# SPECIALIZE decimal :: Reader Word16 #-}

59{-# SPECIALIZE decimal :: Reader Word32 #-}

61{-# SPECIALIZE decimal :: Reader Word32 #-}

@@ -111,15 +113,6 @@ hex txt

111 where (# h,t #) = span_ isHexDigit txt

113 where (# h,t #) = span_ isHexDigit txt

112 go n d = (n * 16 + fromIntegral (hexDigitToInt d))

114 go n d = (n * 16 + fromIntegral (hexDigitToInt d))

113

115

114−hexDigitToInt :: Char -> Int

115−hexDigitToInt c

116− | c >= '0' && c <= '9' = ord c - ord '0'

117− | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)

118− | otherwise = ord c - (ord 'A' - 10)

119−

120−digitToInt :: Char -> Int

121−digitToInt c = ord c - ord '0'

122−

123-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and

116-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and

124-- apply it to the result of applying the given reader.

117-- apply it to the result of applying the given reader.

125signed :: Num a => Reader a -> Reader a

118signed :: Num a => Reader a -> Reader a

@@ -179,31 +172,11 @@ signa p = do

179 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')

172 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')

180 if sign == '+' then p else negate `liftM` p

173 if sign == '+' then p else negate `liftM` p

181

174

182−newtype Parser a = P {

183− runP :: Reader a

184− }

185−

186−instance Monad Parser where

187− return a = P $ \t -> Right (a,t)

188− {-# INLINE return #-}

189− m >>= k = P $ \t -> case runP m t of

190− Left err -> Left err

191− Right (a,t') -> runP (k a) t'

192− {-# INLINE (>>=) #-}

193− fail msg = P $ \_ -> Left msg

194−

195−perhaps :: a -> Parser a -> Parser a

196−perhaps def m = P $ \t -> case runP m t of

197− Left _ -> Right (def,t)

198− r@(Right _) -> r

199−

200char :: (Char -> Bool) -> Parser Char

175char :: (Char -> Bool) -> Parser Char

201char p = P $ \t -> case T.uncons t of

176char p = P $ \t -> case T.uncons t of

202 Just (c,t') | p c -> Right (c,t')

177 Just (c,t') | p c -> Right (c,t')

203 _ -> Left "character does not match"

178 _ -> Left "character does not match"

204

179

205−data T = T !Integer !Int

206−

207floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a

180floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a

208{-# INLINE floaty #-}

181{-# INLINE floaty #-}

209floaty f = runP $ do

182floaty f = runP $ do

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

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

18 , iter

19 , iter_

20 , reverseIter

21+ , reverseIter_

21 , unsafeHead

22 , unsafeHead

22 , unsafeTail

23 , unsafeTail

23 , lengthWord16

24 , lengthWord16

@@ -94,6 +95,16 @@ reverseIter (Text arr off _len) i

94 k = j - 1

95 k = j - 1

95{-# INLINE reverseIter #-}

96{-# INLINE reverseIter #-}

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+

97-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This

108-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This

98-- is useful for sizing a target array appropriately before using

109-- is useful for sizing a target array appropriately before using

99-- 'unsafeCopyToPtr'.

110-- 'unsafeCopyToPtr'.

benchmarks/haskell/Benchmarks.hs+3−1

@@ -15,6 +15,7 @@ import qualified Benchmarks.EncodeUtf8 as EncodeUtf8

15import qualified Benchmarks.Equality as Equality

16import qualified Benchmarks.FileRead as FileRead

17import qualified Benchmarks.FoldLines as FoldLines

18+import qualified Benchmarks.Mul as Mul

18import qualified Benchmarks.Pure as Pure

19import qualified Benchmarks.Pure as Pure

19import qualified Benchmarks.ReadNumbers as ReadNumbers

20import qualified Benchmarks.ReadNumbers as ReadNumbers

20import qualified Benchmarks.Replace as Replace

21import qualified Benchmarks.Replace as Replace

@@ -49,9 +50,10 @@ benchmarks = do

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

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

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

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

51 , FoldLines.benchmark (tf "russian.txt")

52 , FoldLines.benchmark (tf "russian.txt")

53+ , Mul.benchmark

52 , Pure.benchmark "tiny" (tf "tiny.txt")

54 , Pure.benchmark "tiny" (tf "tiny.txt")

53 , Pure.benchmark "ascii" (tf "ascii-small.txt")

55 , Pure.benchmark "ascii" (tf "ascii-small.txt")

54− , Pure.benchmark "france" (tf "france.html")

56+ -- , Pure.benchmark "france" (tf "france.html")

55 , Pure.benchmark "russian" (tf "russian-small.txt")

57 , Pure.benchmark "russian" (tf "russian-small.txt")

56 , Pure.benchmark "japanese" (tf "japanese.txt")

58 , Pure.benchmark "japanese" (tf "japanese.txt")

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

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

benchmarks/haskell/Benchmarks/DecodeUtf8.hs+2−2

@@ -25,7 +25,7 @@ import Foreign.Ptr (Ptr, plusPtr)

25import Foreign.ForeignPtr (withForeignPtr)

26import Data.Word (Word8)

27import qualified Criterion as C

28−import Criterion (Benchmark, bgroup, nf)

28+import Criterion (Benchmark, bgroup, nf, whnfIO)

29import qualified Codec.Binary.UTF8.Generic as U8

30import qualified Data.ByteString as B

31import qualified Data.ByteString.Lazy as BL

@@ -48,7 +48,7 @@ benchmark kind fp = do

48 return $ bgroup "DecodeUtf8"

49 [ bench "Strict" $ nf T.decodeUtf8 bs

50 , bench "Stream" $ nf decodeStream lbs

51− , bench "IConv" $ iconv bs

51+ , bench "IConv" $ whnfIO $ iconv bs

52 , bench "StrictLength" $ nf (T.length . T.decodeUtf8) bs

53 , bench "StrictInitLength" $ nf (T.length . T.init . T.decodeUtf8) bs

54 , bench "Lazy" $ nf TL.decodeUtf8 lbs

benchmarks/haskell/Benchmarks/FileRead.hs+11−11

@@ -8,8 +8,8 @@ module Benchmarks.FileRead

8 ( benchmark

9 ) where

11−import Control.Exception (evaluate)

11+import Control.Applicative ((<$>))

12−import Criterion (Benchmark, bgroup, bench)

12+import Criterion (Benchmark, bgroup, bench, whnfIO)

13import qualified Data.ByteString as SB

14import qualified Data.ByteString.Lazy as LB

15import qualified Data.Text as T

@@ -21,13 +21,13 @@ import qualified Data.Text.Lazy.IO as LT

22benchmark :: FilePath -> IO Benchmark

23benchmark p = return $ bgroup "FileRead"

24− [ bench "String" $ readFile p >>= evaluate . length

24+ [ bench "String" $ whnfIO $ length <$> readFile p

25− , bench "ByteString" $ SB.readFile p >>= evaluate . SB.length

25+ , bench "ByteString" $ whnfIO $ SB.length <$> SB.readFile p

26− , bench "LazyByteString" $ LB.readFile p >>= evaluate . LB.length

26+ , bench "LazyByteString" $ whnfIO $ LB.length <$> LB.readFile p

27− , bench "Text" $ T.readFile p >>= evaluate . T.length

27+ , bench "Text" $ whnfIO $ T.length <$> T.readFile p

28− , bench "LazyText" $ LT.readFile p >>= evaluate . LT.length

28+ , bench "LazyText" $ whnfIO $ LT.length <$> LT.readFile p

29− , bench "TextByteString" $

29+ , bench "TextByteString" $ whnfIO $

30− SB.readFile p >>= evaluate . T.length . T.decodeUtf8

30+ (T.length . T.decodeUtf8) <$> SB.readFile p

31− , bench "LazyTextByteString" $

31+ , bench "LazyTextByteString" $ whnfIO $

32− LB.readFile p >>= evaluate . LT.length . LT.decodeUtf8

32+ (LT.length . LT.decodeUtf8) <$> LB.readFile p

33 ]

benchmarks/haskell/Benchmarks/FoldLines.hs+2−2

@@ -10,7 +10,7 @@ module Benchmarks.FoldLines

10 ( benchmark

11 ) where

13−import Criterion (Benchmark, bgroup, bench)

13+import Criterion (Benchmark, bgroup, bench, whnfIO)

14import System.IO

15import qualified Data.ByteString as B

16import qualified Data.Text as T

@@ -22,7 +22,7 @@ benchmark fp = return $ bgroup "ReadLines"

22 , bench "ByteString" $ withHandle $ foldLinesB (\n _ -> n + 1) (0 :: Int)

23 ]

24 where

25− withHandle f = do

25+ withHandle f = whnfIO $ do

26 h <- openFile fp ReadMode

27 hSetBuffering h (BlockBuffering (Just 16384))

28 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)]

benchmarks/haskell/Benchmarks/Programs/BigTable.hs+2−2

@@ -11,7 +11,7 @@ module Benchmarks.Programs.BigTable

11 ( benchmark

12 ) where

14−import Criterion (Benchmark, bench)

14+import Criterion (Benchmark, bench, whnfIO)

15import Data.Monoid (mappend, mconcat)

16import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)

17import Data.Text.Lazy.IO (hPutStr)

@@ -19,7 +19,7 @@ import System.IO (Handle)

19import qualified Data.Text as T

21benchmark :: Handle -> IO Benchmark

22−benchmark sink = return $ bench "BigTable" $ do

22+benchmark sink = return $ bench "BigTable" $ whnfIO $ do

23 hPutStr sink "Content-Type: text/html\n\n<table>"

24 hPutStr sink . toLazyText . makeTable =<< rows

25 hPutStr sink "</table>"

benchmarks/haskell/Benchmarks/Programs/Cut.hs+2−2

@@ -16,7 +16,7 @@ module Benchmarks.Programs.Cut

16 ( benchmark

17 ) where

19−import Criterion (Benchmark, bgroup, bench)

19+import Criterion (Benchmark, bgroup, bench, whnfIO)

20import System.IO (Handle, hPutStr)

21import qualified Data.ByteString as B

22import qualified Data.ByteString.Char8 as BC

@@ -40,7 +40,7 @@ benchmark p sink from to = return $ bgroup "Cut"

40 , bench' "LazyTextByteString" lazyTextByteString

41 ]

42 where

43− bench' n s = bench n (s p sink from to)

43+ bench' n s = bench n $ whnfIO (s p sink from to)

45string :: FilePath -> Handle -> Int -> Int -> IO ()

46string fp sink from to = do

benchmarks/haskell/Benchmarks/Programs/Fold.hs+2−2

@@ -21,7 +21,7 @@ import Data.List (foldl')

21import Data.List (intersperse)

22import Data.Monoid (mempty, mappend, mconcat)

23import System.IO (Handle)

24−import Criterion (Benchmark, bench)

24+import Criterion (Benchmark, bench, whnfIO)

25import qualified Data.Text as T

26import qualified Data.Text.IO as T

27import qualified Data.Text.Lazy.Builder as TLB

@@ -30,7 +30,7 @@ import qualified Data.Text.Lazy.IO as TL

31benchmark :: FilePath -> Handle -> IO Benchmark

32benchmark 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

35-- | We represent a paragraph by a word list

36--

benchmarks/haskell/Benchmarks/Programs/Sort.hs+10−9

@@ -17,7 +17,7 @@ module Benchmarks.Programs.Sort

17 ( benchmark

18 ) where

20−import Criterion (Benchmark, bgroup, bench)

20+import Criterion (Benchmark, bgroup, bench, whnfIO)

21import Data.Monoid (mconcat)

22import System.IO (Handle, hPutStr)

23import qualified Data.ByteString as B

@@ -35,16 +35,17 @@ import qualified Data.Text.Lazy.IO as TL

36benchmark :: FilePath -> Handle -> IO Benchmark

37benchmark i o = return $ bgroup "Sort"

38− [ bench "String" $ readFile i >>= hPutStr o . string

38+ [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string

39− , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString

39+ , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString

40+ , bench "LazyByteString" $ whnfIO $

40− , bench "LazyByteString" $ BL.readFile i >>= BL.hPutStr o . lazyByteString

41+ BL.readFile i >>= BL.hPutStr o . lazyByteString

41− , bench "Text" $ T.readFile i >>= T.hPutStr o . text

42+ , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text

42− , bench "LazyText" $ TL.readFile i >>= TL.hPutStr o . lazyText

43+ , bench "LazyText" $ whnfIO $ TL.readFile i >>= TL.hPutStr o . lazyText

43− , bench "TextByteString" $ B.readFile i >>=

44+ , bench "TextByteString" $ whnfIO $ B.readFile i >>=

44 B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8

45 B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8

45− , bench "LazyTextByteString" $ BL.readFile i >>=

46+ , bench "LazyTextByteString" $ whnfIO $ BL.readFile i >>=

46 BL.hPutStr o . TL.encodeUtf8 . lazyText . TL.decodeUtf8

47 BL.hPutStr o . TL.encodeUtf8 . lazyText . TL.decodeUtf8

47− , bench "TextBuilder" $ B.readFile i >>=

48+ , bench "TextBuilder" $ whnfIO $ B.readFile i >>=

48 BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8

49 BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8

49 ]

50 ]

benchmarks/haskell/Benchmarks/Programs/StripTags.hs+5−5

@@ -15,7 +15,7 @@ module Benchmarks.Programs.StripTags

15 ( benchmark

16 ) where

18−import Criterion (Benchmark, bgroup, bench)

18+import Criterion (Benchmark, bgroup, bench, whnfIO)

19import Data.List (mapAccumL)

20import System.IO (Handle, hPutStr)

21import qualified Data.ByteString as B

@@ -26,10 +26,10 @@ import qualified Data.Text.IO as T

27benchmark :: FilePath -> Handle -> IO Benchmark

28benchmark i o = return $ bgroup "StripTags"

29− [ bench "String" $ readFile i >>= hPutStr o . string

29+ [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string

30− , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString

30+ , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString

31− , bench "Text" $ T.readFile i >>= T.hPutStr o . text

31+ , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text

32− , bench "TextByteString" $

32+ , bench "TextByteString" $ whnfIO $

33 B.readFile i >>= B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8

34 ]

benchmarks/haskell/Benchmarks/Programs/Throughput.hs+8−8

@@ -18,7 +18,7 @@ module Benchmarks.Programs.Throughput

18 ( benchmark

19 ) where

21−import Criterion (Benchmark, bgroup, bench)

21+import Criterion (Benchmark, bgroup, bench, whnfIO)

22import System.IO (Handle, hPutStr)

23import qualified Data.ByteString as B

24import qualified Data.ByteString.Lazy as BL

@@ -29,13 +29,13 @@ import qualified Data.Text.Lazy.IO as TL

30benchmark :: FilePath -> Handle -> IO Benchmark

31benchmark fp sink = return $ bgroup "Throughput"

32− [ bench "String" $ readFile fp >>= hPutStr sink

32+ [ bench "String" $ whnfIO $ readFile fp >>= hPutStr sink

33− , bench "ByteString" $ B.readFile fp >>= B.hPutStr sink

33+ , bench "ByteString" $ whnfIO $ B.readFile fp >>= B.hPutStr sink

34− , bench "LazyByteString" $ BL.readFile fp >>= BL.hPutStr sink

34+ , bench "LazyByteString" $ whnfIO $ BL.readFile fp >>= BL.hPutStr sink

35− , bench "Text" $ T.readFile fp >>= T.hPutStr sink

35+ , bench "Text" $ whnfIO $ T.readFile fp >>= T.hPutStr sink

36− , bench "LazyText" $ TL.readFile fp >>= TL.hPutStr sink

36+ , bench "LazyText" $ whnfIO $ TL.readFile fp >>= TL.hPutStr sink

37− , bench "TextByteString" $

37+ , bench "TextByteString" $ whnfIO $

38 B.readFile fp >>= B.hPutStr sink . T.encodeUtf8 . T.decodeUtf8

39− , bench "LazyTextByteString" $

39+ , bench "LazyTextByteString" $ whnfIO $

40 BL.readFile fp >>= BL.hPutStr sink . TL.encodeUtf8 . TL.decodeUtf8

41 ]

benchmarks/haskell/Benchmarks/Pure.hs+7

@@ -262,6 +262,13 @@ benchmark kind fp = do

262 , benchBSL $ nf (BL.map toUpper) bla

263 , benchS $ nf (L.map toUpper) sa

264 ]

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

265 , bgroup "words"

272 , bgroup "words"

266 [ benchT $ nf T.words ta

273 [ benchT $ nf T.words ta

267 , benchTL $ nf TL.words tla

274 , benchTL $ nf TL.words tla

benchmarks/haskell/Benchmarks/ReadNumbers.hs+2−5

@@ -25,8 +25,7 @@ import Data.List (foldl')

25import Numeric (readDec, readFloat, readHex)

26import qualified Data.ByteString.Char8 as B

27import qualified Data.ByteString.Lazy.Char8 as BL

28−import qualified Data.ByteString.Lex.Double as B

28+import qualified Data.ByteString.Lex.Fractional as B

29−import qualified Data.ByteString.Lex.Lazy.Double as BL

30import qualified Data.Text as T

29import qualified Data.Text as T

31import qualified Data.Text.IO as T

30import qualified Data.Text.IO as T

32import qualified Data.Text.Lazy as TL

31import qualified Data.Text.Lazy as TL

@@ -63,12 +62,10 @@ benchmark fp = do

63 whnf (double . text TL.rational) tl

62 whnf (double . text TL.rational) tl

65 , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b

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

68 , bench "DecimalLazyByteString" $

67 , bench "DecimalLazyByteString" $

69 whnf (int . byteString BL.readInt) bl

68 whnf (int . byteString BL.readInt) bl

70− , bench "DoubleLazyByteString" $

71− whnf (double . byteString BL.readDouble) bl

72 ]

69 ]

73 where

70 where

74 -- Used for fixing types

71 -- Used for fixing types

benchmarks/haskell/Benchmarks/Stream.hs+16−5

@@ -18,11 +18,11 @@ import qualified Data.Text.Encoding as T

18import qualified Data.Text.Encoding.Error as E

19import qualified Data.Text.Internal.Encoding.Fusion as T

20import qualified Data.Text.Internal.Encoding.Fusion.Common as F

21−import qualified Data.Text.Internal.Fusion as T

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

22import qualified Data.Text.IO as T

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

24import qualified Data.Text.Internal.Lazy.Encoding.Fusion as TL

25−import qualified Data.Text.Internal.Lazy.Fusion as TL

25+import qualified Data.Text.Internal.Lazy.Fusion as FL

26import qualified Data.Text.Lazy.IO as TL

28instance NFData a => NFData (Stream a) where

@@ -53,14 +53,25 @@ benchmark fp = do

53 !utf32beL = TL.encodeUtf32BE tl

55 -- For the functions which operate on streams

56− let !s = T.stream t

56+ let !s = F.stream t

58 return $ bgroup "Stream"

60 -- Fusion

61 [ bgroup "stream" $

62− [ bench "Text" $ nf T.stream t

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

63− , bench "LazyText" $ nf TL.stream tl

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

64 ]

75 ]

66 -- Encoding.Fusion

77 -- Encoding.Fusion

benchmarks/text-benchmarks.cabal+18−6

@@ -3,7 +3,7 @@ version: 0.0.0.0

3synopsis: Benchmarks for the text package

4description: Benchmarks for the text package

5homepage: https://bitbucket.org/bos/text

6−license: BSD3

6+license: BSD2

7license-file: ../LICENSE

8author: Jasper Van der Jeugt <jaspervdj@gmail.com>,

9 Bryan O'Sullivan <bos@serpentine.com>,

@@ -15,9 +15,15 @@ build-type: Simple

16cabal-version: >=1.2

18+flag bytestring-builder

19+ description: Depend on the bytestring-builder package for backwards compatibility.

20+ default: False

21+ manual: False

22+

18flag llvm

23flag llvm

19 description: use LLVM

24 description: use LLVM

20 default: False

25 default: False

26+ manual: True

22executable text-benchmarks

28executable text-benchmarks

23 hs-source-dirs: haskell ..

29 hs-source-dirs: haskell ..

@@ -25,24 +31,30 @@ executable text-benchmarks

25 cbits/time_iconv.c

31 cbits/time_iconv.c

26 include-dirs: ../include

32 include-dirs: ../include

27 main-is: Benchmarks.hs

33 main-is: Benchmarks.hs

28− ghc-options: -Wall -O2

34+ ghc-options: -Wall -O2 -rtsopts

29 if flag(llvm)

35 if flag(llvm)

30 ghc-options: -fllvm

36 ghc-options: -fllvm

31 cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP

37 cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP

32 build-depends: base == 4.*,

38 build-depends: base == 4.*,

33 binary,

39 binary,

34 blaze-builder,

40 blaze-builder,

35− bytestring,

41+ bytestring-lexing >= 0.5.0,

36− bytestring-lexing,

37 containers,

42 containers,

38− criterion >= 0.6.0.1,

43+ criterion >= 0.10.0.0,

39 deepseq,

44 deepseq,

40 directory,

45 directory,

41 filepath,

46 filepath,

42 ghc-prim,

47 ghc-prim,

43 integer-gmp,

48 integer-gmp,

44 stringsearch,

49 stringsearch,

45− utf8-string

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

47executable text-multilang

59executable text-multilang

48 hs-source-dirs: haskell

60 hs-source-dirs: haskell

cbits/cbits.c+20−7

@@ -68,8 +68,8 @@ decode(uint32_t *state, uint32_t* codep, uint32_t byte) {

68 * an UTF16 array

69 */

70void

71−_hs_text_decode_latin1(uint16_t *dest, const uint8_t const *src,

71+_hs_text_decode_latin1(uint16_t *dest, const uint8_t *src,

72− const uint8_t const *srcend)

72+ const uint8_t *srcend)

73{

74 const uint8_t *p = src;

@@ -130,14 +130,14 @@ _hs_text_decode_latin1(uint16_t *dest, const uint8_t const *src,

130#if defined(__GNUC__) || defined(__clang__)

131static inline uint8_t const *

132_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,

133− const uint8_t const **src, const uint8_t const *srcend,

133+ const uint8_t **src, const uint8_t *srcend,

134 uint32_t *codepoint0, uint32_t *state0)

135 __attribute((always_inline));

136#endif

137

138static inline uint8_t const *

139_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,

140− const uint8_t const **src, const uint8_t const *srcend,

140+ const uint8_t **src, const uint8_t *srcend,

141 uint32_t *codepoint0, uint32_t *state0)

142{

143 uint16_t *d = dest + *destoff;

@@ -202,8 +202,8 @@ _hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,

202

203uint8_t const *

204_hs_text_decode_utf8_state(uint16_t *const dest, size_t *destoff,

205− const uint8_t const **src,

205+ const uint8_t **src,

206− const uint8_t const *srcend,

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,

@@ -245,8 +245,21 @@ _hs_text_encode_utf8(uint8_t **destp, const uint16_t *src, size_t srcoff,

245 while (srcend - src >= 4) {

246 uint64_t w = *((uint64_t *) src);

247

248− if (w & 0xFF80FF80FF80FF80ULL)

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

249 break;

261 break;

262+ }

250 *dest++ = w & 0xFFFF;

263 *dest++ = w & 0xFFFF;

251 *dest++ = (w >> 16) & 0xFFFF;

264 *dest++ = (w >> 16) & 0xFFFF;

252 *dest++ = (w >> 32) & 0xFFFF;

265 *dest++ = (w >> 32) & 0xFFFF;

changelogdeleted−41

@@ -1,41 +0,0 @@

1−1.1.0.0

2−

3− * encodeUtf8: Performance is improved by up to 4x.

4−

5− * encodeUtf8Builder, encodeUtf8BuilderEscaped: new functions,

6− available only if bytestring >= 0.10.4.0 is installed, that

7− allow very fast and flexible encoding of a Text value to a

8− bytestring Builder.

9−

10− As an example of the performance gain to be had, the

11− encodeUtf8BuilderEscaped function helps to double the speed

12− of JSON encoding in the latest version of aeson! (Note: if

13− all you need is a plain ByteString, encodeUtf8 is still the

14− faster way to go.)

15−

16− * All of the internal module hierarchy is now publicly

17− exposed. If a module is in the .Internal hierarchy, or is

18− documented as internal, use at your own risk - there are no

19− API stability guarantees for internal modules!

20−

21−1.0.0.1

22−

23− * decodeUtf8: Fixed a regression that caused us to incorrectly

24− identify truncated UTF-8 as valid (gh-61)

25−

26−1.0.0.0

27−

28− * Added support for Unicode 6.3.0 to case conversion functions

29−

30− * New function toTitle converts words in a string to title case

31−

32− * New functions peekCStringLen and withCStringLen simplify

33− interoperability with C functionns

34−

35− * Added support for decoding UTF-8 in stream-friendly fashion

36−

37− * Fixed a bug in mapAccumL

38−

39− * Added trusted Haskell support

40−

41− * Removed support for GHC 6.10 (released in 2008) and older

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

scripts/CaseFolding.hs+1−1

@@ -37,7 +37,7 @@ mapCF :: CaseFolding -> [String]

37mapCF (CF _ ms) = typ ++ (map nice . filter p $ ms) ++ [last]

38 where

39 typ = ["foldMapping :: forall s. Char -> s -> Step (CC s) Char"

40− ,"{-# INLINE foldMapping #-}"]

40+ ,"{-# NOINLINE foldMapping #-}"]

41 last = "foldMapping c s = Yield (toLower c) (CC s '\\0' '\\0')"

42 nice c = "-- " ++ name c ++ "\n" ++

43 "foldMapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"

scripts/CaseMapping.hs+3−3

@@ -8,7 +8,7 @@ import SpecialCasing

8main = do

9 args <- getArgs

10 let oname = case args of

11− [] -> "../Data/Text/Fusion/CaseMapping.hs"

11+ [] -> "../Data/Text/Internal/Fusion/CaseMapping.hs"

12 [o] -> o

13 psc <- parseSC "SpecialCasing.txt"

14 pcf <- parseCF "CaseFolding.txt"

@@ -24,10 +24,10 @@ main = do

24 mapM_ (hPutStrLn h) $

25 ["{-# LANGUAGE Rank2Types #-}"

26 ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"

27− ,"-- Generated by scripts/SpecialCasing.hs"] ++

27+ ,"-- Generated by scripts/CaseMapping.hs"] ++

28 comments ++

29 [""

30− ,"module Data.Text.Fusion.CaseMapping where"

30+ ,"module Data.Text.Internal.Fusion.CaseMapping where"

31 ,"import Data.Char"

32 ,"import Data.Text.Internal.Fusion.Types"

33 ,""]

scripts/SpecialCasing.hs+1−1

@@ -43,7 +43,7 @@ mapSC which access twiddle (SC _ ms) =

43 typ ++ (map nice . filter p $ ms) ++ [last]

44 where

45 typ = [which ++ "Mapping :: forall s. Char -> s -> Step (CC s) Char"

46− ,"{-# INLINE " ++ which ++ "Mapping #-}"]

46+ ,"{-# NOINLINE " ++ which ++ "Mapping #-}"]

47 last = which ++ "Mapping c s = Yield (to" ++ ucFirst which ++ " c) (CC s '\\0' '\\0')"

48 nice c = "-- " ++ name c ++ "\n" ++

49 which ++ "Mapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"

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/Makefile+6−1

@@ -1,5 +1,10 @@

1count = 1000

3+all: coverage literal-rule-test

5+literal-rule-test:

6+ ./literal-rule-test.sh

3coverage: build coverage/hpc_index.html

8coverage: build coverage/hpc_index.html

5build: text-test-data

10build: text-test-data

@@ -32,4 +37,4 @@ coverage/hpc_index.html: coverage/coverage.tix

32clean:

37clean:

33 rm -rf dist coverage .hpc

38 rm -rf dist coverage .hpc

35−.PHONY: build coverage

40+.PHONY: build coverage all literal-rule-test

tests/Tests/Properties.hs+167−77

@@ -1,67 +1,61 @@

1−-- | General quicktest properties for the text library

1+-- | QuickCheck properties for the text library.

2−--

3−{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, OverloadedStrings,

3+{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,

4 ScopedTypeVariables, TypeSynonymInstances #-}

5−{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}

5+{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}

6−{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

7module Tests.Properties

6module Tests.Properties

8 (

7 (

9 tests

8 tests

10 ) where

9 ) where

12−import Test.QuickCheck hiding ((.&.))

13−import Test.QuickCheck.Monadic

14−import Text.Show.Functions ()

15−

16import Control.Applicative ((<$>), (<*>))

11import Control.Applicative ((<$>), (<*>))

17import Control.Arrow ((***), second)

12import Control.Arrow ((***), second)

18−import Control.Exception (catch)

19import Data.Bits ((.&.))

13import Data.Bits ((.&.))

20import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)

14import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)

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

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

22import Data.Monoid (Monoid(..))

16import Data.Monoid (Monoid(..))

23−import Data.String (fromString)

17+import Data.String (IsString(fromString))

24import Data.Text.Encoding.Error

18import Data.Text.Encoding.Error

25import Data.Text.Foreign

19import Data.Text.Foreign

26import Data.Text.Internal.Encoding.Utf8

20import Data.Text.Internal.Encoding.Utf8

27import Data.Text.Internal.Fusion.Size

21import Data.Text.Internal.Fusion.Size

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

28import Data.Text.Lazy.Read as TL

23import Data.Text.Lazy.Read as TL

29import Data.Text.Read as T

24import Data.Text.Read as T

30−import Data.Text.Internal.Search (indices)

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

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

32−import Numeric (showHex)

26+import Numeric (showEFloat, showFFloat, showGFloat, showHex)

27+import Prelude hiding (replicate)

33import Test.Framework (Test, testGroup)

28import Test.Framework (Test, testGroup)

34import Test.Framework.Providers.QuickCheck2 (testProperty)

29import 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

35import qualified Data.Bits as Bits (shiftL, shiftR)

37import qualified Data.Bits as Bits (shiftL, shiftR)

36import qualified Data.ByteString as B

38import qualified Data.ByteString as B

37import qualified Data.ByteString.Lazy as BL

39import qualified Data.ByteString.Lazy as BL

38import qualified Data.List as L

40import qualified Data.List as L

39import qualified Data.Text as T

41import qualified Data.Text as T

40import qualified Data.Text.Encoding as E

42import qualified Data.Text.Encoding as E

43+import qualified Data.Text.IO as T

41import qualified Data.Text.Internal.Fusion as S

44import qualified Data.Text.Internal.Fusion as S

42import qualified Data.Text.Internal.Fusion.Common as S

45import qualified Data.Text.Internal.Fusion.Common as S

43−import qualified Data.Text.IO as T

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

44import qualified Data.Text.Lazy as TL

49import qualified Data.Text.Lazy as TL

45import qualified Data.Text.Lazy.Builder as TB

50import qualified Data.Text.Lazy.Builder as TB

46import qualified Data.Text.Lazy.Builder.Int as TB

51import qualified Data.Text.Lazy.Builder.Int as TB

47import qualified Data.Text.Lazy.Builder.RealFloat as TB

52import qualified Data.Text.Lazy.Builder.RealFloat as TB

48import qualified Data.Text.Lazy.Encoding as EL

53import qualified Data.Text.Lazy.Encoding as EL

49−import qualified Data.Text.Internal.Lazy.Fusion as SL

50import qualified Data.Text.Lazy.IO as TL

54import qualified Data.Text.Lazy.IO as TL

51−import qualified Data.Text.Internal.Lazy.Search as S (indices)

52−import qualified Data.Text.Internal.Unsafe.Shift as U

53import qualified System.IO as IO

55import qualified System.IO as IO

54−

56+import qualified Tests.Properties.Mul as Mul

55−import Tests.QuickCheckUtils

56−import Tests.Utils

57import qualified Tests.SlowFunctions as Slow

59−#if MIN_VERSION_base(4,6,0)

60−import Prelude hiding (replicate)

61−#else

62−import Prelude hiding (catch, replicate)

63−#endif

64−

65t_pack_unpack = (T.unpack . T.pack) `eq` id

59t_pack_unpack = (T.unpack . T.pack) `eq` id

66tl_pack_unpack = (TL.unpack . TL.pack) `eq` id

60tl_pack_unpack = (TL.unpack . TL.pack) `eq` id

67t_stream_unstream = (S.unstream . S.stream) `eq` id

61t_stream_unstream = (S.unstream . S.stream) `eq` id

@@ -101,17 +95,23 @@ tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id

101t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id

95t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id

102tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id

96tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id

103

104−t_utf8_incr = do

98+t_utf8_incr = forAll genUnicode $ \s (Positive n) -> (recode n `eq` id) s

105− Positive n <- arbitrary

106− forAll genUnicode $ recode n `eq` id

107− where recode n = T.concat . feedChunksOf n E.streamDecodeUtf8 . E.encodeUtf8

99+ where recode n = T.concat . map fst . feedChunksOf n E.streamDecodeUtf8 .

100+ E.encodeUtf8

101+

108− feedChunksOf :: Int -> (B.ByteString -> E.Decoding) -> B.ByteString

102+feedChunksOf :: Int -> (B.ByteString -> E.Decoding) -> B.ByteString

109− -> [T.Text]

103+ -> [(T.Text, B.ByteString)]

110− feedChunksOf n f bs

104+feedChunksOf n f bs

111− | B.null bs = []

105+ | B.null bs = []

112− | otherwise = let (a,b) = B.splitAt n bs

106+ | otherwise = let (x,y) = B.splitAt n bs

113− E.Some t _ f' = f a

107+ E.Some t b f' = f x

114− in t : feedChunksOf n f' b

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

116data Badness = Solo | Leading | Trailing

117 deriving (Eq, Show)

@@ -126,11 +126,11 @@ t_utf8_err bad de = do

126 Leading -> B.append <$> genInvalidUTF8 <*> genUTF8

127 Trailing -> B.append <$> genUTF8 <*> genInvalidUTF8

128 genUTF8 = E.encodeUtf8 <$> genUnicode

129− forAll gen $ \bs -> do

129+ forAll gen $ \bs -> MkProperty $ do

130 onErr <- genDecodeErr de

131− monadicIO $ do

131+ unProperty . monadicIO $ do

132 l <- run $ let len = T.length (E.decodeUtf8With onErr bs)

133− in (len `seq` return (Right len)) `catch`

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

@@ -197,8 +197,10 @@ t_Show = show `eq` (show . T.pack)

197tl_Show = show `eq` (show . TL.pack)

198t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))

199tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))

200+t_mconcat = unsquare $

200−t_mconcat = mconcat `eq` (unpackS . mconcat . L.map T.pack)

201+ mconcat `eq` (unpackS . mconcat . L.map T.pack)

202+tl_mconcat = unsquare $

201−tl_mconcat = mconcat `eq` (unpackS . mconcat . L.map TL.pack)

203+ mconcat `eq` (unpackS . mconcat . L.map TL.pack)

202t_mempty = mempty == (unpackS (mempty :: T.Text))

204t_mempty = mempty == (unpackS (mempty :: T.Text))

203tl_mempty = mempty == (unpackS (mempty :: TL.Text))

205tl_mempty = mempty == (unpackS (mempty :: TL.Text))

204t_IsString = fromString `eqP` (T.unpack . fromString)

206t_IsString = fromString `eqP` (T.unpack . fromString)

@@ -262,11 +264,14 @@ s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)

262sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)

264sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)

263t_map f = map f `eqP` (unpackS . T.map f)

265t_map f = map f `eqP` (unpackS . T.map f)

264tl_map f = map f `eqP` (unpackS . TL.map f)

266tl_map f = map f `eqP` (unpackS . TL.map f)

267+s_intercalate c = unsquare $

265−s_intercalate c = L.intercalate c `eq`

268+ L.intercalate c `eq`

266 (unpackS . S.intercalate (packS c) . map packS)

269 (unpackS . S.intercalate (packS c) . map packS)

270+t_intercalate c = unsquare $

267−t_intercalate c = L.intercalate c `eq`

271+ L.intercalate c `eq`

268 (unpackS . T.intercalate (packS c) . map packS)

272 (unpackS . T.intercalate (packS c) . map packS)

273+tl_intercalate c = unsquare $

269−tl_intercalate c = L.intercalate c `eq`

274+ L.intercalate c `eq`

270 (unpackS . TL.intercalate (TL.pack c) . map TL.pack)

275 (unpackS . TL.intercalate (TL.pack c) . map TL.pack)

271s_intersperse c = L.intersperse c `eqP`

276s_intersperse c = L.intersperse c `eqP`

272 (unpackS . S.intersperse c)

277 (unpackS . S.intersperse c)

@@ -274,10 +279,14 @@ s_intersperse_s c = L.intersperse c `eqP`

274 (unpackS . S.unstream . S.intersperse c)

279 (unpackS . S.unstream . S.intersperse c)

275sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`

280sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`

276 (unpackS . S.intersperse c . S.filter p)

281 (unpackS . S.intersperse c . S.filter p)

282+t_intersperse c = unsquare $

277−t_intersperse c = L.intersperse c `eqP` (unpackS . T.intersperse c)

283+ L.intersperse c `eqP` (unpackS . T.intersperse c)

284+tl_intersperse c = unsquare $

278−tl_intersperse c = L.intersperse c `eqP` (unpackS . TL.intersperse c)

285+ L.intersperse c `eqP` (unpackS . TL.intersperse c)

286+t_transpose = unsquare $

279−t_transpose = L.transpose `eq` (map unpackS . T.transpose . map packS)

287+ L.transpose `eq` (map unpackS . T.transpose . map packS)

288+tl_transpose = unsquare $

280−tl_transpose = L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)

289+ L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)

281t_reverse = L.reverse `eqP` (unpackS . T.reverse)

290t_reverse = L.reverse `eqP` (unpackS . T.reverse)

282tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)

291tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)

283t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)

292t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)

@@ -374,17 +383,24 @@ sf_foldr p f z = (L.foldr f z . L.filter p) `eqP` (S.foldr f z . S.filter p)

374 where _types = f :: Char -> Char -> Char

383 where _types = f :: Char -> Char -> Char

375t_foldr f z = L.foldr f z `eqP` T.foldr f z

384t_foldr f z = L.foldr f z `eqP` T.foldr f z

376 where _types = f :: Char -> Char -> Char

385 where _types = f :: Char -> Char -> Char

386+tl_foldr f z = unsquare $

377−tl_foldr f z = L.foldr f z `eqP` TL.foldr f z

387+ L.foldr f z `eqP` TL.foldr f z

378 where _types = f :: Char -> Char -> Char

388 where _types = f :: Char -> Char -> Char

389+sf_foldr1 p f = unsquare $

379−sf_foldr1 p f = (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)

390+ (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)

380t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f

391t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f

392+tl_foldr1 f = unsquare $

381−tl_foldr1 f = L.foldr1 f `eqP` TL.foldr1 f

393+ L.foldr1 f `eqP` TL.foldr1 f

382

394

395+s_concat_s = unsquare $

383−s_concat_s = L.concat `eq` (unpackS . S.unstream . S.concat . map packS)

396+ L.concat `eq` (unpackS . S.unstream . S.concat . map packS)

397+sf_concat p = unsquare $

384−sf_concat p = (L.concat . map (L.filter p)) `eq`

398+ (L.concat . map (L.filter p)) `eq`

385 (unpackS . S.concat . map (S.filter p . packS))

399 (unpackS . S.concat . map (S.filter p . packS))

400+t_concat = unsquare $

386−t_concat = L.concat `eq` (unpackS . T.concat . map packS)

401+ L.concat `eq` (unpackS . T.concat . map packS)

402+tl_concat = unsquare $

387−tl_concat = L.concat `eq` (unpackS . TL.concat . map TL.pack)

403+ L.concat `eq` (unpackS . TL.concat . map TL.pack)

388sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`

404sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`

389 (unpackS . S.concatMap (packS . f) . S.filter p)

405 (unpackS . S.concatMap (packS . f) . S.filter p)

390t_concatMap f = unsquare $

406t_concatMap f = unsquare $

@@ -424,6 +440,10 @@ t_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z)

424tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)

440tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)

425 where _types = f :: Int -> Char -> (Int,Char)

441 where _types = f :: Int -> Char -> (Int,Char)

426

442

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+

427replicate n l = concat (L.replicate n l)

447replicate n l = concat (L.replicate n l)

428

448

429s_replicate n = replicate m `eq`

449s_replicate n = replicate m `eq`

@@ -435,6 +455,14 @@ tl_replicate n = replicate m `eq`

435 (unpackS . TL.replicate (fromIntegral m) . packS)

455 (unpackS . TL.replicate (fromIntegral m) . packS)

436 where m = fromIntegral (n :: Word8)

456 where m = fromIntegral (n :: Word8)

437

457

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+

438unf :: Int -> Char -> Maybe (Char, Char)

466unf :: Int -> Char -> Maybe (Char, Char)

439unf n c | fromEnum c * 100 > n = Nothing

467unf n c | fromEnum c * 100 > n = Nothing

440 | otherwise = Just (c, succ c)

468 | otherwise = Just (c, succ c)

@@ -461,14 +489,22 @@ s_take_s m = L.take n `eqP` (unpackS . S.unstream . S.take n)

461sf_take p n = (L.take n . L.filter p) `eqP`

489sf_take p n = (L.take n . L.filter p) `eqP`

462 (unpackS . S.take n . S.filter p)

490 (unpackS . S.take n . S.filter p)

463t_take n = L.take n `eqP` (unpackS . T.take n)

491t_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)

464tl_take n = L.take n `eqP` (unpackS . TL.take (fromIntegral n))

494tl_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)

465s_drop n = L.drop n `eqP` (unpackS . S.drop n)

497s_drop n = L.drop n `eqP` (unpackS . S.drop n)

466s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)

498s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)

467 where n = small m

499 where n = small m

468sf_drop p n = (L.drop n . L.filter p) `eqP`

500sf_drop p n = (L.drop n . L.filter p) `eqP`

469 (unpackS . S.drop n . S.filter p)

501 (unpackS . S.drop n . S.filter p)

470t_drop n = L.drop n `eqP` (unpackS . T.drop n)

502t_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)

471tl_drop n = L.drop n `eqP` (unpackS . TL.drop (fromIntegral n))

505tl_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))

472s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)

508s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)

473 where n = small m

509 where n = small m

474s_take_drop_s m = (L.take n . L.drop n) `eqP`

510s_take_drop_s m = (L.take n . L.drop n) `eqP`

@@ -480,6 +516,10 @@ sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`

480 (unpackS . S.takeWhile p . S.filter q)

516 (unpackS . S.takeWhile p . S.filter q)

481t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)

517t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)

482tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)

518tl_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)

483s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)

523s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)

484s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)

524s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)

485sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`

525sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`

@@ -532,24 +572,27 @@ tl_groupBy p = L.groupBy p `eqP` (map unpackS . TL.groupBy p)

532t_inits = L.inits `eqP` (map unpackS . T.inits)

572t_inits = L.inits `eqP` (map unpackS . T.inits)

533tl_inits = L.inits `eqP` (map unpackS . TL.inits)

573tl_inits = L.inits `eqP` (map unpackS . TL.inits)

534t_tails = L.tails `eqP` (map unpackS . T.tails)

574t_tails = L.tails `eqP` (map unpackS . T.tails)

575+tl_tails = unsquare $

535−tl_tails = L.tails `eqP` (map unpackS . TL.tails)

576+ L.tails `eqP` (map unpackS . TL.tails)

536−t_findAppendId (NotEmpty s) = unsquare $ \ts ->

577+t_findAppendId = unsquare $ \(NotEmpty s) ts ->

537 let t = T.intercalate s ts

578 let t = T.intercalate s ts

538 in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)

579 in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)

539−tl_findAppendId (NotEmpty s) = unsquare $ \ts ->

580+tl_findAppendId = unsquare $ \(NotEmpty s) ts ->

540 let t = TL.intercalate s ts

581 let t = TL.intercalate s ts

541 in all (==t) $ map (uncurry TL.append) (TL.breakOnAll s t)

582 in all (==t) $ map (uncurry TL.append) (TL.breakOnAll s t)

583+t_findContains = unsquare $ \(NotEmpty s) ->

542−t_findContains (NotEmpty s) = all (T.isPrefixOf s . snd) . T.breakOnAll s .

584+ all (T.isPrefixOf s . snd) . T.breakOnAll s . T.intercalate s

543− T.intercalate s

544−tl_findContains (NotEmpty s) = all (TL.isPrefixOf s . snd) .

585+tl_findContains = unsquare $ \(NotEmpty s) -> all (TL.isPrefixOf s . snd) .

545 TL.breakOnAll s . TL.intercalate s

586 TL.breakOnAll s . TL.intercalate s

546sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c

587sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c

547t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s

588t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s

548tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s

589tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s

549

590

591+t_splitOn_split s = unsquare $

550−t_splitOn_split s = (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s

592+ (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s

593+tl_splitOn_split s = unsquare $

551−tl_splitOn_split s = ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`

594+ ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`

552− (map TL.fromStrict . T.splitOn s)) . T.intercalate s

595+ (map TL.fromStrict . T.splitOn s)) . T.intercalate s

553t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)

596t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)

554tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)

597tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)

555

598

@@ -591,10 +634,14 @@ t_lines' = lines' `eqP` (map unpackS . T.lines')

591t_words = L.words `eqP` (map unpackS . T.words)

634t_words = L.words `eqP` (map unpackS . T.words)

592

635

593tl_words = L.words `eqP` (map unpackS . TL.words)

636tl_words = L.words `eqP` (map unpackS . TL.words)

637+t_unlines = unsquare $

594−t_unlines = L.unlines `eq` (unpackS . T.unlines . map packS)

638+ L.unlines `eq` (unpackS . T.unlines . map packS)

639+tl_unlines = unsquare $

595−tl_unlines = L.unlines `eq` (unpackS . TL.unlines . map packS)

640+ L.unlines `eq` (unpackS . TL.unlines . map packS)

641+t_unwords = unsquare $

596−t_unwords = L.unwords `eq` (unpackS . T.unwords . map packS)

642+ L.unwords `eq` (unpackS . T.unwords . map packS)

643+tl_unwords = unsquare $

597−tl_unwords = L.unwords `eq` (unpackS . TL.unwords . map packS)

644+ L.unwords `eq` (unpackS . TL.unwords . map packS)

598

645

599s_isPrefixOf s = L.isPrefixOf s `eqP`

646s_isPrefixOf s = L.isPrefixOf s `eqP`

600 (S.isPrefixOf (S.stream $ packS s) . S.stream)

647 (S.isPrefixOf (S.stream $ packS s) . S.stream)

@@ -671,8 +718,9 @@ t_indices (NotEmpty s) = Slow.indices s `eq` indices s

671tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s

718tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s

672 where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)

719 where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)

673 conc = T.concat . TL.toChunks

720 conc = T.concat . TL.toChunks

674−t_indices_occurs (NotEmpty t) ts = let s = T.intercalate t ts

721+t_indices_occurs = unsquare $ \(NotEmpty t) ts ->

722+ let s = T.intercalate t ts

675− in Slow.indices t s == indices t s

723+ in Slow.indices t s == indices t s

676

724

677-- Bit shifts.

725-- Bit shifts.

678shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k

726shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k

@@ -708,6 +756,7 @@ tb_decimal :: (Integral a, Show a) => a -> Bool

708tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)

756tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)

709

757

710tb_decimal_integer (a::Integer) = tb_decimal a

758tb_decimal_integer (a::Integer) = tb_decimal a

759+tb_decimal_integer_big (Big a) = tb_decimal a

711tb_decimal_int (a::Int) = tb_decimal a

760tb_decimal_int (a::Int) = tb_decimal a

712tb_decimal_int8 (a::Int8) = tb_decimal a

761tb_decimal_int8 (a::Int8) = tb_decimal a

713tb_decimal_int16 (a::Int16) = tb_decimal a

762tb_decimal_int16 (a::Int16) = tb_decimal a

@@ -719,6 +768,11 @@ tb_decimal_word16 (a::Word16) = tb_decimal a

719tb_decimal_word32 (a::Word32) = tb_decimal a

768tb_decimal_word32 (a::Word32) = tb_decimal a

720tb_decimal_word64 (a::Word64) = tb_decimal a

769tb_decimal_word64 (a::Word64) = tb_decimal a

721

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+

722tb_hex :: (Integral a, Show a) => a -> Bool

776tb_hex :: (Integral a, Show a) => a -> Bool

723tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")

777tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")

724

778

@@ -740,6 +794,21 @@ tb_realfloat = (TB.toLazyText . TB.realFloat) `eq` (TL.pack . show)

740tb_realfloat_float (a::Float) = tb_realfloat a

794tb_realfloat_float (a::Float) = tb_realfloat a

741tb_realfloat_double (a::Double) = tb_realfloat a

795tb_realfloat_double (a::Double) = tb_realfloat a

742

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+

743-- Reading.

812-- Reading.

744

813

745t_decimal (n::Int) s =

814t_decimal (n::Int) s =

@@ -748,16 +817,18 @@ t_decimal (n::Int) s =

748tl_decimal (n::Int) s =

817tl_decimal (n::Int) s =

749 TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)

818 TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)

750 where t = TL.dropWhile isDigit s

819 where t = TL.dropWhile isDigit s

751−t_hexadecimal (n::Positive Int) s ox =

820+t_hexadecimal m s ox =

752 T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)

821 T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)

753 where t = T.dropWhile isHexDigit s

822 where t = T.dropWhile isHexDigit s

754 p = if ox then "0x" else ""

823 p = if ox then "0x" else ""

755−tl_hexadecimal (n::Positive Int) s ox =

824+ n = getPositive m :: Int

825+tl_hexadecimal m s ox =

756 TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)

826 TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)

757 where t = TL.dropWhile isHexDigit s

827 where t = TL.dropWhile isHexDigit s

758 p = if ox then "0x" else ""

828 p = if ox then "0x" else ""

829+ n = getPositive m :: Int

759

830

760−isFloaty c = c `elem` "+-.0123456789eE"

831+isFloaty c = c `elem` ("+-.0123456789eE" :: String)

761

832

762t_read_rational p tol (n::Double) s =

833t_read_rational p tol (n::Double) s =

763 case p (T.pack (show n) `T.append` t) of

834 case p (T.pack (show n) `T.append` t) of

@@ -839,6 +910,7 @@ tests =

839 testProperty "t_utf8" t_utf8,

910 testProperty "t_utf8" t_utf8,

840 testProperty "t_utf8'" t_utf8',

911 testProperty "t_utf8'" t_utf8',

841 testProperty "t_utf8_incr" t_utf8_incr,

912 testProperty "t_utf8_incr" t_utf8_incr,

913+ testProperty "t_utf8_undecoded" t_utf8_undecoded,

842 testProperty "tl_utf8" tl_utf8,

914 testProperty "tl_utf8" tl_utf8,

843 testProperty "tl_utf8'" tl_utf8',

915 testProperty "tl_utf8'" tl_utf8',

844 testProperty "t_utf16LE" t_utf16LE,

916 testProperty "t_utf16LE" t_utf16LE,

@@ -1038,9 +1110,12 @@ tests =

1038 ],

1110 ],

1039

1111

1040 testGroup "unfolds" [

1112 testGroup "unfolds" [

1113+ testProperty "tl_repeat" tl_repeat,

1041 testProperty "s_replicate" s_replicate,

1114 testProperty "s_replicate" s_replicate,

1042 testProperty "t_replicate" t_replicate,

1115 testProperty "t_replicate" t_replicate,

1043 testProperty "tl_replicate" tl_replicate,

1116 testProperty "tl_replicate" tl_replicate,

1117+ testProperty "tl_cycle" tl_cycle,

1118+ testProperty "tl_iterate" tl_iterate,

1044 testProperty "t_unfoldr" t_unfoldr,

1119 testProperty "t_unfoldr" t_unfoldr,

1045 testProperty "tl_unfoldr" tl_unfoldr,

1120 testProperty "tl_unfoldr" tl_unfoldr,

1046 testProperty "t_unfoldrN" t_unfoldrN,

1121 testProperty "t_unfoldrN" t_unfoldrN,

@@ -1054,12 +1129,16 @@ tests =

1054 testProperty "s_take_s" s_take_s,

1129 testProperty "s_take_s" s_take_s,

1055 testProperty "sf_take" sf_take,

1130 testProperty "sf_take" sf_take,

1056 testProperty "t_take" t_take,

1131 testProperty "t_take" t_take,

1132+ testProperty "t_takeEnd" t_takeEnd,

1057 testProperty "tl_take" tl_take,

1133 testProperty "tl_take" tl_take,

1134+ testProperty "tl_takeEnd" tl_takeEnd,

1058 testProperty "s_drop" s_drop,

1135 testProperty "s_drop" s_drop,

1059 testProperty "s_drop_s" s_drop_s,

1136 testProperty "s_drop_s" s_drop_s,

1060 testProperty "sf_drop" sf_drop,

1137 testProperty "sf_drop" sf_drop,

1061 testProperty "t_drop" t_drop,

1138 testProperty "t_drop" t_drop,

1139+ testProperty "t_dropEnd" t_dropEnd,

1062 testProperty "tl_drop" tl_drop,

1140 testProperty "tl_drop" tl_drop,

1141+ testProperty "tl_dropEnd" tl_dropEnd,

1063 testProperty "s_take_drop" s_take_drop,

1142 testProperty "s_take_drop" s_take_drop,

1064 testProperty "s_take_drop_s" s_take_drop_s,

1143 testProperty "s_take_drop_s" s_take_drop_s,

1065 testProperty "s_takeWhile" s_takeWhile,

1144 testProperty "s_takeWhile" s_takeWhile,

@@ -1067,6 +1146,8 @@ tests =

1067 testProperty "sf_takeWhile" sf_takeWhile,

1146 testProperty "sf_takeWhile" sf_takeWhile,

1068 testProperty "t_takeWhile" t_takeWhile,

1147 testProperty "t_takeWhile" t_takeWhile,

1069 testProperty "tl_takeWhile" tl_takeWhile,

1148 testProperty "tl_takeWhile" tl_takeWhile,

1149+ testProperty "t_takeWhileEnd" t_takeWhileEnd,

1150+ testProperty "tl_takeWhileEnd" tl_takeWhileEnd,

1070 testProperty "sf_dropWhile" sf_dropWhile,

1151 testProperty "sf_dropWhile" sf_dropWhile,

1071 testProperty "s_dropWhile" s_dropWhile,

1152 testProperty "s_dropWhile" s_dropWhile,

1072 testProperty "s_dropWhile_s" s_dropWhile_s,

1153 testProperty "s_dropWhile_s" s_dropWhile_s,

@@ -1212,11 +1293,16 @@ tests =

1212 testProperty "tb_decimal_int32" tb_decimal_int32,

1293 testProperty "tb_decimal_int32" tb_decimal_int32,

1213 testProperty "tb_decimal_int64" tb_decimal_int64,

1294 testProperty "tb_decimal_int64" tb_decimal_int64,

1214 testProperty "tb_decimal_integer" tb_decimal_integer,

1295 testProperty "tb_decimal_integer" tb_decimal_integer,

1296+ testProperty "tb_decimal_integer_big" tb_decimal_integer_big,

1215 testProperty "tb_decimal_word" tb_decimal_word,

1297 testProperty "tb_decimal_word" tb_decimal_word,

1216 testProperty "tb_decimal_word8" tb_decimal_word8,

1298 testProperty "tb_decimal_word8" tb_decimal_word8,

1217 testProperty "tb_decimal_word16" tb_decimal_word16,

1299 testProperty "tb_decimal_word16" tb_decimal_word16,

1218 testProperty "tb_decimal_word32" tb_decimal_word32,

1300 testProperty "tb_decimal_word32" tb_decimal_word32,

1219− testProperty "tb_decimal_word64" tb_decimal_word64

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

1220 ],

1306 ],

1221 testGroup "hexadecimal" [

1307 testGroup "hexadecimal" [

1222 testProperty "tb_hexadecimal_int" tb_hexadecimal_int,

1308 testProperty "tb_hexadecimal_int" tb_hexadecimal_int,

@@ -1233,7 +1319,9 @@ tests =

1233 ],

1319 ],

1234 testGroup "realfloat" [

1320 testGroup "realfloat" [

1235 testProperty "tb_realfloat_double" tb_realfloat_double,

1321 testProperty "tb_realfloat_double" tb_realfloat_double,

1236− testProperty "tb_realfloat_float" tb_realfloat_float

1322+ testProperty "tb_realfloat_float" tb_realfloat_float,

1323+ testProperty "tb_formatRealFloat_float" tb_formatRealFloat_float,

1324+ testProperty "tb_formatRealFloat_double" tb_formatRealFloat_double

1237 ],

1325 ],

1238 testProperty "tb_fromText" tb_fromText,

1326 testProperty "tb_fromText" tb_fromText,

1239 testProperty "tb_singleton" tb_singleton

1327 testProperty "tb_singleton" tb_singleton

@@ -1269,5 +1357,7 @@ tests =

1269 testProperty "t_take_drop_16" t_take_drop_16,

1357 testProperty "t_take_drop_16" t_take_drop_16,

1270 testProperty "t_use_from" t_use_from,

1358 testProperty "t_use_from" t_use_from,

1271 testProperty "t_copy" t_copy

1359 testProperty "t_copy" t_copy

1272− ]

1360+ ],

1361+

1362+ testGroup "mul" Mul.tests

1273 ]

1363 ]

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/QuickCheckUtils.hs+76−74

@@ -10,48 +10,61 @@ module Tests.QuickCheckUtils

10 , unsquare

11 , smallArbitrary

13+ , BigBounded(..)

14+ , BigInt(..)

13− , NotEmpty (..)

15+ , NotEmpty(..)

15− , Small (..)

17+ , Small(..)

16 , small

18 , small

20+ , Precision(..)

21+ , precision

22+

18 , integralRandomR

23 , integralRandomR

20− , DecodeErr (..)

25+ , DecodeErr(..)

21 , genDecodeErr

26 , genDecodeErr

23− , Stringy (..)

28+ , Stringy(..)

24 , eq

29 , eq

25 , eqP

30 , eqP

27− , Encoding (..)

32+ , Encoding(..)

29 , write_read

34 , write_read

30 ) where

35 ) where

37+import Control.Applicative ((<$>))

32import Control.Arrow (first, (***))

38import Control.Arrow (first, (***))

33import Control.DeepSeq (NFData (..), deepseq)

39import Control.DeepSeq (NFData (..), deepseq)

34import Control.Exception (bracket)

40import Control.Exception (bracket)

35−import Data.Bits ((.&.))

36−import Data.Char (chr)

37−import Data.Word (Word8, Word16)

38import Data.String (IsString, fromString)

41import Data.String (IsString, fromString)

39import Data.Text.Foreign (I16)

42import Data.Text.Foreign (I16)

43+import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))

44+import Data.Word (Word8, Word16)

40import Debug.Trace (trace)

45import Debug.Trace (trace)

41−import System.Random (Random (..), RandomGen)

46+import System.Random (Random(..), RandomGen)

42−import Test.QuickCheck hiding ((.&.))

47+import Test.QuickCheck hiding (Fixed(..), Small (..), (.&.))

43import Test.QuickCheck.Monadic (assert, monadicIO, run)

48import Test.QuickCheck.Monadic (assert, monadicIO, run)

49+import Test.QuickCheck.Unicode (string)

50+import Tests.Utils

44import qualified Data.ByteString as B

51import qualified Data.ByteString as B

45import qualified Data.Text as T

52import qualified Data.Text as T

46import qualified Data.Text.Encoding.Error as T

53import qualified Data.Text.Encoding.Error as T

47import qualified Data.Text.Internal.Fusion as TF

54import qualified Data.Text.Internal.Fusion as TF

48import qualified Data.Text.Internal.Fusion.Common as TF

55import qualified Data.Text.Internal.Fusion.Common as TF

49−import qualified Data.Text.Lazy as TL

50−import qualified Data.Text.Internal.Lazy.Fusion as TLF

51import qualified Data.Text.Internal.Lazy as TL

56import qualified Data.Text.Internal.Lazy as TL

57+import qualified Data.Text.Internal.Lazy.Fusion as TLF

58+import qualified Data.Text.Lazy as TL

52import qualified System.IO as IO

59import qualified System.IO as IO

54−import 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

56instance Random I16 where

69instance Random I16 where

57 randomR = integralRandomR

70 randomR = integralRandomR

@@ -66,60 +79,22 @@ instance Arbitrary B.ByteString where

66 shrink = map B.pack . shrink . B.unpack

79 shrink = map B.pack . shrink . B.unpack

68#if !MIN_VERSION_base(4,4,0)

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+

69instance Random Word8 where

90instance Random Word8 where

70 randomR = integralRandomR

91 randomR = integralRandomR

71 random = randomR (minBound,maxBound)

92 random = randomR (minBound,maxBound)

72−#endif

74−genUnicode :: IsString a => Gen a

94+instance Random Word64 where

75−genUnicode = fmap fromString string where

95+ randomR = integralRandomR

76− string = sized $ \n ->

96+ random = randomR (minBound,maxBound)

77− do k <- choose (0,n)

97+#endif

78− sequence [ char | _ <- [1..k] ]

79−

80− excluding :: [a -> Bool] -> Gen a -> Gen a

81− excluding bad gen = loop

82− where

83− loop = do

84− x <- gen

85− if or (map ($ x) bad)

86− then loop

87− else return x

88−

89− reserved = [lowSurrogate, highSurrogate, noncharacter]

90− lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF

91− highSurrogate c = c >= 0xD800 && c <= 0xDBFF

92− noncharacter c = masked == 0xFFFE || masked == 0xFFFF

93− where

94− masked = c .&. 0xFFFF

95−

96− ascii = choose (0,0x7F)

97− plane0 = choose (0xF0, 0xFFFF)

98− plane1 = oneof [ choose (0x10000, 0x10FFF)

99− , choose (0x11000, 0x11FFF)

100− , choose (0x12000, 0x12FFF)

101− , choose (0x13000, 0x13FFF)

102− , choose (0x1D000, 0x1DFFF)

103− , choose (0x1F000, 0x1FFFF)

104− ]

105− plane2 = oneof [ choose (0x20000, 0x20FFF)

106− , choose (0x21000, 0x21FFF)

107− , choose (0x22000, 0x22FFF)

108− , choose (0x23000, 0x23FFF)

109− , choose (0x24000, 0x24FFF)

110− , choose (0x25000, 0x25FFF)

111− , choose (0x26000, 0x26FFF)

112− , choose (0x27000, 0x27FFF)

113− , choose (0x28000, 0x28FFF)

114− , choose (0x29000, 0x29FFF)

115− , choose (0x2A000, 0x2AFFF)

116− , choose (0x2B000, 0x2BFFF)

117− , choose (0x2F000, 0x2FFFF)

118− ]

119− plane14 = choose (0xE0000, 0xE0FFF)

120− planes = [ascii, plane0, plane1, plane2, plane14]

121−

122− char = chr `fmap` excluding reserved (oneof planes)

123

124-- For tests that have O(n^2) running times or input sizes, resize

99-- For tests that have O(n^2) running times or input sizes, resize

125-- their inputs to the square root of the originals.

100-- their inputs to the square root of the originals.

@@ -138,6 +113,20 @@ instance Arbitrary TL.Text where

138 arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary

113 arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary

139 shrink = map TL.pack . shrink . TL.unpack

114 shrink = map TL.pack . shrink . TL.unpack

140

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)

129+

141newtype NotEmpty a = NotEmpty { notEmpty :: a }

130newtype NotEmpty a = NotEmpty { notEmpty :: a }

142 deriving (Eq, Ord)

131 deriving (Eq, Ord)

143

132

@@ -278,6 +267,30 @@ eqP f g s w = eql "orig" (f s) (g t) &&

278 | a =^= b = True

267 | a =^= b = True

279 | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False

268 | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False

280

269

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+

281-- Work around lack of Show instance for TextEncoding.

294-- Work around lack of Show instance for TextEncoding.

282data Encoding = E String IO.TextEncoding

295data Encoding = E String IO.TextEncoding

283

296

@@ -295,17 +308,6 @@ windowsNewlineMode = IO.NewlineMode

295 { IO.inputNL = IO.CRLF, IO.outputNL = IO.CRLF

308 { IO.inputNL = IO.CRLF, IO.outputNL = IO.CRLF

296 }

309 }

297

310

298−-- Newline and NewlineMode have standard Show instance from GHC 7 onwards

299−#if __GLASGOW_HASKELL__ < 700

300−instance Show IO.Newline where

301− show IO.CRLF = "CRLF"

302− show IO.LF = "LF"

303−

304−instance Show IO.NewlineMode where

305− show (IO.NewlineMode i o) = "NewlineMode { inputNL = " ++ show i ++

306− ", outputNL = " ++ show o ++ " }"

307−# endif

308−

309instance Arbitrary IO.NewlineMode where

311instance Arbitrary IO.NewlineMode where

310 arbitrary = oneof . map return $

312 arbitrary = oneof . map return $

311 [ IO.noNewlineTranslation, IO.universalNewlineMode, IO.nativeNewlineMode

313 [ IO.noNewlineTranslation, IO.universalNewlineMode, IO.nativeNewlineMode

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/text-tests.cabal+18−3

@@ -2,8 +2,8 @@ name: text-tests

2version: 0.0.0.0

3synopsis: Functional tests for the text package

4description: Functional tests for the text package

5−homepage: https://bitbucket.org/bos/text

5+homepage: https://github.com/bos/text

6−license: BSD3

6+license: BSD2

7license-file: ../LICENSE

8author: Jasper Van der Jeugt <jaspervdj@gmail.com>,

9 Bryan O'Sullivan <bos@serpentine.com>,

@@ -18,10 +18,20 @@ cabal-version: >=1.8

18flag hpc

19 description: Enable HPC to generate coverage reports

20 default: False

21+ manual: True

22executable text-tests

23executable text-tests

23 main-is: Tests.hs

24 main-is: Tests.hs

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+

25 ghc-options:

35 ghc-options:

26 -Wall -threaded -O0 -rtsopts

36 -Wall -threaded -O0 -rtsopts

@@ -36,11 +46,12 @@ executable text-tests

37 build-depends:

47 build-depends:

38 HUnit >= 1.2,

48 HUnit >= 1.2,

39− QuickCheck >= 2.4,

49+ QuickCheck >= 2.7,

40 base == 4.*,

50 base == 4.*,

41 bytestring,

51 bytestring,

42 deepseq,

52 deepseq,

43 directory,

53 directory,

54+ quickcheck-unicode,

44 random,

55 random,

45 test-framework >= 0.4,

56 test-framework >= 0.4,

46 test-framework-hunit >= 0.2,

57 test-framework-hunit >= 0.2,

@@ -66,6 +77,7 @@ library

66 hs-source-dirs: ..

77 hs-source-dirs: ..

67 c-sources: ../cbits/cbits.c

78 c-sources: ../cbits/cbits.c

68 include-dirs: ../include

79 include-dirs: ../include

80+ ghc-options: -Wall

69 exposed-modules:

81 exposed-modules:

70 Data.Text

82 Data.Text

71 Data.Text.Array

83 Data.Text.Array

@@ -102,6 +114,8 @@ library

102 Data.Text.Internal.Lazy.Search

114 Data.Text.Internal.Lazy.Search

103 Data.Text.Internal.Private

115 Data.Text.Internal.Private

104 Data.Text.Read

116 Data.Text.Read

117+ Data.Text.Show

118+ Data.Text.Internal.Read

105 Data.Text.Internal.Search

119 Data.Text.Internal.Search

106 Data.Text.Unsafe

120 Data.Text.Unsafe

107 Data.Text.Internal.Unsafe

121 Data.Text.Internal.Unsafe

@@ -122,6 +136,7 @@ library

122 build-depends:

136 build-depends:

123 array,

137 array,

124 base == 4.*,

138 base == 4.*,

139+ binary,

125 bytestring,

140 bytestring,

126 deepseq,

141 deepseq,

127 ghc-prim,

142 ghc-prim,

text.cabal+30−8

@@ -1,5 +1,5 @@

1name: text

2−version: 1.1.0.0

2+version: 1.2.2.1

3homepage: https://github.com/bos/text

4bug-reports: https://github.com/bos/text/issues

5synopsis: An efficient packed Unicode text type.

@@ -31,7 +31,7 @@ description:

31 the @text-icu@ package:

32 <http://hackage.haskell.org/package/text-icu>

34−license: BSD3

34+license: BSD2

35license-file: LICENSE

36author: Bryan O'Sullivan <bos@serpentine.com>

37maintainer: Bryan O'Sullivan <bos@serpentine.com>

@@ -51,7 +51,7 @@ extra-source-files:

51 benchmarks/python/*.py

52 benchmarks/ruby/*.rb

53 benchmarks/text-benchmarks.cabal

54− changelog

54+ changelog.md

55 include/*.h

56 scripts/*.hs

57 tests-and-benchmarks.markdown

@@ -59,16 +59,25 @@ extra-source-files:

59 tests/.ghci

60 tests/Makefile

61 tests/Tests/*.hs

62+ tests/Tests/Properties/*.hs

63+ tests/cabal.config

62 tests/scripts/*.sh

64 tests/scripts/*.sh

63 tests/text-tests.cabal

65 tests/text-tests.cabal

67+flag bytestring-builder

68+ description: Depend on the bytestring-builder package for backwards compatibility.

69+ default: False

70+ manual: False

71+

65flag developer

72flag developer

66 description: operate in developer mode

73 description: operate in developer mode

67 default: False

74 default: False

75+ manual: True

69flag integer-simple

77flag integer-simple

70 description: Use the simple integer library instead of GMP

78 description: Use the simple integer library instead of GMP

71 default: False

79 default: False

80+ manual: False

73library

82library

74 c-sources: cbits/cbits.c

83 c-sources: cbits/cbits.c

@@ -103,6 +112,7 @@ library

103 Data.Text.Internal.Lazy.Fusion

112 Data.Text.Internal.Lazy.Fusion

104 Data.Text.Internal.Lazy.Search

113 Data.Text.Internal.Lazy.Search

105 Data.Text.Internal.Private

114 Data.Text.Internal.Private

115+ Data.Text.Internal.Read

106 Data.Text.Internal.Search

116 Data.Text.Internal.Search

107 Data.Text.Internal.Unsafe

117 Data.Text.Internal.Unsafe

108 Data.Text.Internal.Unsafe.Char

118 Data.Text.Internal.Unsafe.Char

@@ -118,16 +128,21 @@ library

118 Data.Text.Read

128 Data.Text.Read

119 Data.Text.Unsafe

129 Data.Text.Unsafe

120

130

131+ other-modules:

132+ Data.Text.Show

133+

121 build-depends:

134 build-depends:

122 array >= 0.3,

135 array >= 0.3,

123 base >= 4.2 && < 5,

136 base >= 4.2 && < 5,

137+ binary,

124 deepseq >= 1.1.0.0,

138 deepseq >= 1.1.0.0,

125 ghc-prim >= 0.2

139 ghc-prim >= 0.2

126

140

127− if impl(ghc >= 7.7)

141+ if flag(bytestring-builder)

128− build-depends: bytestring >= 0.10.4.0

142+ build-depends: bytestring >= 0.9 && < 0.10.4,

143+ bytestring-builder >= 0.10.4

129 else

144 else

130− build-depends: bytestring >= 0.9

145+ build-depends: bytestring >= 0.10.4

131

146

132 cpp-options: -DHAVE_DEEPSEQ

147 cpp-options: -DHAVE_DEEPSEQ

133 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2

148 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2

@@ -158,18 +173,25 @@ test-suite tests

158

173

159 build-depends:

174 build-depends:

160 HUnit >= 1.2,

175 HUnit >= 1.2,

161− QuickCheck >= 2.4,

176+ QuickCheck >= 2.7,

162 array,

177 array,

163 base,

178 base,

164− bytestring,

179+ binary,

165 deepseq,

180 deepseq,

166 directory,

181 directory,

167 ghc-prim,

182 ghc-prim,

183+ quickcheck-unicode,

168 random,

184 random,

169 test-framework >= 0.4,

185 test-framework >= 0.4,

170 test-framework-hunit >= 0.2,

186 test-framework-hunit >= 0.2,

171 test-framework-quickcheck2 >= 0.2

187 test-framework-quickcheck2 >= 0.2

172

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+

173 if flag(integer-simple)

195 if flag(integer-simple)

174 cpp-options: -DINTEGER_SIMPLE

196 cpp-options: -DINTEGER_SIMPLE

175 build-depends: integer-simple >= 0.1 && < 0.5

197 build-depends: integer-simple >= 0.1 && < 0.5