on master help sign in
.gitignore+1
since splitsnapshots
unifiedsplit
@@ -1,2 +1,3 @@
1dist
1dist
2cabal-dev
2cabal-dev
3+cabal.sandbox.config
.hgtags+18
@@ -46,3 +46,21 @@ d99cd091cdf71ce807a4255f6cc509c3154f51ea 0.11.3.1
467cba97c86467c1881dfced68613891f3c65561b0 1.0.0.1
467cba97c86467c1881dfced68613891f3c65561b0 1.0.0.1
4762674a9bbc83145d1d7be28a05d456ab6bb5ff89 1.1.0.0
4762674a9bbc83145d1d7be28a05d456ab6bb5ff89 1.1.0.0
4868a32d80c0829da164d1e6b3acedcc3efeda0957 1.1.0.1
4868a32d80c0829da164d1e6b3acedcc3efeda0957 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 @@
3#if __GLASGOW_HASKELL__ >= 702
3#if __GLASGOW_HASKELL__ >= 702
4{-# LANGUAGE Trustworthy #-}
4{-# LANGUAGE Trustworthy #-}
5#endif
5#endif
6+#if __GLASGOW_HASKELL__ >= 708
7+{-# LANGUAGE TypeFamilies #-}
8+#endif
6
9
7-- |
10-- |
8-- Module : Data.Text
11-- Module : Data.Text
@@ -29,8 +32,8 @@
29--
32--
30-- To use an extended and very rich family of functions for working
33-- To use an extended and very rich family of functions for working
31-- with Unicode text (including normalization, regular expressions,
34-- with Unicode text (including normalization, regular expressions,
32−-- non-standard encodings, text breaking, and locales), see the
35+-- non-standard encodings, text breaking, and locales), see
33−-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>
36+-- <http://hackage.haskell.org/package/text-icu the text-icu package >.
34
37
35module Data.Text
38module Data.Text
36 (
39 (
@@ -122,8 +125,11 @@ module Data.Text
122
125
123 -- ** Breaking strings
126 -- ** Breaking strings
124 , take
127 , take
128+ , takeEnd
125 , drop
129 , drop
130+ , dropEnd
126 , takeWhile
131 , takeWhile
132+ , takeWhileEnd
127 , dropWhile
133 , dropWhile
128 , dropWhileEnd
134 , dropWhileEnd
129 , dropAround
135 , dropAround
@@ -186,35 +192,43 @@ module Data.Text
186
192
187 -- * Low level operations
193 -- * Low level operations
188 , copy
194 , copy
195+ , unpackCString#
189 ) where
196 ) where
190
197
191import Prelude (Char, Bool(..), Int, Maybe(..), String,
198import Prelude (Char, Bool(..), Int, Maybe(..), String,
192 Eq(..), Ord(..), Ordering(..), (++),
199 Eq(..), Ord(..), Ordering(..), (++),
193− Read(..), Show(..),
200+ Read(..),
194− (&&), (||), (+), (-), (.), ($), ($!), (>>), (*),
201+ (&&), (||), (+), (-), (.), ($), ($!), (>>),
195− maxBound, not, return, otherwise, quot)
202+ not, return, otherwise, quot)
196#if defined(HAVE_DEEPSEQ)
203#if defined(HAVE_DEEPSEQ)
197−import Control.DeepSeq (NFData)
204+import Control.DeepSeq (NFData(rnf))
198#endif
205#endif
199#if defined(ASSERTS)
206#if defined(ASSERTS)
200import Control.Exception (assert)
207import Control.Exception (assert)
201#endif
208#endif
202import Data.Char (isSpace)
209import Data.Char (isSpace)
203−import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))
210+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
204−import Data.Data (mkNoRepType)
211+ Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
205import Control.Monad (foldM)
212import Control.Monad (foldM)
213+import Control.Monad.ST (ST)
206import qualified Data.Text.Array as A
214import qualified Data.Text.Array as A
207import qualified Data.List as L
215import qualified Data.List as L
216+import Data.Binary (Binary(get, put))
208import Data.Monoid (Monoid(..))
217import Data.Monoid (Monoid(..))
218+#if MIN_VERSION_base(4,9,0)
219+import Data.Semigroup (Semigroup(..))
220+#endif
209import Data.String (IsString(..))
221import Data.String (IsString(..))
210import qualified Data.Text.Internal.Fusion as S
222import qualified Data.Text.Internal.Fusion as S
211import qualified Data.Text.Internal.Fusion.Common as S
223import qualified Data.Text.Internal.Fusion.Common as S
224+import Data.Text.Encoding (decodeUtf8', encodeUtf8)
212import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
225import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
213import Data.Text.Internal.Private (span_)
226import Data.Text.Internal.Private (span_)
214−import Data.Text.Internal (Text(..), empty, firstf, safe, text, textP)
227+import Data.Text.Internal (Text(..), empty, firstf, mul, safe, text)
228+import Data.Text.Show (singleton, unpack, unpackCString#)
215import qualified Prelude as P
229import qualified Prelude as P
216import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
230import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
217− unsafeHead, unsafeTail)
231+ reverseIter_, unsafeHead, unsafeTail)
218import Data.Text.Internal.Unsafe.Char (unsafeChr)
232import Data.Text.Internal.Unsafe.Char (unsafeChr)
219import qualified Data.Text.Internal.Functions as F
233import qualified Data.Text.Internal.Functions as F
220import qualified Data.Text.Internal.Encoding.Utf16 as U16
234import qualified Data.Text.Internal.Encoding.Utf16 as U16
@@ -224,12 +238,13 @@ import Data.ByteString (ByteString)
224import qualified Data.Text.Lazy as L
238import qualified Data.Text.Lazy as L
225import Data.Int (Int64)
239import Data.Int (Int64)
226#endif
240#endif
241+import GHC.Base (eqInt, neInt, gtInt, geInt, ltInt, leInt)
227−#if __GLASGOW_HASKELL__ >= 702
242+#if __GLASGOW_HASKELL__ >= 708
228−import qualified GHC.CString as GHC
243+import qualified GHC.Exts as Exts
229−#else
244+#endif
230−import qualified GHC.Base as GHC
245+#if MIN_VERSION_base(4,7,0)
246+import Text.Printf (PrintfArg, formatArg, formatString)
231#endif
247#endif
232−import GHC.Prim (Addr#)
233
248
234-- $strict
249-- $strict
235--
250--
@@ -239,29 +254,32 @@ import GHC.Prim (Addr#)
239-- lazy @Text@ type consists of a list of strict chunks.
254-- lazy @Text@ type consists of a list of strict chunks.
240--
255--
241-- The strict 'Text' type requires that an entire string fit into
256-- The strict 'Text' type requires that an entire string fit into
242−-- memory at once. The lazy @Text@ type is capable of streaming
257+-- memory at once. The lazy 'Data.Text.Lazy.Text' type is capable of
243−-- strings that are larger than memory using a small memory footprint.
258+-- streaming strings that are larger than memory using a small memory
244−-- In many cases, the overhead of chunked streaming makes the lazy
259+-- footprint. In many cases, the overhead of chunked streaming makes
245−-- @Text@ type slower than its strict counterpart, but this is not
260+-- the lazy 'Data.Text.Lazy.Text' type slower than its strict
246−-- always the case. Sometimes, the time complexity of a function in
261+-- counterpart, but this is not always the case. Sometimes, the time
247−-- one module may be different from the other, due to their differing
262+-- complexity of a function in one module may be different from the
248−-- internal structures.
263+-- other, due to their differing internal structures.
249--
264--
250-- Each module provides an almost identical API, with the main
265-- Each module provides an almost identical API, with the main
251-- difference being that the strict module uses 'Int' values for
266-- difference being that the strict module uses 'Int' values for
252−-- lengths and counts, while the lazy module uses 'Int64' lengths.
267+-- lengths and counts, while the lazy module uses 'Data.Int.Int64'
268+-- lengths.
253
269
254-- $replacement
270-- $replacement
255--
271--
256-- A 'Text' value is a sequence of Unicode scalar values, as defined
272-- A 'Text' value is a sequence of Unicode scalar values, as defined
273+-- in
257−-- in &#xa7;3.9, definition D76 of the Unicode 5.2 standard:
274+-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35 §3.9, definition D76 of the Unicode 5.2 standard >.
258−-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35>. As
259−-- such, a 'Text' cannot contain values in the range U+D800 to U+DFFF
275+-- As such, a 'Text' cannot contain values in the range U+D800 to
260−-- inclusive. Haskell implementations admit all Unicode code points
276+-- U+DFFF inclusive. Haskell implementations admit all Unicode code
277+-- points
278+-- (<http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=13 §3.4, definition D10 >)
261−-- (&#xa7;3.4, definition D10) as 'Char' values, including code points
279+-- as 'Char' values, including code points from this invalid range.
262−-- from this invalid range. This means that there are some 'Char'
280+-- This means that there are some 'Char' values that are not valid
263−-- values that are not valid Unicode scalar values, and the functions
281+-- Unicode scalar values, and the functions in this module must handle
264−-- in this module must handle those cases.
282+-- those cases.
265--
283--
266-- Within this module, many functions construct a 'Text' from one or
284-- Within this module, many functions construct a 'Text' from one or
267-- more 'Char' values. Those functions will substitute 'Char' values
285-- more 'Char' values. Those functions will substitute 'Char' values
@@ -275,8 +293,8 @@ import GHC.Prim (Addr#)
275-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate
293-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate
276-- code points, and so cannot be represented. The functions replace
294-- code points, and so cannot be represented. The functions replace
277-- invalid scalar values, instead of dropping them, as a security
295-- invalid scalar values, instead of dropping them, as a security
278−-- measure. For details, see Unicode Technical Report 36, &#xa7;3.5:
296+-- measure. For details, see
279−-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters>)
297+-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters Unicode Technical Report 36, §3.5 >.)
280
298
281-- $fusion
299-- $fusion
282--
300--
@@ -294,11 +312,11 @@ import GHC.Prim (Addr#)
294-- > countChars = T.length . T.toUpper . E.decodeUtf8
312-- > countChars = T.length . T.toUpper . E.decodeUtf8
295--
313--
296-- From the type signatures involved, this looks like it should
314-- From the type signatures involved, this looks like it should
297−-- allocate one 'ByteString' value, and two 'Text' values. However,
315+-- allocate one 'Data.ByteString.ByteString' value, and two 'Text'
298−-- when a module is compiled with optimisation enabled under GHC, the
316+-- values. However, when a module is compiled with optimisation
299−-- two intermediate 'Text' values will be optimised away, and the
317+-- enabled under GHC, the two intermediate 'Text' values will be
300−-- function will be compiled down to a single loop over the source
318+-- optimised away, and the function will be compiled down to a single
301−-- 'ByteString'.
319+-- loop over the source 'Data.ByteString.ByteString'.
302--
320--
303-- Functions that can be fused by the compiler are documented with the
321-- Functions that can be fused by the compiler are documented with the
304-- phrase \"Subject to fusion\".
322-- phrase \"Subject to fusion\".
@@ -312,41 +330,82 @@ instance Eq Text where
312instance Ord Text where
330instance Ord Text where
313 compare = compareText
331 compare = compareText
314
332
315−instance Show Text where
316− showsPrec p ps r = showsPrec p (unpack ps) r
317−
318instance Read Text where
333instance Read Text where
319 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
334 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
320
335
336+#if MIN_VERSION_base(4,9,0)
337+-- Semigroup orphan instances for older GHCs are provided by
338+-- 'semigroups` package
339+
340+instance Semigroup Text where
341+ (<>) = append
342+#endif
343+
321instance Monoid Text where
344instance Monoid Text where
322 mempty = empty
345 mempty = empty
346+#if MIN_VERSION_base(4,9,0)
347+ mappend = (<>) -- future-proof definition
348+#else
323 mappend = append
349 mappend = append
350+#endif
324 mconcat = concat
351 mconcat = concat
325
352
326instance IsString Text where
353instance IsString Text where
327 fromString = pack
354 fromString = pack
328
355
356+#if __GLASGOW_HASKELL__ >= 708
357+instance Exts.IsList Text where
358+ type Item Text = Char
359+ fromList = pack
360+ toList = unpack
361+#endif
362+
329#if defined(HAVE_DEEPSEQ)
363#if defined(HAVE_DEEPSEQ)
330−instance NFData Text
364+instance NFData Text where rnf !_ = ()
331#endif
365#endif
332
366
367+instance Binary Text where
368+ put t = put (encodeUtf8 t)
369+ get = do
370+ bs <- get
371+ case decodeUtf8' bs of
372+ P.Left exn -> P.fail (P.show exn)
373+ P.Right a -> P.return a
374+
333-- | This instance preserves data abstraction at the cost of inefficiency.
375-- | This instance preserves data abstraction at the cost of inefficiency.
334-- We omit reflection services for the sake of data abstraction.
376-- We omit reflection services for the sake of data abstraction.
335--
377--
336−-- This instance was created by copying the behavior of Data.Set and
378+-- This instance was created by copying the updated behavior of
379+-- @"Data.Set".@'Data.Set.Set' and @"Data.Map".@'Data.Map.Map'. If you
337−-- Data.Map. If you feel a mistake has been made, please feel free to
380+-- feel a mistake has been made, please feel free to submit
338−-- submit improvements.
381+-- improvements.
339--
382--
340−-- Original discussion is archived here:
383+-- The original discussion is archived here:
384+-- <http://groups.google.com/group/haskell-cafe/browse_thread/thread/b5bbb1b28a7e525d/0639d46852575b93 could we get a Data instance for Data.Text.Text? >
341--
385--
342−-- "could we get a Data instance for Data.Text.Text?"
386+-- The followup discussion that changed the behavior of 'Data.Set.Set'
343−-- http://groups.google.com/group/haskell-cafe/browse_thread/thread/b5bbb1b28a7e525d/0639d46852575b93
387+-- and 'Data.Map.Map' is archived here:
388+-- <http://markmail.org/message/trovdc6zkphyi3cr#query:+page:1+mid:a46der3iacwjcf6n+state:results Proposal: Allow gunfold for Data.Map, ... >
344
389
345instance Data Text where
390instance Data Text where
346 gfoldl f z txt = z pack `f` (unpack txt)
391 gfoldl f z txt = z pack `f` (unpack txt)
347− toConstr _ = P.error "Data.Text.Text.toConstr"
392+ toConstr _ = packConstr
393+ gunfold k z c = case constrIndex c of
394+ 1 -> k (z pack)
348− gunfold _ _ = P.error "Data.Text.Text.gunfold"
395+ _ -> P.error "gunfold"
349− dataTypeOf _ = mkNoRepType "Data.Text.Text"
396+ dataTypeOf _ = textDataType
397+
398+#if MIN_VERSION_base(4,7,0)
399+-- | Only defined for @base-4.7.0.0@ and later
400+instance PrintfArg Text where
401+ formatArg txt = formatString $ unpack txt
402+#endif
403+
404+packConstr :: Constr
405+packConstr = mkConstr textDataType "pack" [] Prefix
406+
407+textDataType :: DataType
408+textDataType = mkDataType "Data.Text.Text" [packConstr]
350
409
351-- | /O(n)/ Compare two 'Text' values lexicographically.
410-- | /O(n)/ Compare two 'Text' values lexicographically.
352compareText :: Text -> Text -> Ordering
411compareText :: Text -> Text -> Ordering
@@ -371,30 +430,6 @@ pack :: String -> Text
371pack = unstream . S.map safe . S.streamList
430pack = unstream . S.map safe . S.streamList
372{-# INLINE [1] pack #-}
431{-# INLINE [1] pack #-}
373
432
374−-- | /O(n)/ Convert a 'Text' into a 'String'. Subject to fusion.
375−unpack :: Text -> String
376−unpack = S.unstreamList . stream
377−{-# INLINE [1] unpack #-}
378−
379−-- | /O(n)/ Convert a literal string into a Text. Subject to fusion.
380−unpackCString# :: Addr# -> Text
381−unpackCString# addr# = unstream (S.streamCString# addr#)
382−{-# NOINLINE unpackCString# #-}
383−
384−{-# RULES "TEXT literal" forall a.
385− unstream (S.map safe (S.streamList (GHC.unpackCString# a)))
386− = unpackCString# a #-}
387−
388−{-# RULES "TEXT literal UTF8" forall a.
389− unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))
390− = unpackCString# a #-}
391−
392−-- | /O(1)/ Convert a character into a Text. Subject to fusion.
393−-- Performs replacement on invalid scalar values.
394−singleton :: Char -> Text
395−singleton = unstream . S.singleton . safe
396−{-# INLINE [1] singleton #-}
397−
398-- -----------------------------------------------------------------------------
433-- -----------------------------------------------------------------------------
399-- * Basic functions
434-- * Basic functions
400
435
@@ -425,6 +460,7 @@ append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
425 | otherwise = overflowError "append"
460 | otherwise = overflowError "append"
426 where
461 where
427 len = len1+len2
462 len = len1+len2
463+ x :: ST s (A.MArray s)
428 x = do
464 x = do
429 arr <- A.new len
465 arr <- A.new len
430 A.copyI arr 0 arr1 off1 len1
466 A.copyI arr 0 arr1 off1 len1
@@ -450,8 +486,8 @@ head t = S.head (stream t)
450uncons :: Text -> Maybe (Char, Text)
486uncons :: Text -> Maybe (Char, Text)
451uncons t@(Text arr off len)
487uncons t@(Text arr off len)
452 | len <= 0 = Nothing
488 | len <= 0 = Nothing
489+ | otherwise = Just $ let !(Iter c d) = iter t 0
453− | otherwise = Just (c, textP arr (off+d) (len-d))
490+ in (c, text arr (off+d) (len-d))
454− where Iter c d = iter t 0
455{-# INLINE [1] uncons #-}
491{-# INLINE [1] uncons #-}
456
492
457-- | Lifted from Control.Arrow and specialized.
493-- | Lifted from Control.Arrow and specialized.
@@ -481,7 +517,7 @@ last (Text arr off len)
481tail :: Text -> Text
517tail :: Text -> Text
482tail t@(Text arr off len)
518tail t@(Text arr off len)
483 | len <= 0 = emptyError "tail"
519 | len <= 0 = emptyError "tail"
484− | otherwise = textP arr (off+d) (len-d)
520+ | otherwise = text arr (off+d) (len-d)
485 where d = iter_ t 0
521 where d = iter_ t 0
486{-# INLINE [1] tail #-}
522{-# INLINE [1] tail #-}
487
523
@@ -496,8 +532,8 @@ tail t@(Text arr off len)
496-- be non-empty. Subject to fusion.
532-- be non-empty. Subject to fusion.
497init :: Text -> Text
533init :: Text -> Text
498init (Text arr off len) | len <= 0 = emptyError "init"
534init (Text arr off len) | len <= 0 = emptyError "init"
499− | n >= 0xDC00 && n <= 0xDFFF = textP arr off (len-2)
535+ | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)
500− | otherwise = textP arr off (len-1)
536+ | otherwise = text arr off (len-1)
501 where
537 where
502 n = A.unsafeIndex arr (off+len-1)
538 n = A.unsafeIndex arr (off+len-1)
503{-# INLINE [1] init #-}
539{-# INLINE [1] init #-}
@@ -536,7 +572,9 @@ isSingleton = S.isSingleton . stream
536-- Subject to fusion.
572-- Subject to fusion.
537length :: Text -> Int
573length :: Text -> Int
538length t = S.length (stream t)
574length t = S.length (stream t)
539−{-# INLINE length #-}
575+{-# INLINE [0] length #-}
576+-- length needs to be phased after the compareN/length rules otherwise
577+-- it may inline before the rules have an opportunity to fire.
540
578
541-- | /O(n)/ Compare the count of characters in a 'Text' to a number.
579-- | /O(n)/ Compare the count of characters in a 'Text' to a number.
542-- Subject to fusion.
580-- Subject to fusion.
@@ -555,32 +593,32 @@ compareLength t n = S.compareLengthI (stream t) n
555
593
556{-# RULES
594{-# RULES
557"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.
595"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.
558− (==) (length t) n = compareLength t n == EQ
596+ eqInt (length t) n = compareLength t n == EQ
559 #-}
597 #-}
560
598
561{-# RULES
599{-# RULES
562"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.
600"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.
563− (/=) (length t) n = compareLength t n /= EQ
601+ neInt (length t) n = compareLength t n /= EQ
564 #-}
602 #-}
565
603
566{-# RULES
604{-# RULES
567"TEXT <N/length -> compareLength/==LT" [~1] forall t n.
605"TEXT <N/length -> compareLength/==LT" [~1] forall t n.
568− (<) (length t) n = compareLength t n == LT
606+ ltInt (length t) n = compareLength t n == LT
569 #-}
607 #-}
570
608
571{-# RULES
609{-# RULES
572"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.
610"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.
573− (<=) (length t) n = compareLength t n /= GT
611+ leInt (length t) n = compareLength t n /= GT
574 #-}
612 #-}
575
613
576{-# RULES
614{-# RULES
577"TEXT >N/length -> compareLength/==GT" [~1] forall t n.
615"TEXT >N/length -> compareLength/==GT" [~1] forall t n.
578− (>) (length t) n = compareLength t n == GT
616+ gtInt (length t) n = compareLength t n == GT
579 #-}
617 #-}
580
618
581{-# RULES
619{-# RULES
582"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.
620"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.
583− (>=) (length t) n = compareLength t n /= LT
621+ geInt (length t) n = compareLength t n /= LT
584 #-}
622 #-}
585
623
586-- -----------------------------------------------------------------------------
624-- -----------------------------------------------------------------------------
@@ -611,22 +649,48 @@ reverse :: Text -> Text
611reverse t = S.reverse (stream t)
649reverse t = S.reverse (stream t)
612{-# INLINE reverse #-}
650{-# INLINE reverse #-}
613
651
614−-- | /O(m+n)/ Replace every occurrence of one substring with another.
652+-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
653+-- @haystack@ with @replacement@.
654+--
655+-- This function behaves as though it was defined as follows:
656+--
657+-- @
658+-- replace needle replacement haystack =
659+-- 'intercalate' replacement ('splitOn' needle haystack)
660+-- @
661+--
662+-- As this suggests, each occurrence is replaced exactly once. So if
663+-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
664+-- be replaced recursively:
665+--
666+-- > replace "oo" "foo" "oo" == "foo"
667+--
668+-- In cases where several instances of @needle@ overlap, only the
669+-- first one will be replaced:
670+--
671+-- > replace "ofo" "bar" "ofofo" == "barfo"
615--
672--
616-- In (unlikely) bad cases, this function's time complexity degrades
673-- In (unlikely) bad cases, this function's time complexity degrades
617-- towards /O(n*m)/.
674-- towards /O(n*m)/.
618−replace :: Text -> Text -> Text -> Text
675+replace :: Text
676+ -- ^ @needle@ to search for. If this string is empty, an
677+ -- error will occur.
678+ -> Text
679+ -- ^ @replacement@ to replace @needle@ with.
680+ -> Text
681+ -- ^ @haystack@ in which to search.
682+ -> Text
619replace needle@(Text _ _ neeLen)
683replace needle@(Text _ _ neeLen)
620 (Text repArr repOff repLen)
684 (Text repArr repOff repLen)
621 haystack@(Text hayArr hayOff hayLen)
685 haystack@(Text hayArr hayOff hayLen)
622 | neeLen == 0 = emptyError "replace"
686 | neeLen == 0 = emptyError "replace"
623 | L.null ixs = haystack
687 | L.null ixs = haystack
624 | len > 0 = Text (A.run x) 0 len
688 | len > 0 = Text (A.run x) 0 len
625− | len < 0 = overflowError "replace"
626 | otherwise = empty
689 | otherwise = empty
627 where
690 where
628 ixs = indices needle haystack
691 ixs = indices needle haystack
629− len = hayLen - (neeLen - repLen) * L.length ixs
692+ len = hayLen - (neeLen - repLen) `mul` L.length ixs
693+ x :: ST s (A.MArray s)
630 x = do
694 x = do
631 marr <- A.new len
695 marr <- A.new len
632 let loop (i:is) o d = do
696 let loop (i:is) o d = do
@@ -656,9 +720,8 @@ replace needle@(Text _ _ neeLen)
656-- /Note/: In some languages, case conversion is a locale- and
720-- /Note/: In some languages, case conversion is a locale- and
657-- context-dependent operation. The case conversion functions in this
721-- context-dependent operation. The case conversion functions in this
658-- module are /not/ locale sensitive. Programs that require locale
722-- module are /not/ locale sensitive. Programs that require locale
659−-- sensitivity should use appropriate versions of the case mapping
723+-- sensitivity should use appropriate versions of the
660−-- functions from the @text-icu@ package:
661−-- <http://hackage.haskell.org/package/text-icu>
724+-- <http://hackage.haskell.org/package/text-icu-0.6.3.7/docs/Data-Text-ICU.html#g:4 case mapping functions from the text-icu package >.
662
725
663-- | /O(n)/ Convert a string to folded case. Subject to fusion.
726-- | /O(n)/ Convert a string to folded case. Subject to fusion.
664--
727--
@@ -678,7 +741,7 @@ replace needle@(Text _ _ neeLen)
678-- instead of itself.
741-- instead of itself.
679toCaseFold :: Text -> Text
742toCaseFold :: Text -> Text
680toCaseFold t = unstream (S.toCaseFold (stream t))
743toCaseFold t = unstream (S.toCaseFold (stream t))
681−{-# INLINE [0] toCaseFold #-}
744+{-# INLINE toCaseFold #-}
682
745
683-- | /O(n)/ Convert a string to lower case, using simple case
746-- | /O(n)/ Convert a string to lower case, using simple case
684-- conversion. Subject to fusion.
747-- conversion. Subject to fusion.
@@ -838,6 +901,7 @@ concat ts = case ts' of
838 where
901 where
839 ts' = L.filter (not . null) ts
902 ts' = L.filter (not . null) ts
840 len = sumP "concat" $ L.map lengthWord16 ts'
903 len = sumP "concat" $ L.map lengthWord16 ts'
904+ go :: ST s (A.MArray s)
841 go = do
905 go = do
842 arr <- A.new len
906 arr <- A.new len
843 let step i (Text a o l) =
907 let step i (Text a o l) =
@@ -851,13 +915,13 @@ concatMap f = concat . foldr ((:) . f) []
851{-# INLINE concatMap #-}
915{-# INLINE concatMap #-}
852
916
853-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
917-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
854−-- 'Text' @t@ satisifes the predicate @p@. Subject to fusion.
918+-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
855any :: (Char -> Bool) -> Text -> Bool
919any :: (Char -> Bool) -> Text -> Bool
856any p t = S.any p (stream t)
920any p t = S.any p (stream t)
857{-# INLINE any #-}
921{-# INLINE any #-}
858
922
859-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
923-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
860−-- 'Text' @t@ satisify the predicate @p@. Subject to fusion.
924+-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
861all :: (Char -> Bool) -> Text -> Bool
925all :: (Char -> Bool) -> Text -> Bool
862all p t = S.all p (stream t)
926all p t = S.all p (stream t)
863{-# INLINE all #-}
927{-# INLINE all #-}
@@ -948,10 +1012,10 @@ replicate n t@(Text a o l)
948 | n <= 0 || l <= 0 = empty
1012 | n <= 0 || l <= 0 = empty
949 | n == 1 = t
1013 | n == 1 = t
950 | isSingleton t = replicateChar n (unsafeHead t)
1014 | isSingleton t = replicateChar n (unsafeHead t)
951− | n <= maxBound `quot` l = Text (A.run x) 0 len
1015+ | otherwise = Text (A.run x) 0 len
952− | otherwise = overflowError "replicate"
953 where
1016 where
954− len = l * n
1017+ len = l `mul` n
1018+ x :: ST s (A.MArray s)
955 x = do
1019 x = do
956 arr <- A.new len
1020 arr <- A.new len
957 let loop !d !i | i >= n = return arr
1021 let loop !d !i | i >= n = return arr
@@ -1002,14 +1066,16 @@ take :: Int -> Text -> Text
1002take n t@(Text arr off len)
1066take n t@(Text arr off len)
1003 | n <= 0 = empty
1067 | n <= 0 = empty
1004 | n >= len = t
1068 | n >= len = t
1005− | otherwise = Text arr off (loop 0 0)
1069+ | otherwise = text arr off (iterN n t)
1006− where
1007− loop !i !cnt
1008− | i >= len || cnt >= n = i
1009− | otherwise = loop (i+d) (cnt+1)
1010− where d = iter_ t i
1011{-# INLINE [1] take #-}
1070{-# INLINE [1] take #-}
1012
1071
1072+iterN :: Int -> Text -> Int
1073+iterN n t@(Text _arr _off len) = loop 0 0
1074+ where loop !i !cnt
1075+ | i >= len || cnt >= n = i
1076+ | otherwise = loop (i+d) (cnt+1)
1077+ where d = iter_ t i
1078+
1013{-# RULES
1079{-# RULES
1014"TEXT take -> fused" [~1] forall n t.
1080"TEXT take -> fused" [~1] forall n t.
1015 take n t = unstream (S.take n (stream t))
1081 take n t = unstream (S.take n (stream t))
@@ -1017,6 +1083,27 @@ take n t@(Text arr off len)
1017 unstream (S.take n (stream t)) = take n t
1083 unstream (S.take n (stream t)) = take n t
1018 #-}
1084 #-}
1019
1085
1086+-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after
1087+-- taking @n@ characters from the end of @t@.
1088+--
1089+-- Examples:
1090+--
1091+-- > takeEnd 3 "foobar" == "bar"
1092+takeEnd :: Int -> Text -> Text
1093+takeEnd n t@(Text arr off len)
1094+ | n <= 0 = empty
1095+ | n >= len = t
1096+ | otherwise = text arr (off+i) (len-i)
1097+ where i = iterNEnd n t
1098+
1099+iterNEnd :: Int -> Text -> Int
1100+iterNEnd n t@(Text _arr _off len) = loop (len-1) n
1101+ where loop i !m
1102+ | i <= 0 = 0
1103+ | m <= 1 = i
1104+ | otherwise = loop (i+d) (m-1)
1105+ where d = reverseIter_ t i
1106+
1020-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1107-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1021-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1108-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1022-- is greater than the length of the 'Text'. Subject to fusion.
1109-- is greater than the length of the 'Text'. Subject to fusion.
@@ -1024,11 +1111,8 @@ drop :: Int -> Text -> Text
1024drop n t@(Text arr off len)
1111drop n t@(Text arr off len)
1025 | n <= 0 = t
1112 | n <= 0 = t
1026 | n >= len = empty
1113 | n >= len = empty
1027− | otherwise = loop 0 0
1114+ | otherwise = text arr (off+i) (len-i)
1028− where loop !i !cnt
1029− | i >= len || cnt >= n = Text arr (off+i) (len-i)
1030− | otherwise = loop (i+d) (cnt+1)
1031− where d = iter_ t i
1115+ where i = iterN n t
1032{-# INLINE [1] drop #-}
1116{-# INLINE [1] drop #-}
1033
1117
1034{-# RULES
1118{-# RULES
@@ -1038,6 +1122,18 @@ drop n t@(Text arr off len)
1038 unstream (S.drop n (stream t)) = drop n t
1122 unstream (S.drop n (stream t)) = drop n t
1039 #-}
1123 #-}
1040
1124
1125+-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after
1126+-- dropping @n@ characters from the end of @t@.
1127+--
1128+-- Examples:
1129+--
1130+-- > dropEnd 3 "foobar" == "foo"
1131+dropEnd :: Int -> Text -> Text
1132+dropEnd n t@(Text arr off len)
1133+ | n <= 0 = t
1134+ | n >= len = empty
1135+ | otherwise = text arr off (iterNEnd n t)
1136+
1041-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1137-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1042-- returns the longest prefix (possibly empty) of elements that
1138-- returns the longest prefix (possibly empty) of elements that
1043-- satisfy @p@. Subject to fusion.
1139-- satisfy @p@. Subject to fusion.
@@ -1045,7 +1141,7 @@ takeWhile :: (Char -> Bool) -> Text -> Text
1045takeWhile p t@(Text arr off len) = loop 0
1141takeWhile p t@(Text arr off len) = loop 0
1046 where loop !i | i >= len = t
1142 where loop !i | i >= len = t
1047 | p c = loop (i+d)
1143 | p c = loop (i+d)
1048− | otherwise = textP arr off i
1144+ | otherwise = text arr off i
1049 where Iter c d = iter t i
1145 where Iter c d = iter t i
1050{-# INLINE [1] takeWhile #-}
1146{-# INLINE [1] takeWhile #-}
1051
1147
@@ -1056,6 +1152,27 @@ takeWhile p t@(Text arr off len) = loop 0
1056 unstream (S.takeWhile p (stream t)) = takeWhile p t
1152 unstream (S.takeWhile p (stream t)) = takeWhile p t
1057 #-}
1153 #-}
1058
1154
1155+-- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',
1156+-- returns the longest suffix (possibly empty) of elements that
1157+-- satisfy @p@. Subject to fusion.
1158+-- Examples:
1159+--
1160+-- > takeWhileEnd (=='o') "foo" == "oo"
1161+takeWhileEnd :: (Char -> Bool) -> Text -> Text
1162+takeWhileEnd p t@(Text arr off len) = loop (len-1) len
1163+ where loop !i !l | l <= 0 = t
1164+ | p c = loop (i+d) (l+d)
1165+ | otherwise = text arr (off+l) (len-l)
1166+ where (c,d) = reverseIter t i
1167+{-# INLINE [1] takeWhileEnd #-}
1168+
1169+{-# RULES
1170+"TEXT takeWhileEnd -> fused" [~1] forall p t.
1171+ takeWhileEnd p t = S.reverse (S.takeWhile p (S.reverseStream t))
1172+"TEXT takeWhileEnd -> unfused" [1] forall p t.
1173+ S.reverse (S.takeWhile p (S.reverseStream t)) = takeWhileEnd p t
1174+ #-}
1175+
1059-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1176-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1060-- 'takeWhile' @p@ @t@. Subject to fusion.
1177-- 'takeWhile' @p@ @t@. Subject to fusion.
1061dropWhile :: (Char -> Bool) -> Text -> Text
1178dropWhile :: (Char -> Bool) -> Text -> Text
@@ -1074,8 +1191,9 @@ dropWhile p t@(Text arr off len) = loop 0 0
1074 #-}
1191 #-}
1075
1192
1076-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1193-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1077−-- dropping characters that fail the predicate @p@ from the end of
1194+-- dropping characters that satisfy the predicate @p@ from the end of
1078-- @t@. Subject to fusion.
1195-- @t@. Subject to fusion.
1196+--
1079-- Examples:
1197-- Examples:
1080--
1198--
1081-- > dropWhileEnd (=='.') "foo..." == "foo"
1199-- > dropWhileEnd (=='.') "foo..." == "foo"
@@ -1095,7 +1213,7 @@ dropWhileEnd p t@(Text arr off len) = loop (len-1) len
1095 #-}
1213 #-}
1096
1214
1097-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1215-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1098−-- dropping characters that fail the predicate @p@ from both the
1216+-- dropping characters that satisfy the predicate @p@ from both the
1099-- beginning and end of @t@. Subject to fusion.
1217-- beginning and end of @t@. Subject to fusion.
1100dropAround :: (Char -> Bool) -> Text -> Text
1218dropAround :: (Char -> Bool) -> Text -> Text
1101dropAround p = dropWhile p . dropWhileEnd p
1219dropAround p = dropWhile p . dropWhileEnd p
@@ -1130,13 +1248,8 @@ splitAt :: Int -> Text -> (Text, Text)
1130splitAt n t@(Text arr off len)
1248splitAt n t@(Text arr off len)
1131 | n <= 0 = (empty, t)
1249 | n <= 0 = (empty, t)
1132 | n >= len = (t, empty)
1250 | n >= len = (t, empty)
1133− | otherwise = (Text arr off k, Text arr (off+k) (len-k))
1251+ | otherwise = let k = iterN n t
1134− where k = loop 0 0
1252+ in (text arr off k, text arr (off+k) (len-k))
1135− loop !i !cnt
1136− | i >= len || cnt >= n = i
1137− | otherwise = loop (i+d) (cnt+1)
1138− where d = iter_ t i
1139−{-# INLINE splitAt #-}
1140
1253
1141-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
1254-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
1142-- a pair whose first element is the longest prefix (possibly empty)
1255-- a pair whose first element is the longest prefix (possibly empty)
@@ -1195,9 +1308,9 @@ tails t | null t = [empty]
1195-- copies to create substrings; they just construct new 'Text's that
1308-- copies to create substrings; they just construct new 'Text's that
1196-- are slices of the original.
1309-- are slices of the original.
1197
1310
1198−-- | /O(m+n)/ Break a 'Text' into pieces separated by the first
1311+-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'
1199−-- 'Text' argument, consuming the delimiter. An empty delimiter is
1312+-- argument (which cannot be empty), consuming the delimiter. An empty
1200−-- invalid, and will cause an error to be raised.
1313+-- delimiter is invalid, and will cause an error to be raised.
1201--
1314--
1202-- Examples:
1315-- Examples:
1203--
1316--
@@ -1210,16 +1323,23 @@ tails t | null t = [empty]
1210-- > intercalate s . splitOn s == id
1323-- > intercalate s . splitOn s == id
1211-- > splitOn (singleton c) == split (==c)
1324-- > splitOn (singleton c) == split (==c)
1212--
1325--
1326+-- (Note: the string @s@ to split on above cannot be empty.)
1327+--
1213-- In (unlikely) bad cases, this function's time complexity degrades
1328-- In (unlikely) bad cases, this function's time complexity degrades
1214-- towards /O(n*m)/.
1329-- towards /O(n*m)/.
1215−splitOn :: Text -> Text -> [Text]
1330+splitOn :: Text
1331+ -- ^ String to split on. If this string is empty, an error
1332+ -- will occur.
1333+ -> Text
1334+ -- ^ Input text.
1335+ -> [Text]
1216splitOn pat@(Text _ _ l) src@(Text arr off len)
1336splitOn pat@(Text _ _ l) src@(Text arr off len)
1217 | l <= 0 = emptyError "splitOn"
1337 | l <= 0 = emptyError "splitOn"
1218 | isSingleton pat = split (== unsafeHead pat) src
1338 | isSingleton pat = split (== unsafeHead pat) src
1219 | otherwise = go 0 (indices pat src)
1339 | otherwise = go 0 (indices pat src)
1220 where
1340 where
1221− go !s (x:xs) = textP arr (s+off) (x-s) : go (x+l) xs
1341+ go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs
1222− go s _ = [textP arr (s+off) (len-s)]
1342+ go s _ = [text arr (s+off) (len-s)]
1223{-# INLINE [1] splitOn #-}
1343{-# INLINE [1] splitOn #-}
1224
1344
1225{-# RULES
1345{-# RULES
@@ -1311,7 +1431,7 @@ breakOn pat src@(Text arr off len)
1311 | null pat = emptyError "breakOn"
1431 | null pat = emptyError "breakOn"
1312 | otherwise = case indices pat src of
1432 | otherwise = case indices pat src of
1313 [] -> (src, empty)
1433 [] -> (src, empty)
1314− (x:_) -> (textP arr off x, textP arr (off+x) (len-x))
1434+ (x:_) -> (text arr off x, text arr (off+x) (len-x))
1315{-# INLINE breakOn #-}
1435{-# INLINE breakOn #-}
1316
1436
1317-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
1437-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
@@ -1353,7 +1473,7 @@ breakOnAll pat src@(Text arr off slen)
1353 | otherwise = L.map step (indices pat src)
1473 | otherwise = L.map step (indices pat src)
1354 where
1474 where
1355 step x = (chunk 0 x, chunk x (slen-x))
1475 step x = (chunk 0 x, chunk x (slen-x))
1356− chunk !n !l = textP arr (n+off) l
1476+ chunk !n !l = text arr (n+off) l
1357{-# INLINE breakOnAll #-}
1477{-# INLINE breakOnAll #-}
1358
1478
1359-------------------------------------------------------------------------------
1479-------------------------------------------------------------------------------
@@ -1420,7 +1540,7 @@ countChar c t = S.countChar c (stream t)
1420-- equivalent to a pair of 'unpack' operations.
1540-- equivalent to a pair of 'unpack' operations.
1421zip :: Text -> Text -> [(Char,Char)]
1541zip :: Text -> Text -> [(Char,Char)]
1422zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1542zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1423−{-# INLINE [0] zip #-}
1543+{-# INLINE zip #-}
1424
1544
1425-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1545-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1426-- given as the first argument, instead of a tupling function.
1546-- given as the first argument, instead of a tupling function.
@@ -1428,7 +1548,7 @@ zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1428zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1548zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1429zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1549zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1430 where g a b = safe (f a b)
1550 where g a b = safe (f a b)
1431−{-# INLINE [0] zipWith #-}
1551+{-# INLINE zipWith #-}
1432
1552
1433-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1553-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1434-- representing white space.
1554-- representing white space.
@@ -1553,7 +1673,7 @@ isInfixOf needle haystack
1553-- > fnordLength _ = -1
1673-- > fnordLength _ = -1
1554stripPrefix :: Text -> Text -> Maybe Text
1674stripPrefix :: Text -> Text -> Maybe Text
1555stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1675stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1556− | p `isPrefixOf` t = Just $! textP arr (off+plen) (len-plen)
1676+ | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)
1557 | otherwise = Nothing
1677 | otherwise = Nothing
1558
1678
1559-- | /O(n)/ Find the longest non-empty common prefix of two strings
1679-- | /O(n)/ Find the longest non-empty common prefix of two strings
@@ -1573,8 +1693,8 @@ commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1573 where
1693 where
1574 go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1694 go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1575 | i > 0 = Just (Text arr0 off0 i,
1695 | i > 0 = Just (Text arr0 off0 i,
1576− textP arr0 (off0+i) (len0-i),
1696+ text arr0 (off0+i) (len0-i),
1577− textP arr1 (off1+j) (len1-j))
1697+ text arr1 (off1+j) (len1-j))
1578 | otherwise = Nothing
1698 | otherwise = Nothing
1579 where Iter a d0 = iter t0 i
1699 where Iter a d0 = iter t0 i
1580 Iter b d1 = iter t1 j
1700 Iter b d1 = iter t1 j
@@ -1599,7 +1719,7 @@ commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1599-- > quuxLength _ = -1
1719-- > quuxLength _ = -1
1600stripSuffix :: Text -> Text -> Maybe Text
1720stripSuffix :: Text -> Text -> Maybe Text
1601stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
1721stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
1602− | p `isSuffixOf` t = Just $! textP arr off (len-plen)
1722+ | p `isSuffixOf` t = Just $! text arr off (len-plen)
1603 | otherwise = Nothing
1723 | otherwise = Nothing
1604
1724
1605-- | Add a list of non-negative numbers. Errors out on overflow.
1725-- | Add a list of non-negative numbers. Errors out on overflow.
@@ -1628,6 +1748,7 @@ overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
1628copy :: Text -> Text
1748copy :: Text -> Text
1629copy (Text arr off len) = Text (A.run go) 0 len
1749copy (Text arr off len) = Text (A.run go) 0 len
1630 where
1750 where
1751+ go :: ST s (A.MArray s)
1631 go = do
1752 go = do
1632 marr <- A.new len
1753 marr <- A.new len
1633 A.copyI marr 0 arr off len
1754 A.copyI marr 0 arr off len
Data/Text/Array.hs+7−6
@@ -20,13 +20,13 @@
20-- > import qualified Data.Text.Array as A
20-- > import qualified Data.Text.Array as A
21--
21--
22-- The names in this module resemble those in the 'Data.Array' family
22-- The names in this module resemble those in the 'Data.Array' family
23−-- of modules, but are shorter due to the assumption of qualifid
23+-- of modules, but are shorter due to the assumption of qualified
24-- naming.
24-- naming.
25module Data.Text.Array
25module Data.Text.Array
26 (
26 (
27 -- * Types
27 -- * Types
28− Array(aBA)
28+ Array(Array, aBA)
29− , MArray(maBA)
29+ , MArray(MArray, maBA)
30
30
31 -- * Functions
31 -- * Functions
32 , copyM
32 , copyM
@@ -74,7 +74,7 @@ import Foreign.C.Types (CInt, CSize)
74#endif
74#endif
75import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
75import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
76 indexWord16Array#, newByteArray#,
76 indexWord16Array#, newByteArray#,
77− unsafeCoerce#, writeWord16Array#)
77+ unsafeFreezeByteArray#, writeWord16Array#)
78import GHC.ST (ST(..), runST)
78import GHC.ST (ST(..), runST)
79import GHC.Word (Word16(..))
79import GHC.Word (Word16(..))
80import Prelude hiding (length, read)
80import Prelude hiding (length, read)
@@ -130,8 +130,9 @@ array_size_error = error "Data.Text.Array.new: size overflow"
130
130
131-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
131-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
132unsafeFreeze :: MArray s -> ST s Array
132unsafeFreeze :: MArray s -> ST s Array
133−unsafeFreeze MArray{..} = ST $ \s# ->
133+unsafeFreeze MArray{..} = ST $ \s1# ->
134− (# s#, Array (unsafeCoerce# maBA)
134+ case unsafeFreezeByteArray# maBA s1# of
135+ (# s2#, ba# #) -> (# s2#, Array ba#
135#if defined(ASSERTS)
136#if defined(ASSERTS)
136 maLen
137 maLen
137#endif
138#endif
Data/Text/Encoding.hs+13−26
@@ -55,13 +55,9 @@ module Data.Text.Encoding
55 , encodeUtf32LE
55 , encodeUtf32LE
56 , encodeUtf32BE
56 , encodeUtf32BE
57
57
58−#if MIN_VERSION_bytestring(0,10,4)
59 -- * Encoding Text using ByteString Builders
58 -- * Encoding Text using ByteString Builders
60− -- | /Note/ that these functions are only available if built against
61− -- @bytestring >= 0.10.4.0@.
62 , encodeUtf8Builder
59 , encodeUtf8Builder
63 , encodeUtf8BuilderEscaped
60 , encodeUtf8BuilderEscaped
64−#endif
65 ) where
61 ) where
66
62
67#if __GLASGOW_HASKELL__ >= 702
63#if __GLASGOW_HASKELL__ >= 702
@@ -70,26 +66,17 @@ import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
70import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)
66import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)
71#endif
67#endif
72
68
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−
83import Control.Exception (evaluate, try)
69import Control.Exception (evaluate, try)
84import Control.Monad.ST (runST)
70import Control.Monad.ST (runST)
71+import Data.Bits ((.&.))
85import Data.ByteString as B
72import Data.ByteString as B
86import Data.ByteString.Internal as B hiding (c2w)
73import Data.ByteString.Internal as B hiding (c2w)
87−import Data.Text ()
88import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
74import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
89−import Data.Text.Internal (Text(..), safe, textP)
75+import Data.Text.Internal (Text(..), safe, text)
90import Data.Text.Internal.Private (runText)
76import Data.Text.Internal.Private (runText)
91−import Data.Text.Internal.Unsafe.Char (unsafeWrite)
77+import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
92import Data.Text.Internal.Unsafe.Shift (shiftR)
78import Data.Text.Internal.Unsafe.Shift (shiftR)
79+import Data.Text.Show ()
93import Data.Text.Unsafe (unsafeDupablePerformIO)
80import Data.Text.Unsafe (unsafeDupablePerformIO)
94import Data.Word (Word8, Word32)
81import Data.Word (Word8, Word32)
95import Foreign.C.Types (CSize(..))
82import Foreign.C.Types (CSize(..))
@@ -98,8 +85,13 @@ import Foreign.Marshal.Utils (with)
98import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
85import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
99import Foreign.Storable (Storable, peek, poke)
86import Foreign.Storable (Storable, peek, poke)
100import GHC.Base (ByteArray#, MutableByteArray#)
87import GHC.Base (ByteArray#, MutableByteArray#)
88+import qualified Data.ByteString.Builder as B
89+import qualified Data.ByteString.Builder.Internal as B hiding (empty, append)
90+import qualified Data.ByteString.Builder.Prim as BP
91+import qualified Data.ByteString.Builder.Prim.Internal as BP
101import qualified Data.Text.Array as A
92import qualified Data.Text.Array as A
102import qualified Data.Text.Internal.Encoding.Fusion as E
93import qualified Data.Text.Internal.Encoding.Fusion as E
94+import qualified Data.Text.Internal.Encoding.Utf16 as U16
103import qualified Data.Text.Internal.Fusion as F
95import qualified Data.Text.Internal.Fusion as F
104
96
105#include "text_cbits.h"
97#include "text_cbits.h"
@@ -119,8 +111,6 @@ import qualified Data.Text.Internal.Fusion as F
119
111
120-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
112-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
121-- encoded text.
113-- encoded text.
122−--
123−-- This function is deprecated. Use 'decodeLatin1' instead.
124decodeASCII :: ByteString -> Text
114decodeASCII :: ByteString -> Text
125decodeASCII = decodeUtf8
115decodeASCII = decodeUtf8
126{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
116{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
@@ -130,7 +120,7 @@ decodeASCII = decodeUtf8
130-- 'decodeLatin1' is semantically equivalent to
120-- 'decodeLatin1' is semantically equivalent to
131-- @Data.Text.pack . Data.ByteString.Char8.unpack@
121-- @Data.Text.pack . Data.ByteString.Char8.unpack@
132decodeLatin1 :: ByteString -> Text
122decodeLatin1 :: ByteString -> Text
133−decodeLatin1 (PS fp off len) = textP a 0 len
123+decodeLatin1 (PS fp off len) = text a 0 len
134 where
124 where
135 a = A.run (A.new len >>= unsafeIOToST . go)
125 a = A.run (A.new len >>= unsafeIOToST . go)
136 go dest = withForeignPtr fp $ \ptr -> do
126 go dest = withForeignPtr fp $ \ptr -> do
@@ -269,6 +259,7 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
269 UTF8_REJECT -> do
259 UTF8_REJECT -> do
270 -- We encountered an encoding error
260 -- We encountered an encoding error
271 x <- peek curPtr'
261 x <- peek curPtr'
262+ poke statePtr 0
272 case onErr desc (Just x) of
263 case onErr desc (Just x) of
273 Nothing -> loop $ curPtr' `plusPtr` 1
264 Nothing -> loop $ curPtr' `plusPtr` 1
274 Just c -> do
265 Just c -> do
@@ -276,7 +267,6 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
276 w <- unsafeSTToIO $
267 w <- unsafeSTToIO $
277 unsafeWrite dest (fromIntegral destOff) (safe c)
268 unsafeWrite dest (fromIntegral destOff) (safe c)
278 poke destOffPtr (destOff + fromIntegral w)
269 poke destOffPtr (destOff + fromIntegral w)
279− poke statePtr 0
280 loop $ curPtr' `plusPtr` 1
270 loop $ curPtr' `plusPtr` 1
281
271
282 _ -> do
272 _ -> do
@@ -285,10 +275,10 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
285 codepoint <- peek codepointPtr
275 codepoint <- peek codepointPtr
286 chunkText <- unsafeSTToIO $ do
276 chunkText <- unsafeSTToIO $ do
287 arr <- A.unsafeFreeze dest
277 arr <- A.unsafeFreeze dest
288− return $! textP arr 0 (fromIntegral n)
278+ return $! text arr 0 (fromIntegral n)
289 lastPtr <- peek curPtrPtr
279 lastPtr <- peek curPtrPtr
290 let left = lastPtr `minusPtr` curPtr
280 let left = lastPtr `minusPtr` curPtr
291− undecoded = case state of
281+ !undecoded = case state of
292 UTF8_ACCEPT -> B.empty
282 UTF8_ACCEPT -> B.empty
293 _ -> B.append undecoded0 (B.drop left bs)
283 _ -> B.append undecoded0 (B.drop left bs)
294 return $ Some chunkText undecoded
284 return $ Some chunkText undecoded
@@ -317,8 +307,6 @@ decodeUtf8' :: ByteString -> Either UnicodeException Text
317decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode
307decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode
318{-# INLINE decodeUtf8' #-}
308{-# INLINE decodeUtf8' #-}
319
309
320−#if MIN_VERSION_bytestring(0,10,4)
321−
322-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
310-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
323encodeUtf8Builder :: Text -> B.Builder
311encodeUtf8Builder :: Text -> B.Builder
324encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
312encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
@@ -379,7 +367,6 @@ encodeUtf8BuilderEscaped be =
379 outerLoop i (B.BufferRange op ope)
367 outerLoop i (B.BufferRange op ope)
380 where
368 where
381 poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)
369 poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)
382−#endif
383
370
384-- | Encode text using UTF-8 encoding.
371-- | Encode text using UTF-8 encoding.
385encodeUtf8 :: Text -> ByteString
372encodeUtf8 :: Text -> ByteString
Data/Text/Encoding/Error.hs+7−1
@@ -1,5 +1,7 @@
1{-# LANGUAGE CPP, DeriveDataTypeable #-}
1{-# LANGUAGE CPP, DeriveDataTypeable #-}
2−#if __GLASGOW_HASKELL__ >= 702
2+#if __GLASGOW_HASKELL__ >= 704
3+{-# LANGUAGE Safe #-}
4+#elif __GLASGOW_HASKELL__ >= 702
3{-# LANGUAGE Trustworthy #-}
5{-# LANGUAGE Trustworthy #-}
4#endif
6#endif
5-- |
7-- |
@@ -66,6 +68,7 @@ type OnError a b = String -> Maybe a -> Maybe b
66type OnDecodeError = OnError Word8 Char
68type OnDecodeError = OnError Word8 Char
67
69
68-- | A handler for an encoding error.
70-- | A handler for an encoding error.
71+{-# DEPRECATED OnEncodeError "This exception is never used in practice, and will be removed." #-}
69type OnEncodeError = OnError Char Word8
72type OnEncodeError = OnError Char Word8
70
73
71-- | An exception type for representing Unicode encoding errors.
74-- | An exception type for representing Unicode encoding errors.
@@ -78,6 +81,8 @@ data UnicodeException =
78 -- under the given encoding, or ran out of input in mid-encode.
81 -- under the given encoding, or ran out of input in mid-encode.
79 deriving (Eq, Typeable)
82 deriving (Eq, Typeable)
80
83
84+{-# DEPRECATED EncodeError "This constructor is never used, and will be removed." #-}
85+
81showUnicodeException :: UnicodeException -> String
86showUnicodeException :: UnicodeException -> String
82showUnicodeException (DecodeError desc (Just w))
87showUnicodeException (DecodeError desc (Just w))
83 = "Cannot decode byte '\\x" ++ showHex w ("': " ++ desc)
88 = "Cannot decode byte '\\x" ++ showHex w ("': " ++ desc)
@@ -107,6 +112,7 @@ lenientDecode :: OnDecodeError
107lenientDecode _ _ = Just '\xfffd'
112lenientDecode _ _ = Just '\xfffd'
108
113
109-- | Throw a 'UnicodeException' if encoding fails.
114-- | Throw a 'UnicodeException' if encoding fails.
115+{-# DEPRECATED strictEncode "This function always throws an exception, and will be removed." #-}
110strictEncode :: OnEncodeError
116strictEncode :: OnEncodeError
111strictEncode desc c = throw (EncodeError desc c)
117strictEncode desc c = throw (EncodeError desc c)
112
118
Data/Text/Internal.hs+74−10
@@ -1,4 +1,4 @@
1−{-# LANGUAGE CPP, DeriveDataTypeable #-}
1+{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples #-}
2{-# OPTIONS_HADDOCK not-home #-}
2{-# OPTIONS_HADDOCK not-home #-}
3
3
4-- |
4-- |
@@ -20,6 +20,10 @@
20-- with the internals, as the functions here do just about nothing to
20-- with the internals, as the functions here do just about nothing to
21-- preserve data invariants. You have been warned!
21-- preserve data invariants. You have been warned!
22
22
23+#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
24+#include "MachDeps.h"
25+#endif
26+
23module Data.Text.Internal
27module Data.Text.Internal
24 (
28 (
25 -- * Types
29 -- * Types
@@ -32,8 +36,13 @@ module Data.Text.Internal
32 , safe
36 , safe
33 -- * Code that must be here for accessibility
37 -- * Code that must be here for accessibility
34 , empty
38 , empty
39+ , empty_
35 -- * Utilities
40 -- * Utilities
36 , firstf
41 , firstf
42+ -- * Checked multiplication
43+ , mul
44+ , mul32
45+ , mul64
37 -- * Debugging
46 -- * Debugging
38 , showText
47 , showText
39 ) where
48 ) where
@@ -41,10 +50,11 @@ module Data.Text.Internal
41#if defined(ASSERTS)
50#if defined(ASSERTS)
42import Control.Exception (assert)
51import Control.Exception (assert)
43#endif
52#endif
44−import Data.Bits ((.&.))
53+import Data.Bits
45−import qualified Data.Text.Array as A
54+import Data.Int (Int32, Int64)
46import Data.Text.Internal.Unsafe.Char (ord)
55import Data.Text.Internal.Unsafe.Char (ord)
47import Data.Typeable (Typeable)
56import Data.Typeable (Typeable)
57+import qualified Data.Text.Array as A
48
58
49-- | A space efficient, packed, unboxed Unicode text type.
59-- | A space efficient, packed, unboxed Unicode text type.
50data Text = Text
60data Text = Text
@@ -54,8 +64,8 @@ data Text = Text
54 deriving (Typeable)
64 deriving (Typeable)
55
65
56-- | Smart constructor.
66-- | Smart constructor.
57−text :: A.Array -> Int -> Int -> Text
67+text_ :: A.Array -> Int -> Int -> Text
58−text arr off len =
68+text_ arr off len =
59#if defined(ASSERTS)
69#if defined(ASSERTS)
60 let c = A.unsafeIndex arr off
70 let c = A.unsafeIndex arr off
61 alen = A.length arr
71 alen = A.length arr
@@ -65,19 +75,28 @@ text arr off len =
65 assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $
75 assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $
66#endif
76#endif
67 Text arr off len
77 Text arr off len
68−{-# INLINE text #-}
78+{-# INLINE text_ #-}
69
79
70-- | /O(1)/ The empty 'Text'.
80-- | /O(1)/ The empty 'Text'.
71empty :: Text
81empty :: Text
72empty = Text A.empty 0 0
82empty = Text A.empty 0 0
73{-# INLINE [1] empty #-}
83{-# INLINE [1] empty #-}
74
84
85+-- | A non-inlined version of 'empty'.
86+empty_ :: Text
87+empty_ = Text A.empty 0 0
88+{-# NOINLINE empty_ #-}
89+
75-- | Construct a 'Text' without invisibly pinning its byte array in
90-- | Construct a 'Text' without invisibly pinning its byte array in
76-- memory if its length has dwindled to zero.
91-- memory if its length has dwindled to zero.
92+text :: A.Array -> Int -> Int -> Text
93+text arr off len | len == 0 = empty
94+ | otherwise = text_ arr off len
95+{-# INLINE text #-}
96+
77textP :: A.Array -> Int -> Int -> Text
97textP :: A.Array -> Int -> Int -> Text
78−textP arr off len | len == 0 = empty
98+{-# DEPRECATED textP "Use text instead" #-}
79− | otherwise = text arr off len
99+textP = text
80−{-# INLINE textP #-}
81
100
82-- | A useful 'show'-like function for debugging purposes.
101-- | A useful 'show'-like function for debugging purposes.
83showText :: Text -> String
102showText :: Text -> String
@@ -97,13 +116,58 @@ safe :: Char -> Char
97safe c
116safe c
98 | ord c .&. 0x1ff800 /= 0xd800 = c
117 | ord c .&. 0x1ff800 /= 0xd800 = c
99 | otherwise = '\xfffd'
118 | otherwise = '\xfffd'
100−{-# INLINE safe #-}
119+{-# INLINE [0] safe #-}
101
120
102-- | Apply a function to the first element of an optional pair.
121-- | Apply a function to the first element of an optional pair.
103firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)
122firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)
104firstf f (Just (a, b)) = Just (f a, b)
123firstf f (Just (a, b)) = Just (f a, b)
105firstf _ Nothing = Nothing
124firstf _ Nothing = Nothing
106
125
126+-- | Checked multiplication. Calls 'error' if the result would
127+-- overflow.
128+mul :: Int -> Int -> Int
129+#if WORD_SIZE_IN_BITS == 64
130+mul a b = fromIntegral $ fromIntegral a `mul64` fromIntegral b
131+#else
132+mul a b = fromIntegral $ fromIntegral a `mul32` fromIntegral b
133+#endif
134+{-# INLINE mul #-}
135+infixl 7 `mul`
136+
137+-- | Checked multiplication. Calls 'error' if the result would
138+-- overflow.
139+mul64 :: Int64 -> Int64 -> Int64
140+mul64 a b
141+ | a >= 0 && b >= 0 = mul64_ a b
142+ | a >= 0 = -mul64_ a (-b)
143+ | b >= 0 = -mul64_ (-a) b
144+ | otherwise = mul64_ (-a) (-b)
145+{-# INLINE mul64 #-}
146+infixl 7 `mul64`
147+
148+mul64_ :: Int64 -> Int64 -> Int64
149+mul64_ a b
150+ | ahi > 0 && bhi > 0 = error "overflow"
151+ | top > 0x7fffffff = error "overflow"
152+ | total < 0 = error "overflow"
153+ | otherwise = total
154+ where (# ahi, alo #) = (# a `shiftR` 32, a .&. 0xffffffff #)
155+ (# bhi, blo #) = (# b `shiftR` 32, b .&. 0xffffffff #)
156+ top = ahi * blo + alo * bhi
157+ total = (top `shiftL` 32) + alo * blo
158+{-# INLINE mul64_ #-}
159+
160+-- | Checked multiplication. Calls 'error' if the result would
161+-- overflow.
162+mul32 :: Int32 -> Int32 -> Int32
163+mul32 a b = case fromIntegral a * fromIntegral b of
164+ ab | ab < min32 || ab > max32 -> error "overflow"
165+ | otherwise -> fromIntegral ab
166+ where min32 = -0x80000000 :: Int64
167+ max32 = 0x7fffffff
168+{-# INLINE mul32 #-}
169+infixl 7 `mul32`
170+
107-- $internals
171-- $internals
108--
172--
109-- Internally, the 'Text' type is represented as an array of 'Word16'
173-- Internally, the 'Text' type is represented as an array of 'Word16'
Data/Text/Internal/Builder.hs+19−16
@@ -6,7 +6,7 @@
6-- Module : Data.Text.Internal.Builder
6-- Module : Data.Text.Internal.Builder
7-- Copyright : (c) 2013 Bryan O'Sullivan
7-- Copyright : (c) 2013 Bryan O'Sullivan
8-- (c) 2010 Johan Tibell
8-- (c) 2010 Johan Tibell
9−-- License : BSD3-style (see LICENSE)
9+-- License : BSD-style (see LICENSE)
10--
10--
11-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
11-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
12-- Stability : experimental
12-- Stability : experimental
@@ -58,13 +58,14 @@ module Data.Text.Internal.Builder
58 ) where
58 ) where
59
59
60import Control.Monad.ST (ST, runST)
60import Control.Monad.ST (ST, runST)
61−import Data.Bits ((.&.))
62import Data.Monoid (Monoid(..))
61import Data.Monoid (Monoid(..))
62+#if MIN_VERSION_base(4,9,0)
63+import Data.Semigroup (Semigroup(..))
64+#endif
63import Data.Text.Internal (Text(..))
65import Data.Text.Internal (Text(..))
64import Data.Text.Internal.Lazy (smallChunkSize)
66import Data.Text.Internal.Lazy (smallChunkSize)
65import Data.Text.Unsafe (inlineInterleaveST)
67import Data.Text.Unsafe (inlineInterleaveST)
66−import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
68+import Data.Text.Internal.Unsafe.Char (unsafeWrite)
67−import Data.Text.Internal.Unsafe.Shift (shiftR)
68import Prelude hiding (map, putChar)
69import Prelude hiding (map, putChar)
69
70
70import qualified Data.String as String
71import qualified Data.String as String
@@ -91,12 +92,22 @@ newtype Builder = Builder {
91 -> ST s [S.Text]
92 -> ST s [S.Text]
92 }
93 }
93
94
95+#if MIN_VERSION_base(4,9,0)
96+instance Semigroup Builder where
97+ (<>) = append
98+ {-# INLINE (<>) #-}
99+#endif
100+
94instance Monoid Builder where
101instance Monoid Builder where
95 mempty = empty
102 mempty = empty
96 {-# INLINE mempty #-}
103 {-# INLINE mempty #-}
104+#if MIN_VERSION_base(4,9,0)
105+ mappend = (<>) -- future-proof definition
106+#else
97 mappend = append
107 mappend = append
108+#endif
98 {-# INLINE mappend #-}
109 {-# INLINE mappend #-}
99− mconcat = foldr mappend mempty
110+ mconcat = foldr mappend Data.Monoid.mempty
100 {-# INLINE mconcat #-}
111 {-# INLINE mconcat #-}
101
112
102instance String.IsString Builder where
113instance String.IsString Builder where
@@ -127,17 +138,7 @@ empty = Builder (\ k buf -> k buf)
127-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@
138-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@
128--
139--
129singleton :: Char -> Builder
140singleton :: Char -> Builder
130−singleton c = writeAtMost 2 $ \ marr o ->
141+singleton c = writeAtMost 2 $ \ marr o -> unsafeWrite marr o c
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{-# INLINE singleton #-}
142{-# INLINE singleton #-}
142
143
143------------------------------------------------------------------------
144------------------------------------------------------------------------
@@ -241,6 +242,8 @@ flush = Builder $ \ k buf@(Buffer p o u l) ->
241 !t = Text arr o u
242 !t = Text arr o u
242 ts <- inlineInterleaveST (k b)
243 ts <- inlineInterleaveST (k b)
243 return $! t : ts
244 return $! t : ts
245+{-# INLINE [1] flush #-}
246+-- defer inlining so that flush/flush rule may fire.
244
247
245------------------------------------------------------------------------
248------------------------------------------------------------------------
246
249
Data/Text/Internal/Builder/Functions.hs+2−1
@@ -23,7 +23,8 @@ module Data.Text.Internal.Builder.Functions
23
23
24import Data.Monoid (mappend)
24import Data.Monoid (mappend)
25import Data.Text.Lazy.Builder (Builder)
25import Data.Text.Lazy.Builder (Builder)
26−import GHC.Base
26+import GHC.Base (chr#,ord#,(+#),Int(I#),Char(C#))
27+import Prelude ()
27
28
28-- | Unsafe conversion for decimal digits.
29-- | Unsafe conversion for decimal digits.
29{-# INLINE i2d #-}
30{-# INLINE i2d #-}
Data/Text/Internal/Builder/Int/Digits.hs+1−1
@@ -2,7 +2,7 @@
2
2
3-- Module: Data.Text.Internal.Builder.Int.Digits
3-- Module: Data.Text.Internal.Builder.Int.Digits
4-- Copyright: (c) 2013 Bryan O'Sullivan
4-- Copyright: (c) 2013 Bryan O'Sullivan
5−-- License: BSD3
5+-- License: BSD-style
6-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
6-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
7-- Stability: experimental
7-- Stability: experimental
8-- Portability: portable
8-- Portability: portable
Data/Text/Internal/Builder/RealFloat/Functions.hs+28
@@ -1,3 +1,5 @@
1+{-# LANGUAGE CPP #-}
2+
1-- |
3-- |
2-- Module: Data.Text.Internal.Builder.RealFloat.Functions
4-- Module: Data.Text.Internal.Builder.RealFloat.Functions
3-- Copyright: (c) The University of Glasgow 1994-2002
5-- Copyright: (c) The University of Glasgow 1994-2002
@@ -13,6 +15,30 @@ module Data.Text.Internal.Builder.RealFloat.Functions
13 ) where
15 ) where
14
16
15roundTo :: Int -> [Int] -> (Int,[Int])
17roundTo :: Int -> [Int] -> (Int,[Int])
18+
19+#if MIN_VERSION_base(4,6,0)
20+
21+roundTo d is =
22+ case f d True is of
23+ x@(0,_) -> x
24+ (1,xs) -> (1, 1:xs)
25+ _ -> error "roundTo: bad Value"
26+ where
27+ b2 = base `quot` 2
28+
29+ f n _ [] = (0, replicate n 0)
30+ f 0 e (x:xs) | x == b2 && e && all (== 0) xs = (0, []) -- Round to even when at exactly half the base
31+ | otherwise = (if x >= b2 then 1 else 0, [])
32+ f n _ (i:xs)
33+ | i' == base = (1,0:ds)
34+ | otherwise = (0,i':ds)
35+ where
36+ (c,ds) = f (n-1) (even i) xs
37+ i' = c + i
38+ base = 10
39+
40+#else
41+
16roundTo d is =
42roundTo d is =
17 case f d is of
43 case f d is of
18 x@(0,_) -> x
44 x@(0,_) -> x
@@ -27,3 +53,5 @@ roundTo d is =
27 where
53 where
28 (c,ds) = f (n-1) xs
54 (c,ds) = f (n-1) xs
29 i' = c + i
55 i' = c + i
56+
57+#endif
Data/Text/Internal/Fusion.hs+38−28
@@ -68,7 +68,7 @@ default(Int)
68
68
69-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
69-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
70stream :: Text -> Stream Char
70stream :: Text -> Stream Char
71−stream (Text arr off len) = Stream next off (maxSize len)
71+stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)
72 where
72 where
73 !end = off+len
73 !end = off+len
74 next !i
74 next !i
@@ -83,7 +83,7 @@ stream (Text arr off len) = Stream next off (maxSize len)
83-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate
83-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate
84-- backwards.
84-- backwards.
85reverseStream :: Text -> Stream Char
85reverseStream :: Text -> Stream Char
86−reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)
86+reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `shiftR` 1) len)
87 where
87 where
88 {-# INLINE next #-}
88 {-# INLINE next #-}
89 next !i
89 next !i
@@ -98,25 +98,35 @@ reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)
98-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
98-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
99unstream :: Stream Char -> Text
99unstream :: Stream Char -> Text
100unstream (Stream next0 s0 len) = runText $ \done -> do
100unstream (Stream next0 s0 len) = runText $ \done -> do
101+ -- Before encoding each char we perform a buffer realloc check assuming
102+ -- worst case encoding size of two 16-bit units for the char. Just add an
103+ -- extra space to the buffer so that we do not end up reallocating even when
104+ -- all the chars are encoded as single unit.
101− let mlen = upperBound 4 len
105+ let mlen = upperBound 4 len + 1
102 arr0 <- A.new mlen
106 arr0 <- A.new mlen
103− let outer arr top = loop
107+ let outer !arr !maxi = encode
104 where
108 where
105− loop !s !i =
109+ -- keep the common case loop as small as possible
110+ encode !si !di =
106− case next0 s of
111+ case next0 si of
107− Done -> done arr i
112+ Done -> done arr di
108− Skip s' -> loop s' i
113+ Skip si' -> encode si' di
109− Yield x s'
114+ Yield c si'
110− | j >= top -> {-# SCC "unstream/resize" #-} do
115+ -- simply check for the worst case
111− let top' = (top + 1) `shiftL` 1
116+ | maxi < di + 1 -> realloc si di
117+ | otherwise -> do
118+ n <- unsafeWrite arr di c
119+ encode si' (di + n)
120+
121+ -- keep uncommon case separate from the common case code
122+ {-# NOINLINE realloc #-}
123+ realloc !si !di = do
124+ let newlen = (maxi + 1) * 2
112− arr' <- A.new top'
125+ arr' <- A.new newlen
113− A.copyM arr' 0 arr 0 top
126+ A.copyM arr' 0 arr 0 di
114− outer arr' top' s i
127+ outer arr' (newlen - 1) si di
115− | otherwise -> do d <- unsafeWrite arr i x
128+
116− loop s' (i+d)
117− where j | ord x < 0x10000 = i
118− | otherwise = i + 1
119− outer arr0 mlen s0 0
129+ outer arr0 (mlen - 1) s0 0
120{-# INLINE [0] unstream #-}
130{-# INLINE [0] unstream #-}
121{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
131{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
122
132
@@ -132,7 +142,7 @@ length = S.lengthI
132reverse :: Stream Char -> Text
142reverse :: Stream Char -> Text
133reverse (Stream next s len0)
143reverse (Stream next s len0)
134 | isEmpty len0 = I.empty
144 | isEmpty len0 = I.empty
135− | otherwise = I.textP arr off' len'
145+ | otherwise = I.text arr off' len'
136 where
146 where
137 len0' = upperBound 4 (larger len0 4)
147 len0' = upperBound 4 (larger len0 4)
138 (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')
148 (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')
@@ -166,15 +176,15 @@ reverse (Stream next s len0)
166-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with
176-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with
167-- the input and result reversed.
177-- the input and result reversed.
168reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
178reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
169−reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low
179+reverseScanr f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
170 where
180 where
171 {-# INLINE next #-}
181 {-# INLINE next #-}
172− next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)
182+ next (Scan1 z s) = Yield z (Scan2 z s)
173− next (S2 :*: z :*: s) = case next0 s of
183+ next (Scan2 z s) = case next0 s of
174− Yield x s' -> let !x' = f x z
184+ Yield x s' -> let !x' = f x z
175− in Yield x' (S2 :*: x' :*: s')
185+ in Yield x' (Scan2 x' s')
176− Skip s' -> Skip (S2 :*: z :*: s')
186+ Skip s' -> Skip (Scan2 z s')
177− Done -> Done
187+ Done -> Done
178{-# INLINE reverseScanr #-}
188{-# INLINE reverseScanr #-}
179
189
180-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
190-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
@@ -210,7 +220,7 @@ countChar = S.countCharI
210-- function to each element of a 'Text', passing an accumulating
220-- function to each element of a 'Text', passing an accumulating
211-- parameter from left to right, and returns a final 'Text'.
221-- parameter from left to right, and returns a final 'Text'.
212mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)
222mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)
213−mapAccumL f z0 (Stream next0 s0 len) = (nz,I.textP na 0 nl)
223+mapAccumL f z0 (Stream next0 s0 len) = (nz, I.text na 0 nl)
214 where
224 where
215 (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)
225 (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)
216 where mlen = upperBound 4 len
226 where mlen = upperBound 4 len
Data/Text/Internal/Fusion/CaseMapping.hs+291−19
@@ -1,17 +1,17 @@
1{-# LANGUAGE Rank2Types #-}
1{-# LANGUAGE Rank2Types #-}
2-- AUTOMATICALLY GENERATED - DO NOT EDIT
2-- AUTOMATICALLY GENERATED - DO NOT EDIT
3−-- Generated by scripts/SpecialCasing.hs
3+-- Generated by scripts/CaseMapping.hs
4−-- CaseFolding-6.3.0.txt
4+-- CaseFolding-8.0.0.txt
5−-- Date: 2012-12-20, 22:14:35 GMT [MD]
5+-- Date: 2015-01-13, 18:16:36 GMT [MD]
6−-- SpecialCasing-6.3.0.txt
6+-- SpecialCasing-8.0.0.txt
7−-- Date: 2013-05-08, 13:54:51 GMT [MD]
7+-- Date: 2014-12-16, 23:08:04 GMT [MD]
8
8
9module Data.Text.Internal.Fusion.CaseMapping where
9module Data.Text.Internal.Fusion.CaseMapping where
10import Data.Char
10import Data.Char
11import Data.Text.Internal.Fusion.Types
11import Data.Text.Internal.Fusion.Types
12
12
13upperMapping :: forall s. Char -> s -> Step (CC s) Char
13upperMapping :: forall s. Char -> s -> Step (CC s) Char
14−{-# INLINE upperMapping #-}
14+{-# NOINLINE upperMapping #-}
15-- LATIN SMALL LETTER SHARP S
15-- LATIN SMALL LETTER SHARP S
16upperMapping '\x00df' s = Yield '\x0053' (CC s '\x0053' '\x0000')
16upperMapping '\x00df' s = Yield '\x0053' (CC s '\x0053' '\x0000')
17-- LATIN SMALL LIGATURE FF
17-- LATIN SMALL LIGATURE FF
@@ -218,12 +218,12 @@ upperMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0399')
218upperMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0399')
218upperMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0399')
219upperMapping c s = Yield (toUpper c) (CC s '\0' '\0')
219upperMapping c s = Yield (toUpper c) (CC s '\0' '\0')
220lowerMapping :: forall s. Char -> s -> Step (CC s) Char
220lowerMapping :: forall s. Char -> s -> Step (CC s) Char
221−{-# INLINE lowerMapping #-}
221+{-# NOINLINE lowerMapping #-}
222-- LATIN CAPITAL LETTER I WITH DOT ABOVE
222-- LATIN CAPITAL LETTER I WITH DOT ABOVE
223lowerMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')
223lowerMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')
224lowerMapping c s = Yield (toLower c) (CC s '\0' '\0')
224lowerMapping c s = Yield (toLower c) (CC s '\0' '\0')
225titleMapping :: forall s. Char -> s -> Step (CC s) Char
225titleMapping :: forall s. Char -> s -> Step (CC s) Char
226−{-# INLINE titleMapping #-}
226+{-# NOINLINE titleMapping #-}
227-- LATIN SMALL LETTER SHARP S
227-- LATIN SMALL LETTER SHARP S
228titleMapping '\x00df' s = Yield '\x0053' (CC s '\x0073' '\x0000')
228titleMapping '\x00df' s = Yield '\x0053' (CC s '\x0073' '\x0000')
229-- LATIN SMALL LIGATURE FF
229-- LATIN SMALL LIGATURE FF
@@ -322,7 +322,7 @@ titleMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0345')
322titleMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0345')
322titleMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0345')
323titleMapping c s = Yield (toTitle c) (CC s '\0' '\0')
323titleMapping c s = Yield (toTitle c) (CC s '\0' '\0')
324foldMapping :: forall s. Char -> s -> Step (CC s) Char
324foldMapping :: forall s. Char -> s -> Step (CC s) Char
325−{-# INLINE foldMapping #-}
325+{-# NOINLINE foldMapping #-}
326-- MICRO SIGN
326-- MICRO SIGN
327foldMapping '\x00b5' s = Yield '\x03bc' (CC s '\x0000' '\x0000')
327foldMapping '\x00b5' s = Yield '\x03bc' (CC s '\x0000' '\x0000')
328-- LATIN SMALL LETTER SHARP S
328-- LATIN SMALL LETTER SHARP S
@@ -359,10 +359,18 @@ foldMapping '\x03f1' s = Yield '\x03c1' (CC s '\x0000' '\x0000')
359foldMapping '\x03f5' s = Yield '\x03b5' (CC s '\x0000' '\x0000')
359foldMapping '\x03f5' s = Yield '\x03b5' (CC s '\x0000' '\x0000')
360-- ARMENIAN SMALL LIGATURE ECH YIWN
360-- ARMENIAN SMALL LIGATURE ECH YIWN
361foldMapping '\x0587' s = Yield '\x0565' (CC s '\x0582' '\x0000')
361foldMapping '\x0587' s = Yield '\x0565' (CC s '\x0582' '\x0000')
362−-- GEORGIAN CAPITAL LETTER YN
362+-- CHEROKEE SMALL LETTER YE
363+foldMapping '\x13f8' s = Yield '\x13f0' (CC s '\x0000' '\x0000')
364+-- CHEROKEE SMALL LETTER YI
365+foldMapping '\x13f9' s = Yield '\x13f1' (CC s '\x0000' '\x0000')
366+-- CHEROKEE SMALL LETTER YO
367+foldMapping '\x13fa' s = Yield '\x13f2' (CC s '\x0000' '\x0000')
368+-- CHEROKEE SMALL LETTER YU
369+foldMapping '\x13fb' s = Yield '\x13f3' (CC s '\x0000' '\x0000')
370+-- CHEROKEE SMALL LETTER YV
363−foldMapping '\x10c7' s = Yield '\x2d27' (CC s '\x0000' '\x0000')
371+foldMapping '\x13fc' s = Yield '\x13f4' (CC s '\x0000' '\x0000')
364−-- GEORGIAN CAPITAL LETTER AEN
372+-- CHEROKEE SMALL LETTER MV
365−foldMapping '\x10cd' s = Yield '\x2d2d' (CC s '\x0000' '\x0000')
373+foldMapping '\x13fd' s = Yield '\x13f5' (CC s '\x0000' '\x0000')
366-- LATIN SMALL LETTER H WITH LINE BELOW
374-- LATIN SMALL LETTER H WITH LINE BELOW
367foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')
375foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')
368-- LATIN SMALL LETTER T WITH DIAERESIS
376-- LATIN SMALL LETTER T WITH DIAERESIS
@@ -537,12 +545,174 @@ foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')
537foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')
545foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')
538-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
546-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
539foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')
547foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')
540−-- COPTIC CAPITAL LETTER BOHAIRIC KHEI
548+-- LATIN CAPITAL LETTER J WITH CROSSED-TAIL
541−foldMapping '\x2cf2' s = Yield '\x2cf3' (CC s '\x0000' '\x0000')
549+foldMapping '\xa7b2' s = Yield '\x029d' (CC s '\x0000' '\x0000')
542−-- LATIN CAPITAL LETTER C WITH BAR
550+-- LATIN CAPITAL LETTER CHI
551+foldMapping '\xa7b3' s = Yield '\xab53' (CC s '\x0000' '\x0000')
552+-- LATIN CAPITAL LETTER BETA
543−foldMapping '\xa792' s = Yield '\xa793' (CC s '\x0000' '\x0000')
553+foldMapping '\xa7b4' s = Yield '\xa7b5' (CC s '\x0000' '\x0000')
544−-- LATIN CAPITAL LETTER H WITH HOOK
554+-- LATIN CAPITAL LETTER OMEGA
555+foldMapping '\xa7b6' s = Yield '\xa7b7' (CC s '\x0000' '\x0000')
556+-- CHEROKEE SMALL LETTER A
557+foldMapping '\xab70' s = Yield '\x13a0' (CC s '\x0000' '\x0000')
558+-- CHEROKEE SMALL LETTER E
559+foldMapping '\xab71' s = Yield '\x13a1' (CC s '\x0000' '\x0000')
560+-- CHEROKEE SMALL LETTER I
561+foldMapping '\xab72' s = Yield '\x13a2' (CC s '\x0000' '\x0000')
562+-- CHEROKEE SMALL LETTER O
545−foldMapping '\xa7aa' s = Yield '\x0266' (CC s '\x0000' '\x0000')
563+foldMapping '\xab73' s = Yield '\x13a3' (CC s '\x0000' '\x0000')
564+-- CHEROKEE SMALL LETTER U
565+foldMapping '\xab74' s = Yield '\x13a4' (CC s '\x0000' '\x0000')
566+-- CHEROKEE SMALL LETTER V
567+foldMapping '\xab75' s = Yield '\x13a5' (CC s '\x0000' '\x0000')
568+-- CHEROKEE SMALL LETTER GA
569+foldMapping '\xab76' s = Yield '\x13a6' (CC s '\x0000' '\x0000')
570+-- CHEROKEE SMALL LETTER KA
571+foldMapping '\xab77' s = Yield '\x13a7' (CC s '\x0000' '\x0000')
572+-- CHEROKEE SMALL LETTER GE
573+foldMapping '\xab78' s = Yield '\x13a8' (CC s '\x0000' '\x0000')
574+-- CHEROKEE SMALL LETTER GI
575+foldMapping '\xab79' s = Yield '\x13a9' (CC s '\x0000' '\x0000')
576+-- CHEROKEE SMALL LETTER GO
577+foldMapping '\xab7a' s = Yield '\x13aa' (CC s '\x0000' '\x0000')
578+-- CHEROKEE SMALL LETTER GU
579+foldMapping '\xab7b' s = Yield '\x13ab' (CC s '\x0000' '\x0000')
580+-- CHEROKEE SMALL LETTER GV
581+foldMapping '\xab7c' s = Yield '\x13ac' (CC s '\x0000' '\x0000')
582+-- CHEROKEE SMALL LETTER HA
583+foldMapping '\xab7d' s = Yield '\x13ad' (CC s '\x0000' '\x0000')
584+-- CHEROKEE SMALL LETTER HE
585+foldMapping '\xab7e' s = Yield '\x13ae' (CC s '\x0000' '\x0000')
586+-- CHEROKEE SMALL LETTER HI
587+foldMapping '\xab7f' s = Yield '\x13af' (CC s '\x0000' '\x0000')
588+-- CHEROKEE SMALL LETTER HO
589+foldMapping '\xab80' s = Yield '\x13b0' (CC s '\x0000' '\x0000')
590+-- CHEROKEE SMALL LETTER HU
591+foldMapping '\xab81' s = Yield '\x13b1' (CC s '\x0000' '\x0000')
592+-- CHEROKEE SMALL LETTER HV
593+foldMapping '\xab82' s = Yield '\x13b2' (CC s '\x0000' '\x0000')
594+-- CHEROKEE SMALL LETTER LA
595+foldMapping '\xab83' s = Yield '\x13b3' (CC s '\x0000' '\x0000')
596+-- CHEROKEE SMALL LETTER LE
597+foldMapping '\xab84' s = Yield '\x13b4' (CC s '\x0000' '\x0000')
598+-- CHEROKEE SMALL LETTER LI
599+foldMapping '\xab85' s = Yield '\x13b5' (CC s '\x0000' '\x0000')
600+-- CHEROKEE SMALL LETTER LO
601+foldMapping '\xab86' s = Yield '\x13b6' (CC s '\x0000' '\x0000')
602+-- CHEROKEE SMALL LETTER LU
603+foldMapping '\xab87' s = Yield '\x13b7' (CC s '\x0000' '\x0000')
604+-- CHEROKEE SMALL LETTER LV
605+foldMapping '\xab88' s = Yield '\x13b8' (CC s '\x0000' '\x0000')
606+-- CHEROKEE SMALL LETTER MA
607+foldMapping '\xab89' s = Yield '\x13b9' (CC s '\x0000' '\x0000')
608+-- CHEROKEE SMALL LETTER ME
609+foldMapping '\xab8a' s = Yield '\x13ba' (CC s '\x0000' '\x0000')
610+-- CHEROKEE SMALL LETTER MI
611+foldMapping '\xab8b' s = Yield '\x13bb' (CC s '\x0000' '\x0000')
612+-- CHEROKEE SMALL LETTER MO
613+foldMapping '\xab8c' s = Yield '\x13bc' (CC s '\x0000' '\x0000')
614+-- CHEROKEE SMALL LETTER MU
615+foldMapping '\xab8d' s = Yield '\x13bd' (CC s '\x0000' '\x0000')
616+-- CHEROKEE SMALL LETTER NA
617+foldMapping '\xab8e' s = Yield '\x13be' (CC s '\x0000' '\x0000')
618+-- CHEROKEE SMALL LETTER HNA
619+foldMapping '\xab8f' s = Yield '\x13bf' (CC s '\x0000' '\x0000')
620+-- CHEROKEE SMALL LETTER NAH
621+foldMapping '\xab90' s = Yield '\x13c0' (CC s '\x0000' '\x0000')
622+-- CHEROKEE SMALL LETTER NE
623+foldMapping '\xab91' s = Yield '\x13c1' (CC s '\x0000' '\x0000')
624+-- CHEROKEE SMALL LETTER NI
625+foldMapping '\xab92' s = Yield '\x13c2' (CC s '\x0000' '\x0000')
626+-- CHEROKEE SMALL LETTER NO
627+foldMapping '\xab93' s = Yield '\x13c3' (CC s '\x0000' '\x0000')
628+-- CHEROKEE SMALL LETTER NU
629+foldMapping '\xab94' s = Yield '\x13c4' (CC s '\x0000' '\x0000')
630+-- CHEROKEE SMALL LETTER NV
631+foldMapping '\xab95' s = Yield '\x13c5' (CC s '\x0000' '\x0000')
632+-- CHEROKEE SMALL LETTER QUA
633+foldMapping '\xab96' s = Yield '\x13c6' (CC s '\x0000' '\x0000')
634+-- CHEROKEE SMALL LETTER QUE
635+foldMapping '\xab97' s = Yield '\x13c7' (CC s '\x0000' '\x0000')
636+-- CHEROKEE SMALL LETTER QUI
637+foldMapping '\xab98' s = Yield '\x13c8' (CC s '\x0000' '\x0000')
638+-- CHEROKEE SMALL LETTER QUO
639+foldMapping '\xab99' s = Yield '\x13c9' (CC s '\x0000' '\x0000')
640+-- CHEROKEE SMALL LETTER QUU
641+foldMapping '\xab9a' s = Yield '\x13ca' (CC s '\x0000' '\x0000')
642+-- CHEROKEE SMALL LETTER QUV
643+foldMapping '\xab9b' s = Yield '\x13cb' (CC s '\x0000' '\x0000')
644+-- CHEROKEE SMALL LETTER SA
645+foldMapping '\xab9c' s = Yield '\x13cc' (CC s '\x0000' '\x0000')
646+-- CHEROKEE SMALL LETTER S
647+foldMapping '\xab9d' s = Yield '\x13cd' (CC s '\x0000' '\x0000')
648+-- CHEROKEE SMALL LETTER SE
649+foldMapping '\xab9e' s = Yield '\x13ce' (CC s '\x0000' '\x0000')
650+-- CHEROKEE SMALL LETTER SI
651+foldMapping '\xab9f' s = Yield '\x13cf' (CC s '\x0000' '\x0000')
652+-- CHEROKEE SMALL LETTER SO
653+foldMapping '\xaba0' s = Yield '\x13d0' (CC s '\x0000' '\x0000')
654+-- CHEROKEE SMALL LETTER SU
655+foldMapping '\xaba1' s = Yield '\x13d1' (CC s '\x0000' '\x0000')
656+-- CHEROKEE SMALL LETTER SV
657+foldMapping '\xaba2' s = Yield '\x13d2' (CC s '\x0000' '\x0000')
658+-- CHEROKEE SMALL LETTER DA
659+foldMapping '\xaba3' s = Yield '\x13d3' (CC s '\x0000' '\x0000')
660+-- CHEROKEE SMALL LETTER TA
661+foldMapping '\xaba4' s = Yield '\x13d4' (CC s '\x0000' '\x0000')
662+-- CHEROKEE SMALL LETTER DE
663+foldMapping '\xaba5' s = Yield '\x13d5' (CC s '\x0000' '\x0000')
664+-- CHEROKEE SMALL LETTER TE
665+foldMapping '\xaba6' s = Yield '\x13d6' (CC s '\x0000' '\x0000')
666+-- CHEROKEE SMALL LETTER DI
667+foldMapping '\xaba7' s = Yield '\x13d7' (CC s '\x0000' '\x0000')
668+-- CHEROKEE SMALL LETTER TI
669+foldMapping '\xaba8' s = Yield '\x13d8' (CC s '\x0000' '\x0000')
670+-- CHEROKEE SMALL LETTER DO
671+foldMapping '\xaba9' s = Yield '\x13d9' (CC s '\x0000' '\x0000')
672+-- CHEROKEE SMALL LETTER DU
673+foldMapping '\xabaa' s = Yield '\x13da' (CC s '\x0000' '\x0000')
674+-- CHEROKEE SMALL LETTER DV
675+foldMapping '\xabab' s = Yield '\x13db' (CC s '\x0000' '\x0000')
676+-- CHEROKEE SMALL LETTER DLA
677+foldMapping '\xabac' s = Yield '\x13dc' (CC s '\x0000' '\x0000')
678+-- CHEROKEE SMALL LETTER TLA
679+foldMapping '\xabad' s = Yield '\x13dd' (CC s '\x0000' '\x0000')
680+-- CHEROKEE SMALL LETTER TLE
681+foldMapping '\xabae' s = Yield '\x13de' (CC s '\x0000' '\x0000')
682+-- CHEROKEE SMALL LETTER TLI
683+foldMapping '\xabaf' s = Yield '\x13df' (CC s '\x0000' '\x0000')
684+-- CHEROKEE SMALL LETTER TLO
685+foldMapping '\xabb0' s = Yield '\x13e0' (CC s '\x0000' '\x0000')
686+-- CHEROKEE SMALL LETTER TLU
687+foldMapping '\xabb1' s = Yield '\x13e1' (CC s '\x0000' '\x0000')
688+-- CHEROKEE SMALL LETTER TLV
689+foldMapping '\xabb2' s = Yield '\x13e2' (CC s '\x0000' '\x0000')
690+-- CHEROKEE SMALL LETTER TSA
691+foldMapping '\xabb3' s = Yield '\x13e3' (CC s '\x0000' '\x0000')
692+-- CHEROKEE SMALL LETTER TSE
693+foldMapping '\xabb4' s = Yield '\x13e4' (CC s '\x0000' '\x0000')
694+-- CHEROKEE SMALL LETTER TSI
695+foldMapping '\xabb5' s = Yield '\x13e5' (CC s '\x0000' '\x0000')
696+-- CHEROKEE SMALL LETTER TSO
697+foldMapping '\xabb6' s = Yield '\x13e6' (CC s '\x0000' '\x0000')
698+-- CHEROKEE SMALL LETTER TSU
699+foldMapping '\xabb7' s = Yield '\x13e7' (CC s '\x0000' '\x0000')
700+-- CHEROKEE SMALL LETTER TSV
701+foldMapping '\xabb8' s = Yield '\x13e8' (CC s '\x0000' '\x0000')
702+-- CHEROKEE SMALL LETTER WA
703+foldMapping '\xabb9' s = Yield '\x13e9' (CC s '\x0000' '\x0000')
704+-- CHEROKEE SMALL LETTER WE
705+foldMapping '\xabba' s = Yield '\x13ea' (CC s '\x0000' '\x0000')
706+-- CHEROKEE SMALL LETTER WI
707+foldMapping '\xabbb' s = Yield '\x13eb' (CC s '\x0000' '\x0000')
708+-- CHEROKEE SMALL LETTER WO
709+foldMapping '\xabbc' s = Yield '\x13ec' (CC s '\x0000' '\x0000')
710+-- CHEROKEE SMALL LETTER WU
711+foldMapping '\xabbd' s = Yield '\x13ed' (CC s '\x0000' '\x0000')
712+-- CHEROKEE SMALL LETTER WV
713+foldMapping '\xabbe' s = Yield '\x13ee' (CC s '\x0000' '\x0000')
714+-- CHEROKEE SMALL LETTER YA
715+foldMapping '\xabbf' s = Yield '\x13ef' (CC s '\x0000' '\x0000')
546-- LATIN SMALL LIGATURE FF
716-- LATIN SMALL LIGATURE FF
547foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')
717foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')
548-- LATIN SMALL LIGATURE FI
718-- LATIN SMALL LIGATURE FI
@@ -567,4 +737,106 @@ foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')
567foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')
737foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')
568-- ARMENIAN SMALL LIGATURE MEN XEH
738-- ARMENIAN SMALL LIGATURE MEN XEH
569foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')
739foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')
740+-- OLD HUNGARIAN CAPITAL LETTER A
741+foldMapping '\x10c80' s = Yield '\x10cc0' (CC s '\x0000' '\x0000')
742+-- OLD HUNGARIAN CAPITAL LETTER AA
743+foldMapping '\x10c81' s = Yield '\x10cc1' (CC s '\x0000' '\x0000')
744+-- OLD HUNGARIAN CAPITAL LETTER EB
745+foldMapping '\x10c82' s = Yield '\x10cc2' (CC s '\x0000' '\x0000')
746+-- OLD HUNGARIAN CAPITAL LETTER AMB
747+foldMapping '\x10c83' s = Yield '\x10cc3' (CC s '\x0000' '\x0000')
748+-- OLD HUNGARIAN CAPITAL LETTER EC
749+foldMapping '\x10c84' s = Yield '\x10cc4' (CC s '\x0000' '\x0000')
750+-- OLD HUNGARIAN CAPITAL LETTER ENC
751+foldMapping '\x10c85' s = Yield '\x10cc5' (CC s '\x0000' '\x0000')
752+-- OLD HUNGARIAN CAPITAL LETTER ECS
753+foldMapping '\x10c86' s = Yield '\x10cc6' (CC s '\x0000' '\x0000')
754+-- OLD HUNGARIAN CAPITAL LETTER ED
755+foldMapping '\x10c87' s = Yield '\x10cc7' (CC s '\x0000' '\x0000')
756+-- OLD HUNGARIAN CAPITAL LETTER AND
757+foldMapping '\x10c88' s = Yield '\x10cc8' (CC s '\x0000' '\x0000')
758+-- OLD HUNGARIAN CAPITAL LETTER E
759+foldMapping '\x10c89' s = Yield '\x10cc9' (CC s '\x0000' '\x0000')
760+-- OLD HUNGARIAN CAPITAL LETTER CLOSE E
761+foldMapping '\x10c8a' s = Yield '\x10cca' (CC s '\x0000' '\x0000')
762+-- OLD HUNGARIAN CAPITAL LETTER EE
763+foldMapping '\x10c8b' s = Yield '\x10ccb' (CC s '\x0000' '\x0000')
764+-- OLD HUNGARIAN CAPITAL LETTER EF
765+foldMapping '\x10c8c' s = Yield '\x10ccc' (CC s '\x0000' '\x0000')
766+-- OLD HUNGARIAN CAPITAL LETTER EG
767+foldMapping '\x10c8d' s = Yield '\x10ccd' (CC s '\x0000' '\x0000')
768+-- OLD HUNGARIAN CAPITAL LETTER EGY
769+foldMapping '\x10c8e' s = Yield '\x10cce' (CC s '\x0000' '\x0000')
770+-- OLD HUNGARIAN CAPITAL LETTER EH
771+foldMapping '\x10c8f' s = Yield '\x10ccf' (CC s '\x0000' '\x0000')
772+-- OLD HUNGARIAN CAPITAL LETTER I
773+foldMapping '\x10c90' s = Yield '\x10cd0' (CC s '\x0000' '\x0000')
774+-- OLD HUNGARIAN CAPITAL LETTER II
775+foldMapping '\x10c91' s = Yield '\x10cd1' (CC s '\x0000' '\x0000')
776+-- OLD HUNGARIAN CAPITAL LETTER EJ
777+foldMapping '\x10c92' s = Yield '\x10cd2' (CC s '\x0000' '\x0000')
778+-- OLD HUNGARIAN CAPITAL LETTER EK
779+foldMapping '\x10c93' s = Yield '\x10cd3' (CC s '\x0000' '\x0000')
780+-- OLD HUNGARIAN CAPITAL LETTER AK
781+foldMapping '\x10c94' s = Yield '\x10cd4' (CC s '\x0000' '\x0000')
782+-- OLD HUNGARIAN CAPITAL LETTER UNK
783+foldMapping '\x10c95' s = Yield '\x10cd5' (CC s '\x0000' '\x0000')
784+-- OLD HUNGARIAN CAPITAL LETTER EL
785+foldMapping '\x10c96' s = Yield '\x10cd6' (CC s '\x0000' '\x0000')
786+-- OLD HUNGARIAN CAPITAL LETTER ELY
787+foldMapping '\x10c97' s = Yield '\x10cd7' (CC s '\x0000' '\x0000')
788+-- OLD HUNGARIAN CAPITAL LETTER EM
789+foldMapping '\x10c98' s = Yield '\x10cd8' (CC s '\x0000' '\x0000')
790+-- OLD HUNGARIAN CAPITAL LETTER EN
791+foldMapping '\x10c99' s = Yield '\x10cd9' (CC s '\x0000' '\x0000')
792+-- OLD HUNGARIAN CAPITAL LETTER ENY
793+foldMapping '\x10c9a' s = Yield '\x10cda' (CC s '\x0000' '\x0000')
794+-- OLD HUNGARIAN CAPITAL LETTER O
795+foldMapping '\x10c9b' s = Yield '\x10cdb' (CC s '\x0000' '\x0000')
796+-- OLD HUNGARIAN CAPITAL LETTER OO
797+foldMapping '\x10c9c' s = Yield '\x10cdc' (CC s '\x0000' '\x0000')
798+-- OLD HUNGARIAN CAPITAL LETTER NIKOLSBURG OE
799+foldMapping '\x10c9d' s = Yield '\x10cdd' (CC s '\x0000' '\x0000')
800+-- OLD HUNGARIAN CAPITAL LETTER RUDIMENTA OE
801+foldMapping '\x10c9e' s = Yield '\x10cde' (CC s '\x0000' '\x0000')
802+-- OLD HUNGARIAN CAPITAL LETTER OEE
803+foldMapping '\x10c9f' s = Yield '\x10cdf' (CC s '\x0000' '\x0000')
804+-- OLD HUNGARIAN CAPITAL LETTER EP
805+foldMapping '\x10ca0' s = Yield '\x10ce0' (CC s '\x0000' '\x0000')
806+-- OLD HUNGARIAN CAPITAL LETTER EMP
807+foldMapping '\x10ca1' s = Yield '\x10ce1' (CC s '\x0000' '\x0000')
808+-- OLD HUNGARIAN CAPITAL LETTER ER
809+foldMapping '\x10ca2' s = Yield '\x10ce2' (CC s '\x0000' '\x0000')
810+-- OLD HUNGARIAN CAPITAL LETTER SHORT ER
811+foldMapping '\x10ca3' s = Yield '\x10ce3' (CC s '\x0000' '\x0000')
812+-- OLD HUNGARIAN CAPITAL LETTER ES
813+foldMapping '\x10ca4' s = Yield '\x10ce4' (CC s '\x0000' '\x0000')
814+-- OLD HUNGARIAN CAPITAL LETTER ESZ
815+foldMapping '\x10ca5' s = Yield '\x10ce5' (CC s '\x0000' '\x0000')
816+-- OLD HUNGARIAN CAPITAL LETTER ET
817+foldMapping '\x10ca6' s = Yield '\x10ce6' (CC s '\x0000' '\x0000')
818+-- OLD HUNGARIAN CAPITAL LETTER ENT
819+foldMapping '\x10ca7' s = Yield '\x10ce7' (CC s '\x0000' '\x0000')
820+-- OLD HUNGARIAN CAPITAL LETTER ETY
821+foldMapping '\x10ca8' s = Yield '\x10ce8' (CC s '\x0000' '\x0000')
822+-- OLD HUNGARIAN CAPITAL LETTER ECH
823+foldMapping '\x10ca9' s = Yield '\x10ce9' (CC s '\x0000' '\x0000')
824+-- OLD HUNGARIAN CAPITAL LETTER U
825+foldMapping '\x10caa' s = Yield '\x10cea' (CC s '\x0000' '\x0000')
826+-- OLD HUNGARIAN CAPITAL LETTER UU
827+foldMapping '\x10cab' s = Yield '\x10ceb' (CC s '\x0000' '\x0000')
828+-- OLD HUNGARIAN CAPITAL LETTER NIKOLSBURG UE
829+foldMapping '\x10cac' s = Yield '\x10cec' (CC s '\x0000' '\x0000')
830+-- OLD HUNGARIAN CAPITAL LETTER RUDIMENTA UE
831+foldMapping '\x10cad' s = Yield '\x10ced' (CC s '\x0000' '\x0000')
832+-- OLD HUNGARIAN CAPITAL LETTER EV
833+foldMapping '\x10cae' s = Yield '\x10cee' (CC s '\x0000' '\x0000')
834+-- OLD HUNGARIAN CAPITAL LETTER EZ
835+foldMapping '\x10caf' s = Yield '\x10cef' (CC s '\x0000' '\x0000')
836+-- OLD HUNGARIAN CAPITAL LETTER EZS
837+foldMapping '\x10cb0' s = Yield '\x10cf0' (CC s '\x0000' '\x0000')
838+-- OLD HUNGARIAN CAPITAL LETTER ENT-SHAPED SIGN
839+foldMapping '\x10cb1' s = Yield '\x10cf1' (CC s '\x0000' '\x0000')
840+-- OLD HUNGARIAN CAPITAL LETTER US
841+foldMapping '\x10cb2' s = Yield '\x10cf2' (CC s '\x0000' '\x0000')
570foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
842foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
Data/Text/Internal/Fusion/Common.hs+63−75
@@ -71,9 +71,6 @@ module Data.Text.Internal.Fusion.Common
71 -- ** Scans
71 -- ** Scans
72 , scanl
72 , scanl
73
73
74− -- ** Accumulating maps
75− -- , mapAccumL
76−
77 -- ** Generation and unfolding
74 -- ** Generation and unfolding
78 , replicateCharI
75 , replicateCharI
79 , replicateI
76 , replicateI
@@ -123,7 +120,7 @@ singleton :: Char -> Stream Char
123singleton c = Stream next False 1
120singleton c = Stream next False 1
124 where next False = Yield c True
121 where next False = Yield c True
125 next True = Done
122 next True = Done
126−{-# INLINE singleton #-}
123+{-# INLINE [0] singleton #-}
127
124
128streamList :: [a] -> Stream a
125streamList :: [a] -> Stream a
129{-# INLINE [0] streamList #-}
126{-# INLINE [0] streamList #-}
@@ -187,6 +184,9 @@ cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
187 Yield x s' -> Yield x (C0 s')
184 Yield x s' -> Yield x (C0 s')
188{-# INLINE [0] cons #-}
185{-# INLINE [0] cons #-}
189
186
187+data Snoc a = N
188+ | J !a
189+
190-- | /O(n)/ Adds a character to the end of a stream.
190-- | /O(n)/ Adds a character to the end of a stream.
191snoc :: Stream Char -> Char -> Stream Char
191snoc :: Stream Char -> Char -> Stream Char
192snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
192snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
@@ -315,12 +315,13 @@ lengthI (Stream next s0 _len) = loop_length 0 s0
315--
315--
316-- This function gives the same answer as comparing against the result
316-- This function gives the same answer as comparing against the result
317-- of 'lengthI', but can short circuit if the count of characters is
317-- of 'lengthI', but can short circuit if the count of characters is
318+-- greater than the number or if the stream can't possibly be as long
318−-- greater than the number, and hence be more efficient.
319+-- as the number supplied, and hence be more efficient.
319compareLengthI :: Integral a => Stream Char -> a -> Ordering
320compareLengthI :: Integral a => Stream Char -> a -> Ordering
320compareLengthI (Stream next s0 len) n =
321compareLengthI (Stream next s0 len) n =
321− case exactly len of
322+ case compareSize len (fromIntegral n) of
323+ Just o -> o
322 Nothing -> loop_cmp 0 s0
324 Nothing -> loop_cmp 0 s0
323− Just i -> compare (fromIntegral i) n
324 where
325 where
325 loop_cmp !z s = case next s of
326 loop_cmp !z s = case next s of
326 Done -> compare z n
327 Done -> compare z n
@@ -472,17 +473,20 @@ toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len
472 next (CC s a b) = Yield a (CC s b '\0')
473 next (CC s a b) = Yield a (CC s b '\0')
473{-# INLINE [0] toTitle #-}
474{-# INLINE [0] toTitle #-}
474
475
476+data Justify i s = Just1 !i !s
477+ | Just2 !i !s
478+
475justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
479justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
476justifyLeftI k c (Stream next0 s0 len) =
480justifyLeftI k c (Stream next0 s0 len) =
477− Stream next (s0 :*: S1 :*: 0) (larger (fromIntegral k) len)
481+ Stream next (Just1 0 s0) (larger (fromIntegral k) len)
478 where
482 where
479− next (s :*: S1 :*: n) =
483+ next (Just1 n s) =
480 case next0 s of
484 case next0 s of
481− Done -> next (s :*: S2 :*: n)
485+ Done -> next (Just2 n s)
482− Skip s' -> Skip (s' :*: S1 :*: n)
486+ Skip s' -> Skip (Just1 n s')
483− Yield x s' -> Yield x (s' :*: S1 :*: n+1)
487+ Yield x s' -> Yield x (Just1 (n+1) s')
484− next (s :*: S2 :*: n)
488+ next (Just2 n s)
485− | n < k = Yield c (s :*: S2 :*: n+1)
489+ | n < k = Yield c (Just2 (n+1) s)
486 | otherwise = Done
490 | otherwise = Done
487 {-# INLINE next #-}
491 {-# INLINE next #-}
488{-# INLINE [0] justifyLeftI #-}
492{-# INLINE [0] justifyLeftI #-}
@@ -589,7 +593,7 @@ concatMap f = foldr (append . f) empty
589{-# INLINE [0] concatMap #-}
593{-# INLINE [0] concatMap #-}
590
594
591-- | /O(n)/ any @p @xs determines if any character in the stream
595-- | /O(n)/ any @p @xs determines if any character in the stream
592−-- @xs@ satisifes the predicate @p@.
596+-- @xs@ satisfies the predicate @p@.
593any :: (Char -> Bool) -> Stream Char -> Bool
597any :: (Char -> Bool) -> Stream Char -> Bool
594any p (Stream next0 s0 _len) = loop_any s0
598any p (Stream next0 s0 _len) = loop_any s0
595 where
599 where
@@ -601,7 +605,7 @@ any p (Stream next0 s0 _len) = loop_any s0
601{-# INLINE [0] any #-}
605{-# INLINE [0] any #-}
602
606
603-- | /O(n)/ all @p @xs determines if all characters in the 'Text'
607-- | /O(n)/ all @p @xs determines if all characters in the 'Text'
604−-- @xs@ satisify the predicate @p@.
608+-- @xs@ satisfy the predicate @p@.
605all :: (Char -> Bool) -> Stream Char -> Bool
609all :: (Char -> Bool) -> Stream Char -> Bool
606all p (Stream next0 s0 _len) = loop_all s0
610all p (Stream next0 s0 _len) = loop_all s0
607 where
611 where
@@ -650,50 +654,27 @@ minimum (Stream next0 s0 _len) = loop0_minimum s0
650-- * Building streams
654-- * Building streams
651
655
652scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
656scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
653−scanl f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low
657+scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
654 where
658 where
655 {-# INLINE next #-}
659 {-# INLINE next #-}
656− next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)
660+ next (Scan1 z s) = Yield z (Scan2 z s)
657− next (S2 :*: z :*: s) = case next0 s of
661+ next (Scan2 z s) = case next0 s of
658− Yield x s' -> let !x' = f z x
662+ Yield x s' -> let !x' = f z x
659− in Yield x' (S2 :*: x' :*: s')
663+ in Yield x' (Scan2 x' s')
660− Skip s' -> Skip (S2 :*: z :*: s')
664+ Skip s' -> Skip (Scan2 z s')
661− Done -> Done
665+ Done -> Done
662{-# INLINE [0] scanl #-}
666{-# INLINE [0] scanl #-}
663
667
664−-- -----------------------------------------------------------------------------
665−-- ** Accumulating maps
666−
667−{-
668−-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a
669−-- function to each element of a stream, passing an accumulating
670−-- parameter from left to right, and returns a final stream.
671−--
672−-- /Note/: Unlike the version over lists, this function does not
673−-- return a final value for the accumulator, because the nature of
674−-- streams precludes it.
675−mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b
676−mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :*: z0) len -- HINT depends on f
677− where
678− {-# INLINE next #-}
679− next (s :*: z) = case next0 s of
680− Yield x s' -> let (z',y) = f z x
681− in Yield y (s' :*: z')
682− Skip s' -> Skip (s' :*: z)
683− Done -> Done
684−{-# INLINE [0] mapAccumL #-}
685−-}
686−
687-- -----------------------------------------------------------------------------
668-- -----------------------------------------------------------------------------
688-- ** Generating and unfolding streams
669-- ** Generating and unfolding streams
689
670
690replicateCharI :: Integral a => a -> Char -> Stream Char
671replicateCharI :: Integral a => a -> Char -> Stream Char
691−replicateCharI n c
672+replicateCharI !n !c
692 | n < 0 = empty
673 | n < 0 = empty
693 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
674 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
694 where
675 where
695− next i | i >= n = Done
676+ next !i | i >= n = Done
696− | otherwise = Yield c (i + 1)
677+ | otherwise = Yield c (i + 1)
697{-# INLINE [0] replicateCharI #-}
678{-# INLINE [0] replicateCharI #-}
698
679
699data RI s = RI !s {-# UNPACK #-} !Int64
680data RI s = RI !s {-# UNPACK #-} !Int64
@@ -758,24 +739,27 @@ take n0 (Stream next0 s0 len) =
758 Yield x s' -> Yield x ((n-1) :*: s')
739 Yield x s' -> Yield x ((n-1) :*: s')
759{-# INLINE [0] take #-}
740{-# INLINE [0] take #-}
760
741
742+data Drop a s = NS !s
743+ | JS !a !s
744+
761-- | /O(n)/ drop n, applied to a stream, returns the suffix of the
745-- | /O(n)/ drop n, applied to a stream, returns the suffix of the
762-- stream after the first @n@ characters, or the empty stream if @n@
746-- stream after the first @n@ characters, or the empty stream if @n@
763-- is greater than the length of the stream.
747-- is greater than the length of the stream.
764drop :: Integral a => a -> Stream Char -> Stream Char
748drop :: Integral a => a -> Stream Char -> Stream Char
765drop n0 (Stream next0 s0 len) =
749drop n0 (Stream next0 s0 len) =
766− Stream next (J n0 :*: s0) (len - fromIntegral (max 0 n0))
750+ Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))
767 where
751 where
768 {-# INLINE next #-}
752 {-# INLINE next #-}
769− next (J n :*: s)
753+ next (JS n s)
770− | n <= 0 = Skip (N :*: s)
754+ | n <= 0 = Skip (NS s)
771 | otherwise = case next0 s of
755 | otherwise = case next0 s of
772 Done -> Done
756 Done -> Done
773− Skip s' -> Skip (J n :*: s')
757+ Skip s' -> Skip (JS n s')
774− Yield _ s' -> Skip (J (n-1) :*: s')
758+ Yield _ s' -> Skip (JS (n-1) s')
775− next (N :*: s) = case next0 s of
759+ next (NS s) = case next0 s of
776 Done -> Done
760 Done -> Done
777− Skip s' -> Skip (N :*: s')
761+ Skip s' -> Skip (NS s')
778− Yield x s' -> Yield x (N :*: s')
762+ Yield x s' -> Yield x (NS s')
779{-# INLINE [0] drop #-}
763{-# INLINE [0] drop #-}
780
764
781-- | takeWhile, applied to a predicate @p@ and a stream, returns the
765-- | takeWhile, applied to a predicate @p@ and a stream, returns the
@@ -793,18 +777,18 @@ takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
793
777
794-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
778-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
795dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
779dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
796−dropWhile p (Stream next0 s0 len) = Stream next (S1 :*: s0) len -- HINT maybe too high
780+dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
797 where
781 where
798 {-# INLINE next #-}
782 {-# INLINE next #-}
799− next (S1 :*: s) = case next0 s of
783+ next (L s) = case next0 s of
800 Done -> Done
784 Done -> Done
801− Skip s' -> Skip (S1 :*: s')
785+ Skip s' -> Skip (L s')
802− Yield x s' | p x -> Skip (S1 :*: s')
786+ Yield x s' | p x -> Skip (L s')
803− | otherwise -> Yield x (S2 :*: s')
787+ | otherwise -> Yield x (R s')
804− next (S2 :*: s) = case next0 s of
788+ next (R s) = case next0 s of
805 Done -> Done
789 Done -> Done
806− Skip s' -> Skip (S2 :*: s')
790+ Skip s' -> Skip (R s')
807− Yield x s' -> Yield x (S2 :*: s')
791+ Yield x s' -> Yield x (R s')
808{-# INLINE [0] dropWhile #-}
792{-# INLINE [0] dropWhile #-}
809
793
810-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
794-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
@@ -911,21 +895,25 @@ findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0
911-------------------------------------------------------------------------------
895-------------------------------------------------------------------------------
912-- * Zipping
896-- * Zipping
913
897
898+-- | Strict triple.
899+data Zip a b m = Z1 !a !b
900+ | Z2 !a !b !m
901+
914-- | zipWith generalises 'zip' by zipping with the function given as
902-- | zipWith generalises 'zip' by zipping with the function given as
915-- the first argument, instead of a tupling function.
903-- the first argument, instead of a tupling function.
916zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
904zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
917zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
905zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
918− Stream next (sa0 :*: sb0 :*: N) (smaller len1 len2)
906+ Stream next (Z1 sa0 sb0) (smaller len1 len2)
919 where
907 where
920− next (sa :*: sb :*: N) = case next0 sa of
908+ next (Z1 sa sb) = case next0 sa of
921− Done -> Done
909+ Done -> Done
922− Skip sa' -> Skip (sa' :*: sb :*: N)
910+ Skip sa' -> Skip (Z1 sa' sb)
923− Yield a sa' -> Skip (sa' :*: sb :*: J a)
911+ Yield a sa' -> Skip (Z2 sa' sb a)
924−
912+
925− next (sa' :*: sb :*: J a) = case next1 sb of
913+ next (Z2 sa' sb a) = case next1 sb of
926− Done -> Done
914+ Done -> Done
927− Skip sb' -> Skip (sa' :*: sb' :*: J a)
915+ Skip sb' -> Skip (Z2 sa' sb' a)
928− Yield b sb' -> Yield (f a b) (sa' :*: sb' :*: N)
916+ Yield b sb' -> Yield (f a b) (Z1 sa' sb')
929{-# INLINE [0] zipWith #-}
917{-# INLINE [0] zipWith #-}
930
918
931-- | /O(n)/ The 'countCharI' function returns the number of times the
919-- | /O(n)/ The 'countCharI' function returns the number of times the
Data/Text/Internal/Fusion/Size.hs+60−52
@@ -22,25 +22,28 @@ module Data.Text.Internal.Fusion.Size
22 , exactly
22 , exactly
23 , exactSize
23 , exactSize
24 , maxSize
24 , maxSize
25+ , betweenSize
25 , unknownSize
26 , unknownSize
26 , smaller
27 , smaller
27 , larger
28 , larger
28 , upperBound
29 , upperBound
30+ , lowerBound
31+ , compareSize
29 , isEmpty
32 , isEmpty
30 ) where
33 ) where
31
34
35+import Data.Text.Internal (mul)
32#if defined(ASSERTS)
36#if defined(ASSERTS)
33import Control.Exception (assert)
37import Control.Exception (assert)
34#endif
38#endif
35
39
36−data Size = Exact {-# UNPACK #-} !Int -- ^ Exact size.
40+data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.
37− | Max {-# UNPACK #-} !Int -- ^ Upper bound on size.
38− | Unknown -- ^ Unknown size.
41+ | Unknown -- ^ Unknown size.
39 deriving (Eq, Show)
42 deriving (Eq, Show)
40
43
41exactly :: Size -> Maybe Int
44exactly :: Size -> Maybe Int
42−exactly (Exact n) = Just n
45+exactly (Between na nb) | na == nb = Just na
43−exactly _ = Nothing
46+exactly _ = Nothing
44{-# INLINE exactly #-}
47{-# INLINE exactly #-}
45
48
46exactSize :: Int -> Size
49exactSize :: Int -> Size
@@ -48,7 +51,7 @@ exactSize n =
48#if defined(ASSERTS)
51#if defined(ASSERTS)
49 assert (n >= 0)
52 assert (n >= 0)
50#endif
53#endif
51− Exact n
54+ Between n n
52{-# INLINE exactSize #-}
55{-# INLINE exactSize #-}
53
56
54maxSize :: Int -> Size
57maxSize :: Int -> Size
@@ -56,9 +59,18 @@ maxSize n =
56#if defined(ASSERTS)
59#if defined(ASSERTS)
57 assert (n >= 0)
60 assert (n >= 0)
58#endif
61#endif
59− Max n
62+ Between 0 n
60{-# INLINE maxSize #-}
63{-# INLINE maxSize #-}
61
64
65+betweenSize :: Int -> Int -> Size
66+betweenSize m n =
67+#if defined(ASSERTS)
68+ assert (m >= 0)
69+ assert (n >= m)
70+#endif
71+ Between m n
72+{-# INLINE betweenSize #-}
73+
62unknownSize :: Size
74unknownSize :: Size
63unknownSize = Unknown
75unknownSize = Unknown
64{-# INLINE unknownSize #-}
76{-# INLINE unknownSize #-}
@@ -68,7 +80,7 @@ instance Num Size where
68 (-) = subtractSize
80 (-) = subtractSize
69 (*) = mulSize
81 (*) = mulSize
70
82
71− fromInteger = f where f = Exact . fromInteger
83+ fromInteger = f where f = exactSize . fromInteger
72 {-# INLINE f #-}
84 {-# INLINE f #-}
73
85
74add :: Int -> Int -> Int
86add :: Int -> Int -> Int
@@ -78,71 +90,67 @@ add m n | mn >= 0 = mn
78{-# INLINE add #-}
90{-# INLINE add #-}
79
91
80addSize :: Size -> Size -> Size
92addSize :: Size -> Size -> Size
81−addSize (Exact m) (Exact n) = Exact (add m n)
93+addSize (Between ma mb) (Between na nb) = Between (add ma na) (add mb nb)
82−addSize (Exact m) (Max n) = Max (add m n)
83−addSize (Max m) (Exact n) = Max (add m n)
84−addSize (Max m) (Max n) = Max (add m n)
85−addSize _ _ = Unknown
94+addSize _ _ = Unknown
86{-# INLINE addSize #-}
95{-# INLINE addSize #-}
87
96
88subtractSize :: Size -> Size -> Size
97subtractSize :: Size -> Size -> Size
89−subtractSize (Exact m) (Exact n) = Exact (max (m-n) 0)
98+subtractSize (Between ma mb) (Between na nb) = Between (max (ma-nb) 0) (max (mb-na) 0)
90−subtractSize (Exact m) (Max _) = Max m
91−subtractSize (Max m) (Exact n) = Max (max (m-n) 0)
92−subtractSize a@(Max _) (Max _) = a
99+subtractSize a@(Between 0 _) Unknown = a
93−subtractSize a@(Max _) Unknown = a
100+subtractSize (Between _ mb) Unknown = Between 0 mb
94−subtractSize _ _ = Unknown
101+subtractSize _ _ = Unknown
95{-# INLINE subtractSize #-}
102{-# INLINE subtractSize #-}
96
103
97−mul :: Int -> Int -> Int
98−mul m n
99− | m <= maxBound `quot` n = m * n
100− | otherwise = overflowError
101−{-# INLINE mul #-}
102−
103mulSize :: Size -> Size -> Size
104mulSize :: Size -> Size -> Size
104−mulSize (Exact m) (Exact n) = Exact (mul m n)
105+mulSize (Between ma mb) (Between na nb) = Between (mul ma na) (mul mb nb)
105−mulSize (Exact m) (Max n) = Max (mul m n)
106−mulSize (Max m) (Exact n) = Max (mul m n)
107−mulSize (Max m) (Max n) = Max (mul m n)
108−mulSize _ _ = Unknown
106+mulSize _ _ = Unknown
109{-# INLINE mulSize #-}
107{-# INLINE mulSize #-}
110
108
111-- | Minimum of two size hints.
109-- | Minimum of two size hints.
112smaller :: Size -> Size -> Size
110smaller :: Size -> Size -> Size
113−smaller (Exact m) (Exact n) = Exact (m `min` n)
111+smaller a@(Between ma mb) b@(Between na nb)
114−smaller (Exact m) (Max n) = Max (m `min` n)
112+ | mb <= na = a
115−smaller (Exact m) Unknown = Max m
113+ | nb <= ma = b
116−smaller (Max m) (Exact n) = Max (m `min` n)
114+ | otherwise = Between (ma `min` na) (mb `min` nb)
117−smaller (Max m) (Max n) = Max (m `min` n)
118−smaller a@(Max _) Unknown = a
115+smaller a@(Between 0 _) Unknown = a
119−smaller Unknown (Exact n) = Max n
116+smaller (Between _ mb) Unknown = Between 0 mb
117+smaller Unknown b@(Between 0 _) = b
120−smaller Unknown (Max n) = Max n
118+smaller Unknown (Between _ nb) = Between 0 nb
121−smaller Unknown Unknown = Unknown
119+smaller Unknown Unknown = Unknown
122{-# INLINE smaller #-}
120{-# INLINE smaller #-}
123
121
124-- | Maximum of two size hints.
122-- | Maximum of two size hints.
125larger :: Size -> Size -> Size
123larger :: Size -> Size -> Size
126−larger (Exact m) (Exact n) = Exact (m `max` n)
124+larger a@(Between ma mb) b@(Between na nb)
127−larger a@(Exact m) b@(Max n) | m >= n = a
125+ | ma >= nb = a
128− | otherwise = b
126+ | na >= mb = b
129−larger a@(Max m) b@(Exact n) | n >= m = b
130− | otherwise = a
127+ | otherwise = Between (ma `max` na) (mb `max` nb)
131−larger (Max m) (Max n) = Max (m `max` n)
132−larger _ _ = Unknown
128+larger _ _ = Unknown
133{-# INLINE larger #-}
129{-# INLINE larger #-}
134
130
135-- | Compute the maximum size from a size hint, if possible.
131-- | Compute the maximum size from a size hint, if possible.
136upperBound :: Int -> Size -> Int
132upperBound :: Int -> Size -> Int
137−upperBound _ (Exact n) = n
133+upperBound _ (Between _ n) = n
138−upperBound _ (Max n) = n
139−upperBound k _ = k
134+upperBound k _ = k
140{-# INLINE upperBound #-}
135{-# INLINE upperBound #-}
141
136
137+-- | Compute the maximum size from a size hint, if possible.
138+lowerBound :: Int -> Size -> Int
139+lowerBound _ (Between n _) = n
140+lowerBound k _ = k
141+{-# INLINE lowerBound #-}
142+
143+compareSize :: Size -> Int -> Maybe Ordering
144+compareSize (Between ma mb) n
145+ | mb < n = Just LT
146+ | ma > n = Just GT
147+ | ma == n && mb == n = Just EQ
148+compareSize _ _ = Nothing
149+
150+
142isEmpty :: Size -> Bool
151isEmpty :: Size -> Bool
143−isEmpty (Exact n) = n <= 0
152+isEmpty (Between _ n) = n <= 0
144−isEmpty (Max n) = n <= 0
145−isEmpty _ = False
153+isEmpty _ = False
146{-# INLINE isEmpty #-}
154{-# INLINE isEmpty #-}
147
155
148overflowError :: Int
156overflowError :: Int
Data/Text/Internal/Fusion/Types.hs+8−13
@@ -20,13 +20,11 @@
20module Data.Text.Internal.Fusion.Types
20module Data.Text.Internal.Fusion.Types
21 (
21 (
22 CC(..)
22 CC(..)
23− , M(..)
24− , M8
25 , PairS(..)
23 , PairS(..)
24+ , Scan(..)
26 , RS(..)
25 , RS(..)
27 , Step(..)
26 , Step(..)
28 , Stream(..)
27 , Stream(..)
29− , Switch(..)
30 , empty
28 , empty
31 ) where
29 ) where
32
30
@@ -36,26 +34,23 @@ import Data.Word (Word8)
36-- | Specialised tuple for case conversion.
34-- | Specialised tuple for case conversion.
37data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char
35data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char
38
36
39−-- | Specialised, strict Maybe-like type.
40−data M a = N
41− | J !a
42−
43−type M8 = M Word8
44−
45−-- Restreaming state.
37+-- | Restreaming state.
46data RS s
38data RS s
47 = RS0 !s
39 = RS0 !s
48 | RS1 !s {-# UNPACK #-} !Word8
40 | RS1 !s {-# UNPACK #-} !Word8
49 | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
41 | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
50 | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
42 | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
51
43
52−infixl 2 :*:
44+-- | Strict pair.
53data PairS a b = !a :*: !b
45data PairS a b = !a :*: !b
54 -- deriving (Eq, Ord, Show)
46 -- deriving (Eq, Ord, Show)
47+infixl 2 :*:
55
48
56−-- | Allow a function over a stream to switch between two states.
49+-- | An intermediate result in a scan.
57−data Switch = S1 | S2
50+data Scan s = Scan1 {-# UNPACK #-} !Char !s
51+ | Scan2 {-# UNPACK #-} !Char !s
58
52
53+-- | Intermediate result in a processing pipeline.
59data Step s a = Done
54data Step s a = Done
60 | Skip !s
55 | Skip !s
61 | Yield !a !s
56 | Yield !a !s
Data/Text/Internal/Private.hs+4−4
@@ -16,14 +16,14 @@ module Data.Text.Internal.Private
16 ) where
16 ) where
17
17
18import Control.Monad.ST (ST, runST)
18import Control.Monad.ST (ST, runST)
19−import Data.Text.Internal (Text(..), textP)
19+import Data.Text.Internal (Text(..), text)
20import Data.Text.Unsafe (Iter(..), iter)
20import Data.Text.Unsafe (Iter(..), iter)
21import qualified Data.Text.Array as A
21import qualified Data.Text.Array as A
22
22
23span_ :: (Char -> Bool) -> Text -> (# Text, Text #)
23span_ :: (Char -> Bool) -> Text -> (# Text, Text #)
24span_ p t@(Text arr off len) = (# hd,tl #)
24span_ p t@(Text arr off len) = (# hd,tl #)
25− where hd = textP arr off k
25+ where hd = text arr off k
26− tl = textP arr (off+k) (len-k)
26+ tl = text arr (off+k) (len-k)
27 !k = loop 0
27 !k = loop 0
28 loop !i | i < len && p c = loop (i+d)
28 loop !i | i < len && p c = loop (i+d)
29 | otherwise = i
29 | otherwise = i
@@ -33,5 +33,5 @@ span_ p t@(Text arr off len) = (# hd,tl #)
33runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text
33runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text
34runText act = runST (act $ \ !marr !len -> do
34runText act = runST (act $ \ !marr !len -> do
35 arr <- A.unsafeFreeze marr
35 arr <- A.unsafeFreeze marr
36− return $! textP arr 0 len)
36+ return $! text arr 0 len)
37{-# INLINE runText #-}
37{-# INLINE runText #-}
Data/Text/Internal/Read.hs+3−3
@@ -7,7 +7,7 @@
7-- Stability : experimental
7-- Stability : experimental
8-- Portability : GHC
8-- Portability : GHC
9--
9--
10−-- Common internal functiopns for reading textual data.
10+-- Common internal functions for reading textual data.
11module Data.Text.Internal.Read
11module Data.Text.Internal.Read
12 (
12 (
13 IReader
13 IReader
@@ -18,7 +18,7 @@ module Data.Text.Internal.Read
18 , perhaps
18 , perhaps
19 ) where
19 ) where
20
20
21−import Control.Applicative (Applicative(..))
21+import Control.Applicative as App (Applicative(..))
22import Control.Arrow (first)
22import Control.Arrow (first)
23import Control.Monad (ap)
23import Control.Monad (ap)
24import Data.Char (ord)
24import Data.Char (ord)
@@ -38,7 +38,7 @@ instance Applicative (IParser t) where
38 (<*>) = ap
38 (<*>) = ap
39
39
40instance Monad (IParser t) where
40instance Monad (IParser t) where
41− return = pure
41+ return = App.pure
42 m >>= k = P $ \t -> case runP m t of
42 m >>= k = P $ \t -> case runP m t of
43 Left err -> Left err
43 Left err -> Left err
44 Right (a,t') -> runP (k a) t'
44 Right (a,t') -> runP (k a) t'
Data/Text/Lazy.hs+200−25
@@ -3,6 +3,10 @@
3#if __GLASGOW_HASKELL__ >= 702
3#if __GLASGOW_HASKELL__ >= 702
4{-# LANGUAGE Trustworthy #-}
4{-# LANGUAGE Trustworthy #-}
5#endif
5#endif
6+#if __GLASGOW_HASKELL__ >= 708
7+{-# LANGUAGE TypeFamilies #-}
8+#endif
9+
6-- |
10-- |
7-- Module : Data.Text.Lazy
11-- Module : Data.Text.Lazy
8-- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan
12-- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan
@@ -121,7 +125,10 @@ module Data.Text.Lazy
121 , mapAccumR
125 , mapAccumR
122
126
123 -- ** Generation and unfolding
127 -- ** Generation and unfolding
128+ , repeat
124 , replicate
129 , replicate
130+ , cycle
131+ , iterate
125 , unfoldr
132 , unfoldr
126 , unfoldrN
133 , unfoldrN
127
134
@@ -129,8 +136,11 @@ module Data.Text.Lazy
129
136
130 -- ** Breaking strings
137 -- ** Breaking strings
131 , take
138 , take
139+ , takeEnd
132 , drop
140 , drop
141+ , dropEnd
133 , takeWhile
142 , takeWhile
143+ , takeWhileEnd
134 , dropWhile
144 , dropWhile
135 , dropWhileEnd
145 , dropWhileEnd
136 , dropAround
146 , dropAround
@@ -201,9 +211,13 @@ import Control.DeepSeq (NFData(..))
201import Data.Int (Int64)
211import Data.Int (Int64)
202import qualified Data.List as L
212import qualified Data.List as L
203import Data.Char (isSpace)
213import Data.Char (isSpace)
204−import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))
214+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
205−import Data.Data (mkNoRepType)
215+ Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
216+import Data.Binary (Binary(get, put))
206import Data.Monoid (Monoid(..))
217import Data.Monoid (Monoid(..))
218+#if MIN_VERSION_base(4,9,0)
219+import Data.Semigroup (Semigroup(..))
220+#endif
207import Data.String (IsString(..))
221import Data.String (IsString(..))
208import qualified Data.Text as T
222import qualified Data.Text as T
209import qualified Data.Text.Internal as T
223import qualified Data.Text.Internal as T
@@ -212,8 +226,10 @@ import qualified Data.Text.Unsafe as T
212import qualified Data.Text.Internal.Lazy.Fusion as S
226import qualified Data.Text.Internal.Lazy.Fusion as S
213import Data.Text.Internal.Fusion.Types (PairS(..))
227import Data.Text.Internal.Fusion.Types (PairS(..))
214import Data.Text.Internal.Lazy.Fusion (stream, unstream)
228import Data.Text.Internal.Lazy.Fusion (stream, unstream)
215−import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks, foldrChunks)
229+import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks,
230+ foldrChunks, smallChunkSize)
216−import Data.Text.Internal (firstf, safe, textP)
231+import Data.Text.Internal (firstf, safe, text)
232+import Data.Text.Lazy.Encoding (decodeUtf8', encodeUtf8)
217import qualified Data.Text.Internal.Functions as F
233import qualified Data.Text.Internal.Functions as F
218import Data.Text.Internal.Lazy.Search (indices)
234import Data.Text.Internal.Lazy.Search (indices)
219#if __GLASGOW_HASKELL__ >= 702
235#if __GLASGOW_HASKELL__ >= 702
@@ -221,7 +237,13 @@ import qualified GHC.CString as GHC
221#else
237#else
222import qualified GHC.Base as GHC
238import qualified GHC.Base as GHC
223#endif
239#endif
240+#if __GLASGOW_HASKELL__ >= 708
241+import qualified GHC.Exts as Exts
242+#endif
224import GHC.Prim (Addr#)
243import GHC.Prim (Addr#)
244+#if MIN_VERSION_base(4,7,0)
245+import Text.Printf (PrintfArg, formatArg, formatString)
246+#endif
225
247
226-- $fusion
248-- $fusion
227--
249--
@@ -319,25 +341,71 @@ instance Show Text where
319instance Read Text where
341instance Read Text where
320 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
342 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
321
343
344+#if MIN_VERSION_base(4,9,0)
345+-- Semigroup orphan instances for older GHCs are provided by
346+-- 'semigroups` package
347+
348+instance Semigroup Text where
349+ (<>) = append
350+#endif
351+
322instance Monoid Text where
352instance Monoid Text where
323 mempty = empty
353 mempty = empty
354+#if MIN_VERSION_base(4,9,0)
355+ mappend = (<>) -- future-proof definition
356+#else
324 mappend = append
357 mappend = append
358+#endif
325 mconcat = concat
359 mconcat = concat
326
360
327instance IsString Text where
361instance IsString Text where
328 fromString = pack
362 fromString = pack
329
363
364+#if __GLASGOW_HASKELL__ >= 708
365+instance Exts.IsList Text where
366+ type Item Text = Char
367+ fromList = pack
368+ toList = unpack
369+#endif
370+
330#if defined(HAVE_DEEPSEQ)
371#if defined(HAVE_DEEPSEQ)
331instance NFData Text where
372instance NFData Text where
332 rnf Empty = ()
373 rnf Empty = ()
333 rnf (Chunk _ ts) = rnf ts
374 rnf (Chunk _ ts) = rnf ts
334#endif
375#endif
335
376
377+instance Binary Text where
378+ put t = put (encodeUtf8 t)
379+ get = do
380+ bs <- get
381+ case decodeUtf8' bs of
382+ P.Left exn -> P.fail (P.show exn)
383+ P.Right a -> P.return a
384+
385+-- | This instance preserves data abstraction at the cost of inefficiency.
386+-- We omit reflection services for the sake of data abstraction.
387+--
388+-- This instance was created by copying the updated behavior of
389+-- @"Data.Text".@'Data.Text.Text'
336instance Data Text where
390instance Data Text where
337 gfoldl f z txt = z pack `f` (unpack txt)
391 gfoldl f z txt = z pack `f` (unpack txt)
338− toConstr _ = error "Data.Text.Lazy.Text.toConstr"
392+ toConstr _ = packConstr
393+ gunfold k z c = case constrIndex c of
394+ 1 -> k (z pack)
339− gunfold _ _ = error "Data.Text.Lazy.Text.gunfold"
395+ _ -> error "Data.Text.Lazy.Text.gunfold"
340− dataTypeOf _ = mkNoRepType "Data.Text.Lazy.Text"
396+ dataTypeOf _ = textDataType
397+
398+#if MIN_VERSION_base(4,7,0)
399+-- | Only defined for @base-4.7.0.0@ and later
400+instance PrintfArg Text where
401+ formatArg txt = formatString $ unpack txt
402+#endif
403+
404+packConstr :: Constr
405+packConstr = mkConstr textDataType "pack" [] Prefix
406+
407+textDataType :: DataType
408+textDataType = mkDataType "Data.Text.Lazy.Text" [packConstr]
341
409
342-- | /O(n)/ Convert a 'String' into a 'Text'.
410-- | /O(n)/ Convert a 'String' into a 'Text'.
343--
411--
@@ -365,6 +433,14 @@ unpackCString# addr# = unstream (S.streamCString# addr#)
365 unstream (S.streamList (L.map safe (GHC.unpackCStringUtf8# a)))
433 unstream (S.streamList (L.map safe (GHC.unpackCStringUtf8# a)))
366 = unpackCString# a #-}
434 = unpackCString# a #-}
367
435
436+{-# RULES "LAZY TEXT empty literal"
437+ unstream (S.streamList (L.map safe []))
438+ = Empty #-}
439+
440+{-# RULES "LAZY TEXT empty literal" forall a.
441+ unstream (S.streamList (L.map safe [a]))
442+ = Chunk (T.singleton a) Empty #-}
443+
368-- | /O(1)/ Convert a character into a Text. Subject to fusion.
444-- | /O(1)/ Convert a character into a Text. Subject to fusion.
369-- Performs replacement on invalid scalar values.
445-- Performs replacement on invalid scalar values.
370singleton :: Char -> Text
446singleton :: Char -> Text
@@ -469,7 +545,7 @@ tail Empty = emptyError "tail"
469 unstream (S.tail (stream t)) = tail t
545 unstream (S.tail (stream t)) = tail t
470 #-}
546 #-}
471
547
472−-- | /O(1)/ Returns all but the last character of a 'Text', which must
548+-- | /O(n\/c)/ Returns all but the last character of a 'Text', which must
473-- be non-empty. Subject to fusion.
549-- be non-empty. Subject to fusion.
474init :: Text -> Text
550init :: Text -> Text
475init (Chunk t0 ts0) = go t0 ts0
551init (Chunk t0 ts0) = go t0 ts0
@@ -505,7 +581,7 @@ isSingleton :: Text -> Bool
505isSingleton = S.isSingleton . stream
581isSingleton = S.isSingleton . stream
506{-# INLINE isSingleton #-}
582{-# INLINE isSingleton #-}
507
583
508−-- | /O(1)/ Returns the last character of a 'Text', which must be
584+-- | /O(n\/c)/ Returns the last character of a 'Text', which must be
509-- non-empty. Subject to fusion.
585-- non-empty. Subject to fusion.
510last :: Text -> Char
586last :: Text -> Char
511last Empty = emptyError "last"
587last Empty = emptyError "last"
@@ -639,13 +715,36 @@ reverse = rev Empty
639 where rev a Empty = a
715 where rev a Empty = a
640 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts
716 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts
641
717
642−-- | /O(m+n)/ Replace every occurrence of one substring with another.
718+-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
719+-- @haystack@ with @replacement@.
720+--
721+-- This function behaves as though it was defined as follows:
722+--
723+-- @
724+-- replace needle replacement haystack =
725+-- 'intercalate' replacement ('splitOn' needle haystack)
726+-- @
727+--
728+-- As this suggests, each occurrence is replaced exactly once. So if
729+-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
730+-- be replaced recursively:
731+--
732+-- > replace "oo" "foo" "oo" == "foo"
733+--
734+-- In cases where several instances of @needle@ overlap, only the
735+-- first one will be replaced:
736+--
737+-- > replace "ofo" "bar" "ofofo" == "barfo"
643--
738--
644-- In (unlikely) bad cases, this function's time complexity degrades
739-- In (unlikely) bad cases, this function's time complexity degrades
645-- towards /O(n*m)/.
740-- towards /O(n*m)/.
646−replace :: Text -- ^ Text to search for
741+replace :: Text
647− -> Text -- ^ Replacement text
742+ -- ^ @needle@ to search for. If this string is empty, an
743+ -- error will occur.
744+ -> Text
745+ -- ^ @replacement@ to replace @needle@ with.
648− -> Text -- ^ Input text
746+ -> Text
747+ -- ^ @haystack@ in which to search.
649 -> Text
748 -> Text
650replace s d = intercalate d . splitOn s
749replace s d = intercalate d . splitOn s
651{-# INLINE replace #-}
750{-# INLINE replace #-}
@@ -782,13 +881,13 @@ concatMap f = concat . foldr ((:) . f) []
782{-# INLINE concatMap #-}
881{-# INLINE concatMap #-}
783
882
784-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
883-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
785−-- 'Text' @t@ satisifes the predicate @p@. Subject to fusion.
884+-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
786any :: (Char -> Bool) -> Text -> Bool
885any :: (Char -> Bool) -> Text -> Bool
787any p t = S.any p (stream t)
886any p t = S.any p (stream t)
788{-# INLINE any #-}
887{-# INLINE any #-}
789
888
790-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
889-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
791−-- 'Text' @t@ satisify the predicate @p@. Subject to fusion.
890+-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
792all :: (Char -> Bool) -> Text -> Bool
891all :: (Char -> Bool) -> Text -> Bool
793all p t = S.all p (stream t)
892all p t = S.all p (stream t)
794{-# INLINE all #-}
893{-# INLINE all #-}
@@ -871,6 +970,12 @@ mapAccumR f = go
871 go z Empty = (z, Empty)
970 go z Empty = (z, Empty)
872{-# INLINE mapAccumR #-}
971{-# INLINE mapAccumR #-}
873
972
973+-- | @'repeat' x@ is an infinite 'Text', with @x@ the value of every
974+-- element.
975+repeat :: Char -> Text
976+repeat c = let t = Chunk (T.replicate smallChunkSize (T.singleton c)) t
977+ in t
978+
874-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
979-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
875-- @t@ repeated @n@ times.
980-- @t@ repeated @n@ times.
876replicate :: Int64 -> Text -> Text
981replicate :: Int64 -> Text -> Text
@@ -882,6 +987,21 @@ replicate n t
882 | otherwise = t : rep (i+1)
987 | otherwise = t : rep (i+1)
883{-# INLINE [1] replicate #-}
988{-# INLINE [1] replicate #-}
884
989
990+-- | 'cycle' ties a finite, non-empty 'Text' into a circular one, or
991+-- equivalently, the infinite repetition of the original 'Text'.
992+cycle :: Text -> Text
993+cycle Empty = emptyError "cycle"
994+cycle t = let t' = foldrChunks Chunk t' t
995+ in t'
996+
997+-- | @'iterate' f x@ returns an infinite 'Text' of repeated applications
998+-- of @f@ to @x@:
999+--
1000+-- > iterate f x == [x, f x, f (f x), ...]
1001+iterate :: (Char -> Char) -> Char -> Text
1002+iterate f c = let t c' = Chunk (T.singleton c') (t (f c'))
1003+ in t c
1004+
885-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
1005-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
886-- value of every element. Subject to fusion.
1006-- value of every element. Subject to fusion.
887replicateChar :: Int64 -> Char -> Text
1007replicateChar :: Int64 -> Char -> Text
@@ -935,6 +1055,22 @@ take i t0 = take' i t0
935 unstream (S.take n (stream t)) = take n t
1055 unstream (S.take n (stream t)) = take n t
936 #-}
1056 #-}
937
1057
1058+-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after
1059+-- taking @n@ characters from the end of @t@.
1060+--
1061+-- Examples:
1062+--
1063+-- > takeEnd 3 "foobar" == "bar"
1064+takeEnd :: Int64 -> Text -> Text
1065+takeEnd n t0
1066+ | n <= 0 = empty
1067+ | otherwise = takeChunk n empty . L.reverse . toChunks $ t0
1068+ where takeChunk _ acc [] = acc
1069+ takeChunk i acc (t:ts)
1070+ | i <= l = chunk (T.takeEnd (fromIntegral i) t) acc
1071+ | otherwise = takeChunk (i-l) (Chunk t acc) ts
1072+ where l = fromIntegral (T.length t)
1073+
938-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1074-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
939-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1075-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
940-- is greater than the length of the 'Text'. Subject to fusion.
1076-- is greater than the length of the 'Text'. Subject to fusion.
@@ -957,6 +1093,23 @@ drop i t0
957 unstream (S.drop n (stream t)) = drop n t
1093 unstream (S.drop n (stream t)) = drop n t
958 #-}
1094 #-}
959
1095
1096+-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after
1097+-- dropping @n@ characters from the end of @t@.
1098+--
1099+-- Examples:
1100+--
1101+-- > dropEnd 3 "foobar" == "foo"
1102+dropEnd :: Int64 -> Text -> Text
1103+dropEnd n t0
1104+ | n <= 0 = t0
1105+ | otherwise = dropChunk n . L.reverse . toChunks $ t0
1106+ where dropChunk _ [] = empty
1107+ dropChunk m (t:ts)
1108+ | m >= l = dropChunk (m-l) ts
1109+ | otherwise = fromChunks . L.reverse $
1110+ T.dropEnd (fromIntegral m) t : ts
1111+ where l = fromIntegral (T.length t)
1112+
960-- | /O(n)/ 'dropWords' @n@ returns the suffix with @n@ 'Word16'
1113-- | /O(n)/ 'dropWords' @n@ returns the suffix with @n@ 'Word16'
961-- values dropped, or the empty 'Text' if @n@ is greater than the
1114-- values dropped, or the empty 'Text' if @n@ is greater than the
962-- number of 'Word16' values present.
1115-- number of 'Word16' values present.
@@ -967,7 +1120,7 @@ dropWords i t0
967 where drop' 0 ts = ts
1120 where drop' 0 ts = ts
968 drop' _ Empty = Empty
1121 drop' _ Empty = Empty
969 drop' n (Chunk (T.Text arr off len) ts)
1122 drop' n (Chunk (T.Text arr off len) ts)
970− | n < len' = chunk (textP arr (off+n') (len-n')) ts
1123+ | n < len' = chunk (text arr (off+n') (len-n')) ts
971 | otherwise = drop' (n - len') ts
1124 | otherwise = drop' (n - len') ts
972 where len' = fromIntegral len
1125 where len' = fromIntegral len
973 n' = fromIntegral n
1126 n' = fromIntegral n
@@ -991,6 +1144,20 @@ takeWhile p t0 = takeWhile' t0
991"LAZY TEXT takeWhile -> unfused" [1] forall p t.
1144"LAZY TEXT takeWhile -> unfused" [1] forall p t.
992 unstream (S.takeWhile p (stream t)) = takeWhile p t
1145 unstream (S.takeWhile p (stream t)) = takeWhile p t
993 #-}
1146 #-}
1147+-- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',
1148+-- returns the longest suffix (possibly empty) of elements that
1149+-- satisfy @p@.
1150+-- Examples:
1151+--
1152+-- > takeWhileEnd (=='o') "foo" == "oo"
1153+takeWhileEnd :: (Char -> Bool) -> Text -> Text
1154+takeWhileEnd p = takeChunk empty . L.reverse . toChunks
1155+ where takeChunk acc [] = acc
1156+ takeChunk acc (t:ts) = if T.length t' < T.length t
1157+ then (Chunk t' acc)
1158+ else takeChunk (Chunk t' acc) ts
1159+ where t' = T.takeWhileEnd p t
1160+{-# INLINE takeWhileEnd #-}
994
1161
995-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1162-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
996-- 'takeWhile' @p@ @t@. Subject to fusion.
1163-- 'takeWhile' @p@ @t@. Subject to fusion.
@@ -1009,9 +1176,11 @@ dropWhile p t0 = dropWhile' t0
1009"LAZY TEXT dropWhile -> unfused" [1] forall p t.
1176"LAZY TEXT dropWhile -> unfused" [1] forall p t.
1010 unstream (S.dropWhile p (stream t)) = dropWhile p t
1177 unstream (S.dropWhile p (stream t)) = dropWhile p t
1011 #-}
1178 #-}
1179+
1012-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1180-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1013−-- dropping characters that fail the predicate @p@ from the end of
1181+-- dropping characters that satisfy the predicate @p@ from the end of
1014-- @t@.
1182-- @t@.
1183+--
1015-- Examples:
1184-- Examples:
1016--
1185--
1017-- > dropWhileEnd (=='.') "foo..." == "foo"
1186-- > dropWhileEnd (=='.') "foo..." == "foo"
@@ -1028,7 +1197,7 @@ dropWhileEnd p = go
1028{-# INLINE dropWhileEnd #-}
1197{-# INLINE dropWhileEnd #-}
1029
1198
1030-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1199-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1031−-- dropping characters that fail the predicate @p@ from both the
1200+-- dropping characters that satisfy the predicate @p@ from both the
1032-- beginning and end of @t@. Subject to fusion.
1201-- beginning and end of @t@. Subject to fusion.
1033dropAround :: (Char -> Bool) -> Text -> Text
1202dropAround :: (Char -> Bool) -> Text -> Text
1034dropAround p = dropWhile p . dropWhileEnd p
1203dropAround p = dropWhile p . dropWhileEnd p
@@ -1078,8 +1247,8 @@ splitAtWord _ Empty = empty :*: empty
1078splitAtWord x (Chunk c@(T.Text arr off len) cs)
1247splitAtWord x (Chunk c@(T.Text arr off len) cs)
1079 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1248 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1080 in Chunk c h :*: t
1249 in Chunk c h :*: t
1081− | otherwise = chunk (textP arr off y) empty :*:
1250+ | otherwise = chunk (text arr off y) empty :*:
1082− chunk (textP arr (off+y) (len-y)) cs
1251+ chunk (text arr (off+y) (len-y)) cs
1083 where y = fromIntegral x
1252 where y = fromIntegral x
1084
1253
1085-- | /O(n+m)/ Find the first instance of @needle@ (which must be
1254-- | /O(n+m)/ Find the first instance of @needle@ (which must be
@@ -1223,9 +1392,10 @@ tails ts@(Chunk t ts')
1223-- copies to create substrings; they just construct new 'Text's that
1392-- copies to create substrings; they just construct new 'Text's that
1224-- are slices of the original.
1393-- are slices of the original.
1225
1394
1226−-- | /O(m+n)/ Break a 'Text' into pieces separated by the first
1395+-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'
1227−-- 'Text' argument, consuming the delimiter. An empty delimiter is
1396+-- argument (which cannot be an empty string), consuming the
1228−-- invalid, and will cause an error to be raised.
1397+-- delimiter. An empty delimiter is invalid, and will cause an error
1398+-- to be raised.
1229--
1399--
1230-- Examples:
1400-- Examples:
1231--
1401--
@@ -1238,13 +1408,18 @@ tails ts@(Chunk t ts')
1238-- > intercalate s . splitOn s == id
1408-- > intercalate s . splitOn s == id
1239-- > splitOn (singleton c) == split (==c)
1409-- > splitOn (singleton c) == split (==c)
1240--
1410--
1411+-- (Note: the string @s@ to split on above cannot be empty.)
1412+--
1241-- This function is strict in its first argument, and lazy in its
1413-- This function is strict in its first argument, and lazy in its
1242-- second.
1414-- second.
1243--
1415--
1244-- In (unlikely) bad cases, this function's time complexity degrades
1416-- In (unlikely) bad cases, this function's time complexity degrades
1245-- towards /O(n*m)/.
1417-- towards /O(n*m)/.
1246−splitOn :: Text -- ^ Text to split on
1418+splitOn :: Text
1419+ -- ^ String to split on. If this string is empty, an error
1420+ -- will occur.
1421+ -> Text
1247− -> Text -- ^ Input text
1422+ -- ^ Input text.
1248 -> [Text]
1423 -> [Text]
1249splitOn pat src
1424splitOn pat src
1250 | null pat = emptyError "splitOn"
1425 | null pat = emptyError "splitOn"
Data/Text/Lazy/Builder.hs+1−1
@@ -8,7 +8,7 @@
8-- Module : Data.Text.Lazy.Builder
8-- Module : Data.Text.Lazy.Builder
9-- Copyright : (c) 2013 Bryan O'Sullivan
9-- Copyright : (c) 2013 Bryan O'Sullivan
10-- (c) 2010 Johan Tibell
10-- (c) 2010 Johan Tibell
11−-- License : BSD3-style (see LICENSE)
11+-- License : BSD-style (see LICENSE)
12--
12--
13-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
13-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
14-- Stability : experimental
14-- 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 #-}
2#if __GLASGOW_HASKELL__ >= 702
3#if __GLASGOW_HASKELL__ >= 702
3{-# LANGUAGE Trustworthy #-}
4{-# LANGUAGE Trustworthy #-}
4#endif
5#endif
@@ -6,7 +7,7 @@
6-- Module: Data.Text.Lazy.Builder.Int
7-- Module: Data.Text.Lazy.Builder.Int
7-- Copyright: (c) 2013 Bryan O'Sullivan
8-- Copyright: (c) 2013 Bryan O'Sullivan
8-- (c) 2011 MailRank, Inc.
9-- (c) 2011 MailRank, Inc.
9−-- License: BSD3
10+-- License: BSD-style
10-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
11-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
11-- Stability: experimental
12-- Stability: experimental
12-- Portability: portable
13-- Portability: portable
@@ -34,7 +35,7 @@ import Control.Monad.ST
34
35
35#ifdef __GLASGOW_HASKELL__
36#ifdef __GLASGOW_HASKELL__
36# if defined(INTEGER_GMP)
37# if defined(INTEGER_GMP)
37−import GHC.Integer.GMP.Internals
38+import GHC.Integer.GMP.Internals (Integer(S#))
38# elif defined(INTEGER_SIMPLE)
39# elif defined(INTEGER_SIMPLE)
39import GHC.Integer
40import GHC.Integer
40# else
41# else
@@ -54,7 +55,7 @@ decimal :: Integral a => a -> Builder
54{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}
55{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}
55{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}
56{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}
56{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}
57{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}
57−{-# RULES "decimal/Word" decimal = positive :: Word -> Builder #-}
58+{-# RULES "decimal/Word" decimal = positive :: Data.Word.Word -> Builder #-}
58{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}
59{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}
59{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}
60{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}
60{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}
61{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}
@@ -133,8 +134,15 @@ i2w v = zero + fromIntegral v
133
134
134countDigits :: (Integral a) => a -> Int
135countDigits :: (Integral a) => a -> Int
135{-# INLINE countDigits #-}
136{-# INLINE countDigits #-}
136−countDigits v0 = go 1 (fromIntegral v0 :: Word64)
137+countDigits v0
137− where go !k v
138+ | fromIntegral v64 == v0 = go 1 v64
139+ | otherwise = goBig 1 (fromIntegral v0)
140+ where v64 = fromIntegral v0
141+ goBig !k (v :: Integer)
142+ | v > big = goBig (k + 19) (v `quot` big)
143+ | otherwise = go k (fromIntegral v)
144+ big = 10000000000000000000
145+ go !k (v :: Word64)
138 | v < 10 = k
146 | v < 10 = k
139 | v < 100 = k + 1
147 | v < 100 = k + 1
140 | v < 1000 = k + 2
148 | v < 1000 = k + 2
@@ -186,19 +194,12 @@ hexDigit n
186 | otherwise = singleton $! toEnum (fromIntegral n + 87)
194 | otherwise = singleton $! toEnum (fromIntegral n + 87)
187{-# INLINE hexDigit #-}
195{-# INLINE hexDigit #-}
188
196
189−int :: Int -> Builder
190−int = decimal
191−{-# INLINE int #-}
192−
193data T = T !Integer !Int
197data T = T !Integer !Int
194
198
195integer :: Int -> Integer -> Builder
199integer :: Int -> Integer -> Builder
196#ifdef INTEGER_GMP
200#ifdef INTEGER_GMP
197integer 10 (S# i#) = decimal (I# i#)
201integer 10 (S# i#) = decimal (I# i#)
198integer 16 (S# i#) = hexadecimal (I# i#)
202integer 16 (S# i#) = hexadecimal (I# i#)
199−#else
200−integer 10 i = decimal i
201−integer 16 i = hexadecimal i
202#endif
203#endif
203integer base i
204integer base i
204 | i < 0 = singleton '-' <> go (-i)
205 | i < 0 = singleton '-' <> go (-i)
@@ -246,7 +247,11 @@ integer base i
246 PAIR(x,y) -> pblock q <> pblock r <> putB ns
247 PAIR(x,y) -> pblock q <> pblock r <> putB ns
247 where q = fromInteger x
248 where q = fromInteger x
248 r = fromInteger y
249 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
250
255
251 pblock = loop maxDigits
256 pblock = loop maxDigits
252 where
257 where
Data/Text/Lazy/Encoding.hs+9−21
@@ -46,30 +46,25 @@ module Data.Text.Lazy.Encoding
46 , encodeUtf32LE
46 , encodeUtf32LE
47 , encodeUtf32BE
47 , encodeUtf32BE
48
48
49−#if MIN_VERSION_bytestring(0,10,4)
50 -- * Encoding Text using ByteString Builders
49 -- * Encoding Text using ByteString Builders
51 , encodeUtf8Builder
50 , encodeUtf8Builder
52 , encodeUtf8BuilderEscaped
51 , encodeUtf8BuilderEscaped
53−#endif
54 ) where
52 ) where
55
53
56import Control.Exception (evaluate, try)
54import Control.Exception (evaluate, try)
55+import Data.Monoid (Monoid(..))
57import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
56import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
58import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldrChunks)
57import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldrChunks)
59−import qualified Data.ByteString as S
60−import qualified Data.ByteString.Lazy as B
61−import qualified Data.ByteString.Lazy.Internal as B
62−import qualified Data.ByteString.Unsafe as B
63−#if MIN_VERSION_bytestring(0,10,4)
64import Data.Word (Word8)
58import Data.Word (Word8)
65−import Data.Monoid (mempty, (<>))
59+import qualified Data.ByteString as S
66import qualified Data.ByteString.Builder as B
60import qualified Data.ByteString.Builder as B
67import qualified Data.ByteString.Builder.Extra as B (safeStrategy, toLazyByteStringWith)
61import qualified Data.ByteString.Builder.Extra as B (safeStrategy, toLazyByteStringWith)
68import qualified Data.ByteString.Builder.Prim as BP
62import qualified Data.ByteString.Builder.Prim as BP
63+import qualified Data.ByteString.Lazy as B
64+import qualified Data.ByteString.Lazy.Internal as B
65+import qualified Data.ByteString.Unsafe as B
69import qualified Data.Text as T
66import qualified Data.Text as T
70−#endif
71import qualified Data.Text.Encoding as TE
67import qualified Data.Text.Encoding as TE
72−import qualified Data.Text.Lazy as L
73import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E
68import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E
74import qualified Data.Text.Internal.Lazy.Fusion as F
69import qualified Data.Text.Internal.Lazy.Fusion as F
75import Data.Text.Unsafe (unsafeDupablePerformIO)
70import Data.Text.Unsafe (unsafeDupablePerformIO)
@@ -89,8 +84,6 @@ import Data.Text.Unsafe (unsafeDupablePerformIO)
89
84
90-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
85-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
91-- encoded text.
86-- encoded text.
92−--
93−-- This function is deprecated. Use 'decodeLatin1' instead.
94decodeASCII :: B.ByteString -> Text
87decodeASCII :: B.ByteString -> Text
95decodeASCII = decodeUtf8
88decodeASCII = decodeUtf8
96{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
89{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
@@ -112,7 +105,7 @@ decodeUtf8With onErr (B.Chunk b0 bs0) =
112 | S.null l = empty
105 | S.null l = empty
113 | otherwise = case onErr desc (Just (B.unsafeHead l)) of
106 | otherwise = case onErr desc (Just (B.unsafeHead l)) of
114 Nothing -> empty
107 Nothing -> empty
115− Just c -> L.singleton c
108+ Just c -> Chunk (T.singleton c) Empty
116 desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"
109 desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"
117decodeUtf8With _ _ = empty
110decodeUtf8With _ _ = empty
118
111
@@ -149,7 +142,6 @@ decodeUtf8' bs = unsafeDupablePerformIO $ do
149{-# INLINE decodeUtf8' #-}
142{-# INLINE decodeUtf8' #-}
150
143
151encodeUtf8 :: Text -> B.ByteString
144encodeUtf8 :: Text -> B.ByteString
152−#if MIN_VERSION_bytestring(0,10,4)
153encodeUtf8 Empty = B.empty
145encodeUtf8 Empty = B.empty
154encodeUtf8 lt@(Chunk t _) =
146encodeUtf8 lt@(Chunk t _) =
155 B.toLazyByteStringWith strategy B.empty $ encodeUtf8Builder lt
147 B.toLazyByteStringWith strategy B.empty $ encodeUtf8Builder lt
@@ -163,17 +155,13 @@ encodeUtf8 lt@(Chunk t _) =
163 strategy = B.safeStrategy firstChunkSize B.defaultChunkSize
155 strategy = B.safeStrategy firstChunkSize B.defaultChunkSize
164
156
165encodeUtf8Builder :: Text -> B.Builder
157encodeUtf8Builder :: Text -> B.Builder
158+encodeUtf8Builder =
166−encodeUtf8Builder = foldrChunks (\c b -> TE.encodeUtf8Builder c <> b) mempty
159+ foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) Data.Monoid.mempty
167
160
168{-# INLINE encodeUtf8BuilderEscaped #-}
161{-# INLINE encodeUtf8BuilderEscaped #-}
169encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
162encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
170encodeUtf8BuilderEscaped prim =
163encodeUtf8BuilderEscaped prim =
171− foldrChunks (\c b -> TE.encodeUtf8BuilderEscaped prim c <> b) mempty
164+ foldrChunks (\c b -> TE.encodeUtf8BuilderEscaped prim c `mappend` b) mempty
172−
173−#else
174−encodeUtf8 (Chunk c cs) = B.Chunk (TE.encodeUtf8 c) (encodeUtf8 cs)
175−encodeUtf8 Empty = B.Empty
176−#endif
177
165
178-- | Decode text from little endian UTF-16 encoding.
166-- | Decode text from little endian UTF-16 encoding.
179decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text
167decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text
Data/Text/Lazy/Read.hs+4−2
@@ -1,5 +1,7 @@
1{-# LANGUAGE OverloadedStrings, CPP #-}
1{-# LANGUAGE OverloadedStrings, CPP #-}
2−#if __GLASGOW_HASKELL__ >= 702
2+#if __GLASGOW_HASKELL__ >= 704
3+{-# LANGUAGE Safe #-}
4+#elif __GLASGOW_HASKELL__ >= 702
3{-# LANGUAGE Trustworthy #-}
5{-# LANGUAGE Trustworthy #-}
4#endif
6#endif
5
7
@@ -54,7 +56,7 @@ decimal :: Integral a => Reader a
54{-# SPECIALIZE decimal :: Reader Int32 #-}
56{-# SPECIALIZE decimal :: Reader Int32 #-}
55{-# SPECIALIZE decimal :: Reader Int64 #-}
57{-# SPECIALIZE decimal :: Reader Int64 #-}
56{-# SPECIALIZE decimal :: Reader Integer #-}
58{-# SPECIALIZE decimal :: Reader Integer #-}
57−{-# SPECIALIZE decimal :: Reader Word #-}
59+{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}
58{-# SPECIALIZE decimal :: Reader Word8 #-}
60{-# SPECIALIZE decimal :: Reader Word8 #-}
59{-# SPECIALIZE decimal :: Reader Word16 #-}
61{-# SPECIALIZE decimal :: Reader Word16 #-}
60{-# SPECIALIZE decimal :: Reader Word32 #-}
62{-# SPECIALIZE decimal :: Reader Word32 #-}
Data/Text/Read.hs+1−1
@@ -55,7 +55,7 @@ decimal :: Integral a => Reader a
55{-# SPECIALIZE decimal :: Reader Int32 #-}
55{-# SPECIALIZE decimal :: Reader Int32 #-}
56{-# SPECIALIZE decimal :: Reader Int64 #-}
56{-# SPECIALIZE decimal :: Reader Int64 #-}
57{-# SPECIALIZE decimal :: Reader Integer #-}
57{-# SPECIALIZE decimal :: Reader Integer #-}
58−{-# SPECIALIZE decimal :: Reader Word #-}
58+{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}
59{-# SPECIALIZE decimal :: Reader Word8 #-}
59{-# SPECIALIZE decimal :: Reader Word8 #-}
60{-# SPECIALIZE decimal :: Reader Word16 #-}
60{-# SPECIALIZE decimal :: Reader Word16 #-}
61{-# SPECIALIZE decimal :: Reader Word32 #-}
61{-# 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
18 , iter
18 , iter
19 , iter_
19 , iter_
20 , reverseIter
20 , reverseIter
21+ , reverseIter_
21 , unsafeHead
22 , unsafeHead
22 , unsafeTail
23 , unsafeTail
23 , lengthWord16
24 , lengthWord16
@@ -94,6 +95,16 @@ reverseIter (Text arr off _len) i
94 k = j - 1
95 k = j - 1
95{-# INLINE reverseIter #-}
96{-# INLINE reverseIter #-}
96
97
98+-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
99+-- returning the delta to add (i.e. a negative number) to give the
100+-- next offset to iterate at.
101+reverseIter_ :: Text -> Int -> Int
102+reverseIter_ (Text arr off _len) i
103+ | m < 0xDC00 || m > 0xDFFF = -1
104+ | otherwise = -2
105+ where m = A.unsafeIndex arr (off+i)
106+{-# INLINE reverseIter_ #-}
107+
97-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
108-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
98-- is useful for sizing a target array appropriately before using
109-- is useful for sizing a target array appropriately before using
99-- 'unsafeCopyToPtr'.
110-- 'unsafeCopyToPtr'.
benchmarks/haskell/Benchmarks.hs+3−1
@@ -15,6 +15,7 @@ import qualified Benchmarks.EncodeUtf8 as EncodeUtf8
15import qualified Benchmarks.Equality as Equality
15import qualified Benchmarks.Equality as Equality
16import qualified Benchmarks.FileRead as FileRead
16import qualified Benchmarks.FileRead as FileRead
17import qualified Benchmarks.FoldLines as FoldLines
17import qualified Benchmarks.FoldLines as FoldLines
18+import qualified Benchmarks.Mul as Mul
18import qualified Benchmarks.Pure as Pure
19import qualified Benchmarks.Pure as Pure
19import qualified Benchmarks.ReadNumbers as ReadNumbers
20import qualified Benchmarks.ReadNumbers as ReadNumbers
20import qualified Benchmarks.Replace as Replace
21import qualified Benchmarks.Replace as Replace
@@ -49,9 +50,10 @@ benchmarks = do
49 , Equality.benchmark (tf "japanese.txt")
50 , Equality.benchmark (tf "japanese.txt")
50 , FileRead.benchmark (tf "russian.txt")
51 , FileRead.benchmark (tf "russian.txt")
51 , FoldLines.benchmark (tf "russian.txt")
52 , FoldLines.benchmark (tf "russian.txt")
53+ , Mul.benchmark
52 , Pure.benchmark "tiny" (tf "tiny.txt")
54 , Pure.benchmark "tiny" (tf "tiny.txt")
53 , Pure.benchmark "ascii" (tf "ascii-small.txt")
55 , Pure.benchmark "ascii" (tf "ascii-small.txt")
54− , Pure.benchmark "france" (tf "france.html")
56+ -- , Pure.benchmark "france" (tf "france.html")
55 , Pure.benchmark "russian" (tf "russian-small.txt")
57 , Pure.benchmark "russian" (tf "russian-small.txt")
56 , Pure.benchmark "japanese" (tf "japanese.txt")
58 , Pure.benchmark "japanese" (tf "japanese.txt")
57 , ReadNumbers.benchmark (tf "numbers.txt")
59 , ReadNumbers.benchmark (tf "numbers.txt")
benchmarks/haskell/Benchmarks/DecodeUtf8.hs+2−2
@@ -25,7 +25,7 @@ import Foreign.Ptr (Ptr, plusPtr)
25import Foreign.ForeignPtr (withForeignPtr)
25import Foreign.ForeignPtr (withForeignPtr)
26import Data.Word (Word8)
26import Data.Word (Word8)
27import qualified Criterion as C
27import qualified Criterion as C
28−import Criterion (Benchmark, bgroup, nf)
28+import Criterion (Benchmark, bgroup, nf, whnfIO)
29import qualified Codec.Binary.UTF8.Generic as U8
29import qualified Codec.Binary.UTF8.Generic as U8
30import qualified Data.ByteString as B
30import qualified Data.ByteString as B
31import qualified Data.ByteString.Lazy as BL
31import qualified Data.ByteString.Lazy as BL
@@ -48,7 +48,7 @@ benchmark kind fp = do
48 return $ bgroup "DecodeUtf8"
48 return $ bgroup "DecodeUtf8"
49 [ bench "Strict" $ nf T.decodeUtf8 bs
49 [ bench "Strict" $ nf T.decodeUtf8 bs
50 , bench "Stream" $ nf decodeStream lbs
50 , bench "Stream" $ nf decodeStream lbs
51− , bench "IConv" $ iconv bs
51+ , bench "IConv" $ whnfIO $ iconv bs
52 , bench "StrictLength" $ nf (T.length . T.decodeUtf8) bs
52 , bench "StrictLength" $ nf (T.length . T.decodeUtf8) bs
53 , bench "StrictInitLength" $ nf (T.length . T.init . T.decodeUtf8) bs
53 , bench "StrictInitLength" $ nf (T.length . T.init . T.decodeUtf8) bs
54 , bench "Lazy" $ nf TL.decodeUtf8 lbs
54 , bench "Lazy" $ nf TL.decodeUtf8 lbs
benchmarks/haskell/Benchmarks/FileRead.hs+11−11
@@ -8,8 +8,8 @@ module Benchmarks.FileRead
8 ( benchmark
8 ( benchmark
9 ) where
9 ) where
10
10
11−import Control.Exception (evaluate)
11+import Control.Applicative ((<$>))
12−import Criterion (Benchmark, bgroup, bench)
12+import Criterion (Benchmark, bgroup, bench, whnfIO)
13import qualified Data.ByteString as SB
13import qualified Data.ByteString as SB
14import qualified Data.ByteString.Lazy as LB
14import qualified Data.ByteString.Lazy as LB
15import qualified Data.Text as T
15import qualified Data.Text as T
@@ -21,13 +21,13 @@ import qualified Data.Text.Lazy.IO as LT
21
21
22benchmark :: FilePath -> IO Benchmark
22benchmark :: FilePath -> IO Benchmark
23benchmark p = return $ bgroup "FileRead"
23benchmark p = return $ bgroup "FileRead"
24− [ bench "String" $ readFile p >>= evaluate . length
24+ [ bench "String" $ whnfIO $ length <$> readFile p
25− , bench "ByteString" $ SB.readFile p >>= evaluate . SB.length
25+ , bench "ByteString" $ whnfIO $ SB.length <$> SB.readFile p
26− , bench "LazyByteString" $ LB.readFile p >>= evaluate . LB.length
26+ , bench "LazyByteString" $ whnfIO $ LB.length <$> LB.readFile p
27− , bench "Text" $ T.readFile p >>= evaluate . T.length
27+ , bench "Text" $ whnfIO $ T.length <$> T.readFile p
28− , bench "LazyText" $ LT.readFile p >>= evaluate . LT.length
28+ , bench "LazyText" $ whnfIO $ LT.length <$> LT.readFile p
29− , bench "TextByteString" $
29+ , bench "TextByteString" $ whnfIO $
30− SB.readFile p >>= evaluate . T.length . T.decodeUtf8
30+ (T.length . T.decodeUtf8) <$> SB.readFile p
31− , bench "LazyTextByteString" $
31+ , bench "LazyTextByteString" $ whnfIO $
32− LB.readFile p >>= evaluate . LT.length . LT.decodeUtf8
32+ (LT.length . LT.decodeUtf8) <$> LB.readFile p
33 ]
33 ]
benchmarks/haskell/Benchmarks/FoldLines.hs+2−2
@@ -10,7 +10,7 @@ module Benchmarks.FoldLines
10 ( benchmark
10 ( benchmark
11 ) where
11 ) where
12
12
13−import Criterion (Benchmark, bgroup, bench)
13+import Criterion (Benchmark, bgroup, bench, whnfIO)
14import System.IO
14import System.IO
15import qualified Data.ByteString as B
15import qualified Data.ByteString as B
16import qualified Data.Text as T
16import qualified Data.Text as T
@@ -22,7 +22,7 @@ benchmark fp = return $ bgroup "ReadLines"
22 , bench "ByteString" $ withHandle $ foldLinesB (\n _ -> n + 1) (0 :: Int)
22 , bench "ByteString" $ withHandle $ foldLinesB (\n _ -> n + 1) (0 :: Int)
23 ]
23 ]
24 where
24 where
25− withHandle f = do
25+ withHandle f = whnfIO $ do
26 h <- openFile fp ReadMode
26 h <- openFile fp ReadMode
27 hSetBuffering h (BlockBuffering (Just 16384))
27 hSetBuffering h (BlockBuffering (Just 16384))
28 x <- f h
28 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
11 ( benchmark
11 ( benchmark
12 ) where
12 ) where
13
13
14−import Criterion (Benchmark, bench)
14+import Criterion (Benchmark, bench, whnfIO)
15import Data.Monoid (mappend, mconcat)
15import Data.Monoid (mappend, mconcat)
16import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)
16import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)
17import Data.Text.Lazy.IO (hPutStr)
17import Data.Text.Lazy.IO (hPutStr)
@@ -19,7 +19,7 @@ import System.IO (Handle)
19import qualified Data.Text as T
19import qualified Data.Text as T
20
20
21benchmark :: Handle -> IO Benchmark
21benchmark :: Handle -> IO Benchmark
22−benchmark sink = return $ bench "BigTable" $ do
22+benchmark sink = return $ bench "BigTable" $ whnfIO $ do
23 hPutStr sink "Content-Type: text/html\n\n<table>"
23 hPutStr sink "Content-Type: text/html\n\n<table>"
24 hPutStr sink . toLazyText . makeTable =<< rows
24 hPutStr sink . toLazyText . makeTable =<< rows
25 hPutStr sink "</table>"
25 hPutStr sink "</table>"
benchmarks/haskell/Benchmarks/Programs/Cut.hs+2−2
@@ -16,7 +16,7 @@ module Benchmarks.Programs.Cut
16 ( benchmark
16 ( benchmark
17 ) where
17 ) where
18
18
19−import Criterion (Benchmark, bgroup, bench)
19+import Criterion (Benchmark, bgroup, bench, whnfIO)
20import System.IO (Handle, hPutStr)
20import System.IO (Handle, hPutStr)
21import qualified Data.ByteString as B
21import qualified Data.ByteString as B
22import qualified Data.ByteString.Char8 as BC
22import qualified Data.ByteString.Char8 as BC
@@ -40,7 +40,7 @@ benchmark p sink from to = return $ bgroup "Cut"
40 , bench' "LazyTextByteString" lazyTextByteString
40 , bench' "LazyTextByteString" lazyTextByteString
41 ]
41 ]
42 where
42 where
43− bench' n s = bench n (s p sink from to)
43+ bench' n s = bench n $ whnfIO (s p sink from to)
44
44
45string :: FilePath -> Handle -> Int -> Int -> IO ()
45string :: FilePath -> Handle -> Int -> Int -> IO ()
46string fp sink from to = do
46string fp sink from to = do
benchmarks/haskell/Benchmarks/Programs/Fold.hs+2−2
@@ -21,7 +21,7 @@ import Data.List (foldl')
21import Data.List (intersperse)
21import Data.List (intersperse)
22import Data.Monoid (mempty, mappend, mconcat)
22import Data.Monoid (mempty, mappend, mconcat)
23import System.IO (Handle)
23import System.IO (Handle)
24−import Criterion (Benchmark, bench)
24+import Criterion (Benchmark, bench, whnfIO)
25import qualified Data.Text as T
25import qualified Data.Text as T
26import qualified Data.Text.IO as T
26import qualified Data.Text.IO as T
27import qualified Data.Text.Lazy.Builder as TLB
27import qualified Data.Text.Lazy.Builder as TLB
@@ -30,7 +30,7 @@ import qualified Data.Text.Lazy.IO as TL
30
30
31benchmark :: FilePath -> Handle -> IO Benchmark
31benchmark :: FilePath -> Handle -> IO Benchmark
32benchmark i o = return $
32benchmark i o = return $
33− bench "Fold" $ T.readFile i >>= TL.hPutStr o . fold 80
33+ bench "Fold" $ whnfIO $ T.readFile i >>= TL.hPutStr o . fold 80
34
34
35-- | We represent a paragraph by a word list
35-- | We represent a paragraph by a word list
36--
36--
benchmarks/haskell/Benchmarks/Programs/Sort.hs+10−9
@@ -17,7 +17,7 @@ module Benchmarks.Programs.Sort
17 ( benchmark
17 ( benchmark
18 ) where
18 ) where
19
19
20−import Criterion (Benchmark, bgroup, bench)
20+import Criterion (Benchmark, bgroup, bench, whnfIO)
21import Data.Monoid (mconcat)
21import Data.Monoid (mconcat)
22import System.IO (Handle, hPutStr)
22import System.IO (Handle, hPutStr)
23import qualified Data.ByteString as B
23import qualified Data.ByteString as B
@@ -35,16 +35,17 @@ import qualified Data.Text.Lazy.IO as TL
35
35
36benchmark :: FilePath -> Handle -> IO Benchmark
36benchmark :: FilePath -> Handle -> IO Benchmark
37benchmark i o = return $ bgroup "Sort"
37benchmark i o = return $ bgroup "Sort"
38− [ bench "String" $ readFile i >>= hPutStr o . string
38+ [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string
39− , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString
39+ , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString
40+ , bench "LazyByteString" $ whnfIO $
40− , bench "LazyByteString" $ BL.readFile i >>= BL.hPutStr o . lazyByteString
41+ BL.readFile i >>= BL.hPutStr o . lazyByteString
41− , bench "Text" $ T.readFile i >>= T.hPutStr o . text
42+ , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text
42− , bench "LazyText" $ TL.readFile i >>= TL.hPutStr o . lazyText
43+ , bench "LazyText" $ whnfIO $ TL.readFile i >>= TL.hPutStr o . lazyText
43− , bench "TextByteString" $ B.readFile i >>=
44+ , bench "TextByteString" $ whnfIO $ B.readFile i >>=
44 B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8
45 B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8
45− , bench "LazyTextByteString" $ BL.readFile i >>=
46+ , bench "LazyTextByteString" $ whnfIO $ BL.readFile i >>=
46 BL.hPutStr o . TL.encodeUtf8 . lazyText . TL.decodeUtf8
47 BL.hPutStr o . TL.encodeUtf8 . lazyText . TL.decodeUtf8
47− , bench "TextBuilder" $ B.readFile i >>=
48+ , bench "TextBuilder" $ whnfIO $ B.readFile i >>=
48 BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8
49 BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8
49 ]
50 ]
50
51
benchmarks/haskell/Benchmarks/Programs/StripTags.hs+5−5
@@ -15,7 +15,7 @@ module Benchmarks.Programs.StripTags
15 ( benchmark
15 ( benchmark
16 ) where
16 ) where
17
17
18−import Criterion (Benchmark, bgroup, bench)
18+import Criterion (Benchmark, bgroup, bench, whnfIO)
19import Data.List (mapAccumL)
19import Data.List (mapAccumL)
20import System.IO (Handle, hPutStr)
20import System.IO (Handle, hPutStr)
21import qualified Data.ByteString as B
21import qualified Data.ByteString as B
@@ -26,10 +26,10 @@ import qualified Data.Text.IO as T
26
26
27benchmark :: FilePath -> Handle -> IO Benchmark
27benchmark :: FilePath -> Handle -> IO Benchmark
28benchmark i o = return $ bgroup "StripTags"
28benchmark i o = return $ bgroup "StripTags"
29− [ bench "String" $ readFile i >>= hPutStr o . string
29+ [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string
30− , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString
30+ , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString
31− , bench "Text" $ T.readFile i >>= T.hPutStr o . text
31+ , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text
32− , bench "TextByteString" $
32+ , bench "TextByteString" $ whnfIO $
33 B.readFile i >>= B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8
33 B.readFile i >>= B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8
34 ]
34 ]
35
35
benchmarks/haskell/Benchmarks/Programs/Throughput.hs+8−8
@@ -18,7 +18,7 @@ module Benchmarks.Programs.Throughput
18 ( benchmark
18 ( benchmark
19 ) where
19 ) where
20
20
21−import Criterion (Benchmark, bgroup, bench)
21+import Criterion (Benchmark, bgroup, bench, whnfIO)
22import System.IO (Handle, hPutStr)
22import System.IO (Handle, hPutStr)
23import qualified Data.ByteString as B
23import qualified Data.ByteString as B
24import qualified Data.ByteString.Lazy as BL
24import qualified Data.ByteString.Lazy as BL
@@ -29,13 +29,13 @@ import qualified Data.Text.Lazy.IO as TL
29
29
30benchmark :: FilePath -> Handle -> IO Benchmark
30benchmark :: FilePath -> Handle -> IO Benchmark
31benchmark fp sink = return $ bgroup "Throughput"
31benchmark fp sink = return $ bgroup "Throughput"
32− [ bench "String" $ readFile fp >>= hPutStr sink
32+ [ bench "String" $ whnfIO $ readFile fp >>= hPutStr sink
33− , bench "ByteString" $ B.readFile fp >>= B.hPutStr sink
33+ , bench "ByteString" $ whnfIO $ B.readFile fp >>= B.hPutStr sink
34− , bench "LazyByteString" $ BL.readFile fp >>= BL.hPutStr sink
34+ , bench "LazyByteString" $ whnfIO $ BL.readFile fp >>= BL.hPutStr sink
35− , bench "Text" $ T.readFile fp >>= T.hPutStr sink
35+ , bench "Text" $ whnfIO $ T.readFile fp >>= T.hPutStr sink
36− , bench "LazyText" $ TL.readFile fp >>= TL.hPutStr sink
36+ , bench "LazyText" $ whnfIO $ TL.readFile fp >>= TL.hPutStr sink
37− , bench "TextByteString" $
37+ , bench "TextByteString" $ whnfIO $
38 B.readFile fp >>= B.hPutStr sink . T.encodeUtf8 . T.decodeUtf8
38 B.readFile fp >>= B.hPutStr sink . T.encodeUtf8 . T.decodeUtf8
39− , bench "LazyTextByteString" $
39+ , bench "LazyTextByteString" $ whnfIO $
40 BL.readFile fp >>= BL.hPutStr sink . TL.encodeUtf8 . TL.decodeUtf8
40 BL.readFile fp >>= BL.hPutStr sink . TL.encodeUtf8 . TL.decodeUtf8
41 ]
41 ]
benchmarks/haskell/Benchmarks/Pure.hs+7
@@ -262,6 +262,13 @@ benchmark kind fp = do
262 , benchBSL $ nf (BL.map toUpper) bla
262 , benchBSL $ nf (BL.map toUpper) bla
263 , benchS $ nf (L.map toUpper) sa
263 , benchS $ nf (L.map toUpper) sa
264 ]
264 ]
265+ , bgroup "uncons"
266+ [ benchT $ nf T.uncons ta
267+ , benchTL $ nf TL.uncons tla
268+ , benchBS $ nf BS.uncons bsa
269+ , benchBSL $ nf BL.uncons bla
270+ , benchS $ nf L.uncons sa
271+ ]
265 , bgroup "words"
272 , bgroup "words"
266 [ benchT $ nf T.words ta
273 [ benchT $ nf T.words ta
267 , benchTL $ nf TL.words tla
274 , benchTL $ nf TL.words tla
benchmarks/haskell/Benchmarks/ReadNumbers.hs+2−5
@@ -25,8 +25,7 @@ import Data.List (foldl')
25import Numeric (readDec, readFloat, readHex)
25import Numeric (readDec, readFloat, readHex)
26import qualified Data.ByteString.Char8 as B
26import qualified Data.ByteString.Char8 as B
27import qualified Data.ByteString.Lazy.Char8 as BL
27import qualified Data.ByteString.Lazy.Char8 as BL
28−import qualified Data.ByteString.Lex.Double as B
28+import qualified Data.ByteString.Lex.Fractional as B
29−import qualified Data.ByteString.Lex.Lazy.Double as BL
30import qualified Data.Text as T
29import qualified Data.Text as T
31import qualified Data.Text.IO as T
30import qualified Data.Text.IO as T
32import qualified Data.Text.Lazy as TL
31import qualified Data.Text.Lazy as TL
@@ -63,12 +62,10 @@ benchmark fp = do
63 whnf (double . text TL.rational) tl
62 whnf (double . text TL.rational) tl
64
63
65 , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b
64 , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b
66− , bench "DoubleByteString" $ whnf (double . byteString B.readDouble) b
65+ , bench "DoubleByteString" $ whnf (double . byteString B.readDecimal) b
67
66
68 , bench "DecimalLazyByteString" $
67 , bench "DecimalLazyByteString" $
69 whnf (int . byteString BL.readInt) bl
68 whnf (int . byteString BL.readInt) bl
70− , bench "DoubleLazyByteString" $
71− whnf (double . byteString BL.readDouble) bl
72 ]
69 ]
73 where
70 where
74 -- Used for fixing types
71 -- Used for fixing types
benchmarks/haskell/Benchmarks/Stream.hs+16−5
@@ -18,11 +18,11 @@ import qualified Data.Text.Encoding as T
18import qualified Data.Text.Encoding.Error as E
18import qualified Data.Text.Encoding.Error as E
19import qualified Data.Text.Internal.Encoding.Fusion as T
19import qualified Data.Text.Internal.Encoding.Fusion as T
20import qualified Data.Text.Internal.Encoding.Fusion.Common as F
20import qualified Data.Text.Internal.Encoding.Fusion.Common as F
21−import qualified Data.Text.Internal.Fusion as T
21+import qualified Data.Text.Internal.Fusion as F
22import qualified Data.Text.IO as T
22import qualified Data.Text.IO as T
23import qualified Data.Text.Lazy.Encoding as TL
23import qualified Data.Text.Lazy.Encoding as TL
24import qualified Data.Text.Internal.Lazy.Encoding.Fusion as TL
24import qualified Data.Text.Internal.Lazy.Encoding.Fusion as TL
25−import qualified Data.Text.Internal.Lazy.Fusion as TL
25+import qualified Data.Text.Internal.Lazy.Fusion as FL
26import qualified Data.Text.Lazy.IO as TL
26import qualified Data.Text.Lazy.IO as TL
27
27
28instance NFData a => NFData (Stream a) where
28instance NFData a => NFData (Stream a) where
@@ -53,14 +53,25 @@ benchmark fp = do
53 !utf32beL = TL.encodeUtf32BE tl
53 !utf32beL = TL.encodeUtf32BE tl
54
54
55 -- For the functions which operate on streams
55 -- For the functions which operate on streams
56− let !s = T.stream t
56+ let !s = F.stream t
57
57
58 return $ bgroup "Stream"
58 return $ bgroup "Stream"
59
59
60 -- Fusion
60 -- Fusion
61 [ bgroup "stream" $
61 [ bgroup "stream" $
62− [ bench "Text" $ nf T.stream t
62+ [ bench "Text" $ nf F.stream t
63+ , bench "LazyText" $ nf FL.stream tl
64+ ]
65+ -- must perform exactly the same as stream above due to
66+ -- stream/unstream (i.e. stream after unstream) fusion
67+ , bgroup "stream-fusion" $
68+ [ bench "Text" $ nf (F.stream . F.unstream . F.stream) t
63− , bench "LazyText" $ nf TL.stream tl
69+ , bench "LazyText" $ nf (FL.stream . FL.unstream . FL.stream) tl
70+ ]
71+ -- measure the overhead of unstream after stream
72+ , bgroup "stream-unstream" $
73+ [ bench "Text" $ nf (F.unstream . F.stream) t
74+ , bench "LazyText" $ nf (FL.unstream . FL.stream) tl
64 ]
75 ]
65
76
66 -- Encoding.Fusion
77 -- Encoding.Fusion
benchmarks/text-benchmarks.cabal+18−6
@@ -3,7 +3,7 @@ version: 0.0.0.0
3synopsis: Benchmarks for the text package
3synopsis: Benchmarks for the text package
4description: Benchmarks for the text package
4description: Benchmarks for the text package
5homepage: https://bitbucket.org/bos/text
5homepage: https://bitbucket.org/bos/text
6−license: BSD3
6+license: BSD2
7license-file: ../LICENSE
7license-file: ../LICENSE
8author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
8author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
9 Bryan O'Sullivan <bos@serpentine.com>,
9 Bryan O'Sullivan <bos@serpentine.com>,
@@ -15,9 +15,15 @@ build-type: Simple
15
15
16cabal-version: >=1.2
16cabal-version: >=1.2
17
17
18+flag bytestring-builder
19+ description: Depend on the bytestring-builder package for backwards compatibility.
20+ default: False
21+ manual: False
22+
18flag llvm
23flag llvm
19 description: use LLVM
24 description: use LLVM
20 default: False
25 default: False
26+ manual: True
21
27
22executable text-benchmarks
28executable text-benchmarks
23 hs-source-dirs: haskell ..
29 hs-source-dirs: haskell ..
@@ -25,24 +31,30 @@ executable text-benchmarks
25 cbits/time_iconv.c
31 cbits/time_iconv.c
26 include-dirs: ../include
32 include-dirs: ../include
27 main-is: Benchmarks.hs
33 main-is: Benchmarks.hs
28− ghc-options: -Wall -O2
34+ ghc-options: -Wall -O2 -rtsopts
29 if flag(llvm)
35 if flag(llvm)
30 ghc-options: -fllvm
36 ghc-options: -fllvm
31 cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP
37 cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP
32 build-depends: base == 4.*,
38 build-depends: base == 4.*,
33 binary,
39 binary,
34 blaze-builder,
40 blaze-builder,
35− bytestring,
41+ bytestring-lexing >= 0.5.0,
36− bytestring-lexing,
37 containers,
42 containers,
38− criterion >= 0.6.0.1,
43+ criterion >= 0.10.0.0,
39 deepseq,
44 deepseq,
40 directory,
45 directory,
41 filepath,
46 filepath,
42 ghc-prim,
47 ghc-prim,
43 integer-gmp,
48 integer-gmp,
44 stringsearch,
49 stringsearch,
45− utf8-string
50+ utf8-string,
51+ vector
52+
53+ if flag(bytestring-builder)
54+ build-depends: bytestring >= 0.9 && < 0.10.4,
55+ bytestring-builder >= 0.10.4
56+ else
57+ build-depends: bytestring >= 0.10.4
46
58
47executable text-multilang
59executable text-multilang
48 hs-source-dirs: haskell
60 hs-source-dirs: haskell
cbits/cbits.c+6−6
@@ -68,8 +68,8 @@ decode(uint32_t *state, uint32_t* codep, uint32_t byte) {
68 * an UTF16 array
68 * an UTF16 array
69 */
69 */
70void
70void
71−_hs_text_decode_latin1(uint16_t *dest, const uint8_t const *src,
71+_hs_text_decode_latin1(uint16_t *dest, const uint8_t *src,
72− const uint8_t const *srcend)
72+ const uint8_t *srcend)
73{
73{
74 const uint8_t *p = src;
74 const uint8_t *p = src;
75
75
@@ -130,14 +130,14 @@ _hs_text_decode_latin1(uint16_t *dest, const uint8_t const *src,
130#if defined(__GNUC__) || defined(__clang__)
130#if defined(__GNUC__) || defined(__clang__)
131static inline uint8_t const *
131static inline uint8_t const *
132_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,
132_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,
133− const uint8_t const **src, const uint8_t const *srcend,
133+ const uint8_t **src, const uint8_t *srcend,
134 uint32_t *codepoint0, uint32_t *state0)
134 uint32_t *codepoint0, uint32_t *state0)
135 __attribute((always_inline));
135 __attribute((always_inline));
136#endif
136#endif
137
137
138static inline uint8_t const *
138static inline uint8_t const *
139_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,
139_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,
140− const uint8_t const **src, const uint8_t const *srcend,
140+ const uint8_t **src, const uint8_t *srcend,
141 uint32_t *codepoint0, uint32_t *state0)
141 uint32_t *codepoint0, uint32_t *state0)
142{
142{
143 uint16_t *d = dest + *destoff;
143 uint16_t *d = dest + *destoff;
@@ -202,8 +202,8 @@ _hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,
202
202
203uint8_t const *
203uint8_t const *
204_hs_text_decode_utf8_state(uint16_t *const dest, size_t *destoff,
204_hs_text_decode_utf8_state(uint16_t *const dest, size_t *destoff,
205− const uint8_t const **src,
205+ const uint8_t **src,
206− const uint8_t const *srcend,
206+ const uint8_t *srcend,
207 uint32_t *codepoint0, uint32_t *state0)
207 uint32_t *codepoint0, uint32_t *state0)
208{
208{
209 uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, src, srcend,
209 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]
37mapCF (CF _ ms) = typ ++ (map nice . filter p $ ms) ++ [last]
37mapCF (CF _ ms) = typ ++ (map nice . filter p $ ms) ++ [last]
38 where
38 where
39 typ = ["foldMapping :: forall s. Char -> s -> Step (CC s) Char"
39 typ = ["foldMapping :: forall s. Char -> s -> Step (CC s) Char"
40− ,"{-# INLINE foldMapping #-}"]
40+ ,"{-# NOINLINE foldMapping #-}"]
41 last = "foldMapping c s = Yield (toLower c) (CC s '\\0' '\\0')"
41 last = "foldMapping c s = Yield (toLower c) (CC s '\\0' '\\0')"
42 nice c = "-- " ++ name c ++ "\n" ++
42 nice c = "-- " ++ name c ++ "\n" ++
43 "foldMapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"
43 "foldMapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"
scripts/CaseMapping.hs+3−3
@@ -8,7 +8,7 @@ import SpecialCasing
8main = do
8main = do
9 args <- getArgs
9 args <- getArgs
10 let oname = case args of
10 let oname = case args of
11− [] -> "../Data/Text/Fusion/CaseMapping.hs"
11+ [] -> "../Data/Text/Internal/Fusion/CaseMapping.hs"
12 [o] -> o
12 [o] -> o
13 psc <- parseSC "SpecialCasing.txt"
13 psc <- parseSC "SpecialCasing.txt"
14 pcf <- parseCF "CaseFolding.txt"
14 pcf <- parseCF "CaseFolding.txt"
@@ -24,10 +24,10 @@ main = do
24 mapM_ (hPutStrLn h) $
24 mapM_ (hPutStrLn h) $
25 ["{-# LANGUAGE Rank2Types #-}"
25 ["{-# LANGUAGE Rank2Types #-}"
26 ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"
26 ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"
27− ,"-- Generated by scripts/SpecialCasing.hs"] ++
27+ ,"-- Generated by scripts/CaseMapping.hs"] ++
28 comments ++
28 comments ++
29 [""
29 [""
30− ,"module Data.Text.Fusion.CaseMapping where"
30+ ,"module Data.Text.Internal.Fusion.CaseMapping where"
31 ,"import Data.Char"
31 ,"import Data.Char"
32 ,"import Data.Text.Internal.Fusion.Types"
32 ,"import Data.Text.Internal.Fusion.Types"
33 ,""]
33 ,""]
scripts/SpecialCasing.hs+1−1
@@ -43,7 +43,7 @@ mapSC which access twiddle (SC _ ms) =
43 typ ++ (map nice . filter p $ ms) ++ [last]
43 typ ++ (map nice . filter p $ ms) ++ [last]
44 where
44 where
45 typ = [which ++ "Mapping :: forall s. Char -> s -> Step (CC s) Char"
45 typ = [which ++ "Mapping :: forall s. Char -> s -> Step (CC s) Char"
46− ,"{-# INLINE " ++ which ++ "Mapping #-}"]
46+ ,"{-# NOINLINE " ++ which ++ "Mapping #-}"]
47 last = which ++ "Mapping c s = Yield (to" ++ ucFirst which ++ " c) (CC s '\\0' '\\0')"
47 last = which ++ "Mapping c s = Yield (to" ++ ucFirst which ++ " c) (CC s '\\0' '\\0')"
48 nice c = "-- " ++ name c ++ "\n" ++
48 nice c = "-- " ++ name c ++ "\n" ++
49 which ++ "Mapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"
49 which ++ "Mapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"
tests/LiteralRuleTest.hsnew file+21
@@ -0,0 +1,21 @@
1+{-# LANGUAGE OverloadedStrings #-}
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 @@
1count = 1000
1count = 1000
2
2
3+all: coverage literal-rule-test
4+
5+literal-rule-test:
6+ ./literal-rule-test.sh
7+
3coverage: build coverage/hpc_index.html
8coverage: build coverage/hpc_index.html
4
9
5build: text-test-data
10build: text-test-data
@@ -32,4 +37,4 @@ coverage/hpc_index.html: coverage/coverage.tix
32clean:
37clean:
33 rm -rf dist coverage .hpc
38 rm -rf dist coverage .hpc
34
39
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
1+-- | QuickCheck properties for the text library.
2−--
2+
3{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
3{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
4 ScopedTypeVariables, TypeSynonymInstances #-}
4 ScopedTypeVariables, TypeSynonymInstances #-}
5−{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}
5+{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}
6−{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
7module Tests.Properties
6module Tests.Properties
8 (
7 (
9 tests
8 tests
@@ -15,7 +14,7 @@ import Data.Bits ((.&.))
15import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
14import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
16import Data.Int (Int8, Int16, Int32, Int64)
15import Data.Int (Int8, Int16, Int32, Int64)
17import Data.Monoid (Monoid(..))
16import Data.Monoid (Monoid(..))
18−import Data.String (fromString)
17+import Data.String (IsString(fromString))
19import Data.Text.Encoding.Error
18import Data.Text.Encoding.Error
20import Data.Text.Foreign
19import Data.Text.Foreign
21import Data.Text.Internal.Encoding.Utf8
20import Data.Text.Internal.Encoding.Utf8
@@ -24,12 +23,13 @@ import Data.Text.Internal.Search (indices)
24import Data.Text.Lazy.Read as TL
23import Data.Text.Lazy.Read as TL
25import Data.Text.Read as T
24import Data.Text.Read as T
26import Data.Word (Word, Word8, Word16, Word32, Word64)
25import Data.Word (Word, Word8, Word16, Word32, Word64)
27−import Numeric (showHex)
26+import Numeric (showEFloat, showFFloat, showGFloat, showHex)
28import Prelude hiding (replicate)
27import Prelude hiding (replicate)
29import Test.Framework (Test, testGroup)
28import Test.Framework (Test, testGroup)
30import Test.Framework.Providers.QuickCheck2 (testProperty)
29import Test.Framework.Providers.QuickCheck2 (testProperty)
31import Test.QuickCheck hiding ((.&.))
30import Test.QuickCheck hiding ((.&.))
32import Test.QuickCheck.Monadic
31import Test.QuickCheck.Monadic
32+import Test.QuickCheck.Property (Property(..))
33import Tests.QuickCheckUtils
33import Tests.QuickCheckUtils
34import Tests.Utils
34import Tests.Utils
35import Text.Show.Functions ()
35import Text.Show.Functions ()
@@ -53,6 +53,7 @@ import qualified Data.Text.Lazy.Builder.RealFloat as TB
53import qualified Data.Text.Lazy.Encoding as EL
53import qualified Data.Text.Lazy.Encoding as EL
54import qualified Data.Text.Lazy.IO as TL
54import qualified Data.Text.Lazy.IO as TL
55import qualified System.IO as IO
55import qualified System.IO as IO
56+import qualified Tests.Properties.Mul as Mul
56import qualified Tests.SlowFunctions as Slow
57import qualified Tests.SlowFunctions as Slow
57
58
58t_pack_unpack = (T.unpack . T.pack) `eq` id
59t_pack_unpack = (T.unpack . T.pack) `eq` id
@@ -94,9 +95,7 @@ tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id
94t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
95t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
95tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
96tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
96
97
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
100 where recode n = T.concat . map fst . feedChunksOf n E.streamDecodeUtf8 .
99 where recode n = T.concat . map fst . feedChunksOf n E.streamDecodeUtf8 .
101 E.encodeUtf8
100 E.encodeUtf8
102
101
@@ -127,9 +126,9 @@ t_utf8_err bad de = do
127 Leading -> B.append <$> genInvalidUTF8 <*> genUTF8
126 Leading -> B.append <$> genInvalidUTF8 <*> genUTF8
128 Trailing -> B.append <$> genUTF8 <*> genInvalidUTF8
127 Trailing -> B.append <$> genUTF8 <*> genInvalidUTF8
129 genUTF8 = E.encodeUtf8 <$> genUnicode
128 genUTF8 = E.encodeUtf8 <$> genUnicode
130− forAll gen $ \bs -> do
129+ forAll gen $ \bs -> MkProperty $ do
131 onErr <- genDecodeErr de
130 onErr <- genDecodeErr de
132− monadicIO $ do
131+ unProperty . monadicIO $ do
133 l <- run $ let len = T.length (E.decodeUtf8With onErr bs)
132 l <- run $ let len = T.length (E.decodeUtf8With onErr bs)
134 in (len `seq` return (Right len)) `Exception.catch`
133 in (len `seq` return (Right len)) `Exception.catch`
135 (\(e::UnicodeException) -> return (Left e))
134 (\(e::UnicodeException) -> return (Left e))
@@ -198,8 +197,10 @@ t_Show = show `eq` (show . T.pack)
198tl_Show = show `eq` (show . TL.pack)
197tl_Show = show `eq` (show . TL.pack)
199t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))
198t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))
200tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))
199tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))
200+t_mconcat = unsquare $
201−t_mconcat = mconcat `eq` (unpackS . mconcat . L.map T.pack)
201+ mconcat `eq` (unpackS . mconcat . L.map T.pack)
202+tl_mconcat = unsquare $
202−tl_mconcat = mconcat `eq` (unpackS . mconcat . L.map TL.pack)
203+ mconcat `eq` (unpackS . mconcat . L.map TL.pack)
203t_mempty = mempty == (unpackS (mempty :: T.Text))
204t_mempty = mempty == (unpackS (mempty :: T.Text))
204tl_mempty = mempty == (unpackS (mempty :: TL.Text))
205tl_mempty = mempty == (unpackS (mempty :: TL.Text))
205t_IsString = fromString `eqP` (T.unpack . fromString)
206t_IsString = fromString `eqP` (T.unpack . fromString)
@@ -263,11 +264,14 @@ s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)
263sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)
264sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)
264t_map f = map f `eqP` (unpackS . T.map f)
265t_map f = map f `eqP` (unpackS . T.map f)
265tl_map f = map f `eqP` (unpackS . TL.map f)
266tl_map f = map f `eqP` (unpackS . TL.map f)
267+s_intercalate c = unsquare $
266−s_intercalate c = L.intercalate c `eq`
268+ L.intercalate c `eq`
267 (unpackS . S.intercalate (packS c) . map packS)
269 (unpackS . S.intercalate (packS c) . map packS)
270+t_intercalate c = unsquare $
268−t_intercalate c = L.intercalate c `eq`
271+ L.intercalate c `eq`
269 (unpackS . T.intercalate (packS c) . map packS)
272 (unpackS . T.intercalate (packS c) . map packS)
273+tl_intercalate c = unsquare $
270−tl_intercalate c = L.intercalate c `eq`
274+ L.intercalate c `eq`
271 (unpackS . TL.intercalate (TL.pack c) . map TL.pack)
275 (unpackS . TL.intercalate (TL.pack c) . map TL.pack)
272s_intersperse c = L.intersperse c `eqP`
276s_intersperse c = L.intersperse c `eqP`
273 (unpackS . S.intersperse c)
277 (unpackS . S.intersperse c)
@@ -275,10 +279,14 @@ s_intersperse_s c = L.intersperse c `eqP`
275 (unpackS . S.unstream . S.intersperse c)
279 (unpackS . S.unstream . S.intersperse c)
276sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`
280sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`
277 (unpackS . S.intersperse c . S.filter p)
281 (unpackS . S.intersperse c . S.filter p)
282+t_intersperse c = unsquare $
278−t_intersperse c = L.intersperse c `eqP` (unpackS . T.intersperse c)
283+ L.intersperse c `eqP` (unpackS . T.intersperse c)
284+tl_intersperse c = unsquare $
279−tl_intersperse c = L.intersperse c `eqP` (unpackS . TL.intersperse c)
285+ L.intersperse c `eqP` (unpackS . TL.intersperse c)
286+t_transpose = unsquare $
280−t_transpose = L.transpose `eq` (map unpackS . T.transpose . map packS)
287+ L.transpose `eq` (map unpackS . T.transpose . map packS)
288+tl_transpose = unsquare $
281−tl_transpose = L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)
289+ L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)
282t_reverse = L.reverse `eqP` (unpackS . T.reverse)
290t_reverse = L.reverse `eqP` (unpackS . T.reverse)
283tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)
291tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)
284t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)
292t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)
@@ -375,17 +383,24 @@ sf_foldr p f z = (L.foldr f z . L.filter p) `eqP` (S.foldr f z . S.filter p)
375 where _types = f :: Char -> Char -> Char
383 where _types = f :: Char -> Char -> Char
376t_foldr f z = L.foldr f z `eqP` T.foldr f z
384t_foldr f z = L.foldr f z `eqP` T.foldr f z
377 where _types = f :: Char -> Char -> Char
385 where _types = f :: Char -> Char -> Char
386+tl_foldr f z = unsquare $
378−tl_foldr f z = L.foldr f z `eqP` TL.foldr f z
387+ L.foldr f z `eqP` TL.foldr f z
379 where _types = f :: Char -> Char -> Char
388 where _types = f :: Char -> Char -> Char
389+sf_foldr1 p f = unsquare $
380−sf_foldr1 p f = (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)
390+ (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)
381t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f
391t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f
392+tl_foldr1 f = unsquare $
382−tl_foldr1 f = L.foldr1 f `eqP` TL.foldr1 f
393+ L.foldr1 f `eqP` TL.foldr1 f
383
394
395+s_concat_s = unsquare $
384−s_concat_s = L.concat `eq` (unpackS . S.unstream . S.concat . map packS)
396+ L.concat `eq` (unpackS . S.unstream . S.concat . map packS)
397+sf_concat p = unsquare $
385−sf_concat p = (L.concat . map (L.filter p)) `eq`
398+ (L.concat . map (L.filter p)) `eq`
386 (unpackS . S.concat . map (S.filter p . packS))
399 (unpackS . S.concat . map (S.filter p . packS))
400+t_concat = unsquare $
387−t_concat = L.concat `eq` (unpackS . T.concat . map packS)
401+ L.concat `eq` (unpackS . T.concat . map packS)
402+tl_concat = unsquare $
388−tl_concat = L.concat `eq` (unpackS . TL.concat . map TL.pack)
403+ L.concat `eq` (unpackS . TL.concat . map TL.pack)
389sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`
404sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`
390 (unpackS . S.concatMap (packS . f) . S.filter p)
405 (unpackS . S.concatMap (packS . f) . S.filter p)
391t_concatMap f = unsquare $
406t_concatMap f = unsquare $
@@ -425,6 +440,10 @@ t_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z)
425tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)
440tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)
426 where _types = f :: Int -> Char -> (Int,Char)
441 where _types = f :: Int -> Char -> (Int,Char)
427
442
443+tl_repeat n = (L.take m . L.repeat) `eq`
444+ (unpackS . TL.take (fromIntegral m) . TL.repeat)
445+ where m = fromIntegral (n :: Word8)
446+
428replicate n l = concat (L.replicate n l)
447replicate n l = concat (L.replicate n l)
429
448
430s_replicate n = replicate m `eq`
449s_replicate n = replicate m `eq`
@@ -436,6 +455,14 @@ tl_replicate n = replicate m `eq`
436 (unpackS . TL.replicate (fromIntegral m) . packS)
455 (unpackS . TL.replicate (fromIntegral m) . packS)
437 where m = fromIntegral (n :: Word8)
456 where m = fromIntegral (n :: Word8)
438
457
458+tl_cycle n = (L.take m . L.cycle) `eq`
459+ (unpackS . TL.take (fromIntegral m) . TL.cycle . packS)
460+ where m = fromIntegral (n :: Word8)
461+
462+tl_iterate f n = (L.take m . L.iterate f) `eq`
463+ (unpackS . TL.take (fromIntegral m) . TL.iterate f)
464+ where m = fromIntegral (n :: Word8)
465+
439unf :: Int -> Char -> Maybe (Char, Char)
466unf :: Int -> Char -> Maybe (Char, Char)
440unf n c | fromEnum c * 100 > n = Nothing
467unf n c | fromEnum c * 100 > n = Nothing
441 | otherwise = Just (c, succ c)
468 | otherwise = Just (c, succ c)
@@ -462,14 +489,22 @@ s_take_s m = L.take n `eqP` (unpackS . S.unstream . S.take n)
462sf_take p n = (L.take n . L.filter p) `eqP`
489sf_take p n = (L.take n . L.filter p) `eqP`
463 (unpackS . S.take n . S.filter p)
490 (unpackS . S.take n . S.filter p)
464t_take n = L.take n `eqP` (unpackS . T.take n)
491t_take n = L.take n `eqP` (unpackS . T.take n)
492+t_takeEnd n = (L.reverse . L.take n . L.reverse) `eqP`
493+ (unpackS . T.takeEnd n)
465tl_take n = L.take n `eqP` (unpackS . TL.take (fromIntegral n))
494tl_take n = L.take n `eqP` (unpackS . TL.take (fromIntegral n))
495+tl_takeEnd n = (L.reverse . L.take (fromIntegral n) . L.reverse) `eqP`
496+ (unpackS . TL.takeEnd n)
466s_drop n = L.drop n `eqP` (unpackS . S.drop n)
497s_drop n = L.drop n `eqP` (unpackS . S.drop n)
467s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)
498s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)
468 where n = small m
499 where n = small m
469sf_drop p n = (L.drop n . L.filter p) `eqP`
500sf_drop p n = (L.drop n . L.filter p) `eqP`
470 (unpackS . S.drop n . S.filter p)
501 (unpackS . S.drop n . S.filter p)
471t_drop n = L.drop n `eqP` (unpackS . T.drop n)
502t_drop n = L.drop n `eqP` (unpackS . T.drop n)
503+t_dropEnd n = (L.reverse . L.drop n . L.reverse) `eqP`
504+ (unpackS . T.dropEnd n)
472tl_drop n = L.drop n `eqP` (unpackS . TL.drop (fromIntegral n))
505tl_drop n = L.drop n `eqP` (unpackS . TL.drop (fromIntegral n))
506+tl_dropEnd n = (L.reverse . L.drop n . L.reverse) `eqP`
507+ (unpackS . TL.dropEnd (fromIntegral n))
473s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)
508s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)
474 where n = small m
509 where n = small m
475s_take_drop_s m = (L.take n . L.drop n) `eqP`
510s_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`
481 (unpackS . S.takeWhile p . S.filter q)
516 (unpackS . S.takeWhile p . S.filter q)
482t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
517t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
483tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
518tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
519+t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
520+ (unpackS . T.takeWhileEnd p)
521+tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
522+ (unpackS . TL.takeWhileEnd p)
484s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
523s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
485s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
524s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
486sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
525sf_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)
533t_inits = L.inits `eqP` (map unpackS . T.inits)
572t_inits = L.inits `eqP` (map unpackS . T.inits)
534tl_inits = L.inits `eqP` (map unpackS . TL.inits)
573tl_inits = L.inits `eqP` (map unpackS . TL.inits)
535t_tails = L.tails `eqP` (map unpackS . T.tails)
574t_tails = L.tails `eqP` (map unpackS . T.tails)
575+tl_tails = unsquare $
536−tl_tails = L.tails `eqP` (map unpackS . TL.tails)
576+ L.tails `eqP` (map unpackS . TL.tails)
537−t_findAppendId (NotEmpty s) = unsquare $ \ts ->
577+t_findAppendId = unsquare $ \(NotEmpty s) ts ->
538 let t = T.intercalate s ts
578 let t = T.intercalate s ts
539 in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)
579 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 ->
541 let t = TL.intercalate s ts
581 let t = TL.intercalate s ts
542 in all (==t) $ map (uncurry TL.append) (TL.breakOnAll s t)
582 in all (==t) $ map (uncurry TL.append) (TL.breakOnAll s t)
583+t_findContains = unsquare $ \(NotEmpty s) ->
543−t_findContains (NotEmpty s) = all (T.isPrefixOf s . snd) . T.breakOnAll s .
584+ all (T.isPrefixOf s . snd) . T.breakOnAll s . T.intercalate s
544− T.intercalate s
545−tl_findContains (NotEmpty s) = all (TL.isPrefixOf s . snd) .
585+tl_findContains = unsquare $ \(NotEmpty s) -> all (TL.isPrefixOf s . snd) .
546 TL.breakOnAll s . TL.intercalate s
586 TL.breakOnAll s . TL.intercalate s
547sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c
587sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c
548t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s
588t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s
549tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s
589tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s
550
590
591+t_splitOn_split s = unsquare $
551−t_splitOn_split s = (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s
592+ (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s
593+tl_splitOn_split s = unsquare $
552−tl_splitOn_split s = ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`
594+ ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`
553− (map TL.fromStrict . T.splitOn s)) . T.intercalate s
595+ (map TL.fromStrict . T.splitOn s)) . T.intercalate s
554t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)
596t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)
555tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)
597tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)
556
598
@@ -592,10 +634,14 @@ t_lines' = lines' `eqP` (map unpackS . T.lines')
592t_words = L.words `eqP` (map unpackS . T.words)
634t_words = L.words `eqP` (map unpackS . T.words)
593
635
594tl_words = L.words `eqP` (map unpackS . TL.words)
636tl_words = L.words `eqP` (map unpackS . TL.words)
637+t_unlines = unsquare $
595−t_unlines = L.unlines `eq` (unpackS . T.unlines . map packS)
638+ L.unlines `eq` (unpackS . T.unlines . map packS)
639+tl_unlines = unsquare $
596−tl_unlines = L.unlines `eq` (unpackS . TL.unlines . map packS)
640+ L.unlines `eq` (unpackS . TL.unlines . map packS)
641+t_unwords = unsquare $
597−t_unwords = L.unwords `eq` (unpackS . T.unwords . map packS)
642+ L.unwords `eq` (unpackS . T.unwords . map packS)
643+tl_unwords = unsquare $
598−tl_unwords = L.unwords `eq` (unpackS . TL.unwords . map packS)
644+ L.unwords `eq` (unpackS . TL.unwords . map packS)
599
645
600s_isPrefixOf s = L.isPrefixOf s `eqP`
646s_isPrefixOf s = L.isPrefixOf s `eqP`
601 (S.isPrefixOf (S.stream $ packS s) . S.stream)
647 (S.isPrefixOf (S.stream $ packS s) . S.stream)
@@ -672,8 +718,9 @@ t_indices (NotEmpty s) = Slow.indices s `eq` indices s
672tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
718tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
673 where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)
719 where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)
674 conc = T.concat . TL.toChunks
720 conc = T.concat . TL.toChunks
675−t_indices_occurs (NotEmpty t) ts = let s = T.intercalate t ts
721+t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
722+ let s = T.intercalate t ts
676− in Slow.indices t s == indices t s
723+ in Slow.indices t s == indices t s
677
724
678-- Bit shifts.
725-- Bit shifts.
679shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
726shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
@@ -709,6 +756,7 @@ tb_decimal :: (Integral a, Show a) => a -> Bool
709tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)
756tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)
710
757
711tb_decimal_integer (a::Integer) = tb_decimal a
758tb_decimal_integer (a::Integer) = tb_decimal a
759+tb_decimal_integer_big (Big a) = tb_decimal a
712tb_decimal_int (a::Int) = tb_decimal a
760tb_decimal_int (a::Int) = tb_decimal a
713tb_decimal_int8 (a::Int8) = tb_decimal a
761tb_decimal_int8 (a::Int8) = tb_decimal a
714tb_decimal_int16 (a::Int16) = tb_decimal a
762tb_decimal_int16 (a::Int16) = tb_decimal a
@@ -720,6 +768,11 @@ tb_decimal_word16 (a::Word16) = tb_decimal a
720tb_decimal_word32 (a::Word32) = tb_decimal a
768tb_decimal_word32 (a::Word32) = tb_decimal a
721tb_decimal_word64 (a::Word64) = tb_decimal a
769tb_decimal_word64 (a::Word64) = tb_decimal a
722
770
771+tb_decimal_big_int (BigBounded (a::Int)) = tb_decimal a
772+tb_decimal_big_int64 (BigBounded (a::Int64)) = tb_decimal a
773+tb_decimal_big_word (BigBounded (a::Word)) = tb_decimal a
774+tb_decimal_big_word64 (BigBounded (a::Word64)) = tb_decimal a
775+
723tb_hex :: (Integral a, Show a) => a -> Bool
776tb_hex :: (Integral a, Show a) => a -> Bool
724tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")
777tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")
725
778
@@ -741,6 +794,21 @@ tb_realfloat = (TB.toLazyText . TB.realFloat) `eq` (TL.pack . show)
741tb_realfloat_float (a::Float) = tb_realfloat a
794tb_realfloat_float (a::Float) = tb_realfloat a
742tb_realfloat_double (a::Double) = tb_realfloat a
795tb_realfloat_double (a::Double) = tb_realfloat a
743
796
797+showFloat :: (RealFloat a) => TB.FPFormat -> Maybe Int -> a -> ShowS
798+showFloat TB.Exponent = showEFloat
799+showFloat TB.Fixed = showFFloat
800+showFloat TB.Generic = showGFloat
801+
802+tb_formatRealFloat :: (RealFloat a, Show a) =>
803+ a -> TB.FPFormat -> Precision a -> Property
804+tb_formatRealFloat a fmt prec =
805+ TB.formatRealFloat fmt p a ===
806+ TB.fromString (showFloat fmt p a "")
807+ where p = precision a prec
808+
809+tb_formatRealFloat_float (a::Float) = tb_formatRealFloat a
810+tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a
811+
744-- Reading.
812-- Reading.
745
813
746t_decimal (n::Int) s =
814t_decimal (n::Int) s =
@@ -749,16 +817,18 @@ t_decimal (n::Int) s =
749tl_decimal (n::Int) s =
817tl_decimal (n::Int) s =
750 TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
818 TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
751 where t = TL.dropWhile isDigit s
819 where t = TL.dropWhile isDigit s
752−t_hexadecimal (n::Positive Int) s ox =
820+t_hexadecimal m s ox =
753 T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
821 T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
754 where t = T.dropWhile isHexDigit s
822 where t = T.dropWhile isHexDigit s
755 p = if ox then "0x" else ""
823 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 =
757 TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
826 TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
758 where t = TL.dropWhile isHexDigit s
827 where t = TL.dropWhile isHexDigit s
759 p = if ox then "0x" else ""
828 p = if ox then "0x" else ""
829+ n = getPositive m :: Int
760
830
761−isFloaty c = c `elem` "+-.0123456789eE"
831+isFloaty c = c `elem` ("+-.0123456789eE" :: String)
762
832
763t_read_rational p tol (n::Double) s =
833t_read_rational p tol (n::Double) s =
764 case p (T.pack (show n) `T.append` t) of
834 case p (T.pack (show n) `T.append` t) of
@@ -1040,9 +1110,12 @@ tests =
1040 ],
1110 ],
1041
1111
1042 testGroup "unfolds" [
1112 testGroup "unfolds" [
1113+ testProperty "tl_repeat" tl_repeat,
1043 testProperty "s_replicate" s_replicate,
1114 testProperty "s_replicate" s_replicate,
1044 testProperty "t_replicate" t_replicate,
1115 testProperty "t_replicate" t_replicate,
1045 testProperty "tl_replicate" tl_replicate,
1116 testProperty "tl_replicate" tl_replicate,
1117+ testProperty "tl_cycle" tl_cycle,
1118+ testProperty "tl_iterate" tl_iterate,
1046 testProperty "t_unfoldr" t_unfoldr,
1119 testProperty "t_unfoldr" t_unfoldr,
1047 testProperty "tl_unfoldr" tl_unfoldr,
1120 testProperty "tl_unfoldr" tl_unfoldr,
1048 testProperty "t_unfoldrN" t_unfoldrN,
1121 testProperty "t_unfoldrN" t_unfoldrN,
@@ -1056,12 +1129,16 @@ tests =
1056 testProperty "s_take_s" s_take_s,
1129 testProperty "s_take_s" s_take_s,
1057 testProperty "sf_take" sf_take,
1130 testProperty "sf_take" sf_take,
1058 testProperty "t_take" t_take,
1131 testProperty "t_take" t_take,
1132+ testProperty "t_takeEnd" t_takeEnd,
1059 testProperty "tl_take" tl_take,
1133 testProperty "tl_take" tl_take,
1134+ testProperty "tl_takeEnd" tl_takeEnd,
1060 testProperty "s_drop" s_drop,
1135 testProperty "s_drop" s_drop,
1061 testProperty "s_drop_s" s_drop_s,
1136 testProperty "s_drop_s" s_drop_s,
1062 testProperty "sf_drop" sf_drop,
1137 testProperty "sf_drop" sf_drop,
1063 testProperty "t_drop" t_drop,
1138 testProperty "t_drop" t_drop,
1139+ testProperty "t_dropEnd" t_dropEnd,
1064 testProperty "tl_drop" tl_drop,
1140 testProperty "tl_drop" tl_drop,
1141+ testProperty "tl_dropEnd" tl_dropEnd,
1065 testProperty "s_take_drop" s_take_drop,
1142 testProperty "s_take_drop" s_take_drop,
1066 testProperty "s_take_drop_s" s_take_drop_s,
1143 testProperty "s_take_drop_s" s_take_drop_s,
1067 testProperty "s_takeWhile" s_takeWhile,
1144 testProperty "s_takeWhile" s_takeWhile,
@@ -1069,6 +1146,8 @@ tests =
1069 testProperty "sf_takeWhile" sf_takeWhile,
1146 testProperty "sf_takeWhile" sf_takeWhile,
1070 testProperty "t_takeWhile" t_takeWhile,
1147 testProperty "t_takeWhile" t_takeWhile,
1071 testProperty "tl_takeWhile" tl_takeWhile,
1148 testProperty "tl_takeWhile" tl_takeWhile,
1149+ testProperty "t_takeWhileEnd" t_takeWhileEnd,
1150+ testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1072 testProperty "sf_dropWhile" sf_dropWhile,
1151 testProperty "sf_dropWhile" sf_dropWhile,
1073 testProperty "s_dropWhile" s_dropWhile,
1152 testProperty "s_dropWhile" s_dropWhile,
1074 testProperty "s_dropWhile_s" s_dropWhile_s,
1153 testProperty "s_dropWhile_s" s_dropWhile_s,
@@ -1214,11 +1293,16 @@ tests =
1214 testProperty "tb_decimal_int32" tb_decimal_int32,
1293 testProperty "tb_decimal_int32" tb_decimal_int32,
1215 testProperty "tb_decimal_int64" tb_decimal_int64,
1294 testProperty "tb_decimal_int64" tb_decimal_int64,
1216 testProperty "tb_decimal_integer" tb_decimal_integer,
1295 testProperty "tb_decimal_integer" tb_decimal_integer,
1296+ testProperty "tb_decimal_integer_big" tb_decimal_integer_big,
1217 testProperty "tb_decimal_word" tb_decimal_word,
1297 testProperty "tb_decimal_word" tb_decimal_word,
1218 testProperty "tb_decimal_word8" tb_decimal_word8,
1298 testProperty "tb_decimal_word8" tb_decimal_word8,
1219 testProperty "tb_decimal_word16" tb_decimal_word16,
1299 testProperty "tb_decimal_word16" tb_decimal_word16,
1220 testProperty "tb_decimal_word32" tb_decimal_word32,
1300 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
1222 ],
1306 ],
1223 testGroup "hexadecimal" [
1307 testGroup "hexadecimal" [
1224 testProperty "tb_hexadecimal_int" tb_hexadecimal_int,
1308 testProperty "tb_hexadecimal_int" tb_hexadecimal_int,
@@ -1235,7 +1319,9 @@ tests =
1235 ],
1319 ],
1236 testGroup "realfloat" [
1320 testGroup "realfloat" [
1237 testProperty "tb_realfloat_double" tb_realfloat_double,
1321 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
1239 ],
1325 ],
1240 testProperty "tb_fromText" tb_fromText,
1326 testProperty "tb_fromText" tb_fromText,
1241 testProperty "tb_singleton" tb_singleton
1327 testProperty "tb_singleton" tb_singleton
@@ -1271,5 +1357,7 @@ tests =
1271 testProperty "t_take_drop_16" t_take_drop_16,
1357 testProperty "t_take_drop_16" t_take_drop_16,
1272 testProperty "t_use_from" t_use_from,
1358 testProperty "t_use_from" t_use_from,
1273 testProperty "t_copy" t_copy
1359 testProperty "t_copy" t_copy
1274− ]
1360+ ],
1361+
1362+ testGroup "mul" Mul.tests
1275 ]
1363 ]
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 @@
7module Tests.QuickCheckUtils
7module Tests.QuickCheckUtils
8 (
8 (
9 genUnicode
9 genUnicode
10− , genUnicodeWith
11− , ascii
12− , plane0
13− , plane1
14− , plane2
15− , plane14
16− , planes
17−
18 , unsquare
10 , unsquare
19 , smallArbitrary
11 , smallArbitrary
20
12
13+ , BigBounded(..)
14+ , BigInt(..)
21− , NotEmpty (..)
15+ , NotEmpty(..)
22
16
23− , Small (..)
17+ , Small(..)
24 , small
18 , small
25
19
20+ , Precision(..)
21+ , precision
22+
26 , integralRandomR
23 , integralRandomR
27
24
28− , DecodeErr (..)
25+ , DecodeErr(..)
29 , genDecodeErr
26 , genDecodeErr
30
27
31− , Stringy (..)
28+ , Stringy(..)
32 , eq
29 , eq
33 , eqP
30 , eqP
34
31
35− , Encoding (..)
32+ , Encoding(..)
36
33
37 , write_read
34 , write_read
38 ) where
35 ) where
39
36
37+import Control.Applicative ((<$>))
40import Control.Arrow (first, (***))
38import Control.Arrow (first, (***))
41import Control.DeepSeq (NFData (..), deepseq)
39import Control.DeepSeq (NFData (..), deepseq)
42import Control.Exception (bracket)
40import Control.Exception (bracket)
43−import Data.Bits ((.&.))
44−import Data.Char (chr)
45import Data.String (IsString, fromString)
41import Data.String (IsString, fromString)
46import Data.Text.Foreign (I16)
42import Data.Text.Foreign (I16)
43+import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))
47import Data.Word (Word8, Word16)
44import Data.Word (Word8, Word16)
48import Debug.Trace (trace)
45import Debug.Trace (trace)
49−import System.Random (Random (..), RandomGen)
46+import System.Random (Random(..), RandomGen)
50−import Test.QuickCheck hiding ((.&.))
47+import Test.QuickCheck hiding (Fixed(..), Small (..), (.&.))
51import Test.QuickCheck.Monadic (assert, monadicIO, run)
48import Test.QuickCheck.Monadic (assert, monadicIO, run)
49+import Test.QuickCheck.Unicode (string)
52import Tests.Utils
50import Tests.Utils
53import qualified Data.ByteString as B
51import qualified Data.ByteString as B
54import qualified Data.Text as T
52import qualified Data.Text as T
@@ -60,6 +58,14 @@ import qualified Data.Text.Internal.Lazy.Fusion as TLF
60import qualified Data.Text.Lazy as TL
58import qualified Data.Text.Lazy as TL
61import qualified System.IO as IO
59import qualified System.IO as IO
62
60
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+
63instance Random I16 where
69instance Random I16 where
64 randomR = integralRandomR
70 randomR = integralRandomR
65 random = randomR (minBound,maxBound)
71 random = randomR (minBound,maxBound)
@@ -73,75 +79,22 @@ instance Arbitrary B.ByteString where
73 shrink = map B.pack . shrink . B.unpack
79 shrink = map B.pack . shrink . B.unpack
74
80
75#if !MIN_VERSION_base(4,4,0)
81#if !MIN_VERSION_base(4,4,0)
82+instance Random Int64 where
83+ randomR = integralRandomR
84+ random = randomR (minBound,maxBound)
85+
86+instance Random Word where
87+ randomR = integralRandomR
88+ random = randomR (minBound,maxBound)
89+
76instance Random Word8 where
90instance Random Word8 where
77 randomR = integralRandomR
91 randomR = integralRandomR
78 random = randomR (minBound,maxBound)
92 random = randomR (minBound,maxBound)
79−#endif
80
93
81−genUnicode :: IsString a => Gen a
94+instance Random Word64 where
82−genUnicode = genUnicodeWith planes
95+ randomR = integralRandomR
83−
96+ random = randomR (minBound,maxBound)
84−genUnicodeWith :: IsString a => [Gen Int] -> Gen a
97+#endif
85−genUnicodeWith gens = fmap fromString string
86− where
87− string = sized $ \n ->
88− do k <- choose (0,n)
89− sequence [ char | _ <- [1..k] ]
90−
91− excluding :: [a -> Bool] -> Gen a -> Gen a
92− excluding bad gen = loop
93− where
94− loop = do
95− x <- gen
96− if or (map ($ x) bad)
97− then loop
98− else return x
99−
100− reserved = [lowSurrogate, highSurrogate, noncharacter]
101− lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF
102− highSurrogate c = c >= 0xD800 && c <= 0xDBFF
103− noncharacter c = masked == 0xFFFE || masked == 0xFFFF
104− where
105− masked = c .&. 0xFFFF
106−
107− char = chr `fmap` excluding reserved (oneof gens)
108−
109−ascii :: Gen Int
110−ascii = choose (0,0x7F)
111−
112−plane0 :: Gen Int
113−plane0 = choose (0xF0, 0xFFFF)
114−
115−plane1 :: Gen Int
116−plane1 = oneof [ choose (0x10000, 0x10FFF)
117− , choose (0x11000, 0x11FFF)
118− , choose (0x12000, 0x12FFF)
119− , choose (0x13000, 0x13FFF)
120− , choose (0x1D000, 0x1DFFF)
121− , choose (0x1F000, 0x1FFFF)
122− ]
123−
124−plane2 :: Gen Int
125−plane2 = oneof [ choose (0x20000, 0x20FFF)
126− , choose (0x21000, 0x21FFF)
127− , choose (0x22000, 0x22FFF)
128− , choose (0x23000, 0x23FFF)
129− , choose (0x24000, 0x24FFF)
130− , choose (0x25000, 0x25FFF)
131− , choose (0x26000, 0x26FFF)
132− , choose (0x27000, 0x27FFF)
133− , choose (0x28000, 0x28FFF)
134− , choose (0x29000, 0x29FFF)
135− , choose (0x2A000, 0x2AFFF)
136− , choose (0x2B000, 0x2BFFF)
137− , choose (0x2F000, 0x2FFFF)
138− ]
139−
140−plane14 :: Gen Int
141−plane14 = choose (0xE0000, 0xE0FFF)
142−
143−planes :: [Gen Int]
144−planes = [ascii, plane0, plane1, plane2, plane14]
145
98
146-- For tests that have O(n^2) running times or input sizes, resize
99-- For tests that have O(n^2) running times or input sizes, resize
147-- their inputs to the square root of the originals.
100-- their inputs to the square root of the originals.
@@ -160,6 +113,20 @@ instance Arbitrary TL.Text where
160 arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary
113 arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary
161 shrink = map TL.pack . shrink . TL.unpack
114 shrink = map TL.pack . shrink . TL.unpack
162
115
116+newtype BigInt = Big Integer
117+ deriving (Eq, Show)
118+
119+instance Arbitrary BigInt where
120+ arbitrary = choose (1::Int,200) >>= \e -> Big <$> choose (10^(e-1),10^e)
121+ shrink (Big a) = [Big (a `div` 2^(l-e)) | e <- shrink l]
122+ where l = truncate (log (fromIntegral a) / log 2 :: Double) :: Integer
123+
124+newtype BigBounded a = BigBounded a
125+ deriving (Eq, Show)
126+
127+instance (Bounded a, Random a, Arbitrary a) => Arbitrary (BigBounded a) where
128+ arbitrary = BigBounded <$> choose (minBound, maxBound)
129+
163newtype NotEmpty a = NotEmpty { notEmpty :: a }
130newtype NotEmpty a = NotEmpty { notEmpty :: a }
164 deriving (Eq, Ord)
131 deriving (Eq, Ord)
165
132
@@ -300,6 +267,30 @@ eqP f g s w = eql "orig" (f s) (g t) &&
300 | a =^= b = True
267 | a =^= b = True
301 | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
268 | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
302
269
270+instance Arbitrary FPFormat where
271+ arbitrary = elements [Exponent, Fixed, Generic]
272+
273+newtype Precision a = Precision (Maybe Int)
274+ deriving (Eq, Show)
275+
276+precision :: a -> Precision a -> Maybe Int
277+precision _ (Precision prec) = prec
278+
279+arbitraryPrecision :: Int -> Gen (Precision a)
280+arbitraryPrecision maxDigits = Precision <$> do
281+ n <- choose (-1,maxDigits)
282+ return $ if n == -1
283+ then Nothing
284+ else Just n
285+
286+instance Arbitrary (Precision Float) where
287+ arbitrary = arbitraryPrecision 11
288+ shrink = map Precision . shrink . precision undefined
289+
290+instance Arbitrary (Precision Double) where
291+ arbitrary = arbitraryPrecision 22
292+ shrink = map Precision . shrink . precision undefined
293+
303-- Work around lack of Show instance for TextEncoding.
294-- Work around lack of Show instance for TextEncoding.
304data Encoding = E String IO.TextEncoding
295data Encoding = E String IO.TextEncoding
305
296
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
2version: 0.0.0.0
2version: 0.0.0.0
3synopsis: Functional tests for the text package
3synopsis: Functional tests for the text package
4description: Functional tests for the text package
4description: Functional tests for the text package
5−homepage: https://bitbucket.org/bos/text
5+homepage: https://github.com/bos/text
6−license: BSD3
6+license: BSD2
7license-file: ../LICENSE
7license-file: ../LICENSE
8author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
8author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
9 Bryan O'Sullivan <bos@serpentine.com>,
9 Bryan O'Sullivan <bos@serpentine.com>,
@@ -18,10 +18,20 @@ cabal-version: >=1.8
18flag hpc
18flag hpc
19 description: Enable HPC to generate coverage reports
19 description: Enable HPC to generate coverage reports
20 default: False
20 default: False
21+ manual: True
21
22
22executable text-tests
23executable text-tests
23 main-is: Tests.hs
24 main-is: Tests.hs
24
25
26+ other-modules:
27+ Tests.IO
28+ Tests.Properties
29+ Tests.Properties.Mul
30+ Tests.QuickCheckUtils
31+ Tests.Regressions
32+ Tests.SlowFunctions
33+ Tests.Utils
34+
25 ghc-options:
35 ghc-options:
26 -Wall -threaded -O0 -rtsopts
36 -Wall -threaded -O0 -rtsopts
27
37
@@ -36,11 +46,12 @@ executable text-tests
36
46
37 build-depends:
47 build-depends:
38 HUnit >= 1.2,
48 HUnit >= 1.2,
39− QuickCheck >= 2.4,
49+ QuickCheck >= 2.7,
40 base == 4.*,
50 base == 4.*,
41 bytestring,
51 bytestring,
42 deepseq,
52 deepseq,
43 directory,
53 directory,
54+ quickcheck-unicode,
44 random,
55 random,
45 test-framework >= 0.4,
56 test-framework >= 0.4,
46 test-framework-hunit >= 0.2,
57 test-framework-hunit >= 0.2,
@@ -66,6 +77,7 @@ library
66 hs-source-dirs: ..
77 hs-source-dirs: ..
67 c-sources: ../cbits/cbits.c
78 c-sources: ../cbits/cbits.c
68 include-dirs: ../include
79 include-dirs: ../include
80+ ghc-options: -Wall
69 exposed-modules:
81 exposed-modules:
70 Data.Text
82 Data.Text
71 Data.Text.Array
83 Data.Text.Array
@@ -102,6 +114,8 @@ library
102 Data.Text.Internal.Lazy.Search
114 Data.Text.Internal.Lazy.Search
103 Data.Text.Internal.Private
115 Data.Text.Internal.Private
104 Data.Text.Read
116 Data.Text.Read
117+ Data.Text.Show
118+ Data.Text.Internal.Read
105 Data.Text.Internal.Search
119 Data.Text.Internal.Search
106 Data.Text.Unsafe
120 Data.Text.Unsafe
107 Data.Text.Internal.Unsafe
121 Data.Text.Internal.Unsafe
@@ -122,6 +136,7 @@ library
122 build-depends:
136 build-depends:
123 array,
137 array,
124 base == 4.*,
138 base == 4.*,
139+ binary,
125 bytestring,
140 bytestring,
126 deepseq,
141 deepseq,
127 ghc-prim,
142 ghc-prim,
text.cabal+29−8
@@ -1,5 +1,5 @@
1name: text
1name: text
2−version: 1.1.0.1
2+version: 1.2.2.1
3homepage: https://github.com/bos/text
3homepage: https://github.com/bos/text
4bug-reports: https://github.com/bos/text/issues
4bug-reports: https://github.com/bos/text/issues
5synopsis: An efficient packed Unicode text type.
5synopsis: An efficient packed Unicode text type.
@@ -31,7 +31,7 @@ description:
31 the @text-icu@ package:
31 the @text-icu@ package:
32 <http://hackage.haskell.org/package/text-icu>
32 <http://hackage.haskell.org/package/text-icu>
33
33
34−license: BSD3
34+license: BSD2
35license-file: LICENSE
35license-file: LICENSE
36author: Bryan O'Sullivan <bos@serpentine.com>
36author: Bryan O'Sullivan <bos@serpentine.com>
37maintainer: Bryan O'Sullivan <bos@serpentine.com>
37maintainer: Bryan O'Sullivan <bos@serpentine.com>
@@ -51,7 +51,7 @@ extra-source-files:
51 benchmarks/python/*.py
51 benchmarks/python/*.py
52 benchmarks/ruby/*.rb
52 benchmarks/ruby/*.rb
53 benchmarks/text-benchmarks.cabal
53 benchmarks/text-benchmarks.cabal
54− changelog
54+ changelog.md
55 include/*.h
55 include/*.h
56 scripts/*.hs
56 scripts/*.hs
57 tests-and-benchmarks.markdown
57 tests-and-benchmarks.markdown
@@ -59,16 +59,25 @@ extra-source-files:
59 tests/.ghci
59 tests/.ghci
60 tests/Makefile
60 tests/Makefile
61 tests/Tests/*.hs
61 tests/Tests/*.hs
62+ tests/Tests/Properties/*.hs
63+ tests/cabal.config
62 tests/scripts/*.sh
64 tests/scripts/*.sh
63 tests/text-tests.cabal
65 tests/text-tests.cabal
64
66
67+flag bytestring-builder
68+ description: Depend on the bytestring-builder package for backwards compatibility.
69+ default: False
70+ manual: False
71+
65flag developer
72flag developer
66 description: operate in developer mode
73 description: operate in developer mode
67 default: False
74 default: False
75+ manual: True
68
76
69flag integer-simple
77flag integer-simple
70 description: Use the simple integer library instead of GMP
78 description: Use the simple integer library instead of GMP
71 default: False
79 default: False
80+ manual: False
72
81
73library
82library
74 c-sources: cbits/cbits.c
83 c-sources: cbits/cbits.c
@@ -119,16 +128,21 @@ library
119 Data.Text.Read
128 Data.Text.Read
120 Data.Text.Unsafe
129 Data.Text.Unsafe
121
130
131+ other-modules:
132+ Data.Text.Show
133+
122 build-depends:
134 build-depends:
123 array >= 0.3,
135 array >= 0.3,
124 base >= 4.2 && < 5,
136 base >= 4.2 && < 5,
137+ binary,
125 deepseq >= 1.1.0.0,
138 deepseq >= 1.1.0.0,
126 ghc-prim >= 0.2
139 ghc-prim >= 0.2
127
140
128− if impl(ghc >= 7.7)
141+ if flag(bytestring-builder)
129− build-depends: bytestring >= 0.10.4.0
142+ build-depends: bytestring >= 0.9 && < 0.10.4,
143+ bytestring-builder >= 0.10.4
130 else
144 else
131− build-depends: bytestring >= 0.9
145+ build-depends: bytestring >= 0.10.4
132
146
133 cpp-options: -DHAVE_DEEPSEQ
147 cpp-options: -DHAVE_DEEPSEQ
134 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
148 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
@@ -159,18 +173,25 @@ test-suite tests
159
173
160 build-depends:
174 build-depends:
161 HUnit >= 1.2,
175 HUnit >= 1.2,
162− QuickCheck >= 2.4,
176+ QuickCheck >= 2.7,
163 array,
177 array,
164 base,
178 base,
165− bytestring,
179+ binary,
166 deepseq,
180 deepseq,
167 directory,
181 directory,
168 ghc-prim,
182 ghc-prim,
183+ quickcheck-unicode,
169 random,
184 random,
170 test-framework >= 0.4,
185 test-framework >= 0.4,
171 test-framework-hunit >= 0.2,
186 test-framework-hunit >= 0.2,
172 test-framework-quickcheck2 >= 0.2
187 test-framework-quickcheck2 >= 0.2
173
188
189+ if flag(bytestring-builder)
190+ build-depends: bytestring >= 0.9 && < 0.10.4,
191+ bytestring-builder >= 0.10.4
192+ else
193+ build-depends: bytestring >= 0.10.4
194+
174 if flag(integer-simple)
195 if flag(integer-simple)
175 cpp-options: -DINTEGER_SIMPLE
196 cpp-options: -DINTEGER_SIMPLE
176 build-depends: integer-simple >= 0.1 && < 0.5
197 build-depends: integer-simple >= 0.1 && < 0.5