on master help sign in
56 files changed+1988−708
since splitsnapshots
unifiedsplit
.gitignore+1 .hgtags+18 Data/Text.hs+256−135 Data/Text/Array.hs+7−6 Data/Text/Encoding.hs+13−26 Data/Text/Encoding/Error.hs+7−1 Data/Text/Internal.hs+74−10 Data/Text/Internal/Builder.hs+19−16 Data/Text/Internal/Builder/Functions.hs+2−1 Data/Text/Internal/Builder/Int/Digits.hs+1−1 Data/Text/Internal/Builder/RealFloat/Functions.hs+28 Data/Text/Internal/Fusion.hs+38−28 Data/Text/Internal/Fusion/CaseMapping.hs+291−19 Data/Text/Internal/Fusion/Common.hs+63−75 Data/Text/Internal/Fusion/Size.hs+60−52 Data/Text/Internal/Fusion/Types.hs+8−13 Data/Text/Internal/Private.hs+4−4 Data/Text/Internal/Read.hs+3−3 Data/Text/Lazy.hs+200−25 Data/Text/Lazy/Builder.hs+1−1 Data/Text/Lazy/Builder/Int.hs+19−14 Data/Text/Lazy/Encoding.hs+9−21 Data/Text/Lazy/Read.hs+4−2 Data/Text/Read.hs+1−1 Data/Text/Show.hs+89 Data/Text/Unsafe.hs+11 benchmarks/haskell/Benchmarks.hs+3−1 benchmarks/haskell/Benchmarks/DecodeUtf8.hs+2−2 benchmarks/haskell/Benchmarks/FileRead.hs+11−11 benchmarks/haskell/Benchmarks/FoldLines.hs+2−2 benchmarks/haskell/Benchmarks/Mul.hs+138 benchmarks/haskell/Benchmarks/Programs/BigTable.hs+2−2 benchmarks/haskell/Benchmarks/Programs/Cut.hs+2−2 benchmarks/haskell/Benchmarks/Programs/Fold.hs+2−2 benchmarks/haskell/Benchmarks/Programs/Sort.hs+10−9 benchmarks/haskell/Benchmarks/Programs/StripTags.hs+5−5 benchmarks/haskell/Benchmarks/Programs/Throughput.hs+8−8 benchmarks/haskell/Benchmarks/Pure.hs+7 benchmarks/haskell/Benchmarks/ReadNumbers.hs+2−5 benchmarks/haskell/Benchmarks/Stream.hs+16−5 benchmarks/text-benchmarks.cabal+18−6 cbits/cbits.c+6−6 changelog−41 changelog.md+164 scripts/CaseFolding.hs+1−1 scripts/CaseMapping.hs+3−3 scripts/SpecialCasing.hs+1−1 tests/LiteralRuleTest.hs+21 tests/Makefile+6−1 tests/Tests/Properties.hs+136−48 tests/Tests/Properties/Mul.hs+40 tests/Tests/QuickCheckUtils.hs+73−82 tests/cabal.config+6 tests/literal-rule-test.sh+29 tests/text-tests.cabal+18−3 text.cabal+29−8
.gitignore+1
@@ -1,2 +1,3 @@
11dist
22cabal-dev
3+cabal.sandbox.config
.hgtags+18
@@ -46,3 +46,21 @@ d99cd091cdf71ce807a4255f6cc509c3154f51ea 0.11.3.1
46467cba97c86467c1881dfced68613891f3c65561b0 1.0.0.1
474762674a9bbc83145d1d7be28a05d456ab6bb5ff89 1.1.0.0
484868a32d80c0829da164d1e6b3acedcc3efeda0957 1.1.0.1
49+6d863daafbf0e1289ec0a0eb9b4be2a0a9cb8d3d 1.1.1.0
50+fb7299f22449750c653ac64dee4bd63c13ea6e4c 1.1.1.1
51+eb170cb533b63534d166b5fd5344b36676adf140 1.1.1.2
52+e749e05f715d02445803f653cd3d97d5395d7c6f 1.1.1.3
53+b0dff8ca1142595bab489a768ca62e6a6805aac4 1.1.1.4
54+f8a60279237c1c28e094868740d9188dd94fcc9e 1.2.0.0
55+6231451979b2d33e28038b75f2dab19c9731f5c3 1.2.0.1
56+99a3503b4ad001fc1894e90286e96d7dea1e9195 1.2.0.2
57+47f138edf15576b9adaeed64784e30811099f202 1.2.0.3
58+0b064b0c69106bbcd13cb0099e72ae5fa2347bf0 1.2.0.4
59+8bbb3e222a0037035d893f731b0a23be449f7346 1.2.0.5
60+18c7f8e19872762b7e28ee1871e72f70ea54e3cd 1.2.0.6
61+42f751b87b4a187db93f595a8166d51746ff57d4 1.2.1.0
62+78227a84740b70dcd4cf7a65f3bcf603d87e48e2 1.2.1.1
63+40f268e6735749ef36f487e1d928eaa957bb431d 1.2.1.2
64+631fd055e27fa10983e17e9ad36d1b285b85c661 1.2.1.3
65+8221a68ed5ec37028357df9c6c25f52320e54ad9 1.2.2.0
66+ce1c5ac65eb9f5580114b4e380092b05a485e95d 1.2.2.1
Data/Text.hs+256−135
@@ -3,6 +3,9 @@
33#if __GLASGOW_HASKELL__ >= 702
44{-# LANGUAGE Trustworthy #-}
55#endif
6+#if __GLASGOW_HASKELL__ >= 708
7+{-# LANGUAGE TypeFamilies #-}
8+#endif
69
710-- |
811-- Module : Data.Text
@@ -29,8 +32,8 @@
2932--
3033-- To use an extended and very rich family of functions for working
3134-- with Unicode text (including normalization, regular expressions,
32−-- non-standard encodings, text breaking, and locales), see the
33−-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>
35+-- non-standard encodings, text breaking, and locales), see
36+-- <http://hackage.haskell.org/package/text-icu the text-icu package >.
3437
3538module Data.Text
3639 (
@@ -122,8 +125,11 @@ module Data.Text
122125
123126 -- ** Breaking strings
124127 , take
128+ , takeEnd
125129 , drop
130+ , dropEnd
126131 , takeWhile
132+ , takeWhileEnd
127133 , dropWhile
128134 , dropWhileEnd
129135 , dropAround
@@ -186,35 +192,43 @@ module Data.Text
186192
187193 -- * Low level operations
188194 , copy
195+ , unpackCString#
189196 ) where
190197
191198import Prelude (Char, Bool(..), Int, Maybe(..), String,
192199 Eq(..), Ord(..), Ordering(..), (++),
193− Read(..), Show(..),
194− (&&), (||), (+), (-), (.), ($), ($!), (>>), (*),
195− maxBound, not, return, otherwise, quot)
200+ Read(..),
201+ (&&), (||), (+), (-), (.), ($), ($!), (>>),
202+ not, return, otherwise, quot)
196203#if defined(HAVE_DEEPSEQ)
197−import Control.DeepSeq (NFData)
204+import Control.DeepSeq (NFData(rnf))
198205#endif
199206#if defined(ASSERTS)
200207import Control.Exception (assert)
201208#endif
202209import Data.Char (isSpace)
203−import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))
204−import Data.Data (mkNoRepType)
210+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
211+ Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
205212import Control.Monad (foldM)
213+import Control.Monad.ST (ST)
206214import qualified Data.Text.Array as A
207215import qualified Data.List as L
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.Internal.Fusion as S
211223import qualified Data.Text.Internal.Fusion.Common as S
224+import Data.Text.Encoding (decodeUtf8', encodeUtf8)
212225import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
213226import Data.Text.Internal.Private (span_)
214−import Data.Text.Internal (Text(..), empty, firstf, safe, text, textP)
227+import Data.Text.Internal (Text(..), empty, firstf, mul, safe, text)
228+import Data.Text.Show (singleton, unpack, unpackCString#)
215229import qualified Prelude as P
216230import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
217− unsafeHead, unsafeTail)
231+ reverseIter_, unsafeHead, unsafeTail)
218232import Data.Text.Internal.Unsafe.Char (unsafeChr)
219233import qualified Data.Text.Internal.Functions as F
220234import qualified Data.Text.Internal.Encoding.Utf16 as U16
@@ -224,12 +238,13 @@ import Data.ByteString (ByteString)
224238import qualified Data.Text.Lazy as L
225239import Data.Int (Int64)
226240#endif
227−#if __GLASGOW_HASKELL__ >= 702
228−import qualified GHC.CString as GHC
229−#else
230−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)
231247#endif
232−import GHC.Prim (Addr#)
233248
234249-- $strict
235250--
@@ -239,29 +254,32 @@ import GHC.Prim (Addr#)
239254-- lazy @Text@ type consists of a list of strict chunks.
240255--
241256-- The strict 'Text' type requires that an entire string fit into
242−-- memory at once. The lazy @Text@ type is capable of streaming
243−-- strings that are larger than memory using a small memory footprint.
244−-- In many cases, the overhead of chunked streaming makes the lazy
245−-- @Text@ type slower than its strict counterpart, but this is not
246−-- always the case. Sometimes, the time complexity of a function in
247−-- one module may be different from the other, due to their differing
248−-- internal structures.
257+-- memory at once. The lazy 'Data.Text.Lazy.Text' type is capable of
258+-- streaming strings that are larger than memory using a small memory
259+-- footprint. In many cases, the overhead of chunked streaming makes
260+-- the lazy 'Data.Text.Lazy.Text' type slower than its strict
261+-- counterpart, but this is not always the case. Sometimes, the time
262+-- complexity of a function in one module may be different from the
263+-- other, due to their differing internal structures.
249264--
250265-- Each module provides an almost identical API, with the main
251266-- difference being that the strict module uses 'Int' values for
252−-- lengths and counts, while the lazy module uses 'Int64' lengths.
267+-- lengths and counts, while the lazy module uses 'Data.Int.Int64'
268+-- lengths.
253269
254270-- $replacement
255271--
256272-- A 'Text' value is a sequence of Unicode scalar values, as defined
257−-- in &#xa7;3.9, definition D76 of the Unicode 5.2 standard:
258−-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35>. As
259−-- such, a 'Text' cannot contain values in the range U+D800 to U+DFFF
260−-- inclusive. Haskell implementations admit all Unicode code points
261−-- (&#xa7;3.4, definition D10) as 'Char' values, including code points
262−-- from this invalid range. This means that there are some 'Char'
263−-- values that are not valid Unicode scalar values, and the functions
264−-- in this module must handle those cases.
273+-- in
274+-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35 §3.9, definition D76 of the Unicode 5.2 standard >.
275+-- As such, a 'Text' cannot contain values in the range U+D800 to
276+-- U+DFFF inclusive. Haskell implementations admit all Unicode code
277+-- points
278+-- (<http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=13 §3.4, definition D10 >)
279+-- as 'Char' values, including code points from this invalid range.
280+-- This means that there are some 'Char' values that are not valid
281+-- Unicode scalar values, and the functions in this module must handle
282+-- those cases.
265283--
266284-- Within this module, many functions construct a 'Text' from one or
267285-- more 'Char' values. Those functions will substitute 'Char' values
@@ -275,8 +293,8 @@ import GHC.Prim (Addr#)
275293-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate
276294-- code points, and so cannot be represented. The functions replace
277295-- invalid scalar values, instead of dropping them, as a security
278−-- measure. For details, see Unicode Technical Report 36, &#xa7;3.5:
279−-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters>)
296+-- measure. For details, see
297+-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters Unicode Technical Report 36, §3.5 >.)
280298
281299-- $fusion
282300--
@@ -294,11 +312,11 @@ import GHC.Prim (Addr#)
294312-- > countChars = T.length . T.toUpper . E.decodeUtf8
295313--
296314-- From the type signatures involved, this looks like it should
297−-- allocate one 'ByteString' value, and two 'Text' values. However,
298−-- when a module is compiled with optimisation enabled under GHC, the
299−-- two intermediate 'Text' values will be optimised away, and the
300−-- function will be compiled down to a single loop over the source
301−-- 'ByteString'.
315+-- allocate one 'Data.ByteString.ByteString' value, and two 'Text'
316+-- values. However, when a module is compiled with optimisation
317+-- enabled under GHC, the two intermediate 'Text' values will be
318+-- optimised away, and the function will be compiled down to a single
319+-- loop over the source 'Data.ByteString.ByteString'.
302320--
303321-- Functions that can be fused by the compiler are documented with the
304322-- phrase \"Subject to fusion\".
@@ -312,41 +330,82 @@ instance Eq Text where
312330instance Ord Text where
313331 compare = compareText
314332
315−instance Show Text where
316− showsPrec p ps r = showsPrec p (unpack ps) r
317−
318333instance Read Text where
319334 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
320335
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+
321344instance Monoid Text where
322345 mempty = empty
346+#if MIN_VERSION_base(4,9,0)
347+ mappend = (<>) -- future-proof definition
348+#else
323349 mappend = append
350+#endif
324351 mconcat = concat
325352
326353instance IsString Text where
327354 fromString = pack
328355
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+
329363#if defined(HAVE_DEEPSEQ)
330−instance NFData Text
364+instance NFData Text where rnf !_ = ()
331365#endif
332366
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+
333375-- | This instance preserves data abstraction at the cost of inefficiency.
334376-- We omit reflection services for the sake of data abstraction.
335377--
336−-- This instance was created by copying the behavior of Data.Set and
337−-- Data.Map. If you feel a mistake has been made, please feel free to
338−-- submit improvements.
378+-- This instance was created by copying the updated behavior of
379+-- @"Data.Set".@'Data.Set.Set' and @"Data.Map".@'Data.Map.Map'. If you
380+-- feel a mistake has been made, please feel free to submit
381+-- improvements.
339382--
340−-- Original discussion is archived here:
383+-- The original discussion is archived here:
384+-- <http://groups.google.com/group/haskell-cafe/browse_thread/thread/b5bbb1b28a7e525d/0639d46852575b93 could we get a Data instance for Data.Text.Text? >
341385--
342−-- "could we get a Data instance for Data.Text.Text?"
343−-- http://groups.google.com/group/haskell-cafe/browse_thread/thread/b5bbb1b28a7e525d/0639d46852575b93
386+-- The followup discussion that changed the behavior of 'Data.Set.Set'
387+-- and 'Data.Map.Map' is archived here:
388+-- <http://markmail.org/message/trovdc6zkphyi3cr#query:+page:1+mid:a46der3iacwjcf6n+state:results Proposal: Allow gunfold for Data.Map, ... >
344389
345390instance Data Text where
346391 gfoldl f z txt = z pack `f` (unpack txt)
347− toConstr _ = P.error "Data.Text.Text.toConstr"
348− gunfold _ _ = P.error "Data.Text.Text.gunfold"
349− dataTypeOf _ = mkNoRepType "Data.Text.Text"
392+ toConstr _ = packConstr
393+ gunfold k z c = case constrIndex c of
394+ 1 -> k (z pack)
395+ _ -> P.error "gunfold"
396+ dataTypeOf _ = textDataType
397+
398+#if MIN_VERSION_base(4,7,0)
399+-- | Only defined for @base-4.7.0.0@ and later
400+instance PrintfArg Text where
401+ formatArg txt = formatString $ unpack txt
402+#endif
403+
404+packConstr :: Constr
405+packConstr = mkConstr textDataType "pack" [] Prefix
406+
407+textDataType :: DataType
408+textDataType = mkDataType "Data.Text.Text" [packConstr]
350409
351410-- | /O(n)/ Compare two 'Text' values lexicographically.
352411compareText :: Text -> Text -> Ordering
@@ -371,30 +430,6 @@ pack :: String -> Text
371430pack = unstream . S.map safe . S.streamList
372431{-# INLINE [1] pack #-}
373432
374−-- | /O(n)/ Convert a 'Text' into a 'String'. Subject to fusion.
375−unpack :: Text -> String
376−unpack = S.unstreamList . stream
377−{-# INLINE [1] unpack #-}
378−
379−-- | /O(n)/ Convert a literal string into a Text. Subject to fusion.
380−unpackCString# :: Addr# -> Text
381−unpackCString# addr# = unstream (S.streamCString# addr#)
382−{-# NOINLINE unpackCString# #-}
383−
384−{-# RULES "TEXT literal" forall a.
385− unstream (S.map safe (S.streamList (GHC.unpackCString# a)))
386− = unpackCString# a #-}
387−
388−{-# RULES "TEXT literal UTF8" forall a.
389− unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))
390− = unpackCString# a #-}
391−
392−-- | /O(1)/ Convert a character into a Text. Subject to fusion.
393−-- Performs replacement on invalid scalar values.
394−singleton :: Char -> Text
395−singleton = unstream . S.singleton . safe
396−{-# INLINE [1] singleton #-}
397−
398433-- -----------------------------------------------------------------------------
399434-- * Basic functions
400435
@@ -425,6 +460,7 @@ append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
425460 | otherwise = overflowError "append"
426461 where
427462 len = len1+len2
463+ x :: ST s (A.MArray s)
428464 x = do
429465 arr <- A.new len
430466 A.copyI arr 0 arr1 off1 len1
@@ -450,8 +486,8 @@ head t = S.head (stream t)
450486uncons :: Text -> Maybe (Char, Text)
451487uncons t@(Text arr off len)
452488 | len <= 0 = Nothing
453− | otherwise = Just (c, textP arr (off+d) (len-d))
454− 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))
455491{-# INLINE [1] uncons #-}
456492
457493-- | Lifted from Control.Arrow and specialized.
@@ -481,7 +517,7 @@ last (Text arr off len)
481517tail :: Text -> Text
482518tail t@(Text arr off len)
483519 | len <= 0 = emptyError "tail"
484− | otherwise = textP arr (off+d) (len-d)
520+ | otherwise = text arr (off+d) (len-d)
485521 where d = iter_ t 0
486522{-# INLINE [1] tail #-}
487523
@@ -496,8 +532,8 @@ tail t@(Text arr off len)
496532-- be non-empty. Subject to fusion.
497533init :: Text -> Text
498534init (Text arr off len) | len <= 0 = emptyError "init"
499− | n >= 0xDC00 && n <= 0xDFFF = textP arr off (len-2)
500− | otherwise = textP arr off (len-1)
535+ | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)
536+ | otherwise = text arr off (len-1)
501537 where
502538 n = A.unsafeIndex arr (off+len-1)
503539{-# INLINE [1] init #-}
@@ -536,7 +572,9 @@ isSingleton = S.isSingleton . stream
536572-- Subject to fusion.
537573length :: Text -> Int
538574length t = S.length (stream t)
539−{-# INLINE length #-}
575+{-# INLINE [0] length #-}
576+-- length needs to be phased after the compareN/length rules otherwise
577+-- it may inline before the rules have an opportunity to fire.
540578
541579-- | /O(n)/ Compare the count of characters in a 'Text' to a number.
542580-- Subject to fusion.
@@ -555,32 +593,32 @@ compareLength t n = S.compareLengthI (stream t) n
555593
556594{-# RULES
557595"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.
558− (==) (length t) n = compareLength t n == EQ
596+ eqInt (length t) n = compareLength t n == EQ
559597 #-}
560598
561599{-# RULES
562600"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.
563− (/=) (length t) n = compareLength t n /= EQ
601+ neInt (length t) n = compareLength t n /= EQ
564602 #-}
565603
566604{-# RULES
567605"TEXT <N/length -> compareLength/==LT" [~1] forall t n.
568− (<) (length t) n = compareLength t n == LT
606+ ltInt (length t) n = compareLength t n == LT
569607 #-}
570608
571609{-# RULES
572610"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.
573− (<=) (length t) n = compareLength t n /= GT
611+ leInt (length t) n = compareLength t n /= GT
574612 #-}
575613
576614{-# RULES
577615"TEXT >N/length -> compareLength/==GT" [~1] forall t n.
578− (>) (length t) n = compareLength t n == GT
616+ gtInt (length t) n = compareLength t n == GT
579617 #-}
580618
581619{-# RULES
582620"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.
583− (>=) (length t) n = compareLength t n /= LT
621+ geInt (length t) n = compareLength t n /= LT
584622 #-}
585623
586624-- -----------------------------------------------------------------------------
@@ -611,22 +649,48 @@ reverse :: Text -> Text
611649reverse t = S.reverse (stream t)
612650{-# INLINE reverse #-}
613651
614−-- | /O(m+n)/ Replace every occurrence of one substring with another.
652+-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
653+-- @haystack@ with @replacement@.
654+--
655+-- This function behaves as though it was defined as follows:
656+--
657+-- @
658+-- replace needle replacement haystack =
659+-- 'intercalate' replacement ('splitOn' needle haystack)
660+-- @
661+--
662+-- As this suggests, each occurrence is replaced exactly once. So if
663+-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
664+-- be replaced recursively:
665+--
666+-- > replace "oo" "foo" "oo" == "foo"
667+--
668+-- In cases where several instances of @needle@ overlap, only the
669+-- first one will be replaced:
670+--
671+-- > replace "ofo" "bar" "ofofo" == "barfo"
615672--
616673-- In (unlikely) bad cases, this function's time complexity degrades
617674-- towards /O(n*m)/.
618−replace :: Text -> Text -> Text -> Text
675+replace :: Text
676+ -- ^ @needle@ to search for. If this string is empty, an
677+ -- error will occur.
678+ -> Text
679+ -- ^ @replacement@ to replace @needle@ with.
680+ -> Text
681+ -- ^ @haystack@ in which to search.
682+ -> Text
619683replace needle@(Text _ _ neeLen)
620684 (Text repArr repOff repLen)
621685 haystack@(Text hayArr hayOff hayLen)
622686 | neeLen == 0 = emptyError "replace"
623687 | L.null ixs = haystack
624688 | len > 0 = Text (A.run x) 0 len
625− | len < 0 = overflowError "replace"
626689 | otherwise = empty
627690 where
628691 ixs = indices needle haystack
629− len = hayLen - (neeLen - repLen) * L.length ixs
692+ len = hayLen - (neeLen - repLen) `mul` L.length ixs
693+ x :: ST s (A.MArray s)
630694 x = do
631695 marr <- A.new len
632696 let loop (i:is) o d = do
@@ -656,9 +720,8 @@ replace needle@(Text _ _ neeLen)
656720-- /Note/: In some languages, case conversion is a locale- and
657721-- context-dependent operation. The case conversion functions in this
658722-- module are /not/ locale sensitive. Programs that require locale
659−-- sensitivity should use appropriate versions of the case mapping
660−-- functions from the @text-icu@ package:
661−-- <http://hackage.haskell.org/package/text-icu>
723+-- sensitivity should use appropriate versions of the
724+-- <http://hackage.haskell.org/package/text-icu-0.6.3.7/docs/Data-Text-ICU.html#g:4 case mapping functions from the text-icu package >.
662725
663726-- | /O(n)/ Convert a string to folded case. Subject to fusion.
664727--
@@ -678,7 +741,7 @@ replace needle@(Text _ _ neeLen)
678741-- instead of itself.
679742toCaseFold :: Text -> Text
680743toCaseFold t = unstream (S.toCaseFold (stream t))
681−{-# INLINE [0] toCaseFold #-}
744+{-# INLINE toCaseFold #-}
682745
683746-- | /O(n)/ Convert a string to lower case, using simple case
684747-- conversion. Subject to fusion.
@@ -838,6 +901,7 @@ concat ts = case ts' of
838901 where
839902 ts' = L.filter (not . null) ts
840903 len = sumP "concat" $ L.map lengthWord16 ts'
904+ go :: ST s (A.MArray s)
841905 go = do
842906 arr <- A.new len
843907 let step i (Text a o l) =
@@ -851,13 +915,13 @@ concatMap f = concat . foldr ((:) . f) []
851915{-# INLINE concatMap #-}
852916
853917-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
854−-- 'Text' @t@ satisifes the predicate @p@. Subject to fusion.
918+-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
855919any :: (Char -> Bool) -> Text -> Bool
856920any p t = S.any p (stream t)
857921{-# INLINE any #-}
858922
859923-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
860−-- 'Text' @t@ satisify the predicate @p@. Subject to fusion.
924+-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
861925all :: (Char -> Bool) -> Text -> Bool
862926all p t = S.all p (stream t)
863927{-# INLINE all #-}
@@ -948,10 +1012,10 @@ replicate n t@(Text a o l)
9481012 | n <= 0 || l <= 0 = empty
9491013 | n == 1 = t
9501014 | isSingleton t = replicateChar n (unsafeHead t)
951− | n <= maxBound `quot` l = Text (A.run x) 0 len
952− | otherwise = overflowError "replicate"
1015+ | otherwise = Text (A.run x) 0 len
9531016 where
954− len = l * n
1017+ len = l `mul` n
1018+ x :: ST s (A.MArray s)
9551019 x = do
9561020 arr <- A.new len
9571021 let loop !d !i | i >= n = return arr
@@ -1002,14 +1066,16 @@ take :: Int -> Text -> Text
10021066take n t@(Text arr off len)
10031067 | n <= 0 = empty
10041068 | n >= len = t
1005− | otherwise = Text arr off (loop 0 0)
1006− where
1007− loop !i !cnt
1008− | i >= len || cnt >= n = i
1009− | otherwise = loop (i+d) (cnt+1)
1010− where d = iter_ t i
1069+ | otherwise = text arr off (iterN n t)
10111070{-# INLINE [1] take #-}
10121071
1072+iterN :: Int -> Text -> Int
1073+iterN n t@(Text _arr _off len) = loop 0 0
1074+ where loop !i !cnt
1075+ | i >= len || cnt >= n = i
1076+ | otherwise = loop (i+d) (cnt+1)
1077+ where d = iter_ t i
1078+
10131079{-# RULES
10141080"TEXT take -> fused" [~1] forall n t.
10151081 take n t = unstream (S.take n (stream t))
@@ -1017,6 +1083,27 @@ take n t@(Text arr off len)
10171083 unstream (S.take n (stream t)) = take n t
10181084 #-}
10191085
1086+-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after
1087+-- taking @n@ characters from the end of @t@.
1088+--
1089+-- Examples:
1090+--
1091+-- > takeEnd 3 "foobar" == "bar"
1092+takeEnd :: Int -> Text -> Text
1093+takeEnd n t@(Text arr off len)
1094+ | n <= 0 = empty
1095+ | n >= len = t
1096+ | otherwise = text arr (off+i) (len-i)
1097+ where i = iterNEnd n t
1098+
1099+iterNEnd :: Int -> Text -> Int
1100+iterNEnd n t@(Text _arr _off len) = loop (len-1) n
1101+ where loop i !m
1102+ | i <= 0 = 0
1103+ | m <= 1 = i
1104+ | otherwise = loop (i+d) (m-1)
1105+ where d = reverseIter_ t i
1106+
10201107-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
10211108-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
10221109-- is greater than the length of the 'Text'. Subject to fusion.
@@ -1024,11 +1111,8 @@ drop :: Int -> Text -> Text
10241111drop n t@(Text arr off len)
10251112 | n <= 0 = t
10261113 | n >= len = empty
1027− | otherwise = loop 0 0
1028− where loop !i !cnt
1029− | i >= len || cnt >= n = Text arr (off+i) (len-i)
1030− | otherwise = loop (i+d) (cnt+1)
1031− where d = iter_ t i
1114+ | otherwise = text arr (off+i) (len-i)
1115+ where i = iterN n t
10321116{-# INLINE [1] drop #-}
10331117
10341118{-# RULES
@@ -1038,6 +1122,18 @@ drop n t@(Text arr off len)
10381122 unstream (S.drop n (stream t)) = drop n t
10391123 #-}
10401124
1125+-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after
1126+-- dropping @n@ characters from the end of @t@.
1127+--
1128+-- Examples:
1129+--
1130+-- > dropEnd 3 "foobar" == "foo"
1131+dropEnd :: Int -> Text -> Text
1132+dropEnd n t@(Text arr off len)
1133+ | n <= 0 = t
1134+ | n >= len = empty
1135+ | otherwise = text arr off (iterNEnd n t)
1136+
10411137-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
10421138-- returns the longest prefix (possibly empty) of elements that
10431139-- satisfy @p@. Subject to fusion.
@@ -1045,7 +1141,7 @@ takeWhile :: (Char -> Bool) -> Text -> Text
10451141takeWhile p t@(Text arr off len) = loop 0
10461142 where loop !i | i >= len = t
10471143 | p c = loop (i+d)
1048− | otherwise = textP arr off i
1144+ | otherwise = text arr off i
10491145 where Iter c d = iter t i
10501146{-# INLINE [1] takeWhile #-}
10511147
@@ -1056,6 +1152,27 @@ takeWhile p t@(Text arr off len) = loop 0
10561152 unstream (S.takeWhile p (stream t)) = takeWhile p t
10571153 #-}
10581154
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+
10591176-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
10601177-- 'takeWhile' @p@ @t@. Subject to fusion.
10611178dropWhile :: (Char -> Bool) -> Text -> Text
@@ -1074,8 +1191,9 @@ dropWhile p t@(Text arr off len) = loop 0 0
10741191 #-}
10751192
10761193-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1077−-- dropping characters that fail the predicate @p@ from the end of
1194+-- dropping characters that satisfy the predicate @p@ from the end of
10781195-- @t@. Subject to fusion.
1196+--
10791197-- Examples:
10801198--
10811199-- > dropWhileEnd (=='.') "foo..." == "foo"
@@ -1095,7 +1213,7 @@ dropWhileEnd p t@(Text arr off len) = loop (len-1) len
10951213 #-}
10961214
10971215-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1098−-- dropping characters that fail the predicate @p@ from both the
1216+-- dropping characters that satisfy the predicate @p@ from both the
10991217-- beginning and end of @t@. Subject to fusion.
11001218dropAround :: (Char -> Bool) -> Text -> Text
11011219dropAround p = dropWhile p . dropWhileEnd p
@@ -1130,13 +1248,8 @@ splitAt :: Int -> Text -> (Text, Text)
11301248splitAt n t@(Text arr off len)
11311249 | n <= 0 = (empty, t)
11321250 | n >= len = (t, empty)
1133− | otherwise = (Text arr off k, Text arr (off+k) (len-k))
1134− where k = loop 0 0
1135− loop !i !cnt
1136− | i >= len || cnt >= n = i
1137− | otherwise = loop (i+d) (cnt+1)
1138− where d = iter_ t i
1139−{-# INLINE splitAt #-}
1251+ | otherwise = let k = iterN n t
1252+ in (text arr off k, text arr (off+k) (len-k))
11401253
11411254-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
11421255-- a pair whose first element is the longest prefix (possibly empty)
@@ -1195,9 +1308,9 @@ tails t | null t = [empty]
11951308-- copies to create substrings; they just construct new 'Text's that
11961309-- are slices of the original.
11971310
1198−-- | /O(m+n)/ Break a 'Text' into pieces separated by the first
1199−-- 'Text' argument, consuming the delimiter. An empty delimiter is
1200−-- 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.
12011314--
12021315-- Examples:
12031316--
@@ -1210,16 +1323,23 @@ tails t | null t = [empty]
12101323-- > intercalate s . splitOn s == id
12111324-- > splitOn (singleton c) == split (==c)
12121325--
1326+-- (Note: the string @s@ to split on above cannot be empty.)
1327+--
12131328-- In (unlikely) bad cases, this function's time complexity degrades
12141329-- towards /O(n*m)/.
1215−splitOn :: Text -> Text -> [Text]
1330+splitOn :: Text
1331+ -- ^ String to split on. If this string is empty, an error
1332+ -- will occur.
1333+ -> Text
1334+ -- ^ Input text.
1335+ -> [Text]
12161336splitOn pat@(Text _ _ l) src@(Text arr off len)
12171337 | l <= 0 = emptyError "splitOn"
12181338 | isSingleton pat = split (== unsafeHead pat) src
12191339 | otherwise = go 0 (indices pat src)
12201340 where
1221− go !s (x:xs) = textP arr (s+off) (x-s) : go (x+l) xs
1222− go s _ = [textP arr (s+off) (len-s)]
1341+ go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs
1342+ go s _ = [text arr (s+off) (len-s)]
12231343{-# INLINE [1] splitOn #-}
12241344
12251345{-# RULES
@@ -1311,7 +1431,7 @@ breakOn pat src@(Text arr off len)
13111431 | null pat = emptyError "breakOn"
13121432 | otherwise = case indices pat src of
13131433 [] -> (src, empty)
1314− (x:_) -> (textP arr off x, textP arr (off+x) (len-x))
1434+ (x:_) -> (text arr off x, text arr (off+x) (len-x))
13151435{-# INLINE breakOn #-}
13161436
13171437-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
@@ -1353,7 +1473,7 @@ breakOnAll pat src@(Text arr off slen)
13531473 | otherwise = L.map step (indices pat src)
13541474 where
13551475 step x = (chunk 0 x, chunk x (slen-x))
1356− chunk !n !l = textP arr (n+off) l
1476+ chunk !n !l = text arr (n+off) l
13571477{-# INLINE breakOnAll #-}
13581478
13591479-------------------------------------------------------------------------------
@@ -1420,7 +1540,7 @@ countChar c t = S.countChar c (stream t)
14201540-- equivalent to a pair of 'unpack' operations.
14211541zip :: Text -> Text -> [(Char,Char)]
14221542zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1423−{-# INLINE [0] zip #-}
1543+{-# INLINE zip #-}
14241544
14251545-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
14261546-- given as the first argument, instead of a tupling function.
@@ -1428,7 +1548,7 @@ zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
14281548zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
14291549zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
14301550 where g a b = safe (f a b)
1431−{-# INLINE [0] zipWith #-}
1551+{-# INLINE zipWith #-}
14321552
14331553-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
14341554-- representing white space.
@@ -1553,7 +1673,7 @@ isInfixOf needle haystack
15531673-- > fnordLength _ = -1
15541674stripPrefix :: Text -> Text -> Maybe Text
15551675stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1556− | p `isPrefixOf` t = Just $! textP arr (off+plen) (len-plen)
1676+ | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)
15571677 | otherwise = Nothing
15581678
15591679-- | /O(n)/ Find the longest non-empty common prefix of two strings
@@ -1573,8 +1693,8 @@ commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
15731693 where
15741694 go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
15751695 | i > 0 = Just (Text arr0 off0 i,
1576− textP arr0 (off0+i) (len0-i),
1577− textP arr1 (off1+j) (len1-j))
1696+ text arr0 (off0+i) (len0-i),
1697+ text arr1 (off1+j) (len1-j))
15781698 | otherwise = Nothing
15791699 where Iter a d0 = iter t0 i
15801700 Iter b d1 = iter t1 j
@@ -1599,7 +1719,7 @@ commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
15991719-- > quuxLength _ = -1
16001720stripSuffix :: Text -> Text -> Maybe Text
16011721stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
1602− | p `isSuffixOf` t = Just $! textP arr off (len-plen)
1722+ | p `isSuffixOf` t = Just $! text arr off (len-plen)
16031723 | otherwise = Nothing
16041724
16051725-- | Add a list of non-negative numbers. Errors out on overflow.
@@ -1628,6 +1748,7 @@ overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
16281748copy :: Text -> Text
16291749copy (Text arr off len) = Text (A.run go) 0 len
16301750 where
1751+ go :: ST s (A.MArray s)
16311752 go = do
16321753 marr <- A.new len
16331754 A.copyI marr 0 arr off len
Data/Text/Array.hs+7−6
@@ -20,13 +20,13 @@
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 (
2727 -- * Types
28− Array(aBA)
29− , MArray(maBA)
28+ Array(Array, aBA)
29+ , MArray(MArray, maBA)
3030
3131 -- * Functions
3232 , copyM
@@ -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+13−26
@@ -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)
89−import Data.Text.Internal (Text(..), safe, textP)
75+import 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" #-}
@@ -130,7 +120,7 @@ decodeASCII = decodeUtf8
130120-- 'decodeLatin1' is semantically equivalent to
131121-- @Data.Text.pack . Data.ByteString.Char8.unpack@
132122decodeLatin1 :: ByteString -> Text
133−decodeLatin1 (PS fp off len) = textP a 0 len
123+decodeLatin1 (PS fp off len) = text a 0 len
134124 where
135125 a = A.run (A.new len >>= unsafeIOToST . go)
136126 go dest = withForeignPtr fp $ \ptr -> do
@@ -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
@@ -285,10 +275,10 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
285275 codepoint <- peek codepointPtr
286276 chunkText <- unsafeSTToIO $ do
287277 arr <- A.unsafeFreeze dest
288− return $! textP arr 0 (fromIntegral n)
278+ 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+74−10
@@ -1,4 +1,4 @@
1−{-# LANGUAGE CPP, DeriveDataTypeable #-}
1+{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples #-}
22{-# OPTIONS_HADDOCK not-home #-}
33
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
@@ -54,8 +64,8 @@ data Text = Text
5464 deriving (Typeable)
5565
5666-- | Smart constructor.
57−text :: A.Array -> Int -> Int -> Text
58−text arr off len =
67+text_ :: A.Array -> Int -> Int -> Text
68+text_ arr off len =
5969#if defined(ASSERTS)
6070 let c = A.unsafeIndex arr off
6171 alen = A.length arr
@@ -65,19 +75,28 @@ text arr off len =
6575 assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $
6676#endif
6777 Text arr off len
68−{-# INLINE text #-}
78+{-# INLINE text_ #-}
6979
7080-- | /O(1)/ The empty 'Text'.
7181empty :: 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.
92+text :: A.Array -> Int -> Int -> Text
93+text arr off len | len == 0 = empty
94+ | otherwise = text_ arr off len
95+{-# INLINE text #-}
96+
7797textP :: A.Array -> Int -> Int -> Text
78−textP arr off len | len == 0 = empty
79− | otherwise = text arr off len
80−{-# INLINE textP #-}
98+{-# DEPRECATED textP "Use text instead" #-}
99+textP = text
81100
82101-- | A useful 'show'-like function for debugging purposes.
83102showText :: Text -> String
@@ -97,13 +116,58 @@ safe :: Char -> Char
97116safe c
98117 | ord c .&. 0x1ff800 /= 0xd800 = c
99118 | otherwise = '\xfffd'
100−{-# INLINE safe #-}
119+{-# INLINE [0] safe #-}
101120
102121-- | Apply a function to the first element of an optional pair.
103122firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)
104123firstf f (Just (a, b)) = Just (f a, b)
105124firstf _ Nothing = Nothing
106125
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+
107171-- $internals
108172--
109173-- 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
77-- Copyright : (c) 2013 Bryan O'Sullivan
88-- (c) 2010 Johan Tibell
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 @@
22
33-- Module: Data.Text.Internal.Builder.Int.Digits
44-- Copyright: (c) 2013 Bryan O'Sullivan
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 #-}
2+
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+38−28
@@ -68,7 +68,7 @@ default(Int)
6868
6969-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
7070stream :: Text -> Stream Char
71−stream (Text arr off len) = Stream next off (maxSize len)
71+stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)
7272 where
7373 !end = off+len
7474 next !i
@@ -83,7 +83,7 @@ stream (Text arr off len) = Stream next off (maxSize len)
8383-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate
8484-- backwards.
8585reverseStream :: Text -> Stream Char
86−reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)
86+reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `shiftR` 1) len)
8787 where
8888 {-# INLINE next #-}
8989 next !i
@@ -98,25 +98,35 @@ reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)
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
@@ -132,7 +142,7 @@ length = S.lengthI
132142reverse :: Stream Char -> Text
133143reverse (Stream next s len0)
134144 | isEmpty len0 = I.empty
135− | otherwise = I.textP arr off' len'
145+ | otherwise = I.text arr off' len'
136146 where
137147 len0' = upperBound 4 (larger len0 4)
138148 (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')
@@ -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
@@ -210,7 +220,7 @@ countChar = S.countCharI
210220-- function to each element of a 'Text', passing an accumulating
211221-- parameter from left to right, and returns a final 'Text'.
212222mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)
213−mapAccumL f z0 (Stream next0 s0 len) = (nz,I.textP na 0 nl)
223+mapAccumL f z0 (Stream next0 s0 len) = (nz, I.text na 0 nl)
214224 where
215225 (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)
216226 where mlen = upperBound 4 len
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]
88
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+63−75
@@ -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)
@@ -315,12 +315,13 @@ lengthI (Stream next s0 _len) = loop_length 0 s0
315315--
316316-- This function gives the same answer as comparing against the result
317317-- of 'lengthI', but can short circuit if the count of characters is
318−-- greater than the number, and hence be more efficient.
318+-- greater than the number or if the stream can't possibly be as long
319+-- as the number supplied, and hence be more efficient.
319320compareLengthI :: Integral a => Stream Char -> a -> Ordering
320321compareLengthI (Stream next s0 len) n =
321− case exactly len of
322+ case compareSize len (fromIntegral n) of
323+ Just o -> o
322324 Nothing -> loop_cmp 0 s0
323− Just i -> compare (fromIntegral i) n
324325 where
325326 loop_cmp !z s = case next s of
326327 Done -> compare z n
@@ -472,17 +473,20 @@ toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len
472473 next (CC s a b) = Yield a (CC s b '\0')
473474{-# INLINE [0] toTitle #-}
474475
476+data Justify i s = Just1 !i !s
477+ | Just2 !i !s
478+
475479justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
476480justifyLeftI k c (Stream next0 s0 len) =
477− Stream next (s0 :*: S1 :*: 0) (larger (fromIntegral k) len)
481+ Stream next (Just1 0 s0) (larger (fromIntegral k) len)
478482 where
479− next (s :*: S1 :*: n) =
483+ next (Just1 n s) =
480484 case next0 s of
481− Done -> next (s :*: S2 :*: n)
482− Skip s' -> Skip (s' :*: S1 :*: n)
483− Yield x s' -> Yield x (s' :*: S1 :*: n+1)
484− next (s :*: S2 :*: n)
485− | 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)
486490 | otherwise = Done
487491 {-# INLINE next #-}
488492{-# INLINE [0] justifyLeftI #-}
@@ -589,7 +593,7 @@ concatMap f = foldr (append . f) empty
589593{-# INLINE [0] concatMap #-}
590594
591595-- | /O(n)/ any @p @xs determines if any character in the stream
592−-- @xs@ satisifes the predicate @p@.
596+-- @xs@ satisfies the predicate @p@.
593597any :: (Char -> Bool) -> Stream Char -> Bool
594598any p (Stream next0 s0 _len) = loop_any s0
595599 where
@@ -601,7 +605,7 @@ any p (Stream next0 s0 _len) = loop_any s0
601605{-# INLINE [0] any #-}
602606
603607-- | /O(n)/ all @p @xs determines if all characters in the 'Text'
604−-- @xs@ satisify the predicate @p@.
608+-- @xs@ satisfy the predicate @p@.
605609all :: (Char -> Bool) -> Stream Char -> Bool
606610all p (Stream next0 s0 _len) = loop_all s0
607611 where
@@ -650,50 +654,27 @@ minimum (Stream next0 s0 _len) = loop0_minimum s0
650654-- * Building streams
651655
652656scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
653−scanl f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low
657+scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
654658 where
655659 {-# INLINE next #-}
656− next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)
657− next (S2 :*: z :*: s) = case next0 s of
658− Yield x s' -> let !x' = f z x
659− in Yield x' (S2 :*: x' :*: s')
660− Skip s' -> Skip (S2 :*: z :*: s')
661− 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
662666{-# INLINE [0] scanl #-}
663667
664−-- -----------------------------------------------------------------------------
665−-- ** Accumulating maps
666−
667−{-
668−-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a
669−-- function to each element of a stream, passing an accumulating
670−-- parameter from left to right, and returns a final stream.
671−--
672−-- /Note/: Unlike the version over lists, this function does not
673−-- return a final value for the accumulator, because the nature of
674−-- streams precludes it.
675−mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b
676−mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :*: z0) len -- HINT depends on f
677− where
678− {-# INLINE next #-}
679− next (s :*: z) = case next0 s of
680− Yield x s' -> let (z',y) = f z x
681− in Yield y (s' :*: z')
682− Skip s' -> Skip (s' :*: z)
683− Done -> Done
684−{-# INLINE [0] mapAccumL #-}
685−-}
686−
687668-- -----------------------------------------------------------------------------
688669-- ** Generating and unfolding streams
689670
690671replicateCharI :: Integral a => a -> Char -> Stream Char
691−replicateCharI n c
672+replicateCharI !n !c
692673 | n < 0 = empty
693674 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
694675 where
695− next i | i >= n = Done
696− | otherwise = Yield c (i + 1)
676+ next !i | i >= n = Done
677+ | otherwise = Yield c (i + 1)
697678{-# INLINE [0] replicateCharI #-}
698679
699680data RI s = RI !s {-# UNPACK #-} !Int64
@@ -758,24 +739,27 @@ take n0 (Stream next0 s0 len) =
758739 Yield x s' -> Yield x ((n-1) :*: s')
759740{-# INLINE [0] take #-}
760741
742+data Drop a s = NS !s
743+ | JS !a !s
744+
761745-- | /O(n)/ drop n, applied to a stream, returns the suffix of the
762746-- stream after the first @n@ characters, or the empty stream if @n@
763747-- is greater than the length of the stream.
764748drop :: Integral a => a -> Stream Char -> Stream Char
765749drop n0 (Stream next0 s0 len) =
766− Stream next (J n0 :*: s0) (len - fromIntegral (max 0 n0))
750+ Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))
767751 where
768752 {-# INLINE next #-}
769− next (J n :*: s)
770− | n <= 0 = Skip (N :*: s)
753+ next (JS n s)
754+ | n <= 0 = Skip (NS s)
771755 | otherwise = case next0 s of
772756 Done -> Done
773− Skip s' -> Skip (J n :*: s')
774− Yield _ s' -> Skip (J (n-1) :*: s')
775− 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
776760 Done -> Done
777− Skip s' -> Skip (N :*: s')
778− Yield x s' -> Yield x (N :*: s')
761+ Skip s' -> Skip (NS s')
762+ Yield x s' -> Yield x (NS s')
779763{-# INLINE [0] drop #-}
780764
781765-- | takeWhile, applied to a predicate @p@ and a stream, returns the
@@ -793,18 +777,18 @@ takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
793777
794778-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
795779dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
796−dropWhile p (Stream next0 s0 len) = Stream next (S1 :*: s0) len -- HINT maybe too high
780+dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
797781 where
798782 {-# INLINE next #-}
799− next (S1 :*: s) = case next0 s of
783+ next (L s) = case next0 s of
800784 Done -> Done
801− Skip s' -> Skip (S1 :*: s')
802− Yield x s' | p x -> Skip (S1 :*: s')
803− | otherwise -> Yield x (S2 :*: s')
804− 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
805789 Done -> Done
806− Skip s' -> Skip (S2 :*: s')
807− Yield x s' -> Yield x (S2 :*: s')
790+ Skip s' -> Skip (R s')
791+ Yield x s' -> Yield x (R s')
808792{-# INLINE [0] dropWhile #-}
809793
810794-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
@@ -911,21 +895,25 @@ findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0
911895-------------------------------------------------------------------------------
912896-- * Zipping
913897
898+-- | Strict triple.
899+data Zip a b m = Z1 !a !b
900+ | Z2 !a !b !m
901+
914902-- | zipWith generalises 'zip' by zipping with the function given as
915903-- the first argument, instead of a tupling function.
916904zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
917905zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
918− Stream next (sa0 :*: sb0 :*: N) (smaller len1 len2)
906+ Stream next (Z1 sa0 sb0) (smaller len1 len2)
919907 where
920− next (sa :*: sb :*: N) = case next0 sa of
921− Done -> Done
922− Skip sa' -> Skip (sa' :*: sb :*: N)
923− Yield a sa' -> Skip (sa' :*: sb :*: J a)
924−
925− next (sa' :*: sb :*: J a) = case next1 sb of
926− Done -> Done
927− Skip sb' -> Skip (sa' :*: sb' :*: J a)
928− 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')
929917{-# INLINE [0] zipWith #-}
930918
931919-- | /O(n)/ The 'countCharI' function returns the number of times the
Data/Text/Internal/Fusion/Size.hs+60−52
@@ -22,25 +22,28 @@ module Data.Text.Internal.Fusion.Size
2222 , exactly
2323 , exactSize
2424 , maxSize
25+ , betweenSize
2526 , unknownSize
2627 , smaller
2728 , larger
2829 , upperBound
30+ , lowerBound
31+ , compareSize
2932 , isEmpty
3033 ) where
3134
35+import Data.Text.Internal (mul)
3236#if defined(ASSERTS)
3337import Control.Exception (assert)
3438#endif
3539
36−data Size = Exact {-# UNPACK #-} !Int -- ^ Exact size.
37− | Max {-# UNPACK #-} !Int -- ^ Upper bound on size.
38− | Unknown -- ^ Unknown size.
40+data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.
41+ | Unknown -- ^ Unknown size.
3942 deriving (Eq, Show)
4043
4144exactly :: Size -> Maybe Int
42−exactly (Exact n) = Just n
43−exactly _ = Nothing
45+exactly (Between na nb) | na == nb = Just na
46+exactly _ = Nothing
4447{-# INLINE exactly #-}
4548
4649exactSize :: Int -> Size
@@ -48,7 +51,7 @@ exactSize n =
4851#if defined(ASSERTS)
4952 assert (n >= 0)
5053#endif
51− Exact n
54+ Between n n
5255{-# INLINE exactSize #-}
5356
5457maxSize :: Int -> Size
@@ -56,9 +59,18 @@ maxSize n =
5659#if defined(ASSERTS)
5760 assert (n >= 0)
5861#endif
59− Max n
62+ Between 0 n
6063{-# INLINE maxSize #-}
6164
65+betweenSize :: Int -> Int -> Size
66+betweenSize m n =
67+#if defined(ASSERTS)
68+ assert (m >= 0)
69+ assert (n >= m)
70+#endif
71+ Between m n
72+{-# INLINE betweenSize #-}
73+
6274unknownSize :: Size
6375unknownSize = Unknown
6476{-# INLINE unknownSize #-}
@@ -68,7 +80,7 @@ instance Num Size where
6880 (-) = subtractSize
6981 (*) = mulSize
7082
71− fromInteger = f where f = Exact . fromInteger
83+ fromInteger = f where f = exactSize . fromInteger
7284 {-# INLINE f #-}
7385
7486add :: Int -> Int -> Int
@@ -78,71 +90,67 @@ add m n | mn >= 0 = mn
7890{-# INLINE add #-}
7991
8092addSize :: Size -> Size -> Size
81−addSize (Exact m) (Exact n) = Exact (add m n)
82−addSize (Exact m) (Max n) = Max (add m n)
83−addSize (Max m) (Exact n) = Max (add m n)
84−addSize (Max m) (Max n) = Max (add m n)
85−addSize _ _ = Unknown
93+addSize (Between ma mb) (Between na nb) = Between (add ma na) (add mb nb)
94+addSize _ _ = Unknown
8695{-# INLINE addSize #-}
8796
8897subtractSize :: Size -> Size -> Size
89−subtractSize (Exact m) (Exact n) = Exact (max (m-n) 0)
90−subtractSize (Exact m) (Max _) = Max m
91−subtractSize (Max m) (Exact n) = Max (max (m-n) 0)
92−subtractSize a@(Max _) (Max _) = a
93−subtractSize a@(Max _) Unknown = a
94−subtractSize _ _ = Unknown
98+subtractSize (Between ma mb) (Between na nb) = Between (max (ma-nb) 0) (max (mb-na) 0)
99+subtractSize a@(Between 0 _) Unknown = a
100+subtractSize (Between _ mb) Unknown = Between 0 mb
101+subtractSize _ _ = Unknown
95102{-# INLINE subtractSize #-}
96103
97−mul :: Int -> Int -> Int
98−mul m n
99− | m <= maxBound `quot` n = m * n
100− | otherwise = overflowError
101−{-# INLINE mul #-}
102−
103104mulSize :: Size -> Size -> Size
104−mulSize (Exact m) (Exact n) = Exact (mul m n)
105−mulSize (Exact m) (Max n) = Max (mul m n)
106−mulSize (Max m) (Exact n) = Max (mul m n)
107−mulSize (Max m) (Max n) = Max (mul m n)
108−mulSize _ _ = Unknown
105+mulSize (Between ma mb) (Between na nb) = Between (mul ma na) (mul mb nb)
106+mulSize _ _ = Unknown
109107{-# INLINE mulSize #-}
110108
111109-- | Minimum of two size hints.
112110smaller :: Size -> Size -> Size
113−smaller (Exact m) (Exact n) = Exact (m `min` n)
114−smaller (Exact m) (Max n) = Max (m `min` n)
115−smaller (Exact m) Unknown = Max m
116−smaller (Max m) (Exact n) = Max (m `min` n)
117−smaller (Max m) (Max n) = Max (m `min` n)
118−smaller a@(Max _) Unknown = a
119−smaller Unknown (Exact n) = Max n
120−smaller Unknown (Max n) = Max n
121−smaller Unknown Unknown = Unknown
111+smaller a@(Between ma mb) b@(Between na nb)
112+ | mb <= na = a
113+ | nb <= ma = b
114+ | otherwise = Between (ma `min` na) (mb `min` nb)
115+smaller a@(Between 0 _) Unknown = a
116+smaller (Between _ mb) Unknown = Between 0 mb
117+smaller Unknown b@(Between 0 _) = b
118+smaller Unknown (Between _ nb) = Between 0 nb
119+smaller Unknown Unknown = Unknown
122120{-# INLINE smaller #-}
123121
124122-- | Maximum of two size hints.
125123larger :: Size -> Size -> Size
126−larger (Exact m) (Exact n) = Exact (m `max` n)
127−larger a@(Exact m) b@(Max n) | m >= n = a
128− | otherwise = b
129−larger a@(Max m) b@(Exact n) | n >= m = b
130− | otherwise = a
131−larger (Max m) (Max n) = Max (m `max` n)
132−larger _ _ = Unknown
124+larger a@(Between ma mb) b@(Between na nb)
125+ | ma >= nb = a
126+ | na >= mb = b
127+ | otherwise = Between (ma `max` na) (mb `max` nb)
128+larger _ _ = Unknown
133129{-# INLINE larger #-}
134130
135131-- | Compute the maximum size from a size hint, if possible.
136132upperBound :: Int -> Size -> Int
137−upperBound _ (Exact n) = n
138−upperBound _ (Max n) = n
139−upperBound k _ = k
133+upperBound _ (Between _ n) = n
134+upperBound k _ = k
140135{-# INLINE upperBound #-}
141136
137+-- | Compute the maximum size from a size hint, if possible.
138+lowerBound :: Int -> Size -> Int
139+lowerBound _ (Between n _) = n
140+lowerBound k _ = k
141+{-# INLINE lowerBound #-}
142+
143+compareSize :: Size -> Int -> Maybe Ordering
144+compareSize (Between ma mb) n
145+ | mb < n = Just LT
146+ | ma > n = Just GT
147+ | ma == n && mb == n = Just EQ
148+compareSize _ _ = Nothing
149+
150+
142151isEmpty :: Size -> Bool
143−isEmpty (Exact n) = n <= 0
144−isEmpty (Max n) = n <= 0
145−isEmpty _ = False
152+isEmpty (Between _ n) = n <= 0
153+isEmpty _ = False
146154{-# INLINE isEmpty #-}
147155
148156overflowError :: Int
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/Private.hs+4−4
@@ -16,14 +16,14 @@ module Data.Text.Internal.Private
1616 ) where
1717
1818import Control.Monad.ST (ST, runST)
19−import Data.Text.Internal (Text(..), textP)
19+import Data.Text.Internal (Text(..), text)
2020import Data.Text.Unsafe (Iter(..), iter)
2121import qualified Data.Text.Array as A
2222
2323span_ :: (Char -> Bool) -> Text -> (# Text, Text #)
2424span_ p t@(Text arr off len) = (# hd,tl #)
25− where hd = textP arr off k
26− tl = textP arr (off+k) (len-k)
25+ where hd = text arr off k
26+ tl = text arr (off+k) (len-k)
2727 !k = loop 0
2828 loop !i | i < len && p c = loop (i+d)
2929 | otherwise = i
@@ -33,5 +33,5 @@ span_ p t@(Text arr off len) = (# hd,tl #)
3333runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text
3434runText act = runST (act $ \ !marr !len -> do
3535 arr <- A.unsafeFreeze marr
36− return $! textP arr 0 len)
36+ return $! text arr 0 len)
3737{-# INLINE runText #-}
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+200−25
@@ -3,6 +3,10 @@
33#if __GLASGOW_HASKELL__ >= 702
44{-# LANGUAGE Trustworthy #-}
55#endif
6+#if __GLASGOW_HASKELL__ >= 708
7+{-# LANGUAGE TypeFamilies #-}
8+#endif
9+
610-- |
711-- Module : Data.Text.Lazy
812-- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan
@@ -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
@@ -129,8 +136,11 @@ module Data.Text.Lazy
129136
130137 -- ** Breaking strings
131138 , take
139+ , takeEnd
132140 , drop
141+ , dropEnd
133142 , takeWhile
143+ , takeWhileEnd
134144 , dropWhile
135145 , dropWhileEnd
136146 , dropAround
@@ -201,9 +211,13 @@ import Control.DeepSeq (NFData(..))
201211import Data.Int (Int64)
202212import qualified Data.List as L
203213import Data.Char (isSpace)
204−import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))
205−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))
206217import Data.Monoid (Monoid(..))
218+#if MIN_VERSION_base(4,9,0)
219+import Data.Semigroup (Semigroup(..))
220+#endif
207221import Data.String (IsString(..))
208222import qualified Data.Text as T
209223import qualified Data.Text.Internal as T
@@ -212,8 +226,10 @@ import qualified Data.Text.Unsafe as T
212226import qualified Data.Text.Internal.Lazy.Fusion as S
213227import Data.Text.Internal.Fusion.Types (PairS(..))
214228import Data.Text.Internal.Lazy.Fusion (stream, unstream)
215−import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks, foldrChunks)
216−import Data.Text.Internal (firstf, safe, textP)
229+import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks,
230+ foldrChunks, smallChunkSize)
231+import Data.Text.Internal (firstf, safe, text)
232+import Data.Text.Lazy.Encoding (decodeUtf8', encodeUtf8)
217233import qualified Data.Text.Internal.Functions as F
218234import Data.Text.Internal.Lazy.Search (indices)
219235#if __GLASGOW_HASKELL__ >= 702
@@ -221,7 +237,13 @@ import qualified GHC.CString as GHC
221237#else
222238import qualified GHC.Base as GHC
223239#endif
240+#if __GLASGOW_HASKELL__ >= 708
241+import qualified GHC.Exts as Exts
242+#endif
224243import GHC.Prim (Addr#)
244+#if MIN_VERSION_base(4,7,0)
245+import Text.Printf (PrintfArg, formatArg, formatString)
246+#endif
225247
226248-- $fusion
227249--
@@ -319,25 +341,71 @@ instance Show Text where
319341instance Read Text where
320342 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
321343
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+
322352instance Monoid Text where
323353 mempty = empty
354+#if MIN_VERSION_base(4,9,0)
355+ mappend = (<>) -- future-proof definition
356+#else
324357 mappend = append
358+#endif
325359 mconcat = concat
326360
327361instance IsString Text where
328362 fromString = pack
329363
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+
330371#if defined(HAVE_DEEPSEQ)
331372instance NFData Text where
332373 rnf Empty = ()
333374 rnf (Chunk _ ts) = rnf ts
334375#endif
335376
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'
336390instance Data Text where
337391 gfoldl f z txt = z pack `f` (unpack txt)
338− toConstr _ = error "Data.Text.Lazy.Text.toConstr"
339− gunfold _ _ = error "Data.Text.Lazy.Text.gunfold"
340− 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]
341409
342410-- | /O(n)/ Convert a 'String' into a 'Text'.
343411--
@@ -365,6 +433,14 @@ unpackCString# addr# = unstream (S.streamCString# addr#)
365433 unstream (S.streamList (L.map safe (GHC.unpackCStringUtf8# a)))
366434 = unpackCString# a #-}
367435
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+
368444-- | /O(1)/ Convert a character into a Text. Subject to fusion.
369445-- Performs replacement on invalid scalar values.
370446singleton :: Char -> Text
@@ -469,7 +545,7 @@ tail Empty = emptyError "tail"
469545 unstream (S.tail (stream t)) = tail t
470546 #-}
471547
472−-- | /O(1)/ Returns all but the last character of a 'Text', which must
548+-- | /O(n\/c)/ Returns all but the last character of a 'Text', which must
473549-- be non-empty. Subject to fusion.
474550init :: Text -> Text
475551init (Chunk t0 ts0) = go t0 ts0
@@ -505,7 +581,7 @@ isSingleton :: Text -> Bool
505581isSingleton = S.isSingleton . stream
506582{-# INLINE isSingleton #-}
507583
508−-- | /O(1)/ Returns the last character of a 'Text', which must be
584+-- | /O(n\/c)/ Returns the last character of a 'Text', which must be
509585-- non-empty. Subject to fusion.
510586last :: Text -> Char
511587last Empty = emptyError "last"
@@ -639,13 +715,36 @@ reverse = rev Empty
639715 where rev a Empty = a
640716 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts
641717
642−-- | /O(m+n)/ Replace every occurrence of one substring with another.
718+-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
719+-- @haystack@ with @replacement@.
720+--
721+-- This function behaves as though it was defined as follows:
722+--
723+-- @
724+-- replace needle replacement haystack =
725+-- 'intercalate' replacement ('splitOn' needle haystack)
726+-- @
727+--
728+-- As this suggests, each occurrence is replaced exactly once. So if
729+-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
730+-- be replaced recursively:
731+--
732+-- > replace "oo" "foo" "oo" == "foo"
733+--
734+-- In cases where several instances of @needle@ overlap, only the
735+-- first one will be replaced:
736+--
737+-- > replace "ofo" "bar" "ofofo" == "barfo"
643738--
644739-- In (unlikely) bad cases, this function's time complexity degrades
645740-- towards /O(n*m)/.
646−replace :: Text -- ^ Text to search for
647− -> Text -- ^ Replacement text
648− -> 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.
649748 -> Text
650749replace s d = intercalate d . splitOn s
651750{-# INLINE replace #-}
@@ -782,13 +881,13 @@ concatMap f = concat . foldr ((:) . f) []
782881{-# INLINE concatMap #-}
783882
784883-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
785−-- 'Text' @t@ satisifes the predicate @p@. Subject to fusion.
884+-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
786885any :: (Char -> Bool) -> Text -> Bool
787886any p t = S.any p (stream t)
788887{-# INLINE any #-}
789888
790889-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
791−-- 'Text' @t@ satisify the predicate @p@. Subject to fusion.
890+-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
792891all :: (Char -> Bool) -> Text -> Bool
793892all p t = S.all p (stream t)
794893{-# INLINE all #-}
@@ -871,6 +970,12 @@ mapAccumR f = go
871970 go z Empty = (z, Empty)
872971{-# INLINE mapAccumR #-}
873972
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+
874979-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
875980-- @t@ repeated @n@ times.
876981replicate :: Int64 -> Text -> Text
@@ -882,6 +987,21 @@ replicate n t
882987 | otherwise = t : rep (i+1)
883988{-# INLINE [1] replicate #-}
884989
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+
8851005-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
8861006-- value of every element. Subject to fusion.
8871007replicateChar :: Int64 -> Char -> Text
@@ -935,6 +1055,22 @@ take i t0 = take' i t0
9351055 unstream (S.take n (stream t)) = take n t
9361056 #-}
9371057
1058+-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after
1059+-- taking @n@ characters from the end of @t@.
1060+--
1061+-- Examples:
1062+--
1063+-- > takeEnd 3 "foobar" == "bar"
1064+takeEnd :: Int64 -> Text -> Text
1065+takeEnd n t0
1066+ | n <= 0 = empty
1067+ | otherwise = takeChunk n empty . L.reverse . toChunks $ t0
1068+ where takeChunk _ acc [] = acc
1069+ takeChunk i acc (t:ts)
1070+ | i <= l = chunk (T.takeEnd (fromIntegral i) t) acc
1071+ | otherwise = takeChunk (i-l) (Chunk t acc) ts
1072+ where l = fromIntegral (T.length t)
1073+
9381074-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
9391075-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
9401076-- is greater than the length of the 'Text'. Subject to fusion.
@@ -957,6 +1093,23 @@ drop i t0
9571093 unstream (S.drop n (stream t)) = drop n t
9581094 #-}
9591095
1096+-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after
1097+-- dropping @n@ characters from the end of @t@.
1098+--
1099+-- Examples:
1100+--
1101+-- > dropEnd 3 "foobar" == "foo"
1102+dropEnd :: Int64 -> Text -> Text
1103+dropEnd n t0
1104+ | n <= 0 = t0
1105+ | otherwise = dropChunk n . L.reverse . toChunks $ t0
1106+ where dropChunk _ [] = empty
1107+ dropChunk m (t:ts)
1108+ | m >= l = dropChunk (m-l) ts
1109+ | otherwise = fromChunks . L.reverse $
1110+ T.dropEnd (fromIntegral m) t : ts
1111+ where l = fromIntegral (T.length t)
1112+
9601113-- | /O(n)/ 'dropWords' @n@ returns the suffix with @n@ 'Word16'
9611114-- values dropped, or the empty 'Text' if @n@ is greater than the
9621115-- number of 'Word16' values present.
@@ -967,7 +1120,7 @@ dropWords i t0
9671120 where drop' 0 ts = ts
9681121 drop' _ Empty = Empty
9691122 drop' n (Chunk (T.Text arr off len) ts)
970− | n < len' = chunk (textP arr (off+n') (len-n')) ts
1123+ | n < len' = chunk (text arr (off+n') (len-n')) ts
9711124 | otherwise = drop' (n - len') ts
9721125 where len' = fromIntegral len
9731126 n' = fromIntegral n
@@ -991,6 +1144,20 @@ takeWhile p t0 = takeWhile' t0
9911144"LAZY TEXT takeWhile -> unfused" [1] forall p t.
9921145 unstream (S.takeWhile p (stream t)) = takeWhile p t
9931146 #-}
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 #-}
9941161
9951162-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
9961163-- 'takeWhile' @p@ @t@. Subject to fusion.
@@ -1009,9 +1176,11 @@ dropWhile p t0 = dropWhile' t0
10091176"LAZY TEXT dropWhile -> unfused" [1] forall p t.
10101177 unstream (S.dropWhile p (stream t)) = dropWhile p t
10111178 #-}
1179+
10121180-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1013−-- dropping characters that fail the predicate @p@ from the end of
1181+-- dropping characters that satisfy the predicate @p@ from the end of
10141182-- @t@.
1183+--
10151184-- Examples:
10161185--
10171186-- > dropWhileEnd (=='.') "foo..." == "foo"
@@ -1028,7 +1197,7 @@ dropWhileEnd p = go
10281197{-# INLINE dropWhileEnd #-}
10291198
10301199-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1031−-- dropping characters that fail the predicate @p@ from both the
1200+-- dropping characters that satisfy the predicate @p@ from both the
10321201-- beginning and end of @t@. Subject to fusion.
10331202dropAround :: (Char -> Bool) -> Text -> Text
10341203dropAround p = dropWhile p . dropWhileEnd p
@@ -1078,8 +1247,8 @@ splitAtWord _ Empty = empty :*: empty
10781247splitAtWord x (Chunk c@(T.Text arr off len) cs)
10791248 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
10801249 in Chunk c h :*: t
1081− | otherwise = chunk (textP arr off y) empty :*:
1082− chunk (textP arr (off+y) (len-y)) cs
1250+ | otherwise = chunk (text arr off y) empty :*:
1251+ chunk (text arr (off+y) (len-y)) cs
10831252 where y = fromIntegral x
10841253
10851254-- | /O(n+m)/ Find the first instance of @needle@ (which must be
@@ -1223,9 +1392,10 @@ tails ts@(Chunk t ts')
12231392-- copies to create substrings; they just construct new 'Text's that
12241393-- are slices of the original.
12251394
1226−-- | /O(m+n)/ Break a 'Text' into pieces separated by the first
1227−-- 'Text' argument, consuming the delimiter. An empty delimiter is
1228−-- 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.
12291399--
12301400-- Examples:
12311401--
@@ -1238,13 +1408,18 @@ tails ts@(Chunk t ts')
12381408-- > intercalate s . splitOn s == id
12391409-- > splitOn (singleton c) == split (==c)
12401410--
1411+-- (Note: the string @s@ to split on above cannot be empty.)
1412+--
12411413-- This function is strict in its first argument, and lazy in its
12421414-- second.
12431415--
12441416-- In (unlikely) bad cases, this function's time complexity degrades
12451417-- towards /O(n*m)/.
1246−splitOn :: Text -- ^ Text to split on
1247− -> 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.
12481423 -> [Text]
12491424splitOn pat src
12501425 | null pat = emptyError "splitOn"
Data/Text/Lazy/Builder.hs+1−1
@@ -8,7 +8,7 @@
88-- Module : Data.Text.Lazy.Builder
99-- Copyright : (c) 2013 Bryan O'Sullivan
1010-- (c) 2010 Johan Tibell
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
78-- Copyright: (c) 2013 Bryan O'Sullivan
89-- (c) 2011 MailRank, Inc.
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+9−21
@@ -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, (<>))
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,17 +155,13 @@ encodeUtf8 lt@(Chunk t _) =
163155 strategy = B.safeStrategy firstChunkSize B.defaultChunkSize
164156
165157encodeUtf8Builder :: Text -> B.Builder
166−encodeUtf8Builder = foldrChunks (\c b -> TE.encodeUtf8Builder c <> 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 =
171− foldrChunks (\c b -> TE.encodeUtf8BuilderEscaped prim c <> b) mempty
172−
173−#else
174−encodeUtf8 (Chunk c cs) = B.Chunk (TE.encodeUtf8 c) (encodeUtf8 cs)
175−encodeUtf8 Empty = B.Empty
176−#endif
164+ foldrChunks (\c b -> TE.encodeUtf8BuilderEscaped prim c `mappend` b) mempty
177165
178166-- | Decode text from little endian UTF-16 encoding.
179167decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text
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
57
@@ -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
6+
7+-- |
8+-- Module : Data.Text.Show
9+-- Copyright : (c) 2009-2015 Bryan O'Sullivan
10+--
11+-- License : BSD-style
12+-- Maintainer : bos@serpentine.com
13+-- Stability : experimental
14+-- Portability : GHC
15+
16+module Data.Text.Show
17+ (
18+ singleton
19+ , unpack
20+ , unpackCString#
21+ ) where
22+
23+import Control.Monad.ST (ST)
24+import Data.Text.Internal (Text(..), empty_, safe)
25+import Data.Text.Internal.Fusion (stream, unstream)
26+import Data.Text.Internal.Unsafe.Char (unsafeWrite)
27+import GHC.Prim (Addr#)
28+import qualified Data.Text.Array as A
29+import qualified Data.Text.Internal.Fusion.Common as S
30+
31+#if __GLASGOW_HASKELL__ >= 702
32+import qualified GHC.CString as GHC
33+#else
34+import qualified GHC.Base as GHC
35+#endif
36+
37+instance Show Text where
38+ showsPrec p ps r = showsPrec p (unpack ps) r
39+
40+-- | /O(n)/ Convert a 'Text' into a 'String'. Subject to fusion.
41+unpack :: Text -> String
42+unpack = S.unstreamList . stream
43+{-# INLINE [1] unpack #-}
44+
45+-- | /O(n)/ Convert a literal string into a 'Text'. Subject to
46+-- fusion.
47+--
48+-- This is exposed solely for people writing GHC rewrite rules.
49+unpackCString# :: Addr# -> Text
50+unpackCString# addr# = unstream (S.streamCString# addr#)
51+{-# NOINLINE unpackCString# #-}
52+
53+{-# RULES "TEXT literal" [1] forall a.
54+ unstream (S.map safe (S.streamList (GHC.unpackCString# a)))
55+ = unpackCString# a #-}
56+
57+{-# RULES "TEXT literal UTF8" [1] forall a.
58+ unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))
59+ = unpackCString# a #-}
60+
61+{-# RULES "TEXT empty literal" [1]
62+ unstream (S.map safe (S.streamList []))
63+ = empty_ #-}
64+
65+{-# RULES "TEXT singleton literal" [1] forall a.
66+ unstream (S.map safe (S.streamList [a]))
67+ = singleton_ a #-}
68+
69+-- | /O(1)/ Convert a character into a Text. Subject to fusion.
70+-- Performs replacement on invalid scalar values.
71+singleton :: Char -> Text
72+singleton = unstream . S.singleton . safe
73+{-# INLINE [1] singleton #-}
74+
75+{-# RULES "TEXT singleton" forall a.
76+ unstream (S.singleton (safe a))
77+ = singleton_ a #-}
78+
79+-- This is intended to reduce inlining bloat.
80+singleton_ :: Char -> Text
81+singleton_ c = Text (A.run x) 0 len
82+ where x :: ST s (A.MArray s)
83+ x = do arr <- A.new len
84+ _ <- unsafeWrite arr 0 d
85+ return arr
86+ len | d < '\x10000' = 1
87+ | otherwise = 2
88+ d = safe c
89+{-# NOINLINE singleton_ #-}
Data/Text/Unsafe.hs+11
@@ -18,6 +18,7 @@ module Data.Text.Unsafe
1818 , iter
1919 , iter_
2020 , reverseIter
21+ , reverseIter_
2122 , unsafeHead
2223 , unsafeTail
2324 , lengthWord16
@@ -94,6 +95,16 @@ reverseIter (Text arr off _len) i
9495 k = j - 1
9596{-# INLINE reverseIter #-}
9697
98+-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
99+-- returning the delta to add (i.e. a negative number) to give the
100+-- next offset to iterate at.
101+reverseIter_ :: Text -> Int -> Int
102+reverseIter_ (Text arr off _len) i
103+ | m < 0xDC00 || m > 0xDFFF = -1
104+ | otherwise = -2
105+ where m = A.unsafeIndex arr (off+i)
106+{-# INLINE reverseIter_ #-}
107+
97108-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
98109-- is useful for sizing a target array appropriately before using
99110-- 'unsafeCopyToPtr'.
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
2+
3+import Control.Exception (evaluate)
4+import Criterion.Main
5+import Data.Int (Int32, Int64)
6+import Data.Text.Internal (mul32, mul64)
7+import qualified Data.Vector.Unboxed as U
8+
9+oldMul :: Int64 -> Int64 -> Int64
10+oldMul m n
11+ | n == 0 = 0
12+ | m <= maxBound `quot` n = m * n
13+ | otherwise = error "overflow"
14+
15+benchmark :: IO Benchmark
16+benchmark = do
17+ _ <- evaluate testVector32
18+ _ <- evaluate testVector64
19+ return $ bgroup "Mul" [
20+ bench "oldMul" $ whnf (U.map (uncurry oldMul)) testVector64
21+ , bench "mul64" $ whnf (U.map (uncurry mul64)) testVector64
22+ , bench "*64" $ whnf (U.map (uncurry (*))) testVector64
23+ , bench "mul32" $ whnf (U.map (uncurry mul32)) testVector32
24+ , bench "*32" $ whnf (U.map (uncurry (*))) testVector32
25+ ]
26+
27+testVector64 :: U.Vector (Int64,Int64)
28+testVector64 = U.fromList [
29+ (0,1248868987182846646),(169004623633872,24458),(482549039517835,7614),
30+ (372,8157063115504364),(27,107095594861148252),(3,63249878517962420),
31+ (4363,255694473572912),(86678474,1732634806),(1572453024,1800489338),
32+ (9384523143,77053781),(49024709555,75095046),(7,43457620410239131),
33+ (8,8201563008844571),(387719037,1520696708),(189869238220197,1423),
34+ (46788016849611,23063),(503077742109974359,0),(104,1502010908706487),
35+ (30478140346,207525518),(80961140129236192,14),(4283,368012829143675),
36+ (1028719181728108146,6),(318904,5874863049591),(56724427166898,110794),
37+ (234539368,31369110449),(2,251729663598178612),(103291548194451219,5),
38+ (76013,5345328755566),(1769631,2980846129318),(40898,60598477385754),
39+ (0,98931348893227155),(573555872156917492,3),(318821187115,4476566),
40+ (11152874213584,243582),(40274276,16636653248),(127,4249988676030597),
41+ (103543712111871836,5),(71,16954462148248238),(3963027173504,216570),
42+ (13000,503523808916753),(17038308,20018685905),(0,510350226577891549),
43+ (175898,3875698895405),(425299191292676,5651),(17223451323664536,50),
44+ (61755131,14247665326),(0,1018195131697569303),(36433751497238985,20),
45+ (3473607861601050,1837),(1392342328,1733971838),(225770297367,3249655),
46+ (14,127545244155254102),(1751488975299136,2634),(3949208,504190668767),
47+ (153329,831454434345),(1066212122928663658,2),(351224,2663633539556),
48+ (344565,53388869217),(35825609350446863,54),(276011553660081475,10),
49+ (1969754174790470349,3),(35,68088438338633),(506710,3247689556438),
50+ (11099382291,327739909),(105787303549,32824363),(210366111,14759049409),
51+ (688893241579,3102676),(8490,70047474429581),(152085,29923000251880),
52+ (5046974599257095,400),(4183167795,263434071),(10089728,502781960687),
53+ (44831977765,4725378),(91,8978094664238578),(30990165721,44053350),
54+ (1772377,149651820860),(243420621763408572,4),(32,5790357453815138),
55+ (27980806337993771,5),(47696295759774,20848),(1745874142313778,1098),
56+ (46869334770121,1203),(886995283,1564424789),(40679396544,76002479),
57+ (1,672849481568486995),(337656187205,3157069),(816980552858963,6003),
58+ (2271434085804831543,1),(0,1934521023868747186),(6266220038281,15825),
59+ (4160,107115946987394),(524,246808621791561),(0,1952519482439636339),
60+ (128,2865935904539691),(1044,3211982069426297),(16000511542473,88922),
61+ (1253596745404082,2226),(27041,56836278958002),(23201,49247489754471),
62+ (175906590497,21252392),(185163584757182295,24),(34742225226802197,150),
63+ (2363228,250824838408),(216327527109550,45),(24,81574076994520675),
64+ (28559899906542,15356),(10890139774837133,511),(2293,707179303654492),
65+ (2749366833,40703233),(0,4498229704622845986),(439,4962056468281937),
66+ (662,1453820621089921),(16336770612459631,220),(24282989393,74239137),
67+ (2724564648490195,3),(743672760,124992589),(4528103,704330948891),
68+ (6050483122491561,250),(13322953,13594265152),(181794,22268101450214),
69+ (25957941712,75384092),(43352,7322262295009),(32838,52609059549923),
70+ (33003585202001564,2),(103019,68430142267402),(129918230800,8742978),
71+ (0,2114347379589080688),(2548,905723041545274),(222745067962838382,0),
72+ (1671683850790425181,1),(455,4836932776795684),(794227702827214,6620),
73+ (212534135175874,1365),(96432431858,29784975),(466626763743380,3484),
74+ (29793949,53041519613),(8359,309952753409844),(3908960585331901,26),
75+ (45185288970365760,114),(10131829775,68110174),(58039242399640479,83),
76+ (628092278238719399,6),(1,196469106875361889),(302336625,16347502444),
77+ (148,3748088684181047),(1,1649096568849015456),(1019866864,2349753026),
78+ (8211344830,569363306),(65647579546873,34753),(2340190,1692053129069),
79+ (64263301,30758930355),(48681618072372209,110),(7074794736,47640197),
80+ (249634721521,7991792),(1162917363807215,232),(7446433349,420634045),
81+ (63398619383,60709817),(51359004508011,14200),(131788797028647,7072),
82+ (52079887791430043,7),(7,136277667582599838),(28582879735696,50327),
83+ (1404582800566278,833),(469164435,15017166943),(99567079957578263,49),
84+ (1015285971,3625801566),(321504843,4104079293),(5196954,464515406632),
85+ (114246832260876,7468),(8149664437,487119673),(12265299,378168974869),
86+ (37711995764,30766513),(3971137243,710996152),(483120070302,603162),
87+ (103009942,61645547145),(8476344625340,6987),(547948761229739,1446),
88+ (42234,18624767306301),(13486714173011,58948),(4,198309153268019840),
89+ (9913176974,325539248),(28246225540203,116822),(2882463945582154,18),
90+ (959,25504987505398),(3,1504372236378217710),(13505229956793,374987),
91+ (751661959,457611342),(27375926,36219151769),(482168869,5301952074),
92+ (1,1577425863241520640),(714116235611821,1164),(904492524250310488,0),
93+ (5983514941763398,68),(10759472423,23540686),(72539568471529,34919),
94+ (4,176090672310337473),(938702842110356453,1),(673652445,3335287382),
95+ (3111998893666122,917),(1568013,3168419765469)]
96+
97+testVector32 :: U.Vector (Int32,Int32)
98+testVector32 = U.fromList [
99+ (39242,410),(0,100077553),(2206,9538),(509400240,1),(38048,6368),
100+ (1789,651480),(2399,157032),(701,170017),(5241456,14),(11212,70449),
101+ (1,227804876),(749687254,1),(74559,2954),(1158,147957),(410604456,1),
102+ (170851,1561),(92643422,1),(6192,180509),(7,24202210),(3440,241481),
103+ (5753677,5),(294327,1622),(252,4454673),(127684121,11),(28315800,30),
104+ (340370905,0),(1,667887987),(592782090,1),(49023,27641),(750,290387),
105+ (72886,3847),(0,301047933),(3050276,473),(1,788366142),(59457,15813),
106+ (637726933,1),(1135,344317),(853616,264),(696816,493),(7038,12046),
107+ (125219574,4),(803694088,1),(107081726,1),(39294,21699),(16361,38191),
108+ (132561123,12),(1760,23499),(847543,484),(175687349,1),(2963,252678),
109+ (6248,224553),(27596,4606),(5422922,121),(1542,485890),(131,583035),
110+ (59096,4925),(3637115,132),(0,947225435),(86854,6794),(2984745,339),
111+ (760129569,1),(1,68260595),(380835652,2),(430575,2579),(54514,7211),
112+ (15550606,3),(9,27367402),(3007053,207),(7060988,60),(28560,27130),
113+ (1355,21087),(10880,53059),(14563646,4),(461886361,1),(2,169260724),
114+ (241454126,2),(406797,1),(61631630,16),(44473,5943),(63869104,12),
115+ (950300,1528),(2113,62333),(120817,9358),(100261456,1),(426764723,1),
116+ (119,12723684),(3,53358711),(4448071,18),(1,230278091),(238,232102),
117+ (8,57316440),(42437979,10),(6769,19555),(48590,22006),(11500585,79),
118+ (2808,97638),(42,26952545),(11,32104194),(23954638,1),(785427272,0),
119+ (513,81379),(31333960,37),(897772,1009),(4,25679692),(103027993,12),
120+ (104972702,11),(546,443401),(7,65137092),(88574269,3),(872139069,0),
121+ (2,97417121),(378802603,0),(141071401,4),(22613,10575),(2191743,118),
122+ (470,116119),(7062,38166),(231056,1847),(43901963,9),(2400,70640),
123+ (63553,1555),(34,11249573),(815174,1820),(997894011,0),(98881794,2),
124+ (5448,43132),(27956,9),(904926,1357),(112608626,3),(124,613021),
125+ (282086,1966),(99,10656881),(113799,1501),(433318,2085),(442,948171),
126+ (165380,1043),(28,14372905),(14880,50462),(2386,219918),(229,1797565),
127+ (1174961,298),(3925,41833),(3903515,299),(15690452,111),(360860521,3),
128+ (7440846,81),(2541026,507),(0,492448477),(6869,82469),(245,8322939),
129+ (3503496,253),(123495298,0),(150963,2299),(33,4408482),(1,200911107),
130+ (305,252121),(13,123369189),(215846,8181),(2440,65387),(776764401,1),
131+ (1241172,434),(8,15493155),(81953961,6),(17884993,5),(26,6893822),
132+ (0,502035190),(1,582451018),(2,514870139),(227,3625619),(49,12720258),
133+ (1456769,207),(94797661,10),(234407,893),(26843,5783),(15688,24547),
134+ (4091,86268),(4339448,151),(21360,6294),(397046497,2),(1227,205936),
135+ (9966,21959),(160046791,1),(0,159992224),(27,24974797),(19177,29334),
136+ (4136148,42),(21179785,53),(61256583,31),(385,344176),(7,11934915),
137+ (1,18992566),(3488065,5),(768021,224),(36288474,7),(8624,117561),
138+ (8,20341439),(5903,261475),(561,1007618),(1738,392327),(633049,1708)]
benchmarks/haskell/Benchmarks/Programs/BigTable.hs+2−2
@@ -11,7 +11,7 @@ module Benchmarks.Programs.BigTable
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+18−6
@@ -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,9 +15,15 @@ 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
26+ manual: True
2127
2228executable text-benchmarks
2329 hs-source-dirs: haskell ..
@@ -25,24 +31,30 @@ executable text-benchmarks
2531 cbits/time_iconv.c
2632 include-dirs: ../include
2733 main-is: Benchmarks.hs
28− ghc-options: -Wall -O2
34+ ghc-options: -Wall -O2 -rtsopts
2935 if flag(llvm)
3036 ghc-options: -fllvm
3137 cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP
3238 build-depends: base == 4.*,
3339 binary,
3440 blaze-builder,
35− bytestring,
36− bytestring-lexing,
41+ bytestring-lexing >= 0.5.0,
3742 containers,
38− criterion >= 0.6.0.1,
43+ criterion >= 0.10.0.0,
3944 deepseq,
4045 directory,
4146 filepath,
4247 ghc-prim,
4348 integer-gmp,
4449 stringsearch,
45− utf8-string
50+ utf8-string,
51+ vector
52+
53+ if flag(bytestring-builder)
54+ build-depends: bytestring >= 0.9 && < 0.10.4,
55+ bytestring-builder >= 0.10.4
56+ else
57+ build-depends: bytestring >= 0.10.4
4658
4759executable text-multilang
4860 hs-source-dirs: haskell
cbits/cbits.c+6−6
@@ -68,8 +68,8 @@ decode(uint32_t *state, uint32_t* codep, uint32_t byte) {
6868 * an UTF16 array
6969 */
7070void
71−_hs_text_decode_latin1(uint16_t *dest, const uint8_t const *src,
72− const uint8_t const *srcend)
71+_hs_text_decode_latin1(uint16_t *dest, const uint8_t *src,
72+ const uint8_t *srcend)
7373{
7474 const uint8_t *p = src;
7575
@@ -130,14 +130,14 @@ _hs_text_decode_latin1(uint16_t *dest, const uint8_t const *src,
130130#if defined(__GNUC__) || defined(__clang__)
131131static inline uint8_t const *
132132_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,
133− const uint8_t const **src, const uint8_t const *srcend,
133+ const uint8_t **src, const uint8_t *srcend,
134134 uint32_t *codepoint0, uint32_t *state0)
135135 __attribute((always_inline));
136136#endif
137137
138138static inline uint8_t const *
139139_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,
140− const uint8_t const **src, const uint8_t const *srcend,
140+ const uint8_t **src, const uint8_t *srcend,
141141 uint32_t *codepoint0, uint32_t *state0)
142142{
143143 uint16_t *d = dest + *destoff;
@@ -202,8 +202,8 @@ _hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,
202202
203203uint8_t const *
204204_hs_text_decode_utf8_state(uint16_t *const dest, size_t *destoff,
205− const uint8_t const **src,
206− const uint8_t const *srcend,
205+ const uint8_t **src,
206+ const uint8_t *srcend,
207207 uint32_t *codepoint0, uint32_t *state0)
208208{
209209 uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, src, srcend,
changelogdeleted−41
@@ -1,41 +0,0 @@
1−1.1.0.0
2−
3− * encodeUtf8: Performance is improved by up to 4x.
4−
5− * encodeUtf8Builder, encodeUtf8BuilderEscaped: new functions,
6− available only if bytestring >= 0.10.4.0 is installed, that
7− allow very fast and flexible encoding of a Text value to a
8− bytestring Builder.
9−
10− As an example of the performance gain to be had, the
11− encodeUtf8BuilderEscaped function helps to double the speed
12− of JSON encoding in the latest version of aeson! (Note: if
13− all you need is a plain ByteString, encodeUtf8 is still the
14− faster way to go.)
15−
16− * All of the internal module hierarchy is now publicly
17− exposed. If a module is in the .Internal hierarchy, or is
18− documented as internal, use at your own risk - there are no
19− API stability guarantees for internal modules!
20−
21−1.0.0.1
22−
23− * decodeUtf8: Fixed a regression that caused us to incorrectly
24− identify truncated UTF-8 as valid (gh-61)
25−
26−1.0.0.0
27−
28− * Added support for Unicode 6.3.0 to case conversion functions
29−
30− * New function toTitle converts words in a string to title case
31−
32− * New functions peekCStringLen and withCStringLen simplify
33− interoperability with C functionns
34−
35− * Added support for decoding UTF-8 in stream-friendly fashion
36−
37− * Fixed a bug in mapAccumL
38−
39− * Added trusted Haskell support
40−
41− * Removed support for GHC 6.10 (released in 2008) and older
changelog.mdnew file+164
@@ -0,0 +1,164 @@
1+1.2.2.1
2+
3+* The switch to `integer-pure` in 1.2.2.0 was apparently mistaken.
4+ The build flag has been renamed accordingly. Your army of diligent
5+ maintainers apologizes for the churn.
6+
7+* Spec compliance: toCaseFold now follows the Unicode 8.0 spec
8+ (updated from 7.0)
9+
10+* An STG lint error has been fixed
11+
12+1.2.2.0
13+
14+* The `integer-simple` package, upon which this package optionally
15+ depended, has been replaced with `integer-pure`. The build flag has
16+ been renamed accordingly.
17+
18+* Bug fix: For the `Binary` instance, If UTF-8 decoding fails during a
19+ `get`, the error is propagated via `fail` instead of an uncatchable
20+ crash.
21+
22+* New function: `takeWhileEnd`
23+
24+* New instances for the `Text` types:
25+ * if `base` >= 4.7: `PrintfArg`
26+ * if `base` >= 4.9: `Semigroup`
27+
28+1.2.1.3
29+
30+* Bug fix: As it turns out, moving the literal rewrite rules to simplifier
31+ phase 2 does not prevent competition with the `unpack` rule, which is
32+ also active in this phase. Unfortunately this was hidden due to a silly
33+ test environment mistake. Moving literal rules back to phase 1 finally
34+ fixes GHC Trac #10528 correctly.
35+
36+1.2.1.2
37+
38+* Bug fix: Run literal rewrite rules in simplifier phase 2.
39+ The behavior of the simplifier changed in GHC 7.10.2,
40+ causing these rules to fail to fire, leading to poor code generation
41+ and long compilation times. See
42+ [GHC Trac #10528](https://ghc.haskell.org/trac/ghc/ticket/10528).
43+
44+1.2.1.1
45+
46+* Expose unpackCString#, which you should never use.
47+
48+1.2.1.0
49+
50+* Added Binary instances for both Text types. (If you have previously
51+ been using the text-binary package to get a Binary instance, it is
52+ now obsolete.)
53+
54+1.2.0.6
55+
56+* Fixed a space leak in UTF-8 decoding
57+
58+1.2.0.5
59+
60+* Feature parity: repeat, cycle, iterate are now implemented for lazy
61+ Text, and the Data instance is more complete
62+
63+* Build speed: an inliner space explosion has been fixed with toCaseFold
64+
65+* Bug fix: encoding Int to a Builder would infinite-loop if the
66+ integer-simple package was used
67+
68+* Deprecation: OnEncodeError and EncodeError are deprecated, as they
69+ are never used
70+
71+* Internals: some types that are used internally in fusion-related
72+ functions have moved around, been renamed, or been deleted (we don't
73+ bump the major version if .Internal modules change)
74+
75+* Spec compliance: toCaseFold now follows the Unicode 7.0 spec
76+ (updated from 6.3)
77+
78+1.2.0.4
79+
80+* Fixed an incompatibility with base < 4.5
81+
82+1.2.0.3
83+
84+* Update formatRealFloat to correspond to the definition in versions
85+ of base newer than 4.5 (https://github.com/bos/text/issues/105)
86+
87+1.2.0.2
88+
89+* Bumped lower bound on deepseq to 1.4 for compatibility with the
90+ upcoming GHC 7.10
91+
92+1.2.0.1
93+
94+* Fixed a buffer overflow in rendering of large Integers
95+ (https://github.com/bos/text/issues/99)
96+
97+1.2.0.0
98+
99+* Fixed an integer overflow in the replace function
100+ (https://github.com/bos/text/issues/81)
101+
102+* Fixed a hang in lazy decodeUtf8With
103+ (https://github.com/bos/text/issues/87)
104+
105+* Reduced codegen bloat caused by use of empty and single-character
106+ literals
107+
108+* Added an instance of IsList for GHC 7.8 and above
109+
110+1.1.1.0
111+
112+* The Data.Data instance now allows gunfold to work, via a virtual
113+ pack constructor
114+
115+* dropEnd, takeEnd: new functions
116+
117+* Comparing the length of a Text against a number can now
118+ short-circuit in more cases
119+
120+1.1.0.1
121+
122+* streamDecodeUtf8: fixed gh-70, did not return all unconsumed bytes
123+ in single-byte chunks
124+
125+1.1.0.0
126+
127+* encodeUtf8: Performance is improved by up to 4x.
128+
129+* encodeUtf8Builder, encodeUtf8BuilderEscaped: new functions,
130+ available only if bytestring >= 0.10.4.0 is installed, that allow
131+ very fast and flexible encoding of a Text value to a bytestring
132+ Builder.
133+
134+ As an example of the performance gain to be had, the
135+ encodeUtf8BuilderEscaped function helps to double the speed of JSON
136+ encoding in the latest version of aeson! (Note: if all you need is a
137+ plain ByteString, encodeUtf8 is still the faster way to go.)
138+
139+* All of the internal module hierarchy is now publicly exposed. If a
140+ module is in the .Internal hierarchy, or is documented as internal,
141+ use at your own risk - there are no API stability guarantees for
142+ internal modules!
143+
144+1.0.0.1
145+
146+* decodeUtf8: Fixed a regression that caused us to incorrectly
147+ identify truncated UTF-8 as valid (gh-61)
148+
149+1.0.0.0
150+
151+* Added support for Unicode 6.3.0 to case conversion functions
152+
153+* New function toTitle converts words in a string to title case
154+
155+* New functions peekCStringLen and withCStringLen simplify
156+ interoperability with C functionns
157+
158+* Added support for decoding UTF-8 in stream-friendly fashion
159+
160+* Fixed a bug in mapAccumL
161+
162+* Added trusted Haskell support
163+
164+* Removed support for GHC 6.10 (released in 2008) and older
scripts/CaseFolding.hs+1−1
@@ -37,7 +37,7 @@ mapCF :: CaseFolding -> [String]
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 #-}
2+
3+module LiteralRuleTest where
4+
5+import Data.Text (Text)
6+
7+-- This should produce 8 firings of the "TEXT literal" rule
8+strings :: [Text]
9+strings = [ "abstime", "aclitem", "bit", "bool", "box", "bpchar", "bytea", "char" ]
10+
11+-- This should produce 7 firings of the "TEXT literal UTF8" rule
12+utf8Strings :: [Text]
13+utf8Strings = [ "\0abstime", "\0aclitem", "\xfefe bit", "\0bool", "\0box", "\0bpchar", "\0bytea" ]
14+
15+-- This should produce 4 firings of the "TEXT empty literal" rule
16+empties :: [Text]
17+empties = [ "", "", "", "" ]
18+
19+-- This should produce 5 firings of the "TEXT empty literal" rule
20+--singletons :: [Text]
21+--singletons = [ "a", "b", "c", "d", "e" ]
tests/Makefile+6−1
@@ -1,5 +1,10 @@
11count = 1000
22
3+all: coverage literal-rule-test
4+
5+literal-rule-test:
6+ ./literal-rule-test.sh
7+
38coverage: build coverage/hpc_index.html
49
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+136−48
@@ -1,9 +1,8 @@
1−-- | General quicktest properties for the text library
2−--
1+-- | QuickCheck properties for the text library.
2+
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,12 +23,13 @@ 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)
3130import Test.QuickCheck hiding ((.&.))
3231import Test.QuickCheck.Monadic
32+import Test.QuickCheck.Property (Property(..))
3333import Tests.QuickCheckUtils
3434import Tests.Utils
3535import Text.Show.Functions ()
@@ -53,6 +53,7 @@ import qualified Data.Text.Lazy.Builder.RealFloat as TB
5353import qualified Data.Text.Lazy.Encoding as EL
5454import qualified Data.Text.Lazy.IO as TL
5555import qualified System.IO as IO
56+import qualified Tests.Properties.Mul as Mul
5657import qualified Tests.SlowFunctions as Slow
5758
5859t_pack_unpack = (T.unpack . T.pack) `eq` id
@@ -94,9 +95,7 @@ tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id
9495t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
9596tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
9697
97−t_utf8_incr = do
98− Positive n <- arbitrary
99− forAll genUnicode $ recode n `eq` id
98+t_utf8_incr = forAll genUnicode $ \s (Positive n) -> (recode n `eq` id) s
10099 where recode n = T.concat . map fst . feedChunksOf n E.streamDecodeUtf8 .
101100 E.encodeUtf8
102101
@@ -127,9 +126,9 @@ t_utf8_err bad de = do
127126 Leading -> B.append <$> genInvalidUTF8 <*> genUTF8
128127 Trailing -> B.append <$> genUTF8 <*> genInvalidUTF8
129128 genUTF8 = E.encodeUtf8 <$> genUnicode
130− forAll gen $ \bs -> do
129+ forAll gen $ \bs -> MkProperty $ do
131130 onErr <- genDecodeErr de
132− monadicIO $ do
131+ unProperty . monadicIO $ do
133132 l <- run $ let len = T.length (E.decodeUtf8With onErr bs)
134133 in (len `seq` return (Right len)) `Exception.catch`
135134 (\(e::UnicodeException) -> return (Left e))
@@ -198,8 +197,10 @@ t_Show = show `eq` (show . T.pack)
198197tl_Show = show `eq` (show . TL.pack)
199198t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))
200199tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))
201−t_mconcat = mconcat `eq` (unpackS . mconcat . L.map T.pack)
202−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)
203204t_mempty = mempty == (unpackS (mempty :: T.Text))
204205tl_mempty = mempty == (unpackS (mempty :: TL.Text))
205206t_IsString = fromString `eqP` (T.unpack . fromString)
@@ -263,11 +264,14 @@ s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)
263264sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)
264265t_map f = map f `eqP` (unpackS . T.map f)
265266tl_map f = map f `eqP` (unpackS . TL.map f)
266−s_intercalate c = L.intercalate c `eq`
267+s_intercalate c = unsquare $
268+ L.intercalate c `eq`
267269 (unpackS . S.intercalate (packS c) . map packS)
268−t_intercalate c = L.intercalate c `eq`
270+t_intercalate c = unsquare $
271+ L.intercalate c `eq`
269272 (unpackS . T.intercalate (packS c) . map packS)
270−tl_intercalate c = L.intercalate c `eq`
273+tl_intercalate c = unsquare $
274+ L.intercalate c `eq`
271275 (unpackS . TL.intercalate (TL.pack c) . map TL.pack)
272276s_intersperse c = L.intersperse c `eqP`
273277 (unpackS . S.intersperse c)
@@ -275,10 +279,14 @@ s_intersperse_s c = L.intersperse c `eqP`
275279 (unpackS . S.unstream . S.intersperse c)
276280sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`
277281 (unpackS . S.intersperse c . S.filter p)
278−t_intersperse c = L.intersperse c `eqP` (unpackS . T.intersperse c)
279−tl_intersperse c = L.intersperse c `eqP` (unpackS . TL.intersperse c)
280−t_transpose = L.transpose `eq` (map unpackS . T.transpose . map packS)
281−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)
282290t_reverse = L.reverse `eqP` (unpackS . T.reverse)
283291tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)
284292t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)
@@ -375,17 +383,24 @@ sf_foldr p f z = (L.foldr f z . L.filter p) `eqP` (S.foldr f z . S.filter p)
375383 where _types = f :: Char -> Char -> Char
376384t_foldr f z = L.foldr f z `eqP` T.foldr f z
377385 where _types = f :: Char -> Char -> Char
378−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
379388 where _types = f :: Char -> Char -> Char
380−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)
381391t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f
382−tl_foldr1 f = L.foldr1 f `eqP` TL.foldr1 f
392+tl_foldr1 f = unsquare $
393+ L.foldr1 f `eqP` TL.foldr1 f
383394
384−s_concat_s = L.concat `eq` (unpackS . S.unstream . S.concat . map packS)
385−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`
386399 (unpackS . S.concat . map (S.filter p . packS))
387−t_concat = L.concat `eq` (unpackS . T.concat . map packS)
388−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)
389404sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`
390405 (unpackS . S.concatMap (packS . f) . S.filter p)
391406t_concatMap f = unsquare $
@@ -425,6 +440,10 @@ t_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z)
425440tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)
426441 where _types = f :: Int -> Char -> (Int,Char)
427442
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+
428447replicate n l = concat (L.replicate n l)
429448
430449s_replicate n = replicate m `eq`
@@ -436,6 +455,14 @@ tl_replicate n = replicate m `eq`
436455 (unpackS . TL.replicate (fromIntegral m) . packS)
437456 where m = fromIntegral (n :: Word8)
438457
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+
439466unf :: Int -> Char -> Maybe (Char, Char)
440467unf n c | fromEnum c * 100 > n = Nothing
441468 | otherwise = Just (c, succ c)
@@ -462,14 +489,22 @@ s_take_s m = L.take n `eqP` (unpackS . S.unstream . S.take n)
462489sf_take p n = (L.take n . L.filter p) `eqP`
463490 (unpackS . S.take n . S.filter p)
464491t_take n = L.take n `eqP` (unpackS . T.take n)
492+t_takeEnd n = (L.reverse . L.take n . L.reverse) `eqP`
493+ (unpackS . T.takeEnd n)
465494tl_take n = L.take n `eqP` (unpackS . TL.take (fromIntegral n))
495+tl_takeEnd n = (L.reverse . L.take (fromIntegral n) . L.reverse) `eqP`
496+ (unpackS . TL.takeEnd n)
466497s_drop n = L.drop n `eqP` (unpackS . S.drop n)
467498s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)
468499 where n = small m
469500sf_drop p n = (L.drop n . L.filter p) `eqP`
470501 (unpackS . S.drop n . S.filter p)
471502t_drop n = L.drop n `eqP` (unpackS . T.drop n)
503+t_dropEnd n = (L.reverse . L.drop n . L.reverse) `eqP`
504+ (unpackS . T.dropEnd n)
472505tl_drop n = L.drop n `eqP` (unpackS . TL.drop (fromIntegral n))
506+tl_dropEnd n = (L.reverse . L.drop n . L.reverse) `eqP`
507+ (unpackS . TL.dropEnd (fromIntegral n))
473508s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)
474509 where n = small m
475510s_take_drop_s m = (L.take n . L.drop n) `eqP`
@@ -481,6 +516,10 @@ sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
481516 (unpackS . S.takeWhile p . S.filter q)
482517t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
483518tl_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)
484523s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
485524s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
486525sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
@@ -533,24 +572,27 @@ tl_groupBy p = L.groupBy p `eqP` (map unpackS . TL.groupBy p)
533572t_inits = L.inits `eqP` (map unpackS . T.inits)
534573tl_inits = L.inits `eqP` (map unpackS . TL.inits)
535574t_tails = L.tails `eqP` (map unpackS . T.tails)
536−tl_tails = L.tails `eqP` (map unpackS . TL.tails)
537−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 ->
538578 let t = T.intercalate s ts
539579 in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)
540−tl_findAppendId (NotEmpty s) = unsquare $ \ts ->
580+tl_findAppendId = unsquare $ \(NotEmpty s) ts ->
541581 let t = TL.intercalate s ts
542582 in all (==t) $ map (uncurry TL.append) (TL.breakOnAll s t)
543−t_findContains (NotEmpty s) = all (T.isPrefixOf s . snd) . T.breakOnAll s .
544− T.intercalate s
545−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) .
546586 TL.breakOnAll s . TL.intercalate s
547587sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c
548588t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s
549589tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s
550590
551−t_splitOn_split s = (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s
552−tl_splitOn_split s = ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`
553− (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
554596t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)
555597tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)
556598
@@ -592,10 +634,14 @@ t_lines' = lines' `eqP` (map unpackS . T.lines')
592634t_words = L.words `eqP` (map unpackS . T.words)
593635
594636tl_words = L.words `eqP` (map unpackS . TL.words)
595−t_unlines = L.unlines `eq` (unpackS . T.unlines . map packS)
596−tl_unlines = L.unlines `eq` (unpackS . TL.unlines . map packS)
597−t_unwords = L.unwords `eq` (unpackS . T.unwords . map packS)
598−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)
599645
600646s_isPrefixOf s = L.isPrefixOf s `eqP`
601647 (S.isPrefixOf (S.stream $ packS s) . S.stream)
@@ -672,8 +718,9 @@ t_indices (NotEmpty s) = Slow.indices s `eq` indices s
672718tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
673719 where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)
674720 conc = T.concat . TL.toChunks
675−t_indices_occurs (NotEmpty t) ts = let s = T.intercalate t ts
676− 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
677724
678725-- Bit shifts.
679726shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
@@ -709,6 +756,7 @@ tb_decimal :: (Integral a, Show a) => a -> Bool
709756tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)
710757
711758tb_decimal_integer (a::Integer) = tb_decimal a
759+tb_decimal_integer_big (Big a) = tb_decimal a
712760tb_decimal_int (a::Int) = tb_decimal a
713761tb_decimal_int8 (a::Int8) = tb_decimal a
714762tb_decimal_int16 (a::Int16) = tb_decimal a
@@ -720,6 +768,11 @@ tb_decimal_word16 (a::Word16) = tb_decimal a
720768tb_decimal_word32 (a::Word32) = tb_decimal a
721769tb_decimal_word64 (a::Word64) = tb_decimal a
722770
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+
723776tb_hex :: (Integral a, Show a) => a -> Bool
724777tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")
725778
@@ -741,6 +794,21 @@ tb_realfloat = (TB.toLazyText . TB.realFloat) `eq` (TL.pack . show)
741794tb_realfloat_float (a::Float) = tb_realfloat a
742795tb_realfloat_double (a::Double) = tb_realfloat a
743796
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+
744812-- Reading.
745813
746814t_decimal (n::Int) s =
@@ -749,16 +817,18 @@ t_decimal (n::Int) s =
749817tl_decimal (n::Int) s =
750818 TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
751819 where t = TL.dropWhile isDigit s
752−t_hexadecimal (n::Positive Int) s ox =
820+t_hexadecimal m s ox =
753821 T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
754822 where t = T.dropWhile isHexDigit s
755823 p = if ox then "0x" else ""
756−tl_hexadecimal (n::Positive Int) s ox =
824+ n = getPositive m :: Int
825+tl_hexadecimal m s ox =
757826 TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
758827 where t = TL.dropWhile isHexDigit s
759828 p = if ox then "0x" else ""
829+ n = getPositive m :: Int
760830
761−isFloaty c = c `elem` "+-.0123456789eE"
831+isFloaty c = c `elem` ("+-.0123456789eE" :: String)
762832
763833t_read_rational p tol (n::Double) s =
764834 case p (T.pack (show n) `T.append` t) of
@@ -1040,9 +1110,12 @@ tests =
10401110 ],
10411111
10421112 testGroup "unfolds" [
1113+ testProperty "tl_repeat" tl_repeat,
10431114 testProperty "s_replicate" s_replicate,
10441115 testProperty "t_replicate" t_replicate,
10451116 testProperty "tl_replicate" tl_replicate,
1117+ testProperty "tl_cycle" tl_cycle,
1118+ testProperty "tl_iterate" tl_iterate,
10461119 testProperty "t_unfoldr" t_unfoldr,
10471120 testProperty "tl_unfoldr" tl_unfoldr,
10481121 testProperty "t_unfoldrN" t_unfoldrN,
@@ -1056,12 +1129,16 @@ tests =
10561129 testProperty "s_take_s" s_take_s,
10571130 testProperty "sf_take" sf_take,
10581131 testProperty "t_take" t_take,
1132+ testProperty "t_takeEnd" t_takeEnd,
10591133 testProperty "tl_take" tl_take,
1134+ testProperty "tl_takeEnd" tl_takeEnd,
10601135 testProperty "s_drop" s_drop,
10611136 testProperty "s_drop_s" s_drop_s,
10621137 testProperty "sf_drop" sf_drop,
10631138 testProperty "t_drop" t_drop,
1139+ testProperty "t_dropEnd" t_dropEnd,
10641140 testProperty "tl_drop" tl_drop,
1141+ testProperty "tl_dropEnd" tl_dropEnd,
10651142 testProperty "s_take_drop" s_take_drop,
10661143 testProperty "s_take_drop_s" s_take_drop_s,
10671144 testProperty "s_takeWhile" s_takeWhile,
@@ -1069,6 +1146,8 @@ tests =
10691146 testProperty "sf_takeWhile" sf_takeWhile,
10701147 testProperty "t_takeWhile" t_takeWhile,
10711148 testProperty "tl_takeWhile" tl_takeWhile,
1149+ testProperty "t_takeWhileEnd" t_takeWhileEnd,
1150+ testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
10721151 testProperty "sf_dropWhile" sf_dropWhile,
10731152 testProperty "s_dropWhile" s_dropWhile,
10741153 testProperty "s_dropWhile_s" s_dropWhile_s,
@@ -1214,11 +1293,16 @@ tests =
12141293 testProperty "tb_decimal_int32" tb_decimal_int32,
12151294 testProperty "tb_decimal_int64" tb_decimal_int64,
12161295 testProperty "tb_decimal_integer" tb_decimal_integer,
1296+ testProperty "tb_decimal_integer_big" tb_decimal_integer_big,
12171297 testProperty "tb_decimal_word" tb_decimal_word,
12181298 testProperty "tb_decimal_word8" tb_decimal_word8,
12191299 testProperty "tb_decimal_word16" tb_decimal_word16,
12201300 testProperty "tb_decimal_word32" tb_decimal_word32,
1221− 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
12221306 ],
12231307 testGroup "hexadecimal" [
12241308 testProperty "tb_hexadecimal_int" tb_hexadecimal_int,
@@ -1235,7 +1319,9 @@ tests =
12351319 ],
12361320 testGroup "realfloat" [
12371321 testProperty "tb_realfloat_double" tb_realfloat_double,
1238− 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
12391325 ],
12401326 testProperty "tb_fromText" tb_fromText,
12411327 testProperty "tb_singleton" tb_singleton
@@ -1271,5 +1357,7 @@ tests =
12711357 testProperty "t_take_drop_16" t_take_drop_16,
12721358 testProperty "t_use_from" t_use_from,
12731359 testProperty "t_copy" t_copy
1274− ]
1360+ ],
1361+
1362+ testGroup "mul" Mul.tests
12751363 ]
tests/Tests/Properties/Mul.hsnew file+40
@@ -0,0 +1,40 @@
1+{-# LANGUAGE ScopedTypeVariables #-}
2+
3+module Tests.Properties.Mul (tests) where
4+
5+import Control.Applicative ((<$>), pure)
6+import Control.Exception as E (SomeException, catch, evaluate)
7+import Data.Int (Int32, Int64)
8+import Data.Text.Internal (mul, mul32, mul64)
9+import System.IO.Unsafe (unsafePerformIO)
10+import Test.Framework (Test)
11+import Test.Framework.Providers.QuickCheck2 (testProperty)
12+import Test.QuickCheck hiding ((.&.))
13+
14+mulRef :: (Integral a, Bounded a) => a -> a -> Maybe a
15+mulRef a b
16+ | ab < bot || ab > top = Nothing
17+ | otherwise = Just (fromIntegral ab)
18+ where ab = fromIntegral a * fromIntegral b
19+ top = fromIntegral (maxBound `asTypeOf` a) :: Integer
20+ bot = fromIntegral (minBound `asTypeOf` a) :: Integer
21+
22+eval :: (a -> b -> c) -> a -> b -> Maybe c
23+eval f a b = unsafePerformIO $
24+ (Just <$> evaluate (f a b)) `E.catch` (\(_::SomeException) -> pure Nothing)
25+
26+t_mul32 :: Int32 -> Int32 -> Property
27+t_mul32 a b = mulRef a b === eval mul32 a b
28+
29+t_mul64 :: Int64 -> Int64 -> Property
30+t_mul64 a b = mulRef a b === eval mul64 a b
31+
32+t_mul :: Int -> Int -> Property
33+t_mul a b = mulRef a b === eval mul a b
34+
35+tests :: [Test]
36+tests = [
37+ testProperty "t_mul" t_mul
38+ , testProperty "t_mul32" t_mul32
39+ , testProperty "t_mul64" t_mul64
40+ ]
tests/Tests/QuickCheckUtils.hs+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 ((.&.))
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.confignew file+6
@@ -0,0 +1,6 @@
1+-- These flags help to speed up building the test suite.
2+
3+documentation: False
4+executable-stripping: False
5+flags: developer
6+library-profiling: False
tests/literal-rule-test.shnew file+29
@@ -0,0 +1,29 @@
1+#!/bin/bash -e
2+
3+failed=0
4+
5+function check_firings() {
6+ rule=$1
7+ expected=$2
8+ build="ghc -O -ddump-rule-firings LiteralRuleTest.hs"
9+ build="$build -i.. -I../include"
10+ touch LiteralRuleTest.hs
11+ echo -n "Want to see $expected firings of rule $rule... " >&2
12+ firings=$($build 2>&1 | grep "Rule fired: $rule\$" | wc -l)
13+ rm -f LiteralRuleTest.{o.hi}
14+
15+ if [ $firings != $expected ]; then
16+ echo "failed, saw $firings" >&2
17+ failed=1
18+ else
19+ echo "pass" >&2
20+ fi
21+}
22+
23+check_firings "TEXT literal" 8
24+check_firings "TEXT literal UTF8" 7
25+check_firings "TEXT empty literal" 4
26+# This is broken at the moment. "TEXT literal" rule fires instead.
27+#check_firings "TEXT singleton literal" 5
28+
29+exit $failed
tests/text-tests.cabal+18−3
@@ -2,8 +2,8 @@ name: text-tests
22version: 0.0.0.0
33synopsis: Functional tests for the text package
44description: Functional tests for the text package
5−homepage: https://bitbucket.org/bos/text
6−license: BSD3
5+homepage: https://github.com/bos/text
6+license: BSD2
77license-file: ../LICENSE
88author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
99 Bryan O'Sullivan <bos@serpentine.com>,
@@ -18,10 +18,20 @@ cabal-version: >=1.8
1818flag hpc
1919 description: Enable HPC to generate coverage reports
2020 default: False
21+ manual: True
2122
2223executable text-tests
2324 main-is: Tests.hs
2425
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+
2535 ghc-options:
2636 -Wall -threaded -O0 -rtsopts
2737
@@ -36,11 +46,12 @@ executable text-tests
3646
3747 build-depends:
3848 HUnit >= 1.2,
39− QuickCheck >= 2.4,
49+ QuickCheck >= 2.7,
4050 base == 4.*,
4151 bytestring,
4252 deepseq,
4353 directory,
54+ quickcheck-unicode,
4455 random,
4556 test-framework >= 0.4,
4657 test-framework-hunit >= 0.2,
@@ -66,6 +77,7 @@ library
6677 hs-source-dirs: ..
6778 c-sources: ../cbits/cbits.c
6879 include-dirs: ../include
80+ ghc-options: -Wall
6981 exposed-modules:
7082 Data.Text
7183 Data.Text.Array
@@ -102,6 +114,8 @@ library
102114 Data.Text.Internal.Lazy.Search
103115 Data.Text.Internal.Private
104116 Data.Text.Read
117+ Data.Text.Show
118+ Data.Text.Internal.Read
105119 Data.Text.Internal.Search
106120 Data.Text.Unsafe
107121 Data.Text.Internal.Unsafe
@@ -122,6 +136,7 @@ library
122136 build-depends:
123137 array,
124138 base == 4.*,
139+ binary,
125140 bytestring,
126141 deepseq,
127142 ghc-prim,
text.cabal+29−8
@@ -1,5 +1,5 @@
11name: text
2−version: 1.1.0.1
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>
@@ -51,7 +51,7 @@ extra-source-files:
5151 benchmarks/python/*.py
5252 benchmarks/ruby/*.rb
5353 benchmarks/text-benchmarks.cabal
54− changelog
54+ changelog.md
5555 include/*.h
5656 scripts/*.hs
5757 tests-and-benchmarks.markdown
@@ -59,16 +59,25 @@ extra-source-files:
5959 tests/.ghci
6060 tests/Makefile
6161 tests/Tests/*.hs
62+ tests/Tests/Properties/*.hs
63+ tests/cabal.config
6264 tests/scripts/*.sh
6365 tests/text-tests.cabal
6466
67+flag bytestring-builder
68+ description: Depend on the bytestring-builder package for backwards compatibility.
69+ default: False
70+ manual: False
71+
6572flag developer
6673 description: operate in developer mode
6774 default: False
75+ manual: True
6876
6977flag integer-simple
7078 description: Use the simple integer library instead of GMP
7179 default: False
80+ manual: False
7281
7382library
7483 c-sources: cbits/cbits.c
@@ -119,16 +128,21 @@ library
119128 Data.Text.Read
120129 Data.Text.Unsafe
121130
131+ other-modules:
132+ Data.Text.Show
133+
122134 build-depends:
123135 array >= 0.3,
124136 base >= 4.2 && < 5,
137+ binary,
125138 deepseq >= 1.1.0.0,
126139 ghc-prim >= 0.2
127140
128− if impl(ghc >= 7.7)
129− 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
130144 else
131− build-depends: bytestring >= 0.9
145+ build-depends: bytestring >= 0.10.4
132146
133147 cpp-options: -DHAVE_DEEPSEQ
134148 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
@@ -159,18 +173,25 @@ test-suite tests
159173
160174 build-depends:
161175 HUnit >= 1.2,
162− QuickCheck >= 2.4,
176+ QuickCheck >= 2.7,
163177 array,
164178 base,
165− bytestring,
179+ binary,
166180 deepseq,
167181 directory,
168182 ghc-prim,
183+ quickcheck-unicode,
169184 random,
170185 test-framework >= 0.4,
171186 test-framework-hunit >= 0.2,
172187 test-framework-quickcheck2 >= 0.2
173188
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+
174195 if flag(integer-simple)
175196 cpp-options: -DINTEGER_SIMPLE
176197 build-depends: integer-simple >= 0.1 && < 0.5