master..9b208ec · text

.gitignore−1

since splitsnapshots

unifiedsplit

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

1dist

2cabal-dev

3−cabal.sandbox.config

.hgtags−14

@@ -50,17 +50,3 @@ d99cd091cdf71ce807a4255f6cc509c3154f51ea 0.11.3.1

50fb7299f22449750c653ac64dee4bd63c13ea6e4c 1.1.1.1

51eb170cb533b63534d166b5fd5344b36676adf140 1.1.1.2

52e749e05f715d02445803f653cd3d97d5395d7c6f 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+65−144

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

3#if __GLASGOW_HASKELL__ >= 702

4{-# LANGUAGE Trustworthy #-}

5#endif

6−#if __GLASGOW_HASKELL__ >= 708

7−{-# LANGUAGE TypeFamilies #-}

8−#endif

9

6

10-- |

7-- |

11-- Module : Data.Text

8-- Module : Data.Text

@@ -129,7 +126,6 @@ module Data.Text

129 , drop

126 , drop

130 , dropEnd

127 , dropEnd

131 , takeWhile

128 , takeWhile

132− , takeWhileEnd

133 , dropWhile

129 , dropWhile

134 , dropWhileEnd

130 , dropWhileEnd

135 , dropAround

131 , dropAround

@@ -192,16 +188,15 @@ module Data.Text

192

188

193 -- * Low level operations

189 -- * Low level operations

194 , copy

190 , copy

195− , unpackCString#

196 ) where

191 ) where

197

192

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

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

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

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

200− Read(..),

195+ Read(..), Show(..),

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

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

202− not, return, otherwise, quot)

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

203#if defined(HAVE_DEEPSEQ)

198#if defined(HAVE_DEEPSEQ)

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

199+import Control.DeepSeq (NFData)

205#endif

200#endif

206#if defined(ASSERTS)

201#if defined(ASSERTS)

207import Control.Exception (assert)

202import Control.Exception (assert)

@@ -210,22 +205,15 @@ import Data.Char (isSpace)

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

205import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,

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

206 Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))

212import Control.Monad (foldM)

207import Control.Monad (foldM)

213−import Control.Monad.ST (ST)

214import qualified Data.Text.Array as A

208import qualified Data.Text.Array as A

215import qualified Data.List as L

209import qualified Data.List as L

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

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

210import Data.Monoid (Monoid(..))

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

219−import Data.Semigroup (Semigroup(..))

220−#endif

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

211import Data.String (IsString(..))

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

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

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

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

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

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

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

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

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

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

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

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

229import qualified Prelude as P

217import qualified Prelude as P

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

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

231 reverseIter_, unsafeHead, unsafeTail)

219 reverseIter_, unsafeHead, unsafeTail)

@@ -238,13 +226,12 @@ import Data.ByteString (ByteString)

238import qualified Data.Text.Lazy as L

226import qualified Data.Text.Lazy as L

239import Data.Int (Int64)

227import Data.Int (Int64)

240#endif

228#endif

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

242−#if __GLASGOW_HASKELL__ >= 708

229+#if __GLASGOW_HASKELL__ >= 702

243−import qualified GHC.Exts as Exts

230+import qualified GHC.CString as GHC

244−#endif

231+#else

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

232+import qualified GHC.Base as GHC

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

247#endif

233#endif

