on 77fef5f help sign in
.gitignoredeleted−3
since splitsnapshots
unifiedsplit
@@ -1,3 +0,0 @@
1−dist
2−cabal-dev
3−cabal.sandbox.config
.hgtags−21
@@ -43,24 +43,3 @@ b75d3041d275e8e76b26605b0d426a572ddf1249 0.11.1.3
437fa79662b66aade97fe49394977213fe6432942e 0.11.3.0
437fa79662b66aade97fe49394977213fe6432942e 0.11.3.0
44d99cd091cdf71ce807a4255f6cc509c3154f51ea 0.11.3.1
44d99cd091cdf71ce807a4255f6cc509c3154f51ea 0.11.3.1
4531f57612fd425d1bb56352ce6b79e41ce6699a45 1.0.0.0
4531f57612fd425d1bb56352ce6b79e41ce6699a45 1.0.0.0
46−7cba97c86467c1881dfced68613891f3c65561b0 1.0.0.1
47−62674a9bbc83145d1d7be28a05d456ab6bb5ff89 1.1.0.0
48−68a32d80c0829da164d1e6b3acedcc3efeda0957 1.1.0.1
49−6d863daafbf0e1289ec0a0eb9b4be2a0a9cb8d3d 1.1.1.0
50−fb7299f22449750c653ac64dee4bd63c13ea6e4c 1.1.1.1
51−eb170cb533b63534d166b5fd5344b36676adf140 1.1.1.2
52−e749e05f715d02445803f653cd3d97d5395d7c6f 1.1.1.3
53−b0dff8ca1142595bab489a768ca62e6a6805aac4 1.1.1.4
54−f8a60279237c1c28e094868740d9188dd94fcc9e 1.2.0.0
55−6231451979b2d33e28038b75f2dab19c9731f5c3 1.2.0.1
56−99a3503b4ad001fc1894e90286e96d7dea1e9195 1.2.0.2
57−47f138edf15576b9adaeed64784e30811099f202 1.2.0.3
58−0b064b0c69106bbcd13cb0099e72ae5fa2347bf0 1.2.0.4
59−8bbb3e222a0037035d893f731b0a23be449f7346 1.2.0.5
60−18c7f8e19872762b7e28ee1871e72f70ea54e3cd 1.2.0.6
61−42f751b87b4a187db93f595a8166d51746ff57d4 1.2.1.0
62−78227a84740b70dcd4cf7a65f3bcf603d87e48e2 1.2.1.1
63−40f268e6735749ef36f487e1d928eaa957bb431d 1.2.1.2
64−631fd055e27fa10983e17e9ad36d1b285b85c661 1.2.1.3
65−8221a68ed5ec37028357df9c6c25f52320e54ad9 1.2.2.0
66−ce1c5ac65eb9f5580114b4e380092b05a485e95d 1.2.2.1
Data/Text.hs+142−262
@@ -3,9 +3,6 @@
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-- |
11-- Module : Data.Text
8-- Module : Data.Text
@@ -14,7 +11,8 @@
14-- (c) 2008, 2009 Tom Harper
11-- (c) 2008, 2009 Tom Harper
15--
12--
16-- License : BSD-style
13-- License : BSD-style
17−-- Maintainer : bos@serpentine.com
14+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
15+-- duncan@haskell.org
18-- Stability : experimental
16-- Stability : experimental
19-- Portability : GHC
17-- Portability : GHC
20--
18--
@@ -32,8 +30,8 @@
32--
30--
33-- To use an extended and very rich family of functions for working
31-- To use an extended and very rich family of functions for working
34-- with Unicode text (including normalization, regular expressions,
32-- with Unicode text (including normalization, regular expressions,
35−-- non-standard encodings, text breaking, and locales), see
33+-- non-standard encodings, text breaking, and locales), see the
36−-- <http://hackage.haskell.org/package/text-icu the text-icu package >.
34+-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>
37
35
38module Data.Text
36module Data.Text
39 (
37 (
@@ -125,11 +123,8 @@ module Data.Text
125
123
126 -- ** Breaking strings
124 -- ** Breaking strings
127 , take
125 , take
128− , takeEnd
129 , drop
126 , drop
130− , dropEnd
131 , takeWhile
127 , takeWhile
132− , takeWhileEnd
133 , dropWhile
128 , dropWhile
134 , dropWhileEnd
129 , dropWhileEnd
135 , dropAround
130 , dropAround
@@ -192,43 +187,35 @@ module Data.Text
192
187
193 -- * Low level operations
188 -- * Low level operations
194 , copy
189 , copy
195− , unpackCString#
196 ) where
190 ) where
197
191
198import Prelude (Char, Bool(..), Int, Maybe(..), String,
192import Prelude (Char, Bool(..), Int, Maybe(..), String,
199 Eq(..), Ord(..), Ordering(..), (++),
193 Eq(..), Ord(..), Ordering(..), (++),
200− Read(..),
194+ Read(..), Show(..),
201− (&&), (||), (+), (-), (.), ($), ($!), (>>),
195+ (&&), (||), (+), (-), (.), ($), ($!), (>>), (*),
202− not, return, otherwise, quot)
196+ maxBound, not, return, otherwise, quot)
203#if defined(HAVE_DEEPSEQ)
197#if defined(HAVE_DEEPSEQ)
204−import Control.DeepSeq (NFData(rnf))
198+import Control.DeepSeq (NFData)
205#endif
199#endif
206#if defined(ASSERTS)
200#if defined(ASSERTS)
207import Control.Exception (assert)
201import Control.Exception (assert)
208#endif
202#endif
209import Data.Char (isSpace)
203import Data.Char (isSpace)
210−import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
204+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))
211− Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
205+import Data.Data (mkNoRepType)
212import Control.Monad (foldM)
206import Control.Monad (foldM)
213−import Control.Monad.ST (ST)
214import qualified Data.Text.Array as A
207import qualified Data.Text.Array as A
215import qualified Data.List as L
208import qualified Data.List as L
216−import Data.Binary (Binary(get, put))
217import Data.Monoid (Monoid(..))
209import Data.Monoid (Monoid(..))
218−#if MIN_VERSION_base(4,9,0)
219−import Data.Semigroup (Semigroup(..))
220−#endif
221import Data.String (IsString(..))
210import Data.String (IsString(..))
222import qualified Data.Text.Internal.Fusion as S
211import qualified Data.Text.Internal.Fusion as S
223import qualified Data.Text.Internal.Fusion.Common as S
212import qualified Data.Text.Internal.Fusion.Common as S
224−import Data.Text.Encoding (decodeUtf8', encodeUtf8)
225import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
213import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
226import Data.Text.Internal.Private (span_)
214import Data.Text.Internal.Private (span_)
227−import Data.Text.Internal (Text(..), empty, firstf, mul, safe, text)
215+import Data.Text.Internal (Text(..), empty, firstf, safe, text, textP)
228−import Data.Text.Show (singleton, unpack, unpackCString#)
229import qualified Prelude as P
216import qualified Prelude as P
230import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
217import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
231− reverseIter_, unsafeHead, unsafeTail)
218+ unsafeHead, unsafeTail)
232import Data.Text.Internal.Unsafe.Char (unsafeChr)
219import Data.Text.Internal.Unsafe.Char (unsafeChr)
233import qualified Data.Text.Internal.Functions as F
220import qualified Data.Text.Internal.Functions as F
234import qualified Data.Text.Internal.Encoding.Utf16 as U16
221import qualified Data.Text.Internal.Encoding.Utf16 as U16
@@ -238,48 +225,44 @@ import Data.ByteString (ByteString)
238import qualified Data.Text.Lazy as L
225import qualified Data.Text.Lazy as L
239import Data.Int (Int64)
226import Data.Int (Int64)
240#endif
227#endif
241−import GHC.Base (eqInt, neInt, gtInt, geInt, ltInt, leInt)
242−#if __GLASGOW_HASKELL__ >= 708
228+#if __GLASGOW_HASKELL__ >= 702
243−import qualified GHC.Exts as Exts
229+import qualified GHC.CString as GHC
244−#endif
230+#else
245−#if MIN_VERSION_base(4,7,0)
231+import qualified GHC.Base as GHC
246−import Text.Printf (PrintfArg, formatArg, formatString)
247#endif
232#endif
233+import GHC.Prim (Addr#)
248
234
249-- $strict
235-- $strict
250--
236--
251-- This package provides both strict and lazy 'Text' types. The
237-- This package provides both strict and lazy 'Text' types. The
252−-- strict type is provided by the "Data.Text" module, while the lazy
238+-- strict type is provided by the 'Data.Text' package, while the lazy
253−-- type is provided by the "Data.Text.Lazy" module. Internally, the
239+-- type is provided by the 'Data.Text.Lazy' package. Internally, the
254-- lazy @Text@ type consists of a list of strict chunks.
240-- lazy @Text@ type consists of a list of strict chunks.
255--
241--
256-- The strict 'Text' type requires that an entire string fit into
242-- The strict 'Text' type requires that an entire string fit into
257−-- memory at once. The lazy 'Data.Text.Lazy.Text' type is capable of
243+-- memory at once. The lazy @Text@ type is capable of streaming
258−-- streaming strings that are larger than memory using a small memory
244+-- strings that are larger than memory using a small memory footprint.
259−-- footprint. In many cases, the overhead of chunked streaming makes
245+-- In many cases, the overhead of chunked streaming makes the lazy
260−-- the lazy 'Data.Text.Lazy.Text' type slower than its strict
246+-- @Text@ type slower than its strict counterpart, but this is not
261−-- counterpart, but this is not always the case. Sometimes, the time
247+-- always the case. Sometimes, the time complexity of a function in
262−-- complexity of a function in one module may be different from the
248+-- one module may be different from the other, due to their differing
263−-- other, due to their differing internal structures.
249+-- internal structures.
264--
250--
265-- Each module provides an almost identical API, with the main
251-- Each module provides an almost identical API, with the main
266-- difference being that the strict module uses 'Int' values for
252-- difference being that the strict module uses 'Int' values for
267−-- lengths and counts, while the lazy module uses 'Data.Int.Int64'
253+-- lengths and counts, while the lazy module uses 'Int64' lengths.
268−-- lengths.
269
254
270-- $replacement
255-- $replacement
271--
256--
272-- A 'Text' value is a sequence of Unicode scalar values, as defined
257-- A 'Text' value is a sequence of Unicode scalar values, as defined
273−-- in
274−-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35 §3.9, definition D76 of the Unicode 5.2 standard >.
258+-- in &#xa7;3.9, definition D76 of the Unicode 5.2 standard:
259+-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35>. As
275−-- As such, a 'Text' cannot contain values in the range U+D800 to
260+-- such, a 'Text' cannot contain values in the range U+D800 to U+DFFF
276−-- U+DFFF inclusive. Haskell implementations admit all Unicode code
261+-- inclusive. Haskell implementations admit all Unicode code points
277−-- points
278−-- (<http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=13 §3.4, definition D10 >)
279−-- as 'Char' values, including code points from this invalid range.
262+-- (&#xa7;3.4, definition D10) as 'Char' values, including code points
280−-- This means that there are some 'Char' values that are not valid
263+-- from this invalid range. This means that there are some 'Char'
281−-- Unicode scalar values, and the functions in this module must handle
264+-- values that are not valid Unicode scalar values, and the functions
282−-- those cases.
265+-- in this module must handle those cases.
283--
266--
284-- Within this module, many functions construct a 'Text' from one or
267-- Within this module, many functions construct a 'Text' from one or
285-- more 'Char' values. Those functions will substitute 'Char' values
268-- more 'Char' values. Those functions will substitute 'Char' values
@@ -293,8 +276,8 @@ import Text.Printf (PrintfArg, formatArg, formatString)
293-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate
276-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate
294-- code points, and so cannot be represented. The functions replace
277-- code points, and so cannot be represented. The functions replace
295-- invalid scalar values, instead of dropping them, as a security
278-- invalid scalar values, instead of dropping them, as a security
296−-- measure. For details, see
279+-- measure. For details, see Unicode Technical Report 36, &#xa7;3.5:
297−-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters Unicode Technical Report 36, §3.5 >.)
280+-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters>)
298
281
299-- $fusion
282-- $fusion
300--
283--
@@ -312,11 +295,11 @@ import Text.Printf (PrintfArg, formatArg, formatString)
312-- > countChars = T.length . T.toUpper . E.decodeUtf8
295-- > countChars = T.length . T.toUpper . E.decodeUtf8
313--
296--
314-- From the type signatures involved, this looks like it should
297-- From the type signatures involved, this looks like it should
315−-- allocate one 'Data.ByteString.ByteString' value, and two 'Text'
298+-- allocate one 'ByteString' value, and two 'Text' values. However,
316−-- values. However, when a module is compiled with optimisation
299+-- when a module is compiled with optimisation enabled under GHC, the
317−-- enabled under GHC, the two intermediate 'Text' values will be
300+-- two intermediate 'Text' values will be optimised away, and the
318−-- optimised away, and the function will be compiled down to a single
301+-- function will be compiled down to a single loop over the source
319−-- loop over the source 'Data.ByteString.ByteString'.
302+-- 'ByteString'.
320--
303--
321-- Functions that can be fused by the compiler are documented with the
304-- Functions that can be fused by the compiler are documented with the
322-- phrase \"Subject to fusion\".
305-- phrase \"Subject to fusion\".
@@ -330,82 +313,41 @@ instance Eq Text where
330instance Ord Text where
313instance Ord Text where
331 compare = compareText
314 compare = compareText
332
315
316+instance Show Text where
317+ showsPrec p ps r = showsPrec p (unpack ps) r
318+
333instance Read Text where
319instance Read Text where
334 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
320 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
335
321
336−#if MIN_VERSION_base(4,9,0)
337−-- Semigroup orphan instances for older GHCs are provided by
338−-- 'semigroups` package
339−
340−instance Semigroup Text where
341− (<>) = append
342−#endif
343−
344instance Monoid Text where
322instance Monoid Text where
345 mempty = empty
323 mempty = empty
346−#if MIN_VERSION_base(4,9,0)
347− mappend = (<>) -- future-proof definition
348−#else
349 mappend = append
324 mappend = append
350−#endif
351 mconcat = concat
325 mconcat = concat
352
326
353instance IsString Text where
327instance IsString Text where
354 fromString = pack
328 fromString = pack
355
329
356−#if __GLASGOW_HASKELL__ >= 708
357−instance Exts.IsList Text where
358− type Item Text = Char
359− fromList = pack
360− toList = unpack
361−#endif
362−
363#if defined(HAVE_DEEPSEQ)
330#if defined(HAVE_DEEPSEQ)
364−instance NFData Text where rnf !_ = ()
331+instance NFData Text
365#endif
332#endif
366
333
367−instance Binary Text where
368− put t = put (encodeUtf8 t)
369− get = do
370− bs <- get
371− case decodeUtf8' bs of
372− P.Left exn -> P.fail (P.show exn)
373− P.Right a -> P.return a
374−
375−-- | This instance preserves data abstraction at the cost of inefficiency.
334+-- This instance preserves data abstraction at the cost of inefficiency.
376-- We omit reflection services for the sake of data abstraction.
335-- We omit reflection services for the sake of data abstraction.
377--
336--
378−-- This instance was created by copying the updated behavior of
337+-- This instance was created by copying the behavior of Data.Set and
379−-- @"Data.Set".@'Data.Set.Set' and @"Data.Map".@'Data.Map.Map'. If you
380−-- feel a mistake has been made, please feel free to submit
338+-- Data.Map. If you feel a mistake has been made, please feel free to
381−-- improvements.
339+-- submit improvements.
382--
340--
383−-- The original discussion is archived here:
341+-- Original discussion is archived here:
342+
343+-- "could we get a Data instance for Data.Text.Text?"
384−-- <http://groups.google.com/group/haskell-cafe/browse_thread/thread/b5bbb1b28a7e525d/0639d46852575b93 could we get a Data instance for Data.Text.Text? >
344+-- http://groups.google.com/group/haskell-cafe/browse_thread/thread/b5bbb1b28a7e525d/0639d46852575b93
385−--
386−-- The followup discussion that changed the behavior of 'Data.Set.Set'
387−-- and 'Data.Map.Map' is archived here:
388−-- <http://markmail.org/message/trovdc6zkphyi3cr#query:+page:1+mid:a46der3iacwjcf6n+state:results Proposal: Allow gunfold for Data.Map, ... >
389
345
390instance Data Text where
346instance Data Text where
391 gfoldl f z txt = z pack `f` (unpack txt)
347 gfoldl f z txt = z pack `f` (unpack txt)
392− toConstr _ = packConstr
348+ toConstr _ = P.error "Data.Text.Text.toConstr"
393− gunfold k z c = case constrIndex c of
394− 1 -> k (z pack)
395− _ -> P.error "gunfold"
349+ gunfold _ _ = P.error "Data.Text.Text.gunfold"
396− dataTypeOf _ = textDataType
350+ dataTypeOf _ = mkNoRepType "Data.Text.Text"
397−
398−#if MIN_VERSION_base(4,7,0)
399−-- | Only defined for @base-4.7.0.0@ and later
400−instance PrintfArg Text where
401− formatArg txt = formatString $ unpack txt
402−#endif
403−
404−packConstr :: Constr
405−packConstr = mkConstr textDataType "pack" [] Prefix
406−
407−textDataType :: DataType
408−textDataType = mkDataType "Data.Text.Text" [packConstr]
409
351
410-- | /O(n)/ Compare two 'Text' values lexicographically.
352-- | /O(n)/ Compare two 'Text' values lexicographically.
411compareText :: Text -> Text -> Ordering
353compareText :: Text -> Text -> Ordering
@@ -430,6 +372,30 @@ pack :: String -> Text
430pack = unstream . S.map safe . S.streamList
372pack = unstream . S.map safe . S.streamList
431{-# INLINE [1] pack #-}
373{-# INLINE [1] pack #-}
432
374
375+-- | /O(n)/ Convert a Text into a String. Subject to fusion.
376+unpack :: Text -> String
377+unpack = S.unstreamList . stream
378+{-# INLINE [1] unpack #-}
379+
380+-- | /O(n)/ Convert a literal string into a Text. Subject to fusion.
381+unpackCString# :: Addr# -> Text
382+unpackCString# addr# = unstream (S.streamCString# addr#)
383+{-# NOINLINE unpackCString# #-}
384+
385+{-# RULES "TEXT literal" forall a.
386+ unstream (S.map safe (S.streamList (GHC.unpackCString# a)))
387+ = unpackCString# a #-}
388+
389+{-# RULES "TEXT literal UTF8" forall a.
390+ unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))
391+ = unpackCString# a #-}
392+
393+-- | /O(1)/ Convert a character into a Text. Subject to fusion.
394+-- Performs replacement on invalid scalar values.
395+singleton :: Char -> Text
396+singleton = unstream . S.singleton . safe
397+{-# INLINE [1] singleton #-}
398+
433-- -----------------------------------------------------------------------------
399-- -----------------------------------------------------------------------------
434-- * Basic functions
400-- * Basic functions
435
401
@@ -460,13 +426,12 @@ append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
460 | otherwise = overflowError "append"
426 | otherwise = overflowError "append"
461 where
427 where
462 len = len1+len2
428 len = len1+len2
463− x :: ST s (A.MArray s)
464 x = do
429 x = do
465 arr <- A.new len
430 arr <- A.new len
466 A.copyI arr 0 arr1 off1 len1
431 A.copyI arr 0 arr1 off1 len1
467 A.copyI arr len1 arr2 off2 len
432 A.copyI arr len1 arr2 off2 len
468 return arr
433 return arr
469−{-# NOINLINE append #-}
434+{-# INLINE append #-}
470
435
471{-# RULES
436{-# RULES
472"TEXT append -> fused" [~1] forall t1 t2.
437"TEXT append -> fused" [~1] forall t1 t2.
@@ -486,8 +451,8 @@ head t = S.head (stream t)
486uncons :: Text -> Maybe (Char, Text)
451uncons :: Text -> Maybe (Char, Text)
487uncons t@(Text arr off len)
452uncons t@(Text arr off len)
488 | len <= 0 = Nothing
453 | len <= 0 = Nothing
489− | otherwise = Just $ let !(Iter c d) = iter t 0
490− in (c, text arr (off+d) (len-d))
454+ | otherwise = Just (c, textP arr (off+d) (len-d))
455+ where Iter c d = iter t 0
491{-# INLINE [1] uncons #-}
456{-# INLINE [1] uncons #-}
492
457
493-- | Lifted from Control.Arrow and specialized.
458-- | Lifted from Control.Arrow and specialized.
@@ -517,7 +482,7 @@ last (Text arr off len)
517tail :: Text -> Text
482tail :: Text -> Text
518tail t@(Text arr off len)
483tail t@(Text arr off len)
519 | len <= 0 = emptyError "tail"
484 | len <= 0 = emptyError "tail"
520− | otherwise = text arr (off+d) (len-d)
485+ | otherwise = textP arr (off+d) (len-d)
521 where d = iter_ t 0
486 where d = iter_ t 0
522{-# INLINE [1] tail #-}
487{-# INLINE [1] tail #-}
523
488
@@ -532,8 +497,8 @@ tail t@(Text arr off len)
532-- be non-empty. Subject to fusion.
497-- be non-empty. Subject to fusion.
533init :: Text -> Text
498init :: Text -> Text
534init (Text arr off len) | len <= 0 = emptyError "init"
499init (Text arr off len) | len <= 0 = emptyError "init"
535− | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)
500+ | n >= 0xDC00 && n <= 0xDFFF = textP arr off (len-2)
536− | otherwise = text arr off (len-1)
501+ | otherwise = textP arr off (len-1)
537 where
502 where
538 n = A.unsafeIndex arr (off+len-1)
503 n = A.unsafeIndex arr (off+len-1)
539{-# INLINE [1] init #-}
504{-# INLINE [1] init #-}
@@ -572,9 +537,7 @@ isSingleton = S.isSingleton . stream
572-- Subject to fusion.
537-- Subject to fusion.
573length :: Text -> Int
538length :: Text -> Int
574length t = S.length (stream t)
539length t = S.length (stream t)
575−{-# INLINE [0] length #-}
540+{-# INLINE length #-}
576−-- length needs to be phased after the compareN/length rules otherwise
577−-- it may inline before the rules have an opportunity to fire.
578
541
579-- | /O(n)/ Compare the count of characters in a 'Text' to a number.
542-- | /O(n)/ Compare the count of characters in a 'Text' to a number.
580-- Subject to fusion.
543-- Subject to fusion.
@@ -593,32 +556,32 @@ compareLength t n = S.compareLengthI (stream t) n
593
556
594{-# RULES
557{-# RULES
595"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.
558"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.
596− eqInt (length t) n = compareLength t n == EQ
559+ (==) (length t) n = compareLength t n == EQ
597 #-}
560 #-}
598
561
599{-# RULES
562{-# RULES
600"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.
563"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.
601− neInt (length t) n = compareLength t n /= EQ
564+ (/=) (length t) n = compareLength t n /= EQ
602 #-}
565 #-}
603
566
604{-# RULES
567{-# RULES
605"TEXT <N/length -> compareLength/==LT" [~1] forall t n.
568"TEXT <N/length -> compareLength/==LT" [~1] forall t n.
606− ltInt (length t) n = compareLength t n == LT
569+ (<) (length t) n = compareLength t n == LT
607 #-}
570 #-}
608
571
609{-# RULES
572{-# RULES
610"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.
573"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.
611− leInt (length t) n = compareLength t n /= GT
574+ (<=) (length t) n = compareLength t n /= GT
612 #-}
575 #-}
613
576
614{-# RULES
577{-# RULES
615"TEXT >N/length -> compareLength/==GT" [~1] forall t n.
578"TEXT >N/length -> compareLength/==GT" [~1] forall t n.
616− gtInt (length t) n = compareLength t n == GT
579+ (>) (length t) n = compareLength t n == GT
617 #-}
580 #-}
618
581
619{-# RULES
582{-# RULES
620"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.
583"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.
621− geInt (length t) n = compareLength t n /= LT
584+ (>=) (length t) n = compareLength t n /= LT
622 #-}
585 #-}
623
586
624-- -----------------------------------------------------------------------------
587-- -----------------------------------------------------------------------------
@@ -649,48 +612,22 @@ reverse :: Text -> Text
649reverse t = S.reverse (stream t)
612reverse t = S.reverse (stream t)
650{-# INLINE reverse #-}
613{-# INLINE reverse #-}
651
614
652−-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
615+-- | /O(m+n)/ Replace every occurrence of one substring with another.
653−-- @haystack@ with @replacement@.
654−--
655−-- This function behaves as though it was defined as follows:
656−--
657−-- @
658−-- replace needle replacement haystack =
659−-- 'intercalate' replacement ('splitOn' needle haystack)
660−-- @
661−--
662−-- As this suggests, each occurrence is replaced exactly once. So if
663−-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
664−-- be replaced recursively:
665−--
666−-- > replace "oo" "foo" "oo" == "foo"
667−--
668−-- In cases where several instances of @needle@ overlap, only the
669−-- first one will be replaced:
670−--
671−-- > replace "ofo" "bar" "ofofo" == "barfo"
672--
616--
673-- In (unlikely) bad cases, this function's time complexity degrades
617-- In (unlikely) bad cases, this function's time complexity degrades
674-- towards /O(n*m)/.
618-- towards /O(n*m)/.
675−replace :: Text
619+replace :: Text -> Text -> Text -> Text
676− -- ^ @needle@ to search for. If this string is empty, an
677− -- error will occur.
678− -> Text
679− -- ^ @replacement@ to replace @needle@ with.
680− -> Text
681− -- ^ @haystack@ in which to search.
682− -> Text
683replace needle@(Text _ _ neeLen)
620replace needle@(Text _ _ neeLen)
684 (Text repArr repOff repLen)
621 (Text repArr repOff repLen)
685 haystack@(Text hayArr hayOff hayLen)
622 haystack@(Text hayArr hayOff hayLen)
686 | neeLen == 0 = emptyError "replace"
623 | neeLen == 0 = emptyError "replace"
687 | L.null ixs = haystack
624 | L.null ixs = haystack
688 | len > 0 = Text (A.run x) 0 len
625 | len > 0 = Text (A.run x) 0 len
626+ | len < 0 = overflowError "replace"
689 | otherwise = empty
627 | otherwise = empty
690 where
628 where
691 ixs = indices needle haystack
629 ixs = indices needle haystack
692− len = hayLen - (neeLen - repLen) `mul` L.length ixs
630+ len = hayLen - (neeLen - repLen) * L.length ixs
693− x :: ST s (A.MArray s)
694 x = do
631 x = do
695 marr <- A.new len
632 marr <- A.new len
696 let loop (i:is) o d = do
633 let loop (i:is) o d = do
@@ -720,8 +657,9 @@ replace needle@(Text _ _ neeLen)
720-- /Note/: In some languages, case conversion is a locale- and
657-- /Note/: In some languages, case conversion is a locale- and
721-- context-dependent operation. The case conversion functions in this
658-- context-dependent operation. The case conversion functions in this
722-- module are /not/ locale sensitive. Programs that require locale
659-- module are /not/ locale sensitive. Programs that require locale
723−-- sensitivity should use appropriate versions of the
660+-- sensitivity should use appropriate versions of the case mapping
661+-- functions from the @text-icu@ package:
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+-- <http://hackage.haskell.org/package/text-icu>
725
663
726-- | /O(n)/ Convert a string to folded case. Subject to fusion.
664-- | /O(n)/ Convert a string to folded case. Subject to fusion.
727--
665--
@@ -741,7 +679,7 @@ replace needle@(Text _ _ neeLen)
741-- instead of itself.
679-- instead of itself.
742toCaseFold :: Text -> Text
680toCaseFold :: Text -> Text
743toCaseFold t = unstream (S.toCaseFold (stream t))
681toCaseFold t = unstream (S.toCaseFold (stream t))
744−{-# INLINE toCaseFold #-}
682+{-# INLINE [0] toCaseFold #-}
745
683
746-- | /O(n)/ Convert a string to lower case, using simple case
684-- | /O(n)/ Convert a string to lower case, using simple case
747-- conversion. Subject to fusion.
685-- conversion. Subject to fusion.
@@ -901,7 +839,6 @@ concat ts = case ts' of
901 where
839 where
902 ts' = L.filter (not . null) ts
840 ts' = L.filter (not . null) ts
903 len = sumP "concat" $ L.map lengthWord16 ts'
841 len = sumP "concat" $ L.map lengthWord16 ts'
904− go :: ST s (A.MArray s)
905 go = do
842 go = do
906 arr <- A.new len
843 arr <- A.new len
907 let step i (Text a o l) =
844 let step i (Text a o l) =
@@ -915,13 +852,13 @@ concatMap f = concat . foldr ((:) . f) []
915{-# INLINE concatMap #-}
852{-# INLINE concatMap #-}
916
853
917-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
854-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
918−-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
855+-- 'Text' @t@ satisifes the predicate @p@. Subject to fusion.
919any :: (Char -> Bool) -> Text -> Bool
856any :: (Char -> Bool) -> Text -> Bool
920any p t = S.any p (stream t)
857any p t = S.any p (stream t)
921{-# INLINE any #-}
858{-# INLINE any #-}
922
859
923-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
860-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
924−-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
861+-- 'Text' @t@ satisify the predicate @p@. Subject to fusion.
925all :: (Char -> Bool) -> Text -> Bool
862all :: (Char -> Bool) -> Text -> Bool
926all p t = S.all p (stream t)
863all p t = S.all p (stream t)
927{-# INLINE all #-}
864{-# INLINE all #-}
@@ -1012,10 +949,10 @@ replicate n t@(Text a o l)
1012 | n <= 0 || l <= 0 = empty
949 | n <= 0 || l <= 0 = empty
1013 | n == 1 = t
950 | n == 1 = t
1014 | isSingleton t = replicateChar n (unsafeHead t)
951 | isSingleton t = replicateChar n (unsafeHead t)
1015− | otherwise = Text (A.run x) 0 len
952+ | n <= maxBound `quot` l = Text (A.run x) 0 len
953+ | otherwise = overflowError "replicate"
1016 where
954 where
1017− len = l `mul` n
955+ len = l * n
1018− x :: ST s (A.MArray s)
1019 x = do
956 x = do
1020 arr <- A.new len
957 arr <- A.new len
1021 let loop !d !i | i >= n = return arr
958 let loop !d !i | i >= n = return arr
@@ -1066,16 +1003,14 @@ take :: Int -> Text -> Text
1066take n t@(Text arr off len)
1003take n t@(Text arr off len)
1067 | n <= 0 = empty
1004 | n <= 0 = empty
1068 | n >= len = t
1005 | n >= len = t
1069− | otherwise = text arr off (iterN n t)
1006+ | otherwise = Text arr off (loop 0 0)
1007+ where
1008+ loop !i !cnt
1009+ | i >= len || cnt >= n = i
1010+ | otherwise = loop (i+d) (cnt+1)
1011+ where d = iter_ t i
1070{-# INLINE [1] take #-}
1012{-# INLINE [1] take #-}
1071
1013
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−
1079{-# RULES
1014{-# RULES
1080"TEXT take -> fused" [~1] forall n t.
1015"TEXT take -> fused" [~1] forall n t.
1081 take n t = unstream (S.take n (stream t))
1016 take n t = unstream (S.take n (stream t))
@@ -1083,27 +1018,6 @@ iterN n t@(Text _arr _off len) = loop 0 0
1083 unstream (S.take n (stream t)) = take n t
1018 unstream (S.take n (stream t)) = take n t
1084 #-}
1019 #-}
1085
1020
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−
1107-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1021-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1108-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1022-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1109-- is greater than the length of the 'Text'. Subject to fusion.
1023-- is greater than the length of the 'Text'. Subject to fusion.
@@ -1111,8 +1025,11 @@ drop :: Int -> Text -> Text
1111drop n t@(Text arr off len)
1025drop n t@(Text arr off len)
1112 | n <= 0 = t
1026 | n <= 0 = t
1113 | n >= len = empty
1027 | n >= len = empty
1114− | otherwise = text arr (off+i) (len-i)
1028+ | otherwise = loop 0 0
1115− where i = iterN n t
1029+ where loop !i !cnt
1030+ | i >= len || cnt >= n = Text arr (off+i) (len-i)
1031+ | otherwise = loop (i+d) (cnt+1)
1032+ where d = iter_ t i
1116{-# INLINE [1] drop #-}
1033{-# INLINE [1] drop #-}
1117
1034
1118{-# RULES
1035{-# RULES
@@ -1122,18 +1039,6 @@ drop n t@(Text arr off len)
1122 unstream (S.drop n (stream t)) = drop n t
1039 unstream (S.drop n (stream t)) = drop n t
1123 #-}
1040 #-}
1124
1041
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−
1137-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1042-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1138-- returns the longest prefix (possibly empty) of elements that
1043-- returns the longest prefix (possibly empty) of elements that
1139-- satisfy @p@. Subject to fusion.
1044-- satisfy @p@. Subject to fusion.
@@ -1141,7 +1046,7 @@ takeWhile :: (Char -> Bool) -> Text -> Text
1141takeWhile p t@(Text arr off len) = loop 0
1046takeWhile p t@(Text arr off len) = loop 0
1142 where loop !i | i >= len = t
1047 where loop !i | i >= len = t
1143 | p c = loop (i+d)
1048 | p c = loop (i+d)
1144− | otherwise = text arr off i
1049+ | otherwise = textP arr off i
1145 where Iter c d = iter t i
1050 where Iter c d = iter t i
1146{-# INLINE [1] takeWhile #-}
1051{-# INLINE [1] takeWhile #-}
1147
1052
@@ -1152,27 +1057,6 @@ takeWhile p t@(Text arr off len) = loop 0
1152 unstream (S.takeWhile p (stream t)) = takeWhile p t
1057 unstream (S.takeWhile p (stream t)) = takeWhile p t
1153 #-}
1058 #-}
1154
1059
1155−-- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',
1156−-- returns the longest suffix (possibly empty) of elements that
1157−-- satisfy @p@. Subject to fusion.
1158−-- Examples:
1159−--
1160−-- > takeWhileEnd (=='o') "foo" == "oo"
1161−takeWhileEnd :: (Char -> Bool) -> Text -> Text
1162−takeWhileEnd p t@(Text arr off len) = loop (len-1) len
1163− where loop !i !l | l <= 0 = t
1164− | p c = loop (i+d) (l+d)
1165− | otherwise = text arr (off+l) (len-l)
1166− where (c,d) = reverseIter t i
1167−{-# INLINE [1] takeWhileEnd #-}
1168−
1169−{-# RULES
1170−"TEXT takeWhileEnd -> fused" [~1] forall p t.
1171− takeWhileEnd p t = S.reverse (S.takeWhile p (S.reverseStream t))
1172−"TEXT takeWhileEnd -> unfused" [1] forall p t.
1173− S.reverse (S.takeWhile p (S.reverseStream t)) = takeWhileEnd p t
1174− #-}
1175−
1176-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1060-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1177-- 'takeWhile' @p@ @t@. Subject to fusion.
1061-- 'takeWhile' @p@ @t@. Subject to fusion.
1178dropWhile :: (Char -> Bool) -> Text -> Text
1062dropWhile :: (Char -> Bool) -> Text -> Text
@@ -1191,9 +1075,8 @@ dropWhile p t@(Text arr off len) = loop 0 0
1191 #-}
1075 #-}
1192
1076
1193-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1077-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1194−-- dropping characters that satisfy the predicate @p@ from the end of
1078+-- dropping characters that fail the predicate @p@ from the end of
1195-- @t@. Subject to fusion.
1079-- @t@. Subject to fusion.
1196−--
1197-- Examples:
1080-- Examples:
1198--
1081--
1199-- > dropWhileEnd (=='.') "foo..." == "foo"
1082-- > dropWhileEnd (=='.') "foo..." == "foo"
@@ -1213,7 +1096,7 @@ dropWhileEnd p t@(Text arr off len) = loop (len-1) len
1213 #-}
1096 #-}
1214
1097
1215-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1098-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1216−-- dropping characters that satisfy the predicate @p@ from both the
1099+-- dropping characters that fail the predicate @p@ from both the
1217-- beginning and end of @t@. Subject to fusion.
1100-- beginning and end of @t@. Subject to fusion.
1218dropAround :: (Char -> Bool) -> Text -> Text
1101dropAround :: (Char -> Bool) -> Text -> Text
1219dropAround p = dropWhile p . dropWhileEnd p
1102dropAround p = dropWhile p . dropWhileEnd p
@@ -1248,8 +1131,13 @@ splitAt :: Int -> Text -> (Text, Text)
1248splitAt n t@(Text arr off len)
1131splitAt n t@(Text arr off len)
1249 | n <= 0 = (empty, t)
1132 | n <= 0 = (empty, t)
1250 | n >= len = (t, empty)
1133 | n >= len = (t, empty)
1251− | otherwise = let k = iterN n t
1134+ | otherwise = (Text arr off k, Text arr (off+k) (len-k))
1252− in (text arr off k, text arr (off+k) (len-k))
1135+ where k = loop 0 0
1136+ loop !i !cnt
1137+ | i >= len || cnt >= n = i
1138+ | otherwise = loop (i+d) (cnt+1)
1139+ where d = iter_ t i
1140+{-# INLINE splitAt #-}
1253
1141
1254-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
1142-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
1255-- a pair whose first element is the longest prefix (possibly empty)
1143-- a pair whose first element is the longest prefix (possibly empty)
@@ -1308,9 +1196,9 @@ tails t | null t = [empty]
1308-- copies to create substrings; they just construct new 'Text's that
1196-- copies to create substrings; they just construct new 'Text's that
1309-- are slices of the original.
1197-- are slices of the original.
1310
1198
1311−-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'
1199+-- | /O(m+n)/ Break a 'Text' into pieces separated by the first
1312−-- argument (which cannot be empty), consuming the delimiter. An empty
1200+-- 'Text' argument, consuming the delimiter. An empty delimiter is
1313−-- delimiter is invalid, and will cause an error to be raised.
1201+-- invalid, and will cause an error to be raised.
1314--
1202--
1315-- Examples:
1203-- Examples:
1316--
1204--
@@ -1323,23 +1211,16 @@ tails t | null t = [empty]
1323-- > intercalate s . splitOn s == id
1211-- > intercalate s . splitOn s == id
1324-- > splitOn (singleton c) == split (==c)
1212-- > splitOn (singleton c) == split (==c)
1325--
1213--
1326−-- (Note: the string @s@ to split on above cannot be empty.)
1327−--
1328-- In (unlikely) bad cases, this function's time complexity degrades
1214-- In (unlikely) bad cases, this function's time complexity degrades
1329-- towards /O(n*m)/.
1215-- towards /O(n*m)/.
1330−splitOn :: Text
1216+splitOn :: Text -> Text -> [Text]
1331− -- ^ String to split on. If this string is empty, an error
1332− -- will occur.
1333− -> Text
1334− -- ^ Input text.
1335− -> [Text]
1336splitOn pat@(Text _ _ l) src@(Text arr off len)
1217splitOn pat@(Text _ _ l) src@(Text arr off len)
1337 | l <= 0 = emptyError "splitOn"
1218 | l <= 0 = emptyError "splitOn"
1338 | isSingleton pat = split (== unsafeHead pat) src
1219 | isSingleton pat = split (== unsafeHead pat) src
1339 | otherwise = go 0 (indices pat src)
1220 | otherwise = go 0 (indices pat src)
1340 where
1221 where
1341− go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs
1222+ go !s (x:xs) = textP arr (s+off) (x-s) : go (x+l) xs
1342− go s _ = [text arr (s+off) (len-s)]
1223+ go s _ = [textP arr (s+off) (len-s)]
1343{-# INLINE [1] splitOn #-}
1224{-# INLINE [1] splitOn #-}
1344
1225
1345{-# RULES
1226{-# RULES
@@ -1431,7 +1312,7 @@ breakOn pat src@(Text arr off len)
1431 | null pat = emptyError "breakOn"
1312 | null pat = emptyError "breakOn"
1432 | otherwise = case indices pat src of
1313 | otherwise = case indices pat src of
1433 [] -> (src, empty)
1314 [] -> (src, empty)
1434− (x:_) -> (text arr off x, text arr (off+x) (len-x))
1315+ (x:_) -> (textP arr off x, textP arr (off+x) (len-x))
1435{-# INLINE breakOn #-}
1316{-# INLINE breakOn #-}
1436
1317
1437-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
1318-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
@@ -1473,7 +1354,7 @@ breakOnAll pat src@(Text arr off slen)
1473 | otherwise = L.map step (indices pat src)
1354 | otherwise = L.map step (indices pat src)
1474 where
1355 where
1475 step x = (chunk 0 x, chunk x (slen-x))
1356 step x = (chunk 0 x, chunk x (slen-x))
1476− chunk !n !l = text arr (n+off) l
1357+ chunk !n !l = textP arr (n+off) l
1477{-# INLINE breakOnAll #-}
1358{-# INLINE breakOnAll #-}
1478
1359
1479-------------------------------------------------------------------------------
1360-------------------------------------------------------------------------------
@@ -1540,7 +1421,7 @@ countChar c t = S.countChar c (stream t)
1540-- equivalent to a pair of 'unpack' operations.
1421-- equivalent to a pair of 'unpack' operations.
1541zip :: Text -> Text -> [(Char,Char)]
1422zip :: Text -> Text -> [(Char,Char)]
1542zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1423zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1543−{-# INLINE zip #-}
1424+{-# INLINE [0] zip #-}
1544
1425
1545-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1426-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1546-- given as the first argument, instead of a tupling function.
1427-- given as the first argument, instead of a tupling function.
@@ -1548,7 +1429,7 @@ zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1548zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1429zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1549zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1430zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1550 where g a b = safe (f a b)
1431 where g a b = safe (f a b)
1551−{-# INLINE zipWith #-}
1432+{-# INLINE [0] zipWith #-}
1552
1433
1553-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1434-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1554-- representing white space.
1435-- representing white space.
@@ -1673,7 +1554,7 @@ isInfixOf needle haystack
1673-- > fnordLength _ = -1
1554-- > fnordLength _ = -1
1674stripPrefix :: Text -> Text -> Maybe Text
1555stripPrefix :: Text -> Text -> Maybe Text
1675stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1556stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1676− | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)
1557+ | p `isPrefixOf` t = Just $! textP arr (off+plen) (len-plen)
1677 | otherwise = Nothing
1558 | otherwise = Nothing
1678
1559
1679-- | /O(n)/ Find the longest non-empty common prefix of two strings
1560-- | /O(n)/ Find the longest non-empty common prefix of two strings
@@ -1693,8 +1574,8 @@ commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1693 where
1574 where
1694 go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1575 go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1695 | i > 0 = Just (Text arr0 off0 i,
1576 | i > 0 = Just (Text arr0 off0 i,
1696− text arr0 (off0+i) (len0-i),
1577+ textP arr0 (off0+i) (len0-i),
1697− text arr1 (off1+j) (len1-j))
1578+ textP arr1 (off1+j) (len1-j))
1698 | otherwise = Nothing
1579 | otherwise = Nothing
1699 where Iter a d0 = iter t0 i
1580 where Iter a d0 = iter t0 i
1700 Iter b d1 = iter t1 j
1581 Iter b d1 = iter t1 j
@@ -1719,7 +1600,7 @@ commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1719-- > quuxLength _ = -1
1600-- > quuxLength _ = -1
1720stripSuffix :: Text -> Text -> Maybe Text
1601stripSuffix :: Text -> Text -> Maybe Text
1721stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
1602stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
1722− | p `isSuffixOf` t = Just $! text arr off (len-plen)
1603+ | p `isSuffixOf` t = Just $! textP arr off (len-plen)
1723 | otherwise = Nothing
1604 | otherwise = Nothing
1724
1605
1725-- | Add a list of non-negative numbers. Errors out on overflow.
1606-- | Add a list of non-negative numbers. Errors out on overflow.
@@ -1748,7 +1629,6 @@ overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
1748copy :: Text -> Text
1629copy :: Text -> Text
1749copy (Text arr off len) = Text (A.run go) 0 len
1630copy (Text arr off len) = Text (A.run go) 0 len
1750 where
1631 where
1751− go :: ST s (A.MArray s)
1752 go = do
1632 go = do
1753 marr <- A.new len
1633 marr <- A.new len
1754 A.copyI marr 0 arr off len
1634 A.copyI marr 0 arr off len
Data/Text/Array.hs+8−8
@@ -6,7 +6,8 @@
6-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
6-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
7--
7--
8-- License : BSD-style
8-- License : BSD-style
9−-- Maintainer : bos@serpentine.com
9+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
10+-- duncan@haskell.org
10-- Stability : experimental
11-- Stability : experimental
11-- Portability : portable
12-- Portability : portable
12--
13--
@@ -20,13 +21,13 @@
20-- > import qualified Data.Text.Array as A
21-- > import qualified Data.Text.Array as A
21--
22--
22-- The names in this module resemble those in the 'Data.Array' family
23-- The names in this module resemble those in the 'Data.Array' family
23−-- of modules, but are shorter due to the assumption of qualified
24+-- of modules, but are shorter due to the assumption of qualifid
24-- naming.
25-- naming.
25module Data.Text.Array
26module Data.Text.Array
26 (
27 (
27 -- * Types
28 -- * Types
28− Array(Array, aBA)
29+ Array(aBA)
29− , MArray(MArray, maBA)
30+ , MArray(maBA)
30
31
31 -- * Functions
32 -- * Functions
32 , copyM
33 , copyM
@@ -74,7 +75,7 @@ import Foreign.C.Types (CInt, CSize)
74#endif
75#endif
75import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
76import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
76 indexWord16Array#, newByteArray#,
77 indexWord16Array#, newByteArray#,
77− unsafeFreezeByteArray#, writeWord16Array#)
78+ unsafeCoerce#, writeWord16Array#)
78import GHC.ST (ST(..), runST)
79import GHC.ST (ST(..), runST)
79import GHC.Word (Word16(..))
80import GHC.Word (Word16(..))
80import Prelude hiding (length, read)
81import Prelude hiding (length, read)
@@ -130,9 +131,8 @@ array_size_error = error "Data.Text.Array.new: size overflow"
130
131
131-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
132-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
132unsafeFreeze :: MArray s -> ST s Array
133unsafeFreeze :: MArray s -> ST s Array
133−unsafeFreeze MArray{..} = ST $ \s1# ->
134+unsafeFreeze MArray{..} = ST $ \s# ->
134− case unsafeFreezeByteArray# maBA s1# of
135+ (# s#, Array (unsafeCoerce# maBA)
135− (# s2#, ba# #) -> (# s2#, Array ba#
136#if defined(ASSERTS)
136#if defined(ASSERTS)
137 maLen
137 maLen
138#endif
138#endif
Data/Text/Encoding.hs+84−128
@@ -10,7 +10,8 @@
10-- (c) 2008, 2009 Tom Harper
10-- (c) 2008, 2009 Tom Harper
11--
11--
12-- License : BSD-style
12-- License : BSD-style
13−-- Maintainer : bos@serpentine.com
13+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
14+-- duncan@haskell.org
14-- Stability : experimental
15-- Stability : experimental
15-- Portability : portable
16-- Portability : portable
16--
17--
@@ -54,45 +55,36 @@ module Data.Text.Encoding
54 , encodeUtf16BE
55 , encodeUtf16BE
55 , encodeUtf32LE
56 , encodeUtf32LE
56 , encodeUtf32BE
57 , encodeUtf32BE
57−
58− -- * Encoding Text using ByteString Builders
59− , encodeUtf8Builder
60− , encodeUtf8BuilderEscaped
61 ) where
58 ) where
62
59
60+import Control.Exception (evaluate, try)
63#if __GLASGOW_HASKELL__ >= 702
61#if __GLASGOW_HASKELL__ >= 702
64import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
62import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
65#else
63#else
66import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)
64import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)
67#endif
65#endif
68−
69−import Control.Exception (evaluate, try)
70import Control.Monad.ST (runST)
66import Control.Monad.ST (runST)
71import Data.Bits ((.&.))
67import Data.Bits ((.&.))
72import Data.ByteString as B
68import Data.ByteString as B
73−import Data.ByteString.Internal as B hiding (c2w)
69+import Data.ByteString.Internal as B
70+import Data.Text ()
74import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
71import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
75−import Data.Text.Internal (Text(..), safe, text)
72+import Data.Text.Internal (Text(..), safe, textP)
76import Data.Text.Internal.Private (runText)
73import Data.Text.Internal.Private (runText)
77import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
74import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
78−import Data.Text.Internal.Unsafe.Shift (shiftR)
75+import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
79−import Data.Text.Show ()
80−import Data.Text.Unsafe (unsafeDupablePerformIO)
81import Data.Word (Word8, Word32)
76import Data.Word (Word8, Word32)
82−import Foreign.C.Types (CSize(..))
77+import Foreign.C.Types (CSize)
83import Foreign.ForeignPtr (withForeignPtr)
78import Foreign.ForeignPtr (withForeignPtr)
84import Foreign.Marshal.Utils (with)
79import Foreign.Marshal.Utils (with)
85import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
80import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
86import Foreign.Storable (Storable, peek, poke)
81import Foreign.Storable (Storable, peek, poke)
87−import GHC.Base (ByteArray#, MutableByteArray#)
82+import GHC.Base (MutableByteArray#)
88−import qualified Data.ByteString.Builder as B
89−import qualified Data.ByteString.Builder.Internal as B hiding (empty, append)
90−import qualified Data.ByteString.Builder.Prim as BP
91−import qualified Data.ByteString.Builder.Prim.Internal as BP
92import qualified Data.Text.Array as A
83import qualified Data.Text.Array as A
93import qualified Data.Text.Internal.Encoding.Fusion as E
84import qualified Data.Text.Internal.Encoding.Fusion as E
94import qualified Data.Text.Internal.Encoding.Utf16 as U16
85import qualified Data.Text.Internal.Encoding.Utf16 as U16
95import qualified Data.Text.Internal.Fusion as F
86import qualified Data.Text.Internal.Fusion as F
87+import Data.Text.Unsafe (unsafeDupablePerformIO)
96
88
97#include "text_cbits.h"
89#include "text_cbits.h"
98
90
@@ -111,6 +103,8 @@ import qualified Data.Text.Internal.Fusion as F
111
103
112-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
104-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
113-- encoded text.
105-- encoded text.
106+--
107+-- This function is deprecated. Use 'decodeLatin1' instead.
114decodeASCII :: ByteString -> Text
108decodeASCII :: ByteString -> Text
115decodeASCII = decodeUtf8
109decodeASCII = decodeUtf8
116{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
110{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
@@ -120,7 +114,7 @@ decodeASCII = decodeUtf8
120-- 'decodeLatin1' is semantically equivalent to
114-- 'decodeLatin1' is semantically equivalent to
121-- @Data.Text.pack . Data.ByteString.Char8.unpack@
115-- @Data.Text.pack . Data.ByteString.Char8.unpack@
122decodeLatin1 :: ByteString -> Text
116decodeLatin1 :: ByteString -> Text
123−decodeLatin1 (PS fp off len) = text a 0 len
117+decodeLatin1 (PS fp off len) = textP a 0 len
124 where
118 where
125 a = A.run (A.new len >>= unsafeIOToST . go)
119 a = A.run (A.new len >>= unsafeIOToST . go)
126 go dest = withForeignPtr fp $ \ptr -> do
120 go dest = withForeignPtr fp $ \ptr -> do
@@ -161,15 +155,11 @@ decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
161-- a 'ByteString' that represents a possibly incomplete input (e.g. a
155-- a 'ByteString' that represents a possibly incomplete input (e.g. a
162-- packet from a network stream) that may not end on a UTF-8 boundary.
156-- packet from a network stream) that may not end on a UTF-8 boundary.
163--
157--
164−-- 1. The maximal prefix of 'Text' that could be decoded from the
158+-- The first element of the result is the maximal chunk of 'Text' that
165−-- given input.
159+-- can be decoded from the given input. The second is a function which
166−--
167−-- 2. The suffix of the 'ByteString' that could not be decoded due to
168−-- insufficient input.
169−--
170−-- 3. A function that accepts another 'ByteString'. That string will
160+-- accepts another 'ByteString'. That string will be assumed to
171−-- be assumed to directly follow the string that was passed as
161+-- directly follow the string that was passed as input to the original
172−-- input to the original function, and it will in turn be decoded.
162+-- function, and it will in turn be decoded.
173--
163--
174-- To help understand the use of these functions, consider the Unicode
164-- To help understand the use of these functions, consider the Unicode
175-- string @\"hi &#9731;\"@. If encoded as UTF-8, this becomes @\"hi
165-- string @\"hi &#9731;\"@. If encoded as UTF-8, this becomes @\"hi
@@ -182,17 +172,15 @@ decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
182-- as we receive each one.
172-- as we receive each one.
183--
173--
184-- @
174-- @
185−-- ghci> let s0\@('Some' _ _ f0) = 'streamDecodeUtf8' \"hi \\xe2\"
175+-- let 'Some' t0 f0 = 'streamDecodeUtf8' \"hi \\xe2\"
186−-- ghci> s0
176+-- t0 == \"hi \" :: 'Text'
187−-- 'Some' \"hi \" \"\\xe2\" _
188-- @
177-- @
189--
178--
190-- We use the continuation @f0@ to decode our second packet.
179-- We use the continuation @f0@ to decode our second packet.
191--
180--
192-- @
181-- @
193−-- ghci> let s1\@('Some' _ _ f1) = f0 \"\\x98\"
182+-- let 'Some' t1 f1 = f0 \"\\x98\"
194−-- ghci> s1
183+-- t1 == \"\"
195−-- 'Some' \"\" \"\\xe2\\x98\"
196-- @
184-- @
197--
185--
198-- We could not give @f0@ enough input to decode anything, so it
186-- We could not give @f0@ enough input to decode anything, so it
@@ -200,9 +188,8 @@ decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
200-- the last byte of input, it will make progress.
188-- the last byte of input, it will make progress.
201--
189--
202-- @
190-- @
203−-- ghci> let s2\@('Some' _ _ f2) = f1 \"\\x83\"
191+-- let 'Some' t2 f2 = f1 \"\\x83\"
204−-- ghci> s2
192+-- t2 == \"&#9731;\"
205−-- 'Some' \"\\x2603\" \"\" _
206-- @
193-- @
207--
194--
208-- If given invalid input, an exception will be thrown by the function
195-- If given invalid input, an exception will be thrown by the function
@@ -234,13 +221,12 @@ streamDecodeUtf8 = streamDecodeUtf8With strictDecode
234-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
221-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
235-- encoded text.
222-- encoded text.
236streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
223streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
237−streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
224+streamDecodeUtf8With onErr = decodeChunk 0 0
238 where
225 where
239 -- We create a slightly larger than necessary buffer to accommodate a
226 -- We create a slightly larger than necessary buffer to accommodate a
240 -- potential surrogate pair started in the last buffer
227 -- potential surrogate pair started in the last buffer
241− decodeChunk :: ByteString -> CodePoint -> DecoderState -> ByteString
228+ decodeChunk :: CodePoint -> DecoderState -> ByteString -> Decoding
242− -> Decoding
243− decodeChunk undecoded0 codepoint0 state0 bs@(PS fp off len) =
229+ decodeChunk codepoint0 state0 bs@(PS fp off len) =
244 runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)
230 runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)
245 where
231 where
246 decodeChunkToBuffer :: A.MArray s -> IO Decoding
232 decodeChunkToBuffer :: A.MArray s -> IO Decoding
@@ -259,7 +245,6 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
259 UTF8_REJECT -> do
245 UTF8_REJECT -> do
260 -- We encountered an encoding error
246 -- We encountered an encoding error
261 x <- peek curPtr'
247 x <- peek curPtr'
262− poke statePtr 0
263 case onErr desc (Just x) of
248 case onErr desc (Just x) of
264 Nothing -> loop $ curPtr' `plusPtr` 1
249 Nothing -> loop $ curPtr' `plusPtr` 1
265 Just c -> do
250 Just c -> do
@@ -267,6 +252,7 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
267 w <- unsafeSTToIO $
252 w <- unsafeSTToIO $
268 unsafeWrite dest (fromIntegral destOff) (safe c)
253 unsafeWrite dest (fromIntegral destOff) (safe c)
269 poke destOffPtr (destOff + fromIntegral w)
254 poke destOffPtr (destOff + fromIntegral w)
255+ poke statePtr 0
270 loop $ curPtr' `plusPtr` 1
256 loop $ curPtr' `plusPtr` 1
271
257
272 _ -> do
258 _ -> do
@@ -275,14 +261,11 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
275 codepoint <- peek codepointPtr
261 codepoint <- peek codepointPtr
276 chunkText <- unsafeSTToIO $ do
262 chunkText <- unsafeSTToIO $ do
277 arr <- A.unsafeFreeze dest
263 arr <- A.unsafeFreeze dest
278− return $! text arr 0 (fromIntegral n)
264+ return $! textP arr 0 (fromIntegral n)
279 lastPtr <- peek curPtrPtr
265 lastPtr <- peek curPtrPtr
280 let left = lastPtr `minusPtr` curPtr
266 let left = lastPtr `minusPtr` curPtr
281− !undecoded = case state of
282− UTF8_ACCEPT -> B.empty
283− _ -> B.append undecoded0 (B.drop left bs)
284− return $ Some chunkText undecoded
267+ return $ Some chunkText (B.drop left bs)
285− (decodeChunk undecoded codepoint state)
268+ (decodeChunk codepoint state)
286 in loop (ptr `plusPtr` off)
269 in loop (ptr `plusPtr` off)
287 desc = "Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"
270 desc = "Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"
288
271
@@ -307,85 +290,61 @@ decodeUtf8' :: ByteString -> Either UnicodeException Text
307decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode
290decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode
308{-# INLINE decodeUtf8' #-}
291{-# INLINE decodeUtf8' #-}
309
292
310−-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
311−encodeUtf8Builder :: Text -> B.Builder
312−encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
313−
314−-- | Encode text using UTF-8 encoding and escape the ASCII characters using
315−-- a 'BP.BoundedPrim'.
316−--
317−-- Use this function is to implement efficient encoders for text-based formats
318−-- like JSON or HTML.
319−{-# INLINE encodeUtf8BuilderEscaped #-}
320−-- TODO: Extend documentation with references to source code in @blaze-html@
321−-- or @aeson@ that uses this function.
322−encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
323−encodeUtf8BuilderEscaped be =
324− -- manual eta-expansion to ensure inlining works as expected
325− \txt -> B.builder (mkBuildstep txt)
326− where
327− bound = max 4 $ BP.sizeBound be
328−
329− mkBuildstep (Text arr off len) !k =
330− outerLoop off
331− where
332− iend = off + len
333−
334− outerLoop !i0 !br@(B.BufferRange op0 ope)
335− | i0 >= iend = k br
336− | outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining)
337− -- TODO: Use a loop with an integrated bound's check if outRemaining
338− -- is smaller than 8, as this will save on divisions.
339− | otherwise = return $ B.bufferFull bound op0 (outerLoop i0)
340− where
341− outRemaining = (ope `minusPtr` op0) `div` bound
342− inpRemaining = iend - i0
343−
344− goPartial !iendTmp = go i0 op0
345− where
346− go !i !op
347− | i < iendTmp = case A.unsafeIndex arr i of
348− w | w <= 0x7F -> do
349− BP.runB be (fromIntegral w) op >>= go (i + 1)
350− | w <= 0x7FF -> do
351− poke8 0 $ (w `shiftR` 6) + 0xC0
352− poke8 1 $ (w .&. 0x3f) + 0x80
353− go (i + 1) (op `plusPtr` 2)
354− | 0xD800 <= w && w <= 0xDBFF -> do
355− let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))
356− poke8 0 $ (c `shiftR` 18) + 0xF0
357− poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80
358− poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80
359− poke8 3 $ (c .&. 0x3F) + 0x80
360− go (i + 2) (op `plusPtr` 4)
361− | otherwise -> do
362− poke8 0 $ (w `shiftR` 12) + 0xE0
363− poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80
364− poke8 2 $ (w .&. 0x3F) + 0x80
365− go (i + 1) (op `plusPtr` 3)
366− | otherwise =
367− outerLoop i (B.BufferRange op ope)
368− where
369− poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)
370−
371-- | Encode text using UTF-8 encoding.
293-- | Encode text using UTF-8 encoding.
372encodeUtf8 :: Text -> ByteString
294encodeUtf8 :: Text -> ByteString
373−encodeUtf8 (Text arr off len)
295+encodeUtf8 (Text arr off len) = unsafeDupablePerformIO $ do
374− | len == 0 = B.empty
296+ let size0 = max len 4
375− | otherwise = unsafeDupablePerformIO $ do
297+ mallocByteString size0 >>= start size0 off 0
376− fp <- mallocByteString (len*4)
298+ where
377− withForeignPtr fp $ \ptr ->
299+ start size n0 m0 fp = withForeignPtr fp $ loop n0 m0
378− with ptr $ \destPtr -> do
300+ where
379− c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
301+ loop n1 m1 ptr = go n1 m1
380− newDest <- peek destPtr
302+ where
303+ offLen = off + len
304+ go !n !m
305+ | n == offLen = return (PS fp 0 m)
306+ | otherwise = do
307+ let poke8 k v = poke (ptr `plusPtr` k) (fromIntegral v :: Word8)
308+ ensure k act
309+ | size-m >= k = act
310+ | otherwise = {-# SCC "resizeUtf8/ensure" #-} do
311+ let newSize = size `shiftL` 1
312+ fp' <- mallocByteString newSize
313+ withForeignPtr fp' $ \ptr' ->
314+ memcpy ptr' ptr (fromIntegral m)
315+ start newSize n m fp'
316+ {-# INLINE ensure #-}
317+ case A.unsafeIndex arr n of
318+ w| w <= 0x7F -> ensure 1 $ do
319+ poke (ptr `plusPtr` m) (fromIntegral w :: Word8)
320+ -- A single ASCII octet is likely to start a run of
321+ -- them. We see better performance when we
322+ -- special-case this assumption.
323+ let end = ptr `plusPtr` size
324+ ascii !t !u
325+ | t == offLen || u == end || v >= 0x80 =
381− let utf8len = newDest `minusPtr` ptr
326+ go t (u `minusPtr` ptr)
382− if utf8len >= len `shiftR` 1
327+ | otherwise = do
383− then return (PS fp 0 utf8len)
328+ poke u (fromIntegral v :: Word8)
384− else do
329+ ascii (t+1) (u `plusPtr` 1)
385− fp' <- mallocByteString utf8len
330+ where v = A.unsafeIndex arr t
386− withForeignPtr fp' $ \ptr' -> do
331+ ascii (n+1) (ptr `plusPtr` (m+1))
387− memcpy ptr' ptr (fromIntegral utf8len)
332+ | w <= 0x7FF -> ensure 2 $ do
388− return (PS fp' 0 utf8len)
333+ poke8 m $ (w `shiftR` 6) + 0xC0
334+ poke8 (m+1) $ (w .&. 0x3f) + 0x80
335+ go (n+1) (m+2)
336+ | 0xD800 <= w && w <= 0xDBFF -> ensure 4 $ do
337+ let c = ord $ U16.chr2 w (A.unsafeIndex arr (n+1))
338+ poke8 m $ (c `shiftR` 18) + 0xF0
339+ poke8 (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80
340+ poke8 (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80
341+ poke8 (m+3) $ (c .&. 0x3F) + 0x80
342+ go (n+2) (m+4)
343+ | otherwise -> ensure 3 $ do
344+ poke8 m $ (w `shiftR` 12) + 0xE0
345+ poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
346+ poke8 (m+2) $ (w .&. 0x3F) + 0x80
347+ go (n+1) (m+3)
389
348
390-- | Decode text from little endian UTF-16 encoding.
349-- | Decode text from little endian UTF-16 encoding.
391decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
350decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
@@ -474,6 +433,3 @@ foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_stat
474
433
475foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
434foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
476 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
435 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
477−
478−foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
479− :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()
Data/Text/Encoding/Error.hs+3−8
@@ -1,7 +1,5 @@
1{-# LANGUAGE CPP, DeriveDataTypeable #-}
1{-# LANGUAGE CPP, DeriveDataTypeable #-}
2−#if __GLASGOW_HASKELL__ >= 704
2+#if __GLASGOW_HASKELL__ >= 702
3−{-# LANGUAGE Safe #-}
4−#elif __GLASGOW_HASKELL__ >= 702
5{-# LANGUAGE Trustworthy #-}
3{-# LANGUAGE Trustworthy #-}
6#endif
4#endif
7-- |
5-- |
@@ -9,7 +7,8 @@
9-- Copyright : (c) Bryan O'Sullivan 2009
7-- Copyright : (c) Bryan O'Sullivan 2009
10--
8--
11-- License : BSD-style
9-- License : BSD-style
12−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
13-- Stability : experimental
12-- Stability : experimental
14-- Portability : GHC
13-- Portability : GHC
15--
14--
@@ -68,7 +67,6 @@ type OnError a b = String -> Maybe a -> Maybe b
68type OnDecodeError = OnError Word8 Char
67type OnDecodeError = OnError Word8 Char
69
68
70-- | A handler for an encoding error.
69-- | A handler for an encoding error.
71−{-# DEPRECATED OnEncodeError "This exception is never used in practice, and will be removed." #-}
72type OnEncodeError = OnError Char Word8
70type OnEncodeError = OnError Char Word8
73
71
74-- | An exception type for representing Unicode encoding errors.
72-- | An exception type for representing Unicode encoding errors.
@@ -81,8 +79,6 @@ data UnicodeException =
81 -- under the given encoding, or ran out of input in mid-encode.
79 -- under the given encoding, or ran out of input in mid-encode.
82 deriving (Eq, Typeable)
80 deriving (Eq, Typeable)
83
81
84−{-# DEPRECATED EncodeError "This constructor is never used, and will be removed." #-}
85−
86showUnicodeException :: UnicodeException -> String
82showUnicodeException :: UnicodeException -> String
87showUnicodeException (DecodeError desc (Just w))
83showUnicodeException (DecodeError desc (Just w))
88 = "Cannot decode byte '\\x" ++ showHex w ("': " ++ desc)
84 = "Cannot decode byte '\\x" ++ showHex w ("': " ++ desc)
@@ -112,7 +108,6 @@ lenientDecode :: OnDecodeError
112lenientDecode _ _ = Just '\xfffd'
108lenientDecode _ _ = Just '\xfffd'
113
109
114-- | Throw a 'UnicodeException' if encoding fails.
110-- | Throw a 'UnicodeException' if encoding fails.
115−{-# DEPRECATED strictEncode "This function always throws an exception, and will be removed." #-}
116strictEncode :: OnEncodeError
111strictEncode :: OnEncodeError
117strictEncode desc c = throw (EncodeError desc c)
112strictEncode desc c = throw (EncodeError desc c)
118
113
Data/Text/Foreign.hs+2−1
@@ -4,7 +4,8 @@
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
5--
5--
6-- License : BSD-style
6-- License : BSD-style
7−-- Maintainer : bos@serpentine.com
7+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
8+-- duncan@haskell.org
8-- Stability : experimental
9-- Stability : experimental
9-- Portability : GHC
10-- Portability : GHC
10--
11--
Data/Text/Internal.hs+12−76
@@ -1,5 +1,4 @@
1−{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples #-}
1+{-# LANGUAGE CPP, DeriveDataTypeable #-}
2−{-# OPTIONS_HADDOCK not-home #-}
3
2
4-- |
3-- |
5-- Module : Data.Text.Internal
4-- Module : Data.Text.Internal
@@ -8,7 +7,8 @@
8-- (c) 2009 Duncan Coutts
7-- (c) 2009 Duncan Coutts
9--
8--
10-- License : BSD-style
9-- License : BSD-style
11−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
12-- Stability : experimental
12-- Stability : experimental
13-- Portability : GHC
13-- Portability : GHC
14--
14--
@@ -20,10 +20,6 @@
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−
27module Data.Text.Internal
23module Data.Text.Internal
28 (
24 (
29 -- * Types
25 -- * Types
@@ -36,13 +32,8 @@ module Data.Text.Internal
36 , safe
32 , safe
37 -- * Code that must be here for accessibility
33 -- * Code that must be here for accessibility
38 , empty
34 , empty
39− , empty_
40 -- * Utilities
35 -- * Utilities
41 , firstf
36 , firstf
42− -- * Checked multiplication
43− , mul
44− , mul32
45− , mul64
46 -- * Debugging
37 -- * Debugging
47 , showText
38 , showText
48 ) where
39 ) where
@@ -50,11 +41,10 @@ module Data.Text.Internal
50#if defined(ASSERTS)
41#if defined(ASSERTS)
51import Control.Exception (assert)
42import Control.Exception (assert)
52#endif
43#endif
53−import Data.Bits
44+import Data.Bits ((.&.))
54−import Data.Int (Int32, Int64)
45+import qualified Data.Text.Array as A
55import Data.Text.Internal.Unsafe.Char (ord)
46import Data.Text.Internal.Unsafe.Char (ord)
56import Data.Typeable (Typeable)
47import Data.Typeable (Typeable)
57−import qualified Data.Text.Array as A
58
48
59-- | A space efficient, packed, unboxed Unicode text type.
49-- | A space efficient, packed, unboxed Unicode text type.
60data Text = Text
50data Text = Text
@@ -64,8 +54,8 @@ data Text = Text
64 deriving (Typeable)
54 deriving (Typeable)
65
55
66-- | Smart constructor.
56-- | Smart constructor.
67−text_ :: A.Array -> Int -> Int -> Text
57+text :: A.Array -> Int -> Int -> Text
68−text_ arr off len =
58+text arr off len =
69#if defined(ASSERTS)
59#if defined(ASSERTS)
70 let c = A.unsafeIndex arr off
60 let c = A.unsafeIndex arr off
71 alen = A.length arr
61 alen = A.length arr
@@ -75,28 +65,19 @@ text_ arr off len =
75 assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $
65 assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $
76#endif
66#endif
77 Text arr off len
67 Text arr off len
78−{-# INLINE text_ #-}
68+{-# INLINE text #-}
79
69
80-- | /O(1)/ The empty 'Text'.
70-- | /O(1)/ The empty 'Text'.
81empty :: Text
71empty :: Text
82empty = Text A.empty 0 0
72empty = Text A.empty 0 0
83{-# INLINE [1] empty #-}
73{-# INLINE [1] empty #-}
84
74
85−-- | A non-inlined version of 'empty'.
86−empty_ :: Text
87−empty_ = Text A.empty 0 0
88−{-# NOINLINE empty_ #-}
89−
90-- | Construct a 'Text' without invisibly pinning its byte array in
75-- | Construct a 'Text' without invisibly pinning its byte array in
91-- memory if its length has dwindled to zero.
76-- memory if its length has dwindled to zero.
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−
97textP :: A.Array -> Int -> Int -> Text
77textP :: A.Array -> Int -> Int -> Text
98−{-# DEPRECATED textP "Use text instead" #-}
78+textP arr off len | len == 0 = empty
99−textP = text
79+ | otherwise = text arr off len
80+{-# INLINE textP #-}
100
81
101-- | A useful 'show'-like function for debugging purposes.
82-- | A useful 'show'-like function for debugging purposes.
102showText :: Text -> String
83showText :: Text -> String
@@ -116,58 +97,13 @@ safe :: Char -> Char
116safe c
97safe c
117 | ord c .&. 0x1ff800 /= 0xd800 = c
98 | ord c .&. 0x1ff800 /= 0xd800 = c
118 | otherwise = '\xfffd'
99 | otherwise = '\xfffd'
119−{-# INLINE [0] safe #-}
100+{-# INLINE safe #-}
120
101
121-- | Apply a function to the first element of an optional pair.
102-- | Apply a function to the first element of an optional pair.
122firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)
103firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)
123firstf f (Just (a, b)) = Just (f a, b)
104firstf f (Just (a, b)) = Just (f a, b)
124firstf _ Nothing = Nothing
105firstf _ Nothing = Nothing
125
106
126−-- | Checked multiplication. Calls 'error' if the result would
127−-- overflow.
128−mul :: Int -> Int -> Int
129−#if WORD_SIZE_IN_BITS == 64
130−mul a b = fromIntegral $ fromIntegral a `mul64` fromIntegral b
131−#else
132−mul a b = fromIntegral $ fromIntegral a `mul32` fromIntegral b
133−#endif
134−{-# INLINE mul #-}
135−infixl 7 `mul`
136−
137−-- | Checked multiplication. Calls 'error' if the result would
138−-- overflow.
139−mul64 :: Int64 -> Int64 -> Int64
140−mul64 a b
141− | a >= 0 && b >= 0 = mul64_ a b
142− | a >= 0 = -mul64_ a (-b)
143− | b >= 0 = -mul64_ (-a) b
144− | otherwise = mul64_ (-a) (-b)
145−{-# INLINE mul64 #-}
146−infixl 7 `mul64`
147−
148−mul64_ :: Int64 -> Int64 -> Int64
149−mul64_ a b
150− | ahi > 0 && bhi > 0 = error "overflow"
151− | top > 0x7fffffff = error "overflow"
152− | total < 0 = error "overflow"
153− | otherwise = total
154− where (# ahi, alo #) = (# a `shiftR` 32, a .&. 0xffffffff #)
155− (# bhi, blo #) = (# b `shiftR` 32, b .&. 0xffffffff #)
156− top = ahi * blo + alo * bhi
157− total = (top `shiftL` 32) + alo * blo
158−{-# INLINE mul64_ #-}
159−
160−-- | Checked multiplication. Calls 'error' if the result would
161−-- overflow.
162−mul32 :: Int32 -> Int32 -> Int32
163−mul32 a b = case fromIntegral a * fromIntegral b of
164− ab | ab < min32 || ab > max32 -> error "overflow"
165− | otherwise -> fromIntegral ab
166− where min32 = -0x80000000 :: Int64
167− max32 = 0x7fffffff
168−{-# INLINE mul32 #-}
169−infixl 7 `mul32`
170−
171-- $internals
107-- $internals
172--
108--
173-- Internally, the 'Text' type is represented as an array of 'Word16'
109-- Internally, the 'Text' type is represented as an array of 'Word16'
Data/Text/Internal/Builder.hs+16−20
@@ -1,12 +1,11 @@
1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
2−{-# OPTIONS_HADDOCK not-home #-}
3
2
4-----------------------------------------------------------------------------
3-----------------------------------------------------------------------------
5-- |
4-- |
6-- Module : Data.Text.Internal.Builder
5-- Module : Data.Text.Internal.Builder
7-- Copyright : (c) 2013 Bryan O'Sullivan
6-- Copyright : (c) 2013 Bryan O'Sullivan
8-- (c) 2010 Johan Tibell
7-- (c) 2010 Johan Tibell
9−-- License : BSD-style (see LICENSE)
8+-- License : BSD3-style (see LICENSE)
10--
9--
11-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
10-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
12-- Stability : experimental
11-- Stability : experimental
@@ -58,14 +57,13 @@ module Data.Text.Internal.Builder
58 ) where
57 ) where
59
58
60import Control.Monad.ST (ST, runST)
59import Control.Monad.ST (ST, runST)
60+import Data.Bits ((.&.))
61import Data.Monoid (Monoid(..))
61import Data.Monoid (Monoid(..))
62−#if MIN_VERSION_base(4,9,0)
63−import Data.Semigroup (Semigroup(..))
64−#endif
65import Data.Text.Internal (Text(..))
62import Data.Text.Internal (Text(..))
66import Data.Text.Internal.Lazy (smallChunkSize)
63import Data.Text.Internal.Lazy (smallChunkSize)
67import Data.Text.Unsafe (inlineInterleaveST)
64import Data.Text.Unsafe (inlineInterleaveST)
68−import Data.Text.Internal.Unsafe.Char (unsafeWrite)
65+import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
66+import Data.Text.Internal.Unsafe.Shift (shiftR)
69import Prelude hiding (map, putChar)
67import Prelude hiding (map, putChar)
70
68
71import qualified Data.String as String
69import qualified Data.String as String
@@ -92,22 +90,12 @@ newtype Builder = Builder {
92 -> ST s [S.Text]
90 -> ST s [S.Text]
93 }
91 }
94
92
95−#if MIN_VERSION_base(4,9,0)
96−instance Semigroup Builder where
97− (<>) = append
98− {-# INLINE (<>) #-}
99−#endif
100−
101instance Monoid Builder where
93instance Monoid Builder where
102 mempty = empty
94 mempty = empty
103 {-# INLINE mempty #-}
95 {-# INLINE mempty #-}
104−#if MIN_VERSION_base(4,9,0)
105− mappend = (<>) -- future-proof definition
106−#else
107 mappend = append
96 mappend = append
108−#endif
109 {-# INLINE mappend #-}
97 {-# INLINE mappend #-}
110− mconcat = foldr mappend Data.Monoid.mempty
98+ mconcat = foldr mappend mempty
111 {-# INLINE mconcat #-}
99 {-# INLINE mconcat #-}
112
100
113instance String.IsString Builder where
101instance String.IsString Builder where
@@ -138,7 +126,17 @@ empty = Builder (\ k buf -> k buf)
138-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@
126-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@
139--
127--
140singleton :: Char -> Builder
128singleton :: Char -> Builder
141−singleton c = writeAtMost 2 $ \ marr o -> unsafeWrite marr o c
129+singleton c = writeAtMost 2 $ \ marr o ->
130+ if n < 0x10000
131+ then A.unsafeWrite marr o (fromIntegral n) >> return 1
132+ else do
133+ A.unsafeWrite marr o lo
134+ A.unsafeWrite marr (o+1) hi
135+ return 2
136+ where n = ord c
137+ m = n - 0x10000
138+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800
139+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
142{-# INLINE singleton #-}
140{-# INLINE singleton #-}
143
141
144------------------------------------------------------------------------
142------------------------------------------------------------------------
@@ -242,8 +240,6 @@ flush = Builder $ \ k buf@(Buffer p o u l) ->
242 !t = Text arr o u
240 !t = Text arr o u
243 ts <- inlineInterleaveST (k b)
241 ts <- inlineInterleaveST (k b)
244 return $! t : ts
242 return $! t : ts
245−{-# INLINE [1] flush #-}
246−-- defer inlining so that flush/flush rule may fire.
247
243
248------------------------------------------------------------------------
244------------------------------------------------------------------------
249
245
Data/Text/Internal/Builder/Functions.hs+1−2
@@ -23,8 +23,7 @@ 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 (chr#,ord#,(+#),Int(I#),Char(C#))
26+import GHC.Base
27−import Prelude ()
28
27
29-- | Unsafe conversion for decimal digits.
28-- | Unsafe conversion for decimal digits.
30{-# INLINE i2d #-}
29{-# INLINE i2d #-}
Data/Text/Internal/Builder/Int/Digits.hs+1−1
@@ -2,7 +2,7 @@
2
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: BSD-style
5+-- License: BSD3
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,5 +1,3 @@
1−{-# LANGUAGE CPP #-}
2−
3-- |
1-- |
4-- Module: Data.Text.Internal.Builder.RealFloat.Functions
2-- Module: Data.Text.Internal.Builder.RealFloat.Functions
5-- Copyright: (c) The University of Glasgow 1994-2002
3-- Copyright: (c) The University of Glasgow 1994-2002
@@ -15,30 +13,6 @@ module Data.Text.Internal.Builder.RealFloat.Functions
15 ) where
13 ) where
16
14
17roundTo :: Int -> [Int] -> (Int,[Int])
15roundTo :: Int -> [Int] -> (Int,[Int])
18−
19−#if MIN_VERSION_base(4,6,0)
20−
21−roundTo d is =
22− case f d True is of
23− x@(0,_) -> x
24− (1,xs) -> (1, 1:xs)
25− _ -> error "roundTo: bad Value"
26− where
27− b2 = base `quot` 2
28−
29− f n _ [] = (0, replicate n 0)
30− f 0 e (x:xs) | x == b2 && e && all (== 0) xs = (0, []) -- Round to even when at exactly half the base
31− | otherwise = (if x >= b2 then 1 else 0, [])
32− f n _ (i:xs)
33− | i' == base = (1,0:ds)
34− | otherwise = (0,i':ds)
35− where
36− (c,ds) = f (n-1) (even i) xs
37− i' = c + i
38− base = 10
39−
40−#else
41−
42roundTo d is =
16roundTo d is =
43 case f d is of
17 case f d is of
44 x@(0,_) -> x
18 x@(0,_) -> x
@@ -53,5 +27,3 @@ roundTo d is =
53 where
27 where
54 (c,ds) = f (n-1) xs
28 (c,ds) = f (n-1) xs
55 i' = c + i
29 i' = c + i
56−
57−#endif
Data/Text/Internal/Encoding/Fusion.hs+2−1
@@ -7,7 +7,8 @@
7-- (c) Duncan Coutts 2009
7-- (c) Duncan Coutts 2009
8--
8--
9-- License : BSD-style
9-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
11-- Stability : experimental
12-- Stability : experimental
12-- Portability : portable
13-- Portability : portable
13--
14--
Data/Text/Internal/Encoding/Fusion/Common.hs+2−1
@@ -8,7 +8,8 @@
8-- (c) Jasper Van der Jeugt 2011
8-- (c) Jasper Van der Jeugt 2011
9--
9--
10-- License : BSD-style
10-- License : BSD-style
11−-- Maintainer : bos@serpentine.com
11+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
12+-- duncan@haskell.org
12-- Stability : experimental
13-- Stability : experimental
13-- Portability : portable
14-- Portability : portable
14--
15--
Data/Text/Internal/Encoding/Utf16.hs+2−1
@@ -7,7 +7,8 @@
7-- (c) 2009 Duncan Coutts
7-- (c) 2009 Duncan Coutts
8--
8--
9-- License : BSD-style
9-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
11-- Stability : experimental
12-- Stability : experimental
12-- Portability : GHC
13-- Portability : GHC
13--
14--
Data/Text/Internal/Encoding/Utf32.hs+2−1
@@ -5,7 +5,8 @@
5-- (c) 2009 Duncan Coutts
5-- (c) 2009 Duncan Coutts
6--
6--
7-- License : BSD-style
7-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
9-- Stability : experimental
10-- Stability : experimental
10-- Portability : portable
11-- Portability : portable
11--
12--
Data/Text/Internal/Encoding/Utf8.hs+2−5
@@ -7,7 +7,8 @@
7-- (c) 2009 Duncan Coutts
7-- (c) 2009 Duncan Coutts
8--
8--
9-- License : BSD-style
9-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
11-- Stability : experimental
12-- Stability : experimental
12-- Portability : GHC
13-- Portability : GHC
13--
14--
@@ -33,10 +34,6 @@ module Data.Text.Internal.Encoding.Utf8
33 , validate4
34 , validate4
34 ) where
35 ) where
35
36
36−#if defined(TEST_SUITE)
37−# undef ASSERTS
38−#endif
39−
40#if defined(ASSERTS)
37#if defined(ASSERTS)
41import Control.Exception (assert)
38import Control.Exception (assert)
42#endif
39#endif
Data/Text/Internal/Fusion.hs+30−39
@@ -7,7 +7,8 @@
7-- (c) Duncan Coutts 2009
7-- (c) Duncan Coutts 2009
8--
8--
9-- License : BSD-style
9-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
11-- Stability : experimental
12-- Stability : experimental
12-- Portability : GHC
13-- Portability : GHC
13--
14--
@@ -68,7 +69,7 @@ default(Int)
68
69
69-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
70-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
70stream :: Text -> Stream Char
71stream :: Text -> Stream Char
71−stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)
72+stream (Text arr off len) = Stream next off (maxSize len)
72 where
73 where
73 !end = off+len
74 !end = off+len
74 next !i
75 next !i
@@ -83,7 +84,7 @@ stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)
83-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate
84-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate
84-- backwards.
85-- backwards.
85reverseStream :: Text -> Stream Char
86reverseStream :: Text -> Stream Char
86−reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `shiftR` 1) len)
87+reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)
87 where
88 where
88 {-# INLINE next #-}
89 {-# INLINE next #-}
89 next !i
90 next !i
@@ -98,35 +99,25 @@ reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `sh
98-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
99-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
99unstream :: Stream Char -> Text
100unstream :: Stream Char -> Text
100unstream (Stream next0 s0 len) = runText $ \done -> do
101unstream (Stream next0 s0 len) = runText $ \done -> do
101− -- Before encoding each char we perform a buffer realloc check assuming
102− -- worst case encoding size of two 16-bit units for the char. Just add an
103− -- extra space to the buffer so that we do not end up reallocating even when
104− -- all the chars are encoded as single unit.
105− let mlen = upperBound 4 len + 1
102+ let mlen = upperBound 4 len
106 arr0 <- A.new mlen
103 arr0 <- A.new mlen
107− let outer !arr !maxi = encode
104+ let outer arr top = loop
108 where
105 where
109− -- keep the common case loop as small as possible
106+ loop !s !i =
110− encode !si !di =
111− case next0 si of
107+ case next0 s of
112− Done -> done arr di
108+ Done -> done arr i
113− Skip si' -> encode si' di
109+ Skip s' -> loop s' i
114− Yield c si'
110+ Yield x s'
115− -- simply check for the worst case
111+ | j >= top -> {-# SCC "unstream/resize" #-} do
116− | maxi < di + 1 -> realloc si di
112+ let top' = (top + 1) `shiftL` 1
117− | otherwise -> do
118− n <- unsafeWrite arr di c
119− encode si' (di + n)
120−
121− -- keep uncommon case separate from the common case code
122− {-# NOINLINE realloc #-}
123− realloc !si !di = do
124− let newlen = (maxi + 1) * 2
125− arr' <- A.new newlen
113+ arr' <- A.new top'
126− A.copyM arr' 0 arr 0 di
114+ A.copyM arr' 0 arr 0 top
127− outer arr' (newlen - 1) si di
115+ outer arr' top' s i
128−
116+ | otherwise -> do d <- unsafeWrite arr i x
117+ loop s' (i+d)
118+ where j | ord x < 0x10000 = i
119+ | otherwise = i + 1
129− outer arr0 (mlen - 1) s0 0
120+ outer arr0 mlen s0 0
130{-# INLINE [0] unstream #-}
121{-# INLINE [0] unstream #-}
131{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
122{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
132
123
@@ -142,7 +133,7 @@ length = S.lengthI
142reverse :: Stream Char -> Text
133reverse :: Stream Char -> Text
143reverse (Stream next s len0)
134reverse (Stream next s len0)
144 | isEmpty len0 = I.empty
135 | isEmpty len0 = I.empty
145− | otherwise = I.text arr off' len'
136+ | otherwise = I.textP arr off' len'
146 where
137 where
147 len0' = upperBound 4 (larger len0 4)
138 len0' = upperBound 4 (larger len0 4)
148 (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')
139 (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')
@@ -176,15 +167,15 @@ reverse (Stream next s len0)
176-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with
167-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with
177-- the input and result reversed.
168-- the input and result reversed.
178reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
169reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
179−reverseScanr f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
170+reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low
180 where
171 where
181 {-# INLINE next #-}
172 {-# INLINE next #-}
182− next (Scan1 z s) = Yield z (Scan2 z s)
173+ next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)
183− next (Scan2 z s) = case next0 s of
174+ next (S2 :*: z :*: s) = case next0 s of
184− Yield x s' -> let !x' = f x z
175+ Yield x s' -> let !x' = f x z
185− in Yield x' (Scan2 x' s')
176+ in Yield x' (S2 :*: x' :*: s')
186− Skip s' -> Skip (Scan2 z s')
177+ Skip s' -> Skip (S2 :*: z :*: s')
187− Done -> Done
178+ Done -> Done
188{-# INLINE reverseScanr #-}
179{-# INLINE reverseScanr #-}
189
180
190-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
181-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
@@ -220,7 +211,7 @@ countChar = S.countCharI
220-- function to each element of a 'Text', passing an accumulating
211-- function to each element of a 'Text', passing an accumulating
221-- parameter from left to right, and returns a final 'Text'.
212-- parameter from left to right, and returns a final 'Text'.
222mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)
213mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)
223−mapAccumL f z0 (Stream next0 s0 len) = (nz, I.text na 0 nl)
214+mapAccumL f z0 (Stream next0 s0 len) = (nz,I.textP na 0 nl)
224 where
215 where
225 (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)
216 (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)
226 where mlen = upperBound 4 len
217 where mlen = upperBound 4 len
Data/Text/Internal/Fusion/CaseMapping.hs+19−291
@@ -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/CaseMapping.hs
3+-- Generated by scripts/SpecialCasing.hs
4−-- CaseFolding-8.0.0.txt
4+-- CaseFolding-6.3.0.txt
5−-- Date: 2015-01-13, 18:16:36 GMT [MD]
5+-- Date: 2012-12-20, 22:14:35 GMT [MD]
6−-- SpecialCasing-8.0.0.txt
6+-- SpecialCasing-6.3.0.txt
7−-- Date: 2014-12-16, 23:08:04 GMT [MD]
7+-- Date: 2013-05-08, 13:54:51 GMT [MD]
8
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−{-# NOINLINE upperMapping #-}
14+{-# INLINE 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−{-# NOINLINE lowerMapping #-}
221+{-# INLINE 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−{-# NOINLINE titleMapping #-}
226+{-# INLINE 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−{-# NOINLINE foldMapping #-}
325+{-# INLINE 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,18 +359,10 @@ 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−-- CHEROKEE SMALL LETTER YE
362+-- GEORGIAN CAPITAL LETTER YN
363−foldMapping '\x13f8' s = Yield '\x13f0' (CC s '\x0000' '\x0000')
363+foldMapping '\x10c7' s = Yield '\x2d27' (CC s '\x0000' '\x0000')
364−-- CHEROKEE SMALL LETTER YI
364+-- GEORGIAN CAPITAL LETTER AEN
365−foldMapping '\x13f9' s = Yield '\x13f1' (CC s '\x0000' '\x0000')
365+foldMapping '\x10cd' s = Yield '\x2d2d' (CC s '\x0000' '\x0000')
366−-- CHEROKEE SMALL LETTER YO
367−foldMapping '\x13fa' s = Yield '\x13f2' (CC s '\x0000' '\x0000')
368−-- CHEROKEE SMALL LETTER YU
369−foldMapping '\x13fb' s = Yield '\x13f3' (CC s '\x0000' '\x0000')
370−-- CHEROKEE SMALL LETTER YV
371−foldMapping '\x13fc' s = Yield '\x13f4' (CC s '\x0000' '\x0000')
372−-- CHEROKEE SMALL LETTER MV
373−foldMapping '\x13fd' s = Yield '\x13f5' (CC s '\x0000' '\x0000')
374-- LATIN SMALL LETTER H WITH LINE BELOW
366-- LATIN SMALL LETTER H WITH LINE BELOW
375foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')
367foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')
376-- LATIN SMALL LETTER T WITH DIAERESIS
368-- LATIN SMALL LETTER T WITH DIAERESIS
@@ -545,174 +537,12 @@ foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')
545foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')
537foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')
546-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
538-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
547foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')
539foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')
548−-- LATIN CAPITAL LETTER J WITH CROSSED-TAIL
540+-- COPTIC CAPITAL LETTER BOHAIRIC KHEI
549−foldMapping '\xa7b2' s = Yield '\x029d' (CC s '\x0000' '\x0000')
541+foldMapping '\x2cf2' s = Yield '\x2cf3' (CC s '\x0000' '\x0000')
550−-- LATIN CAPITAL LETTER CHI
542+-- LATIN CAPITAL LETTER C WITH BAR
551−foldMapping '\xa7b3' s = Yield '\xab53' (CC s '\x0000' '\x0000')
552−-- LATIN CAPITAL LETTER BETA
553−foldMapping '\xa7b4' s = Yield '\xa7b5' (CC s '\x0000' '\x0000')
543+foldMapping '\xa792' s = Yield '\xa793' (CC s '\x0000' '\x0000')
554−-- LATIN CAPITAL LETTER OMEGA
544+-- LATIN CAPITAL LETTER H WITH HOOK
555−foldMapping '\xa7b6' s = Yield '\xa7b7' (CC s '\x0000' '\x0000')
545+foldMapping '\xa7aa' s = Yield '\x0266' (CC s '\x0000' '\x0000')
556−-- CHEROKEE SMALL LETTER A
557−foldMapping '\xab70' s = Yield '\x13a0' (CC s '\x0000' '\x0000')
558−-- CHEROKEE SMALL LETTER E
559−foldMapping '\xab71' s = Yield '\x13a1' (CC s '\x0000' '\x0000')
560−-- CHEROKEE SMALL LETTER I
561−foldMapping '\xab72' s = Yield '\x13a2' (CC s '\x0000' '\x0000')
562−-- CHEROKEE SMALL LETTER O
563−foldMapping '\xab73' s = Yield '\x13a3' (CC s '\x0000' '\x0000')
564−-- CHEROKEE SMALL LETTER U
565−foldMapping '\xab74' s = Yield '\x13a4' (CC s '\x0000' '\x0000')
566−-- CHEROKEE SMALL LETTER V
567−foldMapping '\xab75' s = Yield '\x13a5' (CC s '\x0000' '\x0000')
568−-- CHEROKEE SMALL LETTER GA
569−foldMapping '\xab76' s = Yield '\x13a6' (CC s '\x0000' '\x0000')
570−-- CHEROKEE SMALL LETTER KA
571−foldMapping '\xab77' s = Yield '\x13a7' (CC s '\x0000' '\x0000')
572−-- CHEROKEE SMALL LETTER GE
573−foldMapping '\xab78' s = Yield '\x13a8' (CC s '\x0000' '\x0000')
574−-- CHEROKEE SMALL LETTER GI
575−foldMapping '\xab79' s = Yield '\x13a9' (CC s '\x0000' '\x0000')
576−-- CHEROKEE SMALL LETTER GO
577−foldMapping '\xab7a' s = Yield '\x13aa' (CC s '\x0000' '\x0000')
578−-- CHEROKEE SMALL LETTER GU
579−foldMapping '\xab7b' s = Yield '\x13ab' (CC s '\x0000' '\x0000')
580−-- CHEROKEE SMALL LETTER GV
581−foldMapping '\xab7c' s = Yield '\x13ac' (CC s '\x0000' '\x0000')
582−-- CHEROKEE SMALL LETTER HA
583−foldMapping '\xab7d' s = Yield '\x13ad' (CC s '\x0000' '\x0000')
584−-- CHEROKEE SMALL LETTER HE
585−foldMapping '\xab7e' s = Yield '\x13ae' (CC s '\x0000' '\x0000')
586−-- CHEROKEE SMALL LETTER HI
587−foldMapping '\xab7f' s = Yield '\x13af' (CC s '\x0000' '\x0000')
588−-- CHEROKEE SMALL LETTER HO
589−foldMapping '\xab80' s = Yield '\x13b0' (CC s '\x0000' '\x0000')
590−-- CHEROKEE SMALL LETTER HU
591−foldMapping '\xab81' s = Yield '\x13b1' (CC s '\x0000' '\x0000')
592−-- CHEROKEE SMALL LETTER HV
593−foldMapping '\xab82' s = Yield '\x13b2' (CC s '\x0000' '\x0000')
594−-- CHEROKEE SMALL LETTER LA
595−foldMapping '\xab83' s = Yield '\x13b3' (CC s '\x0000' '\x0000')
596−-- CHEROKEE SMALL LETTER LE
597−foldMapping '\xab84' s = Yield '\x13b4' (CC s '\x0000' '\x0000')
598−-- CHEROKEE SMALL LETTER LI
599−foldMapping '\xab85' s = Yield '\x13b5' (CC s '\x0000' '\x0000')
600−-- CHEROKEE SMALL LETTER LO
601−foldMapping '\xab86' s = Yield '\x13b6' (CC s '\x0000' '\x0000')
602−-- CHEROKEE SMALL LETTER LU
603−foldMapping '\xab87' s = Yield '\x13b7' (CC s '\x0000' '\x0000')
604−-- CHEROKEE SMALL LETTER LV
605−foldMapping '\xab88' s = Yield '\x13b8' (CC s '\x0000' '\x0000')
606−-- CHEROKEE SMALL LETTER MA
607−foldMapping '\xab89' s = Yield '\x13b9' (CC s '\x0000' '\x0000')
608−-- CHEROKEE SMALL LETTER ME
609−foldMapping '\xab8a' s = Yield '\x13ba' (CC s '\x0000' '\x0000')
610−-- CHEROKEE SMALL LETTER MI
611−foldMapping '\xab8b' s = Yield '\x13bb' (CC s '\x0000' '\x0000')
612−-- CHEROKEE SMALL LETTER MO
613−foldMapping '\xab8c' s = Yield '\x13bc' (CC s '\x0000' '\x0000')
614−-- CHEROKEE SMALL LETTER MU
615−foldMapping '\xab8d' s = Yield '\x13bd' (CC s '\x0000' '\x0000')
616−-- CHEROKEE SMALL LETTER NA
617−foldMapping '\xab8e' s = Yield '\x13be' (CC s '\x0000' '\x0000')
618−-- CHEROKEE SMALL LETTER HNA
619−foldMapping '\xab8f' s = Yield '\x13bf' (CC s '\x0000' '\x0000')
620−-- CHEROKEE SMALL LETTER NAH
621−foldMapping '\xab90' s = Yield '\x13c0' (CC s '\x0000' '\x0000')
622−-- CHEROKEE SMALL LETTER NE
623−foldMapping '\xab91' s = Yield '\x13c1' (CC s '\x0000' '\x0000')
624−-- CHEROKEE SMALL LETTER NI
625−foldMapping '\xab92' s = Yield '\x13c2' (CC s '\x0000' '\x0000')
626−-- CHEROKEE SMALL LETTER NO
627−foldMapping '\xab93' s = Yield '\x13c3' (CC s '\x0000' '\x0000')
628−-- CHEROKEE SMALL LETTER NU
629−foldMapping '\xab94' s = Yield '\x13c4' (CC s '\x0000' '\x0000')
630−-- CHEROKEE SMALL LETTER NV
631−foldMapping '\xab95' s = Yield '\x13c5' (CC s '\x0000' '\x0000')
632−-- CHEROKEE SMALL LETTER QUA
633−foldMapping '\xab96' s = Yield '\x13c6' (CC s '\x0000' '\x0000')
634−-- CHEROKEE SMALL LETTER QUE
635−foldMapping '\xab97' s = Yield '\x13c7' (CC s '\x0000' '\x0000')
636−-- CHEROKEE SMALL LETTER QUI
637−foldMapping '\xab98' s = Yield '\x13c8' (CC s '\x0000' '\x0000')
638−-- CHEROKEE SMALL LETTER QUO
639−foldMapping '\xab99' s = Yield '\x13c9' (CC s '\x0000' '\x0000')
640−-- CHEROKEE SMALL LETTER QUU
641−foldMapping '\xab9a' s = Yield '\x13ca' (CC s '\x0000' '\x0000')
642−-- CHEROKEE SMALL LETTER QUV
643−foldMapping '\xab9b' s = Yield '\x13cb' (CC s '\x0000' '\x0000')
644−-- CHEROKEE SMALL LETTER SA
645−foldMapping '\xab9c' s = Yield '\x13cc' (CC s '\x0000' '\x0000')
646−-- CHEROKEE SMALL LETTER S
647−foldMapping '\xab9d' s = Yield '\x13cd' (CC s '\x0000' '\x0000')
648−-- CHEROKEE SMALL LETTER SE
649−foldMapping '\xab9e' s = Yield '\x13ce' (CC s '\x0000' '\x0000')
650−-- CHEROKEE SMALL LETTER SI
651−foldMapping '\xab9f' s = Yield '\x13cf' (CC s '\x0000' '\x0000')
652−-- CHEROKEE SMALL LETTER SO
653−foldMapping '\xaba0' s = Yield '\x13d0' (CC s '\x0000' '\x0000')
654−-- CHEROKEE SMALL LETTER SU
655−foldMapping '\xaba1' s = Yield '\x13d1' (CC s '\x0000' '\x0000')
656−-- CHEROKEE SMALL LETTER SV
657−foldMapping '\xaba2' s = Yield '\x13d2' (CC s '\x0000' '\x0000')
658−-- CHEROKEE SMALL LETTER DA
659−foldMapping '\xaba3' s = Yield '\x13d3' (CC s '\x0000' '\x0000')
660−-- CHEROKEE SMALL LETTER TA
661−foldMapping '\xaba4' s = Yield '\x13d4' (CC s '\x0000' '\x0000')
662−-- CHEROKEE SMALL LETTER DE
663−foldMapping '\xaba5' s = Yield '\x13d5' (CC s '\x0000' '\x0000')
664−-- CHEROKEE SMALL LETTER TE
665−foldMapping '\xaba6' s = Yield '\x13d6' (CC s '\x0000' '\x0000')
666−-- CHEROKEE SMALL LETTER DI
667−foldMapping '\xaba7' s = Yield '\x13d7' (CC s '\x0000' '\x0000')
668−-- CHEROKEE SMALL LETTER TI
669−foldMapping '\xaba8' s = Yield '\x13d8' (CC s '\x0000' '\x0000')
670−-- CHEROKEE SMALL LETTER DO
671−foldMapping '\xaba9' s = Yield '\x13d9' (CC s '\x0000' '\x0000')
672−-- CHEROKEE SMALL LETTER DU
673−foldMapping '\xabaa' s = Yield '\x13da' (CC s '\x0000' '\x0000')
674−-- CHEROKEE SMALL LETTER DV
675−foldMapping '\xabab' s = Yield '\x13db' (CC s '\x0000' '\x0000')
676−-- CHEROKEE SMALL LETTER DLA
677−foldMapping '\xabac' s = Yield '\x13dc' (CC s '\x0000' '\x0000')
678−-- CHEROKEE SMALL LETTER TLA
679−foldMapping '\xabad' s = Yield '\x13dd' (CC s '\x0000' '\x0000')
680−-- CHEROKEE SMALL LETTER TLE
681−foldMapping '\xabae' s = Yield '\x13de' (CC s '\x0000' '\x0000')
682−-- CHEROKEE SMALL LETTER TLI
683−foldMapping '\xabaf' s = Yield '\x13df' (CC s '\x0000' '\x0000')
684−-- CHEROKEE SMALL LETTER TLO
685−foldMapping '\xabb0' s = Yield '\x13e0' (CC s '\x0000' '\x0000')
686−-- CHEROKEE SMALL LETTER TLU
687−foldMapping '\xabb1' s = Yield '\x13e1' (CC s '\x0000' '\x0000')
688−-- CHEROKEE SMALL LETTER TLV
689−foldMapping '\xabb2' s = Yield '\x13e2' (CC s '\x0000' '\x0000')
690−-- CHEROKEE SMALL LETTER TSA
691−foldMapping '\xabb3' s = Yield '\x13e3' (CC s '\x0000' '\x0000')
692−-- CHEROKEE SMALL LETTER TSE
693−foldMapping '\xabb4' s = Yield '\x13e4' (CC s '\x0000' '\x0000')
694−-- CHEROKEE SMALL LETTER TSI
695−foldMapping '\xabb5' s = Yield '\x13e5' (CC s '\x0000' '\x0000')
696−-- CHEROKEE SMALL LETTER TSO
697−foldMapping '\xabb6' s = Yield '\x13e6' (CC s '\x0000' '\x0000')
698−-- CHEROKEE SMALL LETTER TSU
699−foldMapping '\xabb7' s = Yield '\x13e7' (CC s '\x0000' '\x0000')
700−-- CHEROKEE SMALL LETTER TSV
701−foldMapping '\xabb8' s = Yield '\x13e8' (CC s '\x0000' '\x0000')
702−-- CHEROKEE SMALL LETTER WA
703−foldMapping '\xabb9' s = Yield '\x13e9' (CC s '\x0000' '\x0000')
704−-- CHEROKEE SMALL LETTER WE
705−foldMapping '\xabba' s = Yield '\x13ea' (CC s '\x0000' '\x0000')
706−-- CHEROKEE SMALL LETTER WI
707−foldMapping '\xabbb' s = Yield '\x13eb' (CC s '\x0000' '\x0000')
708−-- CHEROKEE SMALL LETTER WO
709−foldMapping '\xabbc' s = Yield '\x13ec' (CC s '\x0000' '\x0000')
710−-- CHEROKEE SMALL LETTER WU
711−foldMapping '\xabbd' s = Yield '\x13ed' (CC s '\x0000' '\x0000')
712−-- CHEROKEE SMALL LETTER WV
713−foldMapping '\xabbe' s = Yield '\x13ee' (CC s '\x0000' '\x0000')
714−-- CHEROKEE SMALL LETTER YA
715−foldMapping '\xabbf' s = Yield '\x13ef' (CC s '\x0000' '\x0000')
716-- LATIN SMALL LIGATURE FF
546-- LATIN SMALL LIGATURE FF
717foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')
547foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')
718-- LATIN SMALL LIGATURE FI
548-- LATIN SMALL LIGATURE FI
@@ -737,106 +567,4 @@ foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')
737foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')
567foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')
738-- ARMENIAN SMALL LIGATURE MEN XEH
568-- ARMENIAN SMALL LIGATURE MEN XEH
739foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')
569foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')
740−-- OLD HUNGARIAN CAPITAL LETTER A
741−foldMapping '\x10c80' s = Yield '\x10cc0' (CC s '\x0000' '\x0000')
742−-- OLD HUNGARIAN CAPITAL LETTER AA
743−foldMapping '\x10c81' s = Yield '\x10cc1' (CC s '\x0000' '\x0000')
744−-- OLD HUNGARIAN CAPITAL LETTER EB
745−foldMapping '\x10c82' s = Yield '\x10cc2' (CC s '\x0000' '\x0000')
746−-- OLD HUNGARIAN CAPITAL LETTER AMB
747−foldMapping '\x10c83' s = Yield '\x10cc3' (CC s '\x0000' '\x0000')
748−-- OLD HUNGARIAN CAPITAL LETTER EC
749−foldMapping '\x10c84' s = Yield '\x10cc4' (CC s '\x0000' '\x0000')
750−-- OLD HUNGARIAN CAPITAL LETTER ENC
751−foldMapping '\x10c85' s = Yield '\x10cc5' (CC s '\x0000' '\x0000')
752−-- OLD HUNGARIAN CAPITAL LETTER ECS
753−foldMapping '\x10c86' s = Yield '\x10cc6' (CC s '\x0000' '\x0000')
754−-- OLD HUNGARIAN CAPITAL LETTER ED
755−foldMapping '\x10c87' s = Yield '\x10cc7' (CC s '\x0000' '\x0000')
756−-- OLD HUNGARIAN CAPITAL LETTER AND
757−foldMapping '\x10c88' s = Yield '\x10cc8' (CC s '\x0000' '\x0000')
758−-- OLD HUNGARIAN CAPITAL LETTER E
759−foldMapping '\x10c89' s = Yield '\x10cc9' (CC s '\x0000' '\x0000')
760−-- OLD HUNGARIAN CAPITAL LETTER CLOSE E
761−foldMapping '\x10c8a' s = Yield '\x10cca' (CC s '\x0000' '\x0000')
762−-- OLD HUNGARIAN CAPITAL LETTER EE
763−foldMapping '\x10c8b' s = Yield '\x10ccb' (CC s '\x0000' '\x0000')
764−-- OLD HUNGARIAN CAPITAL LETTER EF
765−foldMapping '\x10c8c' s = Yield '\x10ccc' (CC s '\x0000' '\x0000')
766−-- OLD HUNGARIAN CAPITAL LETTER EG
767−foldMapping '\x10c8d' s = Yield '\x10ccd' (CC s '\x0000' '\x0000')
768−-- OLD HUNGARIAN CAPITAL LETTER EGY
769−foldMapping '\x10c8e' s = Yield '\x10cce' (CC s '\x0000' '\x0000')
770−-- OLD HUNGARIAN CAPITAL LETTER EH
771−foldMapping '\x10c8f' s = Yield '\x10ccf' (CC s '\x0000' '\x0000')
772−-- OLD HUNGARIAN CAPITAL LETTER I
773−foldMapping '\x10c90' s = Yield '\x10cd0' (CC s '\x0000' '\x0000')
774−-- OLD HUNGARIAN CAPITAL LETTER II
775−foldMapping '\x10c91' s = Yield '\x10cd1' (CC s '\x0000' '\x0000')
776−-- OLD HUNGARIAN CAPITAL LETTER EJ
777−foldMapping '\x10c92' s = Yield '\x10cd2' (CC s '\x0000' '\x0000')
778−-- OLD HUNGARIAN CAPITAL LETTER EK
779−foldMapping '\x10c93' s = Yield '\x10cd3' (CC s '\x0000' '\x0000')
780−-- OLD HUNGARIAN CAPITAL LETTER AK
781−foldMapping '\x10c94' s = Yield '\x10cd4' (CC s '\x0000' '\x0000')
782−-- OLD HUNGARIAN CAPITAL LETTER UNK
783−foldMapping '\x10c95' s = Yield '\x10cd5' (CC s '\x0000' '\x0000')
784−-- OLD HUNGARIAN CAPITAL LETTER EL
785−foldMapping '\x10c96' s = Yield '\x10cd6' (CC s '\x0000' '\x0000')
786−-- OLD HUNGARIAN CAPITAL LETTER ELY
787−foldMapping '\x10c97' s = Yield '\x10cd7' (CC s '\x0000' '\x0000')
788−-- OLD HUNGARIAN CAPITAL LETTER EM
789−foldMapping '\x10c98' s = Yield '\x10cd8' (CC s '\x0000' '\x0000')
790−-- OLD HUNGARIAN CAPITAL LETTER EN
791−foldMapping '\x10c99' s = Yield '\x10cd9' (CC s '\x0000' '\x0000')
792−-- OLD HUNGARIAN CAPITAL LETTER ENY
793−foldMapping '\x10c9a' s = Yield '\x10cda' (CC s '\x0000' '\x0000')
794−-- OLD HUNGARIAN CAPITAL LETTER O
795−foldMapping '\x10c9b' s = Yield '\x10cdb' (CC s '\x0000' '\x0000')
796−-- OLD HUNGARIAN CAPITAL LETTER OO
797−foldMapping '\x10c9c' s = Yield '\x10cdc' (CC s '\x0000' '\x0000')
798−-- OLD HUNGARIAN CAPITAL LETTER NIKOLSBURG OE
799−foldMapping '\x10c9d' s = Yield '\x10cdd' (CC s '\x0000' '\x0000')
800−-- OLD HUNGARIAN CAPITAL LETTER RUDIMENTA OE
801−foldMapping '\x10c9e' s = Yield '\x10cde' (CC s '\x0000' '\x0000')
802−-- OLD HUNGARIAN CAPITAL LETTER OEE
803−foldMapping '\x10c9f' s = Yield '\x10cdf' (CC s '\x0000' '\x0000')
804−-- OLD HUNGARIAN CAPITAL LETTER EP
805−foldMapping '\x10ca0' s = Yield '\x10ce0' (CC s '\x0000' '\x0000')
806−-- OLD HUNGARIAN CAPITAL LETTER EMP
807−foldMapping '\x10ca1' s = Yield '\x10ce1' (CC s '\x0000' '\x0000')
808−-- OLD HUNGARIAN CAPITAL LETTER ER
809−foldMapping '\x10ca2' s = Yield '\x10ce2' (CC s '\x0000' '\x0000')
810−-- OLD HUNGARIAN CAPITAL LETTER SHORT ER
811−foldMapping '\x10ca3' s = Yield '\x10ce3' (CC s '\x0000' '\x0000')
812−-- OLD HUNGARIAN CAPITAL LETTER ES
813−foldMapping '\x10ca4' s = Yield '\x10ce4' (CC s '\x0000' '\x0000')
814−-- OLD HUNGARIAN CAPITAL LETTER ESZ
815−foldMapping '\x10ca5' s = Yield '\x10ce5' (CC s '\x0000' '\x0000')
816−-- OLD HUNGARIAN CAPITAL LETTER ET
817−foldMapping '\x10ca6' s = Yield '\x10ce6' (CC s '\x0000' '\x0000')
818−-- OLD HUNGARIAN CAPITAL LETTER ENT
819−foldMapping '\x10ca7' s = Yield '\x10ce7' (CC s '\x0000' '\x0000')
820−-- OLD HUNGARIAN CAPITAL LETTER ETY
821−foldMapping '\x10ca8' s = Yield '\x10ce8' (CC s '\x0000' '\x0000')
822−-- OLD HUNGARIAN CAPITAL LETTER ECH
823−foldMapping '\x10ca9' s = Yield '\x10ce9' (CC s '\x0000' '\x0000')
824−-- OLD HUNGARIAN CAPITAL LETTER U
825−foldMapping '\x10caa' s = Yield '\x10cea' (CC s '\x0000' '\x0000')
826−-- OLD HUNGARIAN CAPITAL LETTER UU
827−foldMapping '\x10cab' s = Yield '\x10ceb' (CC s '\x0000' '\x0000')
828−-- OLD HUNGARIAN CAPITAL LETTER NIKOLSBURG UE
829−foldMapping '\x10cac' s = Yield '\x10cec' (CC s '\x0000' '\x0000')
830−-- OLD HUNGARIAN CAPITAL LETTER RUDIMENTA UE
831−foldMapping '\x10cad' s = Yield '\x10ced' (CC s '\x0000' '\x0000')
832−-- OLD HUNGARIAN CAPITAL LETTER EV
833−foldMapping '\x10cae' s = Yield '\x10cee' (CC s '\x0000' '\x0000')
834−-- OLD HUNGARIAN CAPITAL LETTER EZ
835−foldMapping '\x10caf' s = Yield '\x10cef' (CC s '\x0000' '\x0000')
836−-- OLD HUNGARIAN CAPITAL LETTER EZS
837−foldMapping '\x10cb0' s = Yield '\x10cf0' (CC s '\x0000' '\x0000')
838−-- OLD HUNGARIAN CAPITAL LETTER ENT-SHAPED SIGN
839−foldMapping '\x10cb1' s = Yield '\x10cf1' (CC s '\x0000' '\x0000')
840−-- OLD HUNGARIAN CAPITAL LETTER US
841−foldMapping '\x10cb2' s = Yield '\x10cf2' (CC s '\x0000' '\x0000')
842foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
570foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
Data/Text/Internal/Fusion/Common.hs+78−65
@@ -4,7 +4,8 @@
4-- Copyright : (c) Bryan O'Sullivan 2009, 2012
4-- Copyright : (c) Bryan O'Sullivan 2009, 2012
5--
5--
6-- License : BSD-style
6-- License : BSD-style
7−-- Maintainer : bos@serpentine.com
7+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
8+-- duncan@haskell.org
8-- Stability : experimental
9-- Stability : experimental
9-- Portability : GHC
10-- Portability : GHC
10--
11--
@@ -71,6 +72,9 @@ module Data.Text.Internal.Fusion.Common
71 -- ** Scans
72 -- ** Scans
72 , scanl
73 , scanl
73
74
75+ -- ** Accumulating maps
76+ -- , mapAccumL
77+
74 -- ** Generation and unfolding
78 -- ** Generation and unfolding
75 , replicateCharI
79 , replicateCharI
76 , replicateI
80 , replicateI
@@ -103,7 +107,7 @@ module Data.Text.Internal.Fusion.Common
103
107
104import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
108import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
105 Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),
109 Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),
106− (&&), fromIntegral, otherwise)
110+ (&&), fromIntegral, not, otherwise)
107import qualified Data.List as L
111import qualified Data.List as L
108import qualified Prelude as P
112import qualified Prelude as P
109import Data.Bits (shiftL)
113import Data.Bits (shiftL)
@@ -120,7 +124,7 @@ singleton :: Char -> Stream Char
120singleton c = Stream next False 1
124singleton c = Stream next False 1
121 where next False = Yield c True
125 where next False = Yield c True
122 next True = Done
126 next True = Done
123−{-# INLINE [0] singleton #-}
127+{-# INLINE singleton #-}
124
128
125streamList :: [a] -> Stream a
129streamList :: [a] -> Stream a
126{-# INLINE [0] streamList #-}
130{-# INLINE [0] streamList #-}
@@ -184,9 +188,6 @@ cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
184 Yield x s' -> Yield x (C0 s')
188 Yield x s' -> Yield x (C0 s')
185{-# INLINE [0] cons #-}
189{-# INLINE [0] cons #-}
186
190
187−data Snoc a = N
188− | J !a
189−
190-- | /O(n)/ Adds a character to the end of a stream.
191-- | /O(n)/ Adds a character to the end of a stream.
191snoc :: Stream Char -> Char -> Stream Char
192snoc :: Stream Char -> Char -> Stream Char
192snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
193snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
@@ -315,13 +316,12 @@ lengthI (Stream next s0 _len) = loop_length 0 s0
315--
316--
316-- This function gives the same answer as comparing against the result
317-- This function gives the same answer as comparing against the result
317-- of 'lengthI', but can short circuit if the count of characters is
318-- 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
319−-- as the number supplied, and hence be more efficient.
319+-- greater than the number, and hence be more efficient.
320compareLengthI :: Integral a => Stream Char -> a -> Ordering
320compareLengthI :: Integral a => Stream Char -> a -> Ordering
321compareLengthI (Stream next s0 len) n =
321compareLengthI (Stream next s0 len) n =
322− case compareSize len (fromIntegral n) of
322+ case exactly len of
323− Just o -> o
324 Nothing -> loop_cmp 0 s0
323 Nothing -> loop_cmp 0 s0
324+ Just i -> compare (fromIntegral i) n
325 where
325 where
326 loop_cmp !z s = case next s of
326 loop_cmp !z s = case next s of
327 Done -> compare z n
327 Done -> compare z n
@@ -473,20 +473,17 @@ toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len
473 next (CC s a b) = Yield a (CC s b '\0')
473 next (CC s a b) = Yield a (CC s b '\0')
474{-# INLINE [0] toTitle #-}
474{-# INLINE [0] toTitle #-}
475
475
476−data Justify i s = Just1 !i !s
477− | Just2 !i !s
478−
479justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
476justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
480justifyLeftI k c (Stream next0 s0 len) =
477justifyLeftI k c (Stream next0 s0 len) =
481− Stream next (Just1 0 s0) (larger (fromIntegral k) len)
478+ Stream next (s0 :*: S1 :*: 0) (larger (fromIntegral k) len)
482 where
479 where
483− next (Just1 n s) =
480+ next (s :*: S1 :*: n) =
484 case next0 s of
481 case next0 s of
485− Done -> next (Just2 n s)
482+ Done -> next (s :*: S2 :*: n)
486− Skip s' -> Skip (Just1 n s')
483+ Skip s' -> Skip (s' :*: S1 :*: n)
487− Yield x s' -> Yield x (Just1 (n+1) s')
484+ Yield x s' -> Yield x (s' :*: S1 :*: n+1)
488− next (Just2 n s)
485+ next (s :*: S2 :*: n)
489− | n < k = Yield c (Just2 (n+1) s)
486+ | n < k = Yield c (s :*: S2 :*: n+1)
490 | otherwise = Done
487 | otherwise = Done
491 {-# INLINE next #-}
488 {-# INLINE next #-}
492{-# INLINE [0] justifyLeftI #-}
489{-# INLINE [0] justifyLeftI #-}
@@ -593,7 +590,7 @@ concatMap f = foldr (append . f) empty
593{-# INLINE [0] concatMap #-}
590{-# INLINE [0] concatMap #-}
594
591
595-- | /O(n)/ any @p @xs determines if any character in the stream
592-- | /O(n)/ any @p @xs determines if any character in the stream
596−-- @xs@ satisfies the predicate @p@.
593+-- @xs@ satisifes the predicate @p@.
597any :: (Char -> Bool) -> Stream Char -> Bool
594any :: (Char -> Bool) -> Stream Char -> Bool
598any p (Stream next0 s0 _len) = loop_any s0
595any p (Stream next0 s0 _len) = loop_any s0
599 where
596 where
@@ -605,7 +602,7 @@ any p (Stream next0 s0 _len) = loop_any s0
605{-# INLINE [0] any #-}
602{-# INLINE [0] any #-}
606
603
607-- | /O(n)/ all @p @xs determines if all characters in the 'Text'
604-- | /O(n)/ all @p @xs determines if all characters in the 'Text'
608−-- @xs@ satisfy the predicate @p@.
605+-- @xs@ satisify the predicate @p@.
609all :: (Char -> Bool) -> Stream Char -> Bool
606all :: (Char -> Bool) -> Stream Char -> Bool
610all p (Stream next0 s0 _len) = loop_all s0
607all p (Stream next0 s0 _len) = loop_all s0
611 where
608 where
@@ -654,27 +651,50 @@ minimum (Stream next0 s0 _len) = loop0_minimum s0
654-- * Building streams
651-- * Building streams
655
652
656scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
653scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
657−scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
654+scanl f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low
658 where
655 where
659 {-# INLINE next #-}
656 {-# INLINE next #-}
660− next (Scan1 z s) = Yield z (Scan2 z s)
657+ next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)
661− next (Scan2 z s) = case next0 s of
658+ next (S2 :*: z :*: s) = case next0 s of
662− Yield x s' -> let !x' = f z x
659+ Yield x s' -> let !x' = f z x
663− in Yield x' (Scan2 x' s')
660+ in Yield x' (S2 :*: x' :*: s')
664− Skip s' -> Skip (Scan2 z s')
661+ Skip s' -> Skip (S2 :*: z :*: s')
665− Done -> Done
662+ Done -> Done
666{-# INLINE [0] scanl #-}
663{-# INLINE [0] scanl #-}
667
664
665+-- -----------------------------------------------------------------------------
666+-- ** Accumulating maps
667+
668+{-
669+-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a
670+-- function to each element of a stream, passing an accumulating
671+-- parameter from left to right, and returns a final stream.
672+--
673+-- /Note/: Unlike the version over lists, this function does not
674+-- return a final value for the accumulator, because the nature of
675+-- streams precludes it.
676+mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b
677+mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :*: z0) len -- HINT depends on f
678+ where
679+ {-# INLINE next #-}
680+ next (s :*: z) = case next0 s of
681+ Yield x s' -> let (z',y) = f z x
682+ in Yield y (s' :*: z')
683+ Skip s' -> Skip (s' :*: z)
684+ Done -> Done
685+{-# INLINE [0] mapAccumL #-}
686+-}
687+
668-- -----------------------------------------------------------------------------
688-- -----------------------------------------------------------------------------
669-- ** Generating and unfolding streams
689-- ** Generating and unfolding streams
670
690
671replicateCharI :: Integral a => a -> Char -> Stream Char
691replicateCharI :: Integral a => a -> Char -> Stream Char
672−replicateCharI !n !c
692+replicateCharI n c
673 | n < 0 = empty
693 | n < 0 = empty
674 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
694 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
675 where
695 where
676− next !i | i >= n = Done
696+ next i | i >= n = Done
677− | otherwise = Yield c (i + 1)
697+ | otherwise = Yield c (i + 1)
678{-# INLINE [0] replicateCharI #-}
698{-# INLINE [0] replicateCharI #-}
679
699
680data RI s = RI !s {-# UNPACK #-} !Int64
700data RI s = RI !s {-# UNPACK #-} !Int64
@@ -739,27 +759,24 @@ take n0 (Stream next0 s0 len) =
739 Yield x s' -> Yield x ((n-1) :*: s')
759 Yield x s' -> Yield x ((n-1) :*: s')
740{-# INLINE [0] take #-}
760{-# INLINE [0] take #-}
741
761
742−data Drop a s = NS !s
743− | JS !a !s
744−
745-- | /O(n)/ drop n, applied to a stream, returns the suffix of the
762-- | /O(n)/ drop n, applied to a stream, returns the suffix of the
746-- stream after the first @n@ characters, or the empty stream if @n@
763-- stream after the first @n@ characters, or the empty stream if @n@
747-- is greater than the length of the stream.
764-- is greater than the length of the stream.
748drop :: Integral a => a -> Stream Char -> Stream Char
765drop :: Integral a => a -> Stream Char -> Stream Char
749drop n0 (Stream next0 s0 len) =
766drop n0 (Stream next0 s0 len) =
750− Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))
767+ Stream next (J n0 :*: s0) (len - fromIntegral (max 0 n0))
751 where
768 where
752 {-# INLINE next #-}
769 {-# INLINE next #-}
753− next (JS n s)
770+ next (J n :*: s)
754− | n <= 0 = Skip (NS s)
771+ | n <= 0 = Skip (N :*: s)
755 | otherwise = case next0 s of
772 | otherwise = case next0 s of
756 Done -> Done
773 Done -> Done
757− Skip s' -> Skip (JS n s')
774+ Skip s' -> Skip (J n :*: s')
758− Yield _ s' -> Skip (JS (n-1) s')
775+ Yield _ s' -> Skip (J (n-1) :*: s')
759− next (NS s) = case next0 s of
776+ next (N :*: s) = case next0 s of
760 Done -> Done
777 Done -> Done
761− Skip s' -> Skip (NS s')
778+ Skip s' -> Skip (N :*: s')
762− Yield x s' -> Yield x (NS s')
779+ Yield x s' -> Yield x (N :*: s')
763{-# INLINE [0] drop #-}
780{-# INLINE [0] drop #-}
764
781
765-- | takeWhile, applied to a predicate @p@ and a stream, returns the
782-- | takeWhile, applied to a predicate @p@ and a stream, returns the
@@ -777,18 +794,18 @@ takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
777
794
778-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
795-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
779dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
796dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
780−dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
797+dropWhile p (Stream next0 s0 len) = Stream next (S1 :*: s0) len -- HINT maybe too high
781 where
798 where
782 {-# INLINE next #-}
799 {-# INLINE next #-}
783− next (L s) = case next0 s of
800+ next (S1 :*: s) = case next0 s of
784 Done -> Done
801 Done -> Done
785− Skip s' -> Skip (L s')
802+ Skip s' -> Skip (S1 :*: s')
786− Yield x s' | p x -> Skip (L s')
803+ Yield x s' | p x -> Skip (S1 :*: s')
787− | otherwise -> Yield x (R s')
804+ | otherwise -> Yield x (S2 :*: s')
788− next (R s) = case next0 s of
805+ next (S2 :*: s) = case next0 s of
789 Done -> Done
806 Done -> Done
790− Skip s' -> Skip (R s')
807+ Skip s' -> Skip (S2 :*: s')
791− Yield x s' -> Yield x (R s')
808+ Yield x s' -> Yield x (S2 :*: s')
792{-# INLINE [0] dropWhile #-}
809{-# INLINE [0] dropWhile #-}
793
810
794-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
811-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
@@ -895,25 +912,21 @@ findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0
895-------------------------------------------------------------------------------
912-------------------------------------------------------------------------------
896-- * Zipping
913-- * Zipping
897
914
898−-- | Strict triple.
899−data Zip a b m = Z1 !a !b
900− | Z2 !a !b !m
901−
902-- | zipWith generalises 'zip' by zipping with the function given as
915-- | zipWith generalises 'zip' by zipping with the function given as
903-- the first argument, instead of a tupling function.
916-- the first argument, instead of a tupling function.
904zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
917zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
905zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
918zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
906− Stream next (Z1 sa0 sb0) (smaller len1 len2)
919+ Stream next (sa0 :*: sb0 :*: N) (smaller len1 len2)
907 where
920 where
908− next (Z1 sa sb) = case next0 sa of
921+ next (sa :*: sb :*: N) = case next0 sa of
909− Done -> Done
922+ Done -> Done
910− Skip sa' -> Skip (Z1 sa' sb)
923+ Skip sa' -> Skip (sa' :*: sb :*: N)
911− Yield a sa' -> Skip (Z2 sa' sb a)
924+ Yield a sa' -> Skip (sa' :*: sb :*: J a)
912−
925+
913− next (Z2 sa' sb a) = case next1 sb of
926+ next (sa' :*: sb :*: J a) = case next1 sb of
914− Done -> Done
927+ Done -> Done
915− Skip sb' -> Skip (Z2 sa' sb' a)
928+ Skip sb' -> Skip (sa' :*: sb' :*: J a)
916− Yield b sb' -> Yield (f a b) (Z1 sa' sb')
929+ Yield b sb' -> Yield (f a b) (sa' :*: sb' :*: N)
917{-# INLINE [0] zipWith #-}
930{-# INLINE [0] zipWith #-}
918
931
919-- | /O(n)/ The 'countCharI' function returns the number of times the
932-- | /O(n)/ The 'countCharI' function returns the number of times the
Data/Text/Internal/Fusion/Size.hs+54−61
@@ -6,7 +6,8 @@
6-- (c) Bryan O'Sullivan 2009
6-- (c) Bryan O'Sullivan 2009
7--
7--
8-- License : BSD-style
8-- License : BSD-style
9−-- Maintainer : bos@serpentine.com
9+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
10+-- duncan@haskell.org
10-- Stability : experimental
11-- Stability : experimental
11-- Portability : portable
12-- Portability : portable
12--
13--
@@ -22,28 +23,25 @@ module Data.Text.Internal.Fusion.Size
22 , exactly
23 , exactly
23 , exactSize
24 , exactSize
24 , maxSize
25 , maxSize
25− , betweenSize
26 , unknownSize
26 , unknownSize
27 , smaller
27 , smaller
28 , larger
28 , larger
29 , upperBound
29 , upperBound
30− , lowerBound
31− , compareSize
32 , isEmpty
30 , isEmpty
33 ) where
31 ) where
34
32
35−import Data.Text.Internal (mul)
36#if defined(ASSERTS)
33#if defined(ASSERTS)
37import Control.Exception (assert)
34import Control.Exception (assert)
38#endif
35#endif
39
36
40−data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.
37+data Size = Exact {-# UNPACK #-} !Int -- ^ Exact size.
38+ | Max {-# UNPACK #-} !Int -- ^ Upper bound on size.
41− | Unknown -- ^ Unknown size.
39+ | Unknown -- ^ Unknown size.
42 deriving (Eq, Show)
40 deriving (Eq, Show)
43
41
44exactly :: Size -> Maybe Int
42exactly :: Size -> Maybe Int
45−exactly (Between na nb) | na == nb = Just na
43+exactly (Exact n) = Just n
46−exactly _ = Nothing
44+exactly _ = Nothing
47{-# INLINE exactly #-}
45{-# INLINE exactly #-}
48
46
49exactSize :: Int -> Size
47exactSize :: Int -> Size
@@ -51,7 +49,7 @@ exactSize n =
51#if defined(ASSERTS)
49#if defined(ASSERTS)
52 assert (n >= 0)
50 assert (n >= 0)
53#endif
51#endif
54− Between n n
52+ Exact n
55{-# INLINE exactSize #-}
53{-# INLINE exactSize #-}
56
54
57maxSize :: Int -> Size
55maxSize :: Int -> Size
@@ -59,18 +57,9 @@ maxSize n =
59#if defined(ASSERTS)
57#if defined(ASSERTS)
60 assert (n >= 0)
58 assert (n >= 0)
61#endif
59#endif
62− Between 0 n
60+ Max n
63{-# INLINE maxSize #-}
61{-# INLINE maxSize #-}
64
62
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−
74unknownSize :: Size
63unknownSize :: Size
75unknownSize = Unknown
64unknownSize = Unknown
76{-# INLINE unknownSize #-}
65{-# INLINE unknownSize #-}
@@ -80,7 +69,7 @@ instance Num Size where
80 (-) = subtractSize
69 (-) = subtractSize
81 (*) = mulSize
70 (*) = mulSize
82
71
83− fromInteger = f where f = exactSize . fromInteger
72+ fromInteger = f where f = Exact . fromInteger
84 {-# INLINE f #-}
73 {-# INLINE f #-}
85
74
86add :: Int -> Int -> Int
75add :: Int -> Int -> Int
@@ -90,67 +79,71 @@ add m n | mn >= 0 = mn
90{-# INLINE add #-}
79{-# INLINE add #-}
91
80
92addSize :: Size -> Size -> Size
81addSize :: Size -> Size -> Size
93−addSize (Between ma mb) (Between na nb) = Between (add ma na) (add mb nb)
82+addSize (Exact m) (Exact n) = Exact (add m n)
83+addSize (Exact m) (Max n) = Max (add m n)
84+addSize (Max m) (Exact n) = Max (add m n)
85+addSize (Max m) (Max n) = Max (add m n)
94−addSize _ _ = Unknown
86+addSize _ _ = Unknown
95{-# INLINE addSize #-}
87{-# INLINE addSize #-}
96
88
97subtractSize :: Size -> Size -> Size
89subtractSize :: Size -> Size -> Size
98−subtractSize (Between ma mb) (Between na nb) = Between (max (ma-nb) 0) (max (mb-na) 0)
90+subtractSize (Exact m) (Exact n) = Exact (max (m-n) 0)
91+subtractSize (Exact m) (Max _) = Max m
92+subtractSize (Max m) (Exact n) = Max (max (m-n) 0)
99−subtractSize a@(Between 0 _) Unknown = a
93+subtractSize a@(Max _) (Max _) = a
100−subtractSize (Between _ mb) Unknown = Between 0 mb
94+subtractSize a@(Max _) Unknown = a
101−subtractSize _ _ = Unknown
95+subtractSize _ _ = Unknown
102{-# INLINE subtractSize #-}
96{-# INLINE subtractSize #-}
103
97
98+mul :: Int -> Int -> Int
99+mul m n
100+ | m <= maxBound `quot` n = m * n
101+ | otherwise = overflowError
102+{-# INLINE mul #-}
103+
104mulSize :: Size -> Size -> Size
104mulSize :: Size -> Size -> Size
105−mulSize (Between ma mb) (Between na nb) = Between (mul ma na) (mul mb nb)
105+mulSize (Exact m) (Exact n) = Exact (mul m n)
106+mulSize (Exact m) (Max n) = Max (mul m n)
107+mulSize (Max m) (Exact n) = Max (mul m n)
108+mulSize (Max m) (Max n) = Max (mul m n)
106−mulSize _ _ = Unknown
109+mulSize _ _ = Unknown
107{-# INLINE mulSize #-}
110{-# INLINE mulSize #-}
108
111
109-- | Minimum of two size hints.
112-- | Minimum of two size hints.
110smaller :: Size -> Size -> Size
113smaller :: Size -> Size -> Size
111−smaller a@(Between ma mb) b@(Between na nb)
114+smaller (Exact m) (Exact n) = Exact (m `min` n)
112− | mb <= na = a
115+smaller (Exact m) (Max n) = Max (m `min` n)
113− | nb <= ma = b
116+smaller (Exact m) Unknown = Max m
114− | otherwise = Between (ma `min` na) (mb `min` nb)
117+smaller (Max m) (Exact n) = Max (m `min` n)
118+smaller (Max m) (Max n) = Max (m `min` n)
115−smaller a@(Between 0 _) Unknown = a
119+smaller a@(Max _) Unknown = a
116−smaller (Between _ mb) Unknown = Between 0 mb
120+smaller Unknown (Exact n) = Max n
117−smaller Unknown b@(Between 0 _) = b
118−smaller Unknown (Between _ nb) = Between 0 nb
121+smaller Unknown (Max n) = Max n
119−smaller Unknown Unknown = Unknown
122+smaller Unknown Unknown = Unknown
120{-# INLINE smaller #-}
123{-# INLINE smaller #-}
121
124
122-- | Maximum of two size hints.
125-- | Maximum of two size hints.
123larger :: Size -> Size -> Size
126larger :: Size -> Size -> Size
124−larger a@(Between ma mb) b@(Between na nb)
127+larger (Exact m) (Exact n) = Exact (m `max` n)
125− | ma >= nb = a
128+larger a@(Exact m) b@(Max n) | m >= n = a
126− | na >= mb = b
129+ | otherwise = b
130+larger a@(Max m) b@(Exact n) | n >= m = b
127− | otherwise = Between (ma `max` na) (mb `max` nb)
131+ | otherwise = a
132+larger (Max m) (Max n) = Max (m `max` n)
128−larger _ _ = Unknown
133+larger _ _ = Unknown
129{-# INLINE larger #-}
134{-# INLINE larger #-}
130
135
131-- | Compute the maximum size from a size hint, if possible.
136-- | Compute the maximum size from a size hint, if possible.
132upperBound :: Int -> Size -> Int
137upperBound :: Int -> Size -> Int
133−upperBound _ (Between _ n) = n
138+upperBound _ (Exact n) = n
139+upperBound _ (Max n) = n
134−upperBound k _ = k
140+upperBound k _ = k
135{-# INLINE upperBound #-}
141{-# INLINE upperBound #-}
136
142
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−
151isEmpty :: Size -> Bool
143isEmpty :: Size -> Bool
152−isEmpty (Between _ n) = n <= 0
144+isEmpty (Exact n) = n <= 0
145+isEmpty (Max n) = n <= 0
153−isEmpty _ = False
146+isEmpty _ = False
154{-# INLINE isEmpty #-}
147{-# INLINE isEmpty #-}
155
148
156overflowError :: Int
149overflowError :: Int
Data/Text/Internal/Fusion/Types.hs+15−9
@@ -7,7 +7,8 @@
7-- (c) Jasper Van der Jeugt 2011
7-- (c) Jasper Van der Jeugt 2011
8--
8--
9-- License : BSD-style
9-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
11-- Stability : experimental
12-- Stability : experimental
12-- Portability : GHC
13-- Portability : GHC
13--
14--
@@ -20,11 +21,13 @@
20module Data.Text.Internal.Fusion.Types
21module Data.Text.Internal.Fusion.Types
21 (
22 (
22 CC(..)
23 CC(..)
24+ , M(..)
25+ , M8
23 , PairS(..)
26 , PairS(..)
24− , Scan(..)
25 , RS(..)
27 , RS(..)
26 , Step(..)
28 , Step(..)
27 , Stream(..)
29 , Stream(..)
30+ , Switch(..)
28 , empty
31 , empty
29 ) where
32 ) where
30
33
@@ -34,23 +37,26 @@ import Data.Word (Word8)
34-- | Specialised tuple for case conversion.
37-- | Specialised tuple for case conversion.
35data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char
38data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char
36
39
40+-- | Specialised, strict Maybe-like type.
41+data M a = N
42+ | J !a
43+
44+type M8 = M Word8
45+
37−-- | Restreaming state.
46+-- Restreaming state.
38data RS s
47data RS s
39 = RS0 !s
48 = RS0 !s
40 | RS1 !s {-# UNPACK #-} !Word8
49 | RS1 !s {-# UNPACK #-} !Word8
41 | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
50 | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
42 | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
51 | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
43
52
44−-- | Strict pair.
53+infixl 2 :*:
45data PairS a b = !a :*: !b
54data PairS a b = !a :*: !b
46 -- deriving (Eq, Ord, Show)
55 -- deriving (Eq, Ord, Show)
47−infixl 2 :*:
48
56
49−-- | An intermediate result in a scan.
57+-- | Allow a function over a stream to switch between two states.
50−data Scan s = Scan1 {-# UNPACK #-} !Char !s
58+data Switch = S1 | S2
51− | Scan2 {-# UNPACK #-} !Char !s
52
59
53−-- | Intermediate result in a processing pipeline.
54data Step s a = Done
60data Step s a = Done
55 | Skip !s
61 | Skip !s
56 | Yield !a !s
62 | Yield !a !s
Data/Text/Internal/Lazy.hs+2−3
@@ -1,12 +1,11 @@
1{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
1{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
2−{-# OPTIONS_HADDOCK not-home #-}
3−
4-- |
2-- |
5-- Module : Data.Text.Internal.Lazy
3-- Module : Data.Text.Internal.Lazy
6-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
7--
5--
8-- License : BSD-style
6-- License : BSD-style
9−-- Maintainer : bos@serpentine.com
7+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
8+-- duncan@haskell.org
10-- Stability : experimental
9-- Stability : experimental
11-- Portability : GHC
10-- Portability : GHC
12--
11--
Data/Text/Internal/Lazy/Encoding/Fusion.hs+2−1
@@ -5,7 +5,8 @@
5-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
5-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
6--
6--
7-- License : BSD-style
7-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
9-- Stability : experimental
10-- Stability : experimental
10-- Portability : portable
11-- Portability : portable
11--
12--
Data/Text/Internal/Lazy/Fusion.hs+2−1
@@ -4,7 +4,8 @@
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
5--
5--
6-- License : BSD-style
6-- License : BSD-style
7−-- Maintainer : bos@serpentine.com
7+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
8+-- duncan@haskell.org
8-- Stability : experimental
9-- Stability : experimental
9-- Portability : GHC
10-- Portability : GHC
10--
11--
Data/Text/Internal/Lazy/Search.hs+2−1
@@ -5,7 +5,8 @@
5-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
5-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
6--
6--
7-- License : BSD-style
7-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
9-- Stability : experimental
10-- Stability : experimental
10-- Portability : GHC
11-- Portability : GHC
11--
12--
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(..), text)
19+import Data.Text.Internal (Text(..), textP)
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 = text arr off k
25+ where hd = textP arr off k
26− tl = text arr (off+k) (len-k)
26+ tl = textP 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 $! text arr 0 len)
36+ return $! textP arr 0 len)
37{-# INLINE runText #-}
37{-# INLINE runText #-}
Data/Text/Internal/Read.hsdeleted−62
@@ -1,62 +0,0 @@
1−-- |
2−-- Module : Data.Text.Internal.Read
3−-- Copyright : (c) 2014 Bryan O'Sullivan
4−--
5−-- License : BSD-style
6−-- Maintainer : bos@serpentine.com
7−-- Stability : experimental
8−-- Portability : GHC
9−--
10−-- Common internal functions for reading textual data.
11−module Data.Text.Internal.Read
12− (
13− IReader
14− , IParser(..)
15− , T(..)
16− , digitToInt
17− , hexDigitToInt
18− , perhaps
19− ) where
20−
21−import Control.Applicative as App (Applicative(..))
22−import Control.Arrow (first)
23−import Control.Monad (ap)
24−import Data.Char (ord)
25−
26−type IReader t a = t -> Either String (a,t)
27−
28−newtype IParser t a = P {
29− runP :: IReader t a
30− }
31−
32−instance Functor (IParser t) where
33− fmap f m = P $ fmap (first f) . runP m
34−
35−instance Applicative (IParser t) where
36− pure a = P $ \t -> Right (a,t)
37− {-# INLINE pure #-}
38− (<*>) = ap
39−
40−instance Monad (IParser t) where
41− return = App.pure
42− m >>= k = P $ \t -> case runP m t of
43− Left err -> Left err
44− Right (a,t') -> runP (k a) t'
45− {-# INLINE (>>=) #-}
46− fail msg = P $ \_ -> Left msg
47−
48−data T = T !Integer !Int
49−
50−perhaps :: a -> IParser t a -> IParser t a
51−perhaps def m = P $ \t -> case runP m t of
52− Left _ -> Right (def,t)
53− r@(Right _) -> r
54−
55−hexDigitToInt :: Char -> Int
56−hexDigitToInt c
57− | c >= '0' && c <= '9' = ord c - ord '0'
58− | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)
59− | otherwise = ord c - (ord 'A' - 10)
60−
61−digitToInt :: Char -> Int
62−digitToInt c = ord c - ord '0'
Data/Text/Internal/Search.hs+2−1
@@ -5,7 +5,8 @@
5-- Copyright : (c) Bryan O'Sullivan 2009
5-- Copyright : (c) Bryan O'Sullivan 2009
6--
6--
7-- License : BSD-style
7-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
9-- Stability : experimental
10-- Stability : experimental
10-- Portability : GHC
11-- Portability : GHC
11--
12--
Data/Text/Internal/Unsafe.hs+2−3
@@ -1,11 +1,10 @@
1{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
1{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
2−{-# OPTIONS_HADDOCK not-home #-}
3−
4-- |
2-- |
5-- Module : Data.Text.Internal.Unsafe
3-- Module : Data.Text.Internal.Unsafe
6-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
4-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
7-- License : BSD-style
5-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
6+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
7+-- duncan@haskell.org
9-- Stability : experimental
8-- Stability : experimental
10-- Portability : portable
9-- Portability : portable
11--
10--
Data/Text/Internal/Unsafe/Char.hs+2−1
@@ -7,7 +7,8 @@
7-- (c) 2009 Duncan Coutts
7-- (c) 2009 Duncan Coutts
8--
8--
9-- License : BSD-style
9-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
11-- Stability : experimental
12-- Stability : experimental
12-- Portability : GHC
13-- Portability : GHC
13--
14--
Data/Text/Internal/Unsafe/Shift.hs+2−1
@@ -5,7 +5,8 @@
5-- Copyright : (c) Bryan O'Sullivan 2009
5-- Copyright : (c) Bryan O'Sullivan 2009
6--
6--
7-- License : BSD-style
7-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
9-- Stability : experimental
10-- Stability : experimental
10-- Portability : GHC
11-- Portability : GHC
11--
12--
Data/Text/Lazy.hs+28−202
@@ -3,16 +3,13 @@
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−
10-- |
6-- |
11-- Module : Data.Text.Lazy
7-- Module : Data.Text.Lazy
12-- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan
8-- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan
13--
9--
14-- License : BSD-style
10-- License : BSD-style
15−-- Maintainer : bos@serpentine.com
11+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
12+-- duncan@haskell.org
16-- Stability : experimental
13-- Stability : experimental
17-- Portability : GHC
14-- Portability : GHC
18--
15--
@@ -125,10 +122,7 @@ module Data.Text.Lazy
125 , mapAccumR
122 , mapAccumR
126
123
127 -- ** Generation and unfolding
124 -- ** Generation and unfolding
128− , repeat
129 , replicate
125 , replicate
130− , cycle
131− , iterate
132 , unfoldr
126 , unfoldr
133 , unfoldrN
127 , unfoldrN
134
128
@@ -136,11 +130,8 @@ module Data.Text.Lazy
136
130
137 -- ** Breaking strings
131 -- ** Breaking strings
138 , take
132 , take
139− , takeEnd
140 , drop
133 , drop
141− , dropEnd
142 , takeWhile
134 , takeWhile
143− , takeWhileEnd
144 , dropWhile
135 , dropWhile
145 , dropWhileEnd
136 , dropWhileEnd
146 , dropAround
137 , dropAround
@@ -211,13 +202,9 @@ import Control.DeepSeq (NFData(..))
211import Data.Int (Int64)
202import Data.Int (Int64)
212import qualified Data.List as L
203import qualified Data.List as L
213import Data.Char (isSpace)
204import Data.Char (isSpace)
214−import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
205+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))
215− Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
206+import Data.Data (mkNoRepType)
216−import Data.Binary (Binary(get, put))
217import Data.Monoid (Monoid(..))
207import Data.Monoid (Monoid(..))
218−#if MIN_VERSION_base(4,9,0)
219−import Data.Semigroup (Semigroup(..))
220−#endif
221import Data.String (IsString(..))
208import Data.String (IsString(..))
222import qualified Data.Text as T
209import qualified Data.Text as T
223import qualified Data.Text.Internal as T
210import qualified Data.Text.Internal as T
@@ -226,10 +213,8 @@ import qualified Data.Text.Unsafe as T
226import qualified Data.Text.Internal.Lazy.Fusion as S
213import qualified Data.Text.Internal.Lazy.Fusion as S
227import Data.Text.Internal.Fusion.Types (PairS(..))
214import Data.Text.Internal.Fusion.Types (PairS(..))
228import Data.Text.Internal.Lazy.Fusion (stream, unstream)
215import Data.Text.Internal.Lazy.Fusion (stream, unstream)
229−import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks,
216+import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks, foldrChunks)
230− foldrChunks, smallChunkSize)
231−import Data.Text.Internal (firstf, safe, text)
217+import Data.Text.Internal (firstf, safe, textP)
232−import Data.Text.Lazy.Encoding (decodeUtf8', encodeUtf8)
233import qualified Data.Text.Internal.Functions as F
218import qualified Data.Text.Internal.Functions as F
234import Data.Text.Internal.Lazy.Search (indices)
219import Data.Text.Internal.Lazy.Search (indices)
235#if __GLASGOW_HASKELL__ >= 702
220#if __GLASGOW_HASKELL__ >= 702
@@ -237,13 +222,7 @@ import qualified GHC.CString as GHC
237#else
222#else
238import qualified GHC.Base as GHC
223import qualified GHC.Base as GHC
239#endif
224#endif
240−#if __GLASGOW_HASKELL__ >= 708
241−import qualified GHC.Exts as Exts
242−#endif
243import GHC.Prim (Addr#)
225import GHC.Prim (Addr#)
244−#if MIN_VERSION_base(4,7,0)
245−import Text.Printf (PrintfArg, formatArg, formatString)
246−#endif
247
226
248-- $fusion
227-- $fusion
249--
228--
@@ -341,71 +320,25 @@ instance Show Text where
341instance Read Text where
320instance Read Text where
342 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
321 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
343
322
344−#if MIN_VERSION_base(4,9,0)
345−-- Semigroup orphan instances for older GHCs are provided by
346−-- 'semigroups` package
347−
348−instance Semigroup Text where
349− (<>) = append
350−#endif
351−
352instance Monoid Text where
323instance Monoid Text where
353 mempty = empty
324 mempty = empty
354−#if MIN_VERSION_base(4,9,0)
355− mappend = (<>) -- future-proof definition
356−#else
357 mappend = append
325 mappend = append
358−#endif
359 mconcat = concat
326 mconcat = concat
360
327
361instance IsString Text where
328instance IsString Text where
362 fromString = pack
329 fromString = pack
363
330
364−#if __GLASGOW_HASKELL__ >= 708
365−instance Exts.IsList Text where
366− type Item Text = Char
367− fromList = pack
368− toList = unpack
369−#endif
370−
371#if defined(HAVE_DEEPSEQ)
331#if defined(HAVE_DEEPSEQ)
372instance NFData Text where
332instance NFData Text where
373 rnf Empty = ()
333 rnf Empty = ()
374 rnf (Chunk _ ts) = rnf ts
334 rnf (Chunk _ ts) = rnf ts
375#endif
335#endif
376
336
377−instance Binary Text where
378− put t = put (encodeUtf8 t)
379− get = do
380− bs <- get
381− case decodeUtf8' bs of
382− P.Left exn -> P.fail (P.show exn)
383− P.Right a -> P.return a
384−
385−-- | This instance preserves data abstraction at the cost of inefficiency.
386−-- We omit reflection services for the sake of data abstraction.
387−--
388−-- This instance was created by copying the updated behavior of
389−-- @"Data.Text".@'Data.Text.Text'
390instance Data Text where
337instance Data Text where
391 gfoldl f z txt = z pack `f` (unpack txt)
338 gfoldl f z txt = z pack `f` (unpack txt)
392− toConstr _ = packConstr
339+ toConstr _ = error "Data.Text.Lazy.Text.toConstr"
393− gunfold k z c = case constrIndex c of
394− 1 -> k (z pack)
395− _ -> error "Data.Text.Lazy.Text.gunfold"
340+ gunfold _ _ = error "Data.Text.Lazy.Text.gunfold"
396− dataTypeOf _ = textDataType
341+ dataTypeOf _ = mkNoRepType "Data.Text.Lazy.Text"
397−
398−#if MIN_VERSION_base(4,7,0)
399−-- | Only defined for @base-4.7.0.0@ and later
400−instance PrintfArg Text where
401− formatArg txt = formatString $ unpack txt
402−#endif
403−
404−packConstr :: Constr
405−packConstr = mkConstr textDataType "pack" [] Prefix
406−
407−textDataType :: DataType
408−textDataType = mkDataType "Data.Text.Lazy.Text" [packConstr]
409
342
410-- | /O(n)/ Convert a 'String' into a 'Text'.
343-- | /O(n)/ Convert a 'String' into a 'Text'.
411--
344--
@@ -433,14 +366,6 @@ unpackCString# addr# = unstream (S.streamCString# addr#)
433 unstream (S.streamList (L.map safe (GHC.unpackCStringUtf8# a)))
366 unstream (S.streamList (L.map safe (GHC.unpackCStringUtf8# a)))
434 = unpackCString# a #-}
367 = unpackCString# a #-}
435
368
436−{-# RULES "LAZY TEXT empty literal"
437− unstream (S.streamList (L.map safe []))
438− = Empty #-}
439−
440−{-# RULES "LAZY TEXT empty literal" forall a.
441− unstream (S.streamList (L.map safe [a]))
442− = Chunk (T.singleton a) Empty #-}
443−
444-- | /O(1)/ Convert a character into a Text. Subject to fusion.
369-- | /O(1)/ Convert a character into a Text. Subject to fusion.
445-- Performs replacement on invalid scalar values.
370-- Performs replacement on invalid scalar values.
446singleton :: Char -> Text
371singleton :: Char -> Text
@@ -545,7 +470,7 @@ tail Empty = emptyError "tail"
545 unstream (S.tail (stream t)) = tail t
470 unstream (S.tail (stream t)) = tail t
546 #-}
471 #-}
547
472
548−-- | /O(n\/c)/ Returns all but the last character of a 'Text', which must
473+-- | /O(1)/ Returns all but the last character of a 'Text', which must
549-- be non-empty. Subject to fusion.
474-- be non-empty. Subject to fusion.
550init :: Text -> Text
475init :: Text -> Text
551init (Chunk t0 ts0) = go t0 ts0
476init (Chunk t0 ts0) = go t0 ts0
@@ -581,7 +506,7 @@ isSingleton :: Text -> Bool
581isSingleton = S.isSingleton . stream
506isSingleton = S.isSingleton . stream
582{-# INLINE isSingleton #-}
507{-# INLINE isSingleton #-}
583
508
584−-- | /O(n\/c)/ Returns the last character of a 'Text', which must be
509+-- | /O(1)/ Returns the last character of a 'Text', which must be
585-- non-empty. Subject to fusion.
510-- non-empty. Subject to fusion.
586last :: Text -> Char
511last :: Text -> Char
587last Empty = emptyError "last"
512last Empty = emptyError "last"
@@ -715,36 +640,13 @@ reverse = rev Empty
715 where rev a Empty = a
640 where rev a Empty = a
716 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts
641 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts
717
642
718−-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
643+-- | /O(m+n)/ Replace every occurrence of one substring with another.
719−-- @haystack@ with @replacement@.
720−--
721−-- This function behaves as though it was defined as follows:
722−--
723−-- @
724−-- replace needle replacement haystack =
725−-- 'intercalate' replacement ('splitOn' needle haystack)
726−-- @
727−--
728−-- As this suggests, each occurrence is replaced exactly once. So if
729−-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
730−-- be replaced recursively:
731−--
732−-- > replace "oo" "foo" "oo" == "foo"
733−--
734−-- In cases where several instances of @needle@ overlap, only the
735−-- first one will be replaced:
736−--
737−-- > replace "ofo" "bar" "ofofo" == "barfo"
738--
644--
739-- In (unlikely) bad cases, this function's time complexity degrades
645-- In (unlikely) bad cases, this function's time complexity degrades
740-- towards /O(n*m)/.
646-- towards /O(n*m)/.
741−replace :: Text
647+replace :: Text -- ^ Text to search for
742− -- ^ @needle@ to search for. If this string is empty, an
648+ -> Text -- ^ Replacement text
743− -- error will occur.
744− -> Text
745− -- ^ @replacement@ to replace @needle@ with.
746− -> Text
649+ -> Text -- ^ Input text
747− -- ^ @haystack@ in which to search.
748 -> Text
650 -> Text
749replace s d = intercalate d . splitOn s
651replace s d = intercalate d . splitOn s
750{-# INLINE replace #-}
652{-# INLINE replace #-}
@@ -881,13 +783,13 @@ concatMap f = concat . foldr ((:) . f) []
881{-# INLINE concatMap #-}
783{-# INLINE concatMap #-}
882
784
883-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
785-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
884−-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
786+-- 'Text' @t@ satisifes the predicate @p@. Subject to fusion.
885any :: (Char -> Bool) -> Text -> Bool
787any :: (Char -> Bool) -> Text -> Bool
886any p t = S.any p (stream t)
788any p t = S.any p (stream t)
887{-# INLINE any #-}
789{-# INLINE any #-}
888
790
889-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
791-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
890−-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
792+-- 'Text' @t@ satisify the predicate @p@. Subject to fusion.
891all :: (Char -> Bool) -> Text -> Bool
793all :: (Char -> Bool) -> Text -> Bool
892all p t = S.all p (stream t)
794all p t = S.all p (stream t)
893{-# INLINE all #-}
795{-# INLINE all #-}
@@ -970,12 +872,6 @@ mapAccumR f = go
970 go z Empty = (z, Empty)
872 go z Empty = (z, Empty)
971{-# INLINE mapAccumR #-}
873{-# INLINE mapAccumR #-}
972
874
973−-- | @'repeat' x@ is an infinite 'Text', with @x@ the value of every
974−-- element.
975−repeat :: Char -> Text
976−repeat c = let t = Chunk (T.replicate smallChunkSize (T.singleton c)) t
977− in t
978−
979-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
875-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
980-- @t@ repeated @n@ times.
876-- @t@ repeated @n@ times.
981replicate :: Int64 -> Text -> Text
877replicate :: Int64 -> Text -> Text
@@ -985,22 +881,7 @@ replicate n t
985 | otherwise = concat (rep 0)
881 | otherwise = concat (rep 0)
986 where rep !i | i >= n = []
882 where rep !i | i >= n = []
987 | otherwise = t : rep (i+1)
883 | otherwise = t : rep (i+1)
988−{-# INLINE [1] replicate #-}
884+{-# INLINE replicate #-}
989−
990−-- | 'cycle' ties a finite, non-empty 'Text' into a circular one, or
991−-- equivalently, the infinite repetition of the original 'Text'.
992−cycle :: Text -> Text
993−cycle Empty = emptyError "cycle"
994−cycle t = let t' = foldrChunks Chunk t' t
995− in t'
996−
997−-- | @'iterate' f x@ returns an infinite 'Text' of repeated applications
998−-- of @f@ to @x@:
999−--
1000−-- > iterate f x == [x, f x, f (f x), ...]
1001−iterate :: (Char -> Char) -> Char -> Text
1002−iterate f c = let t c' = Chunk (T.singleton c') (t (f c'))
1003− in t c
1004
885
1005-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
886-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
1006-- value of every element. Subject to fusion.
887-- value of every element. Subject to fusion.
@@ -1055,22 +936,6 @@ take i t0 = take' i t0
1055 unstream (S.take n (stream t)) = take n t
936 unstream (S.take n (stream t)) = take n t
1056 #-}
937 #-}
1057
938
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−
1074-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
939-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1075-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
940-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1076-- is greater than the length of the 'Text'. Subject to fusion.
941-- is greater than the length of the 'Text'. Subject to fusion.
@@ -1093,23 +958,6 @@ drop i t0
1093 unstream (S.drop n (stream t)) = drop n t
958 unstream (S.drop n (stream t)) = drop n t
1094 #-}
959 #-}
1095
960
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−
1113-- | /O(n)/ 'dropWords' @n@ returns the suffix with @n@ 'Word16'
961-- | /O(n)/ 'dropWords' @n@ returns the suffix with @n@ 'Word16'
1114-- values dropped, or the empty 'Text' if @n@ is greater than the
962-- values dropped, or the empty 'Text' if @n@ is greater than the
1115-- number of 'Word16' values present.
963-- number of 'Word16' values present.
@@ -1120,7 +968,7 @@ dropWords i t0
1120 where drop' 0 ts = ts
968 where drop' 0 ts = ts
1121 drop' _ Empty = Empty
969 drop' _ Empty = Empty
1122 drop' n (Chunk (T.Text arr off len) ts)
970 drop' n (Chunk (T.Text arr off len) ts)
1123− | n < len' = chunk (text arr (off+n') (len-n')) ts
971+ | n < len' = chunk (textP arr (off+n') (len-n')) ts
1124 | otherwise = drop' (n - len') ts
972 | otherwise = drop' (n - len') ts
1125 where len' = fromIntegral len
973 where len' = fromIntegral len
1126 n' = fromIntegral n
974 n' = fromIntegral n
@@ -1144,20 +992,6 @@ takeWhile p t0 = takeWhile' t0
1144"LAZY TEXT takeWhile -> unfused" [1] forall p t.
992"LAZY TEXT takeWhile -> unfused" [1] forall p t.
1145 unstream (S.takeWhile p (stream t)) = takeWhile p t
993 unstream (S.takeWhile p (stream t)) = takeWhile p t
1146 #-}
994 #-}
1147−-- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',
1148−-- returns the longest suffix (possibly empty) of elements that
1149−-- satisfy @p@.
1150−-- Examples:
1151−--
1152−-- > takeWhileEnd (=='o') "foo" == "oo"
1153−takeWhileEnd :: (Char -> Bool) -> Text -> Text
1154−takeWhileEnd p = takeChunk empty . L.reverse . toChunks
1155− where takeChunk acc [] = acc
1156− takeChunk acc (t:ts) = if T.length t' < T.length t
1157− then (Chunk t' acc)
1158− else takeChunk (Chunk t' acc) ts
1159− where t' = T.takeWhileEnd p t
1160−{-# INLINE takeWhileEnd #-}
1161
995
1162-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
996-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1163-- 'takeWhile' @p@ @t@. Subject to fusion.
997-- 'takeWhile' @p@ @t@. Subject to fusion.
@@ -1176,11 +1010,9 @@ dropWhile p t0 = dropWhile' t0
1176"LAZY TEXT dropWhile -> unfused" [1] forall p t.
1010"LAZY TEXT dropWhile -> unfused" [1] forall p t.
1177 unstream (S.dropWhile p (stream t)) = dropWhile p t
1011 unstream (S.dropWhile p (stream t)) = dropWhile p t
1178 #-}
1012 #-}
1179−
1180-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1013-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1181−-- dropping characters that satisfy the predicate @p@ from the end of
1014+-- dropping characters that fail the predicate @p@ from the end of
1182-- @t@.
1015-- @t@.
1183−--
1184-- Examples:
1016-- Examples:
1185--
1017--
1186-- > dropWhileEnd (=='.') "foo..." == "foo"
1018-- > dropWhileEnd (=='.') "foo..." == "foo"
@@ -1197,7 +1029,7 @@ dropWhileEnd p = go
1197{-# INLINE dropWhileEnd #-}
1029{-# INLINE dropWhileEnd #-}
1198
1030
1199-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1031-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1200−-- dropping characters that satisfy the predicate @p@ from both the
1032+-- dropping characters that fail the predicate @p@ from both the
1201-- beginning and end of @t@. Subject to fusion.
1033-- beginning and end of @t@. Subject to fusion.
1202dropAround :: (Char -> Bool) -> Text -> Text
1034dropAround :: (Char -> Bool) -> Text -> Text
1203dropAround p = dropWhile p . dropWhileEnd p
1035dropAround p = dropWhile p . dropWhileEnd p
@@ -1247,8 +1079,8 @@ splitAtWord _ Empty = empty :*: empty
1247splitAtWord x (Chunk c@(T.Text arr off len) cs)
1079splitAtWord x (Chunk c@(T.Text arr off len) cs)
1248 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1080 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1249 in Chunk c h :*: t
1081 in Chunk c h :*: t
1250− | otherwise = chunk (text arr off y) empty :*:
1082+ | otherwise = chunk (textP arr off y) empty :*:
1251− chunk (text arr (off+y) (len-y)) cs
1083+ chunk (textP arr (off+y) (len-y)) cs
1252 where y = fromIntegral x
1084 where y = fromIntegral x
1253
1085
1254-- | /O(n+m)/ Find the first instance of @needle@ (which must be
1086-- | /O(n+m)/ Find the first instance of @needle@ (which must be
@@ -1392,10 +1224,9 @@ tails ts@(Chunk t ts')
1392-- copies to create substrings; they just construct new 'Text's that
1224-- copies to create substrings; they just construct new 'Text's that
1393-- are slices of the original.
1225-- are slices of the original.
1394
1226
1395−-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'
1227+-- | /O(m+n)/ Break a 'Text' into pieces separated by the first
1396−-- argument (which cannot be an empty string), consuming the
1228+-- 'Text' argument, consuming the delimiter. An empty delimiter is
1397−-- delimiter. An empty delimiter is invalid, and will cause an error
1229+-- invalid, and will cause an error to be raised.
1398−-- to be raised.
1399--
1230--
1400-- Examples:
1231-- Examples:
1401--
1232--
@@ -1408,18 +1239,13 @@ tails ts@(Chunk t ts')
1408-- > intercalate s . splitOn s == id
1239-- > intercalate s . splitOn s == id
1409-- > splitOn (singleton c) == split (==c)
1240-- > splitOn (singleton c) == split (==c)
1410--
1241--
1411−-- (Note: the string @s@ to split on above cannot be empty.)
1412−--
1413-- This function is strict in its first argument, and lazy in its
1242-- This function is strict in its first argument, and lazy in its
1414-- second.
1243-- second.
1415--
1244--
1416-- In (unlikely) bad cases, this function's time complexity degrades
1245-- In (unlikely) bad cases, this function's time complexity degrades
1417-- towards /O(n*m)/.
1246-- towards /O(n*m)/.
1418−splitOn :: Text
1247+splitOn :: Text -- ^ Text to split on
1419− -- ^ String to split on. If this string is empty, an error
1420− -- will occur.
1421− -> Text
1422− -- ^ Input text.
1248+ -> Text -- ^ Input text
1423 -> [Text]
1249 -> [Text]
1424splitOn pat src
1250splitOn pat src
1425 | null pat = emptyError "splitOn"
1251 | 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 : BSD-style (see LICENSE)
11+-- License : BSD3-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+15−22
@@ -1,5 +1,4 @@
1−{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,
1+{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, UnboxedTuples #-}
2− UnboxedTuples #-}
3#if __GLASGOW_HASKELL__ >= 702
2#if __GLASGOW_HASKELL__ >= 702
4{-# LANGUAGE Trustworthy #-}
3{-# LANGUAGE Trustworthy #-}
5#endif
4#endif
@@ -7,7 +6,7 @@
7-- Module: Data.Text.Lazy.Builder.Int
6-- Module: Data.Text.Lazy.Builder.Int
8-- Copyright: (c) 2013 Bryan O'Sullivan
7-- Copyright: (c) 2013 Bryan O'Sullivan
9-- (c) 2011 MailRank, Inc.
8-- (c) 2011 MailRank, Inc.
10−-- License: BSD-style
9+-- License: BSD3
11-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
10-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
12-- Stability: experimental
11-- Stability: experimental
13-- Portability: portable
12-- Portability: portable
@@ -35,7 +34,7 @@ import Control.Monad.ST
35
34
36#ifdef __GLASGOW_HASKELL__
35#ifdef __GLASGOW_HASKELL__
37# if defined(INTEGER_GMP)
36# if defined(INTEGER_GMP)
38−import GHC.Integer.GMP.Internals (Integer(S#))
37+import GHC.Integer.GMP.Internals
39# elif defined(INTEGER_SIMPLE)
38# elif defined(INTEGER_SIMPLE)
40import GHC.Integer
39import GHC.Integer
41# else
40# else
@@ -50,19 +49,18 @@ import GHC.Integer
50#endif
49#endif
51
50
52decimal :: Integral a => a -> Builder
51decimal :: Integral a => a -> Builder
53−{-# RULES "decimal/Int8" decimal = boundedDecimal :: Int8 -> Builder #-}
52+{-# SPECIALIZE decimal :: Int8 -> Builder #-}
54{-# RULES "decimal/Int" decimal = boundedDecimal :: Int -> Builder #-}
53{-# RULES "decimal/Int" decimal = boundedDecimal :: Int -> Builder #-}
55{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}
54{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}
56{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}
55{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}
57{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}
56{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}
58−{-# RULES "decimal/Word" decimal = positive :: Data.Word.Word -> Builder #-}
57+{-# RULES "decimal/Word" decimal = positive :: Word -> Builder #-}
59{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}
58{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}
60{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}
59{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}
61{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}
60{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}
62{-# RULES "decimal/Word64" decimal = positive :: Word64 -> Builder #-}
61{-# RULES "decimal/Word64" decimal = positive :: Word64 -> Builder #-}
63{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}
62{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}
64decimal i = decimal' (<= -128) i
63decimal i = decimal' (<= -128) i
65−{-# NOINLINE decimal #-}
66
64
67boundedDecimal :: (Integral a, Bounded a) => a -> Builder
65boundedDecimal :: (Integral a, Bounded a) => a -> Builder
68{-# SPECIALIZE boundedDecimal :: Int -> Builder #-}
66{-# SPECIALIZE boundedDecimal :: Int -> Builder #-}
@@ -134,15 +132,8 @@ i2w v = zero + fromIntegral v
134
132
135countDigits :: (Integral a) => a -> Int
133countDigits :: (Integral a) => a -> Int
136{-# INLINE countDigits #-}
134{-# INLINE countDigits #-}
137−countDigits v0
135+countDigits v0 = go 1 (fromIntegral v0 :: Word64)
138− | fromIntegral v64 == v0 = go 1 v64
139− | otherwise = goBig 1 (fromIntegral v0)
140− where v64 = fromIntegral v0
141− goBig !k (v :: Integer)
142− | v > big = goBig (k + 19) (v `quot` big)
143− | otherwise = go k (fromIntegral v)
144− big = 10000000000000000000
145− go !k (v :: Word64)
136+ where go !k v
146 | v < 10 = k
137 | v < 10 = k
147 | v < 100 = k + 1
138 | v < 100 = k + 1
148 | v < 1000 = k + 2
139 | v < 1000 = k + 2
@@ -178,7 +169,6 @@ hexadecimal i
178 where
169 where
179 go n | n < 16 = hexDigit n
170 go n | n < 16 = hexDigit n
180 | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)
171 | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)
181−{-# NOINLINE[0] hexadecimal #-}
182
172
183hexInteger :: Integer -> Builder
173hexInteger :: Integer -> Builder
184hexInteger i
174hexInteger i
@@ -194,12 +184,19 @@ hexDigit n
194 | otherwise = singleton $! toEnum (fromIntegral n + 87)
184 | otherwise = singleton $! toEnum (fromIntegral n + 87)
195{-# INLINE hexDigit #-}
185{-# INLINE hexDigit #-}
196
186
187+int :: Int -> Builder
188+int = decimal
189+{-# INLINE int #-}
190+
197data T = T !Integer !Int
191data T = T !Integer !Int
198
192
199integer :: Int -> Integer -> Builder
193integer :: Int -> Integer -> Builder
200#ifdef INTEGER_GMP
194#ifdef INTEGER_GMP
201integer 10 (S# i#) = decimal (I# i#)
195integer 10 (S# i#) = decimal (I# i#)
202integer 16 (S# i#) = hexadecimal (I# i#)
196integer 16 (S# i#) = hexadecimal (I# i#)
197+#else
198+integer 10 i = decimal i
199+integer 16 i = hexadecimal i
203#endif
200#endif
204integer base i
201integer base i
205 | i < 0 = singleton '-' <> go (-i)
202 | i < 0 = singleton '-' <> go (-i)
@@ -247,11 +244,7 @@ integer base i
247 PAIR(x,y) -> pblock q <> pblock r <> putB ns
244 PAIR(x,y) -> pblock q <> pblock r <> putB ns
248 where q = fromInteger x
245 where q = fromInteger x
249 r = fromInteger y
246 r = fromInteger y
250− putB _ = Data.Monoid.mempty
247+ putB _ = mempty
251−
252− int :: Int -> Builder
253− int x | base == 10 = decimal x
254− | otherwise = hexadecimal x
255
248
256 pblock = loop maxDigits
249 pblock = loop maxDigits
257 where
250 where
Data/Text/Lazy/Encoding.hs+8−32
@@ -7,7 +7,8 @@
7-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
7-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
8--
8--
9-- License : BSD-style
9-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
11-- Stability : experimental
12-- Stability : experimental
12-- Portability : portable
13-- Portability : portable
13--
14--
@@ -45,26 +46,17 @@ module Data.Text.Lazy.Encoding
45 , encodeUtf16BE
46 , encodeUtf16BE
46 , encodeUtf32LE
47 , encodeUtf32LE
47 , encodeUtf32BE
48 , encodeUtf32BE
48−
49− -- * Encoding Text using ByteString Builders
50− , encodeUtf8Builder
51− , encodeUtf8BuilderEscaped
52 ) where
49 ) where
53
50
54import Control.Exception (evaluate, try)
51import Control.Exception (evaluate, try)
55−import Data.Monoid (Monoid(..))
56import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
52import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
57import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldrChunks)
53import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldrChunks)
58−import Data.Word (Word8)
59import qualified Data.ByteString as S
54import qualified Data.ByteString as S
60−import qualified Data.ByteString.Builder as B
61−import qualified Data.ByteString.Builder.Extra as B (safeStrategy, toLazyByteStringWith)
62−import qualified Data.ByteString.Builder.Prim as BP
63import qualified Data.ByteString.Lazy as B
55import qualified Data.ByteString.Lazy as B
64import qualified Data.ByteString.Lazy.Internal as B
56import qualified Data.ByteString.Lazy.Internal as B
65import qualified Data.ByteString.Unsafe as B
57import qualified Data.ByteString.Unsafe as B
66−import qualified Data.Text as T
67import qualified Data.Text.Encoding as TE
58import qualified Data.Text.Encoding as TE
59+import qualified Data.Text.Lazy as L
68import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E
60import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E
69import qualified Data.Text.Internal.Lazy.Fusion as F
61import qualified Data.Text.Internal.Lazy.Fusion as F
70import Data.Text.Unsafe (unsafeDupablePerformIO)
62import Data.Text.Unsafe (unsafeDupablePerformIO)
@@ -84,6 +76,8 @@ import Data.Text.Unsafe (unsafeDupablePerformIO)
84
76
85-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
77-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
86-- encoded text.
78-- encoded text.
79+--
80+-- This function is deprecated. Use 'decodeLatin1' instead.
87decodeASCII :: B.ByteString -> Text
81decodeASCII :: B.ByteString -> Text
88decodeASCII = decodeUtf8
82decodeASCII = decodeUtf8
89{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
83{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
@@ -105,7 +99,7 @@ decodeUtf8With onErr (B.Chunk b0 bs0) =
105 | S.null l = empty
99 | S.null l = empty
106 | otherwise = case onErr desc (Just (B.unsafeHead l)) of
100 | otherwise = case onErr desc (Just (B.unsafeHead l)) of
107 Nothing -> empty
101 Nothing -> empty
108− Just c -> Chunk (T.singleton c) Empty
102+ Just c -> L.singleton c
109 desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"
103 desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"
110decodeUtf8With _ _ = empty
104decodeUtf8With _ _ = empty
111
105
@@ -142,26 +136,8 @@ decodeUtf8' bs = unsafeDupablePerformIO $ do
142{-# INLINE decodeUtf8' #-}
136{-# INLINE decodeUtf8' #-}
143
137
144encodeUtf8 :: Text -> B.ByteString
138encodeUtf8 :: Text -> B.ByteString
145−encodeUtf8 Empty = B.empty
139+encodeUtf8 (Chunk c cs) = B.Chunk (TE.encodeUtf8 c) (encodeUtf8 cs)
146−encodeUtf8 lt@(Chunk t _) =
140+encodeUtf8 Empty = B.Empty
147− B.toLazyByteStringWith strategy B.empty $ encodeUtf8Builder lt
148− where
149− -- To improve our small string performance, we use a strategy that
150− -- allocates a buffer that is guaranteed to be large enough for the
151− -- encoding of the first chunk, but not larger than the default
152− -- B.smallChunkSize. We clamp the firstChunkSize to ensure that we don't
153− -- generate too large buffers which hamper streaming.
154− firstChunkSize = min B.smallChunkSize (4 * (T.length t + 1))
155− strategy = B.safeStrategy firstChunkSize B.defaultChunkSize
156−
157−encodeUtf8Builder :: Text -> B.Builder
158−encodeUtf8Builder =
159− foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) Data.Monoid.mempty
160−
161−{-# INLINE encodeUtf8BuilderEscaped #-}
162−encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
163−encodeUtf8BuilderEscaped prim =
164− foldrChunks (\c b -> TE.encodeUtf8BuilderEscaped prim c `mappend` b) mempty
165
141
166-- | Decode text from little endian UTF-16 encoding.
142-- | Decode text from little endian UTF-16 encoding.
167decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text
143decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text
Data/Text/Lazy/Internal.hs+2−1
@@ -4,7 +4,8 @@
4-- Copyright : (c) 2013 Bryan O'Sullivan
4-- Copyright : (c) 2013 Bryan O'Sullivan
5--
5--
6-- License : BSD-style
6-- License : BSD-style
7−-- Maintainer : bos@serpentine.com
7+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
8+-- duncan@haskell.org
8-- Stability : experimental
9-- Stability : experimental
9-- Portability : GHC
10-- Portability : GHC
10--
11--
Data/Text/Lazy/Read.hs+33−8
@@ -1,7 +1,5 @@
1{-# LANGUAGE OverloadedStrings, CPP #-}
1{-# LANGUAGE OverloadedStrings, CPP #-}
2−#if __GLASGOW_HASKELL__ >= 704
2+#if __GLASGOW_HASKELL__ >= 702
3−{-# LANGUAGE Safe #-}
4−#elif __GLASGOW_HASKELL__ >= 702
5{-# LANGUAGE Trustworthy #-}
3{-# LANGUAGE Trustworthy #-}
6#endif
4#endif
7
5
@@ -26,17 +24,15 @@ module Data.Text.Lazy.Read
26 ) where
24 ) where
27
25
28import Control.Monad (liftM)
26import Control.Monad (liftM)
29−import Data.Char (isDigit, isHexDigit)
27+import Data.Char (isDigit, isHexDigit, ord)
30import Data.Int (Int8, Int16, Int32, Int64)
28import Data.Int (Int8, Int16, Int32, Int64)
31import Data.Ratio ((%))
29import Data.Ratio ((%))
32−import Data.Text.Internal.Read
33import Data.Text.Lazy as T
30import Data.Text.Lazy as T
34import Data.Word (Word, Word8, Word16, Word32, Word64)
31import Data.Word (Word, Word8, Word16, Word32, Word64)
35
32
36-- | Read some text. If the read succeeds, return its value and the
33-- | Read some text. If the read succeeds, return its value and the
37-- remaining text, otherwise an error message.
34-- remaining text, otherwise an error message.
38−type Reader a = IReader Text a
35+type Reader a = Text -> Either String (a,Text)
39−type Parser = IParser Text
40
36
41-- | Read a decimal integer. The input must begin with at least one
37-- | Read a decimal integer. The input must begin with at least one
42-- decimal digit, and is consumed until a non-digit or end of string
38-- decimal digit, and is consumed until a non-digit or end of string
@@ -56,7 +52,7 @@ decimal :: Integral a => Reader a
56{-# SPECIALIZE decimal :: Reader Int32 #-}
52{-# SPECIALIZE decimal :: Reader Int32 #-}
57{-# SPECIALIZE decimal :: Reader Int64 #-}
53{-# SPECIALIZE decimal :: Reader Int64 #-}
58{-# SPECIALIZE decimal :: Reader Integer #-}
54{-# SPECIALIZE decimal :: Reader Integer #-}
59−{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}
55+{-# SPECIALIZE decimal :: Reader Word #-}
60{-# SPECIALIZE decimal :: Reader Word8 #-}
56{-# SPECIALIZE decimal :: Reader Word8 #-}
61{-# SPECIALIZE decimal :: Reader Word16 #-}
57{-# SPECIALIZE decimal :: Reader Word16 #-}
62{-# SPECIALIZE decimal :: Reader Word32 #-}
58{-# SPECIALIZE decimal :: Reader Word32 #-}
@@ -105,6 +101,15 @@ hex txt
105 where (h,t) = T.span isHexDigit txt
101 where (h,t) = T.span isHexDigit txt
106 go n d = (n * 16 + fromIntegral (hexDigitToInt d))
102 go n d = (n * 16 + fromIntegral (hexDigitToInt d))
107
103
104+hexDigitToInt :: Char -> Int
105+hexDigitToInt c
106+ | c >= '0' && c <= '9' = ord c - ord '0'
107+ | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)
108+ | otherwise = ord c - (ord 'A' - 10)
109+
110+digitToInt :: Char -> Int
111+digitToInt c = ord c - ord '0'
112+
108-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and
113-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and
109-- apply it to the result of applying the given reader.
114-- apply it to the result of applying the given reader.
110signed :: Num a => Reader a -> Reader a
115signed :: Num a => Reader a -> Reader a
@@ -164,11 +169,31 @@ signa p = do
164 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
169 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
165 if sign == '+' then p else negate `liftM` p
170 if sign == '+' then p else negate `liftM` p
166
171
172+newtype Parser a = P {
173+ runP :: Reader a
174+ }
175+
176+instance Monad Parser where
177+ return a = P $ \t -> Right (a,t)
178+ {-# INLINE return #-}
179+ m >>= k = P $ \t -> case runP m t of
180+ Left err -> Left err
181+ Right (a,t') -> runP (k a) t'
182+ {-# INLINE (>>=) #-}
183+ fail msg = P $ \_ -> Left msg
184+
185+perhaps :: a -> Parser a -> Parser a
186+perhaps def m = P $ \t -> case runP m t of
187+ Left _ -> Right (def,t)
188+ r@(Right _) -> r
189+
167char :: (Char -> Bool) -> Parser Char
190char :: (Char -> Bool) -> Parser Char
168char p = P $ \t -> case T.uncons t of
191char p = P $ \t -> case T.uncons t of
169 Just (c,t') | p c -> Right (c,t')
192 Just (c,t') | p c -> Right (c,t')
170 _ -> Left "character does not match"
193 _ -> Left "character does not match"
171
194
195+data T = T !Integer !Int
196+
172floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a
197floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a
173{-# INLINE floaty #-}
198{-# INLINE floaty #-}
174floaty f = runP $ do
199floaty f = runP $ do
Data/Text/Read.hs+32−5
@@ -24,18 +24,16 @@ module Data.Text.Read
24 ) where
24 ) where
25
25
26import Control.Monad (liftM)
26import Control.Monad (liftM)
27−import Data.Char (isDigit, isHexDigit)
27+import Data.Char (isDigit, isHexDigit, ord)
28import Data.Int (Int8, Int16, Int32, Int64)
28import Data.Int (Int8, Int16, Int32, Int64)
29import Data.Ratio ((%))
29import Data.Ratio ((%))
30import Data.Text as T
30import Data.Text as T
31import Data.Text.Internal.Private (span_)
31import Data.Text.Internal.Private (span_)
32−import Data.Text.Internal.Read
33import Data.Word (Word, Word8, Word16, Word32, Word64)
32import Data.Word (Word, Word8, Word16, Word32, Word64)
34
33
35-- | Read some text. If the read succeeds, return its value and the
34-- | Read some text. If the read succeeds, return its value and the
36-- remaining text, otherwise an error message.
35-- remaining text, otherwise an error message.
37−type Reader a = IReader Text a
36+type Reader a = Text -> Either String (a,Text)
38−type Parser a = IParser Text a
39
37
40-- | Read a decimal integer. The input must begin with at least one
38-- | Read a decimal integer. The input must begin with at least one
41-- decimal digit, and is consumed until a non-digit or end of string
39-- decimal digit, and is consumed until a non-digit or end of string
@@ -55,7 +53,7 @@ decimal :: Integral a => Reader a
55{-# SPECIALIZE decimal :: Reader Int32 #-}
53{-# SPECIALIZE decimal :: Reader Int32 #-}
56{-# SPECIALIZE decimal :: Reader Int64 #-}
54{-# SPECIALIZE decimal :: Reader Int64 #-}
57{-# SPECIALIZE decimal :: Reader Integer #-}
55{-# SPECIALIZE decimal :: Reader Integer #-}
58−{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}
56+{-# SPECIALIZE decimal :: Reader Word #-}
59{-# SPECIALIZE decimal :: Reader Word8 #-}
57{-# SPECIALIZE decimal :: Reader Word8 #-}
60{-# SPECIALIZE decimal :: Reader Word16 #-}
58{-# SPECIALIZE decimal :: Reader Word16 #-}
61{-# SPECIALIZE decimal :: Reader Word32 #-}
59{-# SPECIALIZE decimal :: Reader Word32 #-}
@@ -113,6 +111,15 @@ hex txt
113 where (# h,t #) = span_ isHexDigit txt
111 where (# h,t #) = span_ isHexDigit txt
114 go n d = (n * 16 + fromIntegral (hexDigitToInt d))
112 go n d = (n * 16 + fromIntegral (hexDigitToInt d))
115
113
114+hexDigitToInt :: Char -> Int
115+hexDigitToInt c
116+ | c >= '0' && c <= '9' = ord c - ord '0'
117+ | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)
118+ | otherwise = ord c - (ord 'A' - 10)
119+
120+digitToInt :: Char -> Int
121+digitToInt c = ord c - ord '0'
122+
116-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and
123-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and
117-- apply it to the result of applying the given reader.
124-- apply it to the result of applying the given reader.
118signed :: Num a => Reader a -> Reader a
125signed :: Num a => Reader a -> Reader a
@@ -172,11 +179,31 @@ signa p = do
172 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
179 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
173 if sign == '+' then p else negate `liftM` p
180 if sign == '+' then p else negate `liftM` p
174
181
182+newtype Parser a = P {
183+ runP :: Reader a
184+ }
185+
186+instance Monad Parser where
187+ return a = P $ \t -> Right (a,t)
188+ {-# INLINE return #-}
189+ m >>= k = P $ \t -> case runP m t of
190+ Left err -> Left err
191+ Right (a,t') -> runP (k a) t'
192+ {-# INLINE (>>=) #-}
193+ fail msg = P $ \_ -> Left msg
194+
195+perhaps :: a -> Parser a -> Parser a
196+perhaps def m = P $ \t -> case runP m t of
197+ Left _ -> Right (def,t)
198+ r@(Right _) -> r
199+
175char :: (Char -> Bool) -> Parser Char
200char :: (Char -> Bool) -> Parser Char
176char p = P $ \t -> case T.uncons t of
201char p = P $ \t -> case T.uncons t of
177 Just (c,t') | p c -> Right (c,t')
202 Just (c,t') | p c -> Right (c,t')
178 _ -> Left "character does not match"
203 _ -> Left "character does not match"
179
204
205+data T = T !Integer !Int
206+
180floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a
207floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a
181{-# INLINE floaty #-}
208{-# INLINE floaty #-}
182floaty f = runP $ do
209floaty f = runP $ do
Data/Text/Show.hsdeleted−89
@@ -1,89 +0,0 @@
1−{-# LANGUAGE CPP, MagicHash #-}
2−{-# OPTIONS_GHC -fno-warn-orphans #-}
3−#if __GLASGOW_HASKELL__ >= 702
4−{-# LANGUAGE Trustworthy #-}
5−#endif
6−
7−-- |
8−-- Module : Data.Text.Show
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+2−12
@@ -3,7 +3,8 @@
3-- Module : Data.Text.Unsafe
3-- Module : Data.Text.Unsafe
4-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
4-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
5-- License : BSD-style
5-- License : BSD-style
6−-- Maintainer : bos@serpentine.com
6+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
7+-- duncan@haskell.org
7-- Stability : experimental
8-- Stability : experimental
8-- Portability : portable
9-- Portability : portable
9--
10--
@@ -18,7 +19,6 @@ module Data.Text.Unsafe
18 , iter
19 , iter
19 , iter_
20 , iter_
20 , reverseIter
21 , reverseIter
21− , reverseIter_
22 , unsafeHead
22 , unsafeHead
23 , unsafeTail
23 , unsafeTail
24 , lengthWord16
24 , lengthWord16
@@ -95,16 +95,6 @@ reverseIter (Text arr off _len) i
95 k = j - 1
95 k = j - 1
96{-# INLINE reverseIter #-}
96{-# INLINE reverseIter #-}
97
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−
108-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
98-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
109-- is useful for sizing a target array appropriately before using
99-- is useful for sizing a target array appropriately before using
110-- 'unsafeCopyToPtr'.
100-- 'unsafeCopyToPtr'.
benchmarks/haskell/Benchmarks.hs+1−6
@@ -15,7 +15,6 @@ 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
19import qualified Benchmarks.Pure as Pure
18import qualified Benchmarks.Pure as Pure
20import qualified Benchmarks.ReadNumbers as ReadNumbers
19import qualified Benchmarks.ReadNumbers as ReadNumbers
21import qualified Benchmarks.Replace as Replace
20import qualified Benchmarks.Replace as Replace
@@ -50,11 +49,7 @@ benchmarks = do
50 , Equality.benchmark (tf "japanese.txt")
49 , Equality.benchmark (tf "japanese.txt")
51 , FileRead.benchmark (tf "russian.txt")
50 , FileRead.benchmark (tf "russian.txt")
52 , FoldLines.benchmark (tf "russian.txt")
51 , FoldLines.benchmark (tf "russian.txt")
53− , Mul.benchmark
54− , Pure.benchmark "tiny" (tf "tiny.txt")
52+ , Pure.benchmark "tiny "(tf "tiny.txt")
55− , Pure.benchmark "ascii" (tf "ascii-small.txt")
56− -- , Pure.benchmark "france" (tf "france.html")
57− , Pure.benchmark "russian" (tf "russian-small.txt")
58 , Pure.benchmark "japanese" (tf "japanese.txt")
53 , Pure.benchmark "japanese" (tf "japanese.txt")
59 , ReadNumbers.benchmark (tf "numbers.txt")
54 , ReadNumbers.benchmark (tf "numbers.txt")
60 , Replace.benchmark (tf "russian.txt") "принимая" "своем"
55 , Replace.benchmark (tf "russian.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, whnfIO)
28+import Criterion (Benchmark, bgroup, nf)
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" $ whnfIO $ iconv bs
51+ , bench "IConv" $ 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.Applicative ((<$>))
11+import Control.Exception (evaluate)
12−import Criterion (Benchmark, bgroup, bench, whnfIO)
12+import Criterion (Benchmark, bgroup, bench)
13import qualified Data.ByteString as SB
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" $ whnfIO $ length <$> readFile p
24+ [ bench "String" $ readFile p >>= evaluate . length
25− , bench "ByteString" $ whnfIO $ SB.length <$> SB.readFile p
25+ , bench "ByteString" $ SB.readFile p >>= evaluate . SB.length
26− , bench "LazyByteString" $ whnfIO $ LB.length <$> LB.readFile p
26+ , bench "LazyByteString" $ LB.readFile p >>= evaluate . LB.length
27− , bench "Text" $ whnfIO $ T.length <$> T.readFile p
27+ , bench "Text" $ T.readFile p >>= evaluate . T.length
28− , bench "LazyText" $ whnfIO $ LT.length <$> LT.readFile p
28+ , bench "LazyText" $ LT.readFile p >>= evaluate . LT.length
29− , bench "TextByteString" $ whnfIO $
29+ , bench "TextByteString" $
30− (T.length . T.decodeUtf8) <$> SB.readFile p
30+ SB.readFile p >>= evaluate . T.length . T.decodeUtf8
31− , bench "LazyTextByteString" $ whnfIO $
31+ , bench "LazyTextByteString" $
32− (LT.length . LT.decodeUtf8) <$> LB.readFile p
32+ LB.readFile p >>= evaluate . LT.length . LT.decodeUtf8
33 ]
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, whnfIO)
13+import Criterion (Benchmark, bgroup, bench)
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 = whnfIO $ do
25+ withHandle f = 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.hsdeleted−138
@@ -1,138 +0,0 @@
1−module Benchmarks.Mul (benchmark) where
2−
3−import Control.Exception (evaluate)
4−import Criterion.Main
5−import Data.Int (Int32, Int64)
6−import Data.Text.Internal (mul32, mul64)
7−import qualified Data.Vector.Unboxed as U
8−
9−oldMul :: Int64 -> Int64 -> Int64
10−oldMul m n
11− | n == 0 = 0
12− | m <= maxBound `quot` n = m * n
13− | otherwise = error "overflow"
14−
15−benchmark :: IO Benchmark
16−benchmark = do
17− _ <- evaluate testVector32
18− _ <- evaluate testVector64
19− return $ bgroup "Mul" [
20− bench "oldMul" $ whnf (U.map (uncurry oldMul)) testVector64
21− , bench "mul64" $ whnf (U.map (uncurry mul64)) testVector64
22− , bench "*64" $ whnf (U.map (uncurry (*))) testVector64
23− , bench "mul32" $ whnf (U.map (uncurry mul32)) testVector32
24− , bench "*32" $ whnf (U.map (uncurry (*))) testVector32
25− ]
26−
27−testVector64 :: U.Vector (Int64,Int64)
28−testVector64 = U.fromList [
29− (0,1248868987182846646),(169004623633872,24458),(482549039517835,7614),
30− (372,8157063115504364),(27,107095594861148252),(3,63249878517962420),
31− (4363,255694473572912),(86678474,1732634806),(1572453024,1800489338),
32− (9384523143,77053781),(49024709555,75095046),(7,43457620410239131),
33− (8,8201563008844571),(387719037,1520696708),(189869238220197,1423),
34− (46788016849611,23063),(503077742109974359,0),(104,1502010908706487),
35− (30478140346,207525518),(80961140129236192,14),(4283,368012829143675),
36− (1028719181728108146,6),(318904,5874863049591),(56724427166898,110794),
37− (234539368,31369110449),(2,251729663598178612),(103291548194451219,5),
38− (76013,5345328755566),(1769631,2980846129318),(40898,60598477385754),
39− (0,98931348893227155),(573555872156917492,3),(318821187115,4476566),
40− (11152874213584,243582),(40274276,16636653248),(127,4249988676030597),
41− (103543712111871836,5),(71,16954462148248238),(3963027173504,216570),
42− (13000,503523808916753),(17038308,20018685905),(0,510350226577891549),
43− (175898,3875698895405),(425299191292676,5651),(17223451323664536,50),
44− (61755131,14247665326),(0,1018195131697569303),(36433751497238985,20),
45− (3473607861601050,1837),(1392342328,1733971838),(225770297367,3249655),
46− (14,127545244155254102),(1751488975299136,2634),(3949208,504190668767),
47− (153329,831454434345),(1066212122928663658,2),(351224,2663633539556),
48− (344565,53388869217),(35825609350446863,54),(276011553660081475,10),
49− (1969754174790470349,3),(35,68088438338633),(506710,3247689556438),
50− (11099382291,327739909),(105787303549,32824363),(210366111,14759049409),
51− (688893241579,3102676),(8490,70047474429581),(152085,29923000251880),
52− (5046974599257095,400),(4183167795,263434071),(10089728,502781960687),
53− (44831977765,4725378),(91,8978094664238578),(30990165721,44053350),
54− (1772377,149651820860),(243420621763408572,4),(32,5790357453815138),
55− (27980806337993771,5),(47696295759774,20848),(1745874142313778,1098),
56− (46869334770121,1203),(886995283,1564424789),(40679396544,76002479),
57− (1,672849481568486995),(337656187205,3157069),(816980552858963,6003),
58− (2271434085804831543,1),(0,1934521023868747186),(6266220038281,15825),
59− (4160,107115946987394),(524,246808621791561),(0,1952519482439636339),
60− (128,2865935904539691),(1044,3211982069426297),(16000511542473,88922),
61− (1253596745404082,2226),(27041,56836278958002),(23201,49247489754471),
62− (175906590497,21252392),(185163584757182295,24),(34742225226802197,150),
63− (2363228,250824838408),(216327527109550,45),(24,81574076994520675),
64− (28559899906542,15356),(10890139774837133,511),(2293,707179303654492),
65− (2749366833,40703233),(0,4498229704622845986),(439,4962056468281937),
66− (662,1453820621089921),(16336770612459631,220),(24282989393,74239137),
67− (2724564648490195,3),(743672760,124992589),(4528103,704330948891),
68− (6050483122491561,250),(13322953,13594265152),(181794,22268101450214),
69− (25957941712,75384092),(43352,7322262295009),(32838,52609059549923),
70− (33003585202001564,2),(103019,68430142267402),(129918230800,8742978),
71− (0,2114347379589080688),(2548,905723041545274),(222745067962838382,0),
72− (1671683850790425181,1),(455,4836932776795684),(794227702827214,6620),
73− (212534135175874,1365),(96432431858,29784975),(466626763743380,3484),
74− (29793949,53041519613),(8359,309952753409844),(3908960585331901,26),
75− (45185288970365760,114),(10131829775,68110174),(58039242399640479,83),
76− (628092278238719399,6),(1,196469106875361889),(302336625,16347502444),
77− (148,3748088684181047),(1,1649096568849015456),(1019866864,2349753026),
78− (8211344830,569363306),(65647579546873,34753),(2340190,1692053129069),
79− (64263301,30758930355),(48681618072372209,110),(7074794736,47640197),
80− (249634721521,7991792),(1162917363807215,232),(7446433349,420634045),
81− (63398619383,60709817),(51359004508011,14200),(131788797028647,7072),
82− (52079887791430043,7),(7,136277667582599838),(28582879735696,50327),
83− (1404582800566278,833),(469164435,15017166943),(99567079957578263,49),
84− (1015285971,3625801566),(321504843,4104079293),(5196954,464515406632),
85− (114246832260876,7468),(8149664437,487119673),(12265299,378168974869),
86− (37711995764,30766513),(3971137243,710996152),(483120070302,603162),
87− (103009942,61645547145),(8476344625340,6987),(547948761229739,1446),
88− (42234,18624767306301),(13486714173011,58948),(4,198309153268019840),
89− (9913176974,325539248),(28246225540203,116822),(2882463945582154,18),
90− (959,25504987505398),(3,1504372236378217710),(13505229956793,374987),
91− (751661959,457611342),(27375926,36219151769),(482168869,5301952074),
92− (1,1577425863241520640),(714116235611821,1164),(904492524250310488,0),
93− (5983514941763398,68),(10759472423,23540686),(72539568471529,34919),
94− (4,176090672310337473),(938702842110356453,1),(673652445,3335287382),
95− (3111998893666122,917),(1568013,3168419765469)]
96−
97−testVector32 :: U.Vector (Int32,Int32)
98−testVector32 = U.fromList [
99− (39242,410),(0,100077553),(2206,9538),(509400240,1),(38048,6368),
100− (1789,651480),(2399,157032),(701,170017),(5241456,14),(11212,70449),
101− (1,227804876),(749687254,1),(74559,2954),(1158,147957),(410604456,1),
102− (170851,1561),(92643422,1),(6192,180509),(7,24202210),(3440,241481),
103− (5753677,5),(294327,1622),(252,4454673),(127684121,11),(28315800,30),
104− (340370905,0),(1,667887987),(592782090,1),(49023,27641),(750,290387),
105− (72886,3847),(0,301047933),(3050276,473),(1,788366142),(59457,15813),
106− (637726933,1),(1135,344317),(853616,264),(696816,493),(7038,12046),
107− (125219574,4),(803694088,1),(107081726,1),(39294,21699),(16361,38191),
108− (132561123,12),(1760,23499),(847543,484),(175687349,1),(2963,252678),
109− (6248,224553),(27596,4606),(5422922,121),(1542,485890),(131,583035),
110− (59096,4925),(3637115,132),(0,947225435),(86854,6794),(2984745,339),
111− (760129569,1),(1,68260595),(380835652,2),(430575,2579),(54514,7211),
112− (15550606,3),(9,27367402),(3007053,207),(7060988,60),(28560,27130),
113− (1355,21087),(10880,53059),(14563646,4),(461886361,1),(2,169260724),
114− (241454126,2),(406797,1),(61631630,16),(44473,5943),(63869104,12),
115− (950300,1528),(2113,62333),(120817,9358),(100261456,1),(426764723,1),
116− (119,12723684),(3,53358711),(4448071,18),(1,230278091),(238,232102),
117− (8,57316440),(42437979,10),(6769,19555),(48590,22006),(11500585,79),
118− (2808,97638),(42,26952545),(11,32104194),(23954638,1),(785427272,0),
119− (513,81379),(31333960,37),(897772,1009),(4,25679692),(103027993,12),
120− (104972702,11),(546,443401),(7,65137092),(88574269,3),(872139069,0),
121− (2,97417121),(378802603,0),(141071401,4),(22613,10575),(2191743,118),
122− (470,116119),(7062,38166),(231056,1847),(43901963,9),(2400,70640),
123− (63553,1555),(34,11249573),(815174,1820),(997894011,0),(98881794,2),
124− (5448,43132),(27956,9),(904926,1357),(112608626,3),(124,613021),
125− (282086,1966),(99,10656881),(113799,1501),(433318,2085),(442,948171),
126− (165380,1043),(28,14372905),(14880,50462),(2386,219918),(229,1797565),
127− (1174961,298),(3925,41833),(3903515,299),(15690452,111),(360860521,3),
128− (7440846,81),(2541026,507),(0,492448477),(6869,82469),(245,8322939),
129− (3503496,253),(123495298,0),(150963,2299),(33,4408482),(1,200911107),
130− (305,252121),(13,123369189),(215846,8181),(2440,65387),(776764401,1),
131− (1241172,434),(8,15493155),(81953961,6),(17884993,5),(26,6893822),
132− (0,502035190),(1,582451018),(2,514870139),(227,3625619),(49,12720258),
133− (1456769,207),(94797661,10),(234407,893),(26843,5783),(15688,24547),
134− (4091,86268),(4339448,151),(21360,6294),(397046497,2),(1227,205936),
135− (9966,21959),(160046791,1),(0,159992224),(27,24974797),(19177,29334),
136− (4136148,42),(21179785,53),(61256583,31),(385,344176),(7,11934915),
137− (1,18992566),(3488065,5),(768021,224),(36288474,7),(8624,117561),
138− (8,20341439),(5903,261475),(561,1007618),(1738,392327),(633049,1708)]
benchmarks/haskell/Benchmarks/Programs/BigTable.hs+2−2
@@ -11,7 +11,7 @@ module Benchmarks.Programs.BigTable
11 ( benchmark
11 ( benchmark
12 ) where
12 ) where
13
13
14−import Criterion (Benchmark, bench, whnfIO)
14+import Criterion (Benchmark, bench)
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" $ whnfIO $ do
22+benchmark sink = return $ bench "BigTable" $ 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, whnfIO)
19+import Criterion (Benchmark, bgroup, bench)
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 $ whnfIO (s p sink from to)
43+ bench' n s = bench n (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, whnfIO)
24+import Criterion (Benchmark, bench)
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" $ whnfIO $ T.readFile i >>= TL.hPutStr o . fold 80
33+ bench "Fold" $ 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+9−10
@@ -17,7 +17,7 @@ module Benchmarks.Programs.Sort
17 ( benchmark
17 ( benchmark
18 ) where
18 ) where
19
19
20−import Criterion (Benchmark, bgroup, bench, whnfIO)
20+import Criterion (Benchmark, bgroup, bench)
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,17 +35,16 @@ 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" $ whnfIO $ readFile i >>= hPutStr o . string
38+ [ bench "String" $ readFile i >>= hPutStr o . string
39− , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString
39+ , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString
40− , bench "LazyByteString" $ whnfIO $
41− BL.readFile i >>= BL.hPutStr o . lazyByteString
40+ , bench "LazyByteString" $ BL.readFile i >>= BL.hPutStr o . lazyByteString
42− , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text
41+ , bench "Text" $ T.readFile i >>= T.hPutStr o . text
43− , bench "LazyText" $ whnfIO $ TL.readFile i >>= TL.hPutStr o . lazyText
42+ , bench "LazyText" $ TL.readFile i >>= TL.hPutStr o . lazyText
44− , bench "TextByteString" $ whnfIO $ B.readFile i >>=
43+ , bench "TextByteString" $ B.readFile i >>=
45 B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8
44 B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8
46− , bench "LazyTextByteString" $ whnfIO $ BL.readFile i >>=
45+ , bench "LazyTextByteString" $ BL.readFile i >>=
47 BL.hPutStr o . TL.encodeUtf8 . lazyText . TL.decodeUtf8
46 BL.hPutStr o . TL.encodeUtf8 . lazyText . TL.decodeUtf8
48− , bench "TextBuilder" $ whnfIO $ B.readFile i >>=
47+ , bench "TextBuilder" $ B.readFile i >>=
49 BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8
48 BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8
50 ]
49 ]
51
50
benchmarks/haskell/Benchmarks/Programs/StripTags.hs+5−5
@@ -15,7 +15,7 @@ module Benchmarks.Programs.StripTags
15 ( benchmark
15 ( benchmark
16 ) where
16 ) where
17
17
18−import Criterion (Benchmark, bgroup, bench, whnfIO)
18+import Criterion (Benchmark, bgroup, bench)
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" $ whnfIO $ readFile i >>= hPutStr o . string
29+ [ bench "String" $ readFile i >>= hPutStr o . string
30− , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString
30+ , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString
31− , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text
31+ , bench "Text" $ T.readFile i >>= T.hPutStr o . text
32− , bench "TextByteString" $ whnfIO $
32+ , bench "TextByteString" $
33 B.readFile i >>= B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8
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, whnfIO)
21+import Criterion (Benchmark, bgroup, bench)
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" $ whnfIO $ readFile fp >>= hPutStr sink
32+ [ bench "String" $ readFile fp >>= hPutStr sink
33− , bench "ByteString" $ whnfIO $ B.readFile fp >>= B.hPutStr sink
33+ , bench "ByteString" $ B.readFile fp >>= B.hPutStr sink
34− , bench "LazyByteString" $ whnfIO $ BL.readFile fp >>= BL.hPutStr sink
34+ , bench "LazyByteString" $ BL.readFile fp >>= BL.hPutStr sink
35− , bench "Text" $ whnfIO $ T.readFile fp >>= T.hPutStr sink
35+ , bench "Text" $ T.readFile fp >>= T.hPutStr sink
36− , bench "LazyText" $ whnfIO $ TL.readFile fp >>= TL.hPutStr sink
36+ , bench "LazyText" $ TL.readFile fp >>= TL.hPutStr sink
37− , bench "TextByteString" $ whnfIO $
37+ , bench "TextByteString" $
38 B.readFile fp >>= B.hPutStr sink . T.encodeUtf8 . T.decodeUtf8
38 B.readFile fp >>= B.hPutStr sink . T.encodeUtf8 . T.decodeUtf8
39− , bench "LazyTextByteString" $ whnfIO $
39+ , bench "LazyTextByteString" $
40 BL.readFile fp >>= BL.hPutStr sink . TL.encodeUtf8 . TL.decodeUtf8
40 BL.readFile fp >>= BL.hPutStr sink . TL.encodeUtf8 . TL.decodeUtf8
41 ]
41 ]
benchmarks/haskell/Benchmarks/Pure.hs−7
@@ -262,13 +262,6 @@ 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− ]
272 , bgroup "words"
265 , bgroup "words"
273 [ benchT $ nf T.words ta
266 [ benchT $ nf T.words ta
274 , benchTL $ nf TL.words tla
267 , benchTL $ nf TL.words tla
benchmarks/haskell/Benchmarks/ReadNumbers.hs+5−2
@@ -25,7 +25,8 @@ import Data.List (foldl')
25import Numeric (readDec, readFloat, readHex)
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.Fractional as B
28+import qualified Data.ByteString.Lex.Double as B
29+import qualified Data.ByteString.Lex.Lazy.Double as BL
29import qualified Data.Text as T
30import qualified Data.Text as T
30import qualified Data.Text.IO as T
31import qualified Data.Text.IO as T
31import qualified Data.Text.Lazy as TL
32import qualified Data.Text.Lazy as TL
@@ -62,10 +63,12 @@ benchmark fp = do
62 whnf (double . text TL.rational) tl
63 whnf (double . text TL.rational) tl
63
64
64 , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b
65 , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b
65− , bench "DoubleByteString" $ whnf (double . byteString B.readDecimal) b
66+ , bench "DoubleByteString" $ whnf (double . byteString B.readDouble) b
66
67
67 , bench "DecimalLazyByteString" $
68 , bench "DecimalLazyByteString" $
68 whnf (int . byteString BL.readInt) bl
69 whnf (int . byteString BL.readInt) bl
70+ , bench "DoubleLazyByteString" $
71+ whnf (double . byteString BL.readDouble) bl
69 ]
72 ]
70 where
73 where
71 -- Used for fixing types
74 -- Used for fixing types
benchmarks/haskell/Benchmarks/Stream.hs+5−16
@@ -18,11 +18,11 @@ import qualified Data.Text.Encoding as T
18import qualified Data.Text.Encoding.Error as E
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 F
21+import qualified Data.Text.Internal.Fusion as T
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 FL
25+import qualified Data.Text.Internal.Lazy.Fusion as TL
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,25 +53,14 @@ 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 = F.stream t
56+ let !s = T.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 F.stream t
62+ [ bench "Text" $ nf T.stream t
63− , bench "LazyText" $ nf FL.stream tl
63+ , bench "LazyText" $ nf TL.stream tl
64− ]
65− -- must perform exactly the same as stream above due to
66− -- stream/unstream (i.e. stream after unstream) fusion
67− , bgroup "stream-fusion" $
68− [ bench "Text" $ nf (F.stream . F.unstream . F.stream) t
69− , bench "LazyText" $ nf (FL.stream . FL.unstream . FL.stream) tl
70− ]
71− -- measure the overhead of unstream after stream
72− , bgroup "stream-unstream" $
73− [ bench "Text" $ nf (F.unstream . F.stream) t
74− , bench "LazyText" $ nf (FL.unstream . FL.stream) tl
75 ]
64 ]
76
65
77 -- Encoding.Fusion
66 -- Encoding.Fusion
benchmarks/text-benchmarks.cabal+6−18
@@ -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: BSD2
6+license: BSD3
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,15 +15,9 @@ 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−
23flag llvm
18flag llvm
24 description: use LLVM
19 description: use LLVM
25 default: False
20 default: False
26− manual: True
27
21
28executable text-benchmarks
22executable text-benchmarks
29 hs-source-dirs: haskell ..
23 hs-source-dirs: haskell ..
@@ -31,30 +25,24 @@ executable text-benchmarks
31 cbits/time_iconv.c
25 cbits/time_iconv.c
32 include-dirs: ../include
26 include-dirs: ../include
33 main-is: Benchmarks.hs
27 main-is: Benchmarks.hs
34− ghc-options: -Wall -O2 -rtsopts
28+ ghc-options: -Wall -O2
35 if flag(llvm)
29 if flag(llvm)
36 ghc-options: -fllvm
30 ghc-options: -fllvm
37 cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP
31 cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP
38 build-depends: base == 4.*,
32 build-depends: base == 4.*,
39 binary,
33 binary,
40 blaze-builder,
34 blaze-builder,
41− bytestring-lexing >= 0.5.0,
35+ bytestring,
36+ bytestring-lexing,
42 containers,
37 containers,
43− criterion >= 0.10.0.0,
38+ criterion >= 0.6.0.1,
44 deepseq,
39 deepseq,
45 directory,
40 directory,
46 filepath,
41 filepath,
47 ghc-prim,
42 ghc-prim,
48 integer-gmp,
43 integer-gmp,
49 stringsearch,
44 stringsearch,
50− utf8-string,
45+ utf8-string
51− vector
52−
53− if flag(bytestring-builder)
54− build-depends: bytestring >= 0.9 && < 0.10.4,
55− bytestring-builder >= 0.10.4
56− else
57− build-depends: bytestring >= 0.10.4
58
46
59executable text-multilang
47executable text-multilang
60 hs-source-dirs: haskell
48 hs-source-dirs: haskell
cbits/cbits.c+12−113
@@ -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 *src,
71+_hs_text_decode_latin1(uint16_t *dest, const uint8_t const *src,
72− const uint8_t *srcend)
72+ const uint8_t const *srcend)
73{
73{
74 const uint8_t *p = src;
74 const uint8_t *p = src;
75
75
@@ -127,18 +127,11 @@ _hs_text_decode_latin1(uint16_t *dest, const uint8_t *src,
127 * state0 != UTF8_ACCEPT, UTF8_REJECT
127 * state0 != UTF8_ACCEPT, UTF8_REJECT
128 *
128 *
129 */
129 */
130−#if defined(__GNUC__) || defined(__clang__)
130+const uint8_t *
131−static inline uint8_t const *
132−_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,
131+_hs_text_decode_utf8_state(uint16_t *const dest, size_t *destoff,
133− const uint8_t **src, const uint8_t *srcend,
132+ const uint8_t **const src,
134− uint32_t *codepoint0, uint32_t *state0)
135− __attribute((always_inline));
136−#endif
137−
138−static inline uint8_t const *
139−_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,
140− const uint8_t **src, const uint8_t *srcend,
133+ const uint8_t *const srcend,
141− uint32_t *codepoint0, uint32_t *state0)
134+ uint32_t *codepoint0, uint32_t *state0)
142{
135{
143 uint16_t *d = dest + *destoff;
136 uint16_t *d = dest + *destoff;
144 const uint8_t *s = *src, *last = *src;
137 const uint8_t *s = *src, *last = *src;
@@ -192,6 +185,10 @@ _hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,
192 last = s;
185 last = s;
193 }
186 }
194
187
188+ /* Invalid encoding, back up to the errant character */
189+ if (state == UTF8_REJECT)
190+ s -= 1;
191+
195 *destoff = d - dest;
192 *destoff = d - dest;
196 *codepoint0 = codepoint;
193 *codepoint0 = codepoint;
197 *state0 = state;
194 *state0 = state;
@@ -200,19 +197,6 @@ _hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,
200 return s;
197 return s;
201}
198}
202
199
203−uint8_t const *
204−_hs_text_decode_utf8_state(uint16_t *const dest, size_t *destoff,
205− const uint8_t **src,
206− const uint8_t *srcend,
207− uint32_t *codepoint0, uint32_t *state0)
208−{
209− uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, src, srcend,
210− codepoint0, state0);
211− if (*state0 == UTF8_REJECT)
212− ret -=1;
213− return ret;
214−}
215−
216/*
200/*
217 * Helper to decode buffer and discard final decoder state
201 * Helper to decode buffer and discard final decoder state
218 */
202 */
@@ -222,90 +206,5 @@ _hs_text_decode_utf8(uint16_t *const dest, size_t *destoff,
222{
206{
223 uint32_t codepoint;
207 uint32_t codepoint;
224 uint32_t state = UTF8_ACCEPT;
208 uint32_t state = UTF8_ACCEPT;
225− uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, &src, srcend,
209+ return _hs_text_decode_utf8_state(dest, destoff, &src, srcend, &codepoint, &state);
226− &codepoint, &state);
227− /* Back up if we have an incomplete or invalid encoding */
228− if (state != UTF8_ACCEPT)
229− ret -= 1;
230− return ret;
231−}
232−
233−void
234−_hs_text_encode_utf8(uint8_t **destp, const uint16_t *src, size_t srcoff,
235− size_t srclen)
236−{
237− const uint16_t *srcend;
238− uint8_t *dest = *destp;
239−
240− src += srcoff;
241− srcend = src + srclen;
242−
243− ascii:
244−#if defined(__x86_64__)
245− while (srcend - src >= 4) {
246− uint64_t w = *((uint64_t *) src);
247−
248− if (w & 0xFF80FF80FF80FF80ULL) {
249− if (!(w & 0x000000000000FF80ULL)) {
250− *dest++ = w & 0xFFFF;
251− src++;
252− if (!(w & 0x00000000FF800000ULL)) {
253− *dest++ = (w >> 16) & 0xFFFF;
254− src++;
255− if (!(w & 0x0000FF8000000000ULL)) {
256− *dest++ = (w >> 32) & 0xFFFF;
257− src++;
258− }
259− }
260− }
261− break;
262− }
263− *dest++ = w & 0xFFFF;
264− *dest++ = (w >> 16) & 0xFFFF;
265− *dest++ = (w >> 32) & 0xFFFF;
266− *dest++ = w >> 48;
267− src += 4;
268− }
269−#endif
270−
271−#if defined(__i386__)
272− while (srcend - src >= 2) {
273− uint32_t w = *((uint32_t *) src);
274−
275− if (w & 0xFF80FF80)
276− break;
277− *dest++ = w & 0xFFFF;
278− *dest++ = w >> 16;
279− src += 2;
280− }
281−#endif
282−
283− while (src < srcend) {
284− uint16_t w = *src++;
285−
286− if (w <= 0x7F) {
287− *dest++ = w;
288− /* An ASCII byte is likely to begin a run of ASCII bytes.
289− Falling back into the fast path really helps performance. */
290− goto ascii;
291− }
292− else if (w <= 0x7FF) {
293− *dest++ = (w >> 6) | 0xC0;
294− *dest++ = (w & 0x3f) | 0x80;
295− }
296− else if (w < 0xD800 || w > 0xDBFF) {
297− *dest++ = (w >> 12) | 0xE0;
298− *dest++ = ((w >> 6) & 0x3F) | 0x80;
299− *dest++ = (w & 0x3F) | 0x80;
300− } else {
301− uint32_t c = ((((uint32_t) w) - 0xD800) << 10) +
302− (((uint32_t) *src++) - 0xDC00) + 0x10000;
303− *dest++ = (c >> 18) | 0xF0;
304− *dest++ = ((c >> 12) & 0x3F) | 0x80;
305− *dest++ = ((c >> 6) & 0x3F) | 0x80;
306− *dest++ = (c & 0x3F) | 0x80;
307− }
308− }
309−
310− *destp = dest;
311}
210}
changelognew file+16
@@ -0,0 +1,16 @@
1+1.0.0.0
2+
3+ * Added support for Unicode 6.3.0 to case conversion functions
4+
5+ * New function toTitle converts words in a string to title case
6+
7+ * New functions peekCStringLen and withCStringLen simplify
8+ interoperability with C functionns
9+
10+ * Added support for decoding UTF-8 in stream-friendly fashion
11+
12+ * Fixed a bug in mapAccumL
13+
14+ * Added trusted Haskell support
15+
16+ * Removed support for GHC 6.10 (released in 2008) and older
changelog.mddeleted−164
@@ -1,164 +0,0 @@
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− ,"{-# NOINLINE foldMapping #-}"]
40+ ,"{-# INLINE 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/Internal/Fusion/CaseMapping.hs"
11+ [] -> "../Data/Text/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/CaseMapping.hs"] ++
27+ ,"-- Generated by scripts/SpecialCasing.hs"] ++
28 comments ++
28 comments ++
29 [""
29 [""
30− ,"module Data.Text.Internal.Fusion.CaseMapping where"
30+ ,"module Data.Text.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− ,"{-# NOINLINE " ++ which ++ "Mapping #-}"]
46+ ,"{-# INLINE " ++ 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.hsdeleted−21
@@ -1,21 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−
3−module LiteralRuleTest where
4−
5−import Data.Text (Text)
6−
7−-- This should produce 8 firings of the "TEXT literal" rule
8−strings :: [Text]
9−strings = [ "abstime", "aclitem", "bit", "bool", "box", "bpchar", "bytea", "char" ]
10−
11−-- This should produce 7 firings of the "TEXT literal UTF8" rule
12−utf8Strings :: [Text]
13−utf8Strings = [ "\0abstime", "\0aclitem", "\xfefe bit", "\0bool", "\0box", "\0bpchar", "\0bytea" ]
14−
15−-- This should produce 4 firings of the "TEXT empty literal" rule
16−empties :: [Text]
17−empties = [ "", "", "", "" ]
18−
19−-- This should produce 5 firings of the "TEXT empty literal" rule
20−--singletons :: [Text]
21−--singletons = [ "a", "b", "c", "d", "e" ]
tests/Makefile+1−6
@@ -1,10 +1,5 @@
1count = 1000
1count = 1000
2
2
3−all: coverage literal-rule-test
4−
5−literal-rule-test:
6− ./literal-rule-test.sh
7−
8coverage: build coverage/hpc_index.html
3coverage: build coverage/hpc_index.html
9
4
10build: text-test-data
5build: text-test-data
@@ -37,4 +32,4 @@ coverage/hpc_index.html: coverage/coverage.tix
37clean:
32clean:
38 rm -rf dist coverage .hpc
33 rm -rf dist coverage .hpc
39
34
40−.PHONY: build coverage all literal-rule-test
35+.PHONY: build coverage
tests/Tests/Properties.hs+86−226
@@ -1,61 +1,64 @@
1−-- | QuickCheck properties for the text library.
1+-- | General quicktest properties for the text library
2−
2+--
3−{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
3+{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, OverloadedStrings,
4 ScopedTypeVariables, TypeSynonymInstances #-}
4 ScopedTypeVariables, TypeSynonymInstances #-}
5−{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}
5+{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}
6+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
6module Tests.Properties
7module Tests.Properties
7 (
8 (
8 tests
9 tests
9 ) where
10 ) where
10
11
11−import Control.Applicative ((<$>), (<*>))
12+import Test.QuickCheck
13+import Test.QuickCheck.Monadic
14+import Text.Show.Functions ()
15+
12import Control.Arrow ((***), second)
16import Control.Arrow ((***), second)
13−import Data.Bits ((.&.))
17+import Control.Exception (catch)
14import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
18import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
15import Data.Int (Int8, Int16, Int32, Int64)
19import Data.Int (Int8, Int16, Int32, Int64)
16import Data.Monoid (Monoid(..))
20import Data.Monoid (Monoid(..))
17−import Data.String (IsString(fromString))
21+import Data.String (fromString)
18import Data.Text.Encoding.Error
22import Data.Text.Encoding.Error
19import Data.Text.Foreign
23import Data.Text.Foreign
20−import Data.Text.Internal.Encoding.Utf8
21import Data.Text.Internal.Fusion.Size
24import Data.Text.Internal.Fusion.Size
22−import Data.Text.Internal.Search (indices)
23import Data.Text.Lazy.Read as TL
25import Data.Text.Lazy.Read as TL
24import Data.Text.Read as T
26import Data.Text.Read as T
27+import Data.Text.Internal.Search (indices)
25import Data.Word (Word, Word8, Word16, Word32, Word64)
28import Data.Word (Word, Word8, Word16, Word32, Word64)
26−import Numeric (showEFloat, showFFloat, showGFloat, showHex)
29+import Numeric (showHex)
27−import Prelude hiding (replicate)
28import Test.Framework (Test, testGroup)
30import Test.Framework (Test, testGroup)
29import Test.Framework.Providers.QuickCheck2 (testProperty)
31import Test.Framework.Providers.QuickCheck2 (testProperty)
30−import Test.QuickCheck hiding ((.&.))
31−import Test.QuickCheck.Monadic
32−import Test.QuickCheck.Property (Property(..))
33−import Tests.QuickCheckUtils
34−import Tests.Utils
35−import Text.Show.Functions ()
36−import qualified Control.Exception as Exception
37import qualified Data.Bits as Bits (shiftL, shiftR)
32import qualified Data.Bits as Bits (shiftL, shiftR)
38import qualified Data.ByteString as B
33import qualified Data.ByteString as B
39import qualified Data.ByteString.Lazy as BL
34import qualified Data.ByteString.Lazy as BL
40import qualified Data.List as L
35import qualified Data.List as L
41import qualified Data.Text as T
36import qualified Data.Text as T
42import qualified Data.Text.Encoding as E
37import qualified Data.Text.Encoding as E
43−import qualified Data.Text.IO as T
44import qualified Data.Text.Internal.Fusion as S
38import qualified Data.Text.Internal.Fusion as S
45import qualified Data.Text.Internal.Fusion.Common as S
39import qualified Data.Text.Internal.Fusion.Common as S
46−import qualified Data.Text.Internal.Lazy.Fusion as SL
40+import qualified Data.Text.IO as T
47−import qualified Data.Text.Internal.Lazy.Search as S (indices)
48−import qualified Data.Text.Internal.Unsafe.Shift as U
49import qualified Data.Text.Lazy as TL
41import qualified Data.Text.Lazy as TL
50import qualified Data.Text.Lazy.Builder as TB
42import qualified Data.Text.Lazy.Builder as TB
51import qualified Data.Text.Lazy.Builder.Int as TB
43import qualified Data.Text.Lazy.Builder.Int as TB
52import qualified Data.Text.Lazy.Builder.RealFloat as TB
44import qualified Data.Text.Lazy.Builder.RealFloat as TB
53import qualified Data.Text.Lazy.Encoding as EL
45import qualified Data.Text.Lazy.Encoding as EL
46+import qualified Data.Text.Internal.Lazy.Fusion as SL
54import qualified Data.Text.Lazy.IO as TL
47import qualified Data.Text.Lazy.IO as TL
48+import qualified Data.Text.Internal.Lazy.Search as S (indices)
49+import qualified Data.Text.Internal.Unsafe.Shift as U
55import qualified System.IO as IO
50import qualified System.IO as IO
56−import qualified Tests.Properties.Mul as Mul
51+
52+import Tests.QuickCheckUtils
53+import Tests.Utils
57import qualified Tests.SlowFunctions as Slow
54import qualified Tests.SlowFunctions as Slow
58
55
56+#if MIN_VERSION_base(4,6,0)
57+import Prelude hiding (replicate)
58+#else
59+import Prelude hiding (catch, replicate)
60+#endif
61+
59t_pack_unpack = (T.unpack . T.pack) `eq` id
62t_pack_unpack = (T.unpack . T.pack) `eq` id
60tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
63tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
61t_stream_unstream = (S.unstream . S.stream) `eq` id
64t_stream_unstream = (S.unstream . S.stream) `eq` id
@@ -95,88 +98,35 @@ tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id
95t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
98t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
96tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
99tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
97
100
98−t_utf8_incr = forAll genUnicode $ \s (Positive n) -> (recode n `eq` id) s
101+t_utf8_incr = do
102+ Positive n <- arbitrary
103+ forAll genUnicode $ recode n `eq` id
99− where recode n = T.concat . map fst . feedChunksOf n E.streamDecodeUtf8 .
104+ where recode n = T.concat . feedChunksOf n E.streamDecodeUtf8 . E.encodeUtf8
100− E.encodeUtf8
101−
102−feedChunksOf :: Int -> (B.ByteString -> E.Decoding) -> B.ByteString
105+ feedChunksOf :: Int -> (B.ByteString -> E.Decoding) -> B.ByteString
103− -> [(T.Text, B.ByteString)]
106+ -> [T.Text]
104−feedChunksOf n f bs
107+ feedChunksOf n f bs
105− | B.null bs = []
108+ | B.null bs = []
106− | otherwise = let (x,y) = B.splitAt n bs
109+ | otherwise = let (a,b) = B.splitAt n bs
107− E.Some t b f' = f x
110+ E.Some t _ f' = f a
108− in (t,b) : feedChunksOf n f' y
111+ in t : feedChunksOf n f' b
109−
112+
110−t_utf8_undecoded = forAll genUnicode $ \t ->
113+-- This is a poor attempt to ensure that the error handling paths on
111− let b = E.encodeUtf8 t
114+-- decode are exercised in some way. Proper testing would be rather
112− ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
115+-- more involved.
113− leftover = (++ [B.empty]) . init . tail . B.inits
114− in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b == ls
115−
116−data Badness = Solo | Leading | Trailing
117− deriving (Eq, Show)
118−
119−instance Arbitrary Badness where
120− arbitrary = elements [Solo, Leading, Trailing]
121−
122−t_utf8_err :: Badness -> DecodeErr -> Property
116+t_utf8_err :: DecodeErr -> B.ByteString -> Property
123−t_utf8_err bad de = do
117+t_utf8_err (DE _ de) bs = monadicIO $ do
124− let gen = case bad of
125− Solo -> genInvalidUTF8
126− Leading -> B.append <$> genInvalidUTF8 <*> genUTF8
127− Trailing -> B.append <$> genUTF8 <*> genInvalidUTF8
128− genUTF8 = E.encodeUtf8 <$> genUnicode
129− forAll gen $ \bs -> MkProperty $ do
130− onErr <- genDecodeErr de
131− unProperty . monadicIO $ do
132− l <- run $ let len = T.length (E.decodeUtf8With onErr bs)
118+ l <- run $ let len = T.length (E.decodeUtf8With de bs)
133− in (len `seq` return (Right len)) `Exception.catch`
119+ in (len `seq` return (Right len)) `catch`
134− (\(e::UnicodeException) -> return (Left e))
120+ (\(e::UnicodeException) -> return (Left e))
135− assert $ case l of
121+ case l of
136− Left err -> length (show err) >= 0
122+ Left err -> assert $ length (show err) >= 0
137− Right _ -> de /= Strict
123+ Right n -> assert $ n >= 0
138
124
139t_utf8_err' :: B.ByteString -> Property
125t_utf8_err' :: B.ByteString -> Property
140t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of
126t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of
141 Left err -> length (show err) >= 0
127 Left err -> length (show err) >= 0
142 Right t -> T.length t >= 0
128 Right t -> T.length t >= 0
143
129
144−genInvalidUTF8 :: Gen B.ByteString
145−genInvalidUTF8 = B.pack <$> oneof [
146− -- invalid leading byte of a 2-byte sequence
147− (:) <$> choose (0xC0, 0xC1) <*> upTo 1 contByte
148− -- invalid leading byte of a 4-byte sequence
149− , (:) <$> choose (0xF5, 0xFF) <*> upTo 3 contByte
150− -- 4-byte sequence greater than U+10FFFF
151− , do k <- choose (0x11, 0x13)
152− let w0 = 0xF0 + (k `Bits.shiftR` 2)
153− w1 = 0x80 + ((k .&. 3) `Bits.shiftL` 4)
154− ([w0,w1]++) <$> vectorOf 2 contByte
155− -- continuation bytes without a start byte
156− , listOf1 contByte
157− -- short 2-byte sequence
158− , (:[]) <$> choose (0xC2, 0xDF)
159− -- short 3-byte sequence
160− , (:) <$> choose (0xE0, 0xEF) <*> upTo 1 contByte
161− -- short 4-byte sequence
162− , (:) <$> choose (0xF0, 0xF4) <*> upTo 2 contByte
163− -- overlong encoding
164− , do k <- choose (0,0xFFFF)
165− let c = chr k
166− case k of
167− _ | k < 0x80 -> oneof [ let (w,x) = ord2 c in return [w,x]
168− , let (w,x,y) = ord3 c in return [w,x,y]
169− , let (w,x,y,z) = ord4 c in return [w,x,y,z] ]
170− | k < 0x7FF -> oneof [ let (w,x,y) = ord3 c in return [w,x,y]
171− , let (w,x,y,z) = ord4 c in return [w,x,y,z] ]
172− | otherwise -> let (w,x,y,z) = ord4 c in return [w,x,y,z]
173− ]
174− where
175− contByte = (0x80 +) <$> choose (0, 0x3f)
176− upTo n gen = do
177− k <- choose (0,n)
178− vectorOf k gen
179−
180s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
130s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
181 where _types = s :: String
131 where _types = s :: String
182sf_Eq p s =
132sf_Eq p s =
@@ -197,10 +147,8 @@ t_Show = show `eq` (show . T.pack)
197tl_Show = show `eq` (show . TL.pack)
147tl_Show = show `eq` (show . TL.pack)
198t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))
148t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))
199tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))
149tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))
200−t_mconcat = unsquare $
201− mconcat `eq` (unpackS . mconcat . L.map T.pack)
150+t_mconcat = mconcat `eq` (unpackS . mconcat . L.map T.pack)
202−tl_mconcat = unsquare $
203− mconcat `eq` (unpackS . mconcat . L.map TL.pack)
151+tl_mconcat = mconcat `eq` (unpackS . mconcat . L.map TL.pack)
204t_mempty = mempty == (unpackS (mempty :: T.Text))
152t_mempty = mempty == (unpackS (mempty :: T.Text))
205tl_mempty = mempty == (unpackS (mempty :: TL.Text))
153tl_mempty = mempty == (unpackS (mempty :: TL.Text))
206t_IsString = fromString `eqP` (T.unpack . fromString)
154t_IsString = fromString `eqP` (T.unpack . fromString)
@@ -264,14 +212,11 @@ s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)
264sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)
212sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)
265t_map f = map f `eqP` (unpackS . T.map f)
213t_map f = map f `eqP` (unpackS . T.map f)
266tl_map f = map f `eqP` (unpackS . TL.map f)
214tl_map f = map f `eqP` (unpackS . TL.map f)
267−s_intercalate c = unsquare $
268− L.intercalate c `eq`
215+s_intercalate c = L.intercalate c `eq`
269 (unpackS . S.intercalate (packS c) . map packS)
216 (unpackS . S.intercalate (packS c) . map packS)
270−t_intercalate c = unsquare $
271− L.intercalate c `eq`
217+t_intercalate c = L.intercalate c `eq`
272 (unpackS . T.intercalate (packS c) . map packS)
218 (unpackS . T.intercalate (packS c) . map packS)
273−tl_intercalate c = unsquare $
274− L.intercalate c `eq`
219+tl_intercalate c = L.intercalate c `eq`
275 (unpackS . TL.intercalate (TL.pack c) . map TL.pack)
220 (unpackS . TL.intercalate (TL.pack c) . map TL.pack)
276s_intersperse c = L.intersperse c `eqP`
221s_intersperse c = L.intersperse c `eqP`
277 (unpackS . S.intersperse c)
222 (unpackS . S.intersperse c)
@@ -279,14 +224,10 @@ s_intersperse_s c = L.intersperse c `eqP`
279 (unpackS . S.unstream . S.intersperse c)
224 (unpackS . S.unstream . S.intersperse c)
280sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`
225sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`
281 (unpackS . S.intersperse c . S.filter p)
226 (unpackS . S.intersperse c . S.filter p)
282−t_intersperse c = unsquare $
283− L.intersperse c `eqP` (unpackS . T.intersperse c)
227+t_intersperse c = L.intersperse c `eqP` (unpackS . T.intersperse c)
284−tl_intersperse c = unsquare $
285− L.intersperse c `eqP` (unpackS . TL.intersperse c)
228+tl_intersperse c = L.intersperse c `eqP` (unpackS . TL.intersperse c)
286−t_transpose = unsquare $
287− L.transpose `eq` (map unpackS . T.transpose . map packS)
229+t_transpose = L.transpose `eq` (map unpackS . T.transpose . map packS)
288−tl_transpose = unsquare $
289− L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)
230+tl_transpose = L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)
290t_reverse = L.reverse `eqP` (unpackS . T.reverse)
231t_reverse = L.reverse `eqP` (unpackS . T.reverse)
291tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)
232tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)
292t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)
233t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)
@@ -383,24 +324,17 @@ sf_foldr p f z = (L.foldr f z . L.filter p) `eqP` (S.foldr f z . S.filter p)
383 where _types = f :: Char -> Char -> Char
324 where _types = f :: Char -> Char -> Char
384t_foldr f z = L.foldr f z `eqP` T.foldr f z
325t_foldr f z = L.foldr f z `eqP` T.foldr f z
385 where _types = f :: Char -> Char -> Char
326 where _types = f :: Char -> Char -> Char
386−tl_foldr f z = unsquare $
387− L.foldr f z `eqP` TL.foldr f z
327+tl_foldr f z = L.foldr f z `eqP` TL.foldr f z
388 where _types = f :: Char -> Char -> Char
328 where _types = f :: Char -> Char -> Char
389−sf_foldr1 p f = unsquare $
390− (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)
329+sf_foldr1 p f = (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)
391t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f
330t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f
392−tl_foldr1 f = unsquare $
393− L.foldr1 f `eqP` TL.foldr1 f
331+tl_foldr1 f = L.foldr1 f `eqP` TL.foldr1 f
394
332
395−s_concat_s = unsquare $
396− L.concat `eq` (unpackS . S.unstream . S.concat . map packS)
333+s_concat_s = L.concat `eq` (unpackS . S.unstream . S.concat . map packS)
397−sf_concat p = unsquare $
398− (L.concat . map (L.filter p)) `eq`
334+sf_concat p = (L.concat . map (L.filter p)) `eq`
399 (unpackS . S.concat . map (S.filter p . packS))
335 (unpackS . S.concat . map (S.filter p . packS))
400−t_concat = unsquare $
401− L.concat `eq` (unpackS . T.concat . map packS)
336+t_concat = L.concat `eq` (unpackS . T.concat . map packS)
402−tl_concat = unsquare $
403− L.concat `eq` (unpackS . TL.concat . map TL.pack)
337+tl_concat = L.concat `eq` (unpackS . TL.concat . map TL.pack)
404sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`
338sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`
405 (unpackS . S.concatMap (packS . f) . S.filter p)
339 (unpackS . S.concatMap (packS . f) . S.filter p)
406t_concatMap f = unsquare $
340t_concatMap f = unsquare $
@@ -440,10 +374,6 @@ t_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z)
440tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)
374tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)
441 where _types = f :: Int -> Char -> (Int,Char)
375 where _types = f :: Int -> Char -> (Int,Char)
442
376
443−tl_repeat n = (L.take m . L.repeat) `eq`
444− (unpackS . TL.take (fromIntegral m) . TL.repeat)
445− where m = fromIntegral (n :: Word8)
446−
447replicate n l = concat (L.replicate n l)
377replicate n l = concat (L.replicate n l)
448
378
449s_replicate n = replicate m `eq`
379s_replicate n = replicate m `eq`
@@ -455,14 +385,6 @@ tl_replicate n = replicate m `eq`
455 (unpackS . TL.replicate (fromIntegral m) . packS)
385 (unpackS . TL.replicate (fromIntegral m) . packS)
456 where m = fromIntegral (n :: Word8)
386 where m = fromIntegral (n :: Word8)
457
387
458−tl_cycle n = (L.take m . L.cycle) `eq`
459− (unpackS . TL.take (fromIntegral m) . TL.cycle . packS)
460− where m = fromIntegral (n :: Word8)
461−
462−tl_iterate f n = (L.take m . L.iterate f) `eq`
463− (unpackS . TL.take (fromIntegral m) . TL.iterate f)
464− where m = fromIntegral (n :: Word8)
465−
466unf :: Int -> Char -> Maybe (Char, Char)
388unf :: Int -> Char -> Maybe (Char, Char)
467unf n c | fromEnum c * 100 > n = Nothing
389unf n c | fromEnum c * 100 > n = Nothing
468 | otherwise = Just (c, succ c)
390 | otherwise = Just (c, succ c)
@@ -489,22 +411,14 @@ s_take_s m = L.take n `eqP` (unpackS . S.unstream . S.take n)
489sf_take p n = (L.take n . L.filter p) `eqP`
411sf_take p n = (L.take n . L.filter p) `eqP`
490 (unpackS . S.take n . S.filter p)
412 (unpackS . S.take n . S.filter p)
491t_take n = L.take n `eqP` (unpackS . T.take n)
413t_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)
494tl_take n = L.take n `eqP` (unpackS . TL.take (fromIntegral n))
414tl_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)
497s_drop n = L.drop n `eqP` (unpackS . S.drop n)
415s_drop n = L.drop n `eqP` (unpackS . S.drop n)
498s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)
416s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)
499 where n = small m
417 where n = small m
500sf_drop p n = (L.drop n . L.filter p) `eqP`
418sf_drop p n = (L.drop n . L.filter p) `eqP`
501 (unpackS . S.drop n . S.filter p)
419 (unpackS . S.drop n . S.filter p)
502t_drop n = L.drop n `eqP` (unpackS . T.drop n)
420t_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)
505tl_drop n = L.drop n `eqP` (unpackS . TL.drop (fromIntegral n))
421tl_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))
508s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)
422s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)
509 where n = small m
423 where n = small m
510s_take_drop_s m = (L.take n . L.drop n) `eqP`
424s_take_drop_s m = (L.take n . L.drop n) `eqP`
@@ -516,10 +430,6 @@ sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
516 (unpackS . S.takeWhile p . S.filter q)
430 (unpackS . S.takeWhile p . S.filter q)
517t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
431t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
518tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
432tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
519−t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
520− (unpackS . T.takeWhileEnd p)
521−tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
522− (unpackS . TL.takeWhileEnd p)
523s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
433s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
524s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
434s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
525sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
435sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
@@ -572,27 +482,24 @@ tl_groupBy p = L.groupBy p `eqP` (map unpackS . TL.groupBy p)
572t_inits = L.inits `eqP` (map unpackS . T.inits)
482t_inits = L.inits `eqP` (map unpackS . T.inits)
573tl_inits = L.inits `eqP` (map unpackS . TL.inits)
483tl_inits = L.inits `eqP` (map unpackS . TL.inits)
574t_tails = L.tails `eqP` (map unpackS . T.tails)
484t_tails = L.tails `eqP` (map unpackS . T.tails)
575−tl_tails = unsquare $
576− L.tails `eqP` (map unpackS . TL.tails)
485+tl_tails = L.tails `eqP` (map unpackS . TL.tails)
577−t_findAppendId = unsquare $ \(NotEmpty s) ts ->
486+t_findAppendId (NotEmpty s) = unsquare $ \ts ->
578 let t = T.intercalate s ts
487 let t = T.intercalate s ts
579 in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)
488 in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)
580−tl_findAppendId = unsquare $ \(NotEmpty s) ts ->
489+tl_findAppendId (NotEmpty s) = unsquare $ \ts ->
581 let t = TL.intercalate s ts
490 let t = TL.intercalate s ts
582 in all (==t) $ map (uncurry TL.append) (TL.breakOnAll s t)
491 in all (==t) $ map (uncurry TL.append) (TL.breakOnAll s t)
583−t_findContains = unsquare $ \(NotEmpty s) ->
584− all (T.isPrefixOf s . snd) . T.breakOnAll s . T.intercalate s
492+t_findContains (NotEmpty s) = all (T.isPrefixOf s . snd) . T.breakOnAll s .
493+ T.intercalate s
585−tl_findContains = unsquare $ \(NotEmpty s) -> all (TL.isPrefixOf s . snd) .
494+tl_findContains (NotEmpty s) = all (TL.isPrefixOf s . snd) .
586 TL.breakOnAll s . TL.intercalate s
495 TL.breakOnAll s . TL.intercalate s
587sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c
496sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c
588t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s
497t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s
589tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s
498tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s
590
499
591−t_splitOn_split s = unsquare $
592− (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s
500+t_splitOn_split s = (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s
593−tl_splitOn_split s = unsquare $
594− ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`
501+tl_splitOn_split s = ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`
595− (map TL.fromStrict . T.splitOn s)) . T.intercalate s
502+ (map TL.fromStrict . T.splitOn s)) . T.intercalate s
596t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)
503t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)
597tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)
504tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)
598
505
@@ -634,14 +541,10 @@ t_lines' = lines' `eqP` (map unpackS . T.lines')
634t_words = L.words `eqP` (map unpackS . T.words)
541t_words = L.words `eqP` (map unpackS . T.words)
635
542
636tl_words = L.words `eqP` (map unpackS . TL.words)
543tl_words = L.words `eqP` (map unpackS . TL.words)
637−t_unlines = unsquare $
638− L.unlines `eq` (unpackS . T.unlines . map packS)
544+t_unlines = L.unlines `eq` (unpackS . T.unlines . map packS)
639−tl_unlines = unsquare $
640− L.unlines `eq` (unpackS . TL.unlines . map packS)
545+tl_unlines = L.unlines `eq` (unpackS . TL.unlines . map packS)
641−t_unwords = unsquare $
642− L.unwords `eq` (unpackS . T.unwords . map packS)
546+t_unwords = L.unwords `eq` (unpackS . T.unwords . map packS)
643−tl_unwords = unsquare $
644− L.unwords `eq` (unpackS . TL.unwords . map packS)
547+tl_unwords = L.unwords `eq` (unpackS . TL.unwords . map packS)
645
548
646s_isPrefixOf s = L.isPrefixOf s `eqP`
549s_isPrefixOf s = L.isPrefixOf s `eqP`
647 (S.isPrefixOf (S.stream $ packS s) . S.stream)
550 (S.isPrefixOf (S.stream $ packS s) . S.stream)
@@ -718,9 +621,8 @@ t_indices (NotEmpty s) = Slow.indices s `eq` indices s
718tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
621tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
719 where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)
622 where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)
720 conc = T.concat . TL.toChunks
623 conc = T.concat . TL.toChunks
721−t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
624+t_indices_occurs (NotEmpty t) ts = let s = T.intercalate t ts
722− let s = T.intercalate t ts
723− in Slow.indices t s == indices t s
625+ in Slow.indices t s == indices t s
724
626
725-- Bit shifts.
627-- Bit shifts.
726shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
628shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
@@ -756,7 +658,6 @@ tb_decimal :: (Integral a, Show a) => a -> Bool
756tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)
658tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)
757
659
758tb_decimal_integer (a::Integer) = tb_decimal a
660tb_decimal_integer (a::Integer) = tb_decimal a
759−tb_decimal_integer_big (Big a) = tb_decimal a
760tb_decimal_int (a::Int) = tb_decimal a
661tb_decimal_int (a::Int) = tb_decimal a
761tb_decimal_int8 (a::Int8) = tb_decimal a
662tb_decimal_int8 (a::Int8) = tb_decimal a
762tb_decimal_int16 (a::Int16) = tb_decimal a
663tb_decimal_int16 (a::Int16) = tb_decimal a
@@ -768,11 +669,6 @@ tb_decimal_word16 (a::Word16) = tb_decimal a
768tb_decimal_word32 (a::Word32) = tb_decimal a
669tb_decimal_word32 (a::Word32) = tb_decimal a
769tb_decimal_word64 (a::Word64) = tb_decimal a
670tb_decimal_word64 (a::Word64) = tb_decimal a
770
671
771−tb_decimal_big_int (BigBounded (a::Int)) = tb_decimal a
772−tb_decimal_big_int64 (BigBounded (a::Int64)) = tb_decimal a
773−tb_decimal_big_word (BigBounded (a::Word)) = tb_decimal a
774−tb_decimal_big_word64 (BigBounded (a::Word64)) = tb_decimal a
775−
776tb_hex :: (Integral a, Show a) => a -> Bool
672tb_hex :: (Integral a, Show a) => a -> Bool
777tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")
673tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")
778
674
@@ -794,21 +690,6 @@ tb_realfloat = (TB.toLazyText . TB.realFloat) `eq` (TL.pack . show)
794tb_realfloat_float (a::Float) = tb_realfloat a
690tb_realfloat_float (a::Float) = tb_realfloat a
795tb_realfloat_double (a::Double) = tb_realfloat a
691tb_realfloat_double (a::Double) = tb_realfloat a
796
692
797−showFloat :: (RealFloat a) => TB.FPFormat -> Maybe Int -> a -> ShowS
798−showFloat TB.Exponent = showEFloat
799−showFloat TB.Fixed = showFFloat
800−showFloat TB.Generic = showGFloat
801−
802−tb_formatRealFloat :: (RealFloat a, Show a) =>
803− a -> TB.FPFormat -> Precision a -> Property
804−tb_formatRealFloat a fmt prec =
805− TB.formatRealFloat fmt p a ===
806− TB.fromString (showFloat fmt p a "")
807− where p = precision a prec
808−
809−tb_formatRealFloat_float (a::Float) = tb_formatRealFloat a
810−tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a
811−
812-- Reading.
693-- Reading.
813
694
814t_decimal (n::Int) s =
695t_decimal (n::Int) s =
@@ -817,18 +698,16 @@ t_decimal (n::Int) s =
817tl_decimal (n::Int) s =
698tl_decimal (n::Int) s =
818 TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
699 TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
819 where t = TL.dropWhile isDigit s
700 where t = TL.dropWhile isDigit s
820−t_hexadecimal m s ox =
701+t_hexadecimal (n::Positive Int) s ox =
821 T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
702 T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
822 where t = T.dropWhile isHexDigit s
703 where t = T.dropWhile isHexDigit s
823 p = if ox then "0x" else ""
704 p = if ox then "0x" else ""
824− n = getPositive m :: Int
705+tl_hexadecimal (n::Positive Int) s ox =
825−tl_hexadecimal m s ox =
826 TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
706 TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
827 where t = TL.dropWhile isHexDigit s
707 where t = TL.dropWhile isHexDigit s
828 p = if ox then "0x" else ""
708 p = if ox then "0x" else ""
829− n = getPositive m :: Int
830
709
831−isFloaty c = c `elem` ("+-.0123456789eE" :: String)
710+isFloaty c = c `elem` "+-.0123456789eE"
832
711
833t_read_rational p tol (n::Double) s =
712t_read_rational p tol (n::Double) s =
834 case p (T.pack (show n) `T.append` t) of
713 case p (T.pack (show n) `T.append` t) of
@@ -910,7 +789,6 @@ tests =
910 testProperty "t_utf8" t_utf8,
789 testProperty "t_utf8" t_utf8,
911 testProperty "t_utf8'" t_utf8',
790 testProperty "t_utf8'" t_utf8',
912 testProperty "t_utf8_incr" t_utf8_incr,
791 testProperty "t_utf8_incr" t_utf8_incr,
913− testProperty "t_utf8_undecoded" t_utf8_undecoded,
914 testProperty "tl_utf8" tl_utf8,
792 testProperty "tl_utf8" tl_utf8,
915 testProperty "tl_utf8'" tl_utf8',
793 testProperty "tl_utf8'" tl_utf8',
916 testProperty "t_utf16LE" t_utf16LE,
794 testProperty "t_utf16LE" t_utf16LE,
@@ -1110,12 +988,9 @@ tests =
1110 ],
988 ],
1111
989
1112 testGroup "unfolds" [
990 testGroup "unfolds" [
1113− testProperty "tl_repeat" tl_repeat,
1114 testProperty "s_replicate" s_replicate,
991 testProperty "s_replicate" s_replicate,
1115 testProperty "t_replicate" t_replicate,
992 testProperty "t_replicate" t_replicate,
1116 testProperty "tl_replicate" tl_replicate,
993 testProperty "tl_replicate" tl_replicate,
1117− testProperty "tl_cycle" tl_cycle,
1118− testProperty "tl_iterate" tl_iterate,
1119 testProperty "t_unfoldr" t_unfoldr,
994 testProperty "t_unfoldr" t_unfoldr,
1120 testProperty "tl_unfoldr" tl_unfoldr,
995 testProperty "tl_unfoldr" tl_unfoldr,
1121 testProperty "t_unfoldrN" t_unfoldrN,
996 testProperty "t_unfoldrN" t_unfoldrN,
@@ -1129,16 +1004,12 @@ tests =
1129 testProperty "s_take_s" s_take_s,
1004 testProperty "s_take_s" s_take_s,
1130 testProperty "sf_take" sf_take,
1005 testProperty "sf_take" sf_take,
1131 testProperty "t_take" t_take,
1006 testProperty "t_take" t_take,
1132− testProperty "t_takeEnd" t_takeEnd,
1133 testProperty "tl_take" tl_take,
1007 testProperty "tl_take" tl_take,
1134− testProperty "tl_takeEnd" tl_takeEnd,
1135 testProperty "s_drop" s_drop,
1008 testProperty "s_drop" s_drop,
1136 testProperty "s_drop_s" s_drop_s,
1009 testProperty "s_drop_s" s_drop_s,
1137 testProperty "sf_drop" sf_drop,
1010 testProperty "sf_drop" sf_drop,
1138 testProperty "t_drop" t_drop,
1011 testProperty "t_drop" t_drop,
1139− testProperty "t_dropEnd" t_dropEnd,
1140 testProperty "tl_drop" tl_drop,
1012 testProperty "tl_drop" tl_drop,
1141− testProperty "tl_dropEnd" tl_dropEnd,
1142 testProperty "s_take_drop" s_take_drop,
1013 testProperty "s_take_drop" s_take_drop,
1143 testProperty "s_take_drop_s" s_take_drop_s,
1014 testProperty "s_take_drop_s" s_take_drop_s,
1144 testProperty "s_takeWhile" s_takeWhile,
1015 testProperty "s_takeWhile" s_takeWhile,
@@ -1146,8 +1017,6 @@ tests =
1146 testProperty "sf_takeWhile" sf_takeWhile,
1017 testProperty "sf_takeWhile" sf_takeWhile,
1147 testProperty "t_takeWhile" t_takeWhile,
1018 testProperty "t_takeWhile" t_takeWhile,
1148 testProperty "tl_takeWhile" tl_takeWhile,
1019 testProperty "tl_takeWhile" tl_takeWhile,
1149− testProperty "t_takeWhileEnd" t_takeWhileEnd,
1150− testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1151 testProperty "sf_dropWhile" sf_dropWhile,
1020 testProperty "sf_dropWhile" sf_dropWhile,
1152 testProperty "s_dropWhile" s_dropWhile,
1021 testProperty "s_dropWhile" s_dropWhile,
1153 testProperty "s_dropWhile_s" s_dropWhile_s,
1022 testProperty "s_dropWhile_s" s_dropWhile_s,
@@ -1293,16 +1162,11 @@ tests =
1293 testProperty "tb_decimal_int32" tb_decimal_int32,
1162 testProperty "tb_decimal_int32" tb_decimal_int32,
1294 testProperty "tb_decimal_int64" tb_decimal_int64,
1163 testProperty "tb_decimal_int64" tb_decimal_int64,
1295 testProperty "tb_decimal_integer" tb_decimal_integer,
1164 testProperty "tb_decimal_integer" tb_decimal_integer,
1296− testProperty "tb_decimal_integer_big" tb_decimal_integer_big,
1297 testProperty "tb_decimal_word" tb_decimal_word,
1165 testProperty "tb_decimal_word" tb_decimal_word,
1298 testProperty "tb_decimal_word8" tb_decimal_word8,
1166 testProperty "tb_decimal_word8" tb_decimal_word8,
1299 testProperty "tb_decimal_word16" tb_decimal_word16,
1167 testProperty "tb_decimal_word16" tb_decimal_word16,
1300 testProperty "tb_decimal_word32" tb_decimal_word32,
1168 testProperty "tb_decimal_word32" tb_decimal_word32,
1301− testProperty "tb_decimal_word64" tb_decimal_word64,
1169+ testProperty "tb_decimal_word64" tb_decimal_word64
1302− testProperty "tb_decimal_big_int" tb_decimal_big_int,
1303− testProperty "tb_decimal_big_word" tb_decimal_big_word,
1304− testProperty "tb_decimal_big_int64" tb_decimal_big_int64,
1305− testProperty "tb_decimal_big_word64" tb_decimal_big_word64
1306 ],
1170 ],
1307 testGroup "hexadecimal" [
1171 testGroup "hexadecimal" [
1308 testProperty "tb_hexadecimal_int" tb_hexadecimal_int,
1172 testProperty "tb_hexadecimal_int" tb_hexadecimal_int,
@@ -1319,9 +1183,7 @@ tests =
1319 ],
1183 ],
1320 testGroup "realfloat" [
1184 testGroup "realfloat" [
1321 testProperty "tb_realfloat_double" tb_realfloat_double,
1185 testProperty "tb_realfloat_double" tb_realfloat_double,
1322− testProperty "tb_realfloat_float" tb_realfloat_float,
1186+ testProperty "tb_realfloat_float" tb_realfloat_float
1323− testProperty "tb_formatRealFloat_float" tb_formatRealFloat_float,
1324− testProperty "tb_formatRealFloat_double" tb_formatRealFloat_double
1325 ],
1187 ],
1326 testProperty "tb_fromText" tb_fromText,
1188 testProperty "tb_fromText" tb_fromText,
1327 testProperty "tb_singleton" tb_singleton
1189 testProperty "tb_singleton" tb_singleton
@@ -1357,7 +1219,5 @@ tests =
1357 testProperty "t_take_drop_16" t_take_drop_16,
1219 testProperty "t_take_drop_16" t_take_drop_16,
1358 testProperty "t_use_from" t_use_from,
1220 testProperty "t_use_from" t_use_from,
1359 testProperty "t_copy" t_copy
1221 testProperty "t_copy" t_copy
1360− ],
1222+ ]
1361−
1362− testGroup "mul" Mul.tests
1363 ]
1223 ]
tests/Tests/Properties/Mul.hsdeleted−40
@@ -1,40 +0,0 @@
1−{-# LANGUAGE ScopedTypeVariables #-}
2−
3−module Tests.Properties.Mul (tests) where
4−
5−import Control.Applicative ((<$>), pure)
6−import Control.Exception as E (SomeException, catch, evaluate)
7−import Data.Int (Int32, Int64)
8−import Data.Text.Internal (mul, mul32, mul64)
9−import System.IO.Unsafe (unsafePerformIO)
10−import Test.Framework (Test)
11−import Test.Framework.Providers.QuickCheck2 (testProperty)
12−import Test.QuickCheck hiding ((.&.))
13−
14−mulRef :: (Integral a, Bounded a) => a -> a -> Maybe a
15−mulRef a b
16− | ab < bot || ab > top = Nothing
17− | otherwise = Just (fromIntegral ab)
18− where ab = fromIntegral a * fromIntegral b
19− top = fromIntegral (maxBound `asTypeOf` a) :: Integer
20− bot = fromIntegral (minBound `asTypeOf` a) :: Integer
21−
22−eval :: (a -> b -> c) -> a -> b -> Maybe c
23−eval f a b = unsafePerformIO $
24− (Just <$> evaluate (f a b)) `E.catch` (\(_::SomeException) -> pure Nothing)
25−
26−t_mul32 :: Int32 -> Int32 -> Property
27−t_mul32 a b = mulRef a b === eval mul32 a b
28−
29−t_mul64 :: Int64 -> Int64 -> Property
30−t_mul64 a b = mulRef a b === eval mul64 a b
31−
32−t_mul :: Int -> Int -> Property
33−t_mul a b = mulRef a b === eval mul a b
34−
35−tests :: [Test]
36−tests = [
37− testProperty "t_mul" t_mul
38− , testProperty "t_mul32" t_mul32
39− , testProperty "t_mul64" t_mul64
40− ]
tests/Tests/QuickCheckUtils.hs+82−105
@@ -10,91 +10,107 @@ module Tests.QuickCheckUtils
10 , unsquare
10 , unsquare
11 , smallArbitrary
11 , smallArbitrary
12
12
13− , BigBounded(..)
14− , BigInt(..)
15− , NotEmpty(..)
13+ , NotEmpty (..)
16
14
17− , Small(..)
15+ , Small (..)
18 , small
16 , small
19
17
20− , Precision(..)
21− , precision
22−
23 , integralRandomR
18 , integralRandomR
24
19
25− , DecodeErr(..)
20+ , DecodeErr (..)
26− , genDecodeErr
27
21
28− , Stringy(..)
22+ , Stringy (..)
29 , eq
23 , eq
30 , eqP
24 , eqP
31
25
32− , Encoding(..)
26+ , Encoding (..)
33
27
34 , write_read
28 , write_read
35 ) where
29 ) where
36
30
37−import Control.Applicative ((<$>))
38import Control.Arrow (first, (***))
31import Control.Arrow (first, (***))
39import Control.DeepSeq (NFData (..), deepseq)
32import Control.DeepSeq (NFData (..), deepseq)
40import Control.Exception (bracket)
33import Control.Exception (bracket)
34+import Data.Bits ((.&.))
35+import Data.Char (chr)
36+import Data.Word (Word8, Word16)
41import Data.String (IsString, fromString)
37import Data.String (IsString, fromString)
42import Data.Text.Foreign (I16)
38import Data.Text.Foreign (I16)
43−import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))
44−import Data.Word (Word8, Word16)
45import Debug.Trace (trace)
39import Debug.Trace (trace)
46−import System.Random (Random(..), RandomGen)
40+import System.Random (Random (..), RandomGen)
47−import Test.QuickCheck hiding (Fixed(..), Small (..), (.&.))
41+import Test.QuickCheck hiding ((.&.))
48import Test.QuickCheck.Monadic (assert, monadicIO, run)
42import Test.QuickCheck.Monadic (assert, monadicIO, run)
49−import Test.QuickCheck.Unicode (string)
50−import Tests.Utils
51import qualified Data.ByteString as B
43import qualified Data.ByteString as B
52import qualified Data.Text as T
44import qualified Data.Text as T
53import qualified Data.Text.Encoding.Error as T
45import qualified Data.Text.Encoding.Error as T
54import qualified Data.Text.Internal.Fusion as TF
46import qualified Data.Text.Internal.Fusion as TF
55import qualified Data.Text.Internal.Fusion.Common as TF
47import qualified Data.Text.Internal.Fusion.Common as TF
56−import qualified Data.Text.Internal.Lazy as TL
57−import qualified Data.Text.Internal.Lazy.Fusion as TLF
58import qualified Data.Text.Lazy as TL
48import qualified Data.Text.Lazy as TL
49+import qualified Data.Text.Internal.Lazy.Fusion as TLF
50+import qualified Data.Text.Internal.Lazy as TL
59import qualified System.IO as IO
51import qualified System.IO as IO
60
52
61−#if !MIN_VERSION_base(4,4,0)
53+import Tests.Utils
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
54
69instance Random I16 where
55instance Random I16 where
70 randomR = integralRandomR
56 randomR = integralRandomR
71 random = randomR (minBound,maxBound)
57 random = randomR (minBound,maxBound)
72
58
73instance Arbitrary I16 where
59instance Arbitrary I16 where
74− arbitrary = arbitrarySizedIntegral
60+ arbitrary = choose (minBound,maxBound)
75− shrink = shrinkIntegral
76
61
77instance Arbitrary B.ByteString where
62instance Arbitrary B.ByteString where
78 arbitrary = B.pack `fmap` arbitrary
63 arbitrary = B.pack `fmap` arbitrary
79− shrink = map B.pack . shrink . B.unpack
80−
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−
90−instance Random Word8 where
91− randomR = integralRandomR
92− random = randomR (minBound,maxBound)
93
64
94−instance Random Word64 where
65+genUnicode :: IsString a => Gen a
95− randomR = integralRandomR
66+genUnicode = fmap fromString string where
96− random = randomR (minBound,maxBound)
67+ string = sized $ \n ->
97−#endif
68+ do k <- choose (0,n)
69+ sequence [ char | _ <- [1..k] ]
70+
71+ excluding :: [a -> Bool] -> Gen a -> Gen a
72+ excluding bad gen = loop
73+ where
74+ loop = do
75+ x <- gen
76+ if or (map ($ x) bad)
77+ then loop
78+ else return x
79+
80+ reserved = [lowSurrogate, highSurrogate, noncharacter]
81+ lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF
82+ highSurrogate c = c >= 0xD800 && c <= 0xDBFF
83+ noncharacter c = masked == 0xFFFE || masked == 0xFFFF
84+ where
85+ masked = c .&. 0xFFFF
86+
87+ ascii = choose (0,0x7F)
88+ plane0 = choose (0xF0, 0xFFFF)
89+ plane1 = oneof [ choose (0x10000, 0x10FFF)
90+ , choose (0x11000, 0x11FFF)
91+ , choose (0x12000, 0x12FFF)
92+ , choose (0x13000, 0x13FFF)
93+ , choose (0x1D000, 0x1DFFF)
94+ , choose (0x1F000, 0x1FFFF)
95+ ]
96+ plane2 = oneof [ choose (0x20000, 0x20FFF)
97+ , choose (0x21000, 0x21FFF)
98+ , choose (0x22000, 0x22FFF)
99+ , choose (0x23000, 0x23FFF)
100+ , choose (0x24000, 0x24FFF)
101+ , choose (0x25000, 0x25FFF)
102+ , choose (0x26000, 0x26FFF)
103+ , choose (0x27000, 0x27FFF)
104+ , choose (0x28000, 0x28FFF)
105+ , choose (0x29000, 0x29FFF)
106+ , choose (0x2A000, 0x2AFFF)
107+ , choose (0x2B000, 0x2BFFF)
108+ , choose (0x2F000, 0x2FFFF)
109+ ]
110+ plane14 = choose (0xE0000, 0xE0FFF)
111+ planes = [ascii, plane0, plane1, plane2, plane14]
112+
113+ char = chr `fmap` excluding reserved (oneof planes)
98
114
99-- For tests that have O(n^2) running times or input sizes, resize
115-- For tests that have O(n^2) running times or input sizes, resize
100-- their inputs to the square root of the originals.
116-- their inputs to the square root of the originals.
@@ -107,25 +123,9 @@ smallArbitrary = sized $ \n -> resize (smallish n) arbitrary
107
123
108instance Arbitrary T.Text where
124instance Arbitrary T.Text where
109 arbitrary = T.pack `fmap` arbitrary
125 arbitrary = T.pack `fmap` arbitrary
110− shrink = map T.pack . shrink . T.unpack
111
126
112instance Arbitrary TL.Text where
127instance Arbitrary TL.Text where
113 arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary
128 arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary
114− shrink = map TL.pack . shrink . TL.unpack
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
129
130newtype NotEmpty a = NotEmpty { notEmpty :: a }
130newtype NotEmpty a = NotEmpty { notEmpty :: a }
131 deriving (Eq, Ord)
131 deriving (Eq, Ord)
@@ -138,23 +138,15 @@ instance Functor NotEmpty where
138
138
139instance Arbitrary a => Arbitrary (NotEmpty [a]) where
139instance Arbitrary a => Arbitrary (NotEmpty [a]) where
140 arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))
140 arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))
141− shrink = shrinkNotEmpty null
142
141
143instance Arbitrary (NotEmpty T.Text) where
142instance Arbitrary (NotEmpty T.Text) where
144 arbitrary = (fmap T.pack) `fmap` arbitrary
143 arbitrary = (fmap T.pack) `fmap` arbitrary
145− shrink = shrinkNotEmpty T.null
146
144
147instance Arbitrary (NotEmpty TL.Text) where
145instance Arbitrary (NotEmpty TL.Text) where
148 arbitrary = (fmap TL.pack) `fmap` arbitrary
146 arbitrary = (fmap TL.pack) `fmap` arbitrary
149− shrink = shrinkNotEmpty TL.null
150
147
151instance Arbitrary (NotEmpty B.ByteString) where
148instance Arbitrary (NotEmpty B.ByteString) where
152 arbitrary = (fmap B.pack) `fmap` arbitrary
149 arbitrary = (fmap B.pack) `fmap` arbitrary
153− shrink = shrinkNotEmpty B.null
154−
155−shrinkNotEmpty :: Arbitrary a => (a -> Bool) -> NotEmpty a -> [NotEmpty a]
156−shrinkNotEmpty isNull (NotEmpty xs) =
157− [ NotEmpty xs' | xs' <- shrink xs, not (isNull xs') ]
158
150
159data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7
151data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7
160 | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15
152 | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15
@@ -195,25 +187,23 @@ instance Random Small where
195 random = randomR (minBound,maxBound)
187 random = randomR (minBound,maxBound)
196
188
197instance Arbitrary Small where
189instance Arbitrary Small where
198− arbitrary = choose (minBound, maxBound)
190+ arbitrary = choose (minBound,maxBound)
199− shrink = shrinkIntegral
200
191
201integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
192integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
202integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
193integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
203 fromIntegral b :: Integer) g of
194 fromIntegral b :: Integer) g of
204 (x,h) -> (fromIntegral x, h)
195 (x,h) -> (fromIntegral x, h)
205
196
206−data DecodeErr = Lenient | Ignore | Strict | Replace
197+data DecodeErr = DE String T.OnDecodeError
207− deriving (Show, Eq)
208
198
209−genDecodeErr :: DecodeErr -> Gen T.OnDecodeError
199+instance Show DecodeErr where
210−genDecodeErr Lenient = return T.lenientDecode
200+ show (DE d _) = "DE " ++ d
211−genDecodeErr Ignore = return T.ignore
212−genDecodeErr Strict = return T.strictDecode
213−genDecodeErr Replace = arbitrary
214
201
215instance Arbitrary DecodeErr where
202instance Arbitrary DecodeErr where
216− arbitrary = elements [Lenient, Ignore, Strict, Replace]
203+ arbitrary = oneof [ return $ DE "lenient" T.lenientDecode
204+ , return $ DE "ignore" T.ignore
205+ , return $ DE "strict" T.strictDecode
206+ , DE "replace" `fmap` arbitrary ]
217
207
218class Stringy s where
208class Stringy s where
219 packS :: String -> s
209 packS :: String -> s
@@ -267,30 +257,6 @@ eqP f g s w = eql "orig" (f s) (g t) &&
267 | a =^= b = True
257 | a =^= b = True
268 | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
258 | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
269
259
270−instance Arbitrary FPFormat where
271− arbitrary = elements [Exponent, Fixed, Generic]
272−
273−newtype Precision a = Precision (Maybe Int)
274− deriving (Eq, Show)
275−
276−precision :: a -> Precision a -> Maybe Int
277−precision _ (Precision prec) = prec
278−
279−arbitraryPrecision :: Int -> Gen (Precision a)
280−arbitraryPrecision maxDigits = Precision <$> do
281− n <- choose (-1,maxDigits)
282− return $ if n == -1
283− then Nothing
284− else Just n
285−
286−instance Arbitrary (Precision Float) where
287− arbitrary = arbitraryPrecision 11
288− shrink = map Precision . shrink . precision undefined
289−
290−instance Arbitrary (Precision Double) where
291− arbitrary = arbitraryPrecision 22
292− shrink = map Precision . shrink . precision undefined
293−
294-- Work around lack of Show instance for TextEncoding.
260-- Work around lack of Show instance for TextEncoding.
295data Encoding = E String IO.TextEncoding
261data Encoding = E String IO.TextEncoding
296
262
@@ -308,6 +274,17 @@ windowsNewlineMode = IO.NewlineMode
308 { IO.inputNL = IO.CRLF, IO.outputNL = IO.CRLF
274 { IO.inputNL = IO.CRLF, IO.outputNL = IO.CRLF
309 }
275 }
310
276
277+-- Newline and NewlineMode have standard Show instance from GHC 7 onwards
278+#if __GLASGOW_HASKELL__ < 700
279+instance Show IO.Newline where
280+ show IO.CRLF = "CRLF"
281+ show IO.LF = "LF"
282+
283+instance Show IO.NewlineMode where
284+ show (IO.NewlineMode i o) = "NewlineMode { inputNL = " ++ show i ++
285+ ", outputNL = " ++ show o ++ " }"
286+# endif
287+
311instance Arbitrary IO.NewlineMode where
288instance Arbitrary IO.NewlineMode where
312 arbitrary = oneof . map return $
289 arbitrary = oneof . map return $
313 [ IO.noNewlineTranslation, IO.universalNewlineMode, IO.nativeNewlineMode
290 [ IO.noNewlineTranslation, IO.universalNewlineMode, IO.nativeNewlineMode
tests/cabal.configdeleted−6
@@ -1,6 +0,0 @@
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.shdeleted−29
@@ -1,29 +0,0 @@
1−#!/bin/bash -e
2−
3−failed=0
4−
5−function check_firings() {
6− rule=$1
7− expected=$2
8− build="ghc -O -ddump-rule-firings LiteralRuleTest.hs"
9− build="$build -i.. -I../include"
10− touch LiteralRuleTest.hs
11− echo -n "Want to see $expected firings of rule $rule... " >&2
12− firings=$($build 2>&1 | grep "Rule fired: $rule\$" | wc -l)
13− rm -f LiteralRuleTest.{o.hi}
14−
15− if [ $firings != $expected ]; then
16− echo "failed, saw $firings" >&2
17− failed=1
18− else
19− echo "pass" >&2
20− fi
21−}
22−
23−check_firings "TEXT literal" 8
24−check_firings "TEXT literal UTF8" 7
25−check_firings "TEXT empty literal" 4
26−# This is broken at the moment. "TEXT literal" rule fires instead.
27−#check_firings "TEXT singleton literal" 5
28−
29−exit $failed
tests/text-tests.cabal+3−20
@@ -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://github.com/bos/text
5+homepage: https://bitbucket.org/bos/text
6−license: BSD2
6+license: BSD3
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,20 +18,10 @@ 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
22
21
23executable text-tests
22executable text-tests
24 main-is: Tests.hs
23 main-is: Tests.hs
25
24
26− other-modules:
27− Tests.IO
28− Tests.Properties
29− Tests.Properties.Mul
30− Tests.QuickCheckUtils
31− Tests.Regressions
32− Tests.SlowFunctions
33− Tests.Utils
34−
35 ghc-options:
25 ghc-options:
36 -Wall -threaded -O0 -rtsopts
26 -Wall -threaded -O0 -rtsopts
37
27
@@ -40,18 +30,16 @@ executable text-tests
40 -fhpc
30 -fhpc
41
31
42 cpp-options:
32 cpp-options:
43− -DTEST_SUITE
44 -DASSERTS
33 -DASSERTS
45 -DHAVE_DEEPSEQ
34 -DHAVE_DEEPSEQ
46
35
47 build-depends:
36 build-depends:
48 HUnit >= 1.2,
37 HUnit >= 1.2,
49− QuickCheck >= 2.7,
38+ QuickCheck >= 2.4,
50 base == 4.*,
39 base == 4.*,
51 bytestring,
40 bytestring,
52 deepseq,
41 deepseq,
53 directory,
42 directory,
54− quickcheck-unicode,
55 random,
43 random,
56 test-framework >= 0.4,
44 test-framework >= 0.4,
57 test-framework-hunit >= 0.2,
45 test-framework-hunit >= 0.2,
@@ -77,7 +65,6 @@ library
77 hs-source-dirs: ..
65 hs-source-dirs: ..
78 c-sources: ../cbits/cbits.c
66 c-sources: ../cbits/cbits.c
79 include-dirs: ../include
67 include-dirs: ../include
80− ghc-options: -Wall
81 exposed-modules:
68 exposed-modules:
82 Data.Text
69 Data.Text
83 Data.Text.Array
70 Data.Text.Array
@@ -114,8 +101,6 @@ library
114 Data.Text.Internal.Lazy.Search
101 Data.Text.Internal.Lazy.Search
115 Data.Text.Internal.Private
102 Data.Text.Internal.Private
116 Data.Text.Read
103 Data.Text.Read
117− Data.Text.Show
118− Data.Text.Internal.Read
119 Data.Text.Internal.Search
104 Data.Text.Internal.Search
120 Data.Text.Unsafe
105 Data.Text.Unsafe
121 Data.Text.Internal.Unsafe
106 Data.Text.Internal.Unsafe
@@ -128,7 +113,6 @@ library
128 -fhpc
113 -fhpc
129
114
130 cpp-options:
115 cpp-options:
131− -DTEST_SUITE
132 -DHAVE_DEEPSEQ
116 -DHAVE_DEEPSEQ
133 -DASSERTS
117 -DASSERTS
134 -DINTEGER_GMP
118 -DINTEGER_GMP
@@ -136,7 +120,6 @@ library
136 build-depends:
120 build-depends:
137 array,
121 array,
138 base == 4.*,
122 base == 4.*,
139− binary,
140 bytestring,
123 bytestring,
141 deepseq,
124 deepseq,
142 ghc-prim,
125 ghc-prim,
text.cabal+24−49
@@ -1,5 +1,5 @@
1name: text
1name: text
2−version: 1.2.2.1
2+version: 1.0.0.0
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: BSD2
34+license: BSD3
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.md
54+ changelog
55 include/*.h
55 include/*.h
56 scripts/*.hs
56 scripts/*.hs
57 tests-and-benchmarks.markdown
57 tests-and-benchmarks.markdown
@@ -59,25 +59,16 @@ 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
64 tests/scripts/*.sh
62 tests/scripts/*.sh
65 tests/text-tests.cabal
63 tests/text-tests.cabal
66
64
67−flag bytestring-builder
68− description: Depend on the bytestring-builder package for backwards compatibility.
69− default: False
70− manual: False
71−
72flag developer
65flag developer
73 description: operate in developer mode
66 description: operate in developer mode
74 default: False
67 default: False
75− manual: True
76
68
77flag integer-simple
69flag integer-simple
78 description: Use the simple integer library instead of GMP
70 description: Use the simple integer library instead of GMP
79 default: False
71 default: False
80− manual: False
81
72
82library
73library
83 c-sources: cbits/cbits.c
74 c-sources: cbits/cbits.c
@@ -91,59 +82,50 @@ library
91 Data.Text.Foreign
82 Data.Text.Foreign
92 Data.Text.IO
83 Data.Text.IO
93 Data.Text.Internal
84 Data.Text.Internal
94− Data.Text.Internal.Builder
85+ Data.Text.Lazy
95− Data.Text.Internal.Builder.Functions
86+ Data.Text.Lazy.Builder
96− Data.Text.Internal.Builder.Int.Digits
87+ Data.Text.Lazy.Builder.Int
97− Data.Text.Internal.Builder.RealFloat.Functions
88+ Data.Text.Lazy.Builder.RealFloat
89+ Data.Text.Lazy.Encoding
90+ Data.Text.Lazy.IO
91+ Data.Text.Lazy.Internal
92+ Data.Text.Internal.Lazy
93+ Data.Text.Lazy.Read
94+ Data.Text.Read
95+ Data.Text.Unsafe
96+ other-modules:
98 Data.Text.Internal.Encoding.Fusion
97 Data.Text.Internal.Encoding.Fusion
99 Data.Text.Internal.Encoding.Fusion.Common
98 Data.Text.Internal.Encoding.Fusion.Common
100 Data.Text.Internal.Encoding.Utf16
99 Data.Text.Internal.Encoding.Utf16
101 Data.Text.Internal.Encoding.Utf32
100 Data.Text.Internal.Encoding.Utf32
102 Data.Text.Internal.Encoding.Utf8
101 Data.Text.Internal.Encoding.Utf8
103− Data.Text.Internal.Functions
104 Data.Text.Internal.Fusion
102 Data.Text.Internal.Fusion
105 Data.Text.Internal.Fusion.CaseMapping
103 Data.Text.Internal.Fusion.CaseMapping
106 Data.Text.Internal.Fusion.Common
104 Data.Text.Internal.Fusion.Common
107 Data.Text.Internal.Fusion.Size
105 Data.Text.Internal.Fusion.Size
108 Data.Text.Internal.Fusion.Types
106 Data.Text.Internal.Fusion.Types
109 Data.Text.Internal.IO
107 Data.Text.Internal.IO
110− Data.Text.Internal.Lazy
108+ Data.Text.Internal.Builder.Functions
109+ Data.Text.Internal.Builder.Int.Digits
110+ Data.Text.Internal.Builder
111+ Data.Text.Internal.Builder.RealFloat.Functions
111 Data.Text.Internal.Lazy.Encoding.Fusion
112 Data.Text.Internal.Lazy.Encoding.Fusion
112 Data.Text.Internal.Lazy.Fusion
113 Data.Text.Internal.Lazy.Fusion
113 Data.Text.Internal.Lazy.Search
114 Data.Text.Internal.Lazy.Search
114 Data.Text.Internal.Private
115 Data.Text.Internal.Private
115− Data.Text.Internal.Read
116 Data.Text.Internal.Search
116 Data.Text.Internal.Search
117 Data.Text.Internal.Unsafe
117 Data.Text.Internal.Unsafe
118 Data.Text.Internal.Unsafe.Char
118 Data.Text.Internal.Unsafe.Char
119 Data.Text.Internal.Unsafe.Shift
119 Data.Text.Internal.Unsafe.Shift
120− Data.Text.Lazy
120+ Data.Text.Internal.Functions
121− Data.Text.Lazy.Builder
122− Data.Text.Lazy.Builder.Int
123− Data.Text.Lazy.Builder.RealFloat
124− Data.Text.Lazy.Encoding
125− Data.Text.Lazy.IO
126− Data.Text.Lazy.Internal
127− Data.Text.Lazy.Read
128− Data.Text.Read
129− Data.Text.Unsafe
130−
131− other-modules:
132− Data.Text.Show
133
121
134 build-depends:
122 build-depends:
135 array >= 0.3,
123 array >= 0.3,
136 base >= 4.2 && < 5,
124 base >= 4.2 && < 5,
137− binary,
125+ bytestring >= 0.9,
138 deepseq >= 1.1.0.0,
126 deepseq >= 1.1.0.0,
139 ghc-prim >= 0.2
127 ghc-prim >= 0.2
140
128
141− if flag(bytestring-builder)
142− build-depends: bytestring >= 0.9 && < 0.10.4,
143− bytestring-builder >= 0.10.4
144− else
145− build-depends: bytestring >= 0.10.4
146−
147 cpp-options: -DHAVE_DEEPSEQ
129 cpp-options: -DHAVE_DEEPSEQ
148 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
130 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
149 if flag(developer)
131 if flag(developer)
@@ -169,29 +151,22 @@ test-suite tests
169 -Wall -threaded -O0 -rtsopts
151 -Wall -threaded -O0 -rtsopts
170
152
171 cpp-options:
153 cpp-options:
172− -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE
154+ -DASSERTS -DHAVE_DEEPSEQ
173
155
174 build-depends:
156 build-depends:
175 HUnit >= 1.2,
157 HUnit >= 1.2,
176− QuickCheck >= 2.7,
158+ QuickCheck >= 2.4,
177 array,
159 array,
178 base,
160 base,
179− binary,
161+ bytestring,
180 deepseq,
162 deepseq,
181 directory,
163 directory,
182 ghc-prim,
164 ghc-prim,
183− quickcheck-unicode,
184 random,
165 random,
185 test-framework >= 0.4,
166 test-framework >= 0.4,
186 test-framework-hunit >= 0.2,
167 test-framework-hunit >= 0.2,
187 test-framework-quickcheck2 >= 0.2
168 test-framework-quickcheck2 >= 0.2
188
169
189− if flag(bytestring-builder)
190− build-depends: bytestring >= 0.9 && < 0.10.4,
191− bytestring-builder >= 0.10.4
192− else
193− build-depends: bytestring >= 0.10.4
194−
195 if flag(integer-simple)
170 if flag(integer-simple)
196 cpp-options: -DINTEGER_SIMPLE
171 cpp-options: -DINTEGER_SIMPLE
197 build-depends: integer-simple >= 0.1 && < 0.5
172 build-depends: integer-simple >= 0.1 && < 0.5