4fc784a...master · text

git.iko.soy/text

52 files changed+1641−510

since splitsnapshots

unifiedsplit

.gitignore+1

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

11dist

22cabal-dev

3+cabal.sandbox.config

.hgtags+14−1

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

5050fb7299f22449750c653ac64dee4bd63c13ea6e4c 1.1.1.1

5151eb170cb533b63534d166b5fd5344b36676adf140 1.1.1.2

5252e749e05f715d02445803f653cd3d97d5395d7c6f 1.1.1.3

53−44b9927d4a2cc45a824a94f1f81a73b9ba61af43 1.1.1.4

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

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

33#if __GLASGOW_HASKELL__ >= 702

44{-# LANGUAGE Trustworthy #-}

55#endif

6+#if __GLASGOW_HASKELL__ >= 708

7+{-# LANGUAGE TypeFamilies #-}

8+#endif

710-- |

811-- Module : Data.Text

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

126129 , drop

127130 , dropEnd

128131 , takeWhile

132+ , takeWhileEnd

129133 , dropWhile

130134 , dropWhileEnd

131135 , dropAround

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

188192

189193 -- * Low level operations

190194 , copy

195+ , unpackCString#

191196 ) where

192197

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

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

195− Read(..), Show(..),

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

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

200+ Read(..),

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

202+ not, return, otherwise, quot)

198203#if defined(HAVE_DEEPSEQ)

199−import Control.DeepSeq (NFData)

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

200205#endif

201206#if defined(ASSERTS)

202207import Control.Exception (assert)

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

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

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

207212import Control.Monad (foldM)

213+import Control.Monad.ST (ST)

208214import qualified Data.Text.Array as A

209215import qualified Data.List as L

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

210217import Data.Monoid (Monoid(..))

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

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

220+#endif

211221import Data.String (IsString(..))

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

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

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

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

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

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

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

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

217229import qualified Prelude as P

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

219231 reverseIter_, unsafeHead, unsafeTail)

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

226238import qualified Data.Text.Lazy as L

227239import Data.Int (Int64)

228240#endif

229−#if __GLASGOW_HASKELL__ >= 702

230−import qualified GHC.CString as GHC

231−#else

232−import qualified GHC.Base as GHC

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

242+#if __GLASGOW_HASKELL__ >= 708

243+import qualified GHC.Exts as Exts

244+#endif

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

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

233247#endif