234+import GHC.Prim (Addr#)

248

235

249-- $strict

236-- $strict

250--

237--

@@ -330,48 +317,24 @@ instance Eq Text where

330instance Ord Text where

317instance Ord Text where

331 compare = compareText

318 compare = compareText

332

319

320+instance Show Text where

321+ showsPrec p ps r = showsPrec p (unpack ps) r

322+

333instance Read Text where

323instance Read Text where

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

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

335

325

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−

344instance Monoid Text where

326instance Monoid Text where

345 mempty = empty

327 mempty = empty

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

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

348−#else

349 mappend = append

328 mappend = append

350−#endif

351 mconcat = concat

329 mconcat = concat

352

330

353instance IsString Text where

331instance IsString Text where

354 fromString = pack

332 fromString = pack

355

333

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−

363#if defined(HAVE_DEEPSEQ)

334#if defined(HAVE_DEEPSEQ)

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

335+instance NFData Text

365#endif

336#endif

366

337

367−instance Binary Text where

368− put t = put (encodeUtf8 t)

369− get = do

370− bs <- get

371− case decodeUtf8' bs of

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

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

374−

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

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

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

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

377--

340--

@@ -395,12 +358,6 @@ instance Data Text where

395 _ -> P.error "gunfold"

358 _ -> P.error "gunfold"

396 dataTypeOf _ = textDataType

359 dataTypeOf _ = textDataType

397

360

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−

404packConstr :: Constr

361packConstr :: Constr

405packConstr = mkConstr textDataType "pack" [] Prefix

362packConstr = mkConstr textDataType "pack" [] Prefix

406

363

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

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

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

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

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

432

389

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

391+unpack :: Text -> String

392+unpack = S.unstreamList . stream

393+{-# INLINE [1] unpack #-}

394+

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

396+unpackCString# :: Addr# -> Text

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

398+{-# NOINLINE unpackCString# #-}

399+

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

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

402+ = unpackCString# a #-}

403+

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

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

406+ = unpackCString# a #-}

407+

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

409+-- Performs replacement on invalid scalar values.

410+singleton :: Char -> Text

411+singleton = unstream . S.singleton . safe

412+{-# INLINE [1] singleton #-}

413+

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

414-- -----------------------------------------------------------------------------

434-- * Basic functions

415-- * Basic functions

435

416

@@ -460,7 +441,6 @@ append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)

460 | otherwise = overflowError "append"

441 | otherwise = overflowError "append"

461 where

442 where

462 len = len1+len2

443 len = len1+len2

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

464 x = do

444 x = do

465 arr <- A.new len

445 arr <- A.new len

466 A.copyI arr 0 arr1 off1 len1

446 A.copyI arr 0 arr1 off1 len1

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

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

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

487uncons t@(Text arr off len)

467uncons t@(Text arr off len)

488 | len <= 0 = Nothing

468 | len <= 0 = Nothing

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

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

469+ | otherwise = Just (c, text arr (off+d) (len-d))

470+ where Iter c d = iter t 0

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

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

492

472

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

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

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

572-- Subject to fusion.

552-- Subject to fusion.

573length :: Text -> Int

553length :: Text -> Int

574length t = S.length (stream t)

554length t = S.length (stream t)

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

555+{-# INLINE 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.

578

556

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

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

580-- Subject to fusion.

558-- Subject to fusion.

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

593

571

594{-# RULES

572{-# RULES

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

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

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

574+ (==) (length t) n = compareLength t n == EQ

597 #-}

575 #-}

598

576

599{-# RULES

577{-# RULES

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

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

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

579+ (/=) (length t) n = compareLength t n /= EQ

602 #-}

580 #-}

603

581

604{-# RULES

582{-# RULES

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

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

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

584+ (<) (length t) n = compareLength t n == LT

607 #-}

585 #-}

608

586

609{-# RULES

587{-# RULES

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

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

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

589+ (<=) (length t) n = compareLength t n /= GT

612 #-}

590 #-}

613

591

614{-# RULES

592{-# RULES

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

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

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

594+ (>) (length t) n = compareLength t n == GT

617 #-}

595 #-}

618

596

619{-# RULES

597{-# RULES

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

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

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

599+ (>=) (length t) n = compareLength t n /= LT

622 #-}

600 #-}

623

601

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

602-- -----------------------------------------------------------------------------

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

649reverse t = S.reverse (stream t)

627reverse t = S.reverse (stream t)

650{-# INLINE reverse #-}

628{-# INLINE reverse #-}

651

629

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

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

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"

672--

631--

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

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

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

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

675−replace :: Text

634+replace :: Text -> Text -> Text -> 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

683replace needle@(Text _ _ neeLen)

635replace needle@(Text _ _ neeLen)

684 (Text repArr repOff repLen)

636 (Text repArr repOff repLen)

685 haystack@(Text hayArr hayOff hayLen)

637 haystack@(Text hayArr hayOff hayLen)

686 | neeLen == 0 = emptyError "replace"

638 | neeLen == 0 = emptyError "replace"

687 | L.null ixs = haystack

639 | L.null ixs = haystack

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

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

641+ | len < 0 = overflowError "replace"

689 | otherwise = empty

642 | otherwise = empty

690 where

643 where

691 ixs = indices needle haystack

644 ixs = indices needle haystack

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

645+ len = hayLen - (neeLen - repLen) * L.length ixs

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

694 x = do

646 x = do

695 marr <- A.new len

647 marr <- A.new len

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

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

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

741-- instead of itself.

693-- instead of itself.

742toCaseFold :: Text -> Text

694toCaseFold :: Text -> Text

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

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

744−{-# INLINE toCaseFold #-}

696+{-# INLINE [0] toCaseFold #-}

745

697

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

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

747-- conversion. Subject to fusion.

699-- conversion. Subject to fusion.

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

901 where

853 where

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

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

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

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

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

905 go = do

856 go = do

906 arr <- A.new len

857 arr <- A.new len

907 let step i (Text a o l) =

858 let step i (Text a o l) =

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

915{-# INLINE concatMap #-}

866{-# INLINE concatMap #-}

916

867

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

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

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

869+-- 'Text' @t@ satisifes the predicate @p@. Subject to fusion.

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

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

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

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

921{-# INLINE any #-}

872{-# INLINE any #-}

922

873

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

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

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

875+-- 'Text' @t@ satisify the predicate @p@. Subject to fusion.

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

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

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

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

927{-# INLINE all #-}

878{-# INLINE all #-}

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

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

963 | n <= 0 || l <= 0 = empty

1013 | n == 1 = t

964 | n == 1 = t

1014 | isSingleton t = replicateChar n (unsafeHead t)

965 | isSingleton t = replicateChar n (unsafeHead t)

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

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

967+ | otherwise = overflowError "replicate"

1016 where

968 where

1017− len = l `mul` n

969+ len = l * n

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

1019 x = do

970 x = do

1020 arr <- A.new len

971 arr <- A.new len

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

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

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

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

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

1153 #-}

1104 #-}

1154

1105

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−

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

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

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

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

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

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

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

1191 #-}

1121 #-}

1192

1122

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

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

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

1124+-- dropping characters that fail the predicate @p@ from the end of

1195-- @t@. Subject to fusion.

1125-- @t@. Subject to fusion.

1196−--

1197-- Examples:

1126-- Examples:

1198--

1127--

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

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

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

1213 #-}

1142 #-}

1214

1143

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

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

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

1145+-- dropping characters that fail the predicate @p@ from both the

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

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

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

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

1219dropAround p = dropWhile p . dropWhileEnd p

1148dropAround p = dropWhile p . dropWhileEnd p

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

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

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

1309-- are slices of the original.

1238-- are slices of the original.

1310

1239

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

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

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

1241+-- 'Text' argument, consuming the delimiter. An empty delimiter is

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

1242+-- invalid, and will cause an error to be raised.

1314--

1243--

1315-- Examples:

1244-- Examples:

1316--

1245--

@@ -1323,16 +1252,9 @@ tails t | null t = [empty]

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

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

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

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

1325--

1254--

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

1327−--

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

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

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

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

1330−splitOn :: Text

1257+splitOn :: Text -> Text -> [Text]

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

1332− -- will occur.

1333− -> Text

1334− -- ^ Input text.

1335− -> [Text]

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

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

1337 | l <= 0 = emptyError "splitOn"

1259 | l <= 0 = emptyError "splitOn"

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

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

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

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

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

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

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

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

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

1543−{-# INLINE zip #-}

1465+{-# INLINE [0] zip #-}

1544

1466

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

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

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

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

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

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

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

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

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

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

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

1551−{-# INLINE zipWith #-}

1473+{-# INLINE [0] zipWith #-}

1552

1474

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

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

1554-- representing white space.

1476-- representing white space.

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

1748copy :: Text -> Text

1670copy :: Text -> Text

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

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

1750 where

1672 where

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

1752 go = do

1673 go = do

1753 marr <- A.new len

1674 marr <- A.new len

1754 A.copyI marr 0 arr off len

1675 A.copyI marr 0 arr off len

Data/Text/Array.hs+4−5

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

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 qualified

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

24-- naming.

25module Data.Text.Array

26 (

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

74#endif

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

76 indexWord16Array#, newByteArray#,

77− unsafeFreezeByteArray#, writeWord16Array#)

77+ unsafeCoerce#, writeWord16Array#)

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

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

80import Prelude hiding (length, read)

@@ -130,9 +130,8 @@ 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 $ \s1# ->

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

134− case unsafeFreezeByteArray# maBA s1# of

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

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

136#if defined(ASSERTS)

135#if defined(ASSERTS)

137 maLen

136 maLen

138#endif

137#endif

Data/Text/Encoding.hs+23−10

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

55 , encodeUtf32LE

56 , encodeUtf32BE

57

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

58 -- * Encoding Text using ByteString Builders

59 -- * Encoding Text using ByteString Builders

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

61+ -- @bytestring >= 0.10.4.0@.

59 , encodeUtf8Builder

62 , encodeUtf8Builder

60 , encodeUtf8BuilderEscaped

63 , encodeUtf8BuilderEscaped

64+#endif

61 ) where

65 ) where

62

66

63#if __GLASGOW_HASKELL__ >= 702

67#if __GLASGOW_HASKELL__ >= 702

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

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

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

67#endif

71#endif

68

72

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.Internal as B hiding (empty, append)

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

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

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

81+#endif

82+

69import Control.Exception (evaluate, try)

83import Control.Exception (evaluate, try)

70import Control.Monad.ST (runST)

84import Control.Monad.ST (runST)

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

72import Data.ByteString as B

85import Data.ByteString as B

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

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

87+import Data.Text ()

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

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

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

89import Data.Text.Internal (Text(..), safe, text)

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

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

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

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

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

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

79−import Data.Text.Show ()

80import Data.Text.Unsafe (unsafeDupablePerformIO)

93import Data.Text.Unsafe (unsafeDupablePerformIO)

81import Data.Word (Word8, Word32)

94import Data.Word (Word8, Word32)

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

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

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

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

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

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

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

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

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

92import qualified Data.Text.Array as A

101import qualified Data.Text.Array as A

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

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

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

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

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

96

104

97#include "text_cbits.h"

105#include "text_cbits.h"

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

111

119

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

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

113-- encoded text.

121-- encoded text.

122+--

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

114decodeASCII :: ByteString -> Text

124decodeASCII :: ByteString -> Text

115decodeASCII = decodeUtf8

125decodeASCII = decodeUtf8

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

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

@@ -259,7 +269,6 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0

259 UTF8_REJECT -> do

269 UTF8_REJECT -> do

260 -- We encountered an encoding error

270 -- We encountered an encoding error

261 x <- peek curPtr'

271 x <- peek curPtr'

262− poke statePtr 0

263 case onErr desc (Just x) of

272 case onErr desc (Just x) of

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

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

265 Just c -> do

274 Just c -> do

@@ -267,6 +276,7 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0

267 w <- unsafeSTToIO $

276 w <- unsafeSTToIO $

268 unsafeWrite dest (fromIntegral destOff) (safe c)

277 unsafeWrite dest (fromIntegral destOff) (safe c)

269 poke destOffPtr (destOff + fromIntegral w)

278 poke destOffPtr (destOff + fromIntegral w)

279+ poke statePtr 0

270 loop $ curPtr' `plusPtr` 1

280 loop $ curPtr' `plusPtr` 1

271

281

272 _ -> do

282 _ -> do

@@ -278,7 +288,7 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0

278 return $! text arr 0 (fromIntegral n)

288 return $! text arr 0 (fromIntegral n)

279 lastPtr <- peek curPtrPtr

289 lastPtr <- peek curPtrPtr

280 let left = lastPtr `minusPtr` curPtr

290 let left = lastPtr `minusPtr` curPtr

281− !undecoded = case state of

291+ undecoded = case state of

282 UTF8_ACCEPT -> B.empty

292 UTF8_ACCEPT -> B.empty

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

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

284 return $ Some chunkText undecoded

294 return $ Some chunkText undecoded

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

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

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

308{-# INLINE decodeUtf8' #-}

318{-# INLINE decodeUtf8' #-}

309

319

320+#if MIN_VERSION_bytestring(0,10,4)

321+

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

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

311encodeUtf8Builder :: Text -> B.Builder

323encodeUtf8Builder :: Text -> B.Builder

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

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

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

367 outerLoop i (B.BufferRange op ope)

379 outerLoop i (B.BufferRange op ope)

368 where

380 where

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

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

382+#endif

370

383

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

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

372encodeUtf8 :: Text -> ByteString

385encodeUtf8 :: Text -> ByteString

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

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

1{-# LANGUAGE CPP, DeriveDataTypeable #-}

2−#if __GLASGOW_HASKELL__ >= 704

2+#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Safe #-}

4−#elif __GLASGOW_HASKELL__ >= 702

5{-# LANGUAGE Trustworthy #-}

3{-# LANGUAGE Trustworthy #-}

6#endif

4#endif

7-- |

5-- |

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

68type OnDecodeError = OnError Word8 Char

66type OnDecodeError = OnError Word8 Char

69

67

70-- | A handler for an encoding error.

68-- | A handler for an encoding error.

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

72type OnEncodeError = OnError Char Word8

69type OnEncodeError = OnError Char Word8

73

70

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

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

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

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

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

82 deriving (Eq, Typeable)

79 deriving (Eq, Typeable)

83

80

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

85−

86showUnicodeException :: UnicodeException -> String

81showUnicodeException :: UnicodeException -> String

87showUnicodeException (DecodeError desc (Just w))

82showUnicodeException (DecodeError desc (Just w))

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

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

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

112lenientDecode _ _ = Just '\xfffd'

107lenientDecode _ _ = Just '\xfffd'

113

108

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

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

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

116strictEncode :: OnEncodeError

110strictEncode :: OnEncodeError

117strictEncode desc c = throw (EncodeError desc c)

111strictEncode desc c = throw (EncodeError desc c)

118

112

Data/Text/Internal.hs+4−64

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

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

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

2{-# OPTIONS_HADDOCK not-home #-}

3

4-- |

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

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

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

22

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

24−#include "MachDeps.h"

25−#endif

26−

27module Data.Text.Internal

23module Data.Text.Internal

28 (

24 (

29 -- * Types

25 -- * Types

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

36 , safe

32 , safe

37 -- * Code that must be here for accessibility

33 -- * Code that must be here for accessibility

38 , empty

34 , empty

39− , empty_

40 -- * Utilities

35 -- * Utilities

41 , firstf

36 , firstf

42− -- * Checked multiplication

43− , mul

44− , mul32

45− , mul64

46 -- * Debugging

37 -- * Debugging

47 , showText

38 , showText

48 ) where

39 ) where

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

50#if defined(ASSERTS)

41#if defined(ASSERTS)

51import Control.Exception (assert)

42import Control.Exception (assert)

52#endif

43#endif

53−import Data.Bits

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

54−import Data.Int (Int32, Int64)

45+import qualified Data.Text.Array as A

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

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

56import Data.Typeable (Typeable)

47import Data.Typeable (Typeable)

57−import qualified Data.Text.Array as A

58

48

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

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

60data Text = Text

50data Text = Text

@@ -82,11 +72,6 @@ empty :: Text

82empty = Text A.empty 0 0

72empty = Text A.empty 0 0

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

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

84

74

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

86−empty_ :: Text

87−empty_ = Text A.empty 0 0

88−{-# NOINLINE empty_ #-}

89−

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

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

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

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

92text :: A.Array -> Int -> Int -> Text

77text :: A.Array -> Int -> Int -> Text

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

116safe c

101safe c

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

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

118 | otherwise = '\xfffd'

103 | otherwise = '\xfffd'

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

104+{-# INLINE safe #-}

120

105

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

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

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

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

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

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

124firstf _ Nothing = Nothing

109firstf _ Nothing = Nothing

125

110

126−-- | Checked multiplication. Calls 'error' if the result would

127−-- overflow.

128−mul :: Int -> Int -> Int

129−#if WORD_SIZE_IN_BITS == 64

130−mul a b = fromIntegral $ fromIntegral a `mul64` fromIntegral b

131−#else

132−mul a b = fromIntegral $ fromIntegral a `mul32` fromIntegral b

133−#endif

134−{-# INLINE mul #-}

135−infixl 7 `mul`

136−

137−-- | Checked multiplication. Calls 'error' if the result would

138−-- overflow.

139−mul64 :: Int64 -> Int64 -> Int64

140−mul64 a b

141− | a >= 0 && b >= 0 = mul64_ a b

142− | a >= 0 = -mul64_ a (-b)

143− | b >= 0 = -mul64_ (-a) b

144− | otherwise = mul64_ (-a) (-b)

145−{-# INLINE mul64 #-}

146−infixl 7 `mul64`

147−

148−mul64_ :: Int64 -> Int64 -> Int64

149−mul64_ a b

150− | ahi > 0 && bhi > 0 = error "overflow"

151− | top > 0x7fffffff = error "overflow"

152− | total < 0 = error "overflow"

153− | otherwise = total

154− where (# ahi, alo #) = (# a `shiftR` 32, a .&. 0xffffffff #)

155− (# bhi, blo #) = (# b `shiftR` 32, b .&. 0xffffffff #)

156− top = ahi * blo + alo * bhi

157− total = (top `shiftL` 32) + alo * blo

158−{-# INLINE mul64_ #-}

159−

160−-- | Checked multiplication. Calls 'error' if the result would

161−-- overflow.

162−mul32 :: Int32 -> Int32 -> Int32

163−mul32 a b = case fromIntegral a * fromIntegral b of

164− ab | ab < min32 || ab > max32 -> error "overflow"

165− | otherwise -> fromIntegral ab

166− where min32 = -0x80000000 :: Int64

167− max32 = 0x7fffffff

168−{-# INLINE mul32 #-}

169−infixl 7 `mul32`

170−

171-- $internals

111-- $internals

172--

112--

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

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

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

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

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

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

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

10--

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

12-- Stability : experimental

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

58 ) where

59

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

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

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

62import Data.Monoid (Monoid(..))

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

63−import Data.Semigroup (Semigroup(..))

64−#endif

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

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

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

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

67import Data.Text.Unsafe (inlineInterleaveST)

65import Data.Text.Unsafe (inlineInterleaveST)

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

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

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

69import Prelude hiding (map, putChar)

68import Prelude hiding (map, putChar)

70

69

71import qualified Data.String as String

70import qualified Data.String as String

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

92 -> ST s [S.Text]

91 -> ST s [S.Text]

93 }

92 }

94

93

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

96−instance Semigroup Builder where

97− (<>) = append

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

99−#endif

100−

101instance Monoid Builder where

94instance Monoid Builder where

102 mempty = empty

95 mempty = empty

103 {-# INLINE mempty #-}

96 {-# INLINE mempty #-}

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

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

106−#else

107 mappend = append

97 mappend = append

108−#endif

109 {-# INLINE mappend #-}

98 {-# INLINE mappend #-}

110− mconcat = foldr mappend Data.Monoid.mempty

99+ mconcat = foldr mappend mempty

111 {-# INLINE mconcat #-}

100 {-# INLINE mconcat #-}

112

101

113instance String.IsString Builder where

102instance String.IsString Builder where

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

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

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

139--

128--

140singleton :: Char -> Builder

129singleton :: Char -> Builder

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

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

131+ if n < 0x10000

132+ then A.unsafeWrite marr o (fromIntegral n) >> return 1

133+ else do

134+ A.unsafeWrite marr o lo

135+ A.unsafeWrite marr (o+1) hi

136+ return 2

137+ where n = ord c

138+ m = n - 0x10000

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

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

142{-# INLINE singleton #-}

141{-# INLINE singleton #-}

143

142

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

143------------------------------------------------------------------------

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

242 !t = Text arr o u

241 !t = Text arr o u

243 ts <- inlineInterleaveST (k b)

242 ts <- inlineInterleaveST (k b)

244 return $! t : ts

243 return $! t : ts

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

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

247

244

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

245------------------------------------------------------------------------

249

246

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

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

23

24import Data.Monoid (mappend)

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

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

26+import GHC.Base

27−import Prelude ()

28

27

29-- | Unsafe conversion for decimal digits.

28-- | Unsafe conversion for decimal digits.

30{-# INLINE i2d #-}

29{-# INLINE i2d #-}

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

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

2

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

5−-- License: BSD-style

5+-- License: BSD3

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

7-- Stability: experimental

8-- Portability: portable

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

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

1−{-# LANGUAGE CPP #-}

2−

3-- |

1-- |

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

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

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

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

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

15 ) where

13 ) where

16

14

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

15roundTo :: 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−

42roundTo d is =

16roundTo d is =

43 case f d is of

17 case f d is of

44 x@(0,_) -> x

18 x@(0,_) -> x

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

53 where

27 where

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

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

55 i' = c + i

29 i' = c + i

56−

57−#endif

Data/Text/Internal/Fusion.hs+24−34

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

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.

105− let mlen = upperBound 4 len + 1

101+ let mlen = upperBound 4 len

106 arr0 <- A.new mlen

102 arr0 <- A.new mlen

107− let outer !arr !maxi = encode

103+ let outer arr top = loop

108 where

104 where

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

105+ loop !s !i =

110− encode !si !di =

111− case next0 si of

106+ case next0 s of

112− Done -> done arr di

107+ Done -> done arr i

113− Skip si' -> encode si' di

108+ Skip s' -> loop s' i

114− Yield c si'

109+ Yield x s'

115− -- simply check for the worst case

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

116− | maxi < di + 1 -> realloc si di

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

117− | otherwise -> do

118− n <- unsafeWrite arr di c

119− encode si' (di + n)

120−

121− -- keep uncommon case separate from the common case code

122− {-# NOINLINE realloc #-}

123− realloc !si !di = do

124− let newlen = (maxi + 1) * 2

125− arr' <- A.new newlen

112+ arr' <- A.new top'

126− A.copyM arr' 0 arr 0 di

113+ A.copyM arr' 0 arr 0 top

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

114+ outer arr' top' s i

128−

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

116+ loop s' (i+d)

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

118+ | otherwise = i + 1

129− outer arr0 (mlen - 1) s0 0

119+ outer arr0 mlen s0 0

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

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

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

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

132

122

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

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

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

177-- the input and result reversed.

167-- the input and result reversed.

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

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

179−reverseScanr f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low

169+reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low

180 where

170 where

181 {-# INLINE next #-}

171 {-# INLINE next #-}

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

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

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

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

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

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

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

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

186− Skip s' -> Skip (Scan2 z s')

176+ Skip s' -> Skip (S2 :*: z :*: s')

187− Done -> Done

177+ Done -> Done

188{-# INLINE reverseScanr #-}

178{-# INLINE reverseScanr #-}

189

179

190-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed

180-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed

Data/Text/Internal/Fusion/CaseMapping.hs+19−291

@@ -1,17 +1,17 @@

1{-# LANGUAGE Rank2Types #-}

2-- AUTOMATICALLY GENERATED - DO NOT EDIT

3−-- Generated by scripts/CaseMapping.hs

3+-- Generated by scripts/SpecialCasing.hs

4−-- CaseFolding-8.0.0.txt

4+-- CaseFolding-6.3.0.txt

5−-- Date: 2015-01-13, 18:16:36 GMT [MD]

5+-- Date: 2012-12-20, 22:14:35 GMT [MD]

6−-- SpecialCasing-8.0.0.txt

6+-- SpecialCasing-6.3.0.txt

7−-- Date: 2014-12-16, 23:08:04 GMT [MD]

7+-- Date: 2013-05-08, 13:54:51 GMT [MD]

8

9module Data.Text.Internal.Fusion.CaseMapping where

10import Data.Char

11import Data.Text.Internal.Fusion.Types

12

13upperMapping :: forall s. Char -> s -> Step (CC s) Char

14−{-# NOINLINE upperMapping #-}

14+{-# INLINE 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−{-# NOINLINE lowerMapping #-}

221+{-# INLINE 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−{-# NOINLINE titleMapping #-}

226+{-# INLINE 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−{-# NOINLINE foldMapping #-}

325+{-# INLINE foldMapping #-}

326-- MICRO SIGN

327foldMapping '\x00b5' s = Yield '\x03bc' (CC s '\x0000' '\x0000')

328-- LATIN SMALL LETTER SHARP S

@@ -359,18 +359,10 @@ 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−-- CHEROKEE SMALL LETTER YE

362+-- GEORGIAN CAPITAL LETTER YN

363−foldMapping '\x13f8' s = Yield '\x13f0' (CC s '\x0000' '\x0000')

363+foldMapping '\x10c7' s = Yield '\x2d27' (CC s '\x0000' '\x0000')

364−-- CHEROKEE SMALL LETTER YI

364+-- GEORGIAN CAPITAL LETTER AEN

365−foldMapping '\x13f9' s = Yield '\x13f1' (CC s '\x0000' '\x0000')

365+foldMapping '\x10cd' s = Yield '\x2d2d' (CC s '\x0000' '\x0000')

366−-- CHEROKEE SMALL LETTER YO

367−foldMapping '\x13fa' s = Yield '\x13f2' (CC s '\x0000' '\x0000')

368−-- CHEROKEE SMALL LETTER YU

369−foldMapping '\x13fb' s = Yield '\x13f3' (CC s '\x0000' '\x0000')

370−-- CHEROKEE SMALL LETTER YV

371−foldMapping '\x13fc' s = Yield '\x13f4' (CC s '\x0000' '\x0000')

372−-- CHEROKEE SMALL LETTER MV

373−foldMapping '\x13fd' s = Yield '\x13f5' (CC s '\x0000' '\x0000')

374-- LATIN SMALL LETTER H WITH LINE BELOW

366-- LATIN SMALL LETTER H WITH LINE BELOW

375foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')

367foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')

376-- LATIN SMALL LETTER T WITH DIAERESIS

368-- LATIN SMALL LETTER T WITH DIAERESIS

@@ -545,174 +537,12 @@ foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')

545foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')

537foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')

546-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI

538-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI

547foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')

539foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')

548−-- LATIN CAPITAL LETTER J WITH CROSSED-TAIL

540+-- COPTIC CAPITAL LETTER BOHAIRIC KHEI

549−foldMapping '\xa7b2' s = Yield '\x029d' (CC s '\x0000' '\x0000')

541+foldMapping '\x2cf2' s = Yield '\x2cf3' (CC s '\x0000' '\x0000')

550−-- LATIN CAPITAL LETTER CHI

542+-- LATIN CAPITAL LETTER C WITH BAR

551−foldMapping '\xa7b3' s = Yield '\xab53' (CC s '\x0000' '\x0000')

552−-- LATIN CAPITAL LETTER BETA

553−foldMapping '\xa7b4' s = Yield '\xa7b5' (CC s '\x0000' '\x0000')

543+foldMapping '\xa792' s = Yield '\xa793' (CC s '\x0000' '\x0000')

554−-- LATIN CAPITAL LETTER OMEGA

544+-- LATIN CAPITAL LETTER H WITH HOOK

555−foldMapping '\xa7b6' s = Yield '\xa7b7' (CC s '\x0000' '\x0000')

545+foldMapping '\xa7aa' s = Yield '\x0266' (CC s '\x0000' '\x0000')

556−-- CHEROKEE SMALL LETTER A

557−foldMapping '\xab70' s = Yield '\x13a0' (CC s '\x0000' '\x0000')

558−-- CHEROKEE SMALL LETTER E

559−foldMapping '\xab71' s = Yield '\x13a1' (CC s '\x0000' '\x0000')

560−-- CHEROKEE SMALL LETTER I

561−foldMapping '\xab72' s = Yield '\x13a2' (CC s '\x0000' '\x0000')

562−-- CHEROKEE SMALL LETTER O

563−foldMapping '\xab73' s = Yield '\x13a3' (CC s '\x0000' '\x0000')

564−-- CHEROKEE SMALL LETTER U

565−foldMapping '\xab74' s = Yield '\x13a4' (CC s '\x0000' '\x0000')

566−-- CHEROKEE SMALL LETTER V

567−foldMapping '\xab75' s = Yield '\x13a5' (CC s '\x0000' '\x0000')

568−-- CHEROKEE SMALL LETTER GA

569−foldMapping '\xab76' s = Yield '\x13a6' (CC s '\x0000' '\x0000')

570−-- CHEROKEE SMALL LETTER KA

571−foldMapping '\xab77' s = Yield '\x13a7' (CC s '\x0000' '\x0000')

572−-- CHEROKEE SMALL LETTER GE

573−foldMapping '\xab78' s = Yield '\x13a8' (CC s '\x0000' '\x0000')

574−-- CHEROKEE SMALL LETTER GI

575−foldMapping '\xab79' s = Yield '\x13a9' (CC s '\x0000' '\x0000')

576−-- CHEROKEE SMALL LETTER GO

577−foldMapping '\xab7a' s = Yield '\x13aa' (CC s '\x0000' '\x0000')

578−-- CHEROKEE SMALL LETTER GU

579−foldMapping '\xab7b' s = Yield '\x13ab' (CC s '\x0000' '\x0000')

580−-- CHEROKEE SMALL LETTER GV

581−foldMapping '\xab7c' s = Yield '\x13ac' (CC s '\x0000' '\x0000')

582−-- CHEROKEE SMALL LETTER HA

583−foldMapping '\xab7d' s = Yield '\x13ad' (CC s '\x0000' '\x0000')

584−-- CHEROKEE SMALL LETTER HE

585−foldMapping '\xab7e' s = Yield '\x13ae' (CC s '\x0000' '\x0000')

586−-- CHEROKEE SMALL LETTER HI

587−foldMapping '\xab7f' s = Yield '\x13af' (CC s '\x0000' '\x0000')

588−-- CHEROKEE SMALL LETTER HO

589−foldMapping '\xab80' s = Yield '\x13b0' (CC s '\x0000' '\x0000')

590−-- CHEROKEE SMALL LETTER HU

591−foldMapping '\xab81' s = Yield '\x13b1' (CC s '\x0000' '\x0000')

592−-- CHEROKEE SMALL LETTER HV

593−foldMapping '\xab82' s = Yield '\x13b2' (CC s '\x0000' '\x0000')

594−-- CHEROKEE SMALL LETTER LA

595−foldMapping '\xab83' s = Yield '\x13b3' (CC s '\x0000' '\x0000')

596−-- CHEROKEE SMALL LETTER LE

597−foldMapping '\xab84' s = Yield '\x13b4' (CC s '\x0000' '\x0000')

598−-- CHEROKEE SMALL LETTER LI

599−foldMapping '\xab85' s = Yield '\x13b5' (CC s '\x0000' '\x0000')

600−-- CHEROKEE SMALL LETTER LO

601−foldMapping '\xab86' s = Yield '\x13b6' (CC s '\x0000' '\x0000')

602−-- CHEROKEE SMALL LETTER LU

603−foldMapping '\xab87' s = Yield '\x13b7' (CC s '\x0000' '\x0000')

604−-- CHEROKEE SMALL LETTER LV

605−foldMapping '\xab88' s = Yield '\x13b8' (CC s '\x0000' '\x0000')

606−-- CHEROKEE SMALL LETTER MA

607−foldMapping '\xab89' s = Yield '\x13b9' (CC s '\x0000' '\x0000')

608−-- CHEROKEE SMALL LETTER ME

609−foldMapping '\xab8a' s = Yield '\x13ba' (CC s '\x0000' '\x0000')

610−-- CHEROKEE SMALL LETTER MI

611−foldMapping '\xab8b' s = Yield '\x13bb' (CC s '\x0000' '\x0000')

612−-- CHEROKEE SMALL LETTER MO

613−foldMapping '\xab8c' s = Yield '\x13bc' (CC s '\x0000' '\x0000')

614−-- CHEROKEE SMALL LETTER MU

615−foldMapping '\xab8d' s = Yield '\x13bd' (CC s '\x0000' '\x0000')

616−-- CHEROKEE SMALL LETTER NA

617−foldMapping '\xab8e' s = Yield '\x13be' (CC s '\x0000' '\x0000')

618−-- CHEROKEE SMALL LETTER HNA

619−foldMapping '\xab8f' s = Yield '\x13bf' (CC s '\x0000' '\x0000')

620−-- CHEROKEE SMALL LETTER NAH

621−foldMapping '\xab90' s = Yield '\x13c0' (CC s '\x0000' '\x0000')

622−-- CHEROKEE SMALL LETTER NE

623−foldMapping '\xab91' s = Yield '\x13c1' (CC s '\x0000' '\x0000')

624−-- CHEROKEE SMALL LETTER NI

625−foldMapping '\xab92' s = Yield '\x13c2' (CC s '\x0000' '\x0000')

626−-- CHEROKEE SMALL LETTER NO

627−foldMapping '\xab93' s = Yield '\x13c3' (CC s '\x0000' '\x0000')

628−-- CHEROKEE SMALL LETTER NU

629−foldMapping '\xab94' s = Yield '\x13c4' (CC s '\x0000' '\x0000')

630−-- CHEROKEE SMALL LETTER NV

631−foldMapping '\xab95' s = Yield '\x13c5' (CC s '\x0000' '\x0000')

632−-- CHEROKEE SMALL LETTER QUA

633−foldMapping '\xab96' s = Yield '\x13c6' (CC s '\x0000' '\x0000')

634−-- CHEROKEE SMALL LETTER QUE

635−foldMapping '\xab97' s = Yield '\x13c7' (CC s '\x0000' '\x0000')

636−-- CHEROKEE SMALL LETTER QUI

637−foldMapping '\xab98' s = Yield '\x13c8' (CC s '\x0000' '\x0000')

638−-- CHEROKEE SMALL LETTER QUO

639−foldMapping '\xab99' s = Yield '\x13c9' (CC s '\x0000' '\x0000')

640−-- CHEROKEE SMALL LETTER QUU

641−foldMapping '\xab9a' s = Yield '\x13ca' (CC s '\x0000' '\x0000')

642−-- CHEROKEE SMALL LETTER QUV

643−foldMapping '\xab9b' s = Yield '\x13cb' (CC s '\x0000' '\x0000')

644−-- CHEROKEE SMALL LETTER SA

645−foldMapping '\xab9c' s = Yield '\x13cc' (CC s '\x0000' '\x0000')

646−-- CHEROKEE SMALL LETTER S

647−foldMapping '\xab9d' s = Yield '\x13cd' (CC s '\x0000' '\x0000')

648−-- CHEROKEE SMALL LETTER SE

649−foldMapping '\xab9e' s = Yield '\x13ce' (CC s '\x0000' '\x0000')

650−-- CHEROKEE SMALL LETTER SI

651−foldMapping '\xab9f' s = Yield '\x13cf' (CC s '\x0000' '\x0000')

652−-- CHEROKEE SMALL LETTER SO

653−foldMapping '\xaba0' s = Yield '\x13d0' (CC s '\x0000' '\x0000')

654−-- CHEROKEE SMALL LETTER SU

655−foldMapping '\xaba1' s = Yield '\x13d1' (CC s '\x0000' '\x0000')

656−-- CHEROKEE SMALL LETTER SV

657−foldMapping '\xaba2' s = Yield '\x13d2' (CC s '\x0000' '\x0000')

658−-- CHEROKEE SMALL LETTER DA

659−foldMapping '\xaba3' s = Yield '\x13d3' (CC s '\x0000' '\x0000')

660−-- CHEROKEE SMALL LETTER TA

661−foldMapping '\xaba4' s = Yield '\x13d4' (CC s '\x0000' '\x0000')

662−-- CHEROKEE SMALL LETTER DE

663−foldMapping '\xaba5' s = Yield '\x13d5' (CC s '\x0000' '\x0000')

664−-- CHEROKEE SMALL LETTER TE

665−foldMapping '\xaba6' s = Yield '\x13d6' (CC s '\x0000' '\x0000')

666−-- CHEROKEE SMALL LETTER DI

667−foldMapping '\xaba7' s = Yield '\x13d7' (CC s '\x0000' '\x0000')

668−-- CHEROKEE SMALL LETTER TI

669−foldMapping '\xaba8' s = Yield '\x13d8' (CC s '\x0000' '\x0000')

670−-- CHEROKEE SMALL LETTER DO

671−foldMapping '\xaba9' s = Yield '\x13d9' (CC s '\x0000' '\x0000')

672−-- CHEROKEE SMALL LETTER DU

673−foldMapping '\xabaa' s = Yield '\x13da' (CC s '\x0000' '\x0000')

674−-- CHEROKEE SMALL LETTER DV

675−foldMapping '\xabab' s = Yield '\x13db' (CC s '\x0000' '\x0000')

676−-- CHEROKEE SMALL LETTER DLA

677−foldMapping '\xabac' s = Yield '\x13dc' (CC s '\x0000' '\x0000')

678−-- CHEROKEE SMALL LETTER TLA

679−foldMapping '\xabad' s = Yield '\x13dd' (CC s '\x0000' '\x0000')

680−-- CHEROKEE SMALL LETTER TLE

681−foldMapping '\xabae' s = Yield '\x13de' (CC s '\x0000' '\x0000')

682−-- CHEROKEE SMALL LETTER TLI

683−foldMapping '\xabaf' s = Yield '\x13df' (CC s '\x0000' '\x0000')

684−-- CHEROKEE SMALL LETTER TLO

685−foldMapping '\xabb0' s = Yield '\x13e0' (CC s '\x0000' '\x0000')

686−-- CHEROKEE SMALL LETTER TLU

687−foldMapping '\xabb1' s = Yield '\x13e1' (CC s '\x0000' '\x0000')

688−-- CHEROKEE SMALL LETTER TLV

689−foldMapping '\xabb2' s = Yield '\x13e2' (CC s '\x0000' '\x0000')

690−-- CHEROKEE SMALL LETTER TSA

691−foldMapping '\xabb3' s = Yield '\x13e3' (CC s '\x0000' '\x0000')

692−-- CHEROKEE SMALL LETTER TSE

693−foldMapping '\xabb4' s = Yield '\x13e4' (CC s '\x0000' '\x0000')

694−-- CHEROKEE SMALL LETTER TSI

695−foldMapping '\xabb5' s = Yield '\x13e5' (CC s '\x0000' '\x0000')

696−-- CHEROKEE SMALL LETTER TSO

697−foldMapping '\xabb6' s = Yield '\x13e6' (CC s '\x0000' '\x0000')

698−-- CHEROKEE SMALL LETTER TSU

699−foldMapping '\xabb7' s = Yield '\x13e7' (CC s '\x0000' '\x0000')

700−-- CHEROKEE SMALL LETTER TSV

701−foldMapping '\xabb8' s = Yield '\x13e8' (CC s '\x0000' '\x0000')

702−-- CHEROKEE SMALL LETTER WA

703−foldMapping '\xabb9' s = Yield '\x13e9' (CC s '\x0000' '\x0000')

704−-- CHEROKEE SMALL LETTER WE

705−foldMapping '\xabba' s = Yield '\x13ea' (CC s '\x0000' '\x0000')

706−-- CHEROKEE SMALL LETTER WI

707−foldMapping '\xabbb' s = Yield '\x13eb' (CC s '\x0000' '\x0000')

708−-- CHEROKEE SMALL LETTER WO

709−foldMapping '\xabbc' s = Yield '\x13ec' (CC s '\x0000' '\x0000')

710−-- CHEROKEE SMALL LETTER WU

711−foldMapping '\xabbd' s = Yield '\x13ed' (CC s '\x0000' '\x0000')

712−-- CHEROKEE SMALL LETTER WV

713−foldMapping '\xabbe' s = Yield '\x13ee' (CC s '\x0000' '\x0000')

714−-- CHEROKEE SMALL LETTER YA

715−foldMapping '\xabbf' s = Yield '\x13ef' (CC s '\x0000' '\x0000')

716-- LATIN SMALL LIGATURE FF

546-- LATIN SMALL LIGATURE FF

717foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')

547foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')

718-- LATIN SMALL LIGATURE FI

548-- LATIN SMALL LIGATURE FI

@@ -737,106 +567,4 @@ foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')

737foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')

567foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')

738-- ARMENIAN SMALL LIGATURE MEN XEH

568-- ARMENIAN SMALL LIGATURE MEN XEH

739foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')

569foldMapping '\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')

842foldMapping c s = Yield (toLower c) (CC s '\0' '\0')

570foldMapping c s = Yield (toLower c) (CC s '\0' '\0')

Data/Text/Internal/Fusion/Common.hs+72−59

@@ -71,6 +71,9 @@ module Data.Text.Internal.Fusion.Common

71 -- ** Scans

72 , scanl

73

74+ -- ** Accumulating maps

75+ -- , mapAccumL

76+

74 -- ** Generation and unfolding

77 -- ** Generation and unfolding

75 , replicateCharI

78 , replicateCharI

76 , replicateI

79 , replicateI

@@ -120,7 +123,7 @@ singleton :: Char -> Stream Char

120singleton c = Stream next False 1

123singleton c = Stream next False 1

121 where next False = Yield c True

124 where next False = Yield c True

122 next True = Done

125 next True = Done

123−{-# INLINE [0] singleton #-}

126+{-# INLINE singleton #-}

124

127

125streamList :: [a] -> Stream a

128streamList :: [a] -> Stream a

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

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

@@ -184,9 +187,6 @@ cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)

184 Yield x s' -> Yield x (C0 s')

187 Yield x s' -> Yield x (C0 s')

185{-# INLINE [0] cons #-}

188{-# INLINE [0] cons #-}

186

189

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)

@@ -473,20 +473,17 @@ toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len

473 next (CC s a b) = Yield a (CC s b '\0')

474{-# INLINE [0] toTitle #-}

475

476−data Justify i s = Just1 !i !s

477− | Just2 !i !s

478−

479justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char

476justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char

480justifyLeftI k c (Stream next0 s0 len) =

477justifyLeftI k c (Stream next0 s0 len) =

481− Stream next (Just1 0 s0) (larger (fromIntegral k) len)

478+ Stream next (s0 :*: S1 :*: 0) (larger (fromIntegral k) len)

482 where

479 where

483− next (Just1 n s) =

480+ next (s :*: S1 :*: n) =

484 case next0 s of

481 case next0 s of

485− Done -> next (Just2 n s)

482+ Done -> next (s :*: S2 :*: n)

486− Skip s' -> Skip (Just1 n s')

483+ Skip s' -> Skip (s' :*: S1 :*: n)

487− Yield x s' -> Yield x (Just1 (n+1) s')

484+ Yield x s' -> Yield x (s' :*: S1 :*: n+1)

488− next (Just2 n s)

485+ next (s :*: S2 :*: n)

489− | n < k = Yield c (Just2 (n+1) s)

486+ | n < k = Yield c (s :*: S2 :*: n+1)

490 | otherwise = Done

487 | otherwise = Done

491 {-# INLINE next #-}

488 {-# INLINE next #-}

492{-# INLINE [0] justifyLeftI #-}

489{-# INLINE [0] justifyLeftI #-}

@@ -593,7 +590,7 @@ concatMap f = foldr (append . f) empty

593{-# INLINE [0] concatMap #-}

590{-# INLINE [0] concatMap #-}

594

591

595-- | /O(n)/ any @p @xs determines if any character in the stream

592-- | /O(n)/ any @p @xs determines if any character in the stream

596−-- @xs@ satisfies the predicate @p@.

593+-- @xs@ satisifes the predicate @p@.

597any :: (Char -> Bool) -> Stream Char -> Bool

594any :: (Char -> Bool) -> Stream Char -> Bool

598any p (Stream next0 s0 _len) = loop_any s0

595any p (Stream next0 s0 _len) = loop_any s0

599 where

596 where

@@ -605,7 +602,7 @@ any p (Stream next0 s0 _len) = loop_any s0

605{-# INLINE [0] any #-}

602{-# INLINE [0] any #-}

606

603

607-- | /O(n)/ all @p @xs determines if all characters in the 'Text'

604-- | /O(n)/ all @p @xs determines if all characters in the 'Text'

608−-- @xs@ satisfy the predicate @p@.

605+-- @xs@ satisify the predicate @p@.

609all :: (Char -> Bool) -> Stream Char -> Bool

606all :: (Char -> Bool) -> Stream Char -> Bool

610all p (Stream next0 s0 _len) = loop_all s0

607all p (Stream next0 s0 _len) = loop_all s0

611 where

608 where

@@ -654,27 +651,50 @@ minimum (Stream next0 s0 _len) = loop0_minimum s0

654-- * Building streams

651-- * Building streams

655

652

656scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

653scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

657−scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low

654+scanl f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low

658 where

655 where

659 {-# INLINE next #-}

656 {-# INLINE next #-}

660− next (Scan1 z s) = Yield z (Scan2 z s)

657+ next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)

661− next (Scan2 z s) = case next0 s of

658+ next (S2 :*: z :*: s) = case next0 s of

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

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

663− in Yield x' (Scan2 x' s')

660+ in Yield x' (S2 :*: x' :*: s')

664− Skip s' -> Skip (Scan2 z s')

661+ Skip s' -> Skip (S2 :*: z :*: s')

665− Done -> Done

662+ Done -> Done

666{-# INLINE [0] scanl #-}

663{-# INLINE [0] scanl #-}

667

664

665+-- -----------------------------------------------------------------------------

666+-- ** Accumulating maps

667+

668+{-

669+-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a

670+-- function to each element of a stream, passing an accumulating

671+-- parameter from left to right, and returns a final stream.

672+--

673+-- /Note/: Unlike the version over lists, this function does not

674+-- return a final value for the accumulator, because the nature of

675+-- streams precludes it.

676+mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b

677+mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :*: z0) len -- HINT depends on f

678+ where

679+ {-# INLINE next #-}

680+ next (s :*: z) = case next0 s of

681+ Yield x s' -> let (z',y) = f z x

682+ in Yield y (s' :*: z')

683+ Skip s' -> Skip (s' :*: z)

684+ Done -> Done

685+{-# INLINE [0] mapAccumL #-}

686+-}

687+

668-- -----------------------------------------------------------------------------

688-- -----------------------------------------------------------------------------

669-- ** Generating and unfolding streams

689-- ** Generating and unfolding streams

670

690

671replicateCharI :: Integral a => a -> Char -> Stream Char

691replicateCharI :: Integral a => a -> Char -> Stream Char

672−replicateCharI !n !c

692+replicateCharI n c

673 | n < 0 = empty

693 | n < 0 = empty

674 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low

694 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low

675 where

695 where

676− next !i | i >= n = Done

696+ next i | i >= n = Done

677− | otherwise = Yield c (i + 1)

697+ | otherwise = Yield c (i + 1)

678{-# INLINE [0] replicateCharI #-}

698{-# INLINE [0] replicateCharI #-}

679

699

680data RI s = RI !s {-# UNPACK #-} !Int64

700data RI s = RI !s {-# UNPACK #-} !Int64

@@ -739,27 +759,24 @@ take n0 (Stream next0 s0 len) =

739 Yield x s' -> Yield x ((n-1) :*: s')

759 Yield x s' -> Yield x ((n-1) :*: s')

740{-# INLINE [0] take #-}

760{-# INLINE [0] take #-}

741

761

742−data Drop a s = NS !s

743− | JS !a !s

744−

745-- | /O(n)/ drop n, applied to a stream, returns the suffix of the

762-- | /O(n)/ drop n, applied to a stream, returns the suffix of the

746-- stream after the first @n@ characters, or the empty stream if @n@

763-- stream after the first @n@ characters, or the empty stream if @n@

747-- is greater than the length of the stream.

764-- is greater than the length of the stream.

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

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

749drop n0 (Stream next0 s0 len) =

766drop n0 (Stream next0 s0 len) =

750− Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))

767+ Stream next (J n0 :*: s0) (len - fromIntegral (max 0 n0))

751 where

768 where

752 {-# INLINE next #-}

769 {-# INLINE next #-}

753− next (JS n s)

770+ next (J n :*: s)

754− | n <= 0 = Skip (NS s)

771+ | n <= 0 = Skip (N :*: s)

755 | otherwise = case next0 s of

772 | otherwise = case next0 s of

756 Done -> Done

773 Done -> Done

757− Skip s' -> Skip (JS n s')

774+ Skip s' -> Skip (J n :*: s')

758− Yield _ s' -> Skip (JS (n-1) s')

775+ Yield _ s' -> Skip (J (n-1) :*: s')

759− next (NS s) = case next0 s of

776+ next (N :*: s) = case next0 s of

760 Done -> Done

777 Done -> Done

761− Skip s' -> Skip (NS s')

778+ Skip s' -> Skip (N :*: s')

762− Yield x s' -> Yield x (NS s')

779+ Yield x s' -> Yield x (N :*: s')

763{-# INLINE [0] drop #-}

780{-# INLINE [0] drop #-}

764

781

765-- | takeWhile, applied to a predicate @p@ and a stream, returns the

782-- | takeWhile, applied to a predicate @p@ and a stream, returns the

@@ -777,18 +794,18 @@ takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

777

794

778-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.

795-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.

779dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char

796dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char

780−dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high

797+dropWhile p (Stream next0 s0 len) = Stream next (S1 :*: s0) len -- HINT maybe too high

781 where

798 where

782 {-# INLINE next #-}

799 {-# INLINE next #-}

783− next (L s) = case next0 s of

800+ next (S1 :*: s) = case next0 s of

784 Done -> Done

801 Done -> Done

785− Skip s' -> Skip (L s')

802+ Skip s' -> Skip (S1 :*: s')

786− Yield x s' | p x -> Skip (L s')

803+ Yield x s' | p x -> Skip (S1 :*: s')

787− | otherwise -> Yield x (R s')

804+ | otherwise -> Yield x (S2 :*: s')

788− next (R s) = case next0 s of

805+ next (S2 :*: s) = case next0 s of

789 Done -> Done

806 Done -> Done

790− Skip s' -> Skip (R s')

807+ Skip s' -> Skip (S2 :*: s')

791− Yield x s' -> Yield x (R s')

808+ Yield x s' -> Yield x (S2 :*: s')

792{-# INLINE [0] dropWhile #-}

809{-# INLINE [0] dropWhile #-}

793

810

794-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns

811-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns

@@ -895,25 +912,21 @@ findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0

895-------------------------------------------------------------------------------

912-------------------------------------------------------------------------------

896-- * Zipping

913-- * Zipping

897

914

898−-- | Strict triple.

899−data Zip a b m = Z1 !a !b

900− | Z2 !a !b !m

901−

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

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

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

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

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

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

905zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =

918zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =

906− Stream next (Z1 sa0 sb0) (smaller len1 len2)

919+ Stream next (sa0 :*: sb0 :*: N) (smaller len1 len2)

907 where

920 where

908− next (Z1 sa sb) = case next0 sa of

921+ next (sa :*: sb :*: N) = case next0 sa of

909− Done -> Done

922+ Done -> Done

910− Skip sa' -> Skip (Z1 sa' sb)

923+ Skip sa' -> Skip (sa' :*: sb :*: N)

911− Yield a sa' -> Skip (Z2 sa' sb a)

924+ Yield a sa' -> Skip (sa' :*: sb :*: J a)

912−

925+

913− next (Z2 sa' sb a) = case next1 sb of

926+ next (sa' :*: sb :*: J a) = case next1 sb of

914− Done -> Done

927+ Done -> Done

915− Skip sb' -> Skip (Z2 sa' sb' a)

928+ Skip sb' -> Skip (sa' :*: sb' :*: J a)

916− Yield b sb' -> Yield (f a b) (Z1 sa' sb')

929+ Yield b sb' -> Yield (f a b) (sa' :*: sb' :*: N)

917{-# INLINE [0] zipWith #-}

930{-# INLINE [0] zipWith #-}

918

931

919-- | /O(n)/ The 'countCharI' function returns the number of times the

932-- | /O(n)/ The 'countCharI' function returns the number of times the

Data/Text/Internal/Fusion/Size.hs+6−1

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

32 , isEmpty

33 ) where

34

35−import Data.Text.Internal (mul)

36#if defined(ASSERTS)

35#if defined(ASSERTS)

37import Control.Exception (assert)

36import Control.Exception (assert)

38#endif

37#endif

@@ -101,6 +100,12 @@ subtractSize (Between _ mb) Unknown = Between 0 mb

101subtractSize _ _ = Unknown

100subtractSize _ _ = Unknown

102{-# INLINE subtractSize #-}

101{-# INLINE subtractSize #-}

103

102

103+mul :: Int -> Int -> Int

104+mul m n

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

106+ | otherwise = overflowError

107+{-# INLINE mul #-}

108+

104mulSize :: Size -> Size -> Size

109mulSize :: Size -> Size -> Size

105mulSize (Between ma mb) (Between na nb) = Between (mul ma na) (mul mb nb)

110mulSize (Between ma mb) (Between na nb) = Between (mul ma na) (mul mb nb)

106mulSize _ _ = Unknown

111mulSize _ _ = Unknown

Data/Text/Internal/Fusion/Types.hs+13−8

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

20module Data.Text.Internal.Fusion.Types

21 (

22 CC(..)

23+ , M(..)

24+ , M8

23 , PairS(..)

25 , PairS(..)

24− , Scan(..)

25 , RS(..)

26 , RS(..)

26 , Step(..)

27 , Step(..)

27 , Stream(..)

28 , Stream(..)

29+ , Switch(..)

28 , empty

30 , empty

29 ) where

31 ) where

30

32

@@ -34,23 +36,26 @@ import Data.Word (Word8)

34-- | Specialised tuple for case conversion.

36-- | Specialised tuple for case conversion.

35data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char

37data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char

36

38

39+-- | Specialised, strict Maybe-like type.

40+data M a = N

41+ | J !a

42+

43+type M8 = M Word8

44+

37−-- | Restreaming state.

45+-- Restreaming state.

38data RS s

46data RS s

39 = RS0 !s

47 = RS0 !s

40 | RS1 !s {-# UNPACK #-} !Word8

48 | RS1 !s {-# UNPACK #-} !Word8

41 | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

49 | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

42 | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

50 | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

43

51

44−-- | Strict pair.

52+infixl 2 :*:

45data PairS a b = !a :*: !b

53data PairS a b = !a :*: !b

46 -- deriving (Eq, Ord, Show)

54 -- deriving (Eq, Ord, Show)

47−infixl 2 :*:

48

55

49−-- | An intermediate result in a scan.

56+-- | Allow a function over a stream to switch between two states.

50−data Scan s = Scan1 {-# UNPACK #-} !Char !s

57+data Switch = S1 | S2

51− | Scan2 {-# UNPACK #-} !Char !s

52

58

53−-- | Intermediate result in a processing pipeline.

54data Step s a = Done

59data Step s a = Done

55 | Skip !s

60 | Skip !s

56 | Yield !a !s

61 | Yield !a !s

Data/Text/Internal/Read.hs+3−3

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

7-- Stability : experimental

8-- Portability : GHC

9--

10−-- Common internal functions for reading textual data.

10+-- Common internal functiopns for reading textual data.

11module Data.Text.Internal.Read

12 (

13 IReader

@@ -18,7 +18,7 @@ module Data.Text.Internal.Read

18 , perhaps

19 ) where

20

21−import Control.Applicative as App (Applicative(..))

21+import Control.Applicative (Applicative(..))

22import Control.Arrow (first)

23import Control.Monad (ap)

24import Data.Char (ord)

@@ -38,7 +38,7 @@ instance Applicative (IParser t) where

38 (<*>) = ap

39

40instance Monad (IParser t) where

41− return = App.pure

41+ return = pure

42 m >>= k = P $ \t -> case runP m t of

43 Left err -> Left err

44 Right (a,t') -> runP (k a) t'

Data/Text/Lazy.hs+21−161

@@ -3,10 +3,6 @@

3#if __GLASGOW_HASKELL__ >= 702

4{-# LANGUAGE Trustworthy #-}

5#endif

6−#if __GLASGOW_HASKELL__ >= 708

7−{-# LANGUAGE TypeFamilies #-}

8−#endif

9−

10-- |

6-- |

11-- Module : Data.Text.Lazy

7-- Module : Data.Text.Lazy

@@ -125,10 +121,7 @@ module Data.Text.Lazy

125 , mapAccumR

121 , mapAccumR

126

122

127 -- ** Generation and unfolding

123 -- ** Generation and unfolding

128− , repeat

129 , replicate

124 , replicate

130− , cycle

131− , iterate

132 , unfoldr

125 , unfoldr

133 , unfoldrN

126 , unfoldrN

134

127

@@ -140,7 +133,6 @@ module Data.Text.Lazy

140 , drop

133 , drop

141 , dropEnd

134 , dropEnd

142 , takeWhile

135 , takeWhile

143− , takeWhileEnd

144 , dropWhile

136 , dropWhile

145 , dropWhileEnd

137 , dropWhileEnd

146 , dropAround

138 , dropAround

@@ -211,13 +203,9 @@ import Control.DeepSeq (NFData(..))

211import Data.Int (Int64)

203import Data.Int (Int64)

212import qualified Data.List as L

204import qualified Data.List as L

213import Data.Char (isSpace)

205import Data.Char (isSpace)

214−import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,

206+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))

215− Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))

207+import Data.Data (mkNoRepType)

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

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

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

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

219−import Data.Semigroup (Semigroup(..))

220−#endif

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

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

222import qualified Data.Text as T

210import qualified Data.Text as T

223import qualified Data.Text.Internal as T

211import qualified Data.Text.Internal as T

@@ -226,10 +214,8 @@ import qualified Data.Text.Unsafe as T

226import qualified Data.Text.Internal.Lazy.Fusion as S

214import qualified Data.Text.Internal.Lazy.Fusion as S

227import Data.Text.Internal.Fusion.Types (PairS(..))

215import Data.Text.Internal.Fusion.Types (PairS(..))

228import Data.Text.Internal.Lazy.Fusion (stream, unstream)

216import Data.Text.Internal.Lazy.Fusion (stream, unstream)

229−import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks,

217+import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks, foldrChunks)

230− foldrChunks, smallChunkSize)

231import Data.Text.Internal (firstf, safe, text)

218import Data.Text.Internal (firstf, safe, text)

232−import Data.Text.Lazy.Encoding (decodeUtf8', encodeUtf8)

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

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

234import Data.Text.Internal.Lazy.Search (indices)

220import Data.Text.Internal.Lazy.Search (indices)

235#if __GLASGOW_HASKELL__ >= 702

221#if __GLASGOW_HASKELL__ >= 702

@@ -237,13 +223,7 @@ import qualified GHC.CString as GHC

237#else

223#else

238import qualified GHC.Base as GHC

224import qualified GHC.Base as GHC

239#endif

225#endif

240−#if __GLASGOW_HASKELL__ >= 708

241−import qualified GHC.Exts as Exts

242−#endif

243import GHC.Prim (Addr#)

226import GHC.Prim (Addr#)

244−#if MIN_VERSION_base(4,7,0)

245−import Text.Printf (PrintfArg, formatArg, formatString)

246−#endif

247

227

248-- $fusion

228-- $fusion

249--

229--

@@ -341,71 +321,25 @@ instance Show Text where

341instance Read Text where

321instance Read Text where

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

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

343

323

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−

352instance Monoid Text where

324instance Monoid Text where

353 mempty = empty

325 mempty = empty

354−#if MIN_VERSION_base(4,9,0)

355− mappend = (<>) -- future-proof definition

356−#else

357 mappend = append

326 mappend = append

358−#endif

359 mconcat = concat

327 mconcat = concat

360

328

361instance IsString Text where

329instance IsString Text where

362 fromString = pack

330 fromString = pack

363

331

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−

371#if defined(HAVE_DEEPSEQ)

332#if defined(HAVE_DEEPSEQ)

372instance NFData Text where

333instance NFData Text where

373 rnf Empty = ()

334 rnf Empty = ()

374 rnf (Chunk _ ts) = rnf ts

335 rnf (Chunk _ ts) = rnf ts

375#endif

336#endif

376

337

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'

390instance Data Text where

338instance Data Text where

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

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

392− toConstr _ = packConstr

340+ toConstr _ = error "Data.Text.Lazy.Text.toConstr"

393− gunfold k z c = case constrIndex c of

394− 1 -> k (z pack)

395− _ -> error "Data.Text.Lazy.Text.gunfold"

341+ gunfold _ _ = error "Data.Text.Lazy.Text.gunfold"

396− dataTypeOf _ = textDataType

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

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]

409

343

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

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

411--

345--

@@ -433,14 +367,6 @@ unpackCString# addr# = unstream (S.streamCString# addr#)

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

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

434 = unpackCString# a #-}

368 = unpackCString# a #-}

435

369

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−

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

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

445-- Performs replacement on invalid scalar values.

371-- Performs replacement on invalid scalar values.

446singleton :: Char -> Text

372singleton :: Char -> Text

@@ -545,7 +471,7 @@ tail Empty = emptyError "tail"

545 unstream (S.tail (stream t)) = tail t

471 unstream (S.tail (stream t)) = tail t

546 #-}

472 #-}

547

473

548−-- | /O(n\/c)/ Returns all but the last character of a 'Text', which must

474+-- | /O(1)/ Returns all but the last character of a 'Text', which must

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

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

550init :: Text -> Text

476init :: Text -> Text

551init (Chunk t0 ts0) = go t0 ts0

477init (Chunk t0 ts0) = go t0 ts0

@@ -581,7 +507,7 @@ isSingleton :: Text -> Bool

581isSingleton = S.isSingleton . stream

507isSingleton = S.isSingleton . stream

582{-# INLINE isSingleton #-}

508{-# INLINE isSingleton #-}

583

509

584−-- | /O(n\/c)/ Returns the last character of a 'Text', which must be

510+-- | /O(1)/ Returns the last character of a 'Text', which must be

585-- non-empty. Subject to fusion.

511-- non-empty. Subject to fusion.

586last :: Text -> Char

512last :: Text -> Char

587last Empty = emptyError "last"

513last Empty = emptyError "last"

@@ -715,36 +641,13 @@ reverse = rev Empty

715 where rev a Empty = a

641 where rev a Empty = a

716 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts

642 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts

717

643

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

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

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"

738--

645--

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

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

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

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

741−replace :: Text

648+replace :: Text -- ^ Text to search for

742− -- ^ @needle@ to search for. If this string is empty, an

649+ -> Text -- ^ Replacement text

743− -- error will occur.

744− -> Text

745− -- ^ @replacement@ to replace @needle@ with.

746− -> Text

650+ -> Text -- ^ Input text

747− -- ^ @haystack@ in which to search.

748 -> Text

651 -> Text

749replace s d = intercalate d . splitOn s

652replace s d = intercalate d . splitOn s

750{-# INLINE replace #-}

653{-# INLINE replace #-}

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

881{-# INLINE concatMap #-}

784{-# INLINE concatMap #-}

882

785

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

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

884−-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.

787+-- 'Text' @t@ satisifes the predicate @p@. Subject to fusion.

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

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

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

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

887{-# INLINE any #-}

790{-# INLINE any #-}

888

791

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

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

890−-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.

793+-- 'Text' @t@ satisify the predicate @p@. Subject to fusion.

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

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

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

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

893{-# INLINE all #-}

796{-# INLINE all #-}

@@ -970,12 +873,6 @@ mapAccumR f = go

970 go z Empty = (z, Empty)

873 go z Empty = (z, Empty)

971{-# INLINE mapAccumR #-}

874{-# INLINE mapAccumR #-}

972

875

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−

979-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input

876-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input

980-- @t@ repeated @n@ times.

877-- @t@ repeated @n@ times.

981replicate :: Int64 -> Text -> Text

878replicate :: Int64 -> Text -> Text

@@ -987,21 +884,6 @@ replicate n t

987 | otherwise = t : rep (i+1)

884 | otherwise = t : rep (i+1)

988{-# INLINE [1] replicate #-}

885{-# INLINE [1] replicate #-}

989

886

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

1004−

1005-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the

887-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the

1006-- value of every element. Subject to fusion.

888-- value of every element. Subject to fusion.

1007replicateChar :: Int64 -> Char -> Text

889replicateChar :: Int64 -> Char -> Text

@@ -1144,20 +1026,6 @@ takeWhile p t0 = takeWhile' t0

1144"LAZY TEXT takeWhile -> unfused" [1] forall p t.

1026"LAZY TEXT takeWhile -> unfused" [1] forall p t.

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

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

1146 #-}

1028 #-}

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

1161

1029

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

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

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

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

@@ -1176,11 +1044,9 @@ dropWhile p t0 = dropWhile' t0

1176"LAZY TEXT dropWhile -> unfused" [1] forall p t.

1044"LAZY TEXT dropWhile -> unfused" [1] forall p t.

1177 unstream (S.dropWhile p (stream t)) = dropWhile p t

1045 unstream (S.dropWhile p (stream t)) = dropWhile p t

1178 #-}

1046 #-}

1179−

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

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

1181−-- dropping characters that satisfy the predicate @p@ from the end of

1048+-- dropping characters that fail the predicate @p@ from the end of

1182-- @t@.

1049-- @t@.

1183−--

1184-- Examples:

1050-- Examples:

1185--

1051--

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

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

@@ -1197,7 +1063,7 @@ dropWhileEnd p = go

1197{-# INLINE dropWhileEnd #-}

1063{-# INLINE dropWhileEnd #-}

1198

1064

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

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

1200−-- dropping characters that satisfy the predicate @p@ from both the

1066+-- dropping characters that fail the predicate @p@ from both the

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

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

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

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

1203dropAround p = dropWhile p . dropWhileEnd p

1069dropAround p = dropWhile p . dropWhileEnd p

@@ -1392,10 +1258,9 @@ tails ts@(Chunk t ts')

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

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

1393-- are slices of the original.

1259-- are slices of the original.

1394

1260

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

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

1396−-- argument (which cannot be an empty string), consuming the

1262+-- 'Text' argument, consuming the delimiter. An empty delimiter is

1397−-- delimiter. An empty delimiter is invalid, and will cause an error

1263+-- invalid, and will cause an error to be raised.

1398−-- to be raised.

1399--

1264--

1400-- Examples:

1265-- Examples:

1401--

1266--

@@ -1408,18 +1273,13 @@ tails ts@(Chunk t ts')

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

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

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

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

1410--

1275--

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

1412−--

1413-- This function is strict in its first argument, and lazy in its

1276-- This function is strict in its first argument, and lazy in its

1414-- second.

1277-- second.

1415--

1278--

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

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

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

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

1418−splitOn :: Text

1281+splitOn :: Text -- ^ Text to split on

1419− -- ^ String to split on. If this string is empty, an error

1420− -- will occur.

1421− -> Text

1422− -- ^ Input text.

1282+ -> Text -- ^ Input text

1423 -> [Text]

1283 -> [Text]

1424splitOn pat src

1284splitOn pat src

1425 | null pat = emptyError "splitOn"

1285 | null pat = emptyError "splitOn"

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

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

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

11−-- License : BSD-style (see LICENSE)

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

12--

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

14-- Stability : experimental

Data/Text/Lazy/Builder/Int.hs+14−19

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

1−{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,

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

2− UnboxedTuples #-}

3#if __GLASGOW_HASKELL__ >= 702

2#if __GLASGOW_HASKELL__ >= 702

4{-# LANGUAGE Trustworthy #-}

3{-# LANGUAGE Trustworthy #-}

5#endif

4#endif

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

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

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

10−-- License: BSD-style

9+-- License: BSD3

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

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

12-- Stability: experimental

11-- Stability: experimental

13-- Portability: portable

12-- Portability: portable

@@ -35,7 +34,7 @@ import Control.Monad.ST

35

34

36#ifdef __GLASGOW_HASKELL__

35#ifdef __GLASGOW_HASKELL__

37# if defined(INTEGER_GMP)

36# if defined(INTEGER_GMP)

38−import GHC.Integer.GMP.Internals (Integer(S#))

37+import GHC.Integer.GMP.Internals

39# elif defined(INTEGER_SIMPLE)

38# elif defined(INTEGER_SIMPLE)

40import GHC.Integer

39import GHC.Integer

41# else

40# else

@@ -55,7 +54,7 @@ decimal :: Integral a => a -> Builder

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

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

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

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

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

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

58−{-# RULES "decimal/Word" decimal = positive :: Data.Word.Word -> Builder #-}

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

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

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

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

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

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

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

@@ -134,15 +133,8 @@ i2w v = zero + fromIntegral v

134

133

135countDigits :: (Integral a) => a -> Int

134countDigits :: (Integral a) => a -> Int

136{-# INLINE countDigits #-}

135{-# INLINE countDigits #-}

137−countDigits v0

136+countDigits v0 = go 1 (fromIntegral v0 :: Word64)

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+ where go !k v

146 | v < 10 = k

138 | v < 10 = k

147 | v < 100 = k + 1

139 | v < 100 = k + 1

148 | v < 1000 = k + 2

140 | v < 1000 = k + 2

@@ -194,12 +186,19 @@ hexDigit n

194 | otherwise = singleton $! toEnum (fromIntegral n + 87)

186 | otherwise = singleton $! toEnum (fromIntegral n + 87)

195{-# INLINE hexDigit #-}

187{-# INLINE hexDigit #-}

196

188

189+int :: Int -> Builder

190+int = decimal

191+{-# INLINE int #-}

192+

197data T = T !Integer !Int

193data T = T !Integer !Int

198

194

199integer :: Int -> Integer -> Builder

195integer :: Int -> Integer -> Builder

200#ifdef INTEGER_GMP

196#ifdef INTEGER_GMP

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

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

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

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

199+#else

200+integer 10 i = decimal i

201+integer 16 i = hexadecimal i

203#endif

202#endif

204integer base i

203integer base i

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

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

@@ -247,11 +246,7 @@ integer base i

247 PAIR(x,y) -> pblock q <> pblock r <> putB ns

246 PAIR(x,y) -> pblock q <> pblock r <> putB ns

248 where q = fromInteger x

247 where q = fromInteger x

249 r = fromInteger y

248 r = fromInteger y

250− putB _ = Data.Monoid.mempty

249+ putB _ = mempty

251−

252− int :: Int -> Builder

253− int x | base == 10 = decimal x

254− | otherwise = hexadecimal x

255

250

256 pblock = loop maxDigits

251 pblock = loop maxDigits

257 where

252 where

Data/Text/Lazy/Encoding.hs+20−8

@@ -46,25 +46,30 @@ module Data.Text.Lazy.Encoding

46 , encodeUtf32LE

47 , encodeUtf32BE

48

49+#if MIN_VERSION_bytestring(0,10,4)

49 -- * Encoding Text using ByteString Builders

50 -- * Encoding Text using ByteString Builders

50 , encodeUtf8Builder

51 , encodeUtf8Builder

51 , encodeUtf8BuilderEscaped

52 , encodeUtf8BuilderEscaped

53+#endif

52 ) where

54 ) where

53

55

54import Control.Exception (evaluate, try)

56import Control.Exception (evaluate, try)

55−import Data.Monoid (Monoid(..))

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

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

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

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

58−import Data.Word (Word8)

59import qualified Data.ByteString as S

60−import qualified Data.ByteString.Builder as B

61−import qualified Data.ByteString.Builder.Extra as B (safeStrategy, toLazyByteStringWith)

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

63import qualified Data.ByteString.Lazy as B

60import qualified Data.ByteString.Lazy as B

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

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

65import qualified Data.ByteString.Unsafe as B

62import qualified Data.ByteString.Unsafe as B

63+#if MIN_VERSION_bytestring(0,10,4)

64+import Data.Word (Word8)

65+import Data.Monoid (mempty, mappend)

66+import qualified Data.ByteString.Builder as B

67+import qualified Data.ByteString.Builder.Extra as B (safeStrategy, toLazyByteStringWith)

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

66import qualified Data.Text as T

69import qualified Data.Text as T

70+#endif

67import qualified Data.Text.Encoding as TE

71import qualified Data.Text.Encoding as TE

72+import qualified Data.Text.Lazy as L

68import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E

73import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E

69import qualified Data.Text.Internal.Lazy.Fusion as F

74import qualified Data.Text.Internal.Lazy.Fusion as F

70import Data.Text.Unsafe (unsafeDupablePerformIO)

75import Data.Text.Unsafe (unsafeDupablePerformIO)

@@ -84,6 +89,8 @@ import Data.Text.Unsafe (unsafeDupablePerformIO)

84

89

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

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

86-- encoded text.

91-- encoded text.

92+--

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

87decodeASCII :: B.ByteString -> Text

94decodeASCII :: B.ByteString -> Text

88decodeASCII = decodeUtf8

95decodeASCII = decodeUtf8

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

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

@@ -105,7 +112,7 @@ decodeUtf8With onErr (B.Chunk b0 bs0) =

105 | S.null l = empty

112 | S.null l = empty

106 | otherwise = case onErr desc (Just (B.unsafeHead l)) of

113 | otherwise = case onErr desc (Just (B.unsafeHead l)) of

107 Nothing -> empty

114 Nothing -> empty

108− Just c -> Chunk (T.singleton c) Empty

115+ Just c -> L.singleton c

109 desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"

116 desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"

110decodeUtf8With _ _ = empty

117decodeUtf8With _ _ = empty

111

118

@@ -142,6 +149,7 @@ decodeUtf8' bs = unsafeDupablePerformIO $ do

142{-# INLINE decodeUtf8' #-}

149{-# INLINE decodeUtf8' #-}

143

150

144encodeUtf8 :: Text -> B.ByteString

151encodeUtf8 :: Text -> B.ByteString

152+#if MIN_VERSION_bytestring(0,10,4)

145encodeUtf8 Empty = B.empty

153encodeUtf8 Empty = B.empty

146encodeUtf8 lt@(Chunk t _) =

154encodeUtf8 lt@(Chunk t _) =

147 B.toLazyByteStringWith strategy B.empty $ encodeUtf8Builder lt

155 B.toLazyByteStringWith strategy B.empty $ encodeUtf8Builder lt

@@ -155,14 +163,18 @@ encodeUtf8 lt@(Chunk t _) =

155 strategy = B.safeStrategy firstChunkSize B.defaultChunkSize

163 strategy = B.safeStrategy firstChunkSize B.defaultChunkSize

156

164

157encodeUtf8Builder :: Text -> B.Builder

165encodeUtf8Builder :: Text -> B.Builder

158−encodeUtf8Builder =

159− foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) Data.Monoid.mempty

166+encodeUtf8Builder = foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) mempty

160

167

161{-# INLINE encodeUtf8BuilderEscaped #-}

168{-# INLINE encodeUtf8BuilderEscaped #-}

162encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder

169encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder

163encodeUtf8BuilderEscaped prim =

170encodeUtf8BuilderEscaped prim =

164 foldrChunks (\c b -> TE.encodeUtf8BuilderEscaped prim c `mappend` b) mempty

171 foldrChunks (\c b -> TE.encodeUtf8BuilderEscaped prim c `mappend` b) mempty

165

172

173+#else

174+encodeUtf8 (Chunk c cs) = B.Chunk (TE.encodeUtf8 c) (encodeUtf8 cs)

175+encodeUtf8 Empty = B.Empty

176+#endif

177+

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

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

167decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text

179decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text

168decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)

180decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)

Data/Text/Lazy/Read.hs+2−4

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

1{-# LANGUAGE OverloadedStrings, CPP #-}

2−#if __GLASGOW_HASKELL__ >= 704

2+#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Safe #-}

4−#elif __GLASGOW_HASKELL__ >= 702

5{-# LANGUAGE Trustworthy #-}

3{-# LANGUAGE Trustworthy #-}

6#endif

4#endif

7

5

@@ -56,7 +54,7 @@ decimal :: Integral a => Reader a

56{-# SPECIALIZE decimal :: Reader Int32 #-}

54{-# SPECIALIZE decimal :: Reader Int32 #-}

57{-# SPECIALIZE decimal :: Reader Int64 #-}

55{-# SPECIALIZE decimal :: Reader Int64 #-}

58{-# SPECIALIZE decimal :: Reader Integer #-}

56{-# SPECIALIZE decimal :: Reader Integer #-}

59−{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}

57+{-# SPECIALIZE decimal :: Reader Word #-}

60{-# SPECIALIZE decimal :: Reader Word8 #-}

58{-# SPECIALIZE decimal :: Reader Word8 #-}

61{-# SPECIALIZE decimal :: Reader Word16 #-}

59{-# SPECIALIZE decimal :: Reader Word16 #-}

62{-# SPECIALIZE decimal :: Reader Word32 #-}

60{-# SPECIALIZE decimal :: Reader Word32 #-}

Data/Text/Read.hs+1−1

@@ -55,7 +55,7 @@ decimal :: Integral a => Reader a

55{-# SPECIALIZE decimal :: Reader Int32 #-}

56{-# SPECIALIZE decimal :: Reader Int64 #-}

57{-# SPECIALIZE decimal :: Reader Integer #-}

58−{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}

58+{-# SPECIALIZE decimal :: Reader Word #-}

59{-# SPECIALIZE decimal :: Reader Word8 #-}

60{-# SPECIALIZE decimal :: Reader Word16 #-}

61{-# SPECIALIZE decimal :: Reader Word32 #-}

Data/Text/Show.hsdeleted−89

@@ -1,89 +0,0 @@

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

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

3−#if __GLASGOW_HASKELL__ >= 702

4−{-# LANGUAGE Trustworthy #-}

5−#endif

6−

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

benchmarks/haskell/Benchmarks.hs+1−3

@@ -15,7 +15,6 @@ 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

19import qualified Benchmarks.Pure as Pure

18import qualified Benchmarks.Pure as Pure

20import qualified Benchmarks.ReadNumbers as ReadNumbers

19import qualified Benchmarks.ReadNumbers as ReadNumbers

21import qualified Benchmarks.Replace as Replace

20import qualified Benchmarks.Replace as Replace

@@ -50,10 +49,9 @@ benchmarks = do

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

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

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

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

52 , FoldLines.benchmark (tf "russian.txt")

51 , FoldLines.benchmark (tf "russian.txt")

53− , Mul.benchmark

54 , Pure.benchmark "tiny" (tf "tiny.txt")

52 , Pure.benchmark "tiny" (tf "tiny.txt")

55 , Pure.benchmark "ascii" (tf "ascii-small.txt")

53 , Pure.benchmark "ascii" (tf "ascii-small.txt")

56− -- , Pure.benchmark "france" (tf "france.html")

54+ , Pure.benchmark "france" (tf "france.html")

57 , Pure.benchmark "russian" (tf "russian-small.txt")

55 , Pure.benchmark "russian" (tf "russian-small.txt")

58 , Pure.benchmark "japanese" (tf "japanese.txt")

56 , Pure.benchmark "japanese" (tf "japanese.txt")

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

57 , 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, whnfIO)

28+import Criterion (Benchmark, bgroup, nf)

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" $ whnfIO $ iconv bs

51+ , bench "IConv" $ 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

10

11−import Control.Applicative ((<$>))

11+import Control.Exception (evaluate)

12−import Criterion (Benchmark, bgroup, bench, whnfIO)

12+import Criterion (Benchmark, bgroup, bench)

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

21

22benchmark :: FilePath -> IO Benchmark

23benchmark p = return $ bgroup "FileRead"

24− [ bench "String" $ whnfIO $ length <$> readFile p

24+ [ bench "String" $ readFile p >>= evaluate . length

25− , bench "ByteString" $ whnfIO $ SB.length <$> SB.readFile p

25+ , bench "ByteString" $ SB.readFile p >>= evaluate . SB.length

26− , bench "LazyByteString" $ whnfIO $ LB.length <$> LB.readFile p

26+ , bench "LazyByteString" $ LB.readFile p >>= evaluate . LB.length

27− , bench "Text" $ whnfIO $ T.length <$> T.readFile p

27+ , bench "Text" $ T.readFile p >>= evaluate . T.length

28− , bench "LazyText" $ whnfIO $ LT.length <$> LT.readFile p

28+ , bench "LazyText" $ LT.readFile p >>= evaluate . LT.length

29− , bench "TextByteString" $ whnfIO $

29+ , bench "TextByteString" $

30− (T.length . T.decodeUtf8) <$> SB.readFile p

30+ SB.readFile p >>= evaluate . T.length . T.decodeUtf8

31− , bench "LazyTextByteString" $ whnfIO $

31+ , bench "LazyTextByteString" $

32− (LT.length . LT.decodeUtf8) <$> LB.readFile p

32+ LB.readFile p >>= evaluate . LT.length . LT.decodeUtf8

33 ]

benchmarks/haskell/Benchmarks/FoldLines.hs+2−2

@@ -10,7 +10,7 @@ module Benchmarks.FoldLines

10 ( benchmark

11 ) where

12

13−import Criterion (Benchmark, bgroup, bench, whnfIO)

13+import Criterion (Benchmark, bgroup, bench)

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 = whnfIO $ do

25+ withHandle f = do

26 h <- openFile fp ReadMode

27 hSetBuffering h (BlockBuffering (Just 16384))

28 x <- f h

benchmarks/haskell/Benchmarks/Mul.hsdeleted−138

@@ -1,138 +0,0 @@

1−module Benchmarks.Mul (benchmark) where

2−

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

8−

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

13

14−import Criterion (Benchmark, bench, whnfIO)

14+import Criterion (Benchmark, bench)

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

20

21benchmark :: Handle -> IO Benchmark

22−benchmark sink = return $ bench "BigTable" $ whnfIO $ do

22+benchmark sink = return $ bench "BigTable" $ 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

18

19−import Criterion (Benchmark, bgroup, bench, whnfIO)

19+import Criterion (Benchmark, bgroup, bench)

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 $ whnfIO (s p sink from to)

43+ bench' n s = bench n (s p sink from to)

44

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

24+import Criterion (Benchmark, bench)

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

30

31benchmark :: FilePath -> Handle -> IO Benchmark

32benchmark i o = return $

33− bench "Fold" $ whnfIO $ T.readFile i >>= TL.hPutStr o . fold 80

33+ bench "Fold" $ T.readFile i >>= TL.hPutStr o . fold 80

34

35-- | We represent a paragraph by a word list

36--

benchmarks/haskell/Benchmarks/Programs/Sort.hs+9−10

@@ -17,7 +17,7 @@ module Benchmarks.Programs.Sort

17 ( benchmark

18 ) where

19

20−import Criterion (Benchmark, bgroup, bench, whnfIO)

20+import Criterion (Benchmark, bgroup, bench)

21import Data.Monoid (mconcat)

22import System.IO (Handle, hPutStr)

23import qualified Data.ByteString as B

@@ -35,17 +35,16 @@ import qualified Data.Text.Lazy.IO as TL

35

36benchmark :: FilePath -> Handle -> IO Benchmark

37benchmark i o = return $ bgroup "Sort"

38− [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string

38+ [ bench "String" $ readFile i >>= hPutStr o . string

39− , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString

39+ , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString

40− , bench "LazyByteString" $ whnfIO $

41− BL.readFile i >>= BL.hPutStr o . lazyByteString

40+ , bench "LazyByteString" $ BL.readFile i >>= BL.hPutStr o . lazyByteString

42− , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text

41+ , bench "Text" $ T.readFile i >>= T.hPutStr o . text

43− , bench "LazyText" $ whnfIO $ TL.readFile i >>= TL.hPutStr o . lazyText

42+ , bench "LazyText" $ TL.readFile i >>= TL.hPutStr o . lazyText

44− , bench "TextByteString" $ whnfIO $ B.readFile i >>=

43+ , bench "TextByteString" $ B.readFile i >>=

45 B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8

44 B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8

46− , bench "LazyTextByteString" $ whnfIO $ BL.readFile i >>=

45+ , bench "LazyTextByteString" $ BL.readFile i >>=

47 BL.hPutStr o . TL.encodeUtf8 . lazyText . TL.decodeUtf8

46 BL.hPutStr o . TL.encodeUtf8 . lazyText . TL.decodeUtf8

48− , bench "TextBuilder" $ whnfIO $ B.readFile i >>=

47+ , bench "TextBuilder" $ B.readFile i >>=

49 BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8

48 BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8

50 ]

49 ]

51

50

benchmarks/haskell/Benchmarks/Programs/StripTags.hs+5−5

@@ -15,7 +15,7 @@ module Benchmarks.Programs.StripTags

15 ( benchmark

16 ) where

17

18−import Criterion (Benchmark, bgroup, bench, whnfIO)

18+import Criterion (Benchmark, bgroup, bench)

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

26

27benchmark :: FilePath -> Handle -> IO Benchmark

28benchmark i o = return $ bgroup "StripTags"

29− [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string

29+ [ bench "String" $ readFile i >>= hPutStr o . string

30− , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString

30+ , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString

31− , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text

31+ , bench "Text" $ T.readFile i >>= T.hPutStr o . text

32− , bench "TextByteString" $ whnfIO $

32+ , bench "TextByteString" $

33 B.readFile i >>= B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8

34 ]

35

benchmarks/haskell/Benchmarks/Programs/Throughput.hs+8−8

@@ -18,7 +18,7 @@ module Benchmarks.Programs.Throughput

18 ( benchmark

19 ) where

20

21−import Criterion (Benchmark, bgroup, bench, whnfIO)

21+import Criterion (Benchmark, bgroup, bench)

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

29

30benchmark :: FilePath -> Handle -> IO Benchmark

31benchmark fp sink = return $ bgroup "Throughput"

32− [ bench "String" $ whnfIO $ readFile fp >>= hPutStr sink

32+ [ bench "String" $ readFile fp >>= hPutStr sink

33− , bench "ByteString" $ whnfIO $ B.readFile fp >>= B.hPutStr sink

33+ , bench "ByteString" $ B.readFile fp >>= B.hPutStr sink

34− , bench "LazyByteString" $ whnfIO $ BL.readFile fp >>= BL.hPutStr sink

34+ , bench "LazyByteString" $ BL.readFile fp >>= BL.hPutStr sink

35− , bench "Text" $ whnfIO $ T.readFile fp >>= T.hPutStr sink

35+ , bench "Text" $ T.readFile fp >>= T.hPutStr sink

36− , bench "LazyText" $ whnfIO $ TL.readFile fp >>= TL.hPutStr sink

36+ , bench "LazyText" $ TL.readFile fp >>= TL.hPutStr sink

37− , bench "TextByteString" $ whnfIO $

37+ , bench "TextByteString" $

38 B.readFile fp >>= B.hPutStr sink . T.encodeUtf8 . T.decodeUtf8

39− , bench "LazyTextByteString" $ whnfIO $

39+ , bench "LazyTextByteString" $

40 BL.readFile fp >>= BL.hPutStr sink . TL.encodeUtf8 . TL.decodeUtf8

41 ]

benchmarks/haskell/Benchmarks/Pure.hs−7

@@ -262,13 +262,6 @@ 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− ]

272 , bgroup "words"

265 , bgroup "words"

273 [ benchT $ nf T.words ta

266 [ benchT $ nf T.words ta

274 , benchTL $ nf TL.words tla

267 , benchTL $ nf TL.words tla

benchmarks/haskell/Benchmarks/ReadNumbers.hs+5−2

@@ -25,7 +25,8 @@ 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.Fractional as B

28+import qualified Data.ByteString.Lex.Double as B

29+import qualified Data.ByteString.Lex.Lazy.Double as BL

29import qualified Data.Text as T

30import qualified Data.Text as T

30import qualified Data.Text.IO as T

31import qualified Data.Text.IO as T

31import qualified Data.Text.Lazy as TL

32import qualified Data.Text.Lazy as TL

@@ -62,10 +63,12 @@ benchmark fp = do

62 whnf (double . text TL.rational) tl

63 whnf (double . text TL.rational) tl

63

64

64 , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b

65 , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b

65− , bench "DoubleByteString" $ whnf (double . byteString B.readDecimal) b

66+ , bench "DoubleByteString" $ whnf (double . byteString B.readDouble) b

66

67

67 , bench "DecimalLazyByteString" $

68 , bench "DecimalLazyByteString" $

68 whnf (int . byteString BL.readInt) bl

69 whnf (int . byteString BL.readInt) bl

70+ , bench "DoubleLazyByteString" $

71+ whnf (double . byteString BL.readDouble) bl

69 ]

72 ]

70 where

73 where

71 -- Used for fixing types

74 -- Used for fixing types

benchmarks/haskell/Benchmarks/Stream.hs+5−16

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

21+import qualified Data.Text.Internal.Fusion as T

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 FL

25+import qualified Data.Text.Internal.Lazy.Fusion as TL

26import qualified Data.Text.Lazy.IO as TL

27

28instance NFData a => NFData (Stream a) where

@@ -53,25 +53,14 @@ benchmark fp = do

53 !utf32beL = TL.encodeUtf32BE tl

54

55 -- For the functions which operate on streams

56− let !s = F.stream t

56+ let !s = T.stream t

57

58 return $ bgroup "Stream"

59

60 -- Fusion

61 [ bgroup "stream" $

62− [ bench "Text" $ nf F.stream t

62+ [ bench "Text" $ nf T.stream t

63− , bench "LazyText" $ nf FL.stream tl

63+ , bench "LazyText" $ nf TL.stream tl

64− ]

65− -- must perform exactly the same as stream above due to

66− -- stream/unstream (i.e. stream after unstream) fusion

67− , bgroup "stream-fusion" $

68− [ bench "Text" $ nf (F.stream . F.unstream . F.stream) t

69− , bench "LazyText" $ nf (FL.stream . FL.unstream . FL.stream) tl

70− ]

71− -- measure the overhead of unstream after stream

72− , bgroup "stream-unstream" $

73− [ bench "Text" $ nf (F.unstream . F.stream) t

74− , bench "LazyText" $ nf (FL.unstream . FL.stream) tl

75 ]

64 ]

76

65

77 -- Encoding.Fusion

66 -- Encoding.Fusion

benchmarks/text-benchmarks.cabal+5−16

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

6+license: BSD3

7license-file: ../LICENSE

8author: Jasper Van der Jeugt <jaspervdj@gmail.com>,

9 Bryan O'Sullivan <bos@serpentine.com>,

@@ -15,11 +15,6 @@ build-type: Simple

15

16cabal-version: >=1.2

17

18−flag bytestring-builder

19− description: Depend on the bytestring-builder package for backwards compatibility.

20− default: False

21− manual: False

22−

23flag llvm

18flag llvm

24 description: use LLVM

19 description: use LLVM

25 default: False

20 default: False

@@ -38,23 +33,17 @@ executable text-benchmarks

38 build-depends: base == 4.*,

33 build-depends: base == 4.*,

39 binary,

34 binary,

40 blaze-builder,

35 blaze-builder,

41− bytestring-lexing >= 0.5.0,

36+ bytestring,

37+ bytestring-lexing,

42 containers,

38 containers,

43− criterion >= 0.10.0.0,

39+ criterion >= 0.6.0.1,

44 deepseq,

40 deepseq,

45 directory,

41 directory,

46 filepath,

42 filepath,

47 ghc-prim,

43 ghc-prim,

48 integer-gmp,

44 integer-gmp,

49 stringsearch,

45 stringsearch,

50− utf8-string,

46+ utf8-string

51− vector

52−

53− if flag(bytestring-builder)

54− build-depends: bytestring >= 0.9 && < 0.10.4,

55− bytestring-builder >= 0.10.4

56− else

57− build-depends: bytestring >= 0.10.4

58

47

59executable text-multilang

48executable text-multilang

60 hs-source-dirs: haskell

49 hs-source-dirs: haskell

changelog.md−109

@@ -1,112 +1,3 @@

1−1.2.2.1

2−

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.

6−

7−* Spec compliance: toCaseFold now follows the Unicode 8.0 spec

8− (updated from 7.0)

9−

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−

1101.1.1.0

11.1.1.0

111

2

112* The Data.Data instance now allows gunfold to work, via a virtual

3* The Data.Data instance now allows gunfold to work, via a virtual

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− ,"{-# NOINLINE foldMapping #-}"]

40+ ,"{-# INLINE 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/Internal/Fusion/CaseMapping.hs"

11+ [] -> "../Data/Text/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/CaseMapping.hs"] ++

27+ ,"-- Generated by scripts/SpecialCasing.hs"] ++

28 comments ++

29 [""

30− ,"module Data.Text.Internal.Fusion.CaseMapping where"

30+ ,"module Data.Text.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− ,"{-# NOINLINE " ++ which ++ "Mapping #-}"]

46+ ,"{-# INLINE " ++ 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.hsdeleted−21

@@ -1,21 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−

3−module LiteralRuleTest where

4−

5−import Data.Text (Text)

6−

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+1−6

@@ -1,10 +1,5 @@

1count = 1000

2

3−all: coverage literal-rule-test

4−

5−literal-rule-test:

6− ./literal-rule-test.sh

7−

8coverage: build coverage/hpc_index.html

3coverage: build coverage/hpc_index.html

9

4

10build: text-test-data

5build: text-test-data

@@ -37,4 +32,4 @@ coverage/hpc_index.html: coverage/coverage.tix

37clean:

32clean:

38 rm -rf dist coverage .hpc

33 rm -rf dist coverage .hpc

39

34

40−.PHONY: build coverage all literal-rule-test

35+.PHONY: build coverage

tests/Tests/Properties.hs+43−120

@@ -1,8 +1,9 @@

1−-- | QuickCheck properties for the text library.

1+-- | General quicktest properties for the text library

2−

2+--

3{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,

4 ScopedTypeVariables, TypeSynonymInstances #-}

5−{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}

5+{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}

6+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

6module Tests.Properties

7module Tests.Properties

7 (

8 (

8 tests

9 tests

@@ -14,7 +15,7 @@ import Data.Bits ((.&.))

14import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)

15import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)

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

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

16import Data.Monoid (Monoid(..))

17import Data.Monoid (Monoid(..))

17−import Data.String (IsString(fromString))

18+import Data.String (fromString)

18import Data.Text.Encoding.Error

19import Data.Text.Encoding.Error

19import Data.Text.Foreign

20import Data.Text.Foreign

20import Data.Text.Internal.Encoding.Utf8

21import Data.Text.Internal.Encoding.Utf8

@@ -23,7 +24,7 @@ import Data.Text.Internal.Search (indices)

23import Data.Text.Lazy.Read as TL

24import Data.Text.Lazy.Read as TL

24import Data.Text.Read as T

25import Data.Text.Read as T

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

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

26−import Numeric (showEFloat, showFFloat, showGFloat, showHex)

27+import Numeric (showHex)

27import Prelude hiding (replicate)

28import Prelude hiding (replicate)

28import Test.Framework (Test, testGroup)

29import Test.Framework (Test, testGroup)

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

30import Test.Framework.Providers.QuickCheck2 (testProperty)

@@ -53,7 +54,6 @@ import qualified Data.Text.Lazy.Builder.RealFloat as TB

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

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

54import qualified Data.Text.Lazy.IO as TL

55import qualified Data.Text.Lazy.IO as TL

55import qualified System.IO as IO

56import qualified System.IO as IO

56−import qualified Tests.Properties.Mul as Mul

57import qualified Tests.SlowFunctions as Slow

58

59t_pack_unpack = (T.unpack . T.pack) `eq` id

@@ -197,10 +197,8 @@ 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 $

201− mconcat `eq` (unpackS . mconcat . L.map T.pack)

200+t_mconcat = mconcat `eq` (unpackS . mconcat . L.map T.pack)

202−tl_mconcat = unsquare $

203− mconcat `eq` (unpackS . mconcat . L.map TL.pack)

201+tl_mconcat = mconcat `eq` (unpackS . mconcat . L.map TL.pack)

204t_mempty = mempty == (unpackS (mempty :: T.Text))

202t_mempty = mempty == (unpackS (mempty :: T.Text))

205tl_mempty = mempty == (unpackS (mempty :: TL.Text))

203tl_mempty = mempty == (unpackS (mempty :: TL.Text))

206t_IsString = fromString `eqP` (T.unpack . fromString)

204t_IsString = fromString `eqP` (T.unpack . fromString)

@@ -264,14 +262,11 @@ s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)

264sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)

262sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)

265t_map f = map f `eqP` (unpackS . T.map f)

263t_map f = map f `eqP` (unpackS . T.map f)

266tl_map f = map f `eqP` (unpackS . TL.map f)

264tl_map f = map f `eqP` (unpackS . TL.map f)

267−s_intercalate c = unsquare $

268− L.intercalate c `eq`

265+s_intercalate c = L.intercalate c `eq`

269 (unpackS . S.intercalate (packS c) . map packS)

266 (unpackS . S.intercalate (packS c) . map packS)

270−t_intercalate c = unsquare $

271− L.intercalate c `eq`

267+t_intercalate c = L.intercalate c `eq`

272 (unpackS . T.intercalate (packS c) . map packS)

268 (unpackS . T.intercalate (packS c) . map packS)

273−tl_intercalate c = unsquare $

274− L.intercalate c `eq`

269+tl_intercalate c = L.intercalate c `eq`

275 (unpackS . TL.intercalate (TL.pack c) . map TL.pack)

270 (unpackS . TL.intercalate (TL.pack c) . map TL.pack)

276s_intersperse c = L.intersperse c `eqP`

271s_intersperse c = L.intersperse c `eqP`

277 (unpackS . S.intersperse c)

272 (unpackS . S.intersperse c)

@@ -279,14 +274,10 @@ s_intersperse_s c = L.intersperse c `eqP`

279 (unpackS . S.unstream . S.intersperse c)

274 (unpackS . S.unstream . S.intersperse c)

280sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`

275sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`

281 (unpackS . S.intersperse c . S.filter p)

276 (unpackS . S.intersperse c . S.filter p)

282−t_intersperse c = unsquare $

283− L.intersperse c `eqP` (unpackS . T.intersperse c)

277+t_intersperse c = L.intersperse c `eqP` (unpackS . T.intersperse c)

284−tl_intersperse c = unsquare $

285− L.intersperse c `eqP` (unpackS . TL.intersperse c)

278+tl_intersperse c = L.intersperse c `eqP` (unpackS . TL.intersperse c)

286−t_transpose = unsquare $

287− L.transpose `eq` (map unpackS . T.transpose . map packS)

279+t_transpose = L.transpose `eq` (map unpackS . T.transpose . map packS)

288−tl_transpose = unsquare $

289− L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)

280+tl_transpose = L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)

290t_reverse = L.reverse `eqP` (unpackS . T.reverse)

281t_reverse = L.reverse `eqP` (unpackS . T.reverse)

291tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)

282tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)

292t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)

283t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)

@@ -383,24 +374,17 @@ sf_foldr p f z = (L.foldr f z . L.filter p) `eqP` (S.foldr f z . S.filter p)

383 where _types = f :: Char -> Char -> Char

374 where _types = f :: Char -> Char -> Char

384t_foldr f z = L.foldr f z `eqP` T.foldr f z

375t_foldr f z = L.foldr f z `eqP` T.foldr f z

385 where _types = f :: Char -> Char -> Char

376 where _types = f :: Char -> Char -> Char

386−tl_foldr f z = unsquare $

387− L.foldr f z `eqP` TL.foldr f z

377+tl_foldr f z = L.foldr f z `eqP` TL.foldr f z

388 where _types = f :: Char -> Char -> Char

378 where _types = f :: Char -> Char -> Char

389−sf_foldr1 p f = unsquare $

390− (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)

379+sf_foldr1 p f = (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)

391t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f

380t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f

392−tl_foldr1 f = unsquare $

393− L.foldr1 f `eqP` TL.foldr1 f

381+tl_foldr1 f = L.foldr1 f `eqP` TL.foldr1 f

394

382

395−s_concat_s = unsquare $

396− L.concat `eq` (unpackS . S.unstream . S.concat . map packS)

383+s_concat_s = L.concat `eq` (unpackS . S.unstream . S.concat . map packS)

397−sf_concat p = unsquare $

398− (L.concat . map (L.filter p)) `eq`

384+sf_concat p = (L.concat . map (L.filter p)) `eq`

399 (unpackS . S.concat . map (S.filter p . packS))

385 (unpackS . S.concat . map (S.filter p . packS))

400−t_concat = unsquare $

401− L.concat `eq` (unpackS . T.concat . map packS)

386+t_concat = L.concat `eq` (unpackS . T.concat . map packS)

402−tl_concat = unsquare $

403− L.concat `eq` (unpackS . TL.concat . map TL.pack)

387+tl_concat = L.concat `eq` (unpackS . TL.concat . map TL.pack)

404sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`

388sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`

405 (unpackS . S.concatMap (packS . f) . S.filter p)

389 (unpackS . S.concatMap (packS . f) . S.filter p)

406t_concatMap f = unsquare $

390t_concatMap f = unsquare $

@@ -440,10 +424,6 @@ t_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z)

440tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)

424tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)

441 where _types = f :: Int -> Char -> (Int,Char)

425 where _types = f :: Int -> Char -> (Int,Char)

442

426

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−

447replicate n l = concat (L.replicate n l)

427replicate n l = concat (L.replicate n l)

448

428

449s_replicate n = replicate m `eq`

429s_replicate n = replicate m `eq`

@@ -455,14 +435,6 @@ tl_replicate n = replicate m `eq`

455 (unpackS . TL.replicate (fromIntegral m) . packS)

435 (unpackS . TL.replicate (fromIntegral m) . packS)

456 where m = fromIntegral (n :: Word8)

436 where m = fromIntegral (n :: Word8)

457

437

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−

466unf :: Int -> Char -> Maybe (Char, Char)

438unf :: Int -> Char -> Maybe (Char, Char)

467unf n c | fromEnum c * 100 > n = Nothing

439unf n c | fromEnum c * 100 > n = Nothing

468 | otherwise = Just (c, succ c)

440 | otherwise = Just (c, succ c)

@@ -516,10 +488,6 @@ sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`

516 (unpackS . S.takeWhile p . S.filter q)

488 (unpackS . S.takeWhile p . S.filter q)

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

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

518tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)

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

523s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)

491s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)

524s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)

492s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)

525sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`

493sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`

@@ -572,27 +540,24 @@ tl_groupBy p = L.groupBy p `eqP` (map unpackS . TL.groupBy p)

572t_inits = L.inits `eqP` (map unpackS . T.inits)

540t_inits = L.inits `eqP` (map unpackS . T.inits)

573tl_inits = L.inits `eqP` (map unpackS . TL.inits)

541tl_inits = L.inits `eqP` (map unpackS . TL.inits)

574t_tails = L.tails `eqP` (map unpackS . T.tails)

542t_tails = L.tails `eqP` (map unpackS . T.tails)

575−tl_tails = unsquare $

576− L.tails `eqP` (map unpackS . TL.tails)

543+tl_tails = L.tails `eqP` (map unpackS . TL.tails)

577−t_findAppendId = unsquare $ \(NotEmpty s) ts ->

544+t_findAppendId (NotEmpty s) = unsquare $ \ts ->

578 let t = T.intercalate s ts

545 let t = T.intercalate s ts

579 in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)

546 in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)

580−tl_findAppendId = unsquare $ \(NotEmpty s) ts ->

547+tl_findAppendId (NotEmpty s) = unsquare $ \ts ->

581 let t = TL.intercalate s ts

548 let t = TL.intercalate s ts

582 in all (==t) $ map (uncurry TL.append) (TL.breakOnAll s t)

549 in all (==t) $ map (uncurry TL.append) (TL.breakOnAll s t)

583−t_findContains = unsquare $ \(NotEmpty s) ->

584− all (T.isPrefixOf s . snd) . T.breakOnAll s . T.intercalate s

550+t_findContains (NotEmpty s) = all (T.isPrefixOf s . snd) . T.breakOnAll s .

551+ T.intercalate s

585−tl_findContains = unsquare $ \(NotEmpty s) -> all (TL.isPrefixOf s . snd) .

552+tl_findContains (NotEmpty s) = all (TL.isPrefixOf s . snd) .

586 TL.breakOnAll s . TL.intercalate s

553 TL.breakOnAll s . TL.intercalate s

587sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c

554sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c

588t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s

555t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s

589tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s

556tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s

590

557

591−t_splitOn_split s = unsquare $

592− (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s

558+t_splitOn_split s = (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s

593−tl_splitOn_split s = unsquare $

594− ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`

559+tl_splitOn_split s = ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`

595− (map TL.fromStrict . T.splitOn s)) . T.intercalate s

560+ (map TL.fromStrict . T.splitOn s)) . T.intercalate s

596t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)

561t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)

597tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)

562tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)

598

563

@@ -634,14 +599,10 @@ t_lines' = lines' `eqP` (map unpackS . T.lines')

634t_words = L.words `eqP` (map unpackS . T.words)

599t_words = L.words `eqP` (map unpackS . T.words)

635

600

636tl_words = L.words `eqP` (map unpackS . TL.words)

601tl_words = L.words `eqP` (map unpackS . TL.words)

637−t_unlines = unsquare $

638− L.unlines `eq` (unpackS . T.unlines . map packS)

602+t_unlines = L.unlines `eq` (unpackS . T.unlines . map packS)

639−tl_unlines = unsquare $

640− L.unlines `eq` (unpackS . TL.unlines . map packS)

603+tl_unlines = L.unlines `eq` (unpackS . TL.unlines . map packS)

641−t_unwords = unsquare $

642− L.unwords `eq` (unpackS . T.unwords . map packS)

604+t_unwords = L.unwords `eq` (unpackS . T.unwords . map packS)

643−tl_unwords = unsquare $

644− L.unwords `eq` (unpackS . TL.unwords . map packS)

605+tl_unwords = L.unwords `eq` (unpackS . TL.unwords . map packS)

645

606

646s_isPrefixOf s = L.isPrefixOf s `eqP`

607s_isPrefixOf s = L.isPrefixOf s `eqP`

647 (S.isPrefixOf (S.stream $ packS s) . S.stream)

608 (S.isPrefixOf (S.stream $ packS s) . S.stream)

@@ -718,9 +679,8 @@ t_indices (NotEmpty s) = Slow.indices s `eq` indices s

718tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s

679tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s

719 where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)

680 where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)

720 conc = T.concat . TL.toChunks

681 conc = T.concat . TL.toChunks

721−t_indices_occurs = unsquare $ \(NotEmpty t) ts ->

682+t_indices_occurs (NotEmpty t) ts = let s = T.intercalate t ts

722− let s = T.intercalate t ts

723− in Slow.indices t s == indices t s

683+ in Slow.indices t s == indices t s

724

684

725-- Bit shifts.

685-- Bit shifts.

726shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k

686shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k

@@ -756,7 +716,6 @@ tb_decimal :: (Integral a, Show a) => a -> Bool

756tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)

716tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)

757

717

758tb_decimal_integer (a::Integer) = tb_decimal a

718tb_decimal_integer (a::Integer) = tb_decimal a

759−tb_decimal_integer_big (Big a) = tb_decimal a

760tb_decimal_int (a::Int) = tb_decimal a

719tb_decimal_int (a::Int) = tb_decimal a

761tb_decimal_int8 (a::Int8) = tb_decimal a

720tb_decimal_int8 (a::Int8) = tb_decimal a

762tb_decimal_int16 (a::Int16) = tb_decimal a

721tb_decimal_int16 (a::Int16) = tb_decimal a

@@ -768,11 +727,6 @@ tb_decimal_word16 (a::Word16) = tb_decimal a

768tb_decimal_word32 (a::Word32) = tb_decimal a

727tb_decimal_word32 (a::Word32) = tb_decimal a

769tb_decimal_word64 (a::Word64) = tb_decimal a

728tb_decimal_word64 (a::Word64) = tb_decimal a

770

729

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−

776tb_hex :: (Integral a, Show a) => a -> Bool

730tb_hex :: (Integral a, Show a) => a -> Bool

777tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")

731tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")

778

732

@@ -794,21 +748,6 @@ tb_realfloat = (TB.toLazyText . TB.realFloat) `eq` (TL.pack . show)

794tb_realfloat_float (a::Float) = tb_realfloat a

748tb_realfloat_float (a::Float) = tb_realfloat a

795tb_realfloat_double (a::Double) = tb_realfloat a

749tb_realfloat_double (a::Double) = tb_realfloat a

796

750

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−

812-- Reading.

751-- Reading.

813

752

814t_decimal (n::Int) s =

753t_decimal (n::Int) s =

@@ -817,18 +756,16 @@ t_decimal (n::Int) s =

817tl_decimal (n::Int) s =

756tl_decimal (n::Int) s =

818 TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)

757 TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)

819 where t = TL.dropWhile isDigit s

758 where t = TL.dropWhile isDigit s

820−t_hexadecimal m s ox =

759+t_hexadecimal (n::Positive Int) s ox =

821 T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)

760 T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)

822 where t = T.dropWhile isHexDigit s

761 where t = T.dropWhile isHexDigit s

823 p = if ox then "0x" else ""

762 p = if ox then "0x" else ""

824− n = getPositive m :: Int

763+tl_hexadecimal (n::Positive Int) s ox =

825−tl_hexadecimal m s ox =

826 TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)

764 TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)

827 where t = TL.dropWhile isHexDigit s

765 where t = TL.dropWhile isHexDigit s

828 p = if ox then "0x" else ""

766 p = if ox then "0x" else ""

829− n = getPositive m :: Int

830

767

831−isFloaty c = c `elem` ("+-.0123456789eE" :: String)

768+isFloaty c = c `elem` "+-.0123456789eE"

832

769

833t_read_rational p tol (n::Double) s =

770t_read_rational p tol (n::Double) s =

834 case p (T.pack (show n) `T.append` t) of

771 case p (T.pack (show n) `T.append` t) of

@@ -1110,12 +1047,9 @@ tests =

1110 ],

1047 ],

1111

1048

1112 testGroup "unfolds" [

1049 testGroup "unfolds" [

1113− testProperty "tl_repeat" tl_repeat,

1114 testProperty "s_replicate" s_replicate,

1050 testProperty "s_replicate" s_replicate,

1115 testProperty "t_replicate" t_replicate,

1051 testProperty "t_replicate" t_replicate,

1116 testProperty "tl_replicate" tl_replicate,

1052 testProperty "tl_replicate" tl_replicate,

1117− testProperty "tl_cycle" tl_cycle,

1118− testProperty "tl_iterate" tl_iterate,

1119 testProperty "t_unfoldr" t_unfoldr,

1053 testProperty "t_unfoldr" t_unfoldr,

1120 testProperty "tl_unfoldr" tl_unfoldr,

1054 testProperty "tl_unfoldr" tl_unfoldr,

1121 testProperty "t_unfoldrN" t_unfoldrN,

1055 testProperty "t_unfoldrN" t_unfoldrN,

@@ -1146,8 +1080,6 @@ tests =

1146 testProperty "sf_takeWhile" sf_takeWhile,

1080 testProperty "sf_takeWhile" sf_takeWhile,

1147 testProperty "t_takeWhile" t_takeWhile,

1081 testProperty "t_takeWhile" t_takeWhile,

1148 testProperty "tl_takeWhile" tl_takeWhile,

1082 testProperty "tl_takeWhile" tl_takeWhile,

1149− testProperty "t_takeWhileEnd" t_takeWhileEnd,

1150− testProperty "tl_takeWhileEnd" tl_takeWhileEnd,

1151 testProperty "sf_dropWhile" sf_dropWhile,

1083 testProperty "sf_dropWhile" sf_dropWhile,

1152 testProperty "s_dropWhile" s_dropWhile,

1084 testProperty "s_dropWhile" s_dropWhile,

1153 testProperty "s_dropWhile_s" s_dropWhile_s,

1085 testProperty "s_dropWhile_s" s_dropWhile_s,

@@ -1293,16 +1225,11 @@ tests =

1293 testProperty "tb_decimal_int32" tb_decimal_int32,

1225 testProperty "tb_decimal_int32" tb_decimal_int32,

1294 testProperty "tb_decimal_int64" tb_decimal_int64,

1226 testProperty "tb_decimal_int64" tb_decimal_int64,

1295 testProperty "tb_decimal_integer" tb_decimal_integer,

1227 testProperty "tb_decimal_integer" tb_decimal_integer,

1296− testProperty "tb_decimal_integer_big" tb_decimal_integer_big,

1297 testProperty "tb_decimal_word" tb_decimal_word,

1228 testProperty "tb_decimal_word" tb_decimal_word,

1298 testProperty "tb_decimal_word8" tb_decimal_word8,

1229 testProperty "tb_decimal_word8" tb_decimal_word8,

1299 testProperty "tb_decimal_word16" tb_decimal_word16,

1230 testProperty "tb_decimal_word16" tb_decimal_word16,

1300 testProperty "tb_decimal_word32" tb_decimal_word32,

1231 testProperty "tb_decimal_word32" tb_decimal_word32,

1301− testProperty "tb_decimal_word64" tb_decimal_word64,

1232+ testProperty "tb_decimal_word64" tb_decimal_word64

1302− testProperty "tb_decimal_big_int" tb_decimal_big_int,

1303− testProperty "tb_decimal_big_word" tb_decimal_big_word,

1304− testProperty "tb_decimal_big_int64" tb_decimal_big_int64,

1305− testProperty "tb_decimal_big_word64" tb_decimal_big_word64

1306 ],

1233 ],

1307 testGroup "hexadecimal" [

1234 testGroup "hexadecimal" [

1308 testProperty "tb_hexadecimal_int" tb_hexadecimal_int,

1235 testProperty "tb_hexadecimal_int" tb_hexadecimal_int,

@@ -1319,9 +1246,7 @@ tests =

1319 ],

1246 ],

1320 testGroup "realfloat" [

1247 testGroup "realfloat" [

1321 testProperty "tb_realfloat_double" tb_realfloat_double,

1248 testProperty "tb_realfloat_double" tb_realfloat_double,

1322− testProperty "tb_realfloat_float" tb_realfloat_float,

1249+ testProperty "tb_realfloat_float" tb_realfloat_float

1323− testProperty "tb_formatRealFloat_float" tb_formatRealFloat_float,

1324− testProperty "tb_formatRealFloat_double" tb_formatRealFloat_double

1325 ],

1250 ],

1326 testProperty "tb_fromText" tb_fromText,

1251 testProperty "tb_fromText" tb_fromText,

1327 testProperty "tb_singleton" tb_singleton

1252 testProperty "tb_singleton" tb_singleton

@@ -1357,7 +1282,5 @@ tests =

1357 testProperty "t_take_drop_16" t_take_drop_16,

1282 testProperty "t_take_drop_16" t_take_drop_16,

1358 testProperty "t_use_from" t_use_from,

1283 testProperty "t_use_from" t_use_from,

1359 testProperty "t_copy" t_copy

1284 testProperty "t_copy" t_copy

1360− ],

1285+ ]

1361−

1362− testGroup "mul" Mul.tests

1363 ]

1286 ]

tests/Tests/Properties/Mul.hsdeleted−40

@@ -1,40 +0,0 @@

1−{-# LANGUAGE ScopedTypeVariables #-}

2−

3−module Tests.Properties.Mul (tests) where

4−

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+82−73

@@ -7,46 +7,48 @@

7module Tests.QuickCheckUtils

8 (

9 genUnicode

10+ , genUnicodeWith

11+ , ascii

12+ , plane0

13+ , plane1

14+ , plane2

15+ , plane14

16+ , planes

17+

10 , unsquare

18 , unsquare

11 , smallArbitrary

19 , smallArbitrary

12

20

13− , BigBounded(..)

14− , BigInt(..)

15− , NotEmpty(..)

21+ , NotEmpty (..)

16

22

17− , Small(..)

23+ , Small (..)

18 , small

24 , small

19

25

20− , Precision(..)

21− , precision

22−

23 , integralRandomR

26 , integralRandomR

24

27

25− , DecodeErr(..)

28+ , DecodeErr (..)

26 , genDecodeErr

29 , genDecodeErr

27

30

28− , Stringy(..)

31+ , Stringy (..)

29 , eq

32 , eq

30 , eqP

33 , eqP

31

34

32− , Encoding(..)

35+ , Encoding (..)

33

36

34 , write_read

37 , write_read

35 ) where

38 ) where

36

39

37−import Control.Applicative ((<$>))

38import Control.Arrow (first, (***))

40import Control.Arrow (first, (***))

39import Control.DeepSeq (NFData (..), deepseq)

41import Control.DeepSeq (NFData (..), deepseq)

40import Control.Exception (bracket)

42import Control.Exception (bracket)

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

44+import Data.Char (chr)

41import Data.String (IsString, fromString)

45import Data.String (IsString, fromString)

42import Data.Text.Foreign (I16)

46import Data.Text.Foreign (I16)

43−import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))

44import Data.Word (Word8, Word16)

47import Data.Word (Word8, Word16)

45import Debug.Trace (trace)

48import Debug.Trace (trace)

46−import System.Random (Random(..), RandomGen)

49+import System.Random (Random (..), RandomGen)

47−import Test.QuickCheck hiding (Fixed(..), Small (..), (.&.))

50+import Test.QuickCheck hiding (Small (..), (.&.))

48import Test.QuickCheck.Monadic (assert, monadicIO, run)

51import Test.QuickCheck.Monadic (assert, monadicIO, run)

49−import Test.QuickCheck.Unicode (string)

50import Tests.Utils

52import Tests.Utils

51import qualified Data.ByteString as B

53import qualified Data.ByteString as B

52import qualified Data.Text as T

54import qualified Data.Text as T

@@ -58,14 +60,6 @@ import qualified Data.Text.Internal.Lazy.Fusion as TLF

58import qualified Data.Text.Lazy as TL

60import qualified Data.Text.Lazy as TL

59import qualified System.IO as IO

61import qualified System.IO as IO

60

62

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

68−

69instance Random I16 where

63instance Random I16 where

70 randomR = integralRandomR

64 randomR = integralRandomR

71 random = randomR (minBound,maxBound)

65 random = randomR (minBound,maxBound)

@@ -79,23 +73,76 @@ instance Arbitrary B.ByteString where

79 shrink = map B.pack . shrink . B.unpack

73 shrink = map B.pack . shrink . B.unpack

80

74

81#if !MIN_VERSION_base(4,4,0)

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

90instance Random Word8 where

76instance Random Word8 where

91 randomR = integralRandomR

77 randomR = integralRandomR

92 random = randomR (minBound,maxBound)

78 random = randomR (minBound,maxBound)

93−

94−instance Random Word64 where

95− randomR = integralRandomR

96− random = randomR (minBound,maxBound)

97#endif

79#endif

98

80

81+genUnicode :: IsString a => Gen a

82+genUnicode = genUnicodeWith planes

83+

84+genUnicodeWith :: IsString a => [Gen Int] -> Gen a

85+genUnicodeWith gens = fmap fromString string

86+ where

87+ string = sized $ \n ->

88+ do k <- choose (0,n)

89+ sequence [ char | _ <- [1..k] ]

90+

91+ excluding :: [a -> Bool] -> Gen a -> Gen a

92+ excluding bad gen = loop

93+ where

94+ loop = do

95+ x <- gen

96+ if or (map ($ x) bad)

97+ then loop

98+ else return x

99+

100+ reserved = [lowSurrogate, highSurrogate, noncharacter]

101+ lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF

102+ highSurrogate c = c >= 0xD800 && c <= 0xDBFF

103+ noncharacter c = masked == 0xFFFE || masked == 0xFFFF

104+ where

105+ masked = c .&. 0xFFFF

106+

107+ char = chr `fmap` excluding reserved (oneof gens)

108+

109+ascii :: Gen Int

110+ascii = choose (0,0x7F)

111+

112+plane0 :: Gen Int

113+plane0 = choose (0xF0, 0xFFFF)

114+

115+plane1 :: Gen Int

116+plane1 = oneof [ choose (0x10000, 0x10FFF)

117+ , choose (0x11000, 0x11FFF)

118+ , choose (0x12000, 0x12FFF)

119+ , choose (0x13000, 0x13FFF)

120+ , choose (0x1D000, 0x1DFFF)

121+ , choose (0x1F000, 0x1FFFF)

122+ ]

123+

124+plane2 :: Gen Int

125+plane2 = oneof [ choose (0x20000, 0x20FFF)

126+ , choose (0x21000, 0x21FFF)

127+ , choose (0x22000, 0x22FFF)

128+ , choose (0x23000, 0x23FFF)

129+ , choose (0x24000, 0x24FFF)

130+ , choose (0x25000, 0x25FFF)

131+ , choose (0x26000, 0x26FFF)

132+ , choose (0x27000, 0x27FFF)

133+ , choose (0x28000, 0x28FFF)

134+ , choose (0x29000, 0x29FFF)

135+ , choose (0x2A000, 0x2AFFF)

136+ , choose (0x2B000, 0x2BFFF)

137+ , choose (0x2F000, 0x2FFFF)

138+ ]

139+

140+plane14 :: Gen Int

141+plane14 = choose (0xE0000, 0xE0FFF)

142+

143+planes :: [Gen Int]

144+planes = [ascii, plane0, plane1, plane2, plane14]

145+

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

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

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

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

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

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

@@ -113,20 +160,6 @@ instance Arbitrary TL.Text where

113 arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary

160 arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary

114 shrink = map TL.pack . shrink . TL.unpack

161 shrink = map TL.pack . shrink . TL.unpack

115

162

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−

130newtype NotEmpty a = NotEmpty { notEmpty :: a }

163newtype NotEmpty a = NotEmpty { notEmpty :: a }

131 deriving (Eq, Ord)

164 deriving (Eq, Ord)

132

165

@@ -267,30 +300,6 @@ eqP f g s w = eql "orig" (f s) (g t) &&

267 | a =^= b = True

300 | a =^= b = True

268 | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False

301 | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False

269

302

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−

294-- Work around lack of Show instance for TextEncoding.

303-- Work around lack of Show instance for TextEncoding.

295data Encoding = E String IO.TextEncoding

304data Encoding = E String IO.TextEncoding

296

305

tests/cabal.config+1

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

1-- These flags help to speed up building the test suite.

2

3documentation: False

4+executable-profiling: False

4executable-stripping: False

5executable-stripping: False

5flags: developer

6flags: developer

6library-profiling: False

7library-profiling: False

tests/literal-rule-test.shdeleted−29

@@ -1,29 +0,0 @@

1−#!/bin/bash -e

2−

3−failed=0

4−

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+1−13

@@ -3,7 +3,7 @@ version: 0.0.0.0

3synopsis: Functional tests for the text package

4description: Functional tests for the text package

5homepage: https://github.com/bos/text

6−license: BSD2

6+license: BSD3

7license-file: ../LICENSE

8author: Jasper Van der Jeugt <jaspervdj@gmail.com>,

9 Bryan O'Sullivan <bos@serpentine.com>,

@@ -23,15 +23,6 @@ flag hpc

23executable text-tests

24 main-is: Tests.hs

25

26− other-modules:

27− Tests.IO

28− Tests.Properties

29− Tests.Properties.Mul

30− Tests.QuickCheckUtils

31− Tests.Regressions

32− Tests.SlowFunctions

33− Tests.Utils

34−

35 ghc-options:

26 ghc-options:

36 -Wall -threaded -O0 -rtsopts

27 -Wall -threaded -O0 -rtsopts

37

28

@@ -51,7 +42,6 @@ executable text-tests

51 bytestring,

42 bytestring,

52 deepseq,

43 deepseq,

53 directory,

44 directory,

54− quickcheck-unicode,

55 random,

45 random,

56 test-framework >= 0.4,

46 test-framework >= 0.4,

57 test-framework-hunit >= 0.2,

47 test-framework-hunit >= 0.2,

@@ -114,7 +104,6 @@ library

114 Data.Text.Internal.Lazy.Search

104 Data.Text.Internal.Lazy.Search

115 Data.Text.Internal.Private

105 Data.Text.Internal.Private

116 Data.Text.Read

106 Data.Text.Read

117− Data.Text.Show

118 Data.Text.Internal.Read

107 Data.Text.Internal.Read

119 Data.Text.Internal.Search

108 Data.Text.Internal.Search

120 Data.Text.Unsafe

109 Data.Text.Unsafe

@@ -136,7 +125,6 @@ library

136 build-depends:

125 build-depends:

137 array,

126 array,

138 base == 4.*,

127 base == 4.*,

139− binary,

140 bytestring,

128 bytestring,

141 deepseq,

129 deepseq,

142 ghc-prim,

130 ghc-prim,

text.cabal+6−25

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

1name: text

2−version: 1.2.2.1

2+version: 1.1.1.4

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>

33

34−license: BSD2

34+license: BSD3

35license-file: LICENSE

36author: Bryan O'Sullivan <bos@serpentine.com>

37maintainer: Bryan O'Sullivan <bos@serpentine.com>

@@ -59,16 +59,10 @@ extra-source-files:

59 tests/.ghci

60 tests/Makefile

61 tests/Tests/*.hs

62− tests/Tests/Properties/*.hs

63 tests/cabal.config

62 tests/cabal.config

64 tests/scripts/*.sh

63 tests/scripts/*.sh

65 tests/text-tests.cabal

64 tests/text-tests.cabal

66

65

67−flag bytestring-builder

68− description: Depend on the bytestring-builder package for backwards compatibility.

69− default: False

70− manual: False

71−

72flag developer

66flag developer

73 description: operate in developer mode

67 description: operate in developer mode

74 default: False

68 default: False

@@ -77,7 +71,6 @@ flag developer

77flag integer-simple

71flag integer-simple

78 description: Use the simple integer library instead of GMP

72 description: Use the simple integer library instead of GMP

79 default: False

73 default: False

80− manual: False

81

74

82library

75library

83 c-sources: cbits/cbits.c

76 c-sources: cbits/cbits.c

@@ -128,21 +121,16 @@ library

128 Data.Text.Read

121 Data.Text.Read

129 Data.Text.Unsafe

122 Data.Text.Unsafe

130

123

131− other-modules:

132− Data.Text.Show

133−

134 build-depends:

124 build-depends:

135 array >= 0.3,

125 array >= 0.3,

136 base >= 4.2 && < 5,

126 base >= 4.2 && < 5,

137− binary,

138 deepseq >= 1.1.0.0,

127 deepseq >= 1.1.0.0,

139 ghc-prim >= 0.2

128 ghc-prim >= 0.2

140

129

141− if flag(bytestring-builder)

130+ if impl(ghc >= 7.7)

142− build-depends: bytestring >= 0.9 && < 0.10.4,

131+ build-depends: bytestring >= 0.10.4.0

143− bytestring-builder >= 0.10.4

144 else

132 else

145− build-depends: bytestring >= 0.10.4

133+ build-depends: bytestring >= 0.9

146

134

147 cpp-options: -DHAVE_DEEPSEQ

135 cpp-options: -DHAVE_DEEPSEQ

148 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2

136 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2

@@ -176,22 +164,15 @@ test-suite tests

176 QuickCheck >= 2.7,

164 QuickCheck >= 2.7,

177 array,

165 array,

178 base,

166 base,

179− binary,

167+ bytestring,

180 deepseq,

168 deepseq,

181 directory,

169 directory,

182 ghc-prim,

170 ghc-prim,

183− quickcheck-unicode,

184 random,

171 random,

185 test-framework >= 0.4,

172 test-framework >= 0.4,

186 test-framework-hunit >= 0.2,

173 test-framework-hunit >= 0.2,

187 test-framework-quickcheck2 >= 0.2

174 test-framework-quickcheck2 >= 0.2

188

175

189− if flag(bytestring-builder)

190− build-depends: bytestring >= 0.9 && < 0.10.4,

191− bytestring-builder >= 0.10.4

192− else

193− build-depends: bytestring >= 0.10.4

194−

195 if flag(integer-simple)

176 if flag(integer-simple)

196 cpp-options: -DINTEGER_SIMPLE

177 cpp-options: -DINTEGER_SIMPLE

197 build-depends: integer-simple >= 0.1 && < 0.5

178 build-depends: integer-simple >= 0.1 && < 0.5