234−import GHC.Prim (Addr#)

235248

236249-- $strict

237250--

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

317330instance Ord Text where

318331 compare = compareText

319332

320−instance Show Text where

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

322−

323333instance Read Text where

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

325335

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+

326344instance Monoid Text where

327345 mempty = empty

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

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

348+#else

328349 mappend = append

350+#endif

329351 mconcat = concat

330352

331353instance IsString Text where

332354 fromString = pack

333355

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+

334363#if defined(HAVE_DEEPSEQ)

335−instance NFData Text

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

336365#endif

337366

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+

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

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

340377--

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

358395 _ -> P.error "gunfold"

359396 dataTypeOf _ = textDataType

360397

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+

361404packConstr :: Constr

362405packConstr = mkConstr textDataType "pack" [] Prefix

363406

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

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

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

389432

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−

414433-- -----------------------------------------------------------------------------

415434-- * Basic functions

416435

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

441460 | otherwise = overflowError "append"

442461 where

443462 len = len1+len2

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

444464 x = do

445465 arr <- A.new len

446466 A.copyI arr 0 arr1 off1 len1

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

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

467487uncons t@(Text arr off len)

468488 | len <= 0 = Nothing

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

470− where Iter c d = iter t 0

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

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

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

472492

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

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

552572-- Subject to fusion.

553573length :: Text -> Int

554574length t = S.length (stream t)

555−{-# INLINE length #-}

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

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

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

556578

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

558580-- Subject to fusion.

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

571593

572594{-# RULES

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

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

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

575597 #-}

576598

577599{-# RULES

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

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

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

580602 #-}

581603

582604{-# RULES

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

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

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

585607 #-}

586608

587609{-# RULES

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

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

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

590612 #-}

591613

592614{-# RULES

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

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

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

595617 #-}

596618

597619{-# RULES

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

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

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

600622 #-}

601623

602624-- -----------------------------------------------------------------------------

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

627649reverse t = S.reverse (stream t)

628650{-# INLINE reverse #-}

629651

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

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

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

654+--

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

656+--

657+-- @

658+-- replace needle replacement haystack =

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

660+-- @

661+--

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

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

664+-- be replaced recursively:

665+--

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

667+--

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

669+-- first one will be replaced:

670+--

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

631672--

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

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

634−replace :: Text -> Text -> Text -> Text

675+replace :: Text

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

677+ -- error will occur.

678+ -> Text

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

680+ -> Text

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

682+ -> Text

635683replace needle@(Text _ _ neeLen)

636684 (Text repArr repOff repLen)

637685 haystack@(Text hayArr hayOff hayLen)

638686 | neeLen == 0 = emptyError "replace"

639687 | L.null ixs = haystack

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

641− | len < 0 = overflowError "replace"

642689 | otherwise = empty

643690 where

644691 ixs = indices needle haystack

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

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

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

646694 x = do

647695 marr <- A.new len

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

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

693741-- instead of itself.

694742toCaseFold :: Text -> Text

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

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

744+{-# INLINE toCaseFold #-}

697745

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

699747-- conversion. Subject to fusion.

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

853901 where

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

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

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

856905 go = do

857906 arr <- A.new len

858907 let step i (Text a o l) =

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

866915{-# INLINE concatMap #-}

867916

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

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

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

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

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

872921{-# INLINE any #-}

873922

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

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

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

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

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

878927{-# INLINE all #-}

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

9631012 | n <= 0 || l <= 0 = empty

9641013 | n == 1 = t

9651014 | isSingleton t = replicateChar n (unsafeHead t)

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

967− | otherwise = overflowError "replicate"

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

9681016 where

969− len = l * n

1017+ len = l `mul` n

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

9701019 x = do

9711020 arr <- A.new len

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

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

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

11041153 #-}

11051154

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+

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

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

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

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

11211191 #-}

11221192

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

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

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

11251195-- @t@. Subject to fusion.

1196+--

11261197-- Examples:

11271198--

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

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

11421213 #-}

11431214

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

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

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

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

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

11481219dropAround p = dropWhile p . dropWhileEnd p

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

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

12381309-- are slices of the original.

12391310

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

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

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

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

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

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

12431314--

12441315-- Examples:

12451316--

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

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

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

12541325--

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

1327+--

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

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

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

1330+splitOn :: Text

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

1332+ -- will occur.

1333+ -> Text

1334+ -- ^ Input text.

1335+ -> [Text]

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

12591337 | l <= 0 = emptyError "splitOn"

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

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

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

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

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

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

1543+{-# INLINE zip #-}

14661544

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

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

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

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

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

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

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

1551+{-# INLINE zipWith #-}

14741552

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

14761554-- representing white space.

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

16701748copy :: Text -> Text

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

16721750 where

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

16731752 go = do

16741753 marr <- A.new len

16751754 A.copyI marr 0 arr off len

Data/Text/Array.hs+5−4

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

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

2121--

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

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

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

2424-- naming.

2525module Data.Text.Array

2626 (

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

7474#endif

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

7676 indexWord16Array#, newByteArray#,

77− unsafeCoerce#, writeWord16Array#)

77+ unsafeFreezeByteArray#, writeWord16Array#)

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

7979import GHC.Word (Word16(..))

8080import Prelude hiding (length, read)

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

130130

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

132132unsafeFreeze :: MArray s -> ST s Array

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

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

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

134+ case unsafeFreezeByteArray# maBA s1# of

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

135136#if defined(ASSERTS)

136137 maLen

137138#endif

Data/Text/Encoding.hs+10−23

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

5555 , encodeUtf32LE

5656 , encodeUtf32BE

5757

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

5958 -- * Encoding Text using ByteString Builders

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

61− -- @bytestring >= 0.10.4.0@.

6259 , encodeUtf8Builder

6360 , encodeUtf8BuilderEscaped

64−#endif

6561 ) where

6662

6763#if __GLASGOW_HASKELL__ >= 702

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

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

7167#endif

7268

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−

8369import Control.Exception (evaluate, try)

8470import Control.Monad.ST (runST)

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

8572import Data.ByteString as B

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

87−import Data.Text ()

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

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

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

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

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

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

79+import Data.Text.Show ()

9380import Data.Text.Unsafe (unsafeDupablePerformIO)

9481import Data.Word (Word8, Word32)

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

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

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

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

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

10192import qualified Data.Text.Array as A

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

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

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

10496

10597#include "text_cbits.h"

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

119111

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

121113-- encoded text.

122−--

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

124114decodeASCII :: ByteString -> Text

125115decodeASCII = decodeUtf8

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

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

269259 UTF8_REJECT -> do

270260 -- We encountered an encoding error

271261 x <- peek curPtr'

262+ poke statePtr 0

272263 case onErr desc (Just x) of

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

274265 Just c -> do

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

276267 w <- unsafeSTToIO $

277268 unsafeWrite dest (fromIntegral destOff) (safe c)

278269 poke destOffPtr (destOff + fromIntegral w)

279− poke statePtr 0

280270 loop $ curPtr' `plusPtr` 1

281271

282272 _ -> do

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

288278 return $! text arr 0 (fromIntegral n)

289279 lastPtr <- peek curPtrPtr

290280 let left = lastPtr `minusPtr` curPtr

291− undecoded = case state of

281+ !undecoded = case state of

292282 UTF8_ACCEPT -> B.empty

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

294284 return $ Some chunkText undecoded

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

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

318308{-# INLINE decodeUtf8' #-}

319309

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

321−

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

323311encodeUtf8Builder :: Text -> B.Builder

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

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

379367 outerLoop i (B.BufferRange op ope)

380368 where

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

382−#endif

383370

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

385372encodeUtf8 :: Text -> ByteString

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

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

11{-# LANGUAGE CPP, DeriveDataTypeable #-}

2−#if __GLASGOW_HASKELL__ >= 702

2+#if __GLASGOW_HASKELL__ >= 704

3+{-# LANGUAGE Safe #-}

4+#elif __GLASGOW_HASKELL__ >= 702

35{-# LANGUAGE Trustworthy #-}

46#endif

57-- |

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

6668type OnDecodeError = OnError Word8 Char

6769

6870-- | A handler for an encoding error.

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

6972type OnEncodeError = OnError Char Word8

7073

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

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

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

7982 deriving (Eq, Typeable)

8083

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

85+

8186showUnicodeException :: UnicodeException -> String

8287showUnicodeException (DecodeError desc (Just w))

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

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

107112lenientDecode _ _ = Just '\xfffd'

108113

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

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

110116strictEncode :: OnEncodeError

111117strictEncode desc c = throw (EncodeError desc c)

112118

Data/Text/Internal.hs+64−4

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

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

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

22{-# OPTIONS_HADDOCK not-home #-}

44-- |

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

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

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

2222

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

24+#include "MachDeps.h"

25+#endif

26+

2327module Data.Text.Internal

2428 (

2529 -- * Types

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

3236 , safe

3337 -- * Code that must be here for accessibility

3438 , empty

39+ , empty_

3540 -- * Utilities

3641 , firstf

42+ -- * Checked multiplication

43+ , mul

44+ , mul32

45+ , mul64

3746 -- * Debugging

3847 , showText

3948 ) where

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

4150#if defined(ASSERTS)

4251import Control.Exception (assert)

4352#endif

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

45−import qualified Data.Text.Array as A

53+import Data.Bits

54+import Data.Int (Int32, Int64)

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

4756import Data.Typeable (Typeable)

57+import qualified Data.Text.Array as A

4858

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

5060data Text = Text

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

7282empty = Text A.empty 0 0

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

7484

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

86+empty_ :: Text

87+empty_ = Text A.empty 0 0

88+{-# NOINLINE empty_ #-}

89+

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

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

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

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

101116safe c

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

103118 | otherwise = '\xfffd'

104−{-# INLINE safe #-}

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

105120

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

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

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

109124firstf _ Nothing = Nothing

110125

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+

111171-- $internals

112172--

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

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

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

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

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

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

1010--

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

1212-- Stability : experimental

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

5858 ) where

5959

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

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

6261import Data.Monoid (Monoid(..))

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

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

64+#endif

6365import Data.Text.Internal (Text(..))

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

6567import Data.Text.Unsafe (inlineInterleaveST)

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

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

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

6869import Prelude hiding (map, putChar)

6970

7071import qualified Data.String as String

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

9192 -> ST s [S.Text]

9293 }

9394

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

96+instance Semigroup Builder where

97+ (<>) = append

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

99+#endif

100+

94101instance Monoid Builder where

95102 mempty = empty

96103 {-# INLINE mempty #-}

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

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

106+#else

97107 mappend = append

108+#endif

98109 {-# INLINE mappend #-}

99− mconcat = foldr mappend mempty

110+ mconcat = foldr mappend Data.Monoid.mempty

100111 {-# INLINE mconcat #-}

101112

102113instance String.IsString Builder where

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

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

128139--

129140singleton :: Char -> Builder

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

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

141142{-# INLINE singleton #-}

142143

143144------------------------------------------------------------------------

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

241242 !t = Text arr o u

242243 ts <- inlineInterleaveST (k b)

243244 return $! t : ts

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

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

244247

245248------------------------------------------------------------------------

246249

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

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

2323

2424import Data.Monoid (mappend)

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

26−import GHC.Base

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

27+import Prelude ()

2728

2829-- | Unsafe conversion for decimal digits.

2930{-# INLINE i2d #-}

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

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

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

5−-- License: BSD3

5+-- License: BSD-style

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

77-- Stability: experimental

88-- Portability: portable

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

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

1+{-# LANGUAGE CPP #-}

13-- |

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

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

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

1315 ) where

1416

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

1642roundTo d is =

1743 case f d is of

1844 x@(0,_) -> x

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

2753 where

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

2955 i' = c + i

56+

57+#endif

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

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

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

9999unstream :: Stream Char -> Text

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

101− let mlen = upperBound 4 len

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

102106 arr0 <- A.new mlen

103− let outer arr top = loop

107+ let outer !arr !maxi = encode

104108 where

105− loop !s !i =

106− case next0 s of

107− Done -> done arr i

108− Skip s' -> loop s' i

109− Yield x s'

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

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

112− arr' <- A.new top'

113− A.copyM arr' 0 arr 0 top

114− outer arr' top' s i

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

116− loop s' (i+d)

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

118− | otherwise = i + 1

119− outer arr0 mlen s0 0

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

110+ encode !si !di =

111+ case next0 si of

112+ Done -> done arr di

113+ Skip si' -> encode si' di

114+ Yield c si'

115+ -- simply check for the worst case

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

117+ | otherwise -> do

118+ n <- unsafeWrite arr di c

119+ encode si' (di + n)

120+

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

122+ {-# NOINLINE realloc #-}

123+ realloc !si !di = do

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

125+ arr' <- A.new newlen

126+ A.copyM arr' 0 arr 0 di

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

128+

129+ outer arr0 (mlen - 1) s0 0

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

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

122132

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

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

167177-- the input and result reversed.

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

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

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

170180 where

171181 {-# INLINE next #-}

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

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

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

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

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

177− Done -> Done

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

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

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

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

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

187+ Done -> Done

178188{-# INLINE reverseScanr #-}

179189

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

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

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

11{-# LANGUAGE Rank2Types #-}

22-- AUTOMATICALLY GENERATED - DO NOT EDIT

3−-- Generated by scripts/SpecialCasing.hs

4−-- CaseFolding-6.3.0.txt

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

6−-- SpecialCasing-6.3.0.txt

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

3+-- Generated by scripts/CaseMapping.hs

4+-- CaseFolding-8.0.0.txt

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

6+-- SpecialCasing-8.0.0.txt

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

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

1010import Data.Char

1111import Data.Text.Internal.Fusion.Types

1212

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

14−{-# INLINE upperMapping #-}

14+{-# NOINLINE upperMapping #-}

1515-- LATIN SMALL LETTER SHARP S

1616upperMapping '\x00df' s = Yield '\x0053' (CC s '\x0053' '\x0000')

1717-- LATIN SMALL LIGATURE FF

@@ -218,12 +218,12 @@ upperMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0399')

218218upperMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0399')

219219upperMapping c s = Yield (toUpper c) (CC s '\0' '\0')

220220lowerMapping :: forall s. Char -> s -> Step (CC s) Char

221−{-# INLINE lowerMapping #-}

221+{-# NOINLINE lowerMapping #-}

222222-- LATIN CAPITAL LETTER I WITH DOT ABOVE

223223lowerMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')

224224lowerMapping c s = Yield (toLower c) (CC s '\0' '\0')

225225titleMapping :: forall s. Char -> s -> Step (CC s) Char

226−{-# INLINE titleMapping #-}

226+{-# NOINLINE titleMapping #-}

227227-- LATIN SMALL LETTER SHARP S

228228titleMapping '\x00df' s = Yield '\x0053' (CC s '\x0073' '\x0000')

229229-- LATIN SMALL LIGATURE FF

@@ -322,7 +322,7 @@ titleMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0345')

322322titleMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0345')

323323titleMapping c s = Yield (toTitle c) (CC s '\0' '\0')

324324foldMapping :: forall s. Char -> s -> Step (CC s) Char

325−{-# INLINE foldMapping #-}

325+{-# NOINLINE foldMapping #-}

326326-- MICRO SIGN

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

328328-- LATIN SMALL LETTER SHARP S

@@ -359,10 +359,18 @@ foldMapping '\x03f1' s = Yield '\x03c1' (CC s '\x0000' '\x0000')

359359foldMapping '\x03f5' s = Yield '\x03b5' (CC s '\x0000' '\x0000')

360360-- ARMENIAN SMALL LIGATURE ECH YIWN

361361foldMapping '\x0587' s = Yield '\x0565' (CC s '\x0582' '\x0000')

362−-- GEORGIAN CAPITAL LETTER YN

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

364−-- GEORGIAN CAPITAL LETTER AEN

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

362+-- CHEROKEE SMALL LETTER YE

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

364+-- CHEROKEE SMALL LETTER YI

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

366+-- CHEROKEE SMALL LETTER YO

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

368+-- CHEROKEE SMALL LETTER YU

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

370+-- CHEROKEE SMALL LETTER YV

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

372+-- CHEROKEE SMALL LETTER MV

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

366374-- LATIN SMALL LETTER H WITH LINE BELOW

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

368376-- LATIN SMALL LETTER T WITH DIAERESIS

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

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

538546-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI

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

540−-- COPTIC CAPITAL LETTER BOHAIRIC KHEI

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

542−-- LATIN CAPITAL LETTER C WITH BAR

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

544−-- LATIN CAPITAL LETTER H WITH HOOK

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

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

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

550+-- LATIN CAPITAL LETTER CHI

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

552+-- LATIN CAPITAL LETTER BETA

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

554+-- LATIN CAPITAL LETTER OMEGA

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

556+-- CHEROKEE SMALL LETTER A

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

558+-- CHEROKEE SMALL LETTER E

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

560+-- CHEROKEE SMALL LETTER I

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

562+-- CHEROKEE SMALL LETTER O

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

564+-- CHEROKEE SMALL LETTER U

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

566+-- CHEROKEE SMALL LETTER V

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

568+-- CHEROKEE SMALL LETTER GA

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

570+-- CHEROKEE SMALL LETTER KA

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

572+-- CHEROKEE SMALL LETTER GE

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

574+-- CHEROKEE SMALL LETTER GI

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

576+-- CHEROKEE SMALL LETTER GO

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

578+-- CHEROKEE SMALL LETTER GU

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

580+-- CHEROKEE SMALL LETTER GV

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

582+-- CHEROKEE SMALL LETTER HA

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

584+-- CHEROKEE SMALL LETTER HE

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

586+-- CHEROKEE SMALL LETTER HI

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

588+-- CHEROKEE SMALL LETTER HO

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

590+-- CHEROKEE SMALL LETTER HU

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

592+-- CHEROKEE SMALL LETTER HV

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

594+-- CHEROKEE SMALL LETTER LA

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

596+-- CHEROKEE SMALL LETTER LE

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

598+-- CHEROKEE SMALL LETTER LI

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

600+-- CHEROKEE SMALL LETTER LO

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

602+-- CHEROKEE SMALL LETTER LU

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

604+-- CHEROKEE SMALL LETTER LV

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

606+-- CHEROKEE SMALL LETTER MA

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

608+-- CHEROKEE SMALL LETTER ME

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

610+-- CHEROKEE SMALL LETTER MI

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

612+-- CHEROKEE SMALL LETTER MO

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

614+-- CHEROKEE SMALL LETTER MU

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

616+-- CHEROKEE SMALL LETTER NA

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

618+-- CHEROKEE SMALL LETTER HNA

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

620+-- CHEROKEE SMALL LETTER NAH

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

622+-- CHEROKEE SMALL LETTER NE

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

624+-- CHEROKEE SMALL LETTER NI

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

626+-- CHEROKEE SMALL LETTER NO

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

628+-- CHEROKEE SMALL LETTER NU

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

630+-- CHEROKEE SMALL LETTER NV

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

632+-- CHEROKEE SMALL LETTER QUA

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

634+-- CHEROKEE SMALL LETTER QUE

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

636+-- CHEROKEE SMALL LETTER QUI

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

638+-- CHEROKEE SMALL LETTER QUO

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

640+-- CHEROKEE SMALL LETTER QUU

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

642+-- CHEROKEE SMALL LETTER QUV

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

644+-- CHEROKEE SMALL LETTER SA

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

646+-- CHEROKEE SMALL LETTER S

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

648+-- CHEROKEE SMALL LETTER SE

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

650+-- CHEROKEE SMALL LETTER SI

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

652+-- CHEROKEE SMALL LETTER SO

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

654+-- CHEROKEE SMALL LETTER SU

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

656+-- CHEROKEE SMALL LETTER SV

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

658+-- CHEROKEE SMALL LETTER DA

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

660+-- CHEROKEE SMALL LETTER TA

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

662+-- CHEROKEE SMALL LETTER DE

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

664+-- CHEROKEE SMALL LETTER TE

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

666+-- CHEROKEE SMALL LETTER DI

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

668+-- CHEROKEE SMALL LETTER TI

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

670+-- CHEROKEE SMALL LETTER DO

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

672+-- CHEROKEE SMALL LETTER DU

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

674+-- CHEROKEE SMALL LETTER DV

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

676+-- CHEROKEE SMALL LETTER DLA

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

678+-- CHEROKEE SMALL LETTER TLA

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

680+-- CHEROKEE SMALL LETTER TLE

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

682+-- CHEROKEE SMALL LETTER TLI

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

684+-- CHEROKEE SMALL LETTER TLO

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

686+-- CHEROKEE SMALL LETTER TLU

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

688+-- CHEROKEE SMALL LETTER TLV

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

690+-- CHEROKEE SMALL LETTER TSA

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

692+-- CHEROKEE SMALL LETTER TSE

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

694+-- CHEROKEE SMALL LETTER TSI

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

696+-- CHEROKEE SMALL LETTER TSO

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

698+-- CHEROKEE SMALL LETTER TSU

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

700+-- CHEROKEE SMALL LETTER TSV

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

702+-- CHEROKEE SMALL LETTER WA

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

704+-- CHEROKEE SMALL LETTER WE

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

706+-- CHEROKEE SMALL LETTER WI

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

708+-- CHEROKEE SMALL LETTER WO

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

710+-- CHEROKEE SMALL LETTER WU

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

712+-- CHEROKEE SMALL LETTER WV

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

714+-- CHEROKEE SMALL LETTER YA

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

546716-- LATIN SMALL LIGATURE FF

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

548718-- LATIN SMALL LIGATURE FI

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

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

568738-- ARMENIAN SMALL LIGATURE MEN XEH

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

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

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

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

7171 -- ** Scans

7272 , scanl

7373

74− -- ** Accumulating maps

75− -- , mapAccumL

76−

7774 -- ** Generation and unfolding

7875 , replicateCharI

7976 , replicateI

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

123120singleton c = Stream next False 1

124121 where next False = Yield c True

125122 next True = Done

126−{-# INLINE singleton #-}

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

127124

128125streamList :: [a] -> Stream a

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

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

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

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

189186

187+data Snoc a = N

188+ | J !a

189+

190190-- | /O(n)/ Adds a character to the end of a stream.

191191snoc :: Stream Char -> Char -> Stream Char

192192snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)

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

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

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

475475

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

477+ | Just2 !i !s

478+

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

477480justifyLeftI k c (Stream next0 s0 len) =

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

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

479482 where

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

483+ next (Just1 n s) =

481484 case next0 s of

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

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

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

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

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

485+ Done -> next (Just2 n s)

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

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

488+ next (Just2 n s)

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

487490 | otherwise = Done

488491 {-# INLINE next #-}

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

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

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

591594

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

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

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

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

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

596599 where

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

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

603606

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

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

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

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

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

608611 where

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

651654-- * Building streams

652655

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

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

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

655658 where

656659 {-# INLINE next #-}

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

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

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

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

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

662− Done -> Done

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

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

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

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

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

665+ Done -> Done

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

664667

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−

688668-- -----------------------------------------------------------------------------

689669-- ** Generating and unfolding streams

690670

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

692−replicateCharI n c

672+replicateCharI !n !c

693673 | n < 0 = empty

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

695675 where

696− next i | i >= n = Done

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

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

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

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

699679

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

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

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

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

761741

742+data Drop a s = NS !s

743+ | JS !a !s

744+

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

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

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

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

766749drop n0 (Stream next0 s0 len) =

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

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

768751 where

769752 {-# INLINE next #-}

770− next (J n :*: s)

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

753+ next (JS n s)

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

772755 | otherwise = case next0 s of

773756 Done -> Done

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

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

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

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

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

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

777760 Done -> Done

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

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

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

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

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

781764

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

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

794777

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

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

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

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

798781 where

799782 {-# INLINE next #-}

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

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

801784 Done -> Done

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

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

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

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

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

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

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

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

806789 Done -> Done

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

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

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

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

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

810793

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

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

912895-------------------------------------------------------------------------------

913896-- * Zipping

914897

898+-- | Strict triple.

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

900+ | Z2 !a !b !m

901+

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

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

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

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

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

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

920907 where

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

922− Done -> Done

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

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

925−

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

927− Done -> Done

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

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

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

909+ Done -> Done

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

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

912+

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

914+ Done -> Done

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

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

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

931918

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

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

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

3232 , isEmpty

3333 ) where

3434

35+import Data.Text.Internal (mul)

3536#if defined(ASSERTS)

3637import Control.Exception (assert)

3738#endif

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

100101subtractSize _ _ = Unknown

101102{-# INLINE subtractSize #-}

102103

103−mul :: Int -> Int -> Int

104−mul m n

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

106− | otherwise = overflowError

107−{-# INLINE mul #-}

108−

109104mulSize :: Size -> Size -> Size

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

111106mulSize _ _ = Unknown

Data/Text/Internal/Fusion/Types.hs+8−13

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

2020module Data.Text.Internal.Fusion.Types

2121 (

2222 CC(..)

23− , M(..)

24− , M8

2523 , PairS(..)

24+ , Scan(..)

2625 , RS(..)

2726 , Step(..)

2827 , Stream(..)

29− , Switch(..)

3028 , empty

3129 ) where

3230

@@ -36,26 +34,23 @@ import Data.Word (Word8)

3634-- | Specialised tuple for case conversion.

3735data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char

3836

39−-- | Specialised, strict Maybe-like type.

40−data M a = N

41− | J !a

42−

43−type M8 = M Word8

44−

45−-- Restreaming state.

37+-- | Restreaming state.

4638data RS s

4739 = RS0 !s

4840 | RS1 !s {-# UNPACK #-} !Word8

4941 | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

5042 | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

5143

52−infixl 2 :*:

44+-- | Strict pair.

5345data PairS a b = !a :*: !b

5446 -- deriving (Eq, Ord, Show)

47+infixl 2 :*:

5548

56−-- | Allow a function over a stream to switch between two states.

57−data Switch = S1 | S2

49+-- | An intermediate result in a scan.

50+data Scan s = Scan1 {-# UNPACK #-} !Char !s

51+ | Scan2 {-# UNPACK #-} !Char !s

5852

53+-- | Intermediate result in a processing pipeline.

5954data Step s a = Done

6055 | Skip !s

6156 | Yield !a !s

Data/Text/Internal/Read.hs+3−3

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

77-- Stability : experimental

88-- Portability : GHC

99--

10−-- Common internal functiopns for reading textual data.

10+-- Common internal functions for reading textual data.

1111module Data.Text.Internal.Read

1212 (

1313 IReader

@@ -18,7 +18,7 @@ module Data.Text.Internal.Read

1818 , perhaps

1919 ) where

2020

21−import Control.Applicative (Applicative(..))

21+import Control.Applicative as App (Applicative(..))

2222import Control.Arrow (first)

2323import Control.Monad (ap)

2424import Data.Char (ord)

@@ -38,7 +38,7 @@ instance Applicative (IParser t) where

3838 (<*>) = ap

3939

4040instance Monad (IParser t) where

41− return = pure

41+ return = App.pure

4242 m >>= k = P $ \t -> case runP m t of

4343 Left err -> Left err

4444 Right (a,t') -> runP (k a) t'

Data/Text/Lazy.hs+161−21

@@ -3,6 +3,10 @@

33#if __GLASGOW_HASKELL__ >= 702

44{-# LANGUAGE Trustworthy #-}

55#endif

6+#if __GLASGOW_HASKELL__ >= 708

7+{-# LANGUAGE TypeFamilies #-}

8+#endif

610-- |

711-- Module : Data.Text.Lazy

@@ -121,7 +125,10 @@ module Data.Text.Lazy

121125 , mapAccumR

122126

123127 -- ** Generation and unfolding

128+ , repeat

124129 , replicate

130+ , cycle

131+ , iterate

125132 , unfoldr

126133 , unfoldrN

127134

@@ -133,6 +140,7 @@ module Data.Text.Lazy

133140 , drop

134141 , dropEnd

135142 , takeWhile

143+ , takeWhileEnd

136144 , dropWhile

137145 , dropWhileEnd

138146 , dropAround

@@ -203,9 +211,13 @@ import Control.DeepSeq (NFData(..))

203211import Data.Int (Int64)

204212import qualified Data.List as L

205213import Data.Char (isSpace)

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

207−import Data.Data (mkNoRepType)

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

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

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

208217import Data.Monoid (Monoid(..))

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

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

220+#endif

209221import Data.String (IsString(..))

210222import qualified Data.Text as T

211223import qualified Data.Text.Internal as T

@@ -214,8 +226,10 @@ import qualified Data.Text.Unsafe as T

214226import qualified Data.Text.Internal.Lazy.Fusion as S

215227import Data.Text.Internal.Fusion.Types (PairS(..))

216228import Data.Text.Internal.Lazy.Fusion (stream, unstream)

217−import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks, foldrChunks)

229+import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks,

230+ foldrChunks, smallChunkSize)

218231import Data.Text.Internal (firstf, safe, text)

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

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

220234import Data.Text.Internal.Lazy.Search (indices)

221235#if __GLASGOW_HASKELL__ >= 702

@@ -223,7 +237,13 @@ import qualified GHC.CString as GHC

223237#else

224238import qualified GHC.Base as GHC

225239#endif

240+#if __GLASGOW_HASKELL__ >= 708

241+import qualified GHC.Exts as Exts

242+#endif

226243import GHC.Prim (Addr#)

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

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

246+#endif

227247

228248-- $fusion

229249--

@@ -321,25 +341,71 @@ instance Show Text where

321341instance Read Text where

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

323343

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+

324352instance Monoid Text where

325353 mempty = empty

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

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

356+#else

326357 mappend = append

358+#endif

327359 mconcat = concat

328360

329361instance IsString Text where

330362 fromString = pack

331363

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+

332371#if defined(HAVE_DEEPSEQ)

333372instance NFData Text where

334373 rnf Empty = ()

335374 rnf (Chunk _ ts) = rnf ts

336375#endif

337376

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'

338390instance Data Text where

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

340− toConstr _ = error "Data.Text.Lazy.Text.toConstr"

341− gunfold _ _ = error "Data.Text.Lazy.Text.gunfold"

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

392+ toConstr _ = packConstr

393+ gunfold k z c = case constrIndex c of

394+ 1 -> k (z pack)

395+ _ -> error "Data.Text.Lazy.Text.gunfold"

396+ dataTypeOf _ = textDataType

397+

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

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

400+instance PrintfArg Text where

401+ formatArg txt = formatString $ unpack txt

402+#endif

403+

404+packConstr :: Constr

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

406+

407+textDataType :: DataType

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

343409

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

345411--

@@ -367,6 +433,14 @@ unpackCString# addr# = unstream (S.streamCString# addr#)

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

368434 = unpackCString# a #-}

369435

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+

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

371445-- Performs replacement on invalid scalar values.

372446singleton :: Char -> Text

@@ -471,7 +545,7 @@ tail Empty = emptyError "tail"

471545 unstream (S.tail (stream t)) = tail t

472546 #-}

473547

474−-- | /O(1)/ Returns all but the last character of a 'Text', which must

548+-- | /O(n\/c)/ Returns all but the last character of a 'Text', which must

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

476550init :: Text -> Text

477551init (Chunk t0 ts0) = go t0 ts0

@@ -507,7 +581,7 @@ isSingleton :: Text -> Bool

507581isSingleton = S.isSingleton . stream

508582{-# INLINE isSingleton #-}

509583

510−-- | /O(1)/ Returns the last character of a 'Text', which must be

584+-- | /O(n\/c)/ Returns the last character of a 'Text', which must be

511585-- non-empty. Subject to fusion.

512586last :: Text -> Char

513587last Empty = emptyError "last"

@@ -641,13 +715,36 @@ reverse = rev Empty

641715 where rev a Empty = a

642716 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts

643717

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

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

719+-- @haystack@ with @replacement@.

720+--

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

722+--

723+-- @

724+-- replace needle replacement haystack =

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

726+-- @

727+--

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

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

730+-- be replaced recursively:

731+--

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

733+--

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

735+-- first one will be replaced:

736+--

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

645738--

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

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

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

649− -> Text -- ^ Replacement text

650− -> Text -- ^ Input text

741+replace :: Text

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

743+ -- error will occur.

744+ -> Text

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

746+ -> Text

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

651748 -> Text

652749replace s d = intercalate d . splitOn s

653750{-# INLINE replace #-}

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

784881{-# INLINE concatMap #-}

785882

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

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

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

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

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

790887{-# INLINE any #-}

791888

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

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

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

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

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

796893{-# INLINE all #-}

@@ -873,6 +970,12 @@ mapAccumR f = go

873970 go z Empty = (z, Empty)

874971{-# INLINE mapAccumR #-}

875972

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+

876979-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input

877980-- @t@ repeated @n@ times.

878981replicate :: Int64 -> Text -> Text

@@ -884,6 +987,21 @@ replicate n t

884987 | otherwise = t : rep (i+1)

885988{-# INLINE [1] replicate #-}

886989

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+

8871005-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the

8881006-- value of every element. Subject to fusion.

8891007replicateChar :: Int64 -> Char -> Text

@@ -1026,6 +1144,20 @@ takeWhile p t0 = takeWhile' t0

10261144"LAZY TEXT takeWhile -> unfused" [1] forall p t.

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

10281146 #-}

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

10291161

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

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

@@ -1044,9 +1176,11 @@ dropWhile p t0 = dropWhile' t0

10441176"LAZY TEXT dropWhile -> unfused" [1] forall p t.

10451177 unstream (S.dropWhile p (stream t)) = dropWhile p t

10461178 #-}

1179+

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

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

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

10491182-- @t@.

1183+--

10501184-- Examples:

10511185--

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

@@ -1063,7 +1197,7 @@ dropWhileEnd p = go

10631197{-# INLINE dropWhileEnd #-}

10641198

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

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

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

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

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

10691203dropAround p = dropWhile p . dropWhileEnd p

@@ -1258,9 +1392,10 @@ tails ts@(Chunk t ts')

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

12591393-- are slices of the original.

12601394

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

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

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

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

1396+-- argument (which cannot be an empty string), consuming the

1397+-- delimiter. An empty delimiter is invalid, and will cause an error

1398+-- to be raised.

12641399--

12651400-- Examples:

12661401--

@@ -1273,13 +1408,18 @@ tails ts@(Chunk t ts')

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

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

12751410--

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

1412+--

12761413-- This function is strict in its first argument, and lazy in its

12771414-- second.

12781415--

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

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

1281−splitOn :: Text -- ^ Text to split on

1282− -> Text -- ^ Input text

1418+splitOn :: Text

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

1420+ -- will occur.

1421+ -> Text

1422+ -- ^ Input text.

12831423 -> [Text]

12841424splitOn pat src

12851425 | null pat = emptyError "splitOn"

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

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

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

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

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

1212--

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

1414-- Stability : experimental

Data/Text/Lazy/Builder/Int.hs+19−14

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

1−{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, UnboxedTuples #-}

1+{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,

2+ UnboxedTuples #-}

23#if __GLASGOW_HASKELL__ >= 702

34{-# LANGUAGE Trustworthy #-}

45#endif

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

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

9−-- License: BSD3

10+-- License: BSD-style

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

1112-- Stability: experimental

1213-- Portability: portable

@@ -34,7 +35,7 @@ import Control.Monad.ST

3435

3536#ifdef __GLASGOW_HASKELL__

3637# if defined(INTEGER_GMP)

37−import GHC.Integer.GMP.Internals

38+import GHC.Integer.GMP.Internals (Integer(S#))

3839# elif defined(INTEGER_SIMPLE)

3940import GHC.Integer

4041# else

@@ -54,7 +55,7 @@ decimal :: Integral a => a -> Builder

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

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

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

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

58+{-# RULES "decimal/Word" decimal = positive :: Data.Word.Word -> Builder #-}

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

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

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

@@ -133,8 +134,15 @@ i2w v = zero + fromIntegral v

133134

134135countDigits :: (Integral a) => a -> Int

135136{-# INLINE countDigits #-}

136−countDigits v0 = go 1 (fromIntegral v0 :: Word64)

137− where go !k v

137+countDigits v0

138+ | fromIntegral v64 == v0 = go 1 v64

139+ | otherwise = goBig 1 (fromIntegral v0)

140+ where v64 = fromIntegral v0

141+ goBig !k (v :: Integer)

142+ | v > big = goBig (k + 19) (v `quot` big)

143+ | otherwise = go k (fromIntegral v)

144+ big = 10000000000000000000

145+ go !k (v :: Word64)

138146 | v < 10 = k

139147 | v < 100 = k + 1

140148 | v < 1000 = k + 2

@@ -186,19 +194,12 @@ hexDigit n

186194 | otherwise = singleton $! toEnum (fromIntegral n + 87)

187195{-# INLINE hexDigit #-}

188196

189−int :: Int -> Builder

190−int = decimal

191−{-# INLINE int #-}

192−

193197data T = T !Integer !Int

194198

195199integer :: Int -> Integer -> Builder

196200#ifdef INTEGER_GMP

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

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

199−#else

200−integer 10 i = decimal i

201−integer 16 i = hexadecimal i

202203#endif

203204integer base i

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

@@ -246,7 +247,11 @@ integer base i

246247 PAIR(x,y) -> pblock q <> pblock r <> putB ns

247248 where q = fromInteger x

248249 r = fromInteger y

249− putB _ = mempty

250+ putB _ = Data.Monoid.mempty

251+

252+ int :: Int -> Builder

253+ int x | base == 10 = decimal x

254+ | otherwise = hexadecimal x

250255

251256 pblock = loop maxDigits

252257 where

Data/Text/Lazy/Encoding.hs+8−20

@@ -46,30 +46,25 @@ module Data.Text.Lazy.Encoding

4646 , encodeUtf32LE

4747 , encodeUtf32BE

4848

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

5049 -- * Encoding Text using ByteString Builders

5150 , encodeUtf8Builder

5251 , encodeUtf8BuilderEscaped

53−#endif

5452 ) where

5553

5654import Control.Exception (evaluate, try)

55+import Data.Monoid (Monoid(..))

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

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

59−import qualified Data.ByteString as S

60−import qualified Data.ByteString.Lazy as B

61−import qualified Data.ByteString.Lazy.Internal as B

62−import qualified Data.ByteString.Unsafe as B

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

6458import Data.Word (Word8)

65−import Data.Monoid (mempty, mappend)

59+import qualified Data.ByteString as S

6660import qualified Data.ByteString.Builder as B

6761import qualified Data.ByteString.Builder.Extra as B (safeStrategy, toLazyByteStringWith)

6862import qualified Data.ByteString.Builder.Prim as BP

63+import qualified Data.ByteString.Lazy as B

64+import qualified Data.ByteString.Lazy.Internal as B

65+import qualified Data.ByteString.Unsafe as B

6966import qualified Data.Text as T

70−#endif

7167import qualified Data.Text.Encoding as TE

72−import qualified Data.Text.Lazy as L

7368import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E

7469import qualified Data.Text.Internal.Lazy.Fusion as F

7570import Data.Text.Unsafe (unsafeDupablePerformIO)

@@ -89,8 +84,6 @@ import Data.Text.Unsafe (unsafeDupablePerformIO)

8984

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

9186-- encoded text.

92−--

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

9487decodeASCII :: B.ByteString -> Text

9588decodeASCII = decodeUtf8

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

@@ -112,7 +105,7 @@ decodeUtf8With onErr (B.Chunk b0 bs0) =

112105 | S.null l = empty

113106 | otherwise = case onErr desc (Just (B.unsafeHead l)) of

114107 Nothing -> empty

115− Just c -> L.singleton c

108+ Just c -> Chunk (T.singleton c) Empty

116109 desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"

117110decodeUtf8With _ _ = empty

118111

@@ -149,7 +142,6 @@ decodeUtf8' bs = unsafeDupablePerformIO $ do

149142{-# INLINE decodeUtf8' #-}

150143

151144encodeUtf8 :: Text -> B.ByteString

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

153145encodeUtf8 Empty = B.empty

154146encodeUtf8 lt@(Chunk t _) =

155147 B.toLazyByteStringWith strategy B.empty $ encodeUtf8Builder lt

@@ -163,18 +155,14 @@ encodeUtf8 lt@(Chunk t _) =

163155 strategy = B.safeStrategy firstChunkSize B.defaultChunkSize

164156

165157encodeUtf8Builder :: Text -> B.Builder

166−encodeUtf8Builder = foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) mempty

158+encodeUtf8Builder =

159+ foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) Data.Monoid.mempty

167160

168161{-# INLINE encodeUtf8BuilderEscaped #-}

169162encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder

170163encodeUtf8BuilderEscaped prim =

171164 foldrChunks (\c b -> TE.encodeUtf8BuilderEscaped prim c `mappend` b) mempty

172165

173−#else

174−encodeUtf8 (Chunk c cs) = B.Chunk (TE.encodeUtf8 c) (encodeUtf8 cs)

175−encodeUtf8 Empty = B.Empty

176−#endif

177−

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

179167decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text

180168decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)

Data/Text/Lazy/Read.hs+4−2

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

11{-# LANGUAGE OverloadedStrings, CPP #-}

2−#if __GLASGOW_HASKELL__ >= 702

2+#if __GLASGOW_HASKELL__ >= 704

3+{-# LANGUAGE Safe #-}

4+#elif __GLASGOW_HASKELL__ >= 702

35{-# LANGUAGE Trustworthy #-}

46#endif

@@ -54,7 +56,7 @@ decimal :: Integral a => Reader a

5456{-# SPECIALIZE decimal :: Reader Int32 #-}

5557{-# SPECIALIZE decimal :: Reader Int64 #-}

5658{-# SPECIALIZE decimal :: Reader Integer #-}

57−{-# SPECIALIZE decimal :: Reader Word #-}

59+{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}

5860{-# SPECIALIZE decimal :: Reader Word8 #-}

5961{-# SPECIALIZE decimal :: Reader Word16 #-}

6062{-# SPECIALIZE decimal :: Reader Word32 #-}

Data/Text/Read.hs+1−1

@@ -55,7 +55,7 @@ decimal :: Integral a => Reader a

5555{-# SPECIALIZE decimal :: Reader Int32 #-}

5656{-# SPECIALIZE decimal :: Reader Int64 #-}

5757{-# SPECIALIZE decimal :: Reader Integer #-}

58−{-# SPECIALIZE decimal :: Reader Word #-}

58+{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}

5959{-# SPECIALIZE decimal :: Reader Word8 #-}

6060{-# SPECIALIZE decimal :: Reader Word16 #-}

6161{-# SPECIALIZE decimal :: Reader Word32 #-}

Data/Text/Show.hsnew file+89

@@ -0,0 +1,89 @@

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

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

3+#if __GLASGOW_HASKELL__ >= 702

4+{-# LANGUAGE Trustworthy #-}

5+#endif

7+-- |

8+-- Module : Data.Text.Show

10+--

11+-- License : BSD-style

12+-- Maintainer : bos@serpentine.com

13+-- Stability : experimental

14+-- Portability : GHC

15+

16+module Data.Text.Show

17+ (

18+ singleton

19+ , unpack

20+ , unpackCString#

21+ ) where

22+

23+import Control.Monad.ST (ST)

24+import Data.Text.Internal (Text(..), empty_, safe)

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

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

27+import GHC.Prim (Addr#)

28+import qualified Data.Text.Array as A

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

30+

31+#if __GLASGOW_HASKELL__ >= 702

32+import qualified GHC.CString as GHC

33+#else

34+import qualified GHC.Base as GHC

35+#endif

36+

37+instance Show Text where

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

39+

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

41+unpack :: Text -> String

42+unpack = S.unstreamList . stream

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

44+

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

46+-- fusion.

47+--

48+-- This is exposed solely for people writing GHC rewrite rules.

49+unpackCString# :: Addr# -> Text

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

51+{-# NOINLINE unpackCString# #-}

52+

53+{-# RULES "TEXT literal" [1] forall a.

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

55+ = unpackCString# a #-}

56+

57+{-# RULES "TEXT literal UTF8" [1] forall a.

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

59+ = unpackCString# a #-}

60+

61+{-# RULES "TEXT empty literal" [1]

62+ unstream (S.map safe (S.streamList []))

63+ = empty_ #-}

64+

65+{-# RULES "TEXT singleton literal" [1] forall a.

66+ unstream (S.map safe (S.streamList [a]))

67+ = singleton_ a #-}

68+

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

70+-- Performs replacement on invalid scalar values.

71+singleton :: Char -> Text

72+singleton = unstream . S.singleton . safe

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

74+

75+{-# RULES "TEXT singleton" forall a.

76+ unstream (S.singleton (safe a))

77+ = singleton_ a #-}

78+

79+-- This is intended to reduce inlining bloat.

80+singleton_ :: Char -> Text

81+singleton_ c = Text (A.run x) 0 len

82+ where x :: ST s (A.MArray s)

83+ x = do arr <- A.new len

84+ _ <- unsafeWrite arr 0 d

85+ return arr

86+ len | d < '\x10000' = 1

87+ | otherwise = 2

88+ d = safe c

89+{-# NOINLINE singleton_ #-}

benchmarks/haskell/Benchmarks.hs+3−1

@@ -15,6 +15,7 @@ import qualified Benchmarks.EncodeUtf8 as EncodeUtf8

1515import qualified Benchmarks.Equality as Equality

1616import qualified Benchmarks.FileRead as FileRead

1717import qualified Benchmarks.FoldLines as FoldLines

18+import qualified Benchmarks.Mul as Mul

1819import qualified Benchmarks.Pure as Pure

1920import qualified Benchmarks.ReadNumbers as ReadNumbers

2021import qualified Benchmarks.Replace as Replace

@@ -49,9 +50,10 @@ benchmarks = do

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

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

5152 , FoldLines.benchmark (tf "russian.txt")

53+ , Mul.benchmark

5254 , Pure.benchmark "tiny" (tf "tiny.txt")

5355 , Pure.benchmark "ascii" (tf "ascii-small.txt")

54− , Pure.benchmark "france" (tf "france.html")

56+ -- , Pure.benchmark "france" (tf "france.html")

5557 , Pure.benchmark "russian" (tf "russian-small.txt")

5658 , Pure.benchmark "japanese" (tf "japanese.txt")

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

benchmarks/haskell/Benchmarks/DecodeUtf8.hs+2−2

@@ -25,7 +25,7 @@ import Foreign.Ptr (Ptr, plusPtr)

2525import Foreign.ForeignPtr (withForeignPtr)

2626import Data.Word (Word8)

2727import qualified Criterion as C

28−import Criterion (Benchmark, bgroup, nf)

28+import Criterion (Benchmark, bgroup, nf, whnfIO)

2929import qualified Codec.Binary.UTF8.Generic as U8

3030import qualified Data.ByteString as B

3131import qualified Data.ByteString.Lazy as BL

@@ -48,7 +48,7 @@ benchmark kind fp = do

4848 return $ bgroup "DecodeUtf8"

4949 [ bench "Strict" $ nf T.decodeUtf8 bs

5050 , bench "Stream" $ nf decodeStream lbs

51− , bench "IConv" $ iconv bs

51+ , bench "IConv" $ whnfIO $ iconv bs

5252 , bench "StrictLength" $ nf (T.length . T.decodeUtf8) bs

5353 , bench "StrictInitLength" $ nf (T.length . T.init . T.decodeUtf8) bs

5454 , bench "Lazy" $ nf TL.decodeUtf8 lbs

benchmarks/haskell/Benchmarks/FileRead.hs+11−11

@@ -8,8 +8,8 @@ module Benchmarks.FileRead

88 ( benchmark

99 ) where

1010

11−import Control.Exception (evaluate)

12−import Criterion (Benchmark, bgroup, bench)

11+import Control.Applicative ((<$>))

12+import Criterion (Benchmark, bgroup, bench, whnfIO)

1313import qualified Data.ByteString as SB

1414import qualified Data.ByteString.Lazy as LB

1515import qualified Data.Text as T

@@ -21,13 +21,13 @@ import qualified Data.Text.Lazy.IO as LT

2121

2222benchmark :: FilePath -> IO Benchmark

2323benchmark p = return $ bgroup "FileRead"

24− [ bench "String" $ readFile p >>= evaluate . length

25− , bench "ByteString" $ SB.readFile p >>= evaluate . SB.length

26− , bench "LazyByteString" $ LB.readFile p >>= evaluate . LB.length

27− , bench "Text" $ T.readFile p >>= evaluate . T.length

28− , bench "LazyText" $ LT.readFile p >>= evaluate . LT.length

29− , bench "TextByteString" $

30− SB.readFile p >>= evaluate . T.length . T.decodeUtf8

31− , bench "LazyTextByteString" $

32− LB.readFile p >>= evaluate . LT.length . LT.decodeUtf8

24+ [ bench "String" $ whnfIO $ length <$> readFile p

25+ , bench "ByteString" $ whnfIO $ SB.length <$> SB.readFile p

26+ , bench "LazyByteString" $ whnfIO $ LB.length <$> LB.readFile p

27+ , bench "Text" $ whnfIO $ T.length <$> T.readFile p

28+ , bench "LazyText" $ whnfIO $ LT.length <$> LT.readFile p

29+ , bench "TextByteString" $ whnfIO $

30+ (T.length . T.decodeUtf8) <$> SB.readFile p

31+ , bench "LazyTextByteString" $ whnfIO $

32+ (LT.length . LT.decodeUtf8) <$> LB.readFile p

3333 ]

benchmarks/haskell/Benchmarks/FoldLines.hs+2−2

@@ -10,7 +10,7 @@ module Benchmarks.FoldLines

1010 ( benchmark

1111 ) where

1212

13−import Criterion (Benchmark, bgroup, bench)

13+import Criterion (Benchmark, bgroup, bench, whnfIO)

1414import System.IO

1515import qualified Data.ByteString as B

1616import qualified Data.Text as T

@@ -22,7 +22,7 @@ benchmark fp = return $ bgroup "ReadLines"

2222 , bench "ByteString" $ withHandle $ foldLinesB (\n _ -> n + 1) (0 :: Int)

2323 ]

2424 where

25− withHandle f = do

25+ withHandle f = whnfIO $ do

2626 h <- openFile fp ReadMode

2727 hSetBuffering h (BlockBuffering (Just 16384))

2828 x <- f h

benchmarks/haskell/Benchmarks/Mul.hsnew file+138

@@ -0,0 +1,138 @@

1+module Benchmarks.Mul (benchmark) where

3+import Control.Exception (evaluate)

4+import Criterion.Main

5+import Data.Int (Int32, Int64)

6+import Data.Text.Internal (mul32, mul64)

7+import qualified Data.Vector.Unboxed as U

9+oldMul :: Int64 -> Int64 -> Int64

10+oldMul m n

11+ | n == 0 = 0

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

13+ | otherwise = error "overflow"

14+

15+benchmark :: IO Benchmark

16+benchmark = do

17+ _ <- evaluate testVector32

18+ _ <- evaluate testVector64

19+ return $ bgroup "Mul" [

20+ bench "oldMul" $ whnf (U.map (uncurry oldMul)) testVector64

21+ , bench "mul64" $ whnf (U.map (uncurry mul64)) testVector64

22+ , bench "*64" $ whnf (U.map (uncurry (*))) testVector64

23+ , bench "mul32" $ whnf (U.map (uncurry mul32)) testVector32

24+ , bench "*32" $ whnf (U.map (uncurry (*))) testVector32

25+ ]

26+

27+testVector64 :: U.Vector (Int64,Int64)

28+testVector64 = U.fromList [

29+ (0,1248868987182846646),(169004623633872,24458),(482549039517835,7614),

30+ (372,8157063115504364),(27,107095594861148252),(3,63249878517962420),

31+ (4363,255694473572912),(86678474,1732634806),(1572453024,1800489338),

32+ (9384523143,77053781),(49024709555,75095046),(7,43457620410239131),

33+ (8,8201563008844571),(387719037,1520696708),(189869238220197,1423),

34+ (46788016849611,23063),(503077742109974359,0),(104,1502010908706487),

35+ (30478140346,207525518),(80961140129236192,14),(4283,368012829143675),

36+ (1028719181728108146,6),(318904,5874863049591),(56724427166898,110794),

37+ (234539368,31369110449),(2,251729663598178612),(103291548194451219,5),

38+ (76013,5345328755566),(1769631,2980846129318),(40898,60598477385754),

39+ (0,98931348893227155),(573555872156917492,3),(318821187115,4476566),

40+ (11152874213584,243582),(40274276,16636653248),(127,4249988676030597),

41+ (103543712111871836,5),(71,16954462148248238),(3963027173504,216570),

42+ (13000,503523808916753),(17038308,20018685905),(0,510350226577891549),

43+ (175898,3875698895405),(425299191292676,5651),(17223451323664536,50),

44+ (61755131,14247665326),(0,1018195131697569303),(36433751497238985,20),

45+ (3473607861601050,1837),(1392342328,1733971838),(225770297367,3249655),

46+ (14,127545244155254102),(1751488975299136,2634),(3949208,504190668767),

47+ (153329,831454434345),(1066212122928663658,2),(351224,2663633539556),

48+ (344565,53388869217),(35825609350446863,54),(276011553660081475,10),

49+ (1969754174790470349,3),(35,68088438338633),(506710,3247689556438),

50+ (11099382291,327739909),(105787303549,32824363),(210366111,14759049409),

51+ (688893241579,3102676),(8490,70047474429581),(152085,29923000251880),

52+ (5046974599257095,400),(4183167795,263434071),(10089728,502781960687),

53+ (44831977765,4725378),(91,8978094664238578),(30990165721,44053350),

54+ (1772377,149651820860),(243420621763408572,4),(32,5790357453815138),

55+ (27980806337993771,5),(47696295759774,20848),(1745874142313778,1098),

56+ (46869334770121,1203),(886995283,1564424789),(40679396544,76002479),

57+ (1,672849481568486995),(337656187205,3157069),(816980552858963,6003),

58+ (2271434085804831543,1),(0,1934521023868747186),(6266220038281,15825),

59+ (4160,107115946987394),(524,246808621791561),(0,1952519482439636339),

60+ (128,2865935904539691),(1044,3211982069426297),(16000511542473,88922),

61+ (1253596745404082,2226),(27041,56836278958002),(23201,49247489754471),

62+ (175906590497,21252392),(185163584757182295,24),(34742225226802197,150),

63+ (2363228,250824838408),(216327527109550,45),(24,81574076994520675),

64+ (28559899906542,15356),(10890139774837133,511),(2293,707179303654492),

65+ (2749366833,40703233),(0,4498229704622845986),(439,4962056468281937),

66+ (662,1453820621089921),(16336770612459631,220),(24282989393,74239137),

67+ (2724564648490195,3),(743672760,124992589),(4528103,704330948891),

68+ (6050483122491561,250),(13322953,13594265152),(181794,22268101450214),

69+ (25957941712,75384092),(43352,7322262295009),(32838,52609059549923),

70+ (33003585202001564,2),(103019,68430142267402),(129918230800,8742978),

71+ (0,2114347379589080688),(2548,905723041545274),(222745067962838382,0),

72+ (1671683850790425181,1),(455,4836932776795684),(794227702827214,6620),

73+ (212534135175874,1365),(96432431858,29784975),(466626763743380,3484),

74+ (29793949,53041519613),(8359,309952753409844),(3908960585331901,26),

75+ (45185288970365760,114),(10131829775,68110174),(58039242399640479,83),

76+ (628092278238719399,6),(1,196469106875361889),(302336625,16347502444),

77+ (148,3748088684181047),(1,1649096568849015456),(1019866864,2349753026),

78+ (8211344830,569363306),(65647579546873,34753),(2340190,1692053129069),

79+ (64263301,30758930355),(48681618072372209,110),(7074794736,47640197),

80+ (249634721521,7991792),(1162917363807215,232),(7446433349,420634045),

81+ (63398619383,60709817),(51359004508011,14200),(131788797028647,7072),

82+ (52079887791430043,7),(7,136277667582599838),(28582879735696,50327),

83+ (1404582800566278,833),(469164435,15017166943),(99567079957578263,49),

84+ (1015285971,3625801566),(321504843,4104079293),(5196954,464515406632),

85+ (114246832260876,7468),(8149664437,487119673),(12265299,378168974869),

86+ (37711995764,30766513),(3971137243,710996152),(483120070302,603162),

87+ (103009942,61645547145),(8476344625340,6987),(547948761229739,1446),

88+ (42234,18624767306301),(13486714173011,58948),(4,198309153268019840),

89+ (9913176974,325539248),(28246225540203,116822),(2882463945582154,18),

90+ (959,25504987505398),(3,1504372236378217710),(13505229956793,374987),

91+ (751661959,457611342),(27375926,36219151769),(482168869,5301952074),

92+ (1,1577425863241520640),(714116235611821,1164),(904492524250310488,0),

93+ (5983514941763398,68),(10759472423,23540686),(72539568471529,34919),

94+ (4,176090672310337473),(938702842110356453,1),(673652445,3335287382),

95+ (3111998893666122,917),(1568013,3168419765469)]

96+

97+testVector32 :: U.Vector (Int32,Int32)

98+testVector32 = U.fromList [

99+ (39242,410),(0,100077553),(2206,9538),(509400240,1),(38048,6368),

100+ (1789,651480),(2399,157032),(701,170017),(5241456,14),(11212,70449),

101+ (1,227804876),(749687254,1),(74559,2954),(1158,147957),(410604456,1),

102+ (170851,1561),(92643422,1),(6192,180509),(7,24202210),(3440,241481),

103+ (5753677,5),(294327,1622),(252,4454673),(127684121,11),(28315800,30),

104+ (340370905,0),(1,667887987),(592782090,1),(49023,27641),(750,290387),

105+ (72886,3847),(0,301047933),(3050276,473),(1,788366142),(59457,15813),

106+ (637726933,1),(1135,344317),(853616,264),(696816,493),(7038,12046),

107+ (125219574,4),(803694088,1),(107081726,1),(39294,21699),(16361,38191),

108+ (132561123,12),(1760,23499),(847543,484),(175687349,1),(2963,252678),

109+ (6248,224553),(27596,4606),(5422922,121),(1542,485890),(131,583035),

110+ (59096,4925),(3637115,132),(0,947225435),(86854,6794),(2984745,339),

111+ (760129569,1),(1,68260595),(380835652,2),(430575,2579),(54514,7211),

112+ (15550606,3),(9,27367402),(3007053,207),(7060988,60),(28560,27130),

113+ (1355,21087),(10880,53059),(14563646,4),(461886361,1),(2,169260724),

114+ (241454126,2),(406797,1),(61631630,16),(44473,5943),(63869104,12),

115+ (950300,1528),(2113,62333),(120817,9358),(100261456,1),(426764723,1),

116+ (119,12723684),(3,53358711),(4448071,18),(1,230278091),(238,232102),

117+ (8,57316440),(42437979,10),(6769,19555),(48590,22006),(11500585,79),

118+ (2808,97638),(42,26952545),(11,32104194),(23954638,1),(785427272,0),

119+ (513,81379),(31333960,37),(897772,1009),(4,25679692),(103027993,12),

120+ (104972702,11),(546,443401),(7,65137092),(88574269,3),(872139069,0),

121+ (2,97417121),(378802603,0),(141071401,4),(22613,10575),(2191743,118),

122+ (470,116119),(7062,38166),(231056,1847),(43901963,9),(2400,70640),

123+ (63553,1555),(34,11249573),(815174,1820),(997894011,0),(98881794,2),

124+ (5448,43132),(27956,9),(904926,1357),(112608626,3),(124,613021),

125+ (282086,1966),(99,10656881),(113799,1501),(433318,2085),(442,948171),

126+ (165380,1043),(28,14372905),(14880,50462),(2386,219918),(229,1797565),

127+ (1174961,298),(3925,41833),(3903515,299),(15690452,111),(360860521,3),

128+ (7440846,81),(2541026,507),(0,492448477),(6869,82469),(245,8322939),

129+ (3503496,253),(123495298,0),(150963,2299),(33,4408482),(1,200911107),

130+ (305,252121),(13,123369189),(215846,8181),(2440,65387),(776764401,1),

131+ (1241172,434),(8,15493155),(81953961,6),(17884993,5),(26,6893822),

132+ (0,502035190),(1,582451018),(2,514870139),(227,3625619),(49,12720258),

133+ (1456769,207),(94797661,10),(234407,893),(26843,5783),(15688,24547),

134+ (4091,86268),(4339448,151),(21360,6294),(397046497,2),(1227,205936),

135+ (9966,21959),(160046791,1),(0,159992224),(27,24974797),(19177,29334),

136+ (4136148,42),(21179785,53),(61256583,31),(385,344176),(7,11934915),

137+ (1,18992566),(3488065,5),(768021,224),(36288474,7),(8624,117561),

138+ (8,20341439),(5903,261475),(561,1007618),(1738,392327),(633049,1708)]

benchmarks/haskell/Benchmarks/Programs/BigTable.hs+2−2

@@ -11,7 +11,7 @@ module Benchmarks.Programs.BigTable

1111 ( benchmark

1212 ) where

1313

14−import Criterion (Benchmark, bench)

14+import Criterion (Benchmark, bench, whnfIO)

1515import Data.Monoid (mappend, mconcat)

1616import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)

1717import Data.Text.Lazy.IO (hPutStr)

@@ -19,7 +19,7 @@ import System.IO (Handle)

1919import qualified Data.Text as T

2020

2121benchmark :: Handle -> IO Benchmark

22−benchmark sink = return $ bench "BigTable" $ do

22+benchmark sink = return $ bench "BigTable" $ whnfIO $ do

2323 hPutStr sink "Content-Type: text/html\n\n<table>"

2424 hPutStr sink . toLazyText . makeTable =<< rows

2525 hPutStr sink "</table>"

benchmarks/haskell/Benchmarks/Programs/Cut.hs+2−2

@@ -16,7 +16,7 @@ module Benchmarks.Programs.Cut

1616 ( benchmark

1717 ) where

1818

19−import Criterion (Benchmark, bgroup, bench)

19+import Criterion (Benchmark, bgroup, bench, whnfIO)

2020import System.IO (Handle, hPutStr)

2121import qualified Data.ByteString as B

2222import qualified Data.ByteString.Char8 as BC

@@ -40,7 +40,7 @@ benchmark p sink from to = return $ bgroup "Cut"

4040 , bench' "LazyTextByteString" lazyTextByteString

4141 ]

4242 where

43− bench' n s = bench n (s p sink from to)

43+ bench' n s = bench n $ whnfIO (s p sink from to)

4444

4545string :: FilePath -> Handle -> Int -> Int -> IO ()

4646string fp sink from to = do

benchmarks/haskell/Benchmarks/Programs/Fold.hs+2−2

@@ -21,7 +21,7 @@ import Data.List (foldl')

2121import Data.List (intersperse)

2222import Data.Monoid (mempty, mappend, mconcat)

2323import System.IO (Handle)

24−import Criterion (Benchmark, bench)

24+import Criterion (Benchmark, bench, whnfIO)

2525import qualified Data.Text as T

2626import qualified Data.Text.IO as T

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

@@ -30,7 +30,7 @@ import qualified Data.Text.Lazy.IO as TL

3030

3131benchmark :: FilePath -> Handle -> IO Benchmark

3232benchmark i o = return $

33− bench "Fold" $ T.readFile i >>= TL.hPutStr o . fold 80

33+ bench "Fold" $ whnfIO $ T.readFile i >>= TL.hPutStr o . fold 80

3434

3535-- | We represent a paragraph by a word list

3636--

benchmarks/haskell/Benchmarks/Programs/Sort.hs+10−9

@@ -17,7 +17,7 @@ module Benchmarks.Programs.Sort

1717 ( benchmark

1818 ) where

1919

20−import Criterion (Benchmark, bgroup, bench)

20+import Criterion (Benchmark, bgroup, bench, whnfIO)

2121import Data.Monoid (mconcat)

2222import System.IO (Handle, hPutStr)

2323import qualified Data.ByteString as B

@@ -35,16 +35,17 @@ import qualified Data.Text.Lazy.IO as TL

3535

3636benchmark :: FilePath -> Handle -> IO Benchmark

3737benchmark i o = return $ bgroup "Sort"

38− [ bench "String" $ readFile i >>= hPutStr o . string

39− , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString

40− , bench "LazyByteString" $ BL.readFile i >>= BL.hPutStr o . lazyByteString

41− , bench "Text" $ T.readFile i >>= T.hPutStr o . text

42− , bench "LazyText" $ TL.readFile i >>= TL.hPutStr o . lazyText

43− , bench "TextByteString" $ B.readFile i >>=

38+ [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string

39+ , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString

40+ , bench "LazyByteString" $ whnfIO $

41+ BL.readFile i >>= BL.hPutStr o . lazyByteString

42+ , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text

43+ , bench "LazyText" $ whnfIO $ TL.readFile i >>= TL.hPutStr o . lazyText

44+ , bench "TextByteString" $ whnfIO $ B.readFile i >>=

4445 B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8

45− , bench "LazyTextByteString" $ BL.readFile i >>=

46+ , bench "LazyTextByteString" $ whnfIO $ BL.readFile i >>=

4647 BL.hPutStr o . TL.encodeUtf8 . lazyText . TL.decodeUtf8

47− , bench "TextBuilder" $ B.readFile i >>=

48+ , bench "TextBuilder" $ whnfIO $ B.readFile i >>=

4849 BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8

4950 ]

5051

benchmarks/haskell/Benchmarks/Programs/StripTags.hs+5−5

@@ -15,7 +15,7 @@ module Benchmarks.Programs.StripTags

1515 ( benchmark

1616 ) where

1717

18−import Criterion (Benchmark, bgroup, bench)

18+import Criterion (Benchmark, bgroup, bench, whnfIO)

1919import Data.List (mapAccumL)

2020import System.IO (Handle, hPutStr)

2121import qualified Data.ByteString as B

@@ -26,10 +26,10 @@ import qualified Data.Text.IO as T

2626

2727benchmark :: FilePath -> Handle -> IO Benchmark

2828benchmark i o = return $ bgroup "StripTags"

29− [ bench "String" $ readFile i >>= hPutStr o . string

30− , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString

31− , bench "Text" $ T.readFile i >>= T.hPutStr o . text

32− , bench "TextByteString" $

29+ [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string

30+ , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString

31+ , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text

32+ , bench "TextByteString" $ whnfIO $

3333 B.readFile i >>= B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8

3434 ]

3535

benchmarks/haskell/Benchmarks/Programs/Throughput.hs+8−8

@@ -18,7 +18,7 @@ module Benchmarks.Programs.Throughput

1818 ( benchmark

1919 ) where

2020

21−import Criterion (Benchmark, bgroup, bench)

21+import Criterion (Benchmark, bgroup, bench, whnfIO)

2222import System.IO (Handle, hPutStr)

2323import qualified Data.ByteString as B

2424import qualified Data.ByteString.Lazy as BL

@@ -29,13 +29,13 @@ import qualified Data.Text.Lazy.IO as TL

2929

3030benchmark :: FilePath -> Handle -> IO Benchmark

3131benchmark fp sink = return $ bgroup "Throughput"

32− [ bench "String" $ readFile fp >>= hPutStr sink

33− , bench "ByteString" $ B.readFile fp >>= B.hPutStr sink

34− , bench "LazyByteString" $ BL.readFile fp >>= BL.hPutStr sink

35− , bench "Text" $ T.readFile fp >>= T.hPutStr sink

36− , bench "LazyText" $ TL.readFile fp >>= TL.hPutStr sink

37− , bench "TextByteString" $

32+ [ bench "String" $ whnfIO $ readFile fp >>= hPutStr sink

33+ , bench "ByteString" $ whnfIO $ B.readFile fp >>= B.hPutStr sink

34+ , bench "LazyByteString" $ whnfIO $ BL.readFile fp >>= BL.hPutStr sink

35+ , bench "Text" $ whnfIO $ T.readFile fp >>= T.hPutStr sink

36+ , bench "LazyText" $ whnfIO $ TL.readFile fp >>= TL.hPutStr sink

37+ , bench "TextByteString" $ whnfIO $

3838 B.readFile fp >>= B.hPutStr sink . T.encodeUtf8 . T.decodeUtf8

39− , bench "LazyTextByteString" $

39+ , bench "LazyTextByteString" $ whnfIO $

4040 BL.readFile fp >>= BL.hPutStr sink . TL.encodeUtf8 . TL.decodeUtf8

4141 ]

benchmarks/haskell/Benchmarks/Pure.hs+7

@@ -262,6 +262,13 @@ benchmark kind fp = do

262262 , benchBSL $ nf (BL.map toUpper) bla

263263 , benchS $ nf (L.map toUpper) sa

264264 ]

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

265272 , bgroup "words"

266273 [ benchT $ nf T.words ta

267274 , benchTL $ nf TL.words tla

benchmarks/haskell/Benchmarks/ReadNumbers.hs+2−5

@@ -25,8 +25,7 @@ import Data.List (foldl')

2525import Numeric (readDec, readFloat, readHex)

2626import qualified Data.ByteString.Char8 as B

2727import qualified Data.ByteString.Lazy.Char8 as BL

28−import qualified Data.ByteString.Lex.Double as B

29−import qualified Data.ByteString.Lex.Lazy.Double as BL

28+import qualified Data.ByteString.Lex.Fractional as B

3029import qualified Data.Text as T

3130import qualified Data.Text.IO as T

3231import qualified Data.Text.Lazy as TL

@@ -63,12 +62,10 @@ benchmark fp = do

6362 whnf (double . text TL.rational) tl

6463

6564 , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b

66− , bench "DoubleByteString" $ whnf (double . byteString B.readDouble) b

65+ , bench "DoubleByteString" $ whnf (double . byteString B.readDecimal) b

6766

6867 , bench "DecimalLazyByteString" $

6968 whnf (int . byteString BL.readInt) bl

70− , bench "DoubleLazyByteString" $

71− whnf (double . byteString BL.readDouble) bl

7269 ]

7370 where

7471 -- Used for fixing types

benchmarks/haskell/Benchmarks/Stream.hs+16−5

@@ -18,11 +18,11 @@ import qualified Data.Text.Encoding as T

1818import qualified Data.Text.Encoding.Error as E

1919import qualified Data.Text.Internal.Encoding.Fusion as T

2020import qualified Data.Text.Internal.Encoding.Fusion.Common as F

21−import qualified Data.Text.Internal.Fusion as T

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

2222import qualified Data.Text.IO as T

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

2424import qualified Data.Text.Internal.Lazy.Encoding.Fusion as TL

25−import qualified Data.Text.Internal.Lazy.Fusion as TL

25+import qualified Data.Text.Internal.Lazy.Fusion as FL

2626import qualified Data.Text.Lazy.IO as TL

2727

2828instance NFData a => NFData (Stream a) where

@@ -53,14 +53,25 @@ benchmark fp = do

5353 !utf32beL = TL.encodeUtf32BE tl

5454

5555 -- For the functions which operate on streams

56− let !s = T.stream t

56+ let !s = F.stream t

5757

5858 return $ bgroup "Stream"

5959

6060 -- Fusion

6161 [ bgroup "stream" $

62− [ bench "Text" $ nf T.stream t

63− , bench "LazyText" $ nf TL.stream tl

62+ [ bench "Text" $ nf F.stream t

63+ , bench "LazyText" $ nf FL.stream tl

64+ ]

65+ -- must perform exactly the same as stream above due to

66+ -- stream/unstream (i.e. stream after unstream) fusion

67+ , bgroup "stream-fusion" $

68+ [ bench "Text" $ nf (F.stream . F.unstream . F.stream) t

69+ , bench "LazyText" $ nf (FL.stream . FL.unstream . FL.stream) tl

70+ ]

71+ -- measure the overhead of unstream after stream

72+ , bgroup "stream-unstream" $

73+ [ bench "Text" $ nf (F.unstream . F.stream) t

74+ , bench "LazyText" $ nf (FL.unstream . FL.stream) tl

6475 ]

6576

6677 -- Encoding.Fusion

benchmarks/text-benchmarks.cabal+16−5

@@ -3,7 +3,7 @@ version: 0.0.0.0

33synopsis: Benchmarks for the text package

44description: Benchmarks for the text package

55homepage: https://bitbucket.org/bos/text

6−license: BSD3

6+license: BSD2

77license-file: ../LICENSE

88author: Jasper Van der Jeugt <jaspervdj@gmail.com>,

99 Bryan O'Sullivan <bos@serpentine.com>,

@@ -15,6 +15,11 @@ build-type: Simple

1515

1616cabal-version: >=1.2

1717

18+flag bytestring-builder

19+ description: Depend on the bytestring-builder package for backwards compatibility.

20+ default: False

21+ manual: False

22+

1823flag llvm

1924 description: use LLVM

2025 default: False

@@ -33,17 +38,23 @@ executable text-benchmarks

3338 build-depends: base == 4.*,

3439 binary,

3540 blaze-builder,

36− bytestring,

37− bytestring-lexing,

41+ bytestring-lexing >= 0.5.0,

3842 containers,

39− criterion >= 0.6.0.1,

43+ criterion >= 0.10.0.0,

4044 deepseq,

4145 directory,

4246 filepath,

4347 ghc-prim,

4448 integer-gmp,

4549 stringsearch,

46− utf8-string

50+ utf8-string,

51+ vector

52+

53+ if flag(bytestring-builder)

54+ build-depends: bytestring >= 0.9 && < 0.10.4,

55+ bytestring-builder >= 0.10.4

56+ else

57+ build-depends: bytestring >= 0.10.4

4758

4859executable text-multilang

4960 hs-source-dirs: haskell

changelog.md+109

@@ -1,3 +1,112 @@

1+1.2.2.1

3+* The switch to `integer-pure` in 1.2.2.0 was apparently mistaken.

4+ The build flag has been renamed accordingly. Your army of diligent

5+ maintainers apologizes for the churn.

7+* Spec compliance: toCaseFold now follows the Unicode 8.0 spec

8+ (updated from 7.0)

10+* An STG lint error has been fixed

11+

12+1.2.2.0

13+

14+* The `integer-simple` package, upon which this package optionally

15+ depended, has been replaced with `integer-pure`. The build flag has

16+ been renamed accordingly.

17+

18+* Bug fix: For the `Binary` instance, If UTF-8 decoding fails during a

19+ `get`, the error is propagated via `fail` instead of an uncatchable

20+ crash.

21+

22+* New function: `takeWhileEnd`

23+

24+* New instances for the `Text` types:

25+ * if `base` >= 4.7: `PrintfArg`

26+ * if `base` >= 4.9: `Semigroup`

27+

28+1.2.1.3

29+

30+* Bug fix: As it turns out, moving the literal rewrite rules to simplifier

31+ phase 2 does not prevent competition with the `unpack` rule, which is

32+ also active in this phase. Unfortunately this was hidden due to a silly

33+ test environment mistake. Moving literal rules back to phase 1 finally

34+ fixes GHC Trac #10528 correctly.

35+

36+1.2.1.2

37+

38+* Bug fix: Run literal rewrite rules in simplifier phase 2.

39+ The behavior of the simplifier changed in GHC 7.10.2,

40+ causing these rules to fail to fire, leading to poor code generation

41+ and long compilation times. See

42+ [GHC Trac #10528](https://ghc.haskell.org/trac/ghc/ticket/10528).

43+

44+1.2.1.1

45+

46+* Expose unpackCString#, which you should never use.

47+

48+1.2.1.0

49+

50+* Added Binary instances for both Text types. (If you have previously

51+ been using the text-binary package to get a Binary instance, it is

52+ now obsolete.)

53+

54+1.2.0.6

55+

56+* Fixed a space leak in UTF-8 decoding

57+

58+1.2.0.5

59+

60+* Feature parity: repeat, cycle, iterate are now implemented for lazy

61+ Text, and the Data instance is more complete

62+

63+* Build speed: an inliner space explosion has been fixed with toCaseFold

64+

65+* Bug fix: encoding Int to a Builder would infinite-loop if the

66+ integer-simple package was used

67+

68+* Deprecation: OnEncodeError and EncodeError are deprecated, as they

69+ are never used

70+

71+* Internals: some types that are used internally in fusion-related

72+ functions have moved around, been renamed, or been deleted (we don't

73+ bump the major version if .Internal modules change)

74+

75+* Spec compliance: toCaseFold now follows the Unicode 7.0 spec

76+ (updated from 6.3)

77+

78+1.2.0.4

79+

80+* Fixed an incompatibility with base < 4.5

81+

82+1.2.0.3

83+

84+* Update formatRealFloat to correspond to the definition in versions

85+ of base newer than 4.5 (https://github.com/bos/text/issues/105)

86+

87+1.2.0.2

88+

89+* Bumped lower bound on deepseq to 1.4 for compatibility with the

90+ upcoming GHC 7.10

91+

92+1.2.0.1

93+

94+* Fixed a buffer overflow in rendering of large Integers

95+ (https://github.com/bos/text/issues/99)

96+

97+1.2.0.0

98+

99+* Fixed an integer overflow in the replace function

100+ (https://github.com/bos/text/issues/81)

101+

102+* Fixed a hang in lazy decodeUtf8With

103+ (https://github.com/bos/text/issues/87)

104+

105+* Reduced codegen bloat caused by use of empty and single-character

106+ literals

107+

108+* Added an instance of IsList for GHC 7.8 and above

109+

11101.1.1.0

2111

3112* The Data.Data instance now allows gunfold to work, via a virtual

scripts/CaseFolding.hs+1−1

@@ -37,7 +37,7 @@ mapCF :: CaseFolding -> [String]

3737mapCF (CF _ ms) = typ ++ (map nice . filter p $ ms) ++ [last]

3838 where

3939 typ = ["foldMapping :: forall s. Char -> s -> Step (CC s) Char"

40− ,"{-# INLINE foldMapping #-}"]

40+ ,"{-# NOINLINE foldMapping #-}"]

4141 last = "foldMapping c s = Yield (toLower c) (CC s '\\0' '\\0')"

4242 nice c = "-- " ++ name c ++ "\n" ++

4343 "foldMapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"

scripts/CaseMapping.hs+3−3

@@ -8,7 +8,7 @@ import SpecialCasing

88main = do

99 args <- getArgs

1010 let oname = case args of

11− [] -> "../Data/Text/Fusion/CaseMapping.hs"

11+ [] -> "../Data/Text/Internal/Fusion/CaseMapping.hs"

1212 [o] -> o

1313 psc <- parseSC "SpecialCasing.txt"

1414 pcf <- parseCF "CaseFolding.txt"

@@ -24,10 +24,10 @@ main = do

2424 mapM_ (hPutStrLn h) $

2525 ["{-# LANGUAGE Rank2Types #-}"

2626 ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"

27− ,"-- Generated by scripts/SpecialCasing.hs"] ++

27+ ,"-- Generated by scripts/CaseMapping.hs"] ++

2828 comments ++

2929 [""

30− ,"module Data.Text.Fusion.CaseMapping where"

30+ ,"module Data.Text.Internal.Fusion.CaseMapping where"

3131 ,"import Data.Char"

3232 ,"import Data.Text.Internal.Fusion.Types"

3333 ,""]

scripts/SpecialCasing.hs+1−1

@@ -43,7 +43,7 @@ mapSC which access twiddle (SC _ ms) =

4343 typ ++ (map nice . filter p $ ms) ++ [last]

4444 where

4545 typ = [which ++ "Mapping :: forall s. Char -> s -> Step (CC s) Char"

46− ,"{-# INLINE " ++ which ++ "Mapping #-}"]

46+ ,"{-# NOINLINE " ++ which ++ "Mapping #-}"]

4747 last = which ++ "Mapping c s = Yield (to" ++ ucFirst which ++ " c) (CC s '\\0' '\\0')"

4848 nice c = "-- " ++ name c ++ "\n" ++

4949 which ++ "Mapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"

tests/LiteralRuleTest.hsnew file+21

@@ -0,0 +1,21 @@

1+{-# LANGUAGE OverloadedStrings #-}

3+module LiteralRuleTest where

5+import Data.Text (Text)

7+-- This should produce 8 firings of the "TEXT literal" rule

8+strings :: [Text]

9+strings = [ "abstime", "aclitem", "bit", "bool", "box", "bpchar", "bytea", "char" ]

10+

11+-- This should produce 7 firings of the "TEXT literal UTF8" rule

12+utf8Strings :: [Text]

13+utf8Strings = [ "\0abstime", "\0aclitem", "\xfefe bit", "\0bool", "\0box", "\0bpchar", "\0bytea" ]

14+

15+-- This should produce 4 firings of the "TEXT empty literal" rule

16+empties :: [Text]

17+empties = [ "", "", "", "" ]

18+

19+-- This should produce 5 firings of the "TEXT empty literal" rule

20+--singletons :: [Text]

21+--singletons = [ "a", "b", "c", "d", "e" ]

tests/Makefile+6−1

@@ -1,5 +1,10 @@

11count = 1000

3+all: coverage literal-rule-test

5+literal-rule-test:

6+ ./literal-rule-test.sh

38coverage: build coverage/hpc_index.html

510build: text-test-data

@@ -32,4 +37,4 @@ coverage/hpc_index.html: coverage/coverage.tix

3237clean:

3338 rm -rf dist coverage .hpc

3439

35−.PHONY: build coverage

40+.PHONY: build coverage all literal-rule-test

tests/Tests/Properties.hs+120−43

@@ -1,9 +1,8 @@

1−-- | General quicktest properties for the text library

2−--

1+-- | QuickCheck properties for the text library.

33{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,

44 ScopedTypeVariables, TypeSynonymInstances #-}

5−{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}

6−{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

5+{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}

76module Tests.Properties

87 (

98 tests

@@ -15,7 +14,7 @@ import Data.Bits ((.&.))

1514import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)

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

1716import Data.Monoid (Monoid(..))

18−import Data.String (fromString)

17+import Data.String (IsString(fromString))

1918import Data.Text.Encoding.Error

2019import Data.Text.Foreign

2120import Data.Text.Internal.Encoding.Utf8

@@ -24,7 +23,7 @@ import Data.Text.Internal.Search (indices)

2423import Data.Text.Lazy.Read as TL

2524import Data.Text.Read as T

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

27−import Numeric (showHex)

26+import Numeric (showEFloat, showFFloat, showGFloat, showHex)

2827import Prelude hiding (replicate)

2928import Test.Framework (Test, testGroup)

3029import Test.Framework.Providers.QuickCheck2 (testProperty)

@@ -54,6 +53,7 @@ import qualified Data.Text.Lazy.Builder.RealFloat as TB

5453import qualified Data.Text.Lazy.Encoding as EL

5554import qualified Data.Text.Lazy.IO as TL

5655import qualified System.IO as IO

56+import qualified Tests.Properties.Mul as Mul

5757import qualified Tests.SlowFunctions as Slow

5858

5959t_pack_unpack = (T.unpack . T.pack) `eq` id

@@ -197,8 +197,10 @@ t_Show = show `eq` (show . T.pack)

197197tl_Show = show `eq` (show . TL.pack)

198198t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))

199199tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))

200−t_mconcat = mconcat `eq` (unpackS . mconcat . L.map T.pack)

201−tl_mconcat = mconcat `eq` (unpackS . mconcat . L.map TL.pack)

200+t_mconcat = unsquare $

201+ mconcat `eq` (unpackS . mconcat . L.map T.pack)

202+tl_mconcat = unsquare $

203+ mconcat `eq` (unpackS . mconcat . L.map TL.pack)

202204t_mempty = mempty == (unpackS (mempty :: T.Text))

203205tl_mempty = mempty == (unpackS (mempty :: TL.Text))

204206t_IsString = fromString `eqP` (T.unpack . fromString)

@@ -262,11 +264,14 @@ s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)

262264sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)

263265t_map f = map f `eqP` (unpackS . T.map f)

264266tl_map f = map f `eqP` (unpackS . TL.map f)

265−s_intercalate c = L.intercalate c `eq`

267+s_intercalate c = unsquare $

268+ L.intercalate c `eq`

266269 (unpackS . S.intercalate (packS c) . map packS)

267−t_intercalate c = L.intercalate c `eq`

270+t_intercalate c = unsquare $

271+ L.intercalate c `eq`

268272 (unpackS . T.intercalate (packS c) . map packS)

269−tl_intercalate c = L.intercalate c `eq`

273+tl_intercalate c = unsquare $

274+ L.intercalate c `eq`

270275 (unpackS . TL.intercalate (TL.pack c) . map TL.pack)

271276s_intersperse c = L.intersperse c `eqP`

272277 (unpackS . S.intersperse c)

@@ -274,10 +279,14 @@ s_intersperse_s c = L.intersperse c `eqP`

274279 (unpackS . S.unstream . S.intersperse c)

275280sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`

276281 (unpackS . S.intersperse c . S.filter p)

277−t_intersperse c = L.intersperse c `eqP` (unpackS . T.intersperse c)

278−tl_intersperse c = L.intersperse c `eqP` (unpackS . TL.intersperse c)

279−t_transpose = L.transpose `eq` (map unpackS . T.transpose . map packS)

280−tl_transpose = L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)

282+t_intersperse c = unsquare $

283+ L.intersperse c `eqP` (unpackS . T.intersperse c)

284+tl_intersperse c = unsquare $

285+ L.intersperse c `eqP` (unpackS . TL.intersperse c)

286+t_transpose = unsquare $

287+ L.transpose `eq` (map unpackS . T.transpose . map packS)

288+tl_transpose = unsquare $

289+ L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)

281290t_reverse = L.reverse `eqP` (unpackS . T.reverse)

282291tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)

283292t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)

@@ -374,17 +383,24 @@ sf_foldr p f z = (L.foldr f z . L.filter p) `eqP` (S.foldr f z . S.filter p)

374383 where _types = f :: Char -> Char -> Char

375384t_foldr f z = L.foldr f z `eqP` T.foldr f z

376385 where _types = f :: Char -> Char -> Char

377−tl_foldr f z = L.foldr f z `eqP` TL.foldr f z

386+tl_foldr f z = unsquare $

387+ L.foldr f z `eqP` TL.foldr f z

378388 where _types = f :: Char -> Char -> Char

379−sf_foldr1 p f = (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)

389+sf_foldr1 p f = unsquare $

390+ (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)

380391t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f

381−tl_foldr1 f = L.foldr1 f `eqP` TL.foldr1 f

392+tl_foldr1 f = unsquare $

393+ L.foldr1 f `eqP` TL.foldr1 f

382394

383−s_concat_s = L.concat `eq` (unpackS . S.unstream . S.concat . map packS)

384−sf_concat p = (L.concat . map (L.filter p)) `eq`

395+s_concat_s = unsquare $

396+ L.concat `eq` (unpackS . S.unstream . S.concat . map packS)

397+sf_concat p = unsquare $

398+ (L.concat . map (L.filter p)) `eq`

385399 (unpackS . S.concat . map (S.filter p . packS))

386−t_concat = L.concat `eq` (unpackS . T.concat . map packS)

387−tl_concat = L.concat `eq` (unpackS . TL.concat . map TL.pack)

400+t_concat = unsquare $

401+ L.concat `eq` (unpackS . T.concat . map packS)

402+tl_concat = unsquare $

403+ L.concat `eq` (unpackS . TL.concat . map TL.pack)

388404sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`

389405 (unpackS . S.concatMap (packS . f) . S.filter p)

390406t_concatMap f = unsquare $

@@ -424,6 +440,10 @@ t_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z)

424440tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)

425441 where _types = f :: Int -> Char -> (Int,Char)

426442

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+

427447replicate n l = concat (L.replicate n l)

428448

429449s_replicate n = replicate m `eq`

@@ -435,6 +455,14 @@ tl_replicate n = replicate m `eq`

435455 (unpackS . TL.replicate (fromIntegral m) . packS)

436456 where m = fromIntegral (n :: Word8)

437457

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+

438466unf :: Int -> Char -> Maybe (Char, Char)

439467unf n c | fromEnum c * 100 > n = Nothing

440468 | otherwise = Just (c, succ c)

@@ -488,6 +516,10 @@ sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`

488516 (unpackS . S.takeWhile p . S.filter q)

489517t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)

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

491523s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)

492524s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)

493525sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`

@@ -540,24 +572,27 @@ tl_groupBy p = L.groupBy p `eqP` (map unpackS . TL.groupBy p)

540572t_inits = L.inits `eqP` (map unpackS . T.inits)

541573tl_inits = L.inits `eqP` (map unpackS . TL.inits)

542574t_tails = L.tails `eqP` (map unpackS . T.tails)

543−tl_tails = L.tails `eqP` (map unpackS . TL.tails)

544−t_findAppendId (NotEmpty s) = unsquare $ \ts ->

575+tl_tails = unsquare $

576+ L.tails `eqP` (map unpackS . TL.tails)

577+t_findAppendId = unsquare $ \(NotEmpty s) ts ->

545578 let t = T.intercalate s ts

546579 in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)

547−tl_findAppendId (NotEmpty s) = unsquare $ \ts ->

580+tl_findAppendId = unsquare $ \(NotEmpty s) ts ->

548581 let t = TL.intercalate s ts

549582 in all (==t) $ map (uncurry TL.append) (TL.breakOnAll s t)

550−t_findContains (NotEmpty s) = all (T.isPrefixOf s . snd) . T.breakOnAll s .

551− T.intercalate s

552−tl_findContains (NotEmpty s) = all (TL.isPrefixOf s . snd) .

583+t_findContains = unsquare $ \(NotEmpty s) ->

584+ all (T.isPrefixOf s . snd) . T.breakOnAll s . T.intercalate s

585+tl_findContains = unsquare $ \(NotEmpty s) -> all (TL.isPrefixOf s . snd) .

553586 TL.breakOnAll s . TL.intercalate s

554587sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c

555588t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s

556589tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s

557590

558−t_splitOn_split s = (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s

559−tl_splitOn_split s = ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`

560− (map TL.fromStrict . T.splitOn s)) . T.intercalate s

591+t_splitOn_split s = unsquare $

592+ (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s

593+tl_splitOn_split s = unsquare $

594+ ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`

595+ (map TL.fromStrict . T.splitOn s)) . T.intercalate s

561596t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)

562597tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)

563598

@@ -599,10 +634,14 @@ t_lines' = lines' `eqP` (map unpackS . T.lines')

599634t_words = L.words `eqP` (map unpackS . T.words)

600635

601636tl_words = L.words `eqP` (map unpackS . TL.words)

602−t_unlines = L.unlines `eq` (unpackS . T.unlines . map packS)

603−tl_unlines = L.unlines `eq` (unpackS . TL.unlines . map packS)

604−t_unwords = L.unwords `eq` (unpackS . T.unwords . map packS)

605−tl_unwords = L.unwords `eq` (unpackS . TL.unwords . map packS)

637+t_unlines = unsquare $

638+ L.unlines `eq` (unpackS . T.unlines . map packS)

639+tl_unlines = unsquare $

640+ L.unlines `eq` (unpackS . TL.unlines . map packS)

641+t_unwords = unsquare $

642+ L.unwords `eq` (unpackS . T.unwords . map packS)

643+tl_unwords = unsquare $

644+ L.unwords `eq` (unpackS . TL.unwords . map packS)

606645

607646s_isPrefixOf s = L.isPrefixOf s `eqP`

608647 (S.isPrefixOf (S.stream $ packS s) . S.stream)

@@ -679,8 +718,9 @@ t_indices (NotEmpty s) = Slow.indices s `eq` indices s

679718tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s

680719 where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)

681720 conc = T.concat . TL.toChunks

682−t_indices_occurs (NotEmpty t) ts = let s = T.intercalate t ts

683− in Slow.indices t s == indices t s

721+t_indices_occurs = unsquare $ \(NotEmpty t) ts ->

722+ let s = T.intercalate t ts

723+ in Slow.indices t s == indices t s

684724

685725-- Bit shifts.

686726shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k

@@ -716,6 +756,7 @@ tb_decimal :: (Integral a, Show a) => a -> Bool

716756tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)

717757

718758tb_decimal_integer (a::Integer) = tb_decimal a

759+tb_decimal_integer_big (Big a) = tb_decimal a

719760tb_decimal_int (a::Int) = tb_decimal a

720761tb_decimal_int8 (a::Int8) = tb_decimal a

721762tb_decimal_int16 (a::Int16) = tb_decimal a

@@ -727,6 +768,11 @@ tb_decimal_word16 (a::Word16) = tb_decimal a

727768tb_decimal_word32 (a::Word32) = tb_decimal a

728769tb_decimal_word64 (a::Word64) = tb_decimal a

729770

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+

730776tb_hex :: (Integral a, Show a) => a -> Bool

731777tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")

732778

@@ -748,6 +794,21 @@ tb_realfloat = (TB.toLazyText . TB.realFloat) `eq` (TL.pack . show)

748794tb_realfloat_float (a::Float) = tb_realfloat a

749795tb_realfloat_double (a::Double) = tb_realfloat a

750796

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+

751812-- Reading.

752813

753814t_decimal (n::Int) s =

@@ -756,16 +817,18 @@ t_decimal (n::Int) s =

756817tl_decimal (n::Int) s =

757818 TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)

758819 where t = TL.dropWhile isDigit s

759−t_hexadecimal (n::Positive Int) s ox =

820+t_hexadecimal m s ox =

760821 T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)

761822 where t = T.dropWhile isHexDigit s

762823 p = if ox then "0x" else ""

763−tl_hexadecimal (n::Positive Int) s ox =

824+ n = getPositive m :: Int

825+tl_hexadecimal m s ox =

764826 TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)

765827 where t = TL.dropWhile isHexDigit s

766828 p = if ox then "0x" else ""

829+ n = getPositive m :: Int

767830

768−isFloaty c = c `elem` "+-.0123456789eE"

831+isFloaty c = c `elem` ("+-.0123456789eE" :: String)

769832

770833t_read_rational p tol (n::Double) s =

771834 case p (T.pack (show n) `T.append` t) of

@@ -1047,9 +1110,12 @@ tests =

10471110 ],

10481111

10491112 testGroup "unfolds" [

1113+ testProperty "tl_repeat" tl_repeat,

10501114 testProperty "s_replicate" s_replicate,

10511115 testProperty "t_replicate" t_replicate,

10521116 testProperty "tl_replicate" tl_replicate,

1117+ testProperty "tl_cycle" tl_cycle,

1118+ testProperty "tl_iterate" tl_iterate,

10531119 testProperty "t_unfoldr" t_unfoldr,

10541120 testProperty "tl_unfoldr" tl_unfoldr,

10551121 testProperty "t_unfoldrN" t_unfoldrN,

@@ -1080,6 +1146,8 @@ tests =

10801146 testProperty "sf_takeWhile" sf_takeWhile,

10811147 testProperty "t_takeWhile" t_takeWhile,

10821148 testProperty "tl_takeWhile" tl_takeWhile,

1149+ testProperty "t_takeWhileEnd" t_takeWhileEnd,

1150+ testProperty "tl_takeWhileEnd" tl_takeWhileEnd,

10831151 testProperty "sf_dropWhile" sf_dropWhile,

10841152 testProperty "s_dropWhile" s_dropWhile,

10851153 testProperty "s_dropWhile_s" s_dropWhile_s,

@@ -1225,11 +1293,16 @@ tests =

12251293 testProperty "tb_decimal_int32" tb_decimal_int32,

12261294 testProperty "tb_decimal_int64" tb_decimal_int64,

12271295 testProperty "tb_decimal_integer" tb_decimal_integer,

1296+ testProperty "tb_decimal_integer_big" tb_decimal_integer_big,

12281297 testProperty "tb_decimal_word" tb_decimal_word,

12291298 testProperty "tb_decimal_word8" tb_decimal_word8,

12301299 testProperty "tb_decimal_word16" tb_decimal_word16,

12311300 testProperty "tb_decimal_word32" tb_decimal_word32,

1232− testProperty "tb_decimal_word64" tb_decimal_word64

1301+ testProperty "tb_decimal_word64" tb_decimal_word64,

1302+ testProperty "tb_decimal_big_int" tb_decimal_big_int,

1303+ testProperty "tb_decimal_big_word" tb_decimal_big_word,

1304+ testProperty "tb_decimal_big_int64" tb_decimal_big_int64,

1305+ testProperty "tb_decimal_big_word64" tb_decimal_big_word64

12331306 ],

12341307 testGroup "hexadecimal" [

12351308 testProperty "tb_hexadecimal_int" tb_hexadecimal_int,

@@ -1246,7 +1319,9 @@ tests =

12461319 ],

12471320 testGroup "realfloat" [

12481321 testProperty "tb_realfloat_double" tb_realfloat_double,

1249− testProperty "tb_realfloat_float" tb_realfloat_float

1322+ testProperty "tb_realfloat_float" tb_realfloat_float,

1323+ testProperty "tb_formatRealFloat_float" tb_formatRealFloat_float,

1324+ testProperty "tb_formatRealFloat_double" tb_formatRealFloat_double

12501325 ],

12511326 testProperty "tb_fromText" tb_fromText,

12521327 testProperty "tb_singleton" tb_singleton

@@ -1282,5 +1357,7 @@ tests =

12821357 testProperty "t_take_drop_16" t_take_drop_16,

12831358 testProperty "t_use_from" t_use_from,

12841359 testProperty "t_copy" t_copy

1285− ]

1360+ ],

1361+

1362+ testGroup "mul" Mul.tests

12861363 ]

tests/Tests/Properties/Mul.hsnew file+40

@@ -0,0 +1,40 @@

1+{-# LANGUAGE ScopedTypeVariables #-}

3+module Tests.Properties.Mul (tests) where

5+import Control.Applicative ((<$>), pure)

6+import Control.Exception as E (SomeException, catch, evaluate)

7+import Data.Int (Int32, Int64)

8+import Data.Text.Internal (mul, mul32, mul64)

9+import System.IO.Unsafe (unsafePerformIO)

10+import Test.Framework (Test)

11+import Test.Framework.Providers.QuickCheck2 (testProperty)

12+import Test.QuickCheck hiding ((.&.))

13+

14+mulRef :: (Integral a, Bounded a) => a -> a -> Maybe a

15+mulRef a b

16+ | ab < bot || ab > top = Nothing

17+ | otherwise = Just (fromIntegral ab)

18+ where ab = fromIntegral a * fromIntegral b

19+ top = fromIntegral (maxBound `asTypeOf` a) :: Integer

20+ bot = fromIntegral (minBound `asTypeOf` a) :: Integer

21+

22+eval :: (a -> b -> c) -> a -> b -> Maybe c

23+eval f a b = unsafePerformIO $

24+ (Just <$> evaluate (f a b)) `E.catch` (\(_::SomeException) -> pure Nothing)

25+

26+t_mul32 :: Int32 -> Int32 -> Property

27+t_mul32 a b = mulRef a b === eval mul32 a b

28+

29+t_mul64 :: Int64 -> Int64 -> Property

30+t_mul64 a b = mulRef a b === eval mul64 a b

31+

32+t_mul :: Int -> Int -> Property

33+t_mul a b = mulRef a b === eval mul a b

34+

35+tests :: [Test]

36+tests = [

37+ testProperty "t_mul" t_mul

38+ , testProperty "t_mul32" t_mul32

39+ , testProperty "t_mul64" t_mul64

40+ ]

tests/Tests/QuickCheckUtils.hs+73−82

@@ -7,48 +7,46 @@

77module Tests.QuickCheckUtils

88 (

99 genUnicode

10− , genUnicodeWith

11− , ascii

12− , plane0

13− , plane1

14− , plane2

15− , plane14

16− , planes

17−

1810 , unsquare

1911 , smallArbitrary

2012

21− , NotEmpty (..)

13+ , BigBounded(..)

14+ , BigInt(..)

15+ , NotEmpty(..)

2216

23− , Small (..)

17+ , Small(..)

2418 , small

2519

20+ , Precision(..)

21+ , precision

22+

2623 , integralRandomR

2724

28− , DecodeErr (..)

25+ , DecodeErr(..)

2926 , genDecodeErr

3027

31− , Stringy (..)

28+ , Stringy(..)

3229 , eq

3330 , eqP

3431

35− , Encoding (..)

32+ , Encoding(..)

3633

3734 , write_read

3835 ) where

3936

37+import Control.Applicative ((<$>))

4038import Control.Arrow (first, (***))

4139import Control.DeepSeq (NFData (..), deepseq)

4240import Control.Exception (bracket)

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

44−import Data.Char (chr)

4541import Data.String (IsString, fromString)

4642import Data.Text.Foreign (I16)

43+import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))

4744import Data.Word (Word8, Word16)

4845import Debug.Trace (trace)

49−import System.Random (Random (..), RandomGen)

50−import Test.QuickCheck hiding (Small (..), (.&.))

46+import System.Random (Random(..), RandomGen)

47+import Test.QuickCheck hiding (Fixed(..), Small (..), (.&.))

5148import Test.QuickCheck.Monadic (assert, monadicIO, run)

49+import Test.QuickCheck.Unicode (string)

5250import Tests.Utils

5351import qualified Data.ByteString as B

5452import qualified Data.Text as T

@@ -60,6 +58,14 @@ import qualified Data.Text.Internal.Lazy.Fusion as TLF

6058import qualified Data.Text.Lazy as TL

6159import qualified System.IO as IO

6260

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+

6369instance Random I16 where

6470 randomR = integralRandomR

6571 random = randomR (minBound,maxBound)

@@ -73,75 +79,22 @@ instance Arbitrary B.ByteString where

7379 shrink = map B.pack . shrink . B.unpack

7480

7581#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+

7690instance Random Word8 where

7791 randomR = integralRandomR

7892 random = randomR (minBound,maxBound)

79−#endif

8093

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]

94+instance Random Word64 where

95+ randomR = integralRandomR

96+ random = randomR (minBound,maxBound)

97+#endif

14598

14699-- For tests that have O(n^2) running times or input sizes, resize

147100-- their inputs to the square root of the originals.

@@ -160,6 +113,20 @@ instance Arbitrary TL.Text where

160113 arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary

161114 shrink = map TL.pack . shrink . TL.unpack

162115

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+

163130newtype NotEmpty a = NotEmpty { notEmpty :: a }

164131 deriving (Eq, Ord)

165132

@@ -300,6 +267,30 @@ eqP f g s w = eql "orig" (f s) (g t) &&

300267 | a =^= b = True

301268 | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False

302269

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+

303294-- Work around lack of Show instance for TextEncoding.

304295data Encoding = E String IO.TextEncoding

305296

tests/cabal.config−1

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

11-- These flags help to speed up building the test suite.

33documentation: False

4−executable-profiling: False

54executable-stripping: False

65flags: developer

76library-profiling: False

tests/literal-rule-test.shnew file+29

@@ -0,0 +1,29 @@

1+#!/bin/bash -e

3+failed=0

5+function check_firings() {

6+ rule=$1

7+ expected=$2

8+ build="ghc -O -ddump-rule-firings LiteralRuleTest.hs"

9+ build="$build -i.. -I../include"

10+ touch LiteralRuleTest.hs

11+ echo -n "Want to see $expected firings of rule $rule... " >&2

12+ firings=$($build 2>&1 | grep "Rule fired: $rule\$" | wc -l)

13+ rm -f LiteralRuleTest.{o.hi}

14+

15+ if [ $firings != $expected ]; then

16+ echo "failed, saw $firings" >&2

17+ failed=1

18+ else

19+ echo "pass" >&2

20+ fi

21+}

22+

23+check_firings "TEXT literal" 8

24+check_firings "TEXT literal UTF8" 7

25+check_firings "TEXT empty literal" 4

26+# This is broken at the moment. "TEXT literal" rule fires instead.

27+#check_firings "TEXT singleton literal" 5

28+

29+exit $failed

tests/text-tests.cabal+13−1

@@ -3,7 +3,7 @@ version: 0.0.0.0

33synopsis: Functional tests for the text package

44description: Functional tests for the text package

55homepage: https://github.com/bos/text

6−license: BSD3

6+license: BSD2

77license-file: ../LICENSE

88author: Jasper Van der Jeugt <jaspervdj@gmail.com>,

99 Bryan O'Sullivan <bos@serpentine.com>,

@@ -23,6 +23,15 @@ flag hpc

2323executable text-tests

2424 main-is: Tests.hs

2525

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+

2635 ghc-options:

2736 -Wall -threaded -O0 -rtsopts

2837

@@ -42,6 +51,7 @@ executable text-tests

4251 bytestring,

4352 deepseq,

4453 directory,

54+ quickcheck-unicode,

4555 random,

4656 test-framework >= 0.4,

4757 test-framework-hunit >= 0.2,

@@ -104,6 +114,7 @@ library

104114 Data.Text.Internal.Lazy.Search

105115 Data.Text.Internal.Private

106116 Data.Text.Read

117+ Data.Text.Show

107118 Data.Text.Internal.Read

108119 Data.Text.Internal.Search

109120 Data.Text.Unsafe

@@ -125,6 +136,7 @@ library

125136 build-depends:

126137 array,

127138 base == 4.*,

139+ binary,

128140 bytestring,

129141 deepseq,

130142 ghc-prim,

text.cabal+25−6

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

11name: text

2−version: 1.1.1.4

2+version: 1.2.2.1

33homepage: https://github.com/bos/text

44bug-reports: https://github.com/bos/text/issues

55synopsis: An efficient packed Unicode text type.

@@ -31,7 +31,7 @@ description:

3131 the @text-icu@ package:

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

3333

34−license: BSD3

34+license: BSD2

3535license-file: LICENSE

3636author: Bryan O'Sullivan <bos@serpentine.com>

3737maintainer: Bryan O'Sullivan <bos@serpentine.com>

@@ -59,10 +59,16 @@ extra-source-files:

5959 tests/.ghci

6060 tests/Makefile

6161 tests/Tests/*.hs

62+ tests/Tests/Properties/*.hs

6263 tests/cabal.config

6364 tests/scripts/*.sh

6465 tests/text-tests.cabal

6566

67+flag bytestring-builder

68+ description: Depend on the bytestring-builder package for backwards compatibility.

69+ default: False

70+ manual: False

71+

6672flag developer

6773 description: operate in developer mode

6874 default: False

@@ -71,6 +77,7 @@ flag developer

7177flag integer-simple

7278 description: Use the simple integer library instead of GMP

7379 default: False

80+ manual: False

7481

7582library

7683 c-sources: cbits/cbits.c

@@ -121,16 +128,21 @@ library

121128 Data.Text.Read

122129 Data.Text.Unsafe

123130

131+ other-modules:

132+ Data.Text.Show

133+

124134 build-depends:

125135 array >= 0.3,

126136 base >= 4.2 && < 5,

137+ binary,

127138 deepseq >= 1.1.0.0,

128139 ghc-prim >= 0.2

129140

130− if impl(ghc >= 7.7)

131− build-depends: bytestring >= 0.10.4.0

141+ if flag(bytestring-builder)

142+ build-depends: bytestring >= 0.9 && < 0.10.4,

143+ bytestring-builder >= 0.10.4

132144 else

133− build-depends: bytestring >= 0.9

145+ build-depends: bytestring >= 0.10.4

134146

135147 cpp-options: -DHAVE_DEEPSEQ

136148 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2

@@ -164,15 +176,22 @@ test-suite tests

164176 QuickCheck >= 2.7,

165177 array,

166178 base,

167− bytestring,

179+ binary,

168180 deepseq,

169181 directory,

170182 ghc-prim,

183+ quickcheck-unicode,

171184 random,

172185 test-framework >= 0.4,

173186 test-framework-hunit >= 0.2,

174187 test-framework-quickcheck2 >= 0.2

175188

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+

176195 if flag(integer-simple)

177196 cpp-options: -DINTEGER_SIMPLE

178197 build-depends: integer-simple >= 0.1 && < 0.5