on master help sign in
.gitignorenew file+3
since splitsnapshots
unifiedsplit
@@ -0,0 +1,3 @@
1+dist
2+cabal-dev
3+cabal.sandbox.config
.hgignore+4
@@ -8,3 +8,7 @@
8syntax: glob
8syntax: glob
9.\#*
9.\#*
10cabal-dev
10cabal-dev
11+cabal.sandbox.config
12+\.cabal-sandbox
13+scripts/CaseFolding.txt
14+scripts/SpecialCasing.txt
.hgtags+24
@@ -40,3 +40,27 @@ b75d3041d275e8e76b26605b0d426a572ddf1249 0.11.1.3
401d2c6fa9092c6a4000b2abdd9d01f3efcd477be5 0.11.2.0
401d2c6fa9092c6a4000b2abdd9d01f3efcd477be5 0.11.2.0
4178219784cf3652cc662805bf2971bd62d80210a9 0.11.2.1
4178219784cf3652cc662805bf2971bd62d80210a9 0.11.2.1
424297307ebc11ad677cfba6b40319e7e5e2c0cfee 0.11.2.3
424297307ebc11ad677cfba6b40319e7e5e2c0cfee 0.11.2.3
43+7fa79662b66aade97fe49394977213fe6432942e 0.11.3.0
44+d99cd091cdf71ce807a4255f6cc509c3154f51ea 0.11.3.1
45+31f57612fd425d1bb56352ce6b79e41ce6699a45 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+350−174
@@ -3,6 +3,9 @@
3#if __GLASGOW_HASKELL__ >= 702
3#if __GLASGOW_HASKELL__ >= 702
4{-# LANGUAGE Trustworthy #-}
4{-# LANGUAGE Trustworthy #-}
5#endif
5#endif
6+#if __GLASGOW_HASKELL__ >= 708
7+{-# LANGUAGE TypeFamilies #-}
8+#endif
6
9
7-- |
10-- |
8-- Module : Data.Text
11-- Module : Data.Text
@@ -11,8 +14,7 @@
11-- (c) 2008, 2009 Tom Harper
14-- (c) 2008, 2009 Tom Harper
12--
15--
13-- License : BSD-style
16-- License : BSD-style
14−-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
17+-- Maintainer : bos@serpentine.com
15−-- duncan@haskell.org
16-- Stability : experimental
18-- Stability : experimental
17-- Portability : GHC
19-- Portability : GHC
18--
20--
@@ -30,8 +32,8 @@
30--
32--
31-- To use an extended and very rich family of functions for working
33-- To use an extended and very rich family of functions for working
32-- with Unicode text (including normalization, regular expressions,
34-- with Unicode text (including normalization, regular expressions,
33−-- non-standard encodings, text breaking, and locales), see the
35+-- non-standard encodings, text breaking, and locales), see
34−-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>
36+-- <http://hackage.haskell.org/package/text-icu the text-icu package >.
35
37
36module Data.Text
38module Data.Text
37 (
39 (
@@ -79,6 +81,7 @@ module Data.Text
79 , toCaseFold
81 , toCaseFold
80 , toLower
82 , toLower
81 , toUpper
83 , toUpper
84+ , toTitle
82
85
83 -- ** Justification
86 -- ** Justification
84 , justifyLeft
87 , justifyLeft
@@ -122,8 +125,11 @@ module Data.Text
122
125
123 -- ** Breaking strings
126 -- ** Breaking strings
124 , take
127 , take
128+ , takeEnd
125 , drop
129 , drop
130+ , dropEnd
126 , takeWhile
131 , takeWhile
132+ , takeWhileEnd
127 , dropWhile
133 , dropWhile
128 , dropWhileEnd
134 , dropWhileEnd
129 , dropAround
135 , dropAround
@@ -177,92 +183,103 @@ module Data.Text
177 , findIndex
183 , findIndex
178 , count
184 , count
179
185
180− -- * Zipping and unzipping
186+ -- * Zipping
181 , zip
187 , zip
182 , zipWith
188 , zipWith
183
189
184 -- -* Ordered text
190 -- -* Ordered text
185 -- , sort
191 -- , sort
192+
193+ -- * Low level operations
194+ , copy
195+ , unpackCString#
186 ) where
196 ) where
187
197
188import Prelude (Char, Bool(..), Int, Maybe(..), String,
198import Prelude (Char, Bool(..), Int, Maybe(..), String,
189 Eq(..), Ord(..), Ordering(..), (++),
199 Eq(..), Ord(..), Ordering(..), (++),
190− Read(..), Show(..),
200+ Read(..),
191− (&&), (||), (+), (-), (.), ($), ($!), (>>), (*),
201+ (&&), (||), (+), (-), (.), ($), ($!), (>>),
192− div, maxBound, not, return, otherwise)
202+ not, return, otherwise, quot)
193#if defined(HAVE_DEEPSEQ)
203#if defined(HAVE_DEEPSEQ)
194−import Control.DeepSeq (NFData)
204+import Control.DeepSeq (NFData(rnf))
195#endif
205#endif
196#if defined(ASSERTS)
206#if defined(ASSERTS)
197import Control.Exception (assert)
207import Control.Exception (assert)
198#endif
208#endif
199import Data.Char (isSpace)
209import Data.Char (isSpace)
200−import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))
210+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
201−#if __GLASGOW_HASKELL__ >= 612
211+ Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
202−import Data.Data (mkNoRepType)
203−#else
204−import Data.Data (mkNorepType)
205−#endif
206import Control.Monad (foldM)
212import Control.Monad (foldM)
213+import Control.Monad.ST (ST)
207import qualified Data.Text.Array as A
214import qualified Data.Text.Array as A
208import qualified Data.List as L
215import qualified Data.List as L
216+import Data.Binary (Binary(get, put))
209import Data.Monoid (Monoid(..))
217import Data.Monoid (Monoid(..))
218+#if MIN_VERSION_base(4,9,0)
219+import Data.Semigroup (Semigroup(..))
220+#endif
210import Data.String (IsString(..))
221import Data.String (IsString(..))
211−import qualified Data.Text.Fusion as S
222+import qualified Data.Text.Internal.Fusion as S
212−import qualified Data.Text.Fusion.Common as S
223+import qualified Data.Text.Internal.Fusion.Common as S
224+import Data.Text.Encoding (decodeUtf8', encodeUtf8)
213−import Data.Text.Fusion (stream, reverseStream, unstream)
225+import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
214−import Data.Text.Private (span_)
226+import Data.Text.Internal.Private (span_)
215−import Data.Text.Internal (Text(..), empty, firstf, safe, text, textP)
227+import Data.Text.Internal (Text(..), empty, firstf, mul, safe, text)
228+import Data.Text.Show (singleton, unpack, unpackCString#)
216import qualified Prelude as P
229import qualified Prelude as P
217import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
230import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
218− unsafeHead, unsafeTail)
231+ reverseIter_, unsafeHead, unsafeTail)
219−import Data.Text.UnsafeChar (unsafeChr)
232+import Data.Text.Internal.Unsafe.Char (unsafeChr)
220−import qualified Data.Text.Util as U
233+import qualified Data.Text.Internal.Functions as F
221−import qualified Data.Text.Encoding.Utf16 as U16
234+import qualified Data.Text.Internal.Encoding.Utf16 as U16
222−import Data.Text.Search (indices)
235+import Data.Text.Internal.Search (indices)
223#if defined(__HADDOCK__)
236#if defined(__HADDOCK__)
224import Data.ByteString (ByteString)
237import Data.ByteString (ByteString)
225import qualified Data.Text.Lazy as L
238import qualified Data.Text.Lazy as L
226import Data.Int (Int64)
239import Data.Int (Int64)
227#endif
240#endif
241+import GHC.Base (eqInt, neInt, gtInt, geInt, ltInt, leInt)
228−#if __GLASGOW_HASKELL__ >= 702
242+#if __GLASGOW_HASKELL__ >= 708
229−import qualified GHC.CString as GHC
243+import qualified GHC.Exts as Exts
230−#else
244+#endif
231−import qualified GHC.Base as GHC
245+#if MIN_VERSION_base(4,7,0)
246+import Text.Printf (PrintfArg, formatArg, formatString)
232#endif
247#endif
233−import GHC.Prim (Addr#)
234
248
235-- $strict
249-- $strict
236--
250--
237-- This package provides both strict and lazy 'Text' types. The
251-- This package provides both strict and lazy 'Text' types. The
238−-- strict type is provided by the 'Data.Text' package, while the lazy
252+-- strict type is provided by the "Data.Text" module, while the lazy
239−-- type is provided by the 'Data.Text.Lazy' package. Internally, the
253+-- type is provided by the "Data.Text.Lazy" module. Internally, the
240-- lazy @Text@ type consists of a list of strict chunks.
254-- lazy @Text@ type consists of a list of strict chunks.
241--
255--
242-- The strict 'Text' type requires that an entire string fit into
256-- The strict 'Text' type requires that an entire string fit into
243−-- memory at once. The lazy @Text@ type is capable of streaming
257+-- memory at once. The lazy 'Data.Text.Lazy.Text' type is capable of
244−-- strings that are larger than memory using a small memory footprint.
258+-- streaming strings that are larger than memory using a small memory
245−-- In many cases, the overhead of chunked streaming makes the lazy
259+-- footprint. In many cases, the overhead of chunked streaming makes
246−-- @Text@ type slower than its strict counterpart, but this is not
260+-- the lazy 'Data.Text.Lazy.Text' type slower than its strict
247−-- always the case. Sometimes, the time complexity of a function in
261+-- counterpart, but this is not always the case. Sometimes, the time
248−-- one module may be different from the other, due to their differing
262+-- complexity of a function in one module may be different from the
249−-- internal structures.
263+-- other, due to their differing internal structures.
250--
264--
251-- Each module provides an almost identical API, with the main
265-- Each module provides an almost identical API, with the main
252-- difference being that the strict module uses 'Int' values for
266-- difference being that the strict module uses 'Int' values for
253−-- lengths and counts, while the lazy module uses 'Int64' lengths.
267+-- lengths and counts, while the lazy module uses 'Data.Int.Int64'
268+-- lengths.
254
269
255-- $replacement
270-- $replacement
256--
271--
257-- A 'Text' value is a sequence of Unicode scalar values, as defined
272-- A 'Text' value is a sequence of Unicode scalar values, as defined
273+-- in
258−-- in &#xa7;3.9, definition D76 of the Unicode 5.2 standard:
274+-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35 §3.9, definition D76 of the Unicode 5.2 standard >.
259−-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35>. As
260−-- such, a 'Text' cannot contain values in the range U+D800 to U+DFFF
275+-- As such, a 'Text' cannot contain values in the range U+D800 to
261−-- inclusive. Haskell implementations admit all Unicode code points
276+-- U+DFFF inclusive. Haskell implementations admit all Unicode code
277+-- points
278+-- (<http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=13 §3.4, definition D10 >)
262−-- (&#xa7;3.4, definition D10) as 'Char' values, including code points
279+-- as 'Char' values, including code points from this invalid range.
263−-- from this invalid range. This means that there are some 'Char'
280+-- This means that there are some 'Char' values that are not valid
264−-- values that are not valid Unicode scalar values, and the functions
281+-- Unicode scalar values, and the functions in this module must handle
265−-- in this module must handle those cases.
282+-- those cases.
266--
283--
267-- Within this module, many functions construct a 'Text' from one or
284-- Within this module, many functions construct a 'Text' from one or
268-- more 'Char' values. Those functions will substitute 'Char' values
285-- more 'Char' values. Those functions will substitute 'Char' values
@@ -276,8 +293,8 @@ import GHC.Prim (Addr#)
276-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate
293-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate
277-- code points, and so cannot be represented. The functions replace
294-- code points, and so cannot be represented. The functions replace
278-- invalid scalar values, instead of dropping them, as a security
295-- invalid scalar values, instead of dropping them, as a security
279−-- measure. For details, see Unicode Technical Report 36, &#xa7;3.5:
296+-- measure. For details, see
280−-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters>)
297+-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters Unicode Technical Report 36, §3.5 >.)
281
298
282-- $fusion
299-- $fusion
283--
300--
@@ -295,11 +312,11 @@ import GHC.Prim (Addr#)
295-- > countChars = T.length . T.toUpper . E.decodeUtf8
312-- > countChars = T.length . T.toUpper . E.decodeUtf8
296--
313--
297-- From the type signatures involved, this looks like it should
314-- From the type signatures involved, this looks like it should
298−-- allocate one 'ByteString' value, and two 'Text' values. However,
315+-- allocate one 'Data.ByteString.ByteString' value, and two 'Text'
299−-- when a module is compiled with optimisation enabled under GHC, the
316+-- values. However, when a module is compiled with optimisation
300−-- two intermediate 'Text' values will be optimised away, and the
317+-- enabled under GHC, the two intermediate 'Text' values will be
301−-- function will be compiled down to a single loop over the source
318+-- optimised away, and the function will be compiled down to a single
302−-- 'ByteString'.
319+-- loop over the source 'Data.ByteString.ByteString'.
303--
320--
304-- Functions that can be fused by the compiler are documented with the
321-- Functions that can be fused by the compiler are documented with the
305-- phrase \"Subject to fusion\".
322-- phrase \"Subject to fusion\".
@@ -313,46 +330,83 @@ instance Eq Text where
313instance Ord Text where
330instance Ord Text where
314 compare = compareText
331 compare = compareText
315
332
316−instance Show Text where
317− showsPrec p ps r = showsPrec p (unpack ps) r
318−
319instance Read Text where
333instance Read Text where
320 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
334 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
321
335
336+#if MIN_VERSION_base(4,9,0)
337+-- Semigroup orphan instances for older GHCs are provided by
338+-- 'semigroups` package
339+
340+instance Semigroup Text where
341+ (<>) = append
342+#endif
343+
322instance Monoid Text where
344instance Monoid Text where
323 mempty = empty
345 mempty = empty
346+#if MIN_VERSION_base(4,9,0)
347+ mappend = (<>) -- future-proof definition
348+#else
324 mappend = append
349 mappend = append
350+#endif
325 mconcat = concat
351 mconcat = concat
326
352
327instance IsString Text where
353instance IsString Text where
328 fromString = pack
354 fromString = pack
329
355
356+#if __GLASGOW_HASKELL__ >= 708
357+instance Exts.IsList Text where
358+ type Item Text = Char
359+ fromList = pack
360+ toList = unpack
361+#endif
362+
330#if defined(HAVE_DEEPSEQ)
363#if defined(HAVE_DEEPSEQ)
331−instance NFData Text
364+instance NFData Text where rnf !_ = ()
332#endif
365#endif
333
366
367+instance Binary Text where
368+ put t = put (encodeUtf8 t)
369+ get = do
370+ bs <- get
371+ case decodeUtf8' bs of
372+ P.Left exn -> P.fail (P.show exn)
373+ P.Right a -> P.return a
374+
334−-- This instance preserves data abstraction at the cost of inefficiency.
375+-- | This instance preserves data abstraction at the cost of inefficiency.
335-- We omit reflection services for the sake of data abstraction.
376-- We omit reflection services for the sake of data abstraction.
336--
377--
337−-- This instance was created by copying the behavior of Data.Set and
378+-- This instance was created by copying the updated behavior of
379+-- @"Data.Set".@'Data.Set.Set' and @"Data.Map".@'Data.Map.Map'. If you
338−-- Data.Map. If you feel a mistake has been made, please feel free to
380+-- feel a mistake has been made, please feel free to submit
339−-- submit improvements.
381+-- improvements.
340--
382--
341−-- Original discussion is archived here:
383+-- The original discussion is archived here:
342−
343−-- "could we get a Data instance for Data.Text.Text?"
344−-- http://groups.google.com/group/haskell-cafe/browse_thread/thread/b5bbb1b28a7e525d/0639d46852575b93
384+-- <http://groups.google.com/group/haskell-cafe/browse_thread/thread/b5bbb1b28a7e525d/0639d46852575b93 could we get a Data instance for Data.Text.Text? >
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, ... >
345
389
346instance Data Text where
390instance Data Text where
347 gfoldl f z txt = z pack `f` (unpack txt)
391 gfoldl f z txt = z pack `f` (unpack txt)
348− toConstr _ = P.error "Data.Text.Text.toConstr"
392+ toConstr _ = packConstr
393+ gunfold k z c = case constrIndex c of
394+ 1 -> k (z pack)
349− gunfold _ _ = P.error "Data.Text.Text.gunfold"
395+ _ -> P.error "gunfold"
350−#if __GLASGOW_HASKELL__ >= 612
396+ dataTypeOf _ = textDataType
351− dataTypeOf _ = mkNoRepType "Data.Text.Text"
397+
352−#else
398+#if MIN_VERSION_base(4,7,0)
353− dataTypeOf _ = mkNorepType "Data.Text.Text"
399+-- | Only defined for @base-4.7.0.0@ and later
400+instance PrintfArg Text where
401+ formatArg txt = formatString $ unpack txt
354#endif
402#endif
355
403
404+packConstr :: Constr
405+packConstr = mkConstr textDataType "pack" [] Prefix
406+
407+textDataType :: DataType
408+textDataType = mkDataType "Data.Text.Text" [packConstr]
409+
356-- | /O(n)/ Compare two 'Text' values lexicographically.
410-- | /O(n)/ Compare two 'Text' values lexicographically.
357compareText :: Text -> Text -> Ordering
411compareText :: Text -> Text -> Ordering
358compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)
412compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)
@@ -376,30 +430,6 @@ pack :: String -> Text
376pack = unstream . S.map safe . S.streamList
430pack = unstream . S.map safe . S.streamList
377{-# INLINE [1] pack #-}
431{-# INLINE [1] pack #-}
378
432
379−-- | /O(n)/ Convert a Text into a String. Subject to fusion.
380−unpack :: Text -> String
381−unpack = S.unstreamList . stream
382−{-# INLINE [1] unpack #-}
383−
384−-- | /O(n)/ Convert a literal string into a Text. Subject to fusion.
385−unpackCString# :: Addr# -> Text
386−unpackCString# addr# = unstream (S.streamCString# addr#)
387−{-# NOINLINE unpackCString# #-}
388−
389−{-# RULES "TEXT literal" forall a.
390− unstream (S.map safe (S.streamList (GHC.unpackCString# a)))
391− = unpackCString# a #-}
392−
393−{-# RULES "TEXT literal UTF8" forall a.
394− unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))
395− = unpackCString# a #-}
396−
397−-- | /O(1)/ Convert a character into a Text. Subject to fusion.
398−-- Performs replacement on invalid scalar values.
399−singleton :: Char -> Text
400−singleton = unstream . S.singleton . safe
401−{-# INLINE [1] singleton #-}
402−
403-- -----------------------------------------------------------------------------
433-- -----------------------------------------------------------------------------
404-- * Basic functions
434-- * Basic functions
405
435
@@ -430,12 +460,13 @@ append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
430 | otherwise = overflowError "append"
460 | otherwise = overflowError "append"
431 where
461 where
432 len = len1+len2
462 len = len1+len2
463+ x :: ST s (A.MArray s)
433 x = do
464 x = do
434 arr <- A.new len
465 arr <- A.new len
435 A.copyI arr 0 arr1 off1 len1
466 A.copyI arr 0 arr1 off1 len1
436 A.copyI arr len1 arr2 off2 len
467 A.copyI arr len1 arr2 off2 len
437 return arr
468 return arr
438−{-# INLINE append #-}
469+{-# NOINLINE append #-}
439
470
440{-# RULES
471{-# RULES
441"TEXT append -> fused" [~1] forall t1 t2.
472"TEXT append -> fused" [~1] forall t1 t2.
@@ -455,8 +486,8 @@ head t = S.head (stream t)
455uncons :: Text -> Maybe (Char, Text)
486uncons :: Text -> Maybe (Char, Text)
456uncons t@(Text arr off len)
487uncons t@(Text arr off len)
457 | len <= 0 = Nothing
488 | len <= 0 = Nothing
489+ | otherwise = Just $ let !(Iter c d) = iter t 0
458− | otherwise = Just (c, textP arr (off+d) (len-d))
490+ in (c, text arr (off+d) (len-d))
459− where Iter c d = iter t 0
460{-# INLINE [1] uncons #-}
491{-# INLINE [1] uncons #-}
461
492
462-- | Lifted from Control.Arrow and specialized.
493-- | Lifted from Control.Arrow and specialized.
@@ -486,7 +517,7 @@ last (Text arr off len)
486tail :: Text -> Text
517tail :: Text -> Text
487tail t@(Text arr off len)
518tail t@(Text arr off len)
488 | len <= 0 = emptyError "tail"
519 | len <= 0 = emptyError "tail"
489− | otherwise = textP arr (off+d) (len-d)
520+ | otherwise = text arr (off+d) (len-d)
490 where d = iter_ t 0
521 where d = iter_ t 0
491{-# INLINE [1] tail #-}
522{-# INLINE [1] tail #-}
492
523
@@ -501,8 +532,8 @@ tail t@(Text arr off len)
501-- be non-empty. Subject to fusion.
532-- be non-empty. Subject to fusion.
502init :: Text -> Text
533init :: Text -> Text
503init (Text arr off len) | len <= 0 = emptyError "init"
534init (Text arr off len) | len <= 0 = emptyError "init"
504− | n >= 0xDC00 && n <= 0xDFFF = textP arr off (len-2)
535+ | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)
505− | otherwise = textP arr off (len-1)
536+ | otherwise = text arr off (len-1)
506 where
537 where
507 n = A.unsafeIndex arr (off+len-1)
538 n = A.unsafeIndex arr (off+len-1)
508{-# INLINE [1] init #-}
539{-# INLINE [1] init #-}
@@ -541,7 +572,9 @@ isSingleton = S.isSingleton . stream
541-- Subject to fusion.
572-- Subject to fusion.
542length :: Text -> Int
573length :: Text -> Int
543length t = S.length (stream t)
574length t = S.length (stream t)
544−{-# INLINE length #-}
575+{-# INLINE [0] length #-}
576+-- length needs to be phased after the compareN/length rules otherwise
577+-- it may inline before the rules have an opportunity to fire.
545
578
546-- | /O(n)/ Compare the count of characters in a 'Text' to a number.
579-- | /O(n)/ Compare the count of characters in a 'Text' to a number.
547-- Subject to fusion.
580-- Subject to fusion.
@@ -560,32 +593,32 @@ compareLength t n = S.compareLengthI (stream t) n
560
593
561{-# RULES
594{-# RULES
562"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.
595"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.
563− (==) (length t) n = compareLength t n == EQ
596+ eqInt (length t) n = compareLength t n == EQ
564 #-}
597 #-}
565
598
566{-# RULES
599{-# RULES
567"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.
600"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.
568− (/=) (length t) n = compareLength t n /= EQ
601+ neInt (length t) n = compareLength t n /= EQ
569 #-}
602 #-}
570
603
571{-# RULES
604{-# RULES
572"TEXT <N/length -> compareLength/==LT" [~1] forall t n.
605"TEXT <N/length -> compareLength/==LT" [~1] forall t n.
573− (<) (length t) n = compareLength t n == LT
606+ ltInt (length t) n = compareLength t n == LT
574 #-}
607 #-}
575
608
576{-# RULES
609{-# RULES
577"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.
610"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.
578− (<=) (length t) n = compareLength t n /= GT
611+ leInt (length t) n = compareLength t n /= GT
579 #-}
612 #-}
580
613
581{-# RULES
614{-# RULES
582"TEXT >N/length -> compareLength/==GT" [~1] forall t n.
615"TEXT >N/length -> compareLength/==GT" [~1] forall t n.
583− (>) (length t) n = compareLength t n == GT
616+ gtInt (length t) n = compareLength t n == GT
584 #-}
617 #-}
585
618
586{-# RULES
619{-# RULES
587"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.
620"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.
588− (>=) (length t) n = compareLength t n /= LT
621+ geInt (length t) n = compareLength t n /= LT
589 #-}
622 #-}
590
623
591-- -----------------------------------------------------------------------------
624-- -----------------------------------------------------------------------------
@@ -601,7 +634,7 @@ map f t = unstream (S.map (safe . f) (stream t))
601-- 'Text's and concatenates the list after interspersing the first
634-- 'Text's and concatenates the list after interspersing the first
602-- argument between each element of the list.
635-- argument between each element of the list.
603intercalate :: Text -> [Text] -> Text
636intercalate :: Text -> [Text] -> Text
604−intercalate t = concat . (U.intersperse t)
637+intercalate t = concat . (F.intersperse t)
605{-# INLINE intercalate #-}
638{-# INLINE intercalate #-}
606
639
607-- | /O(n)/ The 'intersperse' function takes a character and places it
640-- | /O(n)/ The 'intersperse' function takes a character and places it
@@ -616,16 +649,59 @@ reverse :: Text -> Text
616reverse t = S.reverse (stream t)
649reverse t = S.reverse (stream t)
617{-# INLINE reverse #-}
650{-# INLINE reverse #-}
618
651
619−-- | /O(m+n)/ Replace every occurrence of one substring with another.
652+-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
653+-- @haystack@ with @replacement@.
654+--
655+-- This function behaves as though it was defined as follows:
656+--
657+-- @
658+-- replace needle replacement haystack =
659+-- 'intercalate' replacement ('splitOn' needle haystack)
660+-- @
661+--
662+-- As this suggests, each occurrence is replaced exactly once. So if
663+-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
664+-- be replaced recursively:
665+--
666+-- > replace "oo" "foo" "oo" == "foo"
667+--
668+-- In cases where several instances of @needle@ overlap, only the
669+-- first one will be replaced:
670+--
671+-- > replace "ofo" "bar" "ofofo" == "barfo"
620--
672--
621-- In (unlikely) bad cases, this function's time complexity degrades
673-- In (unlikely) bad cases, this function's time complexity degrades
622-- towards /O(n*m)/.
674-- towards /O(n*m)/.
623−replace :: Text -- ^ Text to search for
675+replace :: Text
624− -> Text -- ^ Replacement text
676+ -- ^ @needle@ to search for. If this string is empty, an
677+ -- error will occur.
625− -> Text -- ^ Input text
678+ -> Text
679+ -- ^ @replacement@ to replace @needle@ with.
626 -> Text
680 -> Text
627−replace s d = intercalate d . splitOn s
681+ -- ^ @haystack@ in which to search.
628−{-# INLINE replace #-}
682+ -> Text
683+replace needle@(Text _ _ neeLen)
684+ (Text repArr repOff repLen)
685+ haystack@(Text hayArr hayOff hayLen)
686+ | neeLen == 0 = emptyError "replace"
687+ | L.null ixs = haystack
688+ | len > 0 = Text (A.run x) 0 len
689+ | otherwise = empty
690+ where
691+ ixs = indices needle haystack
692+ len = hayLen - (neeLen - repLen) `mul` L.length ixs
693+ x :: ST s (A.MArray s)
694+ x = do
695+ marr <- A.new len
696+ let loop (i:is) o d = do
697+ let d0 = d + i - o
698+ d1 = d0 + repLen
699+ A.copyI marr d hayArr (hayOff+o) d0
700+ A.copyI marr d0 repArr repOff d1
701+ loop is (i + neeLen) d1
702+ loop [] o d = A.copyI marr d hayArr (hayOff+o) len
703+ loop ixs 0 0
704+ return marr
629
705
630-- ----------------------------------------------------------------------------
706-- ----------------------------------------------------------------------------
631-- ** Case conversions (folds)
707-- ** Case conversions (folds)
@@ -644,13 +720,13 @@ replace s d = intercalate d . splitOn s
644-- /Note/: In some languages, case conversion is a locale- and
720-- /Note/: In some languages, case conversion is a locale- and
645-- context-dependent operation. The case conversion functions in this
721-- context-dependent operation. The case conversion functions in this
646-- module are /not/ locale sensitive. Programs that require locale
722-- module are /not/ locale sensitive. Programs that require locale
647−-- sensitivity should use appropriate versions of the case mapping
723+-- sensitivity should use appropriate versions of the
648−-- functions from the @text-icu@ package:
649−-- <http://hackage.haskell.org/package/text-icu>
724+-- <http://hackage.haskell.org/package/text-icu-0.6.3.7/docs/Data-Text-ICU.html#g:4 case mapping functions from the text-icu package >.
650
725
651−-- | /O(n)/ Convert a string to folded case. This function is mainly
726+-- | /O(n)/ Convert a string to folded case. Subject to fusion.
727+--
652−-- useful for performing caseless (also known as case insensitive)
728+-- This function is mainly useful for performing caseless (also known
653−-- string comparisons.
729+-- as case insensitive) string comparisons.
654--
730--
655-- A string @x@ is a caseless match for a string @y@ if and only if:
731-- A string @x@ is a caseless match for a string @y@ if and only if:
656--
732--
@@ -665,25 +741,51 @@ replace s d = intercalate d . splitOn s
665-- instead of itself.
741-- instead of itself.
666toCaseFold :: Text -> Text
742toCaseFold :: Text -> Text
667toCaseFold t = unstream (S.toCaseFold (stream t))
743toCaseFold t = unstream (S.toCaseFold (stream t))
668−{-# INLINE [0] toCaseFold #-}
744+{-# INLINE toCaseFold #-}
669
745
670-- | /O(n)/ Convert a string to lower case, using simple case
746-- | /O(n)/ Convert a string to lower case, using simple case
747+-- conversion. Subject to fusion.
748+--
671−-- conversion. The result string may be longer than the input string.
749+-- The result string may be longer than the input string. For
672−-- For instance, \"&#x130;\" (Latin capital letter I with dot above,
750+-- instance, \"&#x130;\" (Latin capital letter I with dot above,
673−-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069) followed
751+-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)
674−-- by \" &#x307;\" (combining dot above, U+0307).
752+-- followed by \" &#x307;\" (combining dot above, U+0307).
675toLower :: Text -> Text
753toLower :: Text -> Text
676toLower t = unstream (S.toLower (stream t))
754toLower t = unstream (S.toLower (stream t))
677{-# INLINE toLower #-}
755{-# INLINE toLower #-}
678
756
679-- | /O(n)/ Convert a string to upper case, using simple case
757-- | /O(n)/ Convert a string to upper case, using simple case
758+-- conversion. Subject to fusion.
759+--
680−-- conversion. The result string may be longer than the input string.
760+-- The result string may be longer than the input string. For
681−-- For instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the
761+-- instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the
682-- two-letter sequence \"SS\".
762-- two-letter sequence \"SS\".
683toUpper :: Text -> Text
763toUpper :: Text -> Text
684toUpper t = unstream (S.toUpper (stream t))
764toUpper t = unstream (S.toUpper (stream t))
685{-# INLINE toUpper #-}
765{-# INLINE toUpper #-}
686
766
767+-- | /O(n)/ Convert a string to title case, using simple case
768+-- conversion. Subject to fusion.
769+--
770+-- The first letter of the input is converted to title case, as is
771+-- every subsequent letter that immediately follows a non-letter.
772+-- Every letter that immediately follows another letter is converted
773+-- to lower case.
774+--
775+-- The result string may be longer than the input string. For example,
776+-- the Latin small ligature &#xfb02; (U+FB02) is converted to the
777+-- sequence Latin capital letter F (U+0046) followed by Latin small
778+-- letter l (U+006C).
779+--
780+-- /Note/: this function does not take language or culture specific
781+-- rules into account. For instance, in English, different style
782+-- guides disagree on whether the book name \"The Hill of the Red
783+-- Fox\" is correctly title cased&#x2014;but this function will
784+-- capitalize /every/ word.
785+toTitle :: Text -> Text
786+toTitle t = unstream (S.toTitle (stream t))
787+{-# INLINE toTitle #-}
788+
687-- | /O(n)/ Left-justify a string to the given length, using the
789-- | /O(n)/ Left-justify a string to the given length, using the
688-- specified fill character on the right. Subject to fusion.
790-- specified fill character on the right. Subject to fusion.
689-- Performs replacement on invalid scalar values.
791-- Performs replacement on invalid scalar values.
@@ -734,7 +836,7 @@ center k c t
734 | otherwise = replicateChar l c `append` t `append` replicateChar r c
836 | otherwise = replicateChar l c `append` t `append` replicateChar r c
735 where len = length t
837 where len = length t
736 d = k - len
838 d = k - len
737− r = d `div` 2
839+ r = d `quot` 2
738 l = d - r
840 l = d - r
739{-# INLINE center #-}
841{-# INLINE center #-}
740
842
@@ -799,6 +901,7 @@ concat ts = case ts' of
799 where
901 where
800 ts' = L.filter (not . null) ts
902 ts' = L.filter (not . null) ts
801 len = sumP "concat" $ L.map lengthWord16 ts'
903 len = sumP "concat" $ L.map lengthWord16 ts'
904+ go :: ST s (A.MArray s)
802 go = do
905 go = do
803 arr <- A.new len
906 arr <- A.new len
804 let step i (Text a o l) =
907 let step i (Text a o l) =
@@ -812,13 +915,13 @@ concatMap f = concat . foldr ((:) . f) []
812{-# INLINE concatMap #-}
915{-# INLINE concatMap #-}
813
916
814-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
917-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
815−-- 'Text' @t@ satisifes the predicate @p@. Subject to fusion.
918+-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
816any :: (Char -> Bool) -> Text -> Bool
919any :: (Char -> Bool) -> Text -> Bool
817any p t = S.any p (stream t)
920any p t = S.any p (stream t)
818{-# INLINE any #-}
921{-# INLINE any #-}
819
922
820-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
923-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
821−-- 'Text' @t@ satisify the predicate @p@. Subject to fusion.
924+-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
822all :: (Char -> Bool) -> Text -> Bool
925all :: (Char -> Bool) -> Text -> Bool
823all p t = S.all p (stream t)
926all p t = S.all p (stream t)
824{-# INLINE all #-}
927{-# INLINE all #-}
@@ -906,13 +1009,13 @@ mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream
906-- @t@ repeated @n@ times.
1009-- @t@ repeated @n@ times.
907replicate :: Int -> Text -> Text
1010replicate :: Int -> Text -> Text
908replicate n t@(Text a o l)
1011replicate n t@(Text a o l)
909− | n <= 0 || l <= 0 = empty
1012+ | n <= 0 || l <= 0 = empty
910− | n == 1 = t
1013+ | n == 1 = t
911− | isSingleton t = replicateChar n (unsafeHead t)
1014+ | isSingleton t = replicateChar n (unsafeHead t)
912− | n <= maxBound `div` l = Text (A.run x) 0 len
1015+ | otherwise = Text (A.run x) 0 len
913− | otherwise = overflowError "replicate"
914 where
1016 where
915− len = l * n
1017+ len = l `mul` n
1018+ x :: ST s (A.MArray s)
916 x = do
1019 x = do
917 arr <- A.new len
1020 arr <- A.new len
918 let loop !d !i | i >= n = return arr
1021 let loop !d !i | i >= n = return arr
@@ -963,14 +1066,16 @@ take :: Int -> Text -> Text
963take n t@(Text arr off len)
1066take n t@(Text arr off len)
964 | n <= 0 = empty
1067 | n <= 0 = empty
965 | n >= len = t
1068 | n >= len = t
966− | otherwise = Text arr off (loop 0 0)
1069+ | otherwise = text arr off (iterN n t)
967− where
968− loop !i !cnt
969− | i >= len || cnt >= n = i
970− | otherwise = loop (i+d) (cnt+1)
971− where d = iter_ t i
972{-# INLINE [1] take #-}
1070{-# INLINE [1] take #-}
973
1071
1072+iterN :: Int -> Text -> Int
1073+iterN n t@(Text _arr _off len) = loop 0 0
1074+ where loop !i !cnt
1075+ | i >= len || cnt >= n = i
1076+ | otherwise = loop (i+d) (cnt+1)
1077+ where d = iter_ t i
1078+
974{-# RULES
1079{-# RULES
975"TEXT take -> fused" [~1] forall n t.
1080"TEXT take -> fused" [~1] forall n t.
976 take n t = unstream (S.take n (stream t))
1081 take n t = unstream (S.take n (stream t))
@@ -978,6 +1083,27 @@ take n t@(Text arr off len)
978 unstream (S.take n (stream t)) = take n t
1083 unstream (S.take n (stream t)) = take n t
979 #-}
1084 #-}
980
1085
1086+-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after
1087+-- taking @n@ characters from the end of @t@.
1088+--
1089+-- Examples:
1090+--
1091+-- > takeEnd 3 "foobar" == "bar"
1092+takeEnd :: Int -> Text -> Text
1093+takeEnd n t@(Text arr off len)
1094+ | n <= 0 = empty
1095+ | n >= len = t
1096+ | otherwise = text arr (off+i) (len-i)
1097+ where i = iterNEnd n t
1098+
1099+iterNEnd :: Int -> Text -> Int
1100+iterNEnd n t@(Text _arr _off len) = loop (len-1) n
1101+ where loop i !m
1102+ | i <= 0 = 0
1103+ | m <= 1 = i
1104+ | otherwise = loop (i+d) (m-1)
1105+ where d = reverseIter_ t i
1106+
981-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1107-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
982-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1108-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
983-- is greater than the length of the 'Text'. Subject to fusion.
1109-- is greater than the length of the 'Text'. Subject to fusion.
@@ -985,11 +1111,8 @@ drop :: Int -> Text -> Text
985drop n t@(Text arr off len)
1111drop n t@(Text arr off len)
986 | n <= 0 = t
1112 | n <= 0 = t
987 | n >= len = empty
1113 | n >= len = empty
988− | otherwise = loop 0 0
1114+ | otherwise = text arr (off+i) (len-i)
989− where loop !i !cnt
990− | i >= len || cnt >= n = Text arr (off+i) (len-i)
991− | otherwise = loop (i+d) (cnt+1)
992− where d = iter_ t i
1115+ where i = iterN n t
993{-# INLINE [1] drop #-}
1116{-# INLINE [1] drop #-}
994
1117
995{-# RULES
1118{-# RULES
@@ -999,6 +1122,18 @@ drop n t@(Text arr off len)
999 unstream (S.drop n (stream t)) = drop n t
1122 unstream (S.drop n (stream t)) = drop n t
1000 #-}
1123 #-}
1001
1124
1125+-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after
1126+-- dropping @n@ characters from the end of @t@.
1127+--
1128+-- Examples:
1129+--
1130+-- > dropEnd 3 "foobar" == "foo"
1131+dropEnd :: Int -> Text -> Text
1132+dropEnd n t@(Text arr off len)
1133+ | n <= 0 = t
1134+ | n >= len = empty
1135+ | otherwise = text arr off (iterNEnd n t)
1136+
1002-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1137-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1003-- returns the longest prefix (possibly empty) of elements that
1138-- returns the longest prefix (possibly empty) of elements that
1004-- satisfy @p@. Subject to fusion.
1139-- satisfy @p@. Subject to fusion.
@@ -1006,7 +1141,7 @@ takeWhile :: (Char -> Bool) -> Text -> Text
1006takeWhile p t@(Text arr off len) = loop 0
1141takeWhile p t@(Text arr off len) = loop 0
1007 where loop !i | i >= len = t
1142 where loop !i | i >= len = t
1008 | p c = loop (i+d)
1143 | p c = loop (i+d)
1009− | otherwise = textP arr off i
1144+ | otherwise = text arr off i
1010 where Iter c d = iter t i
1145 where Iter c d = iter t i
1011{-# INLINE [1] takeWhile #-}
1146{-# INLINE [1] takeWhile #-}
1012
1147
@@ -1017,6 +1152,27 @@ takeWhile p t@(Text arr off len) = loop 0
1017 unstream (S.takeWhile p (stream t)) = takeWhile p t
1152 unstream (S.takeWhile p (stream t)) = takeWhile p t
1018 #-}
1153 #-}
1019
1154
1155+-- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',
1156+-- returns the longest suffix (possibly empty) of elements that
1157+-- satisfy @p@. Subject to fusion.
1158+-- Examples:
1159+--
1160+-- > takeWhileEnd (=='o') "foo" == "oo"
1161+takeWhileEnd :: (Char -> Bool) -> Text -> Text
1162+takeWhileEnd p t@(Text arr off len) = loop (len-1) len
1163+ where loop !i !l | l <= 0 = t
1164+ | p c = loop (i+d) (l+d)
1165+ | otherwise = text arr (off+l) (len-l)
1166+ where (c,d) = reverseIter t i
1167+{-# INLINE [1] takeWhileEnd #-}
1168+
1169+{-# RULES
1170+"TEXT takeWhileEnd -> fused" [~1] forall p t.
1171+ takeWhileEnd p t = S.reverse (S.takeWhile p (S.reverseStream t))
1172+"TEXT takeWhileEnd -> unfused" [1] forall p t.
1173+ S.reverse (S.takeWhile p (S.reverseStream t)) = takeWhileEnd p t
1174+ #-}
1175+
1020-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1176-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1021-- 'takeWhile' @p@ @t@. Subject to fusion.
1177-- 'takeWhile' @p@ @t@. Subject to fusion.
1022dropWhile :: (Char -> Bool) -> Text -> Text
1178dropWhile :: (Char -> Bool) -> Text -> Text
@@ -1035,8 +1191,9 @@ dropWhile p t@(Text arr off len) = loop 0 0
1035 #-}
1191 #-}
1036
1192
1037-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1193-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1038−-- dropping characters that fail the predicate @p@ from the end of
1194+-- dropping characters that satisfy the predicate @p@ from the end of
1039-- @t@. Subject to fusion.
1195-- @t@. Subject to fusion.
1196+--
1040-- Examples:
1197-- Examples:
1041--
1198--
1042-- > dropWhileEnd (=='.') "foo..." == "foo"
1199-- > dropWhileEnd (=='.') "foo..." == "foo"
@@ -1056,7 +1213,7 @@ dropWhileEnd p t@(Text arr off len) = loop (len-1) len
1056 #-}
1213 #-}
1057
1214
1058-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1215-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1059−-- dropping characters that fail the predicate @p@ from both the
1216+-- dropping characters that satisfy the predicate @p@ from both the
1060-- beginning and end of @t@. Subject to fusion.
1217-- beginning and end of @t@. Subject to fusion.
1061dropAround :: (Char -> Bool) -> Text -> Text
1218dropAround :: (Char -> Bool) -> Text -> Text
1062dropAround p = dropWhile p . dropWhileEnd p
1219dropAround p = dropWhile p . dropWhileEnd p
@@ -1091,13 +1248,8 @@ splitAt :: Int -> Text -> (Text, Text)
1091splitAt n t@(Text arr off len)
1248splitAt n t@(Text arr off len)
1092 | n <= 0 = (empty, t)
1249 | n <= 0 = (empty, t)
1093 | n >= len = (t, empty)
1250 | n >= len = (t, empty)
1094− | otherwise = (Text arr off k, Text arr (off+k) (len-k))
1251+ | otherwise = let k = iterN n t
1095− where k = loop 0 0
1252+ in (text arr off k, text arr (off+k) (len-k))
1096− loop !i !cnt
1097− | i >= len || cnt >= n = i
1098− | otherwise = loop (i+d) (cnt+1)
1099− where d = iter_ t i
1100−{-# INLINE splitAt #-}
1101
1253
1102-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
1254-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
1103-- a pair whose first element is the longest prefix (possibly empty)
1255-- a pair whose first element is the longest prefix (possibly empty)
@@ -1156,9 +1308,9 @@ tails t | null t = [empty]
1156-- copies to create substrings; they just construct new 'Text's that
1308-- copies to create substrings; they just construct new 'Text's that
1157-- are slices of the original.
1309-- are slices of the original.
1158
1310
1159−-- | /O(m+n)/ Break a 'Text' into pieces separated by the first
1311+-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'
1160−-- 'Text' argument, consuming the delimiter. An empty delimiter is
1312+-- argument (which cannot be empty), consuming the delimiter. An empty
1161−-- invalid, and will cause an error to be raised.
1313+-- delimiter is invalid, and will cause an error to be raised.
1162--
1314--
1163-- Examples:
1315-- Examples:
1164--
1316--
@@ -1171,16 +1323,23 @@ tails t | null t = [empty]
1171-- > intercalate s . splitOn s == id
1323-- > intercalate s . splitOn s == id
1172-- > splitOn (singleton c) == split (==c)
1324-- > splitOn (singleton c) == split (==c)
1173--
1325--
1326+-- (Note: the string @s@ to split on above cannot be empty.)
1327+--
1174-- In (unlikely) bad cases, this function's time complexity degrades
1328-- In (unlikely) bad cases, this function's time complexity degrades
1175-- towards /O(n*m)/.
1329-- towards /O(n*m)/.
1176−splitOn :: Text -> Text -> [Text]
1330+splitOn :: Text
1331+ -- ^ String to split on. If this string is empty, an error
1332+ -- will occur.
1333+ -> Text
1334+ -- ^ Input text.
1335+ -> [Text]
1177splitOn pat@(Text _ _ l) src@(Text arr off len)
1336splitOn pat@(Text _ _ l) src@(Text arr off len)
1178 | l <= 0 = emptyError "splitOn"
1337 | l <= 0 = emptyError "splitOn"
1179 | isSingleton pat = split (== unsafeHead pat) src
1338 | isSingleton pat = split (== unsafeHead pat) src
1180 | otherwise = go 0 (indices pat src)
1339 | otherwise = go 0 (indices pat src)
1181 where
1340 where
1182− go !s (x:xs) = textP arr (s+off) (x-s) : go (x+l) xs
1341+ go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs
1183− go s _ = [textP arr (s+off) (len-s)]
1342+ go s _ = [text arr (s+off) (len-s)]
1184{-# INLINE [1] splitOn #-}
1343{-# INLINE [1] splitOn #-}
1185
1344
1186{-# RULES
1345{-# RULES
@@ -1272,7 +1431,7 @@ breakOn pat src@(Text arr off len)
1272 | null pat = emptyError "breakOn"
1431 | null pat = emptyError "breakOn"
1273 | otherwise = case indices pat src of
1432 | otherwise = case indices pat src of
1274 [] -> (src, empty)
1433 [] -> (src, empty)
1275− (x:_) -> (textP arr off x, textP arr (off+x) (len-x))
1434+ (x:_) -> (text arr off x, text arr (off+x) (len-x))
1276{-# INLINE breakOn #-}
1435{-# INLINE breakOn #-}
1277
1436
1278-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
1437-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
@@ -1314,7 +1473,7 @@ breakOnAll pat src@(Text arr off slen)
1314 | otherwise = L.map step (indices pat src)
1473 | otherwise = L.map step (indices pat src)
1315 where
1474 where
1316 step x = (chunk 0 x, chunk x (slen-x))
1475 step x = (chunk 0 x, chunk x (slen-x))
1317− chunk !n !l = textP arr (n+off) l
1476+ chunk !n !l = text arr (n+off) l
1318{-# INLINE breakOnAll #-}
1477{-# INLINE breakOnAll #-}
1319
1478
1320-------------------------------------------------------------------------------
1479-------------------------------------------------------------------------------
@@ -1381,7 +1540,7 @@ countChar c t = S.countChar c (stream t)
1381-- equivalent to a pair of 'unpack' operations.
1540-- equivalent to a pair of 'unpack' operations.
1382zip :: Text -> Text -> [(Char,Char)]
1541zip :: Text -> Text -> [(Char,Char)]
1383zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1542zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1384−{-# INLINE [0] zip #-}
1543+{-# INLINE zip #-}
1385
1544
1386-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1545-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1387-- given as the first argument, instead of a tupling function.
1546-- given as the first argument, instead of a tupling function.
@@ -1389,7 +1548,7 @@ zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1389zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1548zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1390zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1549zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1391 where g a b = safe (f a b)
1550 where g a b = safe (f a b)
1392−{-# INLINE [0] zipWith #-}
1551+{-# INLINE zipWith #-}
1393
1552
1394-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1553-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1395-- representing white space.
1554-- representing white space.
@@ -1514,7 +1673,7 @@ isInfixOf needle haystack
1514-- > fnordLength _ = -1
1673-- > fnordLength _ = -1
1515stripPrefix :: Text -> Text -> Maybe Text
1674stripPrefix :: Text -> Text -> Maybe Text
1516stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1675stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1517− | p `isPrefixOf` t = Just $! textP arr (off+plen) (len-plen)
1676+ | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)
1518 | otherwise = Nothing
1677 | otherwise = Nothing
1519
1678
1520-- | /O(n)/ Find the longest non-empty common prefix of two strings
1679-- | /O(n)/ Find the longest non-empty common prefix of two strings
@@ -1534,8 +1693,8 @@ commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1534 where
1693 where
1535 go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1694 go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1536 | i > 0 = Just (Text arr0 off0 i,
1695 | i > 0 = Just (Text arr0 off0 i,
1537− textP arr0 (off0+i) (len0-i),
1696+ text arr0 (off0+i) (len0-i),
1538− textP arr1 (off1+j) (len1-j))
1697+ text arr1 (off1+j) (len1-j))
1539 | otherwise = Nothing
1698 | otherwise = Nothing
1540 where Iter a d0 = iter t0 i
1699 where Iter a d0 = iter t0 i
1541 Iter b d1 = iter t1 j
1700 Iter b d1 = iter t1 j
@@ -1560,7 +1719,7 @@ commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1560-- > quuxLength _ = -1
1719-- > quuxLength _ = -1
1561stripSuffix :: Text -> Text -> Maybe Text
1720stripSuffix :: Text -> Text -> Maybe Text
1562stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
1721stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
1563− | p `isSuffixOf` t = Just $! textP arr off (len-plen)
1722+ | p `isSuffixOf` t = Just $! text arr off (len-plen)
1564 | otherwise = Nothing
1723 | otherwise = Nothing
1565
1724
1566-- | Add a list of non-negative numbers. Errors out on overflow.
1725-- | Add a list of non-negative numbers. Errors out on overflow.
@@ -1577,3 +1736,20 @@ emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"
1577
1736
1578overflowError :: String -> a
1737overflowError :: String -> a
1579overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
1738overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
1739+
1740+-- | /O(n)/ Make a distinct copy of the given string, sharing no
1741+-- storage with the original string.
1742+--
1743+-- As an example, suppose you read a large string, of which you need
1744+-- only a small portion. If you do not use 'copy', the entire original
1745+-- array will be kept alive in memory by the smaller string. Making a
1746+-- copy \"breaks the link\" to the original array, allowing it to be
1747+-- garbage collected if there are no other live references to it.
1748+copy :: Text -> Text
1749+copy (Text arr off len) = Text (A.run go) 0 len
1750+ where
1751+ go :: ST s (A.MArray s)
1752+ go = do
1753+ marr <- A.new len
1754+ A.copyI marr 0 arr off len
1755+ return marr
Data/Text/Array.hs+10−10
@@ -6,8 +6,7 @@
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, rtomharper@googlemail.com,
9+-- Maintainer : bos@serpentine.com
10−-- duncan@haskell.org
11-- Stability : experimental
10-- Stability : experimental
12-- Portability : portable
11-- Portability : portable
13--
12--
@@ -21,13 +20,13 @@
21-- > import qualified Data.Text.Array as A
20-- > import qualified Data.Text.Array as A
22--
21--
23-- The names in this module resemble those in the 'Data.Array' family
22-- The names in this module resemble those in the 'Data.Array' family
24−-- of modules, but are shorter due to the assumption of qualifid
23+-- of modules, but are shorter due to the assumption of qualified
25-- naming.
24-- naming.
26module Data.Text.Array
25module Data.Text.Array
27 (
26 (
28 -- * Types
27 -- * Types
29− Array(aBA)
28+ Array(Array, aBA)
30− , MArray(maBA)
29+ , MArray(MArray, maBA)
31
30
32 -- * Functions
31 -- * Functions
33 , copyM
32 , copyM
@@ -66,8 +65,8 @@ import Control.Monad.ST.Unsafe (unsafeIOToST)
66import Control.Monad.ST (unsafeIOToST)
65import Control.Monad.ST (unsafeIOToST)
67#endif
66#endif
68import Data.Bits ((.&.), xor)
67import Data.Bits ((.&.), xor)
69−import Data.Text.Unsafe.Base (inlinePerformIO)
68+import Data.Text.Internal.Unsafe (inlinePerformIO)
70−import Data.Text.UnsafeShift (shiftL, shiftR)
69+import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
71#if __GLASGOW_HASKELL__ >= 703
70#if __GLASGOW_HASKELL__ >= 703
72import Foreign.C.Types (CInt(CInt), CSize(CSize))
71import Foreign.C.Types (CInt(CInt), CSize(CSize))
73#else
72#else
@@ -75,7 +74,7 @@ import Foreign.C.Types (CInt, CSize)
75#endif
74#endif
76import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
75import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
77 indexWord16Array#, newByteArray#,
76 indexWord16Array#, newByteArray#,
78− unsafeCoerce#, writeWord16Array#)
77+ unsafeFreezeByteArray#, writeWord16Array#)
79import GHC.ST (ST(..), runST)
78import GHC.ST (ST(..), runST)
80import GHC.Word (Word16(..))
79import GHC.Word (Word16(..))
81import Prelude hiding (length, read)
80import Prelude hiding (length, read)
@@ -131,8 +130,9 @@ array_size_error = error "Data.Text.Array.new: size overflow"
131
130
132-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
131-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
133unsafeFreeze :: MArray s -> ST s Array
132unsafeFreeze :: MArray s -> ST s Array
134−unsafeFreeze MArray{..} = ST $ \s# ->
133+unsafeFreeze MArray{..} = ST $ \s1# ->
135− (# s#, Array (unsafeCoerce# maBA)
134+ case unsafeFreezeByteArray# maBA s1# of
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+256−77
@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash,
1+{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, GeneralizedNewtypeDeriving, MagicHash,
2 UnliftedFFITypes #-}
2 UnliftedFFITypes #-}
3#if __GLASGOW_HASKELL__ >= 702
3#if __GLASGOW_HASKELL__ >= 702
4{-# LANGUAGE Trustworthy #-}
4{-# LANGUAGE Trustworthy #-}
@@ -10,8 +10,7 @@
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, rtomharper@googlemail.com,
13+-- Maintainer : bos@serpentine.com
14−-- duncan@haskell.org
15-- Stability : experimental
14-- Stability : experimental
16-- Portability : portable
15-- Portability : portable
17--
16--
@@ -43,40 +42,59 @@ module Data.Text.Encoding
43 , decodeUtf32LEWith
42 , decodeUtf32LEWith
44 , decodeUtf32BEWith
43 , decodeUtf32BEWith
45
44
45+ -- ** Stream oriented decoding
46+ -- $stream
47+ , streamDecodeUtf8
48+ , streamDecodeUtf8With
49+ , Decoding(..)
50+
46 -- * Encoding Text to ByteStrings
51 -- * Encoding Text to ByteStrings
47 , encodeUtf8
52 , encodeUtf8
48 , encodeUtf16LE
53 , encodeUtf16LE
49 , encodeUtf16BE
54 , encodeUtf16BE
50 , encodeUtf32LE
55 , encodeUtf32LE
51 , encodeUtf32BE
56 , encodeUtf32BE
57+
58+ -- * Encoding Text using ByteString Builders
59+ , encodeUtf8Builder
60+ , encodeUtf8BuilderEscaped
52 ) where
61 ) where
53
62
54−import Control.Exception (evaluate, try)
55#if __GLASGOW_HASKELL__ >= 702
63#if __GLASGOW_HASKELL__ >= 702
56import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
64import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
57#else
65#else
58import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)
66import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)
59#endif
67#endif
68+
69+import Control.Exception (evaluate, try)
70+import Control.Monad.ST (runST)
60import Data.Bits ((.&.))
71import Data.Bits ((.&.))
61import Data.ByteString as B
72import Data.ByteString as B
62−import Data.ByteString.Internal as B
73+import Data.ByteString.Internal as B hiding (c2w)
63import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
74import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
64−import Data.Text.Internal (Text(..), safe, textP)
75+import Data.Text.Internal (Text(..), safe, text)
65−import Data.Text.Private (runText)
76+import Data.Text.Internal.Private (runText)
66−import Data.Text.UnsafeChar (ord, unsafeWrite)
77+import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
67−import Data.Text.UnsafeShift (shiftL, shiftR)
78+import Data.Text.Internal.Unsafe.Shift (shiftR)
68−import Data.Word (Word8)
79+import Data.Text.Show ()
80+import Data.Text.Unsafe (unsafeDupablePerformIO)
81+import Data.Word (Word8, Word32)
69−import Foreign.C.Types (CSize)
82+import Foreign.C.Types (CSize(..))
70import Foreign.ForeignPtr (withForeignPtr)
83import Foreign.ForeignPtr (withForeignPtr)
71import Foreign.Marshal.Utils (with)
84import Foreign.Marshal.Utils (with)
72−import Foreign.Ptr (Ptr, minusPtr, plusPtr)
85+import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
73−import Foreign.Storable (peek, poke)
86+import Foreign.Storable (Storable, peek, poke)
74−import GHC.Base (MutableByteArray#)
87+import GHC.Base (ByteArray#, MutableByteArray#)
75−import System.IO.Unsafe (unsafePerformIO)
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
76import qualified Data.Text.Array as A
92import qualified Data.Text.Array as A
77−import qualified Data.Text.Encoding.Fusion as E
93+import qualified Data.Text.Internal.Encoding.Fusion as E
78−import qualified Data.Text.Encoding.Utf16 as U16
94+import qualified Data.Text.Internal.Encoding.Utf16 as U16
79−import qualified Data.Text.Fusion as F
95+import qualified Data.Text.Internal.Fusion as F
96+
97+#include "text_cbits.h"
80
98
81-- $strict
99-- $strict
82--
100--
@@ -93,8 +111,6 @@ import qualified Data.Text.Fusion as F
93
111
94-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
112-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
95-- encoded text.
113-- encoded text.
96−--
97−-- This function is deprecated. Use 'decodeLatin1' instead.
98decodeASCII :: ByteString -> Text
114decodeASCII :: ByteString -> Text
99decodeASCII = decodeUtf8
115decodeASCII = decodeUtf8
100{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
116{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
@@ -104,7 +120,7 @@ decodeASCII = decodeUtf8
104-- 'decodeLatin1' is semantically equivalent to
120-- 'decodeLatin1' is semantically equivalent to
105-- @Data.Text.pack . Data.ByteString.Char8.unpack@
121-- @Data.Text.pack . Data.ByteString.Char8.unpack@
106decodeLatin1 :: ByteString -> Text
122decodeLatin1 :: ByteString -> Text
107−decodeLatin1 (PS fp off len) = textP a 0 len
123+decodeLatin1 (PS fp off len) = text a 0 len
108 where
124 where
109 a = A.run (A.new len >>= unsafeIOToST . go)
125 a = A.run (A.new len >>= unsafeIOToST . go)
110 go dest = withForeignPtr fp $ \ptr -> do
126 go dest = withForeignPtr fp $ \ptr -> do
@@ -136,9 +152,140 @@ decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
136 loop (ptr `plusPtr` off)
152 loop (ptr `plusPtr` off)
137 (unsafeIOToST . go) =<< A.new len
153 (unsafeIOToST . go) =<< A.new len
138 where
154 where
139− desc = "Data.Text.Encoding.decodeUtf8: Invalid UTF-8 stream"
155+ desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
140{- INLINE[0] decodeUtf8With #-}
156{- INLINE[0] decodeUtf8With #-}
141
157
158+-- $stream
159+--
160+-- The 'streamDecodeUtf8' and 'streamDecodeUtf8With' functions accept
161+-- 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.
163+--
164+-- 1. The maximal prefix of 'Text' that could be decoded from the
165+-- given input.
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
171+-- be assumed to directly follow the string that was passed as
172+-- input to the original function, and it will in turn be decoded.
173+--
174+-- To help understand the use of these functions, consider the Unicode
175+-- string @\"hi &#9731;\"@. If encoded as UTF-8, this becomes @\"hi
176+-- \\xe2\\x98\\x83\"@; the final @\'&#9731;\'@ is encoded as 3 bytes.
177+--
178+-- Now suppose that we receive this encoded string as 3 packets that
179+-- are split up on untidy boundaries: @[\"hi \\xe2\", \"\\x98\",
180+-- \"\\x83\"]@. We cannot decode the entire Unicode string until we
181+-- have received all three packets, but we would like to make progress
182+-- as we receive each one.
183+--
184+-- @
185+-- ghci> let s0\@('Some' _ _ f0) = 'streamDecodeUtf8' \"hi \\xe2\"
186+-- ghci> s0
187+-- 'Some' \"hi \" \"\\xe2\" _
188+-- @
189+--
190+-- We use the continuation @f0@ to decode our second packet.
191+--
192+-- @
193+-- ghci> let s1\@('Some' _ _ f1) = f0 \"\\x98\"
194+-- ghci> s1
195+-- 'Some' \"\" \"\\xe2\\x98\"
196+-- @
197+--
198+-- We could not give @f0@ enough input to decode anything, so it
199+-- returned an empty string. Once we feed our second continuation @f1@
200+-- the last byte of input, it will make progress.
201+--
202+-- @
203+-- ghci> let s2\@('Some' _ _ f2) = f1 \"\\x83\"
204+-- ghci> s2
205+-- 'Some' \"\\x2603\" \"\" _
206+-- @
207+--
208+-- If given invalid input, an exception will be thrown by the function
209+-- or continuation where it is encountered.
210+
211+-- | A stream oriented decoding result.
212+data Decoding = Some Text ByteString (ByteString -> Decoding)
213+
214+instance Show Decoding where
215+ showsPrec d (Some t bs _) = showParen (d > prec) $
216+ showString "Some " . showsPrec prec' t .
217+ showChar ' ' . showsPrec prec' bs .
218+ showString " _"
219+ where prec = 10; prec' = prec + 1
220+
221+newtype CodePoint = CodePoint Word32 deriving (Eq, Show, Num, Storable)
222+newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable)
223+
224+-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
225+-- encoded text that is known to be valid.
226+--
227+-- If the input contains any invalid UTF-8 data, an exception will be
228+-- thrown (either by this function or a continuation) that cannot be
229+-- caught in pure code. For more control over the handling of invalid
230+-- data, use 'streamDecodeUtf8With'.
231+streamDecodeUtf8 :: ByteString -> Decoding
232+streamDecodeUtf8 = streamDecodeUtf8With strictDecode
233+
234+-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
235+-- encoded text.
236+streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
237+streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
238+ where
239+ -- We create a slightly larger than necessary buffer to accommodate a
240+ -- potential surrogate pair started in the last buffer
241+ decodeChunk :: ByteString -> CodePoint -> DecoderState -> ByteString
242+ -> Decoding
243+ decodeChunk undecoded0 codepoint0 state0 bs@(PS fp off len) =
244+ runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)
245+ where
246+ decodeChunkToBuffer :: A.MArray s -> IO Decoding
247+ decodeChunkToBuffer dest = withForeignPtr fp $ \ptr ->
248+ with (0::CSize) $ \destOffPtr ->
249+ with codepoint0 $ \codepointPtr ->
250+ with state0 $ \statePtr ->
251+ with nullPtr $ \curPtrPtr ->
252+ let end = ptr `plusPtr` (off + len)
253+ loop curPtr = do
254+ poke curPtrPtr curPtr
255+ curPtr' <- c_decode_utf8_with_state (A.maBA dest) destOffPtr
256+ curPtrPtr end codepointPtr statePtr
257+ state <- peek statePtr
258+ case state of
259+ UTF8_REJECT -> do
260+ -- We encountered an encoding error
261+ x <- peek curPtr'
262+ poke statePtr 0
263+ case onErr desc (Just x) of
264+ Nothing -> loop $ curPtr' `plusPtr` 1
265+ Just c -> do
266+ destOff <- peek destOffPtr
267+ w <- unsafeSTToIO $
268+ unsafeWrite dest (fromIntegral destOff) (safe c)
269+ poke destOffPtr (destOff + fromIntegral w)
270+ loop $ curPtr' `plusPtr` 1
271+
272+ _ -> do
273+ -- We encountered the end of the buffer while decoding
274+ n <- peek destOffPtr
275+ codepoint <- peek codepointPtr
276+ chunkText <- unsafeSTToIO $ do
277+ arr <- A.unsafeFreeze dest
278+ return $! text arr 0 (fromIntegral n)
279+ lastPtr <- peek curPtrPtr
280+ 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
285+ (decodeChunk undecoded codepoint state)
286+ in loop (ptr `plusPtr` off)
287+ desc = "Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"
288+
142-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
289-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
143-- to be valid.
290-- to be valid.
144--
291--
@@ -152,69 +299,93 @@ decodeUtf8 = decodeUtf8With strictDecode
152{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
299{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
153 forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}
300 forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}
154
301
155−-- | Decode a 'ByteString' containing UTF-8 encoded text..
302+-- | Decode a 'ByteString' containing UTF-8 encoded text.
156--
303--
157-- If the input contains any invalid UTF-8 data, the relevant
304-- If the input contains any invalid UTF-8 data, the relevant
158-- exception will be returned, otherwise the decoded text.
305-- exception will be returned, otherwise the decoded text.
159decodeUtf8' :: ByteString -> Either UnicodeException Text
306decodeUtf8' :: ByteString -> Either UnicodeException Text
160−decodeUtf8' = unsafePerformIO . try . evaluate . decodeUtf8With strictDecode
307+decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode
161{-# INLINE decodeUtf8' #-}
308{-# INLINE decodeUtf8' #-}
162
309
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+
163-- | Encode text using UTF-8 encoding.
371-- | Encode text using UTF-8 encoding.
164encodeUtf8 :: Text -> ByteString
372encodeUtf8 :: Text -> ByteString
165−encodeUtf8 (Text arr off len) = unsafePerformIO $ do
373+encodeUtf8 (Text arr off len)
166− let size0 = max len 4
374+ | len == 0 = B.empty
167− mallocByteString size0 >>= start size0 off 0
375+ | otherwise = unsafeDupablePerformIO $ do
168− where
376+ fp <- mallocByteString (len*4)
169− start size n0 m0 fp = withForeignPtr fp $ loop n0 m0
377+ withForeignPtr fp $ \ptr ->
170− where
378+ with ptr $ \destPtr -> do
171− loop n1 m1 ptr = go n1 m1
379+ c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
172− where
380+ newDest <- peek destPtr
173− offLen = off + len
381+ let utf8len = newDest `minusPtr` ptr
174− go !n !m
382+ if utf8len >= len `shiftR` 1
175− | n == offLen = return (PS fp 0 m)
383+ then return (PS fp 0 utf8len)
176− | otherwise = do
384+ else do
177− let poke8 k v = poke (ptr `plusPtr` k) (fromIntegral v :: Word8)
178− ensure k act
179− | size-m >= k = act
180− | otherwise = {-# SCC "resizeUtf8/ensure" #-} do
181− let newSize = size `shiftL` 1
182− fp' <- mallocByteString newSize
385+ fp' <- mallocByteString utf8len
183− withForeignPtr fp' $ \ptr' ->
386+ withForeignPtr fp' $ \ptr' -> do
184− memcpy ptr' ptr (fromIntegral m)
387+ memcpy ptr' ptr (fromIntegral utf8len)
185− start newSize n m fp'
388+ return (PS fp' 0 utf8len)
186− {-# INLINE ensure #-}
187− case A.unsafeIndex arr n of
188− w| w <= 0x7F -> ensure 1 $ do
189− poke (ptr `plusPtr` m) (fromIntegral w :: Word8)
190− -- A single ASCII octet is likely to start a run of
191− -- them. We see better performance when we
192− -- special-case this assumption.
193− let end = ptr `plusPtr` size
194− ascii !t !u
195− | t == offLen || u == end || v >= 0x80 =
196− go t (u `minusPtr` ptr)
197− | otherwise = do
198− poke u (fromIntegral v :: Word8)
199− ascii (t+1) (u `plusPtr` 1)
200− where v = A.unsafeIndex arr t
201− ascii (n+1) (ptr `plusPtr` (m+1))
202− | w <= 0x7FF -> ensure 2 $ do
203− poke8 m $ (w `shiftR` 6) + 0xC0
204− poke8 (m+1) $ (w .&. 0x3f) + 0x80
205− go (n+1) (m+2)
206− | 0xD800 <= w && w <= 0xDBFF -> ensure 4 $ do
207− let c = ord $ U16.chr2 w (A.unsafeIndex arr (n+1))
208− poke8 m $ (c `shiftR` 18) + 0xF0
209− poke8 (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80
210− poke8 (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80
211− poke8 (m+3) $ (c .&. 0x3F) + 0x80
212− go (n+2) (m+4)
213− | otherwise -> ensure 3 $ do
214− poke8 m $ (w `shiftR` 12) + 0xE0
215− poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
216− poke8 (m+2) $ (w .&. 0x3F) + 0x80
217− go (n+1) (m+3)
218
389
219-- | Decode text from little endian UTF-16 encoding.
390-- | Decode text from little endian UTF-16 encoding.
220decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
391decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
@@ -296,5 +467,13 @@ foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8
296 :: MutableByteArray# s -> Ptr CSize
467 :: MutableByteArray# s -> Ptr CSize
297 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
468 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
298
469
470+foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state
471+ :: MutableByteArray# s -> Ptr CSize
472+ -> Ptr (Ptr Word8) -> Ptr Word8
473+ -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)
474+
299foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
475foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
300 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
476 :: 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+13−7
@@ -1,5 +1,7 @@
1{-# LANGUAGE CPP, DeriveDataTypeable #-}
1{-# LANGUAGE CPP, DeriveDataTypeable #-}
2−#if __GLASGOW_HASKELL__ >= 702
2+#if __GLASGOW_HASKELL__ >= 704
3+{-# LANGUAGE Safe #-}
4+#elif __GLASGOW_HASKELL__ >= 702
3{-# LANGUAGE Trustworthy #-}
5{-# LANGUAGE Trustworthy #-}
4#endif
6#endif
5-- |
7-- |
@@ -7,8 +9,7 @@
7-- Copyright : (c) Bryan O'Sullivan 2009
9-- Copyright : (c) Bryan O'Sullivan 2009
8--
10--
9-- License : BSD-style
11-- License : BSD-style
10−-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
12+-- Maintainer : bos@serpentine.com
11−-- duncan@haskell.org
12-- Stability : experimental
13-- Stability : experimental
13-- Portability : GHC
14-- Portability : GHC
14--
15--
@@ -38,11 +39,8 @@ module Data.Text.Encoding.Error
38 , replace
39 , replace
39 ) where
40 ) where
40
41
41−#if __GLASGOW_HASKELL__ >= 610
42+import Control.DeepSeq (NFData (..))
42import Control.Exception (Exception, throw)
43import Control.Exception (Exception, throw)
43−#else
44−import Control.Exception.Extensible (Exception, throw)
45−#endif
46import Data.Typeable (Typeable)
44import Data.Typeable (Typeable)
47import Data.Word (Word8)
45import Data.Word (Word8)
48import Numeric (showHex)
46import Numeric (showHex)
@@ -70,6 +68,7 @@ type OnError a b = String -> Maybe a -> Maybe b
70type OnDecodeError = OnError Word8 Char
68type OnDecodeError = OnError Word8 Char
71
69
72-- | A handler for an encoding error.
70-- | A handler for an encoding error.
71+{-# DEPRECATED OnEncodeError "This exception is never used in practice, and will be removed." #-}
73type OnEncodeError = OnError Char Word8
72type OnEncodeError = OnError Char Word8
74
73
75-- | An exception type for representing Unicode encoding errors.
74-- | An exception type for representing Unicode encoding errors.
@@ -82,6 +81,8 @@ data UnicodeException =
82 -- under the given encoding, or ran out of input in mid-encode.
81 -- under the given encoding, or ran out of input in mid-encode.
83 deriving (Eq, Typeable)
82 deriving (Eq, Typeable)
84
83
84+{-# DEPRECATED EncodeError "This constructor is never used, and will be removed." #-}
85+
85showUnicodeException :: UnicodeException -> String
86showUnicodeException :: UnicodeException -> String
86showUnicodeException (DecodeError desc (Just w))
87showUnicodeException (DecodeError desc (Just w))
87 = "Cannot decode byte '\\x" ++ showHex w ("': " ++ desc)
88 = "Cannot decode byte '\\x" ++ showHex w ("': " ++ desc)
@@ -97,6 +98,10 @@ instance Show UnicodeException where
97
98
98instance Exception UnicodeException
99instance Exception UnicodeException
99
100
101+instance NFData UnicodeException where
102+ rnf (DecodeError desc w) = rnf desc `seq` rnf w `seq` ()
103+ rnf (EncodeError desc c) = rnf desc `seq` rnf c `seq` ()
104+
100-- | Throw a 'UnicodeException' if decoding fails.
105-- | Throw a 'UnicodeException' if decoding fails.
101strictDecode :: OnDecodeError
106strictDecode :: OnDecodeError
102strictDecode desc c = throw (DecodeError desc c)
107strictDecode desc c = throw (DecodeError desc c)
@@ -107,6 +112,7 @@ lenientDecode :: OnDecodeError
107lenientDecode _ _ = Just '\xfffd'
112lenientDecode _ _ = Just '\xfffd'
108
113
109-- | Throw a 'UnicodeException' if encoding fails.
114-- | Throw a 'UnicodeException' if encoding fails.
115+{-# DEPRECATED strictEncode "This function always throws an exception, and will be removed." #-}
110strictEncode :: OnEncodeError
116strictEncode :: OnEncodeError
111strictEncode desc c = throw (EncodeError desc c)
117strictEncode desc c = throw (EncodeError desc c)
112
118
Data/Text/Foreign.hs+27−4
@@ -4,8 +4,7 @@
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, rtomharper@googlemail.com,
7+-- Maintainer : bos@serpentine.com
8−-- duncan@haskell.org
9-- Stability : experimental
8-- Stability : experimental
10-- Portability : GHC
9-- Portability : GHC
11--
10--
@@ -21,6 +20,9 @@ module Data.Text.Foreign
21 , fromPtr
20 , fromPtr
22 , useAsPtr
21 , useAsPtr
23 , asForeignPtr
22 , asForeignPtr
23+ -- ** Encoding as UTF-8
24+ , peekCStringLen
25+ , withCStringLen
24 -- * Unsafe conversion code
26 -- * Unsafe conversion code
25 , lengthWord16
27 , lengthWord16
26 , unsafeCopyToPtr
28 , unsafeCopyToPtr
@@ -38,14 +40,17 @@ import Control.Monad.ST.Unsafe (unsafeIOToST)
38#else
40#else
39import Control.Monad.ST (unsafeIOToST)
41import Control.Monad.ST (unsafeIOToST)
40#endif
42#endif
43+import Data.ByteString.Unsafe (unsafePackCStringLen, unsafeUseAsCStringLen)
44+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
41import Data.Text.Internal (Text(..), empty)
45import Data.Text.Internal (Text(..), empty)
42import Data.Text.Unsafe (lengthWord16)
46import Data.Text.Unsafe (lengthWord16)
43−import qualified Data.Text.Array as A
44import Data.Word (Word16)
47import Data.Word (Word16)
48+import Foreign.C.String (CStringLen)
49+import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray, withForeignPtr)
45import Foreign.Marshal.Alloc (allocaBytes)
50import Foreign.Marshal.Alloc (allocaBytes)
46import Foreign.Ptr (Ptr, castPtr, plusPtr)
51import Foreign.Ptr (Ptr, castPtr, plusPtr)
47−import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray, withForeignPtr)
48import Foreign.Storable (peek, poke)
52import Foreign.Storable (peek, poke)
53+import qualified Data.Text.Array as A
49
54
50-- $interop
55-- $interop
51--
56--
@@ -148,3 +153,21 @@ asForeignPtr t@(Text _arr _off len) = do
148 fp <- mallocForeignPtrArray len
153 fp <- mallocForeignPtrArray len
149 withForeignPtr fp $ unsafeCopyToPtr t
154 withForeignPtr fp $ unsafeCopyToPtr t
150 return (fp, I16 len)
155 return (fp, I16 len)
156+
157+-- | /O(n)/ Decode a C string with explicit length, which is assumed
158+-- to have been encoded as UTF-8. If decoding fails, a
159+-- 'UnicodeException' is thrown.
160+peekCStringLen :: CStringLen -> IO Text
161+peekCStringLen cs = do
162+ bs <- unsafePackCStringLen cs
163+ return $! decodeUtf8 bs
164+
165+-- | Marshal a 'Text' into a C string encoded as UTF-8 in temporary
166+-- storage, with explicit length information. The encoded string may
167+-- contain NUL bytes, and is not followed by a trailing NUL byte.
168+--
169+-- The temporary storage is freed when the subcomputation terminates
170+-- (either normally or via an exception), so the pointer to the
171+-- temporary storage must /not/ be used after this function returns.
172+withCStringLen :: Text -> (CStringLen -> IO a) -> IO a
173+withCStringLen t act = unsafeUseAsCStringLen (encodeUtf8 t) act
Data/Text/Fusion/Size.hsdeleted−146
@@ -1,146 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# OPTIONS_GHC -fno-warn-missing-methods #-}
3−-- |
4−-- Module : Data.Text.Fusion.Internal
5−-- Copyright : (c) Roman Leshchinskiy 2008,
6−-- (c) Bryan O'Sullivan 2009
7−--
8−-- License : BSD-style
9−-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
10−-- duncan@haskell.org
11−-- Stability : experimental
12−-- Portability : portable
13−--
14−-- Size hints.
15−
16−module Data.Text.Fusion.Size
17− (
18− Size
19− , exactly
20− , exactSize
21− , maxSize
22− , unknownSize
23− , smaller
24− , larger
25− , upperBound
26− , isEmpty
27− ) where
28−
29−#if defined(ASSERTS)
30−import Control.Exception (assert)
31−#endif
32−
33−data Size = Exact {-# UNPACK #-} !Int -- ^ Exact size.
34− | Max {-# UNPACK #-} !Int -- ^ Upper bound on size.
35− | Unknown -- ^ Unknown size.
36− deriving (Eq, Show)
37−
38−exactly :: Size -> Maybe Int
39−exactly (Exact n) = Just n
40−exactly _ = Nothing
41−{-# INLINE exactly #-}
42−
43−exactSize :: Int -> Size
44−exactSize n =
45−#if defined(ASSERTS)
46− assert (n >= 0)
47−#endif
48− Exact n
49−{-# INLINE exactSize #-}
50−
51−maxSize :: Int -> Size
52−maxSize n =
53−#if defined(ASSERTS)
54− assert (n >= 0)
55−#endif
56− Max n
57−{-# INLINE maxSize #-}
58−
59−unknownSize :: Size
60−unknownSize = Unknown
61−{-# INLINE unknownSize #-}
62−
63−instance Num Size where
64− (+) = addSize
65− (-) = subtractSize
66− (*) = mulSize
67−
68− fromInteger = f where f = Exact . fromInteger
69− {-# INLINE f #-}
70−
71−add :: Int -> Int -> Int
72−add m n | mn >= 0 = mn
73− | otherwise = overflowError
74− where mn = m + n
75−{-# INLINE add #-}
76−
77−addSize :: Size -> Size -> Size
78−addSize (Exact m) (Exact n) = Exact (add m n)
79−addSize (Exact m) (Max n) = Max (add m n)
80−addSize (Max m) (Exact n) = Max (add m n)
81−addSize (Max m) (Max n) = Max (add m n)
82−addSize _ _ = Unknown
83−{-# INLINE addSize #-}
84−
85−subtractSize :: Size -> Size -> Size
86−subtractSize (Exact m) (Exact n) = Exact (max (m-n) 0)
87−subtractSize (Exact m) (Max _) = Max m
88−subtractSize (Max m) (Exact n) = Max (max (m-n) 0)
89−subtractSize a@(Max _) (Max _) = a
90−subtractSize a@(Max _) Unknown = a
91−subtractSize _ _ = Unknown
92−{-# INLINE subtractSize #-}
93−
94−mul :: Int -> Int -> Int
95−mul m n
96− | m <= maxBound `div` n = m * n
97− | otherwise = overflowError
98−{-# INLINE mul #-}
99−
100−mulSize :: Size -> Size -> Size
101−mulSize (Exact m) (Exact n) = Exact (mul m n)
102−mulSize (Exact m) (Max n) = Max (mul m n)
103−mulSize (Max m) (Exact n) = Max (mul m n)
104−mulSize (Max m) (Max n) = Max (mul m n)
105−mulSize _ _ = Unknown
106−{-# INLINE mulSize #-}
107−
108−-- | Minimum of two size hints.
109−smaller :: Size -> Size -> Size
110−smaller (Exact m) (Exact n) = Exact (m `min` n)
111−smaller (Exact m) (Max n) = Max (m `min` n)
112−smaller (Exact m) Unknown = Max m
113−smaller (Max m) (Exact n) = Max (m `min` n)
114−smaller (Max m) (Max n) = Max (m `min` n)
115−smaller a@(Max _) Unknown = a
116−smaller Unknown (Exact n) = Max n
117−smaller Unknown (Max n) = Max n
118−smaller Unknown Unknown = Unknown
119−{-# INLINE smaller #-}
120−
121−-- | Maximum of two size hints.
122−larger :: Size -> Size -> Size
123−larger (Exact m) (Exact n) = Exact (m `max` n)
124−larger a@(Exact m) b@(Max n) | m >= n = a
125− | otherwise = b
126−larger a@(Max m) b@(Exact n) | n >= m = b
127− | otherwise = a
128−larger (Max m) (Max n) = Max (m `max` n)
129−larger _ _ = Unknown
130−{-# INLINE larger #-}
131−
132−-- | Compute the maximum size from a size hint, if possible.
133−upperBound :: Int -> Size -> Int
134−upperBound _ (Exact n) = n
135−upperBound _ (Max n) = n
136−upperBound k _ = k
137−{-# INLINE upperBound #-}
138−
139−isEmpty :: Size -> Bool
140−isEmpty (Exact n) = n <= 0
141−isEmpty (Max n) = n <= 0
142−isEmpty _ = False
143−{-# INLINE isEmpty #-}
144−
145−overflowError :: Int
146−overflowError = error "Data.Text.Fusion.Size: size overflow"
Data/Text/IO.hs+3−20
@@ -46,17 +46,13 @@ import Prelude hiding (appendFile, getContents, getLine, interact,
46 putStr, putStrLn, readFile, writeFile)
46 putStr, putStrLn, readFile, writeFile)
47import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,
47import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,
48 withFile)
48 withFile)
49−#if __GLASGOW_HASKELL__ <= 610
50−import qualified Data.ByteString.Char8 as B
51−import Data.Text.Encoding (decodeUtf8, encodeUtf8)
52−#else
53import qualified Control.Exception as E
49import qualified Control.Exception as E
54import Control.Monad (liftM2, when)
50import Control.Monad (liftM2, when)
55import Data.IORef (readIORef, writeIORef)
51import Data.IORef (readIORef, writeIORef)
56import qualified Data.Text as T
52import qualified Data.Text as T
57−import Data.Text.Fusion (stream)
53+import Data.Text.Internal.Fusion (stream)
58−import Data.Text.Fusion.Internal (Step(..), Stream(..))
54+import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))
59−import Data.Text.IO.Internal (hGetLineWith, readChunk)
55+import Data.Text.Internal.IO (hGetLineWith, readChunk)
60import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBufElem, CharBuffer,
56import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBufElem, CharBuffer,
61 RawCharBuffer, emptyBuffer, isEmptyBuffer, newCharBuffer,
57 RawCharBuffer, emptyBuffer, isEmptyBuffer, newCharBuffer,
62 writeCharBuf)
58 writeCharBuf)
@@ -68,7 +64,6 @@ import GHC.IO.Handle.Types (BufferList(..), BufferMode(..), Handle__(..),
68 HandleType(..), Newline(..))
64 HandleType(..), Newline(..))
69import System.IO (hGetBuffering, hFileSize, hSetBuffering, hTell)
65import System.IO (hGetBuffering, hFileSize, hSetBuffering, hTell)
70import System.IO.Error (isEOFError)
66import System.IO.Error (isEOFError)
71−#endif
72
67
73-- $performance
68-- $performance
74-- #performance#
69-- #performance#
@@ -137,9 +132,6 @@ hGetChunk h = wantReadableHandle "hGetChunk" h readSingleChunk
137-- result to construct its result. For files more than a half of
132-- result to construct its result. For files more than a half of
138-- available RAM in size, this may result in memory exhaustion.
133-- available RAM in size, this may result in memory exhaustion.
139hGetContents :: Handle -> IO Text
134hGetContents :: Handle -> IO Text
140−#if __GLASGOW_HASKELL__ <= 610
141−hGetContents = fmap decodeUtf8 . B.hGetContents
142−#else
143hGetContents h = do
135hGetContents h = do
144 chooseGoodBuffering h
136 chooseGoodBuffering h
145 wantReadableHandle "hGetContents" h readAll
137 wantReadableHandle "hGetContents" h readAll
@@ -171,21 +163,13 @@ chooseGoodBuffering h = do
171 else E.throwIO e
163 else E.throwIO e
172 when (d > 0) . hSetBuffering h . BlockBuffering . Just . fromIntegral $ d
164 when (d > 0) . hSetBuffering h . BlockBuffering . Just . fromIntegral $ d
173 _ -> return ()
165 _ -> return ()
174−#endif
175
166
176-- | Read a single line from a handle.
167-- | Read a single line from a handle.
177hGetLine :: Handle -> IO Text
168hGetLine :: Handle -> IO Text
178−#if __GLASGOW_HASKELL__ <= 610
179−hGetLine = fmap decodeUtf8 . B.hGetLine
180−#else
181hGetLine = hGetLineWith T.concat
169hGetLine = hGetLineWith T.concat
182−#endif
183
170
184-- | Write a string to a handle.
171-- | Write a string to a handle.
185hPutStr :: Handle -> Text -> IO ()
172hPutStr :: Handle -> Text -> IO ()
186−#if __GLASGOW_HASKELL__ <= 610
187−hPutStr h = B.hPutStr h . encodeUtf8
188−#else
189-- This function is lifted almost verbatim from GHC.IO.Handle.Text.
173-- This function is lifted almost verbatim from GHC.IO.Handle.Text.
190hPutStr h t = do
174hPutStr h t = do
191 (buffer_mode, nl) <-
175 (buffer_mode, nl) <-
@@ -295,7 +279,6 @@ commitBuffer hdl !raw !sz !count flush release =
295 wantWritableHandle "commitAndReleaseBuffer" hdl $
279 wantWritableHandle "commitAndReleaseBuffer" hdl $
296 commitBuffer' raw sz count flush release
280 commitBuffer' raw sz count flush release
297{-# INLINE commitBuffer #-}
281{-# INLINE commitBuffer #-}
298−#endif
299
282
300-- | Write a string to a handle, followed by a newline.
283-- | Write a string to a handle, followed by a newline.
301hPutStrLn :: Handle -> Text -> IO ()
284hPutStrLn :: Handle -> Text -> IO ()
Data/Text/Internal.hs+77−13
@@ -1,4 +1,5 @@
1−{-# LANGUAGE CPP, DeriveDataTypeable #-}
1+{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples #-}
2+{-# OPTIONS_HADDOCK not-home #-}
2
3
3-- |
4-- |
4-- Module : Data.Text.Internal
5-- Module : Data.Text.Internal
@@ -7,8 +8,7 @@
7-- (c) 2009 Duncan Coutts
8-- (c) 2009 Duncan Coutts
8--
9--
9-- License : BSD-style
10-- License : BSD-style
10−-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- Maintainer : bos@serpentine.com
11−-- duncan@haskell.org
12-- Stability : experimental
12-- Stability : experimental
13-- Portability : GHC
13-- Portability : GHC
14--
14--
@@ -20,6 +20,10 @@
20-- with the internals, as the functions here do just about nothing to
20-- with the internals, as the functions here do just about nothing to
21-- preserve data invariants. You have been warned!
21-- preserve data invariants. You have been warned!
22
22
23+#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
24+#include "MachDeps.h"
25+#endif
26+
23module Data.Text.Internal
27module Data.Text.Internal
24 (
28 (
25 -- * Types
29 -- * Types
@@ -32,8 +36,13 @@ module Data.Text.Internal
32 , safe
36 , safe
33 -- * Code that must be here for accessibility
37 -- * Code that must be here for accessibility
34 , empty
38 , empty
39+ , empty_
35 -- * Utilities
40 -- * Utilities
36 , firstf
41 , firstf
42+ -- * Checked multiplication
43+ , mul
44+ , mul32
45+ , mul64
37 -- * Debugging
46 -- * Debugging
38 , showText
47 , showText
39 ) where
48 ) where
@@ -41,10 +50,11 @@ module Data.Text.Internal
41#if defined(ASSERTS)
50#if defined(ASSERTS)
42import Control.Exception (assert)
51import Control.Exception (assert)
43#endif
52#endif
44−import Data.Bits ((.&.))
53+import Data.Bits
45−import qualified Data.Text.Array as A
54+import Data.Int (Int32, Int64)
46−import Data.Text.UnsafeChar (ord)
55+import Data.Text.Internal.Unsafe.Char (ord)
47import Data.Typeable (Typeable)
56import Data.Typeable (Typeable)
57+import qualified Data.Text.Array as A
48
58
49-- | A space efficient, packed, unboxed Unicode text type.
59-- | A space efficient, packed, unboxed Unicode text type.
50data Text = Text
60data Text = Text
@@ -54,8 +64,8 @@ data Text = Text
54 deriving (Typeable)
64 deriving (Typeable)
55
65
56-- | Smart constructor.
66-- | Smart constructor.
57−text :: A.Array -> Int -> Int -> Text
67+text_ :: A.Array -> Int -> Int -> Text
58−text arr off len =
68+text_ arr off len =
59#if defined(ASSERTS)
69#if defined(ASSERTS)
60 let c = A.unsafeIndex arr off
70 let c = A.unsafeIndex arr off
61 alen = A.length arr
71 alen = A.length arr
@@ -65,19 +75,28 @@ text arr off len =
65 assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $
75 assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $
66#endif
76#endif
67 Text arr off len
77 Text arr off len
68−{-# INLINE text #-}
78+{-# INLINE text_ #-}
69
79
70-- | /O(1)/ The empty 'Text'.
80-- | /O(1)/ The empty 'Text'.
71empty :: Text
81empty :: Text
72empty = Text A.empty 0 0
82empty = Text A.empty 0 0
73{-# INLINE [1] empty #-}
83{-# INLINE [1] empty #-}
74
84
85+-- | A non-inlined version of 'empty'.
86+empty_ :: Text
87+empty_ = Text A.empty 0 0
88+{-# NOINLINE empty_ #-}
89+
75-- | Construct a 'Text' without invisibly pinning its byte array in
90-- | Construct a 'Text' without invisibly pinning its byte array in
76-- memory if its length has dwindled to zero.
91-- memory if its length has dwindled to zero.
92+text :: A.Array -> Int -> Int -> Text
93+text arr off len | len == 0 = empty
94+ | otherwise = text_ arr off len
95+{-# INLINE text #-}
96+
77textP :: A.Array -> Int -> Int -> Text
97textP :: A.Array -> Int -> Int -> Text
78−textP arr off len | len == 0 = empty
98+{-# DEPRECATED textP "Use text instead" #-}
79− | otherwise = text arr off len
99+textP = text
80−{-# INLINE textP #-}
81
100
82-- | A useful 'show'-like function for debugging purposes.
101-- | A useful 'show'-like function for debugging purposes.
83showText :: Text -> String
102showText :: Text -> String
@@ -97,13 +116,58 @@ safe :: Char -> Char
97safe c
116safe c
98 | ord c .&. 0x1ff800 /= 0xd800 = c
117 | ord c .&. 0x1ff800 /= 0xd800 = c
99 | otherwise = '\xfffd'
118 | otherwise = '\xfffd'
100−{-# INLINE safe #-}
119+{-# INLINE [0] safe #-}
101
120
102-- | Apply a function to the first element of an optional pair.
121-- | Apply a function to the first element of an optional pair.
103firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)
122firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)
104firstf f (Just (a, b)) = Just (f a, b)
123firstf f (Just (a, b)) = Just (f a, b)
105firstf _ Nothing = Nothing
124firstf _ Nothing = Nothing
106
125
126+-- | Checked multiplication. Calls 'error' if the result would
127+-- overflow.
128+mul :: Int -> Int -> Int
129+#if WORD_SIZE_IN_BITS == 64
130+mul a b = fromIntegral $ fromIntegral a `mul64` fromIntegral b
131+#else
132+mul a b = fromIntegral $ fromIntegral a `mul32` fromIntegral b
133+#endif
134+{-# INLINE mul #-}
135+infixl 7 `mul`
136+
137+-- | Checked multiplication. Calls 'error' if the result would
138+-- overflow.
139+mul64 :: Int64 -> Int64 -> Int64
140+mul64 a b
141+ | a >= 0 && b >= 0 = mul64_ a b
142+ | a >= 0 = -mul64_ a (-b)
143+ | b >= 0 = -mul64_ (-a) b
144+ | otherwise = mul64_ (-a) (-b)
145+{-# INLINE mul64 #-}
146+infixl 7 `mul64`
147+
148+mul64_ :: Int64 -> Int64 -> Int64
149+mul64_ a b
150+ | ahi > 0 && bhi > 0 = error "overflow"
151+ | top > 0x7fffffff = error "overflow"
152+ | total < 0 = error "overflow"
153+ | otherwise = total
154+ where (# ahi, alo #) = (# a `shiftR` 32, a .&. 0xffffffff #)
155+ (# bhi, blo #) = (# b `shiftR` 32, b .&. 0xffffffff #)
156+ top = ahi * blo + alo * bhi
157+ total = (top `shiftL` 32) + alo * blo
158+{-# INLINE mul64_ #-}
159+
160+-- | Checked multiplication. Calls 'error' if the result would
161+-- overflow.
162+mul32 :: Int32 -> Int32 -> Int32
163+mul32 a b = case fromIntegral a * fromIntegral b of
164+ ab | ab < min32 || ab > max32 -> error "overflow"
165+ | otherwise -> fromIntegral ab
166+ where min32 = -0x80000000 :: Int64
167+ max32 = 0x7fffffff
168+{-# INLINE mul32 #-}
169+infixl 7 `mul32`
170+
107-- $internals
171-- $internals
108--
172--
109-- Internally, the 'Text' type is represented as an array of 'Word16'
173-- Internally, the 'Text' type is represented as an array of 'Word16'
Data/Text/Internal/Builder.hsnew file+329
@@ -0,0 +1,329 @@
1+{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
2+{-# OPTIONS_HADDOCK not-home #-}
3+
4+-----------------------------------------------------------------------------
5+-- |
6+-- Module : Data.Text.Internal.Builder
7+-- Copyright : (c) 2013 Bryan O'Sullivan
8+-- (c) 2010 Johan Tibell
9+-- License : BSD-style (see LICENSE)
10+--
11+-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
12+-- Stability : experimental
13+-- Portability : portable to Hugs and GHC
14+--
15+-- /Warning/: this is an internal module, and does not have a stable
16+-- API or name. Functions in this module may not check or enforce
17+-- preconditions expected by public modules. Use at your own risk!
18+--
19+-- Efficient construction of lazy @Text@ values. The principal
20+-- operations on a @Builder@ are @singleton@, @fromText@, and
21+-- @fromLazyText@, which construct new builders, and 'mappend', which
22+-- concatenates two builders.
23+--
24+-- To get maximum performance when building lazy @Text@ values using a
25+-- builder, associate @mappend@ calls to the right. For example,
26+-- prefer
27+--
28+-- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')
29+--
30+-- to
31+--
32+-- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'
33+--
34+-- as the latter associates @mappend@ to the left.
35+--
36+-----------------------------------------------------------------------------
37+
38+module Data.Text.Internal.Builder
39+ ( -- * Public API
40+ -- ** The Builder type
41+ Builder
42+ , toLazyText
43+ , toLazyTextWith
44+
45+ -- ** Constructing Builders
46+ , singleton
47+ , fromText
48+ , fromLazyText
49+ , fromString
50+
51+ -- ** Flushing the buffer state
52+ , flush
53+
54+ -- * Internal functions
55+ , append'
56+ , ensureFree
57+ , writeN
58+ ) where
59+
60+import Control.Monad.ST (ST, runST)
61+import Data.Monoid (Monoid(..))
62+#if MIN_VERSION_base(4,9,0)
63+import Data.Semigroup (Semigroup(..))
64+#endif
65+import Data.Text.Internal (Text(..))
66+import Data.Text.Internal.Lazy (smallChunkSize)
67+import Data.Text.Unsafe (inlineInterleaveST)
68+import Data.Text.Internal.Unsafe.Char (unsafeWrite)
69+import Prelude hiding (map, putChar)
70+
71+import qualified Data.String as String
72+import qualified Data.Text as S
73+import qualified Data.Text.Array as A
74+import qualified Data.Text.Lazy as L
75+
76+------------------------------------------------------------------------
77+
78+-- | A @Builder@ is an efficient way to build lazy @Text@ values.
79+-- There are several functions for constructing builders, but only one
80+-- to inspect them: to extract any data, you have to turn them into
81+-- lazy @Text@ values using @toLazyText@.
82+--
83+-- Internally, a builder constructs a lazy @Text@ by filling arrays
84+-- piece by piece. As each buffer is filled, it is \'popped\' off, to
85+-- become a new chunk of the resulting lazy @Text@. All this is
86+-- hidden from the user of the @Builder@.
87+newtype Builder = Builder {
88+ -- Invariant (from Data.Text.Lazy):
89+ -- The lists include no null Texts.
90+ runBuilder :: forall s. (Buffer s -> ST s [S.Text])
91+ -> Buffer s
92+ -> ST s [S.Text]
93+ }
94+
95+#if MIN_VERSION_base(4,9,0)
96+instance Semigroup Builder where
97+ (<>) = append
98+ {-# INLINE (<>) #-}
99+#endif
100+
101+instance Monoid Builder where
102+ mempty = empty
103+ {-# INLINE mempty #-}
104+#if MIN_VERSION_base(4,9,0)
105+ mappend = (<>) -- future-proof definition
106+#else
107+ mappend = append
108+#endif
109+ {-# INLINE mappend #-}
110+ mconcat = foldr mappend Data.Monoid.mempty
111+ {-# INLINE mconcat #-}
112+
113+instance String.IsString Builder where
114+ fromString = fromString
115+ {-# INLINE fromString #-}
116+
117+instance Show Builder where
118+ show = show . toLazyText
119+
120+instance Eq Builder where
121+ a == b = toLazyText a == toLazyText b
122+
123+instance Ord Builder where
124+ a <= b = toLazyText a <= toLazyText b
125+
126+------------------------------------------------------------------------
127+
128+-- | /O(1)./ The empty @Builder@, satisfying
129+--
130+-- * @'toLazyText' 'empty' = 'L.empty'@
131+--
132+empty :: Builder
133+empty = Builder (\ k buf -> k buf)
134+{-# INLINE empty #-}
135+
136+-- | /O(1)./ A @Builder@ taking a single character, satisfying
137+--
138+-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@
139+--
140+singleton :: Char -> Builder
141+singleton c = writeAtMost 2 $ \ marr o -> unsafeWrite marr o c
142+{-# INLINE singleton #-}
143+
144+------------------------------------------------------------------------
145+
146+-- | /O(1)./ The concatenation of two builders, an associative
147+-- operation with identity 'empty', satisfying
148+--
149+-- * @'toLazyText' ('append' x y) = 'L.append' ('toLazyText' x) ('toLazyText' y)@
150+--
151+append :: Builder -> Builder -> Builder
152+append (Builder f) (Builder g) = Builder (f . g)
153+{-# INLINE [0] append #-}
154+
155+-- TODO: Experiment to find the right threshold.
156+copyLimit :: Int
157+copyLimit = 128
158+
159+-- This function attempts to merge small @Text@ values instead of
160+-- treating each value as its own chunk. We may not always want this.
161+
162+-- | /O(1)./ A @Builder@ taking a 'S.Text', satisfying
163+--
164+-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@
165+--
166+fromText :: S.Text -> Builder
167+fromText t@(Text arr off l)
168+ | S.null t = empty
169+ | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)
170+ | otherwise = flush `append` mapBuilder (t :)
171+{-# INLINE [1] fromText #-}
172+
173+{-# RULES
174+"fromText/pack" forall s .
175+ fromText (S.pack s) = fromString s
176+ #-}
177+
178+-- | /O(1)./ A Builder taking a @String@, satisfying
179+--
180+-- * @'toLazyText' ('fromString' s) = 'L.fromChunks' [S.pack s]@
181+--
182+fromString :: String -> Builder
183+fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
184+ let loop !marr !o !u !l [] = k (Buffer marr o u l)
185+ loop marr o u l s@(c:cs)
186+ | l <= 1 = do
187+ arr <- A.unsafeFreeze marr
188+ let !t = Text arr o u
189+ marr' <- A.new chunkSize
190+ ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
191+ return $ t : ts
192+ | otherwise = do
193+ n <- unsafeWrite marr (o+u) c
194+ loop marr o (u+n) (l-n) cs
195+ in loop p0 o0 u0 l0 str
196+ where
197+ chunkSize = smallChunkSize
198+{-# INLINE fromString #-}
199+
200+-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying
201+--
202+-- * @'toLazyText' ('fromLazyText' t) = t@
203+--
204+fromLazyText :: L.Text -> Builder
205+fromLazyText ts = flush `append` mapBuilder (L.toChunks ts ++)
206+{-# INLINE fromLazyText #-}
207+
208+------------------------------------------------------------------------
209+
210+-- Our internal buffer type
211+data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s)
212+ {-# UNPACK #-} !Int -- offset
213+ {-# UNPACK #-} !Int -- used units
214+ {-# UNPACK #-} !Int -- length left
215+
216+------------------------------------------------------------------------
217+
218+-- | /O(n)./ Extract a lazy @Text@ from a @Builder@ with a default
219+-- buffer size. The construction work takes place if and when the
220+-- relevant part of the lazy @Text@ is demanded.
221+toLazyText :: Builder -> L.Text
222+toLazyText = toLazyTextWith smallChunkSize
223+
224+-- | /O(n)./ Extract a lazy @Text@ from a @Builder@, using the given
225+-- size for the initial buffer. The construction work takes place if
226+-- and when the relevant part of the lazy @Text@ is demanded.
227+--
228+-- If the initial buffer is too small to hold all data, subsequent
229+-- buffers will be the default buffer size.
230+toLazyTextWith :: Int -> Builder -> L.Text
231+toLazyTextWith chunkSize m = L.fromChunks (runST $
232+ newBuffer chunkSize >>= runBuilder (m `append` flush) (const (return [])))
233+
234+-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,
235+-- yielding a new chunk in the result lazy @Text@.
236+flush :: Builder
237+flush = Builder $ \ k buf@(Buffer p o u l) ->
238+ if u == 0
239+ then k buf
240+ else do arr <- A.unsafeFreeze p
241+ let !b = Buffer p (o+u) 0 l
242+ !t = Text arr o u
243+ ts <- inlineInterleaveST (k b)
244+ return $! t : ts
245+{-# INLINE [1] flush #-}
246+-- defer inlining so that flush/flush rule may fire.
247+
248+------------------------------------------------------------------------
249+
250+-- | Sequence an ST operation on the buffer
251+withBuffer :: (forall s. Buffer s -> ST s (Buffer s)) -> Builder
252+withBuffer f = Builder $ \k buf -> f buf >>= k
253+{-# INLINE withBuffer #-}
254+
255+-- | Get the size of the buffer
256+withSize :: (Int -> Builder) -> Builder
257+withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->
258+ runBuilder (f l) k buf
259+{-# INLINE withSize #-}
260+
261+-- | Map the resulting list of texts.
262+mapBuilder :: ([S.Text] -> [S.Text]) -> Builder
263+mapBuilder f = Builder (fmap f .)
264+
265+------------------------------------------------------------------------
266+
267+-- | Ensure that there are at least @n@ many elements available.
268+ensureFree :: Int -> Builder
269+ensureFree !n = withSize $ \ l ->
270+ if n <= l
271+ then empty
272+ else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize)))
273+{-# INLINE [0] ensureFree #-}
274+
275+writeAtMost :: Int -> (forall s. A.MArray s -> Int -> ST s Int) -> Builder
276+writeAtMost n f = ensureFree n `append'` withBuffer (writeBuffer f)
277+{-# INLINE [0] writeAtMost #-}
278+
279+-- | Ensure that @n@ many elements are available, and then use @f@ to
280+-- write some elements into the memory.
281+writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder
282+writeN n f = writeAtMost n (\ p o -> f p o >> return n)
283+{-# INLINE writeN #-}
284+
285+writeBuffer :: (A.MArray s -> Int -> ST s Int) -> Buffer s -> ST s (Buffer s)
286+writeBuffer f (Buffer p o u l) = do
287+ n <- f p (o+u)
288+ return $! Buffer p o (u+n) (l-n)
289+{-# INLINE writeBuffer #-}
290+
291+newBuffer :: Int -> ST s (Buffer s)
292+newBuffer size = do
293+ arr <- A.new size
294+ return $! Buffer arr 0 0 size
295+{-# INLINE newBuffer #-}
296+
297+------------------------------------------------------------------------
298+-- Some nice rules for Builder
299+
300+-- This function makes GHC understand that 'writeN' and 'ensureFree'
301+-- are *not* recursive in the precense of the rewrite rules below.
302+-- This is not needed with GHC 7+.
303+append' :: Builder -> Builder -> Builder
304+append' (Builder f) (Builder g) = Builder (f . g)
305+{-# INLINE append' #-}
306+
307+{-# RULES
308+
309+"append/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)
310+ (g::forall s. A.MArray s -> Int -> ST s Int) ws.
311+ append (writeAtMost a f) (append (writeAtMost b g) ws) =
312+ append (writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->
313+ g marr (o+n) >>= \ m ->
314+ let s = n+m in s `seq` return s)) ws
315+
316+"writeAtMost/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)
317+ (g::forall s. A.MArray s -> Int -> ST s Int).
318+ append (writeAtMost a f) (writeAtMost b g) =
319+ writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->
320+ g marr (o+n) >>= \ m ->
321+ let s = n+m in s `seq` return s)
322+
323+"ensureFree/ensureFree" forall a b .
324+ append (ensureFree a) (ensureFree b) = ensureFree (max a b)
325+
326+"flush/flush"
327+ append flush flush = flush
328+
329+ #-}
Data/Text/Lazy/Builder/Functions.hs → Data/Text/Internal/Builder/Functions.hsrenamed+8−3
@@ -1,7 +1,7 @@
1{-# LANGUAGE MagicHash #-}
1{-# LANGUAGE MagicHash #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Lazy.Builder.Functions
4+-- Module : Data.Text.Internal.Builder.Functions
5-- Copyright : (c) 2011 MailRank, Inc.
5-- Copyright : (c) 2011 MailRank, Inc.
6--
6--
7-- License : BSD-style
7-- License : BSD-style
@@ -9,9 +9,13 @@
9-- Stability : experimental
9-- Stability : experimental
10-- Portability : GHC
10-- Portability : GHC
11--
11--
12+-- /Warning/: this is an internal module, and does not have a stable
13+-- API or name. Functions in this module may not check or enforce
14+-- preconditions expected by public modules. Use at your own risk!
15+--
12-- Useful functions and combinators.
16-- Useful functions and combinators.
13
17
14−module Data.Text.Lazy.Builder.Functions
18+module Data.Text.Internal.Builder.Functions
15 (
19 (
16 (<>)
20 (<>)
17 , i2d
21 , i2d
@@ -19,7 +23,8 @@ module Data.Text.Lazy.Builder.Functions
19
23
20import Data.Monoid (mappend)
24import Data.Monoid (mappend)
21import Data.Text.Lazy.Builder (Builder)
25import Data.Text.Lazy.Builder (Builder)
22−import GHC.Base
26+import GHC.Base (chr#,ord#,(+#),Int(I#),Char(C#))
27+import Prelude ()
23
28
24-- | Unsafe conversion for decimal digits.
29-- | Unsafe conversion for decimal digits.
25{-# INLINE i2d #-}
30{-# INLINE i2d #-}
Data/Text/Internal/Builder/Int/Digits.hsnew file+26
@@ -0,0 +1,26 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+-- Module: Data.Text.Internal.Builder.Int.Digits
4+-- Copyright: (c) 2013 Bryan O'Sullivan
5+-- License: BSD-style
6+-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
7+-- Stability: experimental
8+-- Portability: portable
9+--
10+-- /Warning/: this is an internal module, and does not have a stable
11+-- API or name. Functions in this module may not check or enforce
12+-- preconditions expected by public modules. Use at your own risk!
13+--
14+-- This module exists because the C preprocessor does things that we
15+-- shall not speak of when confronted with Haskell multiline strings.
16+
17+module Data.Text.Internal.Builder.Int.Digits (digits) where
18+
19+import Data.ByteString.Char8 (ByteString)
20+
21+digits :: ByteString
22+digits = "0001020304050607080910111213141516171819\
23+ \2021222324252627282930313233343536373839\
24+ \4041424344454647484950515253545556575859\
25+ \6061626364656667686970717273747576777879\
26+ \8081828384858687888990919293949596979899"
Data/Text/Internal/Builder/RealFloat/Functions.hsnew file+57
@@ -0,0 +1,57 @@
1+{-# LANGUAGE CPP #-}
2+
3+-- |
4+-- Module: Data.Text.Internal.Builder.RealFloat.Functions
5+-- Copyright: (c) The University of Glasgow 1994-2002
6+-- License: see libraries/base/LICENSE
7+--
8+-- /Warning/: this is an internal module, and does not have a stable
9+-- API or name. Functions in this module may not check or enforce
10+-- preconditions expected by public modules. Use at your own risk!
11+
12+module Data.Text.Internal.Builder.RealFloat.Functions
13+ (
14+ roundTo
15+ ) where
16+
17+roundTo :: 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+
42+roundTo d is =
43+ case f d is of
44+ x@(0,_) -> x
45+ (1,xs) -> (1, 1:xs)
46+ _ -> error "roundTo: bad Value"
47+ where
48+ f n [] = (0, replicate n 0)
49+ f 0 (x:_) = (if x >= 5 then 1 else 0, [])
50+ f n (i:xs)
51+ | i' == 10 = (1,0:ds)
52+ | otherwise = (0,i':ds)
53+ where
54+ (c,ds) = f (n-1) xs
55+ i' = c + i
56+
57+#endif
Data/Text/Encoding/Fusion.hs → Data/Text/Internal/Encoding/Fusion.hsrenamed+19−16
@@ -1,21 +1,24 @@
1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Encoding.Fusion
4+-- Module : Data.Text.Internal.Encoding.Fusion
5-- Copyright : (c) Tom Harper 2008-2009,
5-- Copyright : (c) Tom Harper 2008-2009,
6-- (c) Bryan O'Sullivan 2009,
6-- (c) Bryan O'Sullivan 2009,
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, rtomharper@googlemail.com,
10+-- Maintainer : bos@serpentine.com
11−-- duncan@haskell.org
12-- Stability : experimental
11-- Stability : experimental
13-- Portability : portable
12-- Portability : portable
14--
13--
14+-- /Warning/: this is an internal module, and does not have a stable
15+-- API or name. Functions in this module may not check or enforce
16+-- preconditions expected by public modules. Use at your own risk!
17+--
15-- Fusible 'Stream'-oriented functions for converting between 'Text'
18-- Fusible 'Stream'-oriented functions for converting between 'Text'
16-- and several common encodings.
19-- and several common encodings.
17
20
18−module Data.Text.Encoding.Fusion
21+module Data.Text.Internal.Encoding.Fusion
19 (
22 (
20 -- * Streaming
23 -- * Streaming
21 streamASCII
24 streamASCII
@@ -28,28 +31,28 @@ module Data.Text.Encoding.Fusion
28 -- * Unstreaming
31 -- * Unstreaming
29 , unstream
32 , unstream
30
33
31− , module Data.Text.Encoding.Fusion.Common
34+ , module Data.Text.Internal.Encoding.Fusion.Common
32 ) where
35 ) where
33
36
34#if defined(ASSERTS)
37#if defined(ASSERTS)
35import Control.Exception (assert)
38import Control.Exception (assert)
36#endif
39#endif
37import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)
40import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)
38−import Data.Text.Fusion (Step(..), Stream(..))
41+import Data.Text.Internal.Fusion (Step(..), Stream(..))
39−import Data.Text.Fusion.Size
42+import Data.Text.Internal.Fusion.Size
40import Data.Text.Encoding.Error
43import Data.Text.Encoding.Error
41−import Data.Text.Encoding.Fusion.Common
44+import Data.Text.Internal.Encoding.Fusion.Common
42−import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)
45+import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)
43−import Data.Text.UnsafeShift (shiftL, shiftR)
46+import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
44import Data.Word (Word8, Word16, Word32)
47import Data.Word (Word8, Word16, Word32)
45import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
48import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
46import Foreign.Storable (pokeByteOff)
49import Foreign.Storable (pokeByteOff)
47−import System.IO.Unsafe (unsafePerformIO)
48import qualified Data.ByteString as B
50import qualified Data.ByteString as B
49import qualified Data.ByteString.Unsafe as B
51import qualified Data.ByteString.Unsafe as B
50−import qualified Data.Text.Encoding.Utf8 as U8
52+import qualified Data.Text.Internal.Encoding.Utf8 as U8
51−import qualified Data.Text.Encoding.Utf16 as U16
53+import qualified Data.Text.Internal.Encoding.Utf16 as U16
52−import qualified Data.Text.Encoding.Utf32 as U32
54+import qualified Data.Text.Internal.Encoding.Utf32 as U32
55+import Data.Text.Unsafe (unsafeDupablePerformIO)
53
56
54streamASCII :: ByteString -> Stream Char
57streamASCII :: ByteString -> Stream Char
55streamASCII bs = Stream next 0 (maxSize l)
58streamASCII bs = Stream next 0 (maxSize l)
@@ -163,7 +166,7 @@ streamUtf32LE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))
163
166
164-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.
167-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.
165unstream :: Stream Word8 -> ByteString
168unstream :: Stream Word8 -> ByteString
166−unstream (Stream next s0 len) = unsafePerformIO $ do
169+unstream (Stream next s0 len) = unsafeDupablePerformIO $ do
167 let mlen = upperBound 4 len
170 let mlen = upperBound 4 len
168 mallocByteString mlen >>= loop mlen 0 s0
171 mallocByteString mlen >>= loop mlen 0 s0
169 where
172 where
@@ -201,5 +204,5 @@ decodeError func kind onErr mb i =
201 case onErr desc mb of
204 case onErr desc mb of
202 Nothing -> Skip i
205 Nothing -> Skip i
203 Just c -> Yield c i
206 Just c -> Yield c i
204− where desc = "Data.Text.Encoding.Fusion." ++ func ++ ": Invalid " ++
207+ where desc = "Data.Text.Internal.Encoding.Fusion." ++ func ++ ": Invalid " ++
205 kind ++ " stream"
208 kind ++ " stream"
Data/Text/Encoding/Fusion/Common.hs → Data/Text/Internal/Encoding/Fusion/Common.hsrenamed+11−35
@@ -1,64 +1,40 @@
1{-# LANGUAGE BangPatterns #-}
1{-# LANGUAGE BangPatterns #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Encoding.Fusion.Common
4+-- Module : Data.Text.Internal.Encoding.Fusion.Common
5-- Copyright : (c) Tom Harper 2008-2009,
5-- Copyright : (c) Tom Harper 2008-2009,
6-- (c) Bryan O'Sullivan 2009,
6-- (c) Bryan O'Sullivan 2009,
7-- (c) Duncan Coutts 2009,
7-- (c) Duncan Coutts 2009,
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, rtomharper@googlemail.com,
11+-- Maintainer : bos@serpentine.com
12−-- duncan@haskell.org
13-- Stability : experimental
12-- Stability : experimental
14-- Portability : portable
13-- Portability : portable
15--
14--
15+-- /Warning/: this is an internal module, and does not have a stable
16+-- API or name. Use at your own risk!
17+--
16-- Fusible 'Stream'-oriented functions for converting between 'Text'
18-- Fusible 'Stream'-oriented functions for converting between 'Text'
17-- and several common encodings.
19-- and several common encodings.
18
20
19−module Data.Text.Encoding.Fusion.Common
21+module Data.Text.Internal.Encoding.Fusion.Common
20 (
22 (
21 -- * Restreaming
23 -- * Restreaming
22 -- Restreaming is the act of converting from one 'Stream'
24 -- Restreaming is the act of converting from one 'Stream'
23 -- representation to another.
25 -- representation to another.
24− restreamUtf8
25− , restreamUtf16LE
26+ restreamUtf16LE
26 , restreamUtf16BE
27 , restreamUtf16BE
27 , restreamUtf32LE
28 , restreamUtf32LE
28 , restreamUtf32BE
29 , restreamUtf32BE
29 ) where
30 ) where
30
31
31import Data.Bits ((.&.))
32import Data.Bits ((.&.))
32−import Data.Text.Fusion (Step(..), Stream(..))
33+import Data.Text.Internal.Fusion (Step(..), Stream(..))
33−import Data.Text.Fusion.Internal (RS(..))
34+import Data.Text.Internal.Fusion.Types (RS(..))
34−import Data.Text.UnsafeChar (ord)
35+import Data.Text.Internal.Unsafe.Char (ord)
35−import Data.Text.UnsafeShift (shiftR)
36+import Data.Text.Internal.Unsafe.Shift (shiftR)
36import Data.Word (Word8)
37import Data.Word (Word8)
37−import qualified Data.Text.Encoding.Utf8 as U8
38−
39−-- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.
40−restreamUtf8 :: Stream Char -> Stream Word8
41−restreamUtf8 (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
42− where
43− next (RS0 s) = case next0 s of
44− Done -> Done
45− Skip s' -> Skip (RS0 s')
46− Yield x s'
47− | n <= 0x7F -> Yield c (RS0 s')
48− | n <= 0x07FF -> Yield a2 (RS1 s' b2)
49− | n <= 0xFFFF -> Yield a3 (RS2 s' b3 c3)
50− | otherwise -> Yield a4 (RS3 s' b4 c4 d4)
51− where
52− n = ord x
53− c = fromIntegral n
54− (a2,b2) = U8.ord2 x
55− (a3,b3,c3) = U8.ord3 x
56− (a4,b4,c4,d4) = U8.ord4 x
57− next (RS1 s x2) = Yield x2 (RS0 s)
58− next (RS2 s x2 x3) = Yield x2 (RS1 s x3)
59− next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)
60− {-# INLINE next #-}
61−{-# INLINE restreamUtf8 #-}
62
38
63restreamUtf16BE :: Stream Char -> Stream Word8
39restreamUtf16BE :: Stream Char -> Stream Word8
64restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
40restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
Data/Text/Encoding/Utf16.hs → Data/Text/Internal/Encoding/Utf16.hsrenamed+7−4
@@ -1,19 +1,22 @@
1{-# LANGUAGE MagicHash, BangPatterns #-}
1{-# LANGUAGE MagicHash, BangPatterns #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Encoding.Utf16
4+-- Module : Data.Text.Internal.Encoding.Utf16
5-- Copyright : (c) 2008, 2009 Tom Harper,
5-- Copyright : (c) 2008, 2009 Tom Harper,
6-- (c) 2009 Bryan O'Sullivan,
6-- (c) 2009 Bryan O'Sullivan,
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, rtomharper@googlemail.com,
10+-- Maintainer : bos@serpentine.com
11−-- duncan@haskell.org
12-- Stability : experimental
11-- Stability : experimental
13-- Portability : GHC
12-- Portability : GHC
14--
13--
14+-- /Warning/: this is an internal module, and does not have a stable
15+-- API or name. Functions in this module may not check or enforce
16+-- preconditions expected by public modules. Use at your own risk!
17+--
15-- Basic UTF-16 validation and character manipulation.
18-- Basic UTF-16 validation and character manipulation.
16−module Data.Text.Encoding.Utf16
19+module Data.Text.Internal.Encoding.Utf16
17 (
20 (
18 chr2
21 chr2
19 , validate1
22 , validate1
Data/Text/Encoding/Utf32.hs → Data/Text/Internal/Encoding/Utf32.hsrenamed+7−4
@@ -1,17 +1,20 @@
1-- |
1-- |
2−-- Module : Data.Text.Encoding.Utf32
2+-- Module : Data.Text.Internal.Encoding.Utf32
3-- Copyright : (c) 2008, 2009 Tom Harper,
3-- Copyright : (c) 2008, 2009 Tom Harper,
4-- (c) 2009, 2010 Bryan O'Sullivan,
4-- (c) 2009, 2010 Bryan O'Sullivan,
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, rtomharper@googlemail.com,
8+-- Maintainer : bos@serpentine.com
9−-- duncan@haskell.org
10-- Stability : experimental
9-- Stability : experimental
11-- Portability : portable
10-- Portability : portable
12--
11--
12+-- /Warning/: this is an internal module, and does not have a stable
13+-- API or name. Functions in this module may not check or enforce
14+-- preconditions expected by public modules. Use at your own risk!
15+--
13-- Basic UTF-32 validation.
16-- Basic UTF-32 validation.
14−module Data.Text.Encoding.Utf32
17+module Data.Text.Internal.Encoding.Utf32
15 (
18 (
16 validate
19 validate
17 ) where
20 ) where
Data/Text/Encoding/Utf8.hs → Data/Text/Internal/Encoding/Utf8.hsrenamed+13−6
@@ -1,19 +1,22 @@
1{-# LANGUAGE CPP, MagicHash, BangPatterns #-}
1{-# LANGUAGE CPP, MagicHash, BangPatterns #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Encoding.Utf8
4+-- Module : Data.Text.Internal.Encoding.Utf8
5-- Copyright : (c) 2008, 2009 Tom Harper,
5-- Copyright : (c) 2008, 2009 Tom Harper,
6-- (c) 2009, 2010 Bryan O'Sullivan,
6-- (c) 2009, 2010 Bryan O'Sullivan,
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, rtomharper@googlemail.com,
10+-- Maintainer : bos@serpentine.com
11−-- duncan@haskell.org
12-- Stability : experimental
11-- Stability : experimental
13-- Portability : GHC
12-- Portability : GHC
14--
13--
14+-- /Warning/: this is an internal module, and does not have a stable
15+-- API or name. Functions in this module may not check or enforce
16+-- preconditions expected by public modules. Use at your own risk!
17+--
15-- Basic UTF-8 validation and character manipulation.
18-- Basic UTF-8 validation and character manipulation.
16−module Data.Text.Encoding.Utf8
19+module Data.Text.Internal.Encoding.Utf8
17 (
20 (
18 -- Decomposition
21 -- Decomposition
19 ord2
22 ord2
@@ -30,12 +33,16 @@ module Data.Text.Encoding.Utf8
30 , validate4
33 , validate4
31 ) where
34 ) where
32
35
36+#if defined(TEST_SUITE)
37+# undef ASSERTS
38+#endif
39+
33#if defined(ASSERTS)
40#if defined(ASSERTS)
34import Control.Exception (assert)
41import Control.Exception (assert)
35#endif
42#endif
36import Data.Bits ((.&.))
43import Data.Bits ((.&.))
37−import Data.Text.UnsafeChar (ord)
44+import Data.Text.Internal.Unsafe.Char (ord)
38−import Data.Text.UnsafeShift (shiftR)
45+import Data.Text.Internal.Unsafe.Shift (shiftR)
39import GHC.Exts
46import GHC.Exts
40import GHC.Word (Word8(..))
47import GHC.Word (Word8(..))
41
48
Data/Text/Util.hs → Data/Text/Internal/Functions.hsrenamed+6−2
@@ -1,7 +1,7 @@
1{-# LANGUAGE CPP, DeriveDataTypeable #-}
1{-# LANGUAGE CPP, DeriveDataTypeable #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Util
4+-- Module : Data.Text.Internal.Functions
5-- Copyright : 2010 Bryan O'Sullivan
5-- Copyright : 2010 Bryan O'Sullivan
6--
6--
7-- License : BSD-style
7-- License : BSD-style
@@ -9,9 +9,13 @@
9-- Stability : experimental
9-- Stability : experimental
10-- Portability : GHC
10-- Portability : GHC
11--
11--
12+-- /Warning/: this is an internal module, and does not have a stable
13+-- API or name. Functions in this module may not check or enforce
14+-- preconditions expected by public modules. Use at your own risk!
15+--
12-- Useful functions.
16-- Useful functions.
13
17
14−module Data.Text.Util
18+module Data.Text.Internal.Functions
15 (
19 (
16 intersperse
20 intersperse
17 ) where
21 ) where
Data/Text/Fusion.hs → Data/Text/Internal/Fusion.hsrenamed+55−42
@@ -1,20 +1,23 @@
1{-# LANGUAGE BangPatterns, MagicHash #-}
1{-# LANGUAGE BangPatterns, MagicHash #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Fusion
4+-- Module : Data.Text.Internal.Fusion
5-- Copyright : (c) Tom Harper 2008-2009,
5-- Copyright : (c) Tom Harper 2008-2009,
6-- (c) Bryan O'Sullivan 2009-2010,
6-- (c) Bryan O'Sullivan 2009-2010,
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, rtomharper@googlemail.com,
10+-- Maintainer : bos@serpentine.com
11−-- duncan@haskell.org
12-- Stability : experimental
11-- Stability : experimental
13-- Portability : GHC
12-- Portability : GHC
14--
13--
14+-- /Warning/: this is an internal module, and does not have a stable
15+-- API or name. Functions in this module may not check or enforce
16+-- preconditions expected by public modules. Use at your own risk!
17+--
15-- Text manipulation functions represented as fusible operations over
18-- Text manipulation functions represented as fusible operations over
16-- streams.
19-- streams.
17−module Data.Text.Fusion
20+module Data.Text.Internal.Fusion
18 (
21 (
19 -- * Types
22 -- * Types
20 Stream(..)
23 Stream(..)
@@ -51,21 +54,21 @@ import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,
51 fromIntegral, otherwise)
54 fromIntegral, otherwise)
52import Data.Bits ((.&.))
55import Data.Bits ((.&.))
53import Data.Text.Internal (Text(..))
56import Data.Text.Internal (Text(..))
54−import Data.Text.Private (runText)
57+import Data.Text.Internal.Private (runText)
55−import Data.Text.UnsafeChar (ord, unsafeChr, unsafeWrite)
58+import Data.Text.Internal.Unsafe.Char (ord, unsafeChr, unsafeWrite)
56−import Data.Text.UnsafeShift (shiftL, shiftR)
59+import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
57import qualified Data.Text.Array as A
60import qualified Data.Text.Array as A
58−import qualified Data.Text.Fusion.Common as S
61+import qualified Data.Text.Internal.Fusion.Common as S
59−import Data.Text.Fusion.Internal
62+import Data.Text.Internal.Fusion.Types
60−import Data.Text.Fusion.Size
63+import Data.Text.Internal.Fusion.Size
61import qualified Data.Text.Internal as I
64import qualified Data.Text.Internal as I
62−import qualified Data.Text.Encoding.Utf16 as U16
65+import qualified Data.Text.Internal.Encoding.Utf16 as U16
63
66
64default(Int)
67default(Int)
65
68
66-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
69-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
67stream :: Text -> Stream Char
70stream :: Text -> Stream Char
68−stream (Text arr off len) = Stream next off (maxSize len)
71+stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)
69 where
72 where
70 !end = off+len
73 !end = off+len
71 next !i
74 next !i
@@ -80,7 +83,7 @@ stream (Text arr off len) = Stream next off (maxSize len)
80-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate
83-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate
81-- backwards.
84-- backwards.
82reverseStream :: Text -> Stream Char
85reverseStream :: Text -> Stream Char
83−reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)
86+reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `shiftR` 1) len)
84 where
87 where
85 {-# INLINE next #-}
88 {-# INLINE next #-}
86 next !i
89 next !i
@@ -95,25 +98,35 @@ reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)
95-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
98-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
96unstream :: Stream Char -> Text
99unstream :: Stream Char -> Text
97unstream (Stream next0 s0 len) = runText $ \done -> do
100unstream (Stream next0 s0 len) = runText $ \done -> do
101+ -- Before encoding each char we perform a buffer realloc check assuming
102+ -- worst case encoding size of two 16-bit units for the char. Just add an
103+ -- extra space to the buffer so that we do not end up reallocating even when
104+ -- all the chars are encoded as single unit.
98− let mlen = upperBound 4 len
105+ let mlen = upperBound 4 len + 1
99 arr0 <- A.new mlen
106 arr0 <- A.new mlen
100− let outer arr top = loop
107+ let outer !arr !maxi = encode
101 where
108 where
102− loop !s !i =
109+ -- keep the common case loop as small as possible
110+ encode !si !di =
103− case next0 s of
111+ case next0 si of
104− Done -> done arr i
112+ Done -> done arr di
105− Skip s' -> loop s' i
113+ Skip si' -> encode si' di
106− Yield x s'
114+ Yield c si'
107− | j >= top -> {-# SCC "unstream/resize" #-} do
115+ -- simply check for the worst case
108− let top' = (top + 1) `shiftL` 1
116+ | maxi < di + 1 -> realloc si di
117+ | otherwise -> do
118+ n <- unsafeWrite arr di c
119+ encode si' (di + n)
120+
121+ -- keep uncommon case separate from the common case code
122+ {-# NOINLINE realloc #-}
123+ realloc !si !di = do
124+ let newlen = (maxi + 1) * 2
109− arr' <- A.new top'
125+ arr' <- A.new newlen
110− A.copyM arr' 0 arr 0 top
126+ A.copyM arr' 0 arr 0 di
111− outer arr' top' s i
127+ outer arr' (newlen - 1) si di
112− | otherwise -> do d <- unsafeWrite arr i x
128+
113− loop s' (i+d)
114− where j | ord x < 0x10000 = i
115− | otherwise = i + 1
116− outer arr0 mlen s0 0
129+ outer arr0 (mlen - 1) s0 0
117{-# INLINE [0] unstream #-}
130{-# INLINE [0] unstream #-}
118{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
131{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
119
132
@@ -129,7 +142,7 @@ length = S.lengthI
129reverse :: Stream Char -> Text
142reverse :: Stream Char -> Text
130reverse (Stream next s len0)
143reverse (Stream next s len0)
131 | isEmpty len0 = I.empty
144 | isEmpty len0 = I.empty
132− | otherwise = I.textP arr off' len'
145+ | otherwise = I.text arr off' len'
133 where
146 where
134 len0' = upperBound 4 (larger len0 4)
147 len0' = upperBound 4 (larger len0 4)
135 (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')
148 (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')
@@ -163,15 +176,15 @@ reverse (Stream next s len0)
163-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with
176-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with
164-- the input and result reversed.
177-- the input and result reversed.
165reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
178reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
166−reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low
179+reverseScanr f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
167 where
180 where
168 {-# INLINE next #-}
181 {-# INLINE next #-}
169− next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)
182+ next (Scan1 z s) = Yield z (Scan2 z s)
170− next (S2 :*: z :*: s) = case next0 s of
183+ next (Scan2 z s) = case next0 s of
171− Yield x s' -> let !x' = f x z
184+ Yield x s' -> let !x' = f x z
172− in Yield x' (S2 :*: x' :*: s')
185+ in Yield x' (Scan2 x' s')
173− Skip s' -> Skip (S2 :*: z :*: s')
186+ Skip s' -> Skip (Scan2 z s')
174− Done -> Done
187+ Done -> Done
175{-# INLINE reverseScanr #-}
188{-# INLINE reverseScanr #-}
176
189
177-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
190-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
@@ -207,7 +220,7 @@ countChar = S.countCharI
207-- function to each element of a 'Text', passing an accumulating
220-- function to each element of a 'Text', passing an accumulating
208-- parameter from left to right, and returns a final 'Text'.
221-- parameter from left to right, and returns a final 'Text'.
209mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)
222mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)
210−mapAccumL f z0 (Stream next0 s0 len) = (nz,I.textP na 0 nl)
223+mapAccumL f z0 (Stream next0 s0 len) = (nz, I.text na 0 nl)
211 where
224 where
212 (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)
225 (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)
213 where mlen = upperBound 4 len
226 where mlen = upperBound 4 len
@@ -223,9 +236,9 @@ mapAccumL f z0 (Stream next0 s0 len) = (nz,I.textP na 0 nl)
223 arr' <- A.new top'
236 arr' <- A.new top'
224 A.copyM arr' 0 arr 0 top
237 A.copyM arr' 0 arr 0 top
225 outer arr' top' z s i
238 outer arr' top' z s i
226− | otherwise -> do let (z',c) = f z x
227− d <- unsafeWrite arr i c
239+ | otherwise -> do d <- unsafeWrite arr i c
228 loop z' s' (i+d)
240 loop z' s' (i+d)
241+ where (z',c) = f z x
229− where j | ord x < 0x10000 = i
242+ j | ord c < 0x10000 = i
230 | otherwise = i + 1
243 | otherwise = i + 1
231{-# INLINE [0] mapAccumL #-}
244{-# INLINE [0] mapAccumL #-}
Data/Text/Fusion/CaseMapping.hs → Data/Text/Internal/Fusion/CaseMapping.hsrenamed+392−6
@@ -1,12 +1,17 @@
1{-# LANGUAGE Rank2Types #-}
1{-# LANGUAGE Rank2Types #-}
2-- AUTOMATICALLY GENERATED - DO NOT EDIT
2-- AUTOMATICALLY GENERATED - DO NOT EDIT
3−-- Generated by scripts/SpecialCasing.hs
3+-- Generated by scripts/CaseMapping.hs
4+-- CaseFolding-8.0.0.txt
5+-- Date: 2015-01-13, 18:16:36 GMT [MD]
6+-- SpecialCasing-8.0.0.txt
7+-- Date: 2014-12-16, 23:08:04 GMT [MD]
8+
4−module Data.Text.Fusion.CaseMapping where
9+module Data.Text.Internal.Fusion.CaseMapping where
5import Data.Char
10import Data.Char
6−import Data.Text.Fusion.Internal
11+import Data.Text.Internal.Fusion.Types
7
12
8upperMapping :: forall s. Char -> s -> Step (CC s) Char
13upperMapping :: forall s. Char -> s -> Step (CC s) Char
9−{-# INLINE upperMapping #-}
14+{-# NOINLINE upperMapping #-}
10-- LATIN SMALL LETTER SHARP S
15-- LATIN SMALL LETTER SHARP S
11upperMapping '\x00df' s = Yield '\x0053' (CC s '\x0053' '\x0000')
16upperMapping '\x00df' s = Yield '\x0053' (CC s '\x0053' '\x0000')
12-- LATIN SMALL LIGATURE FF
17-- LATIN SMALL LIGATURE FF
@@ -213,12 +218,111 @@ upperMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0399')
213upperMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0399')
218upperMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0399')
214upperMapping c s = Yield (toUpper c) (CC s '\0' '\0')
219upperMapping c s = Yield (toUpper c) (CC s '\0' '\0')
215lowerMapping :: forall s. Char -> s -> Step (CC s) Char
220lowerMapping :: forall s. Char -> s -> Step (CC s) Char
216−{-# INLINE lowerMapping #-}
221+{-# NOINLINE lowerMapping #-}
217-- LATIN CAPITAL LETTER I WITH DOT ABOVE
222-- LATIN CAPITAL LETTER I WITH DOT ABOVE
218lowerMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')
223lowerMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')
219lowerMapping c s = Yield (toLower c) (CC s '\0' '\0')
224lowerMapping c s = Yield (toLower c) (CC s '\0' '\0')
225+titleMapping :: forall s. Char -> s -> Step (CC s) Char
226+{-# NOINLINE titleMapping #-}
227+-- LATIN SMALL LETTER SHARP S
228+titleMapping '\x00df' s = Yield '\x0053' (CC s '\x0073' '\x0000')
229+-- LATIN SMALL LIGATURE FF
230+titleMapping '\xfb00' s = Yield '\x0046' (CC s '\x0066' '\x0000')
231+-- LATIN SMALL LIGATURE FI
232+titleMapping '\xfb01' s = Yield '\x0046' (CC s '\x0069' '\x0000')
233+-- LATIN SMALL LIGATURE FL
234+titleMapping '\xfb02' s = Yield '\x0046' (CC s '\x006c' '\x0000')
235+-- LATIN SMALL LIGATURE FFI
236+titleMapping '\xfb03' s = Yield '\x0046' (CC s '\x0066' '\x0069')
237+-- LATIN SMALL LIGATURE FFL
238+titleMapping '\xfb04' s = Yield '\x0046' (CC s '\x0066' '\x006c')
239+-- LATIN SMALL LIGATURE LONG S T
240+titleMapping '\xfb05' s = Yield '\x0053' (CC s '\x0074' '\x0000')
241+-- LATIN SMALL LIGATURE ST
242+titleMapping '\xfb06' s = Yield '\x0053' (CC s '\x0074' '\x0000')
243+-- ARMENIAN SMALL LIGATURE ECH YIWN
244+titleMapping '\x0587' s = Yield '\x0535' (CC s '\x0582' '\x0000')
245+-- ARMENIAN SMALL LIGATURE MEN NOW
246+titleMapping '\xfb13' s = Yield '\x0544' (CC s '\x0576' '\x0000')
247+-- ARMENIAN SMALL LIGATURE MEN ECH
248+titleMapping '\xfb14' s = Yield '\x0544' (CC s '\x0565' '\x0000')
249+-- ARMENIAN SMALL LIGATURE MEN INI
250+titleMapping '\xfb15' s = Yield '\x0544' (CC s '\x056b' '\x0000')
251+-- ARMENIAN SMALL LIGATURE VEW NOW
252+titleMapping '\xfb16' s = Yield '\x054e' (CC s '\x0576' '\x0000')
253+-- ARMENIAN SMALL LIGATURE MEN XEH
254+titleMapping '\xfb17' s = Yield '\x0544' (CC s '\x056d' '\x0000')
255+-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE
256+titleMapping '\x0149' s = Yield '\x02bc' (CC s '\x004e' '\x0000')
257+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
258+titleMapping '\x0390' s = Yield '\x0399' (CC s '\x0308' '\x0301')
259+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
260+titleMapping '\x03b0' s = Yield '\x03a5' (CC s '\x0308' '\x0301')
261+-- LATIN SMALL LETTER J WITH CARON
262+titleMapping '\x01f0' s = Yield '\x004a' (CC s '\x030c' '\x0000')
263+-- LATIN SMALL LETTER H WITH LINE BELOW
264+titleMapping '\x1e96' s = Yield '\x0048' (CC s '\x0331' '\x0000')
265+-- LATIN SMALL LETTER T WITH DIAERESIS
266+titleMapping '\x1e97' s = Yield '\x0054' (CC s '\x0308' '\x0000')
267+-- LATIN SMALL LETTER W WITH RING ABOVE
268+titleMapping '\x1e98' s = Yield '\x0057' (CC s '\x030a' '\x0000')
269+-- LATIN SMALL LETTER Y WITH RING ABOVE
270+titleMapping '\x1e99' s = Yield '\x0059' (CC s '\x030a' '\x0000')
271+-- LATIN SMALL LETTER A WITH RIGHT HALF RING
272+titleMapping '\x1e9a' s = Yield '\x0041' (CC s '\x02be' '\x0000')
273+-- GREEK SMALL LETTER UPSILON WITH PSILI
274+titleMapping '\x1f50' s = Yield '\x03a5' (CC s '\x0313' '\x0000')
275+-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA
276+titleMapping '\x1f52' s = Yield '\x03a5' (CC s '\x0313' '\x0300')
277+-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA
278+titleMapping '\x1f54' s = Yield '\x03a5' (CC s '\x0313' '\x0301')
279+-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI
280+titleMapping '\x1f56' s = Yield '\x03a5' (CC s '\x0313' '\x0342')
281+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI
282+titleMapping '\x1fb6' s = Yield '\x0391' (CC s '\x0342' '\x0000')
283+-- GREEK SMALL LETTER ETA WITH PERISPOMENI
284+titleMapping '\x1fc6' s = Yield '\x0397' (CC s '\x0342' '\x0000')
285+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA
286+titleMapping '\x1fd2' s = Yield '\x0399' (CC s '\x0308' '\x0300')
287+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA
288+titleMapping '\x1fd3' s = Yield '\x0399' (CC s '\x0308' '\x0301')
289+-- GREEK SMALL LETTER IOTA WITH PERISPOMENI
290+titleMapping '\x1fd6' s = Yield '\x0399' (CC s '\x0342' '\x0000')
291+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI
292+titleMapping '\x1fd7' s = Yield '\x0399' (CC s '\x0308' '\x0342')
293+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA
294+titleMapping '\x1fe2' s = Yield '\x03a5' (CC s '\x0308' '\x0300')
295+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA
296+titleMapping '\x1fe3' s = Yield '\x03a5' (CC s '\x0308' '\x0301')
297+-- GREEK SMALL LETTER RHO WITH PSILI
298+titleMapping '\x1fe4' s = Yield '\x03a1' (CC s '\x0313' '\x0000')
299+-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI
300+titleMapping '\x1fe6' s = Yield '\x03a5' (CC s '\x0342' '\x0000')
301+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI
302+titleMapping '\x1fe7' s = Yield '\x03a5' (CC s '\x0308' '\x0342')
303+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI
304+titleMapping '\x1ff6' s = Yield '\x03a9' (CC s '\x0342' '\x0000')
305+-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI
306+titleMapping '\x1fb2' s = Yield '\x1fba' (CC s '\x0345' '\x0000')
307+-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI
308+titleMapping '\x1fb4' s = Yield '\x0386' (CC s '\x0345' '\x0000')
309+-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI
310+titleMapping '\x1fc2' s = Yield '\x1fca' (CC s '\x0345' '\x0000')
311+-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI
312+titleMapping '\x1fc4' s = Yield '\x0389' (CC s '\x0345' '\x0000')
313+-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI
314+titleMapping '\x1ff2' s = Yield '\x1ffa' (CC s '\x0345' '\x0000')
315+-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI
316+titleMapping '\x1ff4' s = Yield '\x038f' (CC s '\x0345' '\x0000')
317+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI
318+titleMapping '\x1fb7' s = Yield '\x0391' (CC s '\x0342' '\x0345')
319+-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI
320+titleMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0345')
321+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI
322+titleMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0345')
323+titleMapping c s = Yield (toTitle c) (CC s '\0' '\0')
220foldMapping :: forall s. Char -> s -> Step (CC s) Char
324foldMapping :: forall s. Char -> s -> Step (CC s) Char
221−{-# INLINE foldMapping #-}
325+{-# NOINLINE foldMapping #-}
222-- MICRO SIGN
326-- MICRO SIGN
223foldMapping '\x00b5' s = Yield '\x03bc' (CC s '\x0000' '\x0000')
327foldMapping '\x00b5' s = Yield '\x03bc' (CC s '\x0000' '\x0000')
224-- LATIN SMALL LETTER SHARP S
328-- LATIN SMALL LETTER SHARP S
@@ -255,6 +359,18 @@ foldMapping '\x03f1' s = Yield '\x03c1' (CC s '\x0000' '\x0000')
255foldMapping '\x03f5' s = Yield '\x03b5' (CC s '\x0000' '\x0000')
359foldMapping '\x03f5' s = Yield '\x03b5' (CC s '\x0000' '\x0000')
256-- ARMENIAN SMALL LIGATURE ECH YIWN
360-- ARMENIAN SMALL LIGATURE ECH YIWN
257foldMapping '\x0587' s = Yield '\x0565' (CC s '\x0582' '\x0000')
361foldMapping '\x0587' s = Yield '\x0565' (CC s '\x0582' '\x0000')
362+-- CHEROKEE SMALL LETTER YE
363+foldMapping '\x13f8' s = Yield '\x13f0' (CC s '\x0000' '\x0000')
364+-- CHEROKEE SMALL LETTER YI
365+foldMapping '\x13f9' s = Yield '\x13f1' (CC s '\x0000' '\x0000')
366+-- CHEROKEE SMALL LETTER YO
367+foldMapping '\x13fa' s = Yield '\x13f2' (CC s '\x0000' '\x0000')
368+-- CHEROKEE SMALL LETTER YU
369+foldMapping '\x13fb' s = Yield '\x13f3' (CC s '\x0000' '\x0000')
370+-- CHEROKEE SMALL LETTER YV
371+foldMapping '\x13fc' s = Yield '\x13f4' (CC s '\x0000' '\x0000')
372+-- CHEROKEE SMALL LETTER MV
373+foldMapping '\x13fd' s = Yield '\x13f5' (CC s '\x0000' '\x0000')
258-- LATIN SMALL LETTER H WITH LINE BELOW
374-- LATIN SMALL LETTER H WITH LINE BELOW
259foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')
375foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')
260-- LATIN SMALL LETTER T WITH DIAERESIS
376-- LATIN SMALL LETTER T WITH DIAERESIS
@@ -429,6 +545,174 @@ foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')
429foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')
545foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')
430-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
546-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
431foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')
547foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')
548+-- LATIN CAPITAL LETTER J WITH CROSSED-TAIL
549+foldMapping '\xa7b2' s = Yield '\x029d' (CC s '\x0000' '\x0000')
550+-- LATIN CAPITAL LETTER CHI
551+foldMapping '\xa7b3' s = Yield '\xab53' (CC s '\x0000' '\x0000')
552+-- LATIN CAPITAL LETTER BETA
553+foldMapping '\xa7b4' s = Yield '\xa7b5' (CC s '\x0000' '\x0000')
554+-- LATIN CAPITAL LETTER OMEGA
555+foldMapping '\xa7b6' s = Yield '\xa7b7' (CC s '\x0000' '\x0000')
556+-- CHEROKEE SMALL LETTER A
557+foldMapping '\xab70' s = Yield '\x13a0' (CC s '\x0000' '\x0000')
558+-- CHEROKEE SMALL LETTER E
559+foldMapping '\xab71' s = Yield '\x13a1' (CC s '\x0000' '\x0000')
560+-- CHEROKEE SMALL LETTER I
561+foldMapping '\xab72' s = Yield '\x13a2' (CC s '\x0000' '\x0000')
562+-- CHEROKEE SMALL LETTER O
563+foldMapping '\xab73' s = Yield '\x13a3' (CC s '\x0000' '\x0000')
564+-- CHEROKEE SMALL LETTER U
565+foldMapping '\xab74' s = Yield '\x13a4' (CC s '\x0000' '\x0000')
566+-- CHEROKEE SMALL LETTER V
567+foldMapping '\xab75' s = Yield '\x13a5' (CC s '\x0000' '\x0000')
568+-- CHEROKEE SMALL LETTER GA
569+foldMapping '\xab76' s = Yield '\x13a6' (CC s '\x0000' '\x0000')
570+-- CHEROKEE SMALL LETTER KA
571+foldMapping '\xab77' s = Yield '\x13a7' (CC s '\x0000' '\x0000')
572+-- CHEROKEE SMALL LETTER GE
573+foldMapping '\xab78' s = Yield '\x13a8' (CC s '\x0000' '\x0000')
574+-- CHEROKEE SMALL LETTER GI
575+foldMapping '\xab79' s = Yield '\x13a9' (CC s '\x0000' '\x0000')
576+-- CHEROKEE SMALL LETTER GO
577+foldMapping '\xab7a' s = Yield '\x13aa' (CC s '\x0000' '\x0000')
578+-- CHEROKEE SMALL LETTER GU
579+foldMapping '\xab7b' s = Yield '\x13ab' (CC s '\x0000' '\x0000')
580+-- CHEROKEE SMALL LETTER GV
581+foldMapping '\xab7c' s = Yield '\x13ac' (CC s '\x0000' '\x0000')
582+-- CHEROKEE SMALL LETTER HA
583+foldMapping '\xab7d' s = Yield '\x13ad' (CC s '\x0000' '\x0000')
584+-- CHEROKEE SMALL LETTER HE
585+foldMapping '\xab7e' s = Yield '\x13ae' (CC s '\x0000' '\x0000')
586+-- CHEROKEE SMALL LETTER HI
587+foldMapping '\xab7f' s = Yield '\x13af' (CC s '\x0000' '\x0000')
588+-- CHEROKEE SMALL LETTER HO
589+foldMapping '\xab80' s = Yield '\x13b0' (CC s '\x0000' '\x0000')
590+-- CHEROKEE SMALL LETTER HU
591+foldMapping '\xab81' s = Yield '\x13b1' (CC s '\x0000' '\x0000')
592+-- CHEROKEE SMALL LETTER HV
593+foldMapping '\xab82' s = Yield '\x13b2' (CC s '\x0000' '\x0000')
594+-- CHEROKEE SMALL LETTER LA
595+foldMapping '\xab83' s = Yield '\x13b3' (CC s '\x0000' '\x0000')
596+-- CHEROKEE SMALL LETTER LE
597+foldMapping '\xab84' s = Yield '\x13b4' (CC s '\x0000' '\x0000')
598+-- CHEROKEE SMALL LETTER LI
599+foldMapping '\xab85' s = Yield '\x13b5' (CC s '\x0000' '\x0000')
600+-- CHEROKEE SMALL LETTER LO
601+foldMapping '\xab86' s = Yield '\x13b6' (CC s '\x0000' '\x0000')
602+-- CHEROKEE SMALL LETTER LU
603+foldMapping '\xab87' s = Yield '\x13b7' (CC s '\x0000' '\x0000')
604+-- CHEROKEE SMALL LETTER LV
605+foldMapping '\xab88' s = Yield '\x13b8' (CC s '\x0000' '\x0000')
606+-- CHEROKEE SMALL LETTER MA
607+foldMapping '\xab89' s = Yield '\x13b9' (CC s '\x0000' '\x0000')
608+-- CHEROKEE SMALL LETTER ME
609+foldMapping '\xab8a' s = Yield '\x13ba' (CC s '\x0000' '\x0000')
610+-- CHEROKEE SMALL LETTER MI
611+foldMapping '\xab8b' s = Yield '\x13bb' (CC s '\x0000' '\x0000')
612+-- CHEROKEE SMALL LETTER MO
613+foldMapping '\xab8c' s = Yield '\x13bc' (CC s '\x0000' '\x0000')
614+-- CHEROKEE SMALL LETTER MU
615+foldMapping '\xab8d' s = Yield '\x13bd' (CC s '\x0000' '\x0000')
616+-- CHEROKEE SMALL LETTER NA
617+foldMapping '\xab8e' s = Yield '\x13be' (CC s '\x0000' '\x0000')
618+-- CHEROKEE SMALL LETTER HNA
619+foldMapping '\xab8f' s = Yield '\x13bf' (CC s '\x0000' '\x0000')
620+-- CHEROKEE SMALL LETTER NAH
621+foldMapping '\xab90' s = Yield '\x13c0' (CC s '\x0000' '\x0000')
622+-- CHEROKEE SMALL LETTER NE
623+foldMapping '\xab91' s = Yield '\x13c1' (CC s '\x0000' '\x0000')
624+-- CHEROKEE SMALL LETTER NI
625+foldMapping '\xab92' s = Yield '\x13c2' (CC s '\x0000' '\x0000')
626+-- CHEROKEE SMALL LETTER NO
627+foldMapping '\xab93' s = Yield '\x13c3' (CC s '\x0000' '\x0000')
628+-- CHEROKEE SMALL LETTER NU
629+foldMapping '\xab94' s = Yield '\x13c4' (CC s '\x0000' '\x0000')
630+-- CHEROKEE SMALL LETTER NV
631+foldMapping '\xab95' s = Yield '\x13c5' (CC s '\x0000' '\x0000')
632+-- CHEROKEE SMALL LETTER QUA
633+foldMapping '\xab96' s = Yield '\x13c6' (CC s '\x0000' '\x0000')
634+-- CHEROKEE SMALL LETTER QUE
635+foldMapping '\xab97' s = Yield '\x13c7' (CC s '\x0000' '\x0000')
636+-- CHEROKEE SMALL LETTER QUI
637+foldMapping '\xab98' s = Yield '\x13c8' (CC s '\x0000' '\x0000')
638+-- CHEROKEE SMALL LETTER QUO
639+foldMapping '\xab99' s = Yield '\x13c9' (CC s '\x0000' '\x0000')
640+-- CHEROKEE SMALL LETTER QUU
641+foldMapping '\xab9a' s = Yield '\x13ca' (CC s '\x0000' '\x0000')
642+-- CHEROKEE SMALL LETTER QUV
643+foldMapping '\xab9b' s = Yield '\x13cb' (CC s '\x0000' '\x0000')
644+-- CHEROKEE SMALL LETTER SA
645+foldMapping '\xab9c' s = Yield '\x13cc' (CC s '\x0000' '\x0000')
646+-- CHEROKEE SMALL LETTER S
647+foldMapping '\xab9d' s = Yield '\x13cd' (CC s '\x0000' '\x0000')
648+-- CHEROKEE SMALL LETTER SE
649+foldMapping '\xab9e' s = Yield '\x13ce' (CC s '\x0000' '\x0000')
650+-- CHEROKEE SMALL LETTER SI
651+foldMapping '\xab9f' s = Yield '\x13cf' (CC s '\x0000' '\x0000')
652+-- CHEROKEE SMALL LETTER SO
653+foldMapping '\xaba0' s = Yield '\x13d0' (CC s '\x0000' '\x0000')
654+-- CHEROKEE SMALL LETTER SU
655+foldMapping '\xaba1' s = Yield '\x13d1' (CC s '\x0000' '\x0000')
656+-- CHEROKEE SMALL LETTER SV
657+foldMapping '\xaba2' s = Yield '\x13d2' (CC s '\x0000' '\x0000')
658+-- CHEROKEE SMALL LETTER DA
659+foldMapping '\xaba3' s = Yield '\x13d3' (CC s '\x0000' '\x0000')
660+-- CHEROKEE SMALL LETTER TA
661+foldMapping '\xaba4' s = Yield '\x13d4' (CC s '\x0000' '\x0000')
662+-- CHEROKEE SMALL LETTER DE
663+foldMapping '\xaba5' s = Yield '\x13d5' (CC s '\x0000' '\x0000')
664+-- CHEROKEE SMALL LETTER TE
665+foldMapping '\xaba6' s = Yield '\x13d6' (CC s '\x0000' '\x0000')
666+-- CHEROKEE SMALL LETTER DI
667+foldMapping '\xaba7' s = Yield '\x13d7' (CC s '\x0000' '\x0000')
668+-- CHEROKEE SMALL LETTER TI
669+foldMapping '\xaba8' s = Yield '\x13d8' (CC s '\x0000' '\x0000')
670+-- CHEROKEE SMALL LETTER DO
671+foldMapping '\xaba9' s = Yield '\x13d9' (CC s '\x0000' '\x0000')
672+-- CHEROKEE SMALL LETTER DU
673+foldMapping '\xabaa' s = Yield '\x13da' (CC s '\x0000' '\x0000')
674+-- CHEROKEE SMALL LETTER DV
675+foldMapping '\xabab' s = Yield '\x13db' (CC s '\x0000' '\x0000')
676+-- CHEROKEE SMALL LETTER DLA
677+foldMapping '\xabac' s = Yield '\x13dc' (CC s '\x0000' '\x0000')
678+-- CHEROKEE SMALL LETTER TLA
679+foldMapping '\xabad' s = Yield '\x13dd' (CC s '\x0000' '\x0000')
680+-- CHEROKEE SMALL LETTER TLE
681+foldMapping '\xabae' s = Yield '\x13de' (CC s '\x0000' '\x0000')
682+-- CHEROKEE SMALL LETTER TLI
683+foldMapping '\xabaf' s = Yield '\x13df' (CC s '\x0000' '\x0000')
684+-- CHEROKEE SMALL LETTER TLO
685+foldMapping '\xabb0' s = Yield '\x13e0' (CC s '\x0000' '\x0000')
686+-- CHEROKEE SMALL LETTER TLU
687+foldMapping '\xabb1' s = Yield '\x13e1' (CC s '\x0000' '\x0000')
688+-- CHEROKEE SMALL LETTER TLV
689+foldMapping '\xabb2' s = Yield '\x13e2' (CC s '\x0000' '\x0000')
690+-- CHEROKEE SMALL LETTER TSA
691+foldMapping '\xabb3' s = Yield '\x13e3' (CC s '\x0000' '\x0000')
692+-- CHEROKEE SMALL LETTER TSE
693+foldMapping '\xabb4' s = Yield '\x13e4' (CC s '\x0000' '\x0000')
694+-- CHEROKEE SMALL LETTER TSI
695+foldMapping '\xabb5' s = Yield '\x13e5' (CC s '\x0000' '\x0000')
696+-- CHEROKEE SMALL LETTER TSO
697+foldMapping '\xabb6' s = Yield '\x13e6' (CC s '\x0000' '\x0000')
698+-- CHEROKEE SMALL LETTER TSU
699+foldMapping '\xabb7' s = Yield '\x13e7' (CC s '\x0000' '\x0000')
700+-- CHEROKEE SMALL LETTER TSV
701+foldMapping '\xabb8' s = Yield '\x13e8' (CC s '\x0000' '\x0000')
702+-- CHEROKEE SMALL LETTER WA
703+foldMapping '\xabb9' s = Yield '\x13e9' (CC s '\x0000' '\x0000')
704+-- CHEROKEE SMALL LETTER WE
705+foldMapping '\xabba' s = Yield '\x13ea' (CC s '\x0000' '\x0000')
706+-- CHEROKEE SMALL LETTER WI
707+foldMapping '\xabbb' s = Yield '\x13eb' (CC s '\x0000' '\x0000')
708+-- CHEROKEE SMALL LETTER WO
709+foldMapping '\xabbc' s = Yield '\x13ec' (CC s '\x0000' '\x0000')
710+-- CHEROKEE SMALL LETTER WU
711+foldMapping '\xabbd' s = Yield '\x13ed' (CC s '\x0000' '\x0000')
712+-- CHEROKEE SMALL LETTER WV
713+foldMapping '\xabbe' s = Yield '\x13ee' (CC s '\x0000' '\x0000')
714+-- CHEROKEE SMALL LETTER YA
715+foldMapping '\xabbf' s = Yield '\x13ef' (CC s '\x0000' '\x0000')
432-- LATIN SMALL LIGATURE FF
716-- LATIN SMALL LIGATURE FF
433foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')
717foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')
434-- LATIN SMALL LIGATURE FI
718-- LATIN SMALL LIGATURE FI
@@ -453,4 +737,106 @@ foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')
453foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')
737foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')
454-- ARMENIAN SMALL LIGATURE MEN XEH
738-- ARMENIAN SMALL LIGATURE MEN XEH
455foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')
739foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')
740+-- OLD HUNGARIAN CAPITAL LETTER A
741+foldMapping '\x10c80' s = Yield '\x10cc0' (CC s '\x0000' '\x0000')
742+-- OLD HUNGARIAN CAPITAL LETTER AA
743+foldMapping '\x10c81' s = Yield '\x10cc1' (CC s '\x0000' '\x0000')
744+-- OLD HUNGARIAN CAPITAL LETTER EB
745+foldMapping '\x10c82' s = Yield '\x10cc2' (CC s '\x0000' '\x0000')
746+-- OLD HUNGARIAN CAPITAL LETTER AMB
747+foldMapping '\x10c83' s = Yield '\x10cc3' (CC s '\x0000' '\x0000')
748+-- OLD HUNGARIAN CAPITAL LETTER EC
749+foldMapping '\x10c84' s = Yield '\x10cc4' (CC s '\x0000' '\x0000')
750+-- OLD HUNGARIAN CAPITAL LETTER ENC
751+foldMapping '\x10c85' s = Yield '\x10cc5' (CC s '\x0000' '\x0000')
752+-- OLD HUNGARIAN CAPITAL LETTER ECS
753+foldMapping '\x10c86' s = Yield '\x10cc6' (CC s '\x0000' '\x0000')
754+-- OLD HUNGARIAN CAPITAL LETTER ED
755+foldMapping '\x10c87' s = Yield '\x10cc7' (CC s '\x0000' '\x0000')
756+-- OLD HUNGARIAN CAPITAL LETTER AND
757+foldMapping '\x10c88' s = Yield '\x10cc8' (CC s '\x0000' '\x0000')
758+-- OLD HUNGARIAN CAPITAL LETTER E
759+foldMapping '\x10c89' s = Yield '\x10cc9' (CC s '\x0000' '\x0000')
760+-- OLD HUNGARIAN CAPITAL LETTER CLOSE E
761+foldMapping '\x10c8a' s = Yield '\x10cca' (CC s '\x0000' '\x0000')
762+-- OLD HUNGARIAN CAPITAL LETTER EE
763+foldMapping '\x10c8b' s = Yield '\x10ccb' (CC s '\x0000' '\x0000')
764+-- OLD HUNGARIAN CAPITAL LETTER EF
765+foldMapping '\x10c8c' s = Yield '\x10ccc' (CC s '\x0000' '\x0000')
766+-- OLD HUNGARIAN CAPITAL LETTER EG
767+foldMapping '\x10c8d' s = Yield '\x10ccd' (CC s '\x0000' '\x0000')
768+-- OLD HUNGARIAN CAPITAL LETTER EGY
769+foldMapping '\x10c8e' s = Yield '\x10cce' (CC s '\x0000' '\x0000')
770+-- OLD HUNGARIAN CAPITAL LETTER EH
771+foldMapping '\x10c8f' s = Yield '\x10ccf' (CC s '\x0000' '\x0000')
772+-- OLD HUNGARIAN CAPITAL LETTER I
773+foldMapping '\x10c90' s = Yield '\x10cd0' (CC s '\x0000' '\x0000')
774+-- OLD HUNGARIAN CAPITAL LETTER II
775+foldMapping '\x10c91' s = Yield '\x10cd1' (CC s '\x0000' '\x0000')
776+-- OLD HUNGARIAN CAPITAL LETTER EJ
777+foldMapping '\x10c92' s = Yield '\x10cd2' (CC s '\x0000' '\x0000')
778+-- OLD HUNGARIAN CAPITAL LETTER EK
779+foldMapping '\x10c93' s = Yield '\x10cd3' (CC s '\x0000' '\x0000')
780+-- OLD HUNGARIAN CAPITAL LETTER AK
781+foldMapping '\x10c94' s = Yield '\x10cd4' (CC s '\x0000' '\x0000')
782+-- OLD HUNGARIAN CAPITAL LETTER UNK
783+foldMapping '\x10c95' s = Yield '\x10cd5' (CC s '\x0000' '\x0000')
784+-- OLD HUNGARIAN CAPITAL LETTER EL
785+foldMapping '\x10c96' s = Yield '\x10cd6' (CC s '\x0000' '\x0000')
786+-- OLD HUNGARIAN CAPITAL LETTER ELY
787+foldMapping '\x10c97' s = Yield '\x10cd7' (CC s '\x0000' '\x0000')
788+-- OLD HUNGARIAN CAPITAL LETTER EM
789+foldMapping '\x10c98' s = Yield '\x10cd8' (CC s '\x0000' '\x0000')
790+-- OLD HUNGARIAN CAPITAL LETTER EN
791+foldMapping '\x10c99' s = Yield '\x10cd9' (CC s '\x0000' '\x0000')
792+-- OLD HUNGARIAN CAPITAL LETTER ENY
793+foldMapping '\x10c9a' s = Yield '\x10cda' (CC s '\x0000' '\x0000')
794+-- OLD HUNGARIAN CAPITAL LETTER O
795+foldMapping '\x10c9b' s = Yield '\x10cdb' (CC s '\x0000' '\x0000')
796+-- OLD HUNGARIAN CAPITAL LETTER OO
797+foldMapping '\x10c9c' s = Yield '\x10cdc' (CC s '\x0000' '\x0000')
798+-- OLD HUNGARIAN CAPITAL LETTER NIKOLSBURG OE
799+foldMapping '\x10c9d' s = Yield '\x10cdd' (CC s '\x0000' '\x0000')
800+-- OLD HUNGARIAN CAPITAL LETTER RUDIMENTA OE
801+foldMapping '\x10c9e' s = Yield '\x10cde' (CC s '\x0000' '\x0000')
802+-- OLD HUNGARIAN CAPITAL LETTER OEE
803+foldMapping '\x10c9f' s = Yield '\x10cdf' (CC s '\x0000' '\x0000')
804+-- OLD HUNGARIAN CAPITAL LETTER EP
805+foldMapping '\x10ca0' s = Yield '\x10ce0' (CC s '\x0000' '\x0000')
806+-- OLD HUNGARIAN CAPITAL LETTER EMP
807+foldMapping '\x10ca1' s = Yield '\x10ce1' (CC s '\x0000' '\x0000')
808+-- OLD HUNGARIAN CAPITAL LETTER ER
809+foldMapping '\x10ca2' s = Yield '\x10ce2' (CC s '\x0000' '\x0000')
810+-- OLD HUNGARIAN CAPITAL LETTER SHORT ER
811+foldMapping '\x10ca3' s = Yield '\x10ce3' (CC s '\x0000' '\x0000')
812+-- OLD HUNGARIAN CAPITAL LETTER ES
813+foldMapping '\x10ca4' s = Yield '\x10ce4' (CC s '\x0000' '\x0000')
814+-- OLD HUNGARIAN CAPITAL LETTER ESZ
815+foldMapping '\x10ca5' s = Yield '\x10ce5' (CC s '\x0000' '\x0000')
816+-- OLD HUNGARIAN CAPITAL LETTER ET
817+foldMapping '\x10ca6' s = Yield '\x10ce6' (CC s '\x0000' '\x0000')
818+-- OLD HUNGARIAN CAPITAL LETTER ENT
819+foldMapping '\x10ca7' s = Yield '\x10ce7' (CC s '\x0000' '\x0000')
820+-- OLD HUNGARIAN CAPITAL LETTER ETY
821+foldMapping '\x10ca8' s = Yield '\x10ce8' (CC s '\x0000' '\x0000')
822+-- OLD HUNGARIAN CAPITAL LETTER ECH
823+foldMapping '\x10ca9' s = Yield '\x10ce9' (CC s '\x0000' '\x0000')
824+-- OLD HUNGARIAN CAPITAL LETTER U
825+foldMapping '\x10caa' s = Yield '\x10cea' (CC s '\x0000' '\x0000')
826+-- OLD HUNGARIAN CAPITAL LETTER UU
827+foldMapping '\x10cab' s = Yield '\x10ceb' (CC s '\x0000' '\x0000')
828+-- OLD HUNGARIAN CAPITAL LETTER NIKOLSBURG UE
829+foldMapping '\x10cac' s = Yield '\x10cec' (CC s '\x0000' '\x0000')
830+-- OLD HUNGARIAN CAPITAL LETTER RUDIMENTA UE
831+foldMapping '\x10cad' s = Yield '\x10ced' (CC s '\x0000' '\x0000')
832+-- OLD HUNGARIAN CAPITAL LETTER EV
833+foldMapping '\x10cae' s = Yield '\x10cee' (CC s '\x0000' '\x0000')
834+-- OLD HUNGARIAN CAPITAL LETTER EZ
835+foldMapping '\x10caf' s = Yield '\x10cef' (CC s '\x0000' '\x0000')
836+-- OLD HUNGARIAN CAPITAL LETTER EZS
837+foldMapping '\x10cb0' s = Yield '\x10cf0' (CC s '\x0000' '\x0000')
838+-- OLD HUNGARIAN CAPITAL LETTER ENT-SHAPED SIGN
839+foldMapping '\x10cb1' s = Yield '\x10cf1' (CC s '\x0000' '\x0000')
840+-- OLD HUNGARIAN CAPITAL LETTER US
841+foldMapping '\x10cb2' s = Yield '\x10cf2' (CC s '\x0000' '\x0000')
456foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
842foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
Data/Text/Fusion/Common.hs → Data/Text/Internal/Fusion/Common.hsrenamed+111−83
@@ -1,17 +1,20 @@
1{-# LANGUAGE BangPatterns, MagicHash, Rank2Types #-}
1{-# LANGUAGE BangPatterns, MagicHash, Rank2Types #-}
2-- |
2-- |
3−-- Module : Data.Text.Fusion.Common
3+-- Module : Data.Text.Internal.Fusion.Common
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, rtomharper@googlemail.com,
7+-- Maintainer : bos@serpentine.com
8−-- duncan@haskell.org
9-- Stability : experimental
8-- Stability : experimental
10-- Portability : GHC
9-- Portability : GHC
11--
10--
11+-- /Warning/: this is an internal module, and does not have a stable
12+-- API or name. Functions in this module may not check or enforce
13+-- preconditions expected by public modules. Use at your own risk!
14+--
12-- Common stream fusion functionality for text.
15-- Common stream fusion functionality for text.
13
16
14−module Data.Text.Fusion.Common
17+module Data.Text.Internal.Fusion.Common
15 (
18 (
16 -- * Creation and elimination
19 -- * Creation and elimination
17 singleton
20 singleton
@@ -42,6 +45,7 @@ module Data.Text.Fusion.Common
42 -- $case
45 -- $case
43 , toCaseFold
46 , toCaseFold
44 , toLower
47 , toLower
48+ , toTitle
45 , toUpper
49 , toUpper
46
50
47 -- ** Justification
51 -- ** Justification
@@ -67,9 +71,6 @@ module Data.Text.Fusion.Common
67 -- ** Scans
71 -- ** Scans
68 , scanl
72 , scanl
69
73
70− -- ** Accumulating maps
71− -- , mapAccumL
72−
73 -- ** Generation and unfolding
74 -- ** Generation and unfolding
74 , replicateCharI
75 , replicateCharI
75 , replicateI
76 , replicateI
@@ -106,10 +107,12 @@ import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
106import qualified Data.List as L
107import qualified Data.List as L
107import qualified Prelude as P
108import qualified Prelude as P
108import Data.Bits (shiftL)
109import Data.Bits (shiftL)
110+import Data.Char (isLetter)
109import Data.Int (Int64)
111import Data.Int (Int64)
110−import Data.Text.Fusion.Internal
112+import Data.Text.Internal.Fusion.Types
111−import Data.Text.Fusion.CaseMapping (foldMapping, lowerMapping, upperMapping)
113+import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,
114+ upperMapping)
112−import Data.Text.Fusion.Size
115+import Data.Text.Internal.Fusion.Size
113import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)
116import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)
114import GHC.Types (Char(..), Int(..))
117import GHC.Types (Char(..), Int(..))
115
118
@@ -117,7 +120,7 @@ singleton :: Char -> Stream Char
117singleton c = Stream next False 1
120singleton c = Stream next False 1
118 where next False = Yield c True
121 where next False = Yield c True
119 next True = Done
122 next True = Done
120−{-# INLINE singleton #-}
123+{-# INLINE [0] singleton #-}
121
124
122streamList :: [a] -> Stream a
125streamList :: [a] -> Stream a
123{-# INLINE [0] streamList #-}
126{-# INLINE [0] streamList #-}
@@ -181,6 +184,9 @@ cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
181 Yield x s' -> Yield x (C0 s')
184 Yield x s' -> Yield x (C0 s')
182{-# INLINE [0] cons #-}
185{-# INLINE [0] cons #-}
183
186
187+data Snoc a = N
188+ | J !a
189+
184-- | /O(n)/ Adds a character to the end of a stream.
190-- | /O(n)/ Adds a character to the end of a stream.
185snoc :: Stream Char -> Char -> Stream Char
191snoc :: Stream Char -> Char -> Stream Char
186snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
192snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
@@ -309,12 +315,13 @@ lengthI (Stream next s0 _len) = loop_length 0 s0
309--
315--
310-- This function gives the same answer as comparing against the result
316-- This function gives the same answer as comparing against the result
311-- of 'lengthI', but can short circuit if the count of characters is
317-- of 'lengthI', but can short circuit if the count of characters is
318+-- greater than the number or if the stream can't possibly be as long
312−-- greater than the number, and hence be more efficient.
319+-- as the number supplied, and hence be more efficient.
313compareLengthI :: Integral a => Stream Char -> a -> Ordering
320compareLengthI :: Integral a => Stream Char -> a -> Ordering
314compareLengthI (Stream next s0 len) n =
321compareLengthI (Stream next s0 len) n =
315− case exactly len of
322+ case compareSize len (fromIntegral n) of
323+ Just o -> o
316 Nothing -> loop_cmp 0 s0
324 Nothing -> loop_cmp 0 s0
317− Just i -> compare (fromIntegral i) n
318 where
325 where
319 loop_cmp !z s = case next s of
326 loop_cmp !z s = case next s of
320 Done -> compare z n
327 Done -> compare z n
@@ -432,17 +439,54 @@ toLower :: Stream Char -> Stream Char
432toLower = caseConvert lowerMapping
439toLower = caseConvert lowerMapping
433{-# INLINE [0] toLower #-}
440{-# INLINE [0] toLower #-}
434
441
442+-- | /O(n)/ Convert a string to title case, using simple case
443+-- conversion.
444+--
445+-- The first letter of the input is converted to title case, as is
446+-- every subsequent letter that immediately follows a non-letter.
447+-- Every letter that immediately follows another letter is converted
448+-- to lower case.
449+--
450+-- The result string may be longer than the input string. For example,
451+-- the Latin small ligature &#xfb02; (U+FB02) is converted to the
452+-- sequence Latin capital letter F (U+0046) followed by Latin small
453+-- letter l (U+006C).
454+--
455+-- /Note/: this function does not take language or culture specific
456+-- rules into account. For instance, in English, different style
457+-- guides disagree on whether the book name \"The Hill of the Red
458+-- Fox\" is correctly title cased&#x2014;but this function will
459+-- capitalize /every/ word.
460+toTitle :: Stream Char -> Stream Char
461+toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len
462+ where
463+ next (CC (letter :*: s) '\0' _) =
464+ case next0 s of
465+ Done -> Done
466+ Skip s' -> Skip (CC (letter :*: s') '\0' '\0')
467+ Yield c s'
468+ | letter' -> if letter
469+ then lowerMapping c (letter' :*: s')
470+ else titleMapping c (letter' :*: s')
471+ | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')
472+ where letter' = isLetter c
473+ next (CC s a b) = Yield a (CC s b '\0')
474+{-# INLINE [0] toTitle #-}
475+
476+data Justify i s = Just1 !i !s
477+ | Just2 !i !s
478+
435justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
479justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
436justifyLeftI k c (Stream next0 s0 len) =
480justifyLeftI k c (Stream next0 s0 len) =
437− Stream next (s0 :*: S1 :*: 0) (larger (fromIntegral k) len)
481+ Stream next (Just1 0 s0) (larger (fromIntegral k) len)
438 where
482 where
439− next (s :*: S1 :*: n) =
483+ next (Just1 n s) =
440 case next0 s of
484 case next0 s of
441− Done -> next (s :*: S2 :*: n)
485+ Done -> next (Just2 n s)
442− Skip s' -> Skip (s' :*: S1 :*: n)
486+ Skip s' -> Skip (Just1 n s')
443− Yield x s' -> Yield x (s' :*: S1 :*: n+1)
487+ Yield x s' -> Yield x (Just1 (n+1) s')
444− next (s :*: S2 :*: n)
488+ next (Just2 n s)
445− | n < k = Yield c (s :*: S2 :*: n+1)
489+ | n < k = Yield c (Just2 (n+1) s)
446 | otherwise = Done
490 | otherwise = Done
447 {-# INLINE next #-}
491 {-# INLINE next #-}
448{-# INLINE [0] justifyLeftI #-}
492{-# INLINE [0] justifyLeftI #-}
@@ -549,7 +593,7 @@ concatMap f = foldr (append . f) empty
549{-# INLINE [0] concatMap #-}
593{-# INLINE [0] concatMap #-}
550
594
551-- | /O(n)/ any @p @xs determines if any character in the stream
595-- | /O(n)/ any @p @xs determines if any character in the stream
552−-- @xs@ satisifes the predicate @p@.
596+-- @xs@ satisfies the predicate @p@.
553any :: (Char -> Bool) -> Stream Char -> Bool
597any :: (Char -> Bool) -> Stream Char -> Bool
554any p (Stream next0 s0 _len) = loop_any s0
598any p (Stream next0 s0 _len) = loop_any s0
555 where
599 where
@@ -561,7 +605,7 @@ any p (Stream next0 s0 _len) = loop_any s0
561{-# INLINE [0] any #-}
605{-# INLINE [0] any #-}
562
606
563-- | /O(n)/ all @p @xs determines if all characters in the 'Text'
607-- | /O(n)/ all @p @xs determines if all characters in the 'Text'
564−-- @xs@ satisify the predicate @p@.
608+-- @xs@ satisfy the predicate @p@.
565all :: (Char -> Bool) -> Stream Char -> Bool
609all :: (Char -> Bool) -> Stream Char -> Bool
566all p (Stream next0 s0 _len) = loop_all s0
610all p (Stream next0 s0 _len) = loop_all s0
567 where
611 where
@@ -610,50 +654,27 @@ minimum (Stream next0 s0 _len) = loop0_minimum s0
610-- * Building streams
654-- * Building streams
611
655
612scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
656scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
613−scanl f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low
657+scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
614 where
658 where
615 {-# INLINE next #-}
659 {-# INLINE next #-}
616− next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)
660+ next (Scan1 z s) = Yield z (Scan2 z s)
617− next (S2 :*: z :*: s) = case next0 s of
661+ next (Scan2 z s) = case next0 s of
618− Yield x s' -> let !x' = f z x
662+ Yield x s' -> let !x' = f z x
619− in Yield x' (S2 :*: x' :*: s')
663+ in Yield x' (Scan2 x' s')
620− Skip s' -> Skip (S2 :*: z :*: s')
664+ Skip s' -> Skip (Scan2 z s')
621− Done -> Done
665+ Done -> Done
622{-# INLINE [0] scanl #-}
666{-# INLINE [0] scanl #-}
623
667
624−-- -----------------------------------------------------------------------------
625−-- ** Accumulating maps
626−
627−{-
628−-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a
629−-- function to each element of a stream, passing an accumulating
630−-- parameter from left to right, and returns a final stream.
631−--
632−-- /Note/: Unlike the version over lists, this function does not
633−-- return a final value for the accumulator, because the nature of
634−-- streams precludes it.
635−mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b
636−mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :*: z0) len -- HINT depends on f
637− where
638− {-# INLINE next #-}
639− next (s :*: z) = case next0 s of
640− Yield x s' -> let (z',y) = f z x
641− in Yield y (s' :*: z')
642− Skip s' -> Skip (s' :*: z)
643− Done -> Done
644−{-# INLINE [0] mapAccumL #-}
645−-}
646−
647-- -----------------------------------------------------------------------------
668-- -----------------------------------------------------------------------------
648-- ** Generating and unfolding streams
669-- ** Generating and unfolding streams
649
670
650replicateCharI :: Integral a => a -> Char -> Stream Char
671replicateCharI :: Integral a => a -> Char -> Stream Char
651−replicateCharI n c
672+replicateCharI !n !c
652 | n < 0 = empty
673 | n < 0 = empty
653 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
674 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
654 where
675 where
655− next i | i >= n = Done
676+ next !i | i >= n = Done
656− | otherwise = Yield c (i + 1)
677+ | otherwise = Yield c (i + 1)
657{-# INLINE [0] replicateCharI #-}
678{-# INLINE [0] replicateCharI #-}
658
679
659data RI s = RI !s {-# UNPACK #-} !Int64
680data RI s = RI !s {-# UNPACK #-} !Int64
@@ -718,24 +739,27 @@ take n0 (Stream next0 s0 len) =
718 Yield x s' -> Yield x ((n-1) :*: s')
739 Yield x s' -> Yield x ((n-1) :*: s')
719{-# INLINE [0] take #-}
740{-# INLINE [0] take #-}
720
741
742+data Drop a s = NS !s
743+ | JS !a !s
744+
721-- | /O(n)/ drop n, applied to a stream, returns the suffix of the
745-- | /O(n)/ drop n, applied to a stream, returns the suffix of the
722-- stream after the first @n@ characters, or the empty stream if @n@
746-- stream after the first @n@ characters, or the empty stream if @n@
723-- is greater than the length of the stream.
747-- is greater than the length of the stream.
724drop :: Integral a => a -> Stream Char -> Stream Char
748drop :: Integral a => a -> Stream Char -> Stream Char
725drop n0 (Stream next0 s0 len) =
749drop n0 (Stream next0 s0 len) =
726− Stream next (J n0 :*: s0) (len - fromIntegral (max 0 n0))
750+ Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))
727 where
751 where
728 {-# INLINE next #-}
752 {-# INLINE next #-}
729− next (J n :*: s)
753+ next (JS n s)
730− | n <= 0 = Skip (N :*: s)
754+ | n <= 0 = Skip (NS s)
731 | otherwise = case next0 s of
755 | otherwise = case next0 s of
732 Done -> Done
756 Done -> Done
733− Skip s' -> Skip (J n :*: s')
757+ Skip s' -> Skip (JS n s')
734− Yield _ s' -> Skip (J (n-1) :*: s')
758+ Yield _ s' -> Skip (JS (n-1) s')
735− next (N :*: s) = case next0 s of
759+ next (NS s) = case next0 s of
736 Done -> Done
760 Done -> Done
737− Skip s' -> Skip (N :*: s')
761+ Skip s' -> Skip (NS s')
738− Yield x s' -> Yield x (N :*: s')
762+ Yield x s' -> Yield x (NS s')
739{-# INLINE [0] drop #-}
763{-# INLINE [0] drop #-}
740
764
741-- | takeWhile, applied to a predicate @p@ and a stream, returns the
765-- | takeWhile, applied to a predicate @p@ and a stream, returns the
@@ -753,18 +777,18 @@ takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
753
777
754-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
778-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
755dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
779dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
756−dropWhile p (Stream next0 s0 len) = Stream next (S1 :*: s0) len -- HINT maybe too high
780+dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
757 where
781 where
758 {-# INLINE next #-}
782 {-# INLINE next #-}
759− next (S1 :*: s) = case next0 s of
783+ next (L s) = case next0 s of
760 Done -> Done
784 Done -> Done
761− Skip s' -> Skip (S1 :*: s')
785+ Skip s' -> Skip (L s')
762− Yield x s' | p x -> Skip (S1 :*: s')
786+ Yield x s' | p x -> Skip (L s')
763− | otherwise -> Yield x (S2 :*: s')
787+ | otherwise -> Yield x (R s')
764− next (S2 :*: s) = case next0 s of
788+ next (R s) = case next0 s of
765 Done -> Done
789 Done -> Done
766− Skip s' -> Skip (S2 :*: s')
790+ Skip s' -> Skip (R s')
767− Yield x s' -> Yield x (S2 :*: s')
791+ Yield x s' -> Yield x (R s')
768{-# INLINE [0] dropWhile #-}
792{-# INLINE [0] dropWhile #-}
769
793
770-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
794-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
@@ -871,21 +895,25 @@ findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0
871-------------------------------------------------------------------------------
895-------------------------------------------------------------------------------
872-- * Zipping
896-- * Zipping
873
897
898+-- | Strict triple.
899+data Zip a b m = Z1 !a !b
900+ | Z2 !a !b !m
901+
874-- | zipWith generalises 'zip' by zipping with the function given as
902-- | zipWith generalises 'zip' by zipping with the function given as
875-- the first argument, instead of a tupling function.
903-- the first argument, instead of a tupling function.
876zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
904zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
877zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
905zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
878− Stream next (sa0 :*: sb0 :*: N) (smaller len1 len2)
906+ Stream next (Z1 sa0 sb0) (smaller len1 len2)
879 where
907 where
880− next (sa :*: sb :*: N) = case next0 sa of
908+ next (Z1 sa sb) = case next0 sa of
881− Done -> Done
909+ Done -> Done
882− Skip sa' -> Skip (sa' :*: sb :*: N)
910+ Skip sa' -> Skip (Z1 sa' sb)
883− Yield a sa' -> Skip (sa' :*: sb :*: J a)
911+ Yield a sa' -> Skip (Z2 sa' sb a)
884−
912+
885− next (sa' :*: sb :*: J a) = case next1 sb of
913+ next (Z2 sa' sb a) = case next1 sb of
886− Done -> Done
914+ Done -> Done
887− Skip sb' -> Skip (sa' :*: sb' :*: J a)
915+ Skip sb' -> Skip (Z2 sa' sb' a)
888− Yield b sb' -> Yield (f a b) (sa' :*: sb' :*: N)
916+ Yield b sb' -> Yield (f a b) (Z1 sa' sb')
889{-# INLINE [0] zipWith #-}
917{-# INLINE [0] zipWith #-}
890
918
891-- | /O(n)/ The 'countCharI' function returns the number of times the
919-- | /O(n)/ The 'countCharI' function returns the number of times the
@@ -901,7 +929,7 @@ countCharI a (Stream next s0 _len) = loop 0 s0
901{-# INLINE [0] countCharI #-}
929{-# INLINE [0] countCharI #-}
902
930
903streamError :: String -> String -> a
931streamError :: String -> String -> a
904−streamError func msg = P.error $ "Data.Text.Fusion.Common." ++ func ++ ": " ++ msg
932+streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg
905
933
906emptyError :: String -> a
934emptyError :: String -> a
907emptyError func = internalError func "Empty input"
935emptyError func = internalError func "Empty input"
Data/Text/Internal/Fusion/Size.hsnew file+157
@@ -0,0 +1,157 @@
1+{-# LANGUAGE CPP #-}
2+{-# OPTIONS_GHC -fno-warn-missing-methods #-}
3+-- |
4+-- Module : Data.Text.Internal.Fusion.Internal
5+-- Copyright : (c) Roman Leshchinskiy 2008,
6+-- (c) Bryan O'Sullivan 2009
7+--
8+-- License : BSD-style
9+-- Maintainer : bos@serpentine.com
10+-- Stability : experimental
11+-- Portability : portable
12+--
13+-- /Warning/: this is an internal module, and does not have a stable
14+-- API or name. Functions in this module may not check or enforce
15+-- preconditions expected by public modules. Use at your own risk!
16+--
17+-- Size hints.
18+
19+module Data.Text.Internal.Fusion.Size
20+ (
21+ Size
22+ , exactly
23+ , exactSize
24+ , maxSize
25+ , betweenSize
26+ , unknownSize
27+ , smaller
28+ , larger
29+ , upperBound
30+ , lowerBound
31+ , compareSize
32+ , isEmpty
33+ ) where
34+
35+import Data.Text.Internal (mul)
36+#if defined(ASSERTS)
37+import Control.Exception (assert)
38+#endif
39+
40+data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.
41+ | Unknown -- ^ Unknown size.
42+ deriving (Eq, Show)
43+
44+exactly :: Size -> Maybe Int
45+exactly (Between na nb) | na == nb = Just na
46+exactly _ = Nothing
47+{-# INLINE exactly #-}
48+
49+exactSize :: Int -> Size
50+exactSize n =
51+#if defined(ASSERTS)
52+ assert (n >= 0)
53+#endif
54+ Between n n
55+{-# INLINE exactSize #-}
56+
57+maxSize :: Int -> Size
58+maxSize n =
59+#if defined(ASSERTS)
60+ assert (n >= 0)
61+#endif
62+ Between 0 n
63+{-# INLINE maxSize #-}
64+
65+betweenSize :: Int -> Int -> Size
66+betweenSize m n =
67+#if defined(ASSERTS)
68+ assert (m >= 0)
69+ assert (n >= m)
70+#endif
71+ Between m n
72+{-# INLINE betweenSize #-}
73+
74+unknownSize :: Size
75+unknownSize = Unknown
76+{-# INLINE unknownSize #-}
77+
78+instance Num Size where
79+ (+) = addSize
80+ (-) = subtractSize
81+ (*) = mulSize
82+
83+ fromInteger = f where f = exactSize . fromInteger
84+ {-# INLINE f #-}
85+
86+add :: Int -> Int -> Int
87+add m n | mn >= 0 = mn
88+ | otherwise = overflowError
89+ where mn = m + n
90+{-# INLINE add #-}
91+
92+addSize :: Size -> Size -> Size
93+addSize (Between ma mb) (Between na nb) = Between (add ma na) (add mb nb)
94+addSize _ _ = Unknown
95+{-# INLINE addSize #-}
96+
97+subtractSize :: Size -> Size -> Size
98+subtractSize (Between ma mb) (Between na nb) = Between (max (ma-nb) 0) (max (mb-na) 0)
99+subtractSize a@(Between 0 _) Unknown = a
100+subtractSize (Between _ mb) Unknown = Between 0 mb
101+subtractSize _ _ = Unknown
102+{-# INLINE subtractSize #-}
103+
104+mulSize :: Size -> Size -> Size
105+mulSize (Between ma mb) (Between na nb) = Between (mul ma na) (mul mb nb)
106+mulSize _ _ = Unknown
107+{-# INLINE mulSize #-}
108+
109+-- | Minimum of two size hints.
110+smaller :: Size -> Size -> Size
111+smaller a@(Between ma mb) b@(Between na nb)
112+ | mb <= na = a
113+ | nb <= ma = b
114+ | otherwise = Between (ma `min` na) (mb `min` nb)
115+smaller a@(Between 0 _) Unknown = a
116+smaller (Between _ mb) Unknown = Between 0 mb
117+smaller Unknown b@(Between 0 _) = b
118+smaller Unknown (Between _ nb) = Between 0 nb
119+smaller Unknown Unknown = Unknown
120+{-# INLINE smaller #-}
121+
122+-- | Maximum of two size hints.
123+larger :: Size -> Size -> Size
124+larger a@(Between ma mb) b@(Between na nb)
125+ | ma >= nb = a
126+ | na >= mb = b
127+ | otherwise = Between (ma `max` na) (mb `max` nb)
128+larger _ _ = Unknown
129+{-# INLINE larger #-}
130+
131+-- | Compute the maximum size from a size hint, if possible.
132+upperBound :: Int -> Size -> Int
133+upperBound _ (Between _ n) = n
134+upperBound k _ = k
135+{-# INLINE upperBound #-}
136+
137+-- | Compute the maximum size from a size hint, if possible.
138+lowerBound :: Int -> Size -> Int
139+lowerBound _ (Between n _) = n
140+lowerBound k _ = k
141+{-# INLINE lowerBound #-}
142+
143+compareSize :: Size -> Int -> Maybe Ordering
144+compareSize (Between ma mb) n
145+ | mb < n = Just LT
146+ | ma > n = Just GT
147+ | ma == n && mb == n = Just EQ
148+compareSize _ _ = Nothing
149+
150+
151+isEmpty :: Size -> Bool
152+isEmpty (Between _ n) = n <= 0
153+isEmpty _ = False
154+{-# INLINE isEmpty #-}
155+
156+overflowError :: Int
157+overflowError = error "Data.Text.Internal.Fusion.Size: size overflow"
Data/Text/Fusion/Internal.hs → Data/Text/Internal/Fusion/Types.hsrenamed+16−18
@@ -1,58 +1,56 @@
1{-# LANGUAGE BangPatterns, ExistentialQuantification #-}
1{-# LANGUAGE BangPatterns, ExistentialQuantification #-}
2-- |
2-- |
3−-- Module : Data.Text.Fusion.Internal
3+-- Module : Data.Text.Internal.Fusion.Types
4-- Copyright : (c) Tom Harper 2008-2009,
4-- Copyright : (c) Tom Harper 2008-2009,
5-- (c) Bryan O'Sullivan 2009,
5-- (c) Bryan O'Sullivan 2009,
6-- (c) Duncan Coutts 2009,
6-- (c) Duncan Coutts 2009,
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, rtomharper@googlemail.com,
10+-- Maintainer : bos@serpentine.com
11−-- duncan@haskell.org
12-- Stability : experimental
11-- Stability : experimental
13-- Portability : GHC
12-- Portability : GHC
14--
13--
14+-- /Warning/: this is an internal module, and does not have a stable
15+-- API or name. Functions in this module may not check or enforce
16+-- preconditions expected by public modules. Use at your own risk!
17+--
15-- Core stream fusion functionality for text.
18-- Core stream fusion functionality for text.
16
19
17−module Data.Text.Fusion.Internal
20+module Data.Text.Internal.Fusion.Types
18 (
21 (
19 CC(..)
22 CC(..)
20− , M(..)
21− , M8
22 , PairS(..)
23 , PairS(..)
24+ , Scan(..)
23 , RS(..)
25 , RS(..)
24 , Step(..)
26 , Step(..)
25 , Stream(..)
27 , Stream(..)
26− , Switch(..)
27 , empty
28 , empty
28 ) where
29 ) where
29
30
30−import Data.Text.Fusion.Size
31+import Data.Text.Internal.Fusion.Size
31import Data.Word (Word8)
32import Data.Word (Word8)
32
33
33-- | Specialised tuple for case conversion.
34-- | Specialised tuple for case conversion.
34data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char
35data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char
35
36
36−-- | Specialised, strict Maybe-like type.
37−data M a = N
38− | J !a
39−
40−type M8 = M Word8
41−
42−-- Restreaming state.
37+-- | Restreaming state.
43data RS s
38data RS s
44 = RS0 !s
39 = RS0 !s
45 | RS1 !s {-# UNPACK #-} !Word8
40 | RS1 !s {-# UNPACK #-} !Word8
46 | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
41 | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
47 | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
42 | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
48
43
49−infixl 2 :*:
44+-- | Strict pair.
50data PairS a b = !a :*: !b
45data PairS a b = !a :*: !b
51 -- deriving (Eq, Ord, Show)
46 -- deriving (Eq, Ord, Show)
47+infixl 2 :*:
52
48
53−-- | Allow a function over a stream to switch between two states.
49+-- | An intermediate result in a scan.
54−data Switch = S1 | S2
50+data Scan s = Scan1 {-# UNPACK #-} !Char !s
51+ | Scan2 {-# UNPACK #-} !Char !s
55
52
53+-- | Intermediate result in a processing pipeline.
56data Step s a = Done
54data Step s a = Done
57 | Skip !s
55 | Skip !s
58 | Yield !a !s
56 | Yield !a !s
Data/Text/IO/Internal.hs → Data/Text/Internal/IO.hsrenamed+9−9
@@ -1,6 +1,6 @@
1{-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}
1{-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}
2-- |
2-- |
3−-- Module : Data.Text.IO.Internal
3+-- Module : Data.Text.Internal.IO
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan,
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan,
5-- (c) 2009 Simon Marlow
5-- (c) 2009 Simon Marlow
6-- License : BSD-style
6-- License : BSD-style
@@ -8,23 +8,24 @@
8-- Stability : experimental
8-- Stability : experimental
9-- Portability : GHC
9-- Portability : GHC
10--
10--
11+-- /Warning/: this is an internal module, and does not have a stable
12+-- API or name. Functions in this module may not check or enforce
13+-- preconditions expected by public modules. Use at your own risk!
14+--
11-- Low-level support for text I\/O.
15-- Low-level support for text I\/O.
12
16
13−module Data.Text.IO.Internal
17+module Data.Text.Internal.IO
14 (
18 (
15−#if __GLASGOW_HASKELL__ >= 612
16 hGetLineWith
19 hGetLineWith
17 , readChunk
20 , readChunk
18−#endif
19 ) where
21 ) where
20
22
21−#if __GLASGOW_HASKELL__ >= 612
22import qualified Control.Exception as E
23import qualified Control.Exception as E
23import Data.IORef (readIORef, writeIORef)
24import Data.IORef (readIORef, writeIORef)
24import Data.Text (Text)
25import Data.Text (Text)
25−import Data.Text.Fusion (unstream)
26+import Data.Text.Internal.Fusion (unstream)
26−import Data.Text.Fusion.Internal (Step(..), Stream(..))
27+import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))
27−import Data.Text.Fusion.Size (exactSize, maxSize)
28+import Data.Text.Internal.Fusion.Size (exactSize, maxSize)
28import Data.Text.Unsafe (inlinePerformIO)
29import Data.Text.Unsafe (inlinePerformIO)
29import Foreign.Storable (peekElemOff)
30import Foreign.Storable (peekElemOff)
30import GHC.IO.Buffer (Buffer(..), CharBuffer, RawCharBuffer, bufferAdjustL,
31import GHC.IO.Buffer (Buffer(..), CharBuffer, RawCharBuffer, bufferAdjustL,
@@ -163,4 +164,3 @@ readChunk hh@Handle__{..} buf = do
163
164
164sizeError :: String -> a
165sizeError :: String -> a
165sizeError loc = error $ "Data.Text.IO." ++ loc ++ ": bad internal buffer size"
166sizeError loc = error $ "Data.Text.IO." ++ loc ++ ": bad internal buffer size"
166−#endif
Data/Text/Internal/Lazy.hsnew file+119
@@ -0,0 +1,119 @@
1+{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
2+{-# OPTIONS_HADDOCK not-home #-}
3+
4+-- |
5+-- Module : Data.Text.Internal.Lazy
6+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
7+--
8+-- License : BSD-style
9+-- Maintainer : bos@serpentine.com
10+-- Stability : experimental
11+-- Portability : GHC
12+--
13+-- /Warning/: this is an internal module, and does not have a stable
14+-- API or name. Functions in this module may not check or enforce
15+-- preconditions expected by public modules. Use at your own risk!
16+--
17+-- A module containing private 'Text' internals. This exposes the
18+-- 'Text' representation and low level construction functions.
19+-- Modules which extend the 'Text' system may need to use this module.
20+
21+module Data.Text.Internal.Lazy
22+ (
23+ Text(..)
24+ , chunk
25+ , empty
26+ , foldrChunks
27+ , foldlChunks
28+ -- * Data type invariant and abstraction functions
29+
30+ -- $invariant
31+ , strictInvariant
32+ , lazyInvariant
33+ , showStructure
34+
35+ -- * Chunk allocation sizes
36+ , defaultChunkSize
37+ , smallChunkSize
38+ , chunkOverhead
39+ ) where
40+
41+import Data.Text ()
42+import Data.Text.Internal.Unsafe.Shift (shiftL)
43+import Data.Typeable (Typeable)
44+import Foreign.Storable (sizeOf)
45+import qualified Data.Text.Internal as T
46+
47+data Text = Empty
48+ | Chunk {-# UNPACK #-} !T.Text Text
49+ deriving (Typeable)
50+
51+-- $invariant
52+--
53+-- The data type invariant for lazy 'Text': Every 'Text' is either 'Empty' or
54+-- consists of non-null 'T.Text's. All functions must preserve this,
55+-- and the QC properties must check this.
56+
57+-- | Check the invariant strictly.
58+strictInvariant :: Text -> Bool
59+strictInvariant Empty = True
60+strictInvariant x@(Chunk (T.Text _ _ len) cs)
61+ | len > 0 = strictInvariant cs
62+ | otherwise = error $ "Data.Text.Lazy: invariant violation: "
63+ ++ showStructure x
64+
65+-- | Check the invariant lazily.
66+lazyInvariant :: Text -> Text
67+lazyInvariant Empty = Empty
68+lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)
69+ | len > 0 = Chunk c (lazyInvariant cs)
70+ | otherwise = error $ "Data.Text.Lazy: invariant violation: "
71+ ++ showStructure x
72+
73+-- | Display the internal structure of a lazy 'Text'.
74+showStructure :: Text -> String
75+showStructure Empty = "Empty"
76+showStructure (Chunk t Empty) = "Chunk " ++ show t ++ " Empty"
77+showStructure (Chunk t ts) =
78+ "Chunk " ++ show t ++ " (" ++ showStructure ts ++ ")"
79+
80+-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.
81+chunk :: T.Text -> Text -> Text
82+{-# INLINE chunk #-}
83+chunk t@(T.Text _ _ len) ts | len == 0 = ts
84+ | otherwise = Chunk t ts
85+
86+-- | Smart constructor for 'Empty'.
87+empty :: Text
88+{-# INLINE [0] empty #-}
89+empty = Empty
90+
91+-- | Consume the chunks of a lazy 'Text' with a natural right fold.
92+foldrChunks :: (T.Text -> a -> a) -> a -> Text -> a
93+foldrChunks f z = go
94+ where go Empty = z
95+ go (Chunk c cs) = f c (go cs)
96+{-# INLINE foldrChunks #-}
97+
98+-- | Consume the chunks of a lazy 'Text' with a strict, tail-recursive,
99+-- accumulating left fold.
100+foldlChunks :: (a -> T.Text -> a) -> a -> Text -> a
101+foldlChunks f z = go z
102+ where go !a Empty = a
103+ go !a (Chunk c cs) = go (f a c) cs
104+{-# INLINE foldlChunks #-}
105+
106+-- | Currently set to 16 KiB, less the memory management overhead.
107+defaultChunkSize :: Int
108+defaultChunkSize = 16384 - chunkOverhead
109+{-# INLINE defaultChunkSize #-}
110+
111+-- | Currently set to 128 bytes, less the memory management overhead.
112+smallChunkSize :: Int
113+smallChunkSize = 128 - chunkOverhead
114+{-# INLINE smallChunkSize #-}
115+
116+-- | The memory management overhead. Currently this is tuned for GHC only.
117+chunkOverhead :: Int
118+chunkOverhead = sizeOf (undefined :: Int) `shiftL` 1
119+{-# INLINE chunkOverhead #-}
Data/Text/Lazy/Encoding/Fusion.hs → Data/Text/Internal/Lazy/Encoding/Fusion.hsrenamed+17−14
@@ -5,15 +5,18 @@
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, rtomharper@googlemail.com,
8+-- Maintainer : bos@serpentine.com
9−-- duncan@haskell.org
10-- Stability : experimental
9-- Stability : experimental
11-- Portability : portable
10-- Portability : portable
12--
11--
12+-- /Warning/: this is an internal module, and does not have a stable
13+-- API or name. Functions in this module may not check or enforce
14+-- preconditions expected by public modules. Use at your own risk!
15+--
13-- Fusible 'Stream'-oriented functions for converting between lazy
16-- Fusible 'Stream'-oriented functions for converting between lazy
14-- 'Text' and several common encodings.
17-- 'Text' and several common encodings.
15
18
16−module Data.Text.Lazy.Encoding.Fusion
19+module Data.Text.Internal.Lazy.Encoding.Fusion
17 (
20 (
18 -- * Streaming
21 -- * Streaming
19 -- streamASCII
22 -- streamASCII
@@ -26,23 +29,23 @@ module Data.Text.Lazy.Encoding.Fusion
26 -- * Unstreaming
29 -- * Unstreaming
27 , unstream
30 , unstream
28
31
29− , module Data.Text.Encoding.Fusion.Common
32+ , module Data.Text.Internal.Encoding.Fusion.Common
30 ) where
33 ) where
31
34
32import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)
35import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)
33import qualified Data.ByteString as B
36import qualified Data.ByteString as B
34import qualified Data.ByteString.Unsafe as B
37import qualified Data.ByteString.Unsafe as B
35−import Data.Text.Encoding.Fusion.Common
38+import Data.Text.Internal.Encoding.Fusion.Common
36import Data.Text.Encoding.Error
39import Data.Text.Encoding.Error
37−import Data.Text.Fusion (Step(..), Stream(..))
40+import Data.Text.Internal.Fusion (Step(..), Stream(..))
38−import Data.Text.Fusion.Size
41+import Data.Text.Internal.Fusion.Size
39−import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)
42+import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)
40−import Data.Text.UnsafeShift (shiftL)
43+import Data.Text.Internal.Unsafe.Shift (shiftL)
41import Data.Word (Word8, Word16, Word32)
44import Data.Word (Word8, Word16, Word32)
42−import qualified Data.Text.Encoding.Utf8 as U8
45+import qualified Data.Text.Internal.Encoding.Utf8 as U8
43−import qualified Data.Text.Encoding.Utf16 as U16
46+import qualified Data.Text.Internal.Encoding.Utf16 as U16
44−import qualified Data.Text.Encoding.Utf32 as U32
47+import qualified Data.Text.Internal.Encoding.Utf32 as U32
45−import System.IO.Unsafe (unsafePerformIO)
48+import Data.Text.Unsafe (unsafeDupablePerformIO)
46import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
49import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
47import Foreign.Storable (pokeByteOff)
50import Foreign.Storable (pokeByteOff)
48import Data.ByteString.Internal (mallocByteString, memcpy)
51import Data.ByteString.Internal (mallocByteString, memcpy)
@@ -272,7 +275,7 @@ streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
272-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
275-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
273unstreamChunks :: Int -> Stream Word8 -> ByteString
276unstreamChunks :: Int -> Stream Word8 -> ByteString
274unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)
277unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)
275− where chunk s1 len1 = unsafePerformIO $ do
278+ where chunk s1 len1 = unsafeDupablePerformIO $ do
276 let len = max 4 (min len1 chunkSize)
279 let len = max 4 (min len1 chunkSize)
277 mallocByteString len >>= loop len 0 s1
280 mallocByteString len >>= loop len 0 s1
278 where
281 where
Data/Text/Lazy/Fusion.hs → Data/Text/Internal/Lazy/Fusion.hsrenamed+12−9
@@ -4,14 +4,17 @@
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, rtomharper@googlemail.com,
7+-- Maintainer : bos@serpentine.com
8−-- duncan@haskell.org
9-- Stability : experimental
8-- Stability : experimental
10-- Portability : GHC
9-- Portability : GHC
11--
10--
11+-- /Warning/: this is an internal module, and does not have a stable
12+-- API or name. Functions in this module may not check or enforce
13+-- preconditions expected by public modules. Use at your own risk!
14+--
12-- Core stream fusion functionality for text.
15-- Core stream fusion functionality for text.
13
16
14−module Data.Text.Lazy.Fusion
17+module Data.Text.Internal.Lazy.Fusion
15 (
18 (
16 stream
19 stream
17 , unstream
20 , unstream
@@ -23,15 +26,15 @@ module Data.Text.Lazy.Fusion
23 ) where
26 ) where
24
27
25import Prelude hiding (length)
28import Prelude hiding (length)
26−import qualified Data.Text.Fusion.Common as S
29+import qualified Data.Text.Internal.Fusion.Common as S
27import Control.Monad.ST (runST)
30import Control.Monad.ST (runST)
28−import Data.Text.Fusion.Internal
31+import Data.Text.Internal.Fusion.Types
29−import Data.Text.Fusion.Size (isEmpty, unknownSize)
32+import Data.Text.Internal.Fusion.Size (isEmpty, unknownSize)
30−import Data.Text.Lazy.Internal
33+import Data.Text.Internal.Lazy
31import qualified Data.Text.Internal as I
34import qualified Data.Text.Internal as I
32import qualified Data.Text.Array as A
35import qualified Data.Text.Array as A
33−import Data.Text.UnsafeChar (unsafeWrite)
36+import Data.Text.Internal.Unsafe.Char (unsafeWrite)
34−import Data.Text.UnsafeShift (shiftL)
37+import Data.Text.Internal.Unsafe.Shift (shiftL)
35import Data.Text.Unsafe (Iter(..), iter)
38import Data.Text.Unsafe (Iter(..), iter)
36import Data.Int (Int64)
39import Data.Int (Int64)
37
40
Data/Text/Lazy/Search.hs → Data/Text/Internal/Lazy/Search.hsrenamed+9−6
@@ -5,16 +5,19 @@
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, rtomharper@googlemail.com,
8+-- Maintainer : bos@serpentine.com
9−-- duncan@haskell.org
10-- Stability : experimental
9-- Stability : experimental
11-- Portability : GHC
10-- Portability : GHC
12--
11--
12+-- /Warning/: this is an internal module, and does not have a stable
13+-- API or name. Functions in this module may not check or enforce
14+-- preconditions expected by public modules. Use at your own risk!
15+--
13-- Fast substring search for lazy 'Text', based on work by Boyer,
16-- Fast substring search for lazy 'Text', based on work by Boyer,
14-- Moore, Horspool, Sunday, and Lundh. Adapted from the strict
17-- Moore, Horspool, Sunday, and Lundh. Adapted from the strict
15-- implementation.
18-- implementation.
16
19
17−module Data.Text.Lazy.Search
20+module Data.Text.Internal.Lazy.Search
18 (
21 (
19 indices
22 indices
20 ) where
23 ) where
@@ -23,10 +26,10 @@ import qualified Data.Text.Array as A
23import Data.Int (Int64)
26import Data.Int (Int64)
24import Data.Word (Word16, Word64)
27import Data.Word (Word16, Word64)
25import qualified Data.Text.Internal as T
28import qualified Data.Text.Internal as T
26−import Data.Text.Fusion.Internal (PairS(..))
29+import Data.Text.Internal.Fusion.Types (PairS(..))
27−import Data.Text.Lazy.Internal (Text(..), foldlChunks)
30+import Data.Text.Internal.Lazy (Text(..), foldlChunks)
28import Data.Bits ((.|.), (.&.))
31import Data.Bits ((.|.), (.&.))
29−import Data.Text.UnsafeShift (shiftL)
32+import Data.Text.Internal.Unsafe.Shift (shiftL)
30
33
31-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
34-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
32-- @needle@ within @haystack@.
35-- @needle@ within @haystack@.
Data/Text/Private.hs → Data/Text/Internal/Private.hsrenamed+6−6
@@ -1,7 +1,7 @@
1{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples #-}
1{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Private
4+-- Module : Data.Text.Internal.Private
5-- Copyright : (c) 2011 Bryan O'Sullivan
5-- Copyright : (c) 2011 Bryan O'Sullivan
6--
6--
7-- License : BSD-style
7-- License : BSD-style
@@ -9,21 +9,21 @@
9-- Stability : experimental
9-- Stability : experimental
10-- Portability : GHC
10-- Portability : GHC
11
11
12−module Data.Text.Private
12+module Data.Text.Internal.Private
13 (
13 (
14 runText
14 runText
15 , span_
15 , span_
16 ) where
16 ) where
17
17
18import Control.Monad.ST (ST, runST)
18import Control.Monad.ST (ST, runST)
19−import Data.Text.Internal (Text(..), textP)
19+import Data.Text.Internal (Text(..), text)
20import Data.Text.Unsafe (Iter(..), iter)
20import Data.Text.Unsafe (Iter(..), iter)
21import qualified Data.Text.Array as A
21import qualified Data.Text.Array as A
22
22
23span_ :: (Char -> Bool) -> Text -> (# Text, Text #)
23span_ :: (Char -> Bool) -> Text -> (# Text, Text #)
24span_ p t@(Text arr off len) = (# hd,tl #)
24span_ p t@(Text arr off len) = (# hd,tl #)
25− where hd = textP arr off k
25+ where hd = text arr off k
26− tl = textP arr (off+k) (len-k)
26+ tl = text arr (off+k) (len-k)
27 !k = loop 0
27 !k = loop 0
28 loop !i | i < len && p c = loop (i+d)
28 loop !i | i < len && p c = loop (i+d)
29 | otherwise = i
29 | otherwise = i
@@ -33,5 +33,5 @@ span_ p t@(Text arr off len) = (# hd,tl #)
33runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text
33runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text
34runText act = runST (act $ \ !marr !len -> do
34runText act = runST (act $ \ !marr !len -> do
35 arr <- A.unsafeFreeze marr
35 arr <- A.unsafeFreeze marr
36− return $! textP arr 0 len)
36+ return $! text arr 0 len)
37{-# INLINE runText #-}
37{-# INLINE runText #-}
Data/Text/Internal/Read.hsnew file+62
@@ -0,0 +1,62 @@
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/Search.hs → Data/Text/Internal/Search.hsrenamed+6−6
@@ -1,12 +1,11 @@
1{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
1{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Search
4+-- Module : Data.Text.Internal.Search
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, rtomharper@googlemail.com,
8+-- Maintainer : bos@serpentine.com
9−-- duncan@haskell.org
10-- Stability : experimental
9-- Stability : experimental
11-- Portability : GHC
10-- Portability : GHC
12--
11--
@@ -27,7 +26,7 @@
27-- * F. Lundh: The Fast Search Algorithm.
26-- * F. Lundh: The Fast Search Algorithm.
28-- <http://effbot.org/zone/stringlib.htm> (2006)
27-- <http://effbot.org/zone/stringlib.htm> (2006)
29
28
30−module Data.Text.Search
29+module Data.Text.Internal.Search
31 (
30 (
32 indices
31 indices
33 ) where
32 ) where
@@ -36,13 +35,14 @@ import qualified Data.Text.Array as A
36import Data.Word (Word64)
35import Data.Word (Word64)
37import Data.Text.Internal (Text(..))
36import Data.Text.Internal (Text(..))
38import Data.Bits ((.|.), (.&.))
37import Data.Bits ((.|.), (.&.))
39−import Data.Text.UnsafeShift (shiftL)
38+import Data.Text.Internal.Unsafe.Shift (shiftL)
40
39
41data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
40data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
42
41
43-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
42-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
44-- @needle@ within @haystack@. The offsets returned represent
43-- @needle@ within @haystack@. The offsets returned represent
45−-- locations in the low-level array.
44+-- uncorrected indices in the low-level \"needle\" array, to which its
45+-- offset must be added.
46--
46--
47-- In (unlikely) bad cases, this algorithm's complexity degrades
47-- In (unlikely) bad cases, this algorithm's complexity degrades
48-- towards /O(n*m)/.
48-- towards /O(n*m)/.
Data/Text/Unsafe/Base.hs → Data/Text/Internal/Unsafe.hsrenamed+11−10
@@ -1,16 +1,21 @@
1{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
1{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
2+{-# OPTIONS_HADDOCK not-home #-}
3+
2-- |
4-- |
3−-- Module : Data.Text.Unsafe.Base
5+-- Module : Data.Text.Internal.Unsafe
4-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
6-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
5-- License : BSD-style
7-- License : BSD-style
6−-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
8+-- Maintainer : bos@serpentine.com
7−-- duncan@haskell.org
8-- Stability : experimental
9-- Stability : experimental
9-- Portability : portable
10-- Portability : portable
10--
11--
12+-- /Warning/: this is an internal module, and does not have a stable
13+-- API or name. Functions in this module may not check or enforce
14+-- preconditions expected by public modules. Use at your own risk!
15+--
11−-- A module containing unsafe operations, for very very careful use in
16+-- A module containing /unsafe/ operations, for /very very careful/ use
12−-- heavily tested code.
17+-- in /heavily tested/ code.
13−module Data.Text.Unsafe.Base
18+module Data.Text.Internal.Unsafe
14 (
19 (
15 inlineInterleaveST
20 inlineInterleaveST
16 , inlinePerformIO
21 , inlinePerformIO
@@ -18,11 +23,7 @@ module Data.Text.Unsafe.Base
18
23
19import GHC.ST (ST(..))
24import GHC.ST (ST(..))
20#if defined(__GLASGOW_HASKELL__)
25#if defined(__GLASGOW_HASKELL__)
21−# if __GLASGOW_HASKELL__ >= 611
22import GHC.IO (IO(IO))
26import GHC.IO (IO(IO))
23−# else
24−import GHC.IOBase (IO(IO))
25−# endif
26import GHC.Base (realWorld#)
27import GHC.Base (realWorld#)
27#endif
28#endif
28
29
Data/Text/UnsafeChar.hs → Data/Text/Internal/Unsafe/Char.hsrenamed+8−5
@@ -1,19 +1,22 @@
1{-# LANGUAGE CPP, MagicHash #-}
1{-# LANGUAGE CPP, MagicHash #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.UnsafeChar
4+-- Module : Data.Text.Internal.Unsafe.Char
5-- Copyright : (c) 2008, 2009 Tom Harper,
5-- Copyright : (c) 2008, 2009 Tom Harper,
6-- (c) 2009, 2010 Bryan O'Sullivan,
6-- (c) 2009, 2010 Bryan O'Sullivan,
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, rtomharper@googlemail.com,
10+-- Maintainer : bos@serpentine.com
11−-- duncan@haskell.org
12-- Stability : experimental
11-- Stability : experimental
13-- Portability : GHC
12-- Portability : GHC
14--
13--
14+-- /Warning/: this is an internal module, and does not have a stable
15+-- API or name. Functions in this module may not check or enforce
16+-- preconditions expected by public modules. Use at your own risk!
17+--
15-- Fast character manipulation functions.
18-- Fast character manipulation functions.
16−module Data.Text.UnsafeChar
19+module Data.Text.Internal.Unsafe.Char
17 (
20 (
18 ord
21 ord
19 , unsafeChr
22 , unsafeChr
@@ -28,7 +31,7 @@ import Control.Exception (assert)
28#endif
31#endif
29import Control.Monad.ST (ST)
32import Control.Monad.ST (ST)
30import Data.Bits ((.&.))
33import Data.Bits ((.&.))
31−import Data.Text.UnsafeShift (shiftR)
34+import Data.Text.Internal.Unsafe.Shift (shiftR)
32import GHC.Exts (Char(..), Int(..), chr#, ord#, word2Int#)
35import GHC.Exts (Char(..), Int(..), chr#, ord#, word2Int#)
33import GHC.Word (Word8(..), Word16(..), Word32(..))
36import GHC.Word (Word8(..), Word16(..), Word32(..))
34import qualified Data.Text.Array as A
37import qualified Data.Text.Array as A
Data/Text/UnsafeShift.hs → Data/Text/Internal/Unsafe/Shift.hsrenamed+7−4
@@ -1,18 +1,21 @@
1{-# LANGUAGE MagicHash #-}
1{-# LANGUAGE MagicHash #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.UnsafeShift
4+-- Module : Data.Text.Internal.Unsafe.Shift
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, rtomharper@googlemail.com,
8+-- Maintainer : bos@serpentine.com
9−-- duncan@haskell.org
10-- Stability : experimental
9-- Stability : experimental
11-- Portability : GHC
10-- Portability : GHC
12--
11--
12+-- /Warning/: this is an internal module, and does not have a stable
13+-- API or name. Functions in this module may not check or enforce
14+-- preconditions expected by public modules. Use at your own risk!
15+--
13-- Fast, unchecked bit shifting functions.
16-- Fast, unchecked bit shifting functions.
14
17
15−module Data.Text.UnsafeShift
18+module Data.Text.Internal.Unsafe.Shift
16 (
19 (
17 UnsafeShift(..)
20 UnsafeShift(..)
18 ) where
21 ) where
Data/Text/Lazy.hs+248−53
@@ -3,13 +3,16 @@
3#if __GLASGOW_HASKELL__ >= 702
3#if __GLASGOW_HASKELL__ >= 702
4{-# LANGUAGE Trustworthy #-}
4{-# LANGUAGE Trustworthy #-}
5#endif
5#endif
6+#if __GLASGOW_HASKELL__ >= 708
7+{-# LANGUAGE TypeFamilies #-}
8+#endif
9+
6-- |
10-- |
7-- Module : Data.Text.Lazy
11-- Module : Data.Text.Lazy
8-- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan
12-- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan
9--
13--
10-- License : BSD-style
14-- License : BSD-style
11−-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
15+-- Maintainer : bos@serpentine.com
12−-- duncan@haskell.org
13-- Stability : experimental
16-- Stability : experimental
14-- Portability : GHC
17-- Portability : GHC
15--
18--
@@ -86,6 +89,7 @@ module Data.Text.Lazy
86 , toCaseFold
89 , toCaseFold
87 , toLower
90 , toLower
88 , toUpper
91 , toUpper
92+ , toTitle
89
93
90 -- ** Justification
94 -- ** Justification
91 , justifyLeft
95 , justifyLeft
@@ -121,7 +125,10 @@ module Data.Text.Lazy
121 , mapAccumR
125 , mapAccumR
122
126
123 -- ** Generation and unfolding
127 -- ** Generation and unfolding
128+ , repeat
124 , replicate
129 , replicate
130+ , cycle
131+ , iterate
125 , unfoldr
132 , unfoldr
126 , unfoldrN
133 , unfoldrN
127
134
@@ -129,8 +136,11 @@ module Data.Text.Lazy
129
136
130 -- ** Breaking strings
137 -- ** Breaking strings
131 , take
138 , take
139+ , takeEnd
132 , drop
140 , drop
141+ , dropEnd
133 , takeWhile
142 , takeWhile
143+ , takeWhileEnd
134 , dropWhile
144 , dropWhile
135 , dropWhileEnd
145 , dropWhileEnd
136 , dropAround
146 , dropAround
@@ -193,7 +203,7 @@ module Data.Text.Lazy
193import Prelude (Char, Bool(..), Maybe(..), String,
203import Prelude (Char, Bool(..), Maybe(..), String,
194 Eq(..), Ord(..), Ordering(..), Read(..), Show(..),
204 Eq(..), Ord(..), Ordering(..), Read(..), Show(..),
195 (&&), (||), (+), (-), (.), ($), (++),
205 (&&), (||), (+), (-), (.), ($), (++),
196− div, error, flip, fmap, fromIntegral, not, otherwise)
206+ error, flip, fmap, fromIntegral, not, otherwise, quot)
197import qualified Prelude as P
207import qualified Prelude as P
198#if defined(HAVE_DEEPSEQ)
208#if defined(HAVE_DEEPSEQ)
199import Control.DeepSeq (NFData(..))
209import Control.DeepSeq (NFData(..))
@@ -201,31 +211,39 @@ import Control.DeepSeq (NFData(..))
201import Data.Int (Int64)
211import Data.Int (Int64)
202import qualified Data.List as L
212import qualified Data.List as L
203import Data.Char (isSpace)
213import Data.Char (isSpace)
204−import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))
214+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
205−#if __GLASGOW_HASKELL__ >= 612
215+ Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
206−import Data.Data (mkNoRepType)
216+import Data.Binary (Binary(get, put))
207−#else
208−import Data.Data (mkNorepType)
209−#endif
210import Data.Monoid (Monoid(..))
217import Data.Monoid (Monoid(..))
218+#if MIN_VERSION_base(4,9,0)
219+import Data.Semigroup (Semigroup(..))
220+#endif
211import Data.String (IsString(..))
221import Data.String (IsString(..))
212import qualified Data.Text as T
222import qualified Data.Text as T
213import qualified Data.Text.Internal as T
223import qualified Data.Text.Internal as T
214−import qualified Data.Text.Fusion.Common as S
224+import qualified Data.Text.Internal.Fusion.Common as S
215import qualified Data.Text.Unsafe as T
225import qualified Data.Text.Unsafe as T
216−import qualified Data.Text.Lazy.Fusion as S
226+import qualified Data.Text.Internal.Lazy.Fusion as S
217−import Data.Text.Fusion.Internal (PairS(..))
227+import Data.Text.Internal.Fusion.Types (PairS(..))
218−import Data.Text.Lazy.Fusion (stream, unstream)
228+import Data.Text.Internal.Lazy.Fusion (stream, unstream)
219−import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldlChunks, foldrChunks)
229+import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks,
230+ foldrChunks, smallChunkSize)
220−import Data.Text.Internal (firstf, safe, textP)
231+import Data.Text.Internal (firstf, safe, text)
232+import Data.Text.Lazy.Encoding (decodeUtf8', encodeUtf8)
221−import qualified Data.Text.Util as U
233+import qualified Data.Text.Internal.Functions as F
222−import Data.Text.Lazy.Search (indices)
234+import Data.Text.Internal.Lazy.Search (indices)
223#if __GLASGOW_HASKELL__ >= 702
235#if __GLASGOW_HASKELL__ >= 702
224import qualified GHC.CString as GHC
236import qualified GHC.CString as GHC
225#else
237#else
226import qualified GHC.Base as GHC
238import qualified GHC.Base as GHC
227#endif
239#endif
240+#if __GLASGOW_HASKELL__ >= 708
241+import qualified GHC.Exts as Exts
242+#endif
228import GHC.Prim (Addr#)
243import GHC.Prim (Addr#)
244+#if MIN_VERSION_base(4,7,0)
245+import Text.Printf (PrintfArg, formatArg, formatString)
246+#endif
229
247
230-- $fusion
248-- $fusion
231--
249--
@@ -323,30 +341,72 @@ instance Show Text where
323instance Read Text where
341instance Read Text where
324 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
342 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
325
343
344+#if MIN_VERSION_base(4,9,0)
345+-- Semigroup orphan instances for older GHCs are provided by
346+-- 'semigroups` package
347+
348+instance Semigroup Text where
349+ (<>) = append
350+#endif
351+
326instance Monoid Text where
352instance Monoid Text where
327 mempty = empty
353 mempty = empty
354+#if MIN_VERSION_base(4,9,0)
355+ mappend = (<>) -- future-proof definition
356+#else
328 mappend = append
357 mappend = append
358+#endif
329 mconcat = concat
359 mconcat = concat
330
360
331instance IsString Text where
361instance IsString Text where
332 fromString = pack
362 fromString = pack
333
363
364+#if __GLASGOW_HASKELL__ >= 708
365+instance Exts.IsList Text where
366+ type Item Text = Char
367+ fromList = pack
368+ toList = unpack
369+#endif
370+
334#if defined(HAVE_DEEPSEQ)
371#if defined(HAVE_DEEPSEQ)
335instance NFData Text where
372instance NFData Text where
336 rnf Empty = ()
373 rnf Empty = ()
337 rnf (Chunk _ ts) = rnf ts
374 rnf (Chunk _ ts) = rnf ts
338#endif
375#endif
339
376
377+instance Binary Text where
378+ put t = put (encodeUtf8 t)
379+ get = do
380+ bs <- get
381+ case decodeUtf8' bs of
382+ P.Left exn -> P.fail (P.show exn)
383+ P.Right a -> P.return a
384+
385+-- | This instance preserves data abstraction at the cost of inefficiency.
386+-- We omit reflection services for the sake of data abstraction.
387+--
388+-- This instance was created by copying the updated behavior of
389+-- @"Data.Text".@'Data.Text.Text'
340instance Data Text where
390instance Data Text where
341 gfoldl f z txt = z pack `f` (unpack txt)
391 gfoldl f z txt = z pack `f` (unpack txt)
342− toConstr _ = error "Data.Text.Lazy.Text.toConstr"
392+ toConstr _ = packConstr
393+ gunfold k z c = case constrIndex c of
394+ 1 -> k (z pack)
343− gunfold _ _ = error "Data.Text.Lazy.Text.gunfold"
395+ _ -> error "Data.Text.Lazy.Text.gunfold"
344−#if __GLASGOW_HASKELL__ >= 612
396+ dataTypeOf _ = textDataType
345− dataTypeOf _ = mkNoRepType "Data.Text.Lazy.Text"
397+
346−#else
398+#if MIN_VERSION_base(4,7,0)
347− dataTypeOf _ = mkNorepType "Data.Text.Lazy.Text"
399+-- | Only defined for @base-4.7.0.0@ and later
400+instance PrintfArg Text where
401+ formatArg txt = formatString $ unpack txt
348#endif
402#endif
349
403
404+packConstr :: Constr
405+packConstr = mkConstr textDataType "pack" [] Prefix
406+
407+textDataType :: DataType
408+textDataType = mkDataType "Data.Text.Lazy.Text" [packConstr]
409+
350-- | /O(n)/ Convert a 'String' into a 'Text'.
410-- | /O(n)/ Convert a 'String' into a 'Text'.
351--
411--
352-- Subject to fusion. Performs replacement on invalid scalar values.
412-- Subject to fusion. Performs replacement on invalid scalar values.
@@ -373,6 +433,14 @@ unpackCString# addr# = unstream (S.streamCString# addr#)
373 unstream (S.streamList (L.map safe (GHC.unpackCStringUtf8# a)))
433 unstream (S.streamList (L.map safe (GHC.unpackCStringUtf8# a)))
374 = unpackCString# a #-}
434 = unpackCString# a #-}
375
435
436+{-# RULES "LAZY TEXT empty literal"
437+ unstream (S.streamList (L.map safe []))
438+ = Empty #-}
439+
440+{-# RULES "LAZY TEXT empty literal" forall a.
441+ unstream (S.streamList (L.map safe [a]))
442+ = Chunk (T.singleton a) Empty #-}
443+
376-- | /O(1)/ Convert a character into a Text. Subject to fusion.
444-- | /O(1)/ Convert a character into a Text. Subject to fusion.
377-- Performs replacement on invalid scalar values.
445-- Performs replacement on invalid scalar values.
378singleton :: Char -> Text
446singleton :: Char -> Text
@@ -477,7 +545,7 @@ tail Empty = emptyError "tail"
477 unstream (S.tail (stream t)) = tail t
545 unstream (S.tail (stream t)) = tail t
478 #-}
546 #-}
479
547
480−-- | /O(1)/ Returns all but the last character of a 'Text', which must
548+-- | /O(n\/c)/ Returns all but the last character of a 'Text', which must
481-- be non-empty. Subject to fusion.
549-- be non-empty. Subject to fusion.
482init :: Text -> Text
550init :: Text -> Text
483init (Chunk t0 ts0) = go t0 ts0
551init (Chunk t0 ts0) = go t0 ts0
@@ -513,7 +581,7 @@ isSingleton :: Text -> Bool
513isSingleton = S.isSingleton . stream
581isSingleton = S.isSingleton . stream
514{-# INLINE isSingleton #-}
582{-# INLINE isSingleton #-}
515
583
516−-- | /O(1)/ Returns the last character of a 'Text', which must be
584+-- | /O(n\/c)/ Returns the last character of a 'Text', which must be
517-- non-empty. Subject to fusion.
585-- non-empty. Subject to fusion.
518last :: Text -> Char
586last :: Text -> Char
519last Empty = emptyError "last"
587last Empty = emptyError "last"
@@ -568,7 +636,7 @@ map f t = unstream (S.map (safe . f) (stream t))
568-- 'Text's and concatenates the list after interspersing the first
636-- 'Text's and concatenates the list after interspersing the first
569-- argument between each element of the list.
637-- argument between each element of the list.
570intercalate :: Text -> [Text] -> Text
638intercalate :: Text -> [Text] -> Text
571−intercalate t = concat . (U.intersperse t)
639+intercalate t = concat . (F.intersperse t)
572{-# INLINE intercalate #-}
640{-# INLINE intercalate #-}
573
641
574-- | /O(n)/ The 'intersperse' function takes a character and places it
642-- | /O(n)/ The 'intersperse' function takes a character and places it
@@ -628,7 +696,7 @@ center k c t
628 | otherwise = replicateChar l c `append` t `append` replicateChar r c
696 | otherwise = replicateChar l c `append` t `append` replicateChar r c
629 where len = length t
697 where len = length t
630 d = k - len
698 d = k - len
631− r = d `div` 2
699+ r = d `quot` 2
632 l = d - r
700 l = d - r
633{-# INLINE center #-}
701{-# INLINE center #-}
634
702
@@ -647,13 +715,36 @@ reverse = rev Empty
647 where rev a Empty = a
715 where rev a Empty = a
648 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts
716 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts
649
717
650−-- | /O(m+n)/ Replace every occurrence of one substring with another.
718+-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
719+-- @haystack@ with @replacement@.
720+--
721+-- This function behaves as though it was defined as follows:
722+--
723+-- @
724+-- replace needle replacement haystack =
725+-- 'intercalate' replacement ('splitOn' needle haystack)
726+-- @
727+--
728+-- As this suggests, each occurrence is replaced exactly once. So if
729+-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
730+-- be replaced recursively:
731+--
732+-- > replace "oo" "foo" "oo" == "foo"
733+--
734+-- In cases where several instances of @needle@ overlap, only the
735+-- first one will be replaced:
736+--
737+-- > replace "ofo" "bar" "ofofo" == "barfo"
651--
738--
652-- In (unlikely) bad cases, this function's time complexity degrades
739-- In (unlikely) bad cases, this function's time complexity degrades
653-- towards /O(n*m)/.
740-- towards /O(n*m)/.
654−replace :: Text -- ^ Text to search for
741+replace :: Text
655− -> Text -- ^ Replacement text
742+ -- ^ @needle@ to search for. If this string is empty, an
743+ -- error will occur.
744+ -> Text
745+ -- ^ @replacement@ to replace @needle@ with.
656− -> Text -- ^ Input text
746+ -> Text
747+ -- ^ @haystack@ in which to search.
657 -> Text
748 -> Text
658replace s d = intercalate d . splitOn s
749replace s d = intercalate d . splitOn s
659{-# INLINE replace #-}
750{-# INLINE replace #-}
@@ -670,9 +761,10 @@ replace s d = intercalate d . splitOn s
670-- functions may map one input character to two or three output
761-- functions may map one input character to two or three output
671-- characters.
762-- characters.
672
763
673−-- | /O(n)/ Convert a string to folded case. This function is mainly
764+-- | /O(n)/ Convert a string to folded case. Subject to fusion.
765+--
674−-- useful for performing caseless (or case insensitive) string
766+-- This function is mainly useful for performing caseless (or case
675−-- comparisons.
767+-- insensitive) string comparisons.
676--
768--
677-- A string @x@ is a caseless match for a string @y@ if and only if:
769-- A string @x@ is a caseless match for a string @y@ if and only if:
678--
770--
@@ -689,22 +781,49 @@ toCaseFold t = unstream (S.toCaseFold (stream t))
689{-# INLINE [0] toCaseFold #-}
781{-# INLINE [0] toCaseFold #-}
690
782
691-- | /O(n)/ Convert a string to lower case, using simple case
783-- | /O(n)/ Convert a string to lower case, using simple case
784+-- conversion. Subject to fusion.
785+--
692−-- conversion. The result string may be longer than the input string.
786+-- The result string may be longer than the input string. For
693−-- For instance, the Latin capital letter I with dot above (U+0130)
787+-- instance, the Latin capital letter I with dot above (U+0130) maps
694−-- maps to the sequence Latin small letter i (U+0069) followed by
788+-- to the sequence Latin small letter i (U+0069) followed by combining
695−-- combining dot above (U+0307).
789+-- dot above (U+0307).
696toLower :: Text -> Text
790toLower :: Text -> Text
697toLower t = unstream (S.toLower (stream t))
791toLower t = unstream (S.toLower (stream t))
698{-# INLINE toLower #-}
792{-# INLINE toLower #-}
699
793
700-- | /O(n)/ Convert a string to upper case, using simple case
794-- | /O(n)/ Convert a string to upper case, using simple case
795+-- conversion. Subject to fusion.
796+--
701−-- conversion. The result string may be longer than the input string.
797+-- The result string may be longer than the input string. For
702−-- For instance, the German eszett (U+00DF) maps to the two-letter
798+-- instance, the German eszett (U+00DF) maps to the two-letter
703-- sequence SS.
799-- sequence SS.
704toUpper :: Text -> Text
800toUpper :: Text -> Text
705toUpper t = unstream (S.toUpper (stream t))
801toUpper t = unstream (S.toUpper (stream t))
706{-# INLINE toUpper #-}
802{-# INLINE toUpper #-}
707
803
804+
805+-- | /O(n)/ Convert a string to title case, using simple case
806+-- conversion. Subject to fusion.
807+--
808+-- The first letter of the input is converted to title case, as is
809+-- every subsequent letter that immediately follows a non-letter.
810+-- Every letter that immediately follows another letter is converted
811+-- to lower case.
812+--
813+-- The result string may be longer than the input string. For example,
814+-- the Latin small ligature &#xfb02; (U+FB02) is converted to the
815+-- sequence Latin capital letter F (U+0046) followed by Latin small
816+-- letter l (U+006C).
817+--
818+-- /Note/: this function does not take language or culture specific
819+-- rules into account. For instance, in English, different style
820+-- guides disagree on whether the book name \"The Hill of the Red
821+-- Fox\" is correctly title cased&#x2014;but this function will
822+-- capitalize /every/ word.
823+toTitle :: Text -> Text
824+toTitle t = unstream (S.toTitle (stream t))
825+{-# INLINE toTitle #-}
826+
708-- | /O(n)/ 'foldl', applied to a binary operator, a starting value
827-- | /O(n)/ 'foldl', applied to a binary operator, a starting value
709-- (typically the left-identity of the operator), and a 'Text',
828-- (typically the left-identity of the operator), and a 'Text',
710-- reduces the 'Text' using the binary operator, from left to right.
829-- reduces the 'Text' using the binary operator, from left to right.
@@ -762,13 +881,13 @@ concatMap f = concat . foldr ((:) . f) []
762{-# INLINE concatMap #-}
881{-# INLINE concatMap #-}
763
882
764-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
883-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
765−-- 'Text' @t@ satisifes the predicate @p@. Subject to fusion.
884+-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
766any :: (Char -> Bool) -> Text -> Bool
885any :: (Char -> Bool) -> Text -> Bool
767any p t = S.any p (stream t)
886any p t = S.any p (stream t)
768{-# INLINE any #-}
887{-# INLINE any #-}
769
888
770-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
889-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
771−-- 'Text' @t@ satisify the predicate @p@. Subject to fusion.
890+-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
772all :: (Char -> Bool) -> Text -> Bool
891all :: (Char -> Bool) -> Text -> Bool
773all p t = S.all p (stream t)
892all p t = S.all p (stream t)
774{-# INLINE all #-}
893{-# INLINE all #-}
@@ -851,6 +970,12 @@ mapAccumR f = go
851 go z Empty = (z, Empty)
970 go z Empty = (z, Empty)
852{-# INLINE mapAccumR #-}
971{-# INLINE mapAccumR #-}
853
972
973+-- | @'repeat' x@ is an infinite 'Text', with @x@ the value of every
974+-- element.
975+repeat :: Char -> Text
976+repeat c = let t = Chunk (T.replicate smallChunkSize (T.singleton c)) t
977+ in t
978+
854-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
979-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
855-- @t@ repeated @n@ times.
980-- @t@ repeated @n@ times.
856replicate :: Int64 -> Text -> Text
981replicate :: Int64 -> Text -> Text
@@ -860,7 +985,22 @@ replicate n t
860 | otherwise = concat (rep 0)
985 | otherwise = concat (rep 0)
861 where rep !i | i >= n = []
986 where rep !i | i >= n = []
862 | otherwise = t : rep (i+1)
987 | otherwise = t : rep (i+1)
863−{-# INLINE replicate #-}
988+{-# INLINE [1] 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
864
1004
865-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
1005-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
866-- value of every element. Subject to fusion.
1006-- value of every element. Subject to fusion.
@@ -915,6 +1055,22 @@ take i t0 = take' i t0
915 unstream (S.take n (stream t)) = take n t
1055 unstream (S.take n (stream t)) = take n t
916 #-}
1056 #-}
917
1057
1058+-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after
1059+-- taking @n@ characters from the end of @t@.
1060+--
1061+-- Examples:
1062+--
1063+-- > takeEnd 3 "foobar" == "bar"
1064+takeEnd :: Int64 -> Text -> Text
1065+takeEnd n t0
1066+ | n <= 0 = empty
1067+ | otherwise = takeChunk n empty . L.reverse . toChunks $ t0
1068+ where takeChunk _ acc [] = acc
1069+ takeChunk i acc (t:ts)
1070+ | i <= l = chunk (T.takeEnd (fromIntegral i) t) acc
1071+ | otherwise = takeChunk (i-l) (Chunk t acc) ts
1072+ where l = fromIntegral (T.length t)
1073+
918-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1074-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
919-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1075-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
920-- is greater than the length of the 'Text'. Subject to fusion.
1076-- is greater than the length of the 'Text'. Subject to fusion.
@@ -937,6 +1093,23 @@ drop i t0
937 unstream (S.drop n (stream t)) = drop n t
1093 unstream (S.drop n (stream t)) = drop n t
938 #-}
1094 #-}
939
1095
1096+-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after
1097+-- dropping @n@ characters from the end of @t@.
1098+--
1099+-- Examples:
1100+--
1101+-- > dropEnd 3 "foobar" == "foo"
1102+dropEnd :: Int64 -> Text -> Text
1103+dropEnd n t0
1104+ | n <= 0 = t0
1105+ | otherwise = dropChunk n . L.reverse . toChunks $ t0
1106+ where dropChunk _ [] = empty
1107+ dropChunk m (t:ts)
1108+ | m >= l = dropChunk (m-l) ts
1109+ | otherwise = fromChunks . L.reverse $
1110+ T.dropEnd (fromIntegral m) t : ts
1111+ where l = fromIntegral (T.length t)
1112+
940-- | /O(n)/ 'dropWords' @n@ returns the suffix with @n@ 'Word16'
1113-- | /O(n)/ 'dropWords' @n@ returns the suffix with @n@ 'Word16'
941-- values dropped, or the empty 'Text' if @n@ is greater than the
1114-- values dropped, or the empty 'Text' if @n@ is greater than the
942-- number of 'Word16' values present.
1115-- number of 'Word16' values present.
@@ -947,7 +1120,7 @@ dropWords i t0
947 where drop' 0 ts = ts
1120 where drop' 0 ts = ts
948 drop' _ Empty = Empty
1121 drop' _ Empty = Empty
949 drop' n (Chunk (T.Text arr off len) ts)
1122 drop' n (Chunk (T.Text arr off len) ts)
950− | n < len' = chunk (textP arr (off+n') (len-n')) ts
1123+ | n < len' = chunk (text arr (off+n') (len-n')) ts
951 | otherwise = drop' (n - len') ts
1124 | otherwise = drop' (n - len') ts
952 where len' = fromIntegral len
1125 where len' = fromIntegral len
953 n' = fromIntegral n
1126 n' = fromIntegral n
@@ -971,6 +1144,20 @@ takeWhile p t0 = takeWhile' t0
971"LAZY TEXT takeWhile -> unfused" [1] forall p t.
1144"LAZY TEXT takeWhile -> unfused" [1] forall p t.
972 unstream (S.takeWhile p (stream t)) = takeWhile p t
1145 unstream (S.takeWhile p (stream t)) = takeWhile p t
973 #-}
1146 #-}
1147+-- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',
1148+-- returns the longest suffix (possibly empty) of elements that
1149+-- satisfy @p@.
1150+-- Examples:
1151+--
1152+-- > takeWhileEnd (=='o') "foo" == "oo"
1153+takeWhileEnd :: (Char -> Bool) -> Text -> Text
1154+takeWhileEnd p = takeChunk empty . L.reverse . toChunks
1155+ where takeChunk acc [] = acc
1156+ takeChunk acc (t:ts) = if T.length t' < T.length t
1157+ then (Chunk t' acc)
1158+ else takeChunk (Chunk t' acc) ts
1159+ where t' = T.takeWhileEnd p t
1160+{-# INLINE takeWhileEnd #-}
974
1161
975-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1162-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
976-- 'takeWhile' @p@ @t@. Subject to fusion.
1163-- 'takeWhile' @p@ @t@. Subject to fusion.
@@ -989,9 +1176,11 @@ dropWhile p t0 = dropWhile' t0
989"LAZY TEXT dropWhile -> unfused" [1] forall p t.
1176"LAZY TEXT dropWhile -> unfused" [1] forall p t.
990 unstream (S.dropWhile p (stream t)) = dropWhile p t
1177 unstream (S.dropWhile p (stream t)) = dropWhile p t
991 #-}
1178 #-}
1179+
992-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1180-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
993−-- dropping characters that fail the predicate @p@ from the end of
1181+-- dropping characters that satisfy the predicate @p@ from the end of
994-- @t@.
1182-- @t@.
1183+--
995-- Examples:
1184-- Examples:
996--
1185--
997-- > dropWhileEnd (=='.') "foo..." == "foo"
1186-- > dropWhileEnd (=='.') "foo..." == "foo"
@@ -1008,7 +1197,7 @@ dropWhileEnd p = go
1008{-# INLINE dropWhileEnd #-}
1197{-# INLINE dropWhileEnd #-}
1009
1198
1010-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1199-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1011−-- dropping characters that fail the predicate @p@ from both the
1200+-- dropping characters that satisfy the predicate @p@ from both the
1012-- beginning and end of @t@. Subject to fusion.
1201-- beginning and end of @t@. Subject to fusion.
1013dropAround :: (Char -> Bool) -> Text -> Text
1202dropAround :: (Char -> Bool) -> Text -> Text
1014dropAround p = dropWhile p . dropWhileEnd p
1203dropAround p = dropWhile p . dropWhileEnd p
@@ -1058,8 +1247,8 @@ splitAtWord _ Empty = empty :*: empty
1058splitAtWord x (Chunk c@(T.Text arr off len) cs)
1247splitAtWord x (Chunk c@(T.Text arr off len) cs)
1059 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1248 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1060 in Chunk c h :*: t
1249 in Chunk c h :*: t
1061− | otherwise = chunk (textP arr off y) empty :*:
1250+ | otherwise = chunk (text arr off y) empty :*:
1062− chunk (textP arr (off+y) (len-y)) cs
1251+ chunk (text arr (off+y) (len-y)) cs
1063 where y = fromIntegral x
1252 where y = fromIntegral x
1064
1253
1065-- | /O(n+m)/ Find the first instance of @needle@ (which must be
1254-- | /O(n+m)/ Find the first instance of @needle@ (which must be
@@ -1203,9 +1392,10 @@ tails ts@(Chunk t ts')
1203-- copies to create substrings; they just construct new 'Text's that
1392-- copies to create substrings; they just construct new 'Text's that
1204-- are slices of the original.
1393-- are slices of the original.
1205
1394
1206−-- | /O(m+n)/ Break a 'Text' into pieces separated by the first
1395+-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'
1207−-- 'Text' argument, consuming the delimiter. An empty delimiter is
1396+-- argument (which cannot be an empty string), consuming the
1208−-- invalid, and will cause an error to be raised.
1397+-- delimiter. An empty delimiter is invalid, and will cause an error
1398+-- to be raised.
1209--
1399--
1210-- Examples:
1400-- Examples:
1211--
1401--
@@ -1218,13 +1408,18 @@ tails ts@(Chunk t ts')
1218-- > intercalate s . splitOn s == id
1408-- > intercalate s . splitOn s == id
1219-- > splitOn (singleton c) == split (==c)
1409-- > splitOn (singleton c) == split (==c)
1220--
1410--
1411+-- (Note: the string @s@ to split on above cannot be empty.)
1412+--
1221-- This function is strict in its first argument, and lazy in its
1413-- This function is strict in its first argument, and lazy in its
1222-- second.
1414-- second.
1223--
1415--
1224-- In (unlikely) bad cases, this function's time complexity degrades
1416-- In (unlikely) bad cases, this function's time complexity degrades
1225-- towards /O(n*m)/.
1417-- towards /O(n*m)/.
1226−splitOn :: Text -- ^ Text to split on
1418+splitOn :: Text
1419+ -- ^ String to split on. If this string is empty, an error
1420+ -- will occur.
1421+ -> Text
1227− -> Text -- ^ Input text
1422+ -- ^ Input text.
1228 -> [Text]
1423 -> [Text]
1229splitOn pat src
1424splitOn pat src
1230 | null pat = emptyError "splitOn"
1425 | null pat = emptyError "splitOn"
Data/Text/Lazy/Builder.hs+17−271
@@ -1,10 +1,14 @@
1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
2+#if __GLASGOW_HASKELL__ >= 702
3+{-# LANGUAGE Trustworthy #-}
4+#endif
2
5
3-----------------------------------------------------------------------------
6-----------------------------------------------------------------------------
4-- |
7-- |
5-- Module : Data.Text.Lazy.Builder
8-- Module : Data.Text.Lazy.Builder
9+-- Copyright : (c) 2013 Bryan O'Sullivan
6−-- Copyright : (c) 2010 Johan Tibell
10+-- (c) 2010 Johan Tibell
7−-- License : BSD3-style (see LICENSE)
11+-- License : BSD-style (see LICENSE)
8--
12--
9-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
13-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
10-- Stability : experimental
14-- Stability : experimental
@@ -15,7 +19,9 @@
15-- @fromLazyText@, which construct new builders, and 'mappend', which
19-- @fromLazyText@, which construct new builders, and 'mappend', which
16-- concatenates two builders.
20-- concatenates two builders.
17--
21--
18−-- To get maximum performance when building lazy @Text@ values using a builder, associate @mappend@ calls to the right. For example, prefer
22+-- To get maximum performance when building lazy @Text@ values using a
23+-- builder, associate @mappend@ calls to the right. For example,
24+-- prefer
19--
25--
20-- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')
26-- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')
21--
27--
@@ -23,8 +29,14 @@
23--
29--
24-- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'
30-- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'
25--
31--
26−-- as the latter associates @mappend@ to the left.
32+-- as the latter associates @mappend@ to the left. Or, equivalently,
33+-- prefer
27--
34--
35+-- > singleton 'a' <> singleton 'b' <> singleton 'c'
36+--
37+-- since the '<>' from recent versions of 'Data.Monoid' associates
38+-- to the right.
39+
28-----------------------------------------------------------------------------
40-----------------------------------------------------------------------------
29
41
30module Data.Text.Lazy.Builder
42module Data.Text.Lazy.Builder
@@ -43,270 +55,4 @@ module Data.Text.Lazy.Builder
43 , flush
55 , flush
44 ) where
56 ) where
45
57
46−import Control.Monad.ST (ST, runST)
47−import Data.Bits ((.&.))
48−import Data.Monoid (Monoid(..))
49−import Data.Text.Internal (Text(..))
58+import Data.Text.Internal.Builder
50−import Data.Text.Lazy.Internal (smallChunkSize)
51−import Data.Text.Unsafe (inlineInterleaveST)
52−import Data.Text.UnsafeChar (ord, unsafeWrite)
53−import Data.Text.UnsafeShift (shiftR)
54−import Prelude hiding (map, putChar)
55−
56−import qualified Data.String as String
57−import qualified Data.Text as S
58−import qualified Data.Text.Array as A
59−import qualified Data.Text.Lazy as L
60−
61−------------------------------------------------------------------------
62−
63−-- | A @Builder@ is an efficient way to build lazy @Text@ values.
64−-- There are several functions for constructing builders, but only one
65−-- to inspect them: to extract any data, you have to turn them into
66−-- lazy @Text@ values using @toLazyText@.
67−--
68−-- Internally, a builder constructs a lazy @Text@ by filling arrays
69−-- piece by piece. As each buffer is filled, it is \'popped\' off, to
70−-- become a new chunk of the resulting lazy @Text@. All this is
71−-- hidden from the user of the @Builder@.
72−newtype Builder = Builder {
73− -- Invariant (from Data.Text.Lazy):
74− -- The lists include no null Texts.
75− runBuilder :: forall s. (Buffer s -> ST s [S.Text])
76− -> Buffer s
77− -> ST s [S.Text]
78− }
79−
80−instance Monoid Builder where
81− mempty = empty
82− {-# INLINE mempty #-}
83− mappend = append
84− {-# INLINE mappend #-}
85− mconcat = foldr mappend mempty
86− {-# INLINE mconcat #-}
87−
88−instance String.IsString Builder where
89− fromString = fromString
90− {-# INLINE fromString #-}
91−
92−instance Show Builder where
93− show = show . toLazyText
94−
95−instance Eq Builder where
96− a == b = toLazyText a == toLazyText b
97−
98−instance Ord Builder where
99− a <= b = toLazyText a <= toLazyText b
100−
101−------------------------------------------------------------------------
102−
103−-- | /O(1)./ The empty @Builder@, satisfying
104−--
105−-- * @'toLazyText' 'empty' = 'L.empty'@
106−--
107−empty :: Builder
108−empty = Builder (\ k buf -> k buf)
109−{-# INLINE empty #-}
110−
111−-- | /O(1)./ A @Builder@ taking a single character, satisfying
112−--
113−-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@
114−--
115−singleton :: Char -> Builder
116−singleton c = writeAtMost 2 $ \ marr o ->
117− if n < 0x10000
118− then A.unsafeWrite marr o (fromIntegral n) >> return 1
119− else do
120− A.unsafeWrite marr o lo
121− A.unsafeWrite marr (o+1) hi
122− return 2
123− where n = ord c
124− m = n - 0x10000
125− lo = fromIntegral $ (m `shiftR` 10) + 0xD800
126− hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
127−{-# INLINE singleton #-}
128−
129−------------------------------------------------------------------------
130−
131−-- | /O(1)./ The concatenation of two builders, an associative
132−-- operation with identity 'empty', satisfying
133−--
134−-- * @'toLazyText' ('append' x y) = 'L.append' ('toLazyText' x) ('toLazyText' y)@
135−--
136−append :: Builder -> Builder -> Builder
137−append (Builder f) (Builder g) = Builder (f . g)
138−{-# INLINE [0] append #-}
139−
140−-- TODO: Experiment to find the right threshold.
141−copyLimit :: Int
142−copyLimit = 128
143−
144−-- This function attempts to merge small @Text@ values instead of
145−-- treating each value as its own chunk. We may not always want this.
146−
147−-- | /O(1)./ A @Builder@ taking a 'S.Text', satisfying
148−--
149−-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@
150−--
151−fromText :: S.Text -> Builder
152−fromText t@(Text arr off l)
153− | S.null t = empty
154− | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)
155− | otherwise = flush `append` mapBuilder (t :)
156−{-# INLINE [1] fromText #-}
157−
158−{-# RULES
159−"fromText/pack" forall s .
160− fromText (S.pack s) = fromString s
161− #-}
162−
163−-- | /O(1)./ A Builder taking a @String@, satisfying
164−--
165−-- * @'toLazyText' ('fromString' s) = 'L.fromChunks' [S.pack s]@
166−--
167−fromString :: String -> Builder
168−fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
169− let loop !marr !o !u !l [] = k (Buffer marr o u l)
170− loop marr o u l s@(c:cs)
171− | l <= 1 = do
172− arr <- A.unsafeFreeze marr
173− let !t = Text arr o u
174− marr' <- A.new chunkSize
175− ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
176− return $ t : ts
177− | otherwise = do
178− n <- unsafeWrite marr (o+u) c
179− loop marr o (u+n) (l-n) cs
180− in loop p0 o0 u0 l0 str
181− where
182− chunkSize = smallChunkSize
183−{-# INLINE fromString #-}
184−
185−-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying
186−--
187−-- * @'toLazyText' ('fromLazyText' t) = t@
188−--
189−fromLazyText :: L.Text -> Builder
190−fromLazyText ts = flush `append` mapBuilder (L.toChunks ts ++)
191−{-# INLINE fromLazyText #-}
192−
193−------------------------------------------------------------------------
194−
195−-- Our internal buffer type
196−data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s)
197− {-# UNPACK #-} !Int -- offset
198− {-# UNPACK #-} !Int -- used units
199− {-# UNPACK #-} !Int -- length left
200−
201−------------------------------------------------------------------------
202−
203−-- | /O(n)./ Extract a lazy @Text@ from a @Builder@ with a default
204−-- buffer size. The construction work takes place if and when the
205−-- relevant part of the lazy @Text@ is demanded.
206−toLazyText :: Builder -> L.Text
207−toLazyText = toLazyTextWith smallChunkSize
208−
209−-- | /O(n)./ Extract a lazy @Text@ from a @Builder@, using the given
210−-- size for the initial buffer. The construction work takes place if
211−-- and when the relevant part of the lazy @Text@ is demanded.
212−--
213−-- If the initial buffer is too small to hold all data, subsequent
214−-- buffers will be the default buffer size.
215−toLazyTextWith :: Int -> Builder -> L.Text
216−toLazyTextWith chunkSize m = L.fromChunks (runST $
217− newBuffer chunkSize >>= runBuilder (m `append` flush) (const (return [])))
218−
219−-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,
220−-- yielding a new chunk in the result lazy @Text@.
221−flush :: Builder
222−flush = Builder $ \ k buf@(Buffer p o u l) ->
223− if u == 0
224− then k buf
225− else do arr <- A.unsafeFreeze p
226− let !b = Buffer p (o+u) 0 l
227− !t = Text arr o u
228− ts <- inlineInterleaveST (k b)
229− return $! t : ts
230−
231−------------------------------------------------------------------------
232−
233−-- | Sequence an ST operation on the buffer
234−withBuffer :: (forall s. Buffer s -> ST s (Buffer s)) -> Builder
235−withBuffer f = Builder $ \k buf -> f buf >>= k
236−{-# INLINE withBuffer #-}
237−
238−-- | Get the size of the buffer
239−withSize :: (Int -> Builder) -> Builder
240−withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->
241− runBuilder (f l) k buf
242−{-# INLINE withSize #-}
243−
244−-- | Map the resulting list of texts.
245−mapBuilder :: ([S.Text] -> [S.Text]) -> Builder
246−mapBuilder f = Builder (fmap f .)
247−
248−------------------------------------------------------------------------
249−
250−-- | Ensure that there are at least @n@ many elements available.
251−ensureFree :: Int -> Builder
252−ensureFree !n = withSize $ \ l ->
253− if n <= l
254− then empty
255− else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize)))
256−{-# INLINE [0] ensureFree #-}
257−
258−writeAtMost :: Int -> (forall s. A.MArray s -> Int -> ST s Int) -> Builder
259−writeAtMost n f = ensureFree n `append'` withBuffer (writeBuffer f)
260−{-# INLINE [0] writeAtMost #-}
261−
262−-- | Ensure that @n@ many elements are available, and then use @f@ to
263−-- write some elements into the memory.
264−writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder
265−writeN n f = writeAtMost n (\ p o -> f p o >> return n)
266−{-# INLINE writeN #-}
267−
268−writeBuffer :: (A.MArray s -> Int -> ST s Int) -> Buffer s -> ST s (Buffer s)
269−writeBuffer f (Buffer p o u l) = do
270− n <- f p (o+u)
271− return $! Buffer p o (u+n) (l-n)
272−{-# INLINE writeBuffer #-}
273−
274−newBuffer :: Int -> ST s (Buffer s)
275−newBuffer size = do
276− arr <- A.new size
277− return $! Buffer arr 0 0 size
278−{-# INLINE newBuffer #-}
279−
280−------------------------------------------------------------------------
281−-- Some nice rules for Builder
282−
283−-- This function makes GHC understand that 'writeN' and 'ensureFree'
284−-- are *not* recursive in the precense of the rewrite rules below.
285−-- This is not needed with GHC 7+.
286−append' :: Builder -> Builder -> Builder
287−append' (Builder f) (Builder g) = Builder (f . g)
288−{-# INLINE append' #-}
289−
290−{-# RULES
291−
292−"append/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)
293− (g::forall s. A.MArray s -> Int -> ST s Int) ws.
294− append (writeAtMost a f) (append (writeAtMost b g) ws) =
295− append (writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->
296− g marr (o+n) >>= \ m ->
297− let s = n+m in s `seq` return s)) ws
298−
299−"writeAtMost/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)
300− (g::forall s. A.MArray s -> Int -> ST s Int).
301− append (writeAtMost a f) (writeAtMost b g) =
302− writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->
303− g marr (o+n) >>= \ m ->
304− let s = n+m in s `seq` return s)
305−
306−"ensureFree/ensureFree" forall a b .
307− append (ensureFree a) (ensureFree b) = ensureFree (max a b)
308−
309−"flush/flush"
310− append flush flush = flush
311−
312− #-}
Data/Text/Lazy/Builder/Int.hs+113−41
@@ -1,8 +1,13 @@
1−{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
1+{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,
2+ UnboxedTuples #-}
3+#if __GLASGOW_HASKELL__ >= 702
4+{-# LANGUAGE Trustworthy #-}
5+#endif
2
6
3-- Module: Data.Text.Lazy.Builder.Int
7-- Module: Data.Text.Lazy.Builder.Int
8+-- Copyright: (c) 2013 Bryan O'Sullivan
4−-- Copyright: (c) 2011 MailRank, Inc.
9+-- (c) 2011 MailRank, Inc.
5−-- License: BSD3
10+-- License: BSD-style
6-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
11-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
7-- Stability: experimental
12-- Stability: experimental
8-- Portability: portable
13-- Portability: portable
@@ -17,18 +22,20 @@ module Data.Text.Lazy.Builder.Int
17
22
18import Data.Int (Int8, Int16, Int32, Int64)
23import Data.Int (Int8, Int16, Int32, Int64)
19import Data.Monoid (mempty)
24import Data.Monoid (mempty)
25+import qualified Data.ByteString.Unsafe as B
20−import Data.Text.Lazy.Builder.Functions ((<>), i2d)
26+import Data.Text.Internal.Builder.Functions ((<>), i2d)
21−import Data.Text.Lazy.Builder
27+import Data.Text.Internal.Builder
28+import Data.Text.Internal.Builder.Int.Digits (digits)
29+import Data.Text.Array
22import Data.Word (Word, Word8, Word16, Word32, Word64)
30import Data.Word (Word, Word8, Word16, Word32, Word64)
23import GHC.Base (quotInt, remInt)
31import GHC.Base (quotInt, remInt)
24import GHC.Num (quotRemInteger)
32import GHC.Num (quotRemInteger)
25import GHC.Types (Int(..))
33import GHC.Types (Int(..))
34+import Control.Monad.ST
26
35
27#ifdef __GLASGOW_HASKELL__
36#ifdef __GLASGOW_HASKELL__
28−# if __GLASGOW_HASKELL__ < 611
29−import GHC.Integer.Internals
30−# elif defined(INTEGER_GMP)
37+# if defined(INTEGER_GMP)
31−import GHC.Integer.GMP.Internals
38+import GHC.Integer.GMP.Internals (Integer(S#))
32# elif defined(INTEGER_SIMPLE)
39# elif defined(INTEGER_SIMPLE)
33import GHC.Integer
40import GHC.Integer
34# else
41# else
@@ -43,23 +50,19 @@ import GHC.Integer
43#endif
50#endif
44
51
45decimal :: Integral a => a -> Builder
52decimal :: Integral a => a -> Builder
46−{-# SPECIALIZE decimal :: Int8 -> Builder #-}
53+{-# RULES "decimal/Int8" decimal = boundedDecimal :: Int8 -> Builder #-}
47{-# RULES "decimal/Int" decimal = boundedDecimal :: Int -> Builder #-}
54{-# RULES "decimal/Int" decimal = boundedDecimal :: Int -> Builder #-}
48{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}
55{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}
49{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}
56{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}
50{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}
57{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}
51−{-# RULES "decimal/Word" decimal = positive :: Word -> Builder #-}
58+{-# RULES "decimal/Word" decimal = positive :: Data.Word.Word -> Builder #-}
52{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}
59{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}
53{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}
60{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}
54{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}
61{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}
55{-# RULES "decimal/Word64" decimal = positive :: Word64 -> Builder #-}
62{-# RULES "decimal/Word64" decimal = positive :: Word64 -> Builder #-}
56{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}
63{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}
57−decimal i
64+decimal i = decimal' (<= -128) i
58− | i < 0 = singleton '-' <>
65+{-# NOINLINE decimal #-}
59− if i <= -128
60− then positive (-(i `quot` 10)) <> digit (-(i `rem` 10))
61− else positive (-i)
62− | otherwise = positive i
63
66
64boundedDecimal :: (Integral a, Bounded a) => a -> Builder
67boundedDecimal :: (Integral a, Bounded a) => a -> Builder
65{-# SPECIALIZE boundedDecimal :: Int -> Builder #-}
68{-# SPECIALIZE boundedDecimal :: Int -> Builder #-}
@@ -67,11 +70,23 @@ boundedDecimal :: (Integral a, Bounded a) => a -> Builder
67{-# SPECIALIZE boundedDecimal :: Int16 -> Builder #-}
70{-# SPECIALIZE boundedDecimal :: Int16 -> Builder #-}
68{-# SPECIALIZE boundedDecimal :: Int32 -> Builder #-}
71{-# SPECIALIZE boundedDecimal :: Int32 -> Builder #-}
69{-# SPECIALIZE boundedDecimal :: Int64 -> Builder #-}
72{-# SPECIALIZE boundedDecimal :: Int64 -> Builder #-}
70−boundedDecimal i
73+boundedDecimal i = decimal' (== minBound) i
71− | i < 0 = singleton '-' <>
74+
72− if i == minBound
75+decimal' :: (Integral a) => (a -> Bool) -> a -> Builder
73− then positive (-(i `quot` 10)) <> digit (-(i `rem` 10))
76+{-# INLINE decimal' #-}
77+decimal' p i
78+ | i < 0 = if p i
79+ then let (q, r) = i `quotRem` 10
80+ qq = -q
81+ !n = countDigits qq
82+ in writeN (n + 2) $ \marr off -> do
83+ unsafeWrite marr off minus
84+ posDecimal marr (off+1) n qq
85+ unsafeWrite marr (off+n+1) (i2w (-r))
74− else positive (-i)
86+ else let j = -i
87+ !n = countDigits j
88+ in writeN (n + 1) $ \marr off ->
89+ unsafeWrite marr off minus >> posDecimal marr (off+1) n j
75 | otherwise = positive i
90 | otherwise = positive i
76
91
77positive :: (Integral a) => a -> Builder
92positive :: (Integral a) => a -> Builder
@@ -85,9 +100,64 @@ positive :: (Integral a) => a -> Builder
85{-# SPECIALIZE positive :: Word16 -> Builder #-}
100{-# SPECIALIZE positive :: Word16 -> Builder #-}
86{-# SPECIALIZE positive :: Word32 -> Builder #-}
101{-# SPECIALIZE positive :: Word32 -> Builder #-}
87{-# SPECIALIZE positive :: Word64 -> Builder #-}
102{-# SPECIALIZE positive :: Word64 -> Builder #-}
88−positive = go
103+positive i
104+ | i < 10 = writeN 1 $ \marr off -> unsafeWrite marr off (i2w i)
105+ | otherwise = let !n = countDigits i
106+ in writeN n $ \marr off -> posDecimal marr off n i
107+
108+posDecimal :: (Integral a) =>
109+ forall s. MArray s -> Int -> Int -> a -> ST s ()
110+{-# INLINE posDecimal #-}
111+posDecimal marr off0 ds v0 = go (off0 + ds - 1) v0
89− where go n | n < 10 = digit n
112+ where go off v
90− | otherwise = go (n `quot` 10) <> digit (n `rem` 10)
113+ | v >= 100 = do
114+ let (q, r) = v `quotRem` 100
115+ write2 off r
116+ go (off - 2) q
117+ | v < 10 = unsafeWrite marr off (i2w v)
118+ | otherwise = write2 off v
119+ write2 off i0 = do
120+ let i = fromIntegral i0; j = i + i
121+ unsafeWrite marr off $ get (j + 1)
122+ unsafeWrite marr (off - 1) $ get j
123+ get = fromIntegral . B.unsafeIndex digits
124+
125+minus, zero :: Word16
126+{-# INLINE minus #-}
127+{-# INLINE zero #-}
128+minus = 45
129+zero = 48
130+
131+i2w :: (Integral a) => a -> Word16
132+{-# INLINE i2w #-}
133+i2w v = zero + fromIntegral v
134+
135+countDigits :: (Integral a) => a -> Int
136+{-# INLINE countDigits #-}
137+countDigits v0
138+ | fromIntegral v64 == v0 = go 1 v64
139+ | otherwise = goBig 1 (fromIntegral v0)
140+ where v64 = fromIntegral v0
141+ goBig !k (v :: Integer)
142+ | v > big = goBig (k + 19) (v `quot` big)
143+ | otherwise = go k (fromIntegral v)
144+ big = 10000000000000000000
145+ go !k (v :: Word64)
146+ | v < 10 = k
147+ | v < 100 = k + 1
148+ | v < 1000 = k + 2
149+ | v < 1000000000000 =
150+ k + if v < 100000000
151+ then if v < 1000000
152+ then if v < 10000
153+ then 3
154+ else 4 + fin v 100000
155+ else 6 + fin v 10000000
156+ else if v < 10000000000
157+ then 8 + fin v 1000000000
158+ else 10 + fin v 100000000000
159+ | otherwise = go (k + 12) (v `quot` 1000000000000)
160+ fin v n = if v >= n then 1 else 0
91
161
92hexadecimal :: Integral a => a -> Builder
162hexadecimal :: Integral a => a -> Builder
93{-# SPECIALIZE hexadecimal :: Int -> Builder #-}
163{-# SPECIALIZE hexadecimal :: Int -> Builder #-}
@@ -100,18 +170,23 @@ hexadecimal :: Integral a => a -> Builder
100{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-}
170{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-}
101{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-}
171{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-}
102{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-}
172{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-}
103−{-# RULES "hexadecimal/Integer" hexadecimal = integer 16 :: Integer -> Builder #-}
173+{-# RULES "hexadecimal/Integer"
174+ hexadecimal = hexInteger :: Integer -> Builder #-}
104hexadecimal i
175hexadecimal i
105− | i < 0 = error msg
176+ | i < 0 = error hexErrMsg
106 | otherwise = go i
177 | otherwise = go i
107 where
178 where
108 go n | n < 16 = hexDigit n
179 go n | n < 16 = hexDigit n
109 | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)
180 | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)
110− msg = "Data.Text.Lazy.Builder.Int.hexadecimal: applied to negative number"
181+{-# NOINLINE[0] hexadecimal #-}
182+
183+hexInteger :: Integer -> Builder
184+hexInteger i
185+ | i < 0 = error hexErrMsg
186+ | otherwise = integer 16 i
111
187
112−digit :: Integral a => a -> Builder
188+hexErrMsg :: String
113−digit n = singleton $! i2d (fromIntegral n)
189+hexErrMsg = "Data.Text.Lazy.Builder.Int.hexadecimal: applied to negative number"
114−{-# INLINE digit #-}
115
190
116hexDigit :: Integral a => a -> Builder
191hexDigit :: Integral a => a -> Builder
117hexDigit n
192hexDigit n
@@ -119,19 +194,12 @@ hexDigit n
119 | otherwise = singleton $! toEnum (fromIntegral n + 87)
194 | otherwise = singleton $! toEnum (fromIntegral n + 87)
120{-# INLINE hexDigit #-}
195{-# INLINE hexDigit #-}
121
196
122−int :: Int -> Builder
123−int = decimal
124−{-# INLINE int #-}
125−
126data T = T !Integer !Int
197data T = T !Integer !Int
127
198
128integer :: Int -> Integer -> Builder
199integer :: Int -> Integer -> Builder
129#ifdef INTEGER_GMP
200#ifdef INTEGER_GMP
130integer 10 (S# i#) = decimal (I# i#)
201integer 10 (S# i#) = decimal (I# i#)
131integer 16 (S# i#) = hexadecimal (I# i#)
202integer 16 (S# i#) = hexadecimal (I# i#)
132−#else
133−integer 10 i = decimal i
134−integer 16 i = hexadecimal i
135#endif
203#endif
136integer base i
204integer base i
137 | i < 0 = singleton '-' <> go (-i)
205 | i < 0 = singleton '-' <> go (-i)
@@ -179,12 +247,16 @@ integer base i
179 PAIR(x,y) -> pblock q <> pblock r <> putB ns
247 PAIR(x,y) -> pblock q <> pblock r <> putB ns
180 where q = fromInteger x
248 where q = fromInteger x
181 r = fromInteger y
249 r = fromInteger y
182− putB _ = mempty
250+ putB _ = Data.Monoid.mempty
251+
252+ int :: Int -> Builder
253+ int x | base == 10 = decimal x
254+ | otherwise = hexadecimal x
183
255
184 pblock = loop maxDigits
256 pblock = loop maxDigits
185 where
257 where
186 loop !d !n
258 loop !d !n
187− | d == 1 = digit n
259+ | d == 1 = hexDigit n
188− | otherwise = loop (d-1) q <> digit r
260+ | otherwise = loop (d-1) q <> hexDigit r
189 where q = n `quotInt` base
261 where q = n `quotInt` base
190 r = n `remInt` base
262 r = n `remInt` base
Data/Text/Lazy/Builder/RealFloat.hs+6−3
@@ -1,4 +1,7 @@
1−{-# LANGUAGE OverloadedStrings #-}
1+{-# LANGUAGE CPP, OverloadedStrings #-}
2+#if __GLASGOW_HASKELL__ >= 702
3+{-# LANGUAGE Trustworthy #-}
4+#endif
2
5
3-- |
6-- |
4-- Module: Data.Text.Lazy.Builder.RealFloat
7-- Module: Data.Text.Lazy.Builder.RealFloat
@@ -16,9 +19,9 @@ module Data.Text.Lazy.Builder.RealFloat
16
19
17import Data.Array.Base (unsafeAt)
20import Data.Array.Base (unsafeAt)
18import Data.Array.IArray
21import Data.Array.IArray
19−import Data.Text.Lazy.Builder.Functions ((<>), i2d)
22+import Data.Text.Internal.Builder.Functions ((<>), i2d)
20import Data.Text.Lazy.Builder.Int (decimal)
23import Data.Text.Lazy.Builder.Int (decimal)
21−import Data.Text.Lazy.Builder.RealFloat.Functions (roundTo)
24+import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)
22import Data.Text.Lazy.Builder
25import Data.Text.Lazy.Builder
23import qualified Data.Text as T
26import qualified Data.Text as T
24
27
Data/Text/Lazy/Builder/RealFloat/Functions.hsdeleted−25
@@ -1,25 +0,0 @@
1−-- |
2−-- Module: Data.Text.Lazy.Builder.RealFloat.Functions
3−-- Copyright: (c) The University of Glasgow 1994-2002
4−-- License: see libraries/base/LICENSE
5−
6−module Data.Text.Lazy.Builder.RealFloat.Functions
7− (
8− roundTo
9− ) where
10−
11−roundTo :: Int -> [Int] -> (Int,[Int])
12−roundTo d is =
13− case f d is of
14− x@(0,_) -> x
15− (1,xs) -> (1, 1:xs)
16− _ -> error "roundTo: bad Value"
17− where
18− f n [] = (0, replicate n 0)
19− f 0 (x:_) = (if x >= 5 then 1 else 0, [])
20− f n (i:xs)
21− | i' == 10 = (1,0:ds)
22− | otherwise = (0,i':ds)
23− where
24− (c,ds) = f (n-1) xs
25− i' = c + i
Data/Text/Lazy/Encoding.hs+48−46
@@ -7,8 +7,7 @@
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, rtomharper@googlemail.com,
10+-- Maintainer : bos@serpentine.com
11−-- duncan@haskell.org
12-- Stability : experimental
11-- Stability : experimental
13-- Portability : portable
12-- Portability : portable
14--
13--
@@ -46,21 +45,29 @@ module Data.Text.Lazy.Encoding
46 , encodeUtf16BE
45 , encodeUtf16BE
47 , encodeUtf32LE
46 , encodeUtf32LE
48 , encodeUtf32BE
47 , encodeUtf32BE
48+
49+ -- * Encoding Text using ByteString Builders
50+ , encodeUtf8Builder
51+ , encodeUtf8BuilderEscaped
49 ) where
52 ) where
50
53
51import Control.Exception (evaluate, try)
54import Control.Exception (evaluate, try)
52−import Data.Bits ((.&.))
55+import Data.Monoid (Monoid(..))
53import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
56import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
54−import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldrChunks)
57+import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldrChunks)
55−import System.IO.Unsafe (unsafePerformIO)
58+import Data.Word (Word8)
56import qualified Data.ByteString as S
59import qualified Data.ByteString as S
60+import qualified Data.ByteString.Builder as B
61+import qualified Data.ByteString.Builder.Extra as B (safeStrategy, toLazyByteStringWith)
62+import qualified Data.ByteString.Builder.Prim as BP
57import qualified Data.ByteString.Lazy as B
63import qualified Data.ByteString.Lazy as B
58import qualified Data.ByteString.Lazy.Internal as B
64import qualified Data.ByteString.Lazy.Internal as B
59−import qualified Data.ByteString.Unsafe as S
65+import qualified Data.ByteString.Unsafe as B
60import qualified Data.Text as T
66import qualified Data.Text as T
61import qualified Data.Text.Encoding as TE
67import qualified Data.Text.Encoding as TE
62−import qualified Data.Text.Lazy.Encoding.Fusion as E
68+import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E
63−import qualified Data.Text.Lazy.Fusion as F
69+import qualified Data.Text.Internal.Lazy.Fusion as F
70+import Data.Text.Unsafe (unsafeDupablePerformIO)
64
71
65-- $strict
72-- $strict
66--
73--
@@ -77,8 +84,6 @@ import qualified Data.Text.Lazy.Fusion as F
77
84
78-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
85-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
79-- encoded text.
86-- encoded text.
80−--
81−-- This function is deprecated. Use 'decodeLatin1' instead.
82decodeASCII :: B.ByteString -> Text
87decodeASCII :: B.ByteString -> Text
83decodeASCII = decodeUtf8
88decodeASCII = decodeUtf8
84{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
89{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
@@ -89,41 +94,20 @@ decodeLatin1 = foldr (chunk . TE.decodeLatin1) empty . B.toChunks
89
94
90-- | Decode a 'ByteString' containing UTF-8 encoded text.
95-- | Decode a 'ByteString' containing UTF-8 encoded text.
91decodeUtf8With :: OnDecodeError -> B.ByteString -> Text
96decodeUtf8With :: OnDecodeError -> B.ByteString -> Text
92−decodeUtf8With onErr bs0 = fast bs0
97+decodeUtf8With onErr (B.Chunk b0 bs0) =
98+ case TE.streamDecodeUtf8With onErr b0 of
99+ TE.Some t l f -> chunk t (go f l bs0)
93 where
100 where
94− decode = TE.decodeUtf8With onErr
101+ go f0 _ (B.Chunk b bs) =
95− fast (B.Chunk p ps) | isComplete p = chunk (decode p) (fast ps)
102+ case f0 b of
96− | otherwise = chunk (decode h) (slow t ps)
103+ TE.Some t l f -> chunk t (go f l bs)
97− where (h,t) = S.splitAt pivot p
104+ go _ l _
98− pivot | at 1 = len-1
105+ | S.null l = empty
99− | at 2 = len-2
106+ | otherwise = case onErr desc (Just (B.unsafeHead l)) of
100− | otherwise = len-3
107+ Nothing -> empty
101− len = S.length p
108+ Just c -> Chunk (T.singleton c) Empty
102− at n = len >= n && S.unsafeIndex p (len-n) .&. 0xc0 == 0xc0
103− fast B.Empty = empty
104− slow i bs = {-# SCC "decodeUtf8With'/slow" #-}
105− case B.uncons bs of
106− Just (w,bs') | isComplete i' -> chunk (decode i') (fast bs')
107− | otherwise -> slow i' bs'
108− where i' = S.snoc i w
109− Nothing -> case S.uncons i of
110− Just (j,i') ->
111− case onErr desc (Just j) of
112− Nothing -> slow i' bs
113− Just c -> Chunk (T.singleton c) (slow i' bs)
114− Nothing ->
115− case onErr desc Nothing of
116− Nothing -> empty
117− Just c -> Chunk (T.singleton c) empty
118− isComplete bs = {-# SCC "decodeUtf8With'/isComplete" #-}
119− ix 1 .&. 0x80 == 0 ||
120− (len >= 2 && ix 2 .&. 0xe0 == 0xc0) ||
121− (len >= 3 && ix 3 .&. 0xf0 == 0xe0) ||
122− (len >= 4 && ix 4 .&. 0xf8 == 0xf0)
123− where len = S.length bs
124− ix n = S.unsafeIndex bs (len-n)
125 desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"
109 desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"
126−{-# INLINE[0] decodeUtf8With #-}
110+decodeUtf8With _ _ = empty
127
111
128-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
112-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
129-- to be valid.
113-- to be valid.
@@ -149,7 +133,7 @@ decodeUtf8 = decodeUtf8With strictDecode
149-- input before it can return a result. If you need lazy (streaming)
133-- input before it can return a result. If you need lazy (streaming)
150-- decoding, use 'decodeUtf8With' in lenient mode.
134-- decoding, use 'decodeUtf8With' in lenient mode.
151decodeUtf8' :: B.ByteString -> Either UnicodeException Text
135decodeUtf8' :: B.ByteString -> Either UnicodeException Text
152−decodeUtf8' bs = unsafePerformIO $ do
136+decodeUtf8' bs = unsafeDupablePerformIO $ do
153 let t = decodeUtf8 bs
137 let t = decodeUtf8 bs
154 try (evaluate (rnf t `seq` t))
138 try (evaluate (rnf t `seq` t))
155 where
139 where
@@ -158,8 +142,26 @@ decodeUtf8' bs = unsafePerformIO $ do
158{-# INLINE decodeUtf8' #-}
142{-# INLINE decodeUtf8' #-}
159
143
160encodeUtf8 :: Text -> B.ByteString
144encodeUtf8 :: Text -> B.ByteString
161−encodeUtf8 (Chunk c cs) = B.Chunk (TE.encodeUtf8 c) (encodeUtf8 cs)
145+encodeUtf8 Empty = B.empty
162−encodeUtf8 Empty = B.Empty
146+encodeUtf8 lt@(Chunk t _) =
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
163
165
164-- | Decode text from little endian UTF-16 encoding.
166-- | Decode text from little endian UTF-16 encoding.
165decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text
167decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text
Data/Text/Lazy/IO.hs+2−16
@@ -47,16 +47,11 @@ import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,
47 withFile)
47 withFile)
48import qualified Data.Text.IO as T
48import qualified Data.Text.IO as T
49import qualified Data.Text.Lazy as L
49import qualified Data.Text.Lazy as L
50−#if __GLASGOW_HASKELL__ <= 610
51−import Data.Text.Lazy.Encoding (decodeUtf8)
52−import qualified Data.ByteString.Char8 as S8
53−import qualified Data.ByteString.Lazy.Char8 as L8
54−#else
55import qualified Control.Exception as E
50import qualified Control.Exception as E
56import Control.Monad (when)
51import Control.Monad (when)
57import Data.IORef (readIORef)
52import Data.IORef (readIORef)
58−import Data.Text.IO.Internal (hGetLineWith, readChunk)
53+import Data.Text.Internal.IO (hGetLineWith, readChunk)
59−import Data.Text.Lazy.Internal (chunk, empty)
54+import Data.Text.Internal.Lazy (chunk, empty)
60import GHC.IO.Buffer (isEmptyBuffer)
55import GHC.IO.Buffer (isEmptyBuffer)
61import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException)
56import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException)
62import GHC.IO.Handle.Internals (augmentIOError, hClose_help,
57import GHC.IO.Handle.Internals (augmentIOError, hClose_help,
@@ -65,7 +60,6 @@ import GHC.IO.Handle.Types (Handle__(..), HandleType(..))
65import System.IO (BufferMode(..), hGetBuffering, hSetBuffering)
60import System.IO (BufferMode(..), hGetBuffering, hSetBuffering)
66import System.IO.Error (isEOFError)
61import System.IO.Error (isEOFError)
67import System.IO.Unsafe (unsafeInterleaveIO)
62import System.IO.Unsafe (unsafeInterleaveIO)
68−#endif
69
63
70-- $performance
64-- $performance
71--
65--
@@ -99,9 +93,6 @@ appendFile p = withFile p AppendMode . flip hPutStr
99-- | Lazily read the remaining contents of a 'Handle'. The 'Handle'
93-- | Lazily read the remaining contents of a 'Handle'. The 'Handle'
100-- will be closed after the read completes, or on error.
94-- will be closed after the read completes, or on error.
101hGetContents :: Handle -> IO Text
95hGetContents :: Handle -> IO Text
102−#if __GLASGOW_HASKELL__ <= 610
103−hGetContents = fmap decodeUtf8 . L8.hGetContents
104−#else
105hGetContents h = do
96hGetContents h = do
106 chooseGoodBuffering h
97 chooseGoodBuffering h
107 wantReadableHandle "hGetContents" h $ \hh -> do
98 wantReadableHandle "hGetContents" h $ \hh -> do
@@ -138,15 +129,10 @@ lazyReadBuffered h hh@Handle__{..} = do
138 then (hh', empty)
129 then (hh', empty)
139 else (hh', L.singleton '\r')
130 else (hh', L.singleton '\r')
140 else E.throwIO (augmentIOError e "hGetContents" h)
131 else E.throwIO (augmentIOError e "hGetContents" h)
141−#endif
142
132
143-- | Read a single line from a handle.
133-- | Read a single line from a handle.
144hGetLine :: Handle -> IO Text
134hGetLine :: Handle -> IO Text
145−#if __GLASGOW_HASKELL__ <= 610
146−hGetLine = fmap (decodeUtf8 . L8.fromChunks . (:[])) . S8.hGetLine
147−#else
148hGetLine = hGetLineWith L.fromChunks
135hGetLine = hGetLineWith L.fromChunks
149−#endif
150
136
151-- | Write a string to a handle.
137-- | Write a string to a handle.
152hPutStr :: Handle -> Text -> IO ()
138hPutStr :: Handle -> Text -> IO ()
Data/Text/Lazy/Internal.hs+7−105
@@ -1,118 +1,20 @@
1{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
1{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
2-- |
2-- |
3-- Module : Data.Text.Lazy.Internal
3-- Module : Data.Text.Lazy.Internal
4−-- Copyright : (c) 2009, 2010 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, rtomharper@googlemail.com,
7+-- Maintainer : bos@serpentine.com
8−-- duncan@haskell.org
9-- Stability : experimental
8-- Stability : experimental
10-- Portability : GHC
9-- Portability : GHC
11--
10--
12−-- A module containing private 'Text' internals. This exposes the
11+-- This module has been renamed to 'Data.Text.Internal.Lazy'. This
13−-- 'Text' representation and low level construction functions.
12+-- name for the module will be removed in the next major release.
14−-- Modules which extend the 'Text' system may need to use this module.
15−--
16−-- You should not use this module unless you are determined to monkey
17−-- with the internals, as the functions here do just about nothing to
18−-- preserve data invariants. You have been warned!
19
13
20module Data.Text.Lazy.Internal
14module Data.Text.Lazy.Internal
15+ {-# DEPRECATED "Use Data.Text.Internal.Lazy instead" #-}
21 (
16 (
22− Text(..)
17+ module Data.Text.Internal.Lazy
23− , chunk
24− , empty
25− , foldrChunks
26− , foldlChunks
27− -- * Data type invariant and abstraction functions
28−
29− -- $invariant
30− , strictInvariant
31− , lazyInvariant
32− , showStructure
33−
34− -- * Chunk allocation sizes
35− , defaultChunkSize
36− , smallChunkSize
37− , chunkOverhead
38 ) where
18 ) where
39
19
40−import Data.Text ()
20+import Data.Text.Internal.Lazy
41−import Data.Text.UnsafeShift (shiftL)
42−import Data.Typeable (Typeable)
43−import Foreign.Storable (sizeOf)
44−import qualified Data.Text.Internal as T
45−
46−data Text = Empty
47− | Chunk {-# UNPACK #-} !T.Text Text
48− deriving (Typeable)
49−
50−-- $invariant
51−--
52−-- The data type invariant for lazy 'Text': Every 'Text' is either 'Empty' or
53−-- consists of non-null 'T.Text's. All functions must preserve this,
54−-- and the QC properties must check this.
55−
56−-- | Check the invariant strictly.
57−strictInvariant :: Text -> Bool
58−strictInvariant Empty = True
59−strictInvariant x@(Chunk (T.Text _ _ len) cs)
60− | len > 0 = strictInvariant cs
61− | otherwise = error $ "Data.Text.Lazy: invariant violation: "
62− ++ showStructure x
63−
64−-- | Check the invariant lazily.
65−lazyInvariant :: Text -> Text
66−lazyInvariant Empty = Empty
67−lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)
68− | len > 0 = Chunk c (lazyInvariant cs)
69− | otherwise = error $ "Data.Text.Lazy: invariant violation: "
70− ++ showStructure x
71−
72−-- | Display the internal structure of a lazy 'Text'.
73−showStructure :: Text -> String
74−showStructure Empty = "Empty"
75−showStructure (Chunk t Empty) = "Chunk " ++ show t ++ " Empty"
76−showStructure (Chunk t ts) =
77− "Chunk " ++ show t ++ " (" ++ showStructure ts ++ ")"
78−
79−-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.
80−chunk :: T.Text -> Text -> Text
81−{-# INLINE chunk #-}
82−chunk t@(T.Text _ _ len) ts | len == 0 = ts
83− | otherwise = Chunk t ts
84−
85−-- | Smart constructor for 'Empty'.
86−empty :: Text
87−{-# INLINE [0] empty #-}
88−empty = Empty
89−
90−-- | Consume the chunks of a lazy 'Text' with a natural right fold.
91−foldrChunks :: (T.Text -> a -> a) -> a -> Text -> a
92−foldrChunks f z = go
93− where go Empty = z
94− go (Chunk c cs) = f c (go cs)
95−{-# INLINE foldrChunks #-}
96−
97−-- | Consume the chunks of a lazy 'Text' with a strict, tail-recursive,
98−-- accumulating left fold.
99−foldlChunks :: (a -> T.Text -> a) -> a -> Text -> a
100−foldlChunks f z = go z
101− where go !a Empty = a
102− go !a (Chunk c cs) = go (f a c) cs
103−{-# INLINE foldlChunks #-}
104−
105−-- | Currently set to 16 KiB, less the memory management overhead.
106−defaultChunkSize :: Int
107−defaultChunkSize = 16384 - chunkOverhead
108−{-# INLINE defaultChunkSize #-}
109−
110−-- | Currently set to 128 bytes, less the memory management overhead.
111−smallChunkSize :: Int
112−smallChunkSize = 128 - chunkOverhead
113−{-# INLINE smallChunkSize #-}
114−
115−-- | The memory management overhead. Currently this is tuned for GHC only.
116−chunkOverhead :: Int
117−chunkOverhead = sizeOf (undefined :: Int) `shiftL` 1
118−{-# INLINE chunkOverhead #-}
Data/Text/Lazy/Read.hs+8−33
@@ -1,5 +1,7 @@
1{-# LANGUAGE OverloadedStrings, CPP #-}
1{-# LANGUAGE OverloadedStrings, CPP #-}
2−#if __GLASGOW_HASKELL__ >= 702
2+#if __GLASGOW_HASKELL__ >= 704
3+{-# LANGUAGE Safe #-}
4+#elif __GLASGOW_HASKELL__ >= 702
3{-# LANGUAGE Trustworthy #-}
5{-# LANGUAGE Trustworthy #-}
4#endif
6#endif
5
7
@@ -24,15 +26,17 @@ module Data.Text.Lazy.Read
24 ) where
26 ) where
25
27
26import Control.Monad (liftM)
28import Control.Monad (liftM)
27−import Data.Char (isDigit, isHexDigit, ord)
29+import Data.Char (isDigit, isHexDigit)
28import Data.Int (Int8, Int16, Int32, Int64)
30import Data.Int (Int8, Int16, Int32, Int64)
29import Data.Ratio ((%))
31import Data.Ratio ((%))
32+import Data.Text.Internal.Read
30import Data.Text.Lazy as T
33import Data.Text.Lazy as T
31import Data.Word (Word, Word8, Word16, Word32, Word64)
34import Data.Word (Word, Word8, Word16, Word32, Word64)
32
35
33-- | Read some text. If the read succeeds, return its value and the
36-- | Read some text. If the read succeeds, return its value and the
34-- remaining text, otherwise an error message.
37-- remaining text, otherwise an error message.
35−type Reader a = Text -> Either String (a,Text)
38+type Reader a = IReader Text a
39+type Parser = IParser Text
36
40
37-- | Read a decimal integer. The input must begin with at least one
41-- | Read a decimal integer. The input must begin with at least one
38-- decimal digit, and is consumed until a non-digit or end of string
42-- decimal digit, and is consumed until a non-digit or end of string
@@ -52,7 +56,7 @@ decimal :: Integral a => Reader a
52{-# SPECIALIZE decimal :: Reader Int32 #-}
56{-# SPECIALIZE decimal :: Reader Int32 #-}
53{-# SPECIALIZE decimal :: Reader Int64 #-}
57{-# SPECIALIZE decimal :: Reader Int64 #-}
54{-# SPECIALIZE decimal :: Reader Integer #-}
58{-# SPECIALIZE decimal :: Reader Integer #-}
55−{-# SPECIALIZE decimal :: Reader Word #-}
59+{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}
56{-# SPECIALIZE decimal :: Reader Word8 #-}
60{-# SPECIALIZE decimal :: Reader Word8 #-}
57{-# SPECIALIZE decimal :: Reader Word16 #-}
61{-# SPECIALIZE decimal :: Reader Word16 #-}
58{-# SPECIALIZE decimal :: Reader Word32 #-}
62{-# SPECIALIZE decimal :: Reader Word32 #-}
@@ -101,15 +105,6 @@ hex txt
101 where (h,t) = T.span isHexDigit txt
105 where (h,t) = T.span isHexDigit txt
102 go n d = (n * 16 + fromIntegral (hexDigitToInt d))
106 go n d = (n * 16 + fromIntegral (hexDigitToInt d))
103
107
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−
113-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and
108-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and
114-- apply it to the result of applying the given reader.
109-- apply it to the result of applying the given reader.
115signed :: Num a => Reader a -> Reader a
110signed :: Num a => Reader a -> Reader a
@@ -169,31 +164,11 @@ signa p = do
169 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
164 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
170 if sign == '+' then p else negate `liftM` p
165 if sign == '+' then p else negate `liftM` p
171
166
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−
190char :: (Char -> Bool) -> Parser Char
167char :: (Char -> Bool) -> Parser Char
191char p = P $ \t -> case T.uncons t of
168char p = P $ \t -> case T.uncons t of
192 Just (c,t') | p c -> Right (c,t')
169 Just (c,t') | p c -> Right (c,t')
193 _ -> Left "character does not match"
170 _ -> Left "character does not match"
194
171
195−data T = T !Integer !Int
196−
197floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a
172floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a
198{-# INLINE floaty #-}
173{-# INLINE floaty #-}
199floaty f = runP $ do
174floaty f = runP $ do
Data/Text/Read.hs+6−33
@@ -24,16 +24,18 @@ module Data.Text.Read
24 ) where
24 ) where
25
25
26import Control.Monad (liftM)
26import Control.Monad (liftM)
27−import Data.Char (isDigit, isHexDigit, ord)
27+import Data.Char (isDigit, isHexDigit)
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
31−import Data.Text.Private (span_)
31+import Data.Text.Internal.Private (span_)
32+import Data.Text.Internal.Read
32import Data.Word (Word, Word8, Word16, Word32, Word64)
33import Data.Word (Word, Word8, Word16, Word32, Word64)
33
34
34-- | Read some text. If the read succeeds, return its value and the
35-- | Read some text. If the read succeeds, return its value and the
35-- remaining text, otherwise an error message.
36-- remaining text, otherwise an error message.
36−type Reader a = Text -> Either String (a,Text)
37+type Reader a = IReader Text a
38+type Parser a = IParser Text a
37
39
38-- | Read a decimal integer. The input must begin with at least one
40-- | Read a decimal integer. The input must begin with at least one
39-- decimal digit, and is consumed until a non-digit or end of string
41-- decimal digit, and is consumed until a non-digit or end of string
@@ -53,7 +55,7 @@ decimal :: Integral a => Reader a
53{-# SPECIALIZE decimal :: Reader Int32 #-}
55{-# SPECIALIZE decimal :: Reader Int32 #-}
54{-# SPECIALIZE decimal :: Reader Int64 #-}
56{-# SPECIALIZE decimal :: Reader Int64 #-}
55{-# SPECIALIZE decimal :: Reader Integer #-}
57{-# SPECIALIZE decimal :: Reader Integer #-}
56−{-# SPECIALIZE decimal :: Reader Word #-}
58+{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}
57{-# SPECIALIZE decimal :: Reader Word8 #-}
59{-# SPECIALIZE decimal :: Reader Word8 #-}
58{-# SPECIALIZE decimal :: Reader Word16 #-}
60{-# SPECIALIZE decimal :: Reader Word16 #-}
59{-# SPECIALIZE decimal :: Reader Word32 #-}
61{-# SPECIALIZE decimal :: Reader Word32 #-}
@@ -111,15 +113,6 @@ hex txt
111 where (# h,t #) = span_ isHexDigit txt
113 where (# h,t #) = span_ isHexDigit txt
112 go n d = (n * 16 + fromIntegral (hexDigitToInt d))
114 go n d = (n * 16 + fromIntegral (hexDigitToInt d))
113
115
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−
123-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and
116-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and
124-- apply it to the result of applying the given reader.
117-- apply it to the result of applying the given reader.
125signed :: Num a => Reader a -> Reader a
118signed :: Num a => Reader a -> Reader a
@@ -179,31 +172,11 @@ signa p = do
179 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
172 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
180 if sign == '+' then p else negate `liftM` p
173 if sign == '+' then p else negate `liftM` p
181
174
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−
200char :: (Char -> Bool) -> Parser Char
175char :: (Char -> Bool) -> Parser Char
201char p = P $ \t -> case T.uncons t of
176char p = P $ \t -> case T.uncons t of
202 Just (c,t') | p c -> Right (c,t')
177 Just (c,t') | p c -> Right (c,t')
203 _ -> Left "character does not match"
178 _ -> Left "character does not match"
204
179
205−data T = T !Integer !Int
206−
207floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a
180floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a
208{-# INLINE floaty #-}
181{-# INLINE floaty #-}
209floaty f = runP $ do
182floaty f = runP $ do
Data/Text/Show.hsnew file+89
@@ -0,0 +1,89 @@
1+{-# LANGUAGE CPP, MagicHash #-}
2+{-# OPTIONS_GHC -fno-warn-orphans #-}
3+#if __GLASGOW_HASKELL__ >= 702
4+{-# LANGUAGE Trustworthy #-}
5+#endif
6+
7+-- |
8+-- Module : Data.Text.Show
9+-- Copyright : (c) 2009-2015 Bryan O'Sullivan
10+--
11+-- License : BSD-style
12+-- Maintainer : bos@serpentine.com
13+-- Stability : experimental
14+-- Portability : GHC
15+
16+module Data.Text.Show
17+ (
18+ singleton
19+ , unpack
20+ , unpackCString#
21+ ) where
22+
23+import Control.Monad.ST (ST)
24+import Data.Text.Internal (Text(..), empty_, safe)
25+import Data.Text.Internal.Fusion (stream, unstream)
26+import Data.Text.Internal.Unsafe.Char (unsafeWrite)
27+import GHC.Prim (Addr#)
28+import qualified Data.Text.Array as A
29+import qualified Data.Text.Internal.Fusion.Common as S
30+
31+#if __GLASGOW_HASKELL__ >= 702
32+import qualified GHC.CString as GHC
33+#else
34+import qualified GHC.Base as GHC
35+#endif
36+
37+instance Show Text where
38+ showsPrec p ps r = showsPrec p (unpack ps) r
39+
40+-- | /O(n)/ Convert a 'Text' into a 'String'. Subject to fusion.
41+unpack :: Text -> String
42+unpack = S.unstreamList . stream
43+{-# INLINE [1] unpack #-}
44+
45+-- | /O(n)/ Convert a literal string into a 'Text'. Subject to
46+-- fusion.
47+--
48+-- This is exposed solely for people writing GHC rewrite rules.
49+unpackCString# :: Addr# -> Text
50+unpackCString# addr# = unstream (S.streamCString# addr#)
51+{-# NOINLINE unpackCString# #-}
52+
53+{-# RULES "TEXT literal" [1] forall a.
54+ unstream (S.map safe (S.streamList (GHC.unpackCString# a)))
55+ = unpackCString# a #-}
56+
57+{-# RULES "TEXT literal UTF8" [1] forall a.
58+ unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))
59+ = unpackCString# a #-}
60+
61+{-# RULES "TEXT empty literal" [1]
62+ unstream (S.map safe (S.streamList []))
63+ = empty_ #-}
64+
65+{-# RULES "TEXT singleton literal" [1] forall a.
66+ unstream (S.map safe (S.streamList [a]))
67+ = singleton_ a #-}
68+
69+-- | /O(1)/ Convert a character into a Text. Subject to fusion.
70+-- Performs replacement on invalid scalar values.
71+singleton :: Char -> Text
72+singleton = unstream . S.singleton . safe
73+{-# INLINE [1] singleton #-}
74+
75+{-# RULES "TEXT singleton" forall a.
76+ unstream (S.singleton (safe a))
77+ = singleton_ a #-}
78+
79+-- This is intended to reduce inlining bloat.
80+singleton_ :: Char -> Text
81+singleton_ c = Text (A.run x) 0 len
82+ where x :: ST s (A.MArray s)
83+ x = do arr <- A.new len
84+ _ <- unsafeWrite arr 0 d
85+ return arr
86+ len | d < '\x10000' = 1
87+ | otherwise = 2
88+ d = safe c
89+{-# NOINLINE singleton_ #-}
Data/Text/Unsafe.hs+18−6
@@ -3,8 +3,7 @@
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, rtomharper@googlemail.com,
6+-- Maintainer : bos@serpentine.com
7−-- duncan@haskell.org
8-- Stability : experimental
7-- Stability : experimental
9-- Portability : portable
8-- Portability : portable
10--
9--
@@ -14,10 +13,12 @@ module Data.Text.Unsafe
14 (
13 (
15 inlineInterleaveST
14 inlineInterleaveST
16 , inlinePerformIO
15 , inlinePerformIO
16+ , unsafeDupablePerformIO
17 , Iter(..)
17 , Iter(..)
18 , iter
18 , iter
19 , iter_
19 , iter_
20 , reverseIter
20 , reverseIter
21+ , reverseIter_
21 , unsafeHead
22 , unsafeHead
22 , unsafeTail
23 , unsafeTail
23 , lengthWord16
24 , lengthWord16
@@ -28,11 +29,12 @@ module Data.Text.Unsafe
28#if defined(ASSERTS)
29#if defined(ASSERTS)
29import Control.Exception (assert)
30import Control.Exception (assert)
30#endif
31#endif
31−import Data.Text.Encoding.Utf16 (chr2)
32+import Data.Text.Internal.Encoding.Utf16 (chr2)
32import Data.Text.Internal (Text(..))
33import Data.Text.Internal (Text(..))
33−import Data.Text.Unsafe.Base (inlineInterleaveST, inlinePerformIO)
34+import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)
34−import Data.Text.UnsafeChar (unsafeChr)
35+import Data.Text.Internal.Unsafe.Char (unsafeChr)
35import qualified Data.Text.Array as A
36import qualified Data.Text.Array as A
37+import GHC.IO (unsafeDupablePerformIO)
36
38
37-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'
39-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'
38-- omits the check for the empty case, so there is an obligation on
40-- omits the check for the empty case, so there is an obligation on
@@ -45,7 +47,7 @@ unsafeHead (Text arr off _len)
45 n = A.unsafeIndex arr (off+1)
47 n = A.unsafeIndex arr (off+1)
46{-# INLINE unsafeHead #-}
48{-# INLINE unsafeHead #-}
47
49
48−-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeHead'
50+-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'
49-- omits the check for the empty case, so there is an obligation on
51-- omits the check for the empty case, so there is an obligation on
50-- the programmer to provide a proof that the 'Text' is non-empty.
52-- the programmer to provide a proof that the 'Text' is non-empty.
51unsafeTail :: Text -> Text
53unsafeTail :: Text -> Text
@@ -93,6 +95,16 @@ reverseIter (Text arr off _len) i
93 k = j - 1
95 k = j - 1
94{-# INLINE reverseIter #-}
96{-# INLINE reverseIter #-}
95
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+
96-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
108-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
97-- is useful for sizing a target array appropriately before using
109-- is useful for sizing a target array appropriately before using
98-- 'unsafeCopyToPtr'.
110-- 'unsafeCopyToPtr'.
benchmarks/haskell/Benchmarks.hs+7−1
@@ -15,6 +15,7 @@ import qualified Benchmarks.EncodeUtf8 as EncodeUtf8
15import qualified Benchmarks.Equality as Equality
15import qualified Benchmarks.Equality as Equality
16import qualified Benchmarks.FileRead as FileRead
16import qualified Benchmarks.FileRead as FileRead
17import qualified Benchmarks.FoldLines as FoldLines
17import qualified Benchmarks.FoldLines as FoldLines
18+import qualified Benchmarks.Mul as Mul
18import qualified Benchmarks.Pure as Pure
19import qualified Benchmarks.Pure as Pure
19import qualified Benchmarks.ReadNumbers as ReadNumbers
20import qualified Benchmarks.ReadNumbers as ReadNumbers
20import qualified Benchmarks.Replace as Replace
21import qualified Benchmarks.Replace as Replace
@@ -49,7 +50,12 @@ benchmarks = do
49 , Equality.benchmark (tf "japanese.txt")
50 , Equality.benchmark (tf "japanese.txt")
50 , FileRead.benchmark (tf "russian.txt")
51 , FileRead.benchmark (tf "russian.txt")
51 , FoldLines.benchmark (tf "russian.txt")
52 , FoldLines.benchmark (tf "russian.txt")
53+ , Mul.benchmark
52− , Pure.benchmark (tf "japanese.txt")
54+ , 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 , ReadNumbers.benchmark (tf "numbers.txt")
59 , ReadNumbers.benchmark (tf "numbers.txt")
54 , Replace.benchmark (tf "russian.txt") "принимая" "своем"
60 , Replace.benchmark (tf "russian.txt") "принимая" "своем"
55 , Search.benchmark (tf "russian.txt") "принимая"
61 , Search.benchmark (tf "russian.txt") "принимая"
benchmarks/haskell/Benchmarks/Builder.hs+36−9
@@ -12,7 +12,7 @@ module Benchmarks.Builder
12import Criterion (Benchmark, bgroup, bench, nf)
12import Criterion (Benchmark, bgroup, bench, nf)
13import Data.Binary.Builder as B
13import Data.Binary.Builder as B
14import Data.ByteString.Char8 ()
14import Data.ByteString.Char8 ()
15−import Data.Monoid (mconcat)
15+import Data.Monoid (mconcat, mempty)
16import qualified Blaze.ByteString.Builder as Blaze
16import qualified Blaze.ByteString.Builder as Blaze
17import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze
17import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze
18import qualified Data.ByteString as SB
18import qualified Data.ByteString as SB
@@ -20,18 +20,45 @@ import qualified Data.ByteString.Lazy as LB
20import qualified Data.Text as T
20import qualified Data.Text as T
21import qualified Data.Text.Lazy as LT
21import qualified Data.Text.Lazy as LT
22import qualified Data.Text.Lazy.Builder as LTB
22import qualified Data.Text.Lazy.Builder as LTB
23+import qualified Data.Text.Lazy.Builder.Int as Int
24+import Data.Int (Int64)
23
25
24benchmark :: IO Benchmark
26benchmark :: IO Benchmark
25benchmark = return $ bgroup "Builder"
27benchmark = return $ bgroup "Builder"
28+ [ bgroup "Comparison"
26− [ bench "LazyText" $ nf
29+ [ bench "LazyText" $ nf
27− (LT.length . LTB.toLazyText . mconcat . map LTB.fromText) texts
30+ (LT.length . LTB.toLazyText . mconcat . map LTB.fromText) texts
28− , bench "Binary" $ nf
31+ , bench "Binary" $ nf
29− (LB.length . B.toLazyByteString . mconcat . map B.fromByteString)
32+ (LB.length . B.toLazyByteString . mconcat . map B.fromByteString)
30− byteStrings
33+ byteStrings
31− , bench "Blaze" $ nf
34+ , bench "Blaze" $ nf
32− (LB.length . Blaze.toLazyByteString . mconcat . map Blaze.fromString)
35+ (LB.length . Blaze.toLazyByteString . mconcat . map Blaze.fromString)
33− strings
36+ strings
37+ ]
38+ , bgroup "Int"
39+ [ bgroup "Decimal"
40+ [ bgroup "Positive" .
41+ flip map numbers $ \n ->
42+ (bench (show (length (show n))) $ nf (LTB.toLazyText . Int.decimal) n)
43+ , bgroup "Negative" .
44+ flip map numbers $ \m ->
45+ let n = negate m in
46+ (bench (show (length (show n))) $ nf (LTB.toLazyText . Int.decimal) n)
47+ , bench "Empty" $ nf LTB.toLazyText mempty
48+ , bgroup "Show" .
49+ flip map numbers $ \n ->
50+ (bench (show (length (show n))) $ nf show n)
51+ ]
52+ ]
34 ]
53 ]
54+ where
55+ numbers :: [Int64]
56+ numbers = [
57+ 6, 14, 500, 9688, 10654, 620735, 5608880, 37010612,
58+ 731223504, 5061580596, 24596952933, 711732309084, 2845910093839,
59+ 54601756118340, 735159434806159, 3619097625502435, 95777227510267124,
60+ 414944309510675693, 8986407456998704019
61+ ]
35
62
36texts :: [T.Text]
63texts :: [T.Text]
37texts = take 200000 $ cycle ["foo", "λx", "由の"]
64texts = take 200000 $ cycle ["foo", "λx", "由の"]
benchmarks/haskell/Benchmarks/DecodeUtf8.hs+11−3
@@ -20,11 +20,12 @@ module Benchmarks.DecodeUtf8
20
20
21import Foreign.C.Types
21import Foreign.C.Types
22import Data.ByteString.Internal (ByteString(..))
22import Data.ByteString.Internal (ByteString(..))
23+import Data.ByteString.Lazy.Internal (ByteString(..))
23import Foreign.Ptr (Ptr, plusPtr)
24import Foreign.Ptr (Ptr, plusPtr)
24import Foreign.ForeignPtr (withForeignPtr)
25import Foreign.ForeignPtr (withForeignPtr)
25import Data.Word (Word8)
26import Data.Word (Word8)
26import qualified Criterion as C
27import qualified Criterion as C
27−import Criterion (Benchmark, bgroup, nf)
28+import Criterion (Benchmark, bgroup, nf, whnfIO)
28import qualified Codec.Binary.UTF8.Generic as U8
29import qualified Codec.Binary.UTF8.Generic as U8
29import qualified Data.ByteString as B
30import qualified Data.ByteString as B
30import qualified Data.ByteString.Lazy as BL
31import qualified Data.ByteString.Lazy as BL
@@ -38,9 +39,16 @@ benchmark kind fp = do
38 bs <- B.readFile fp
39 bs <- B.readFile fp
39 lbs <- BL.readFile fp
40 lbs <- BL.readFile fp
40 let bench name = C.bench (name ++ "+" ++ kind)
41 let bench name = C.bench (name ++ "+" ++ kind)
42+ decodeStream (Chunk b0 bs0) = case T.streamDecodeUtf8 b0 of
43+ T.Some t0 _ f0 -> t0 : go f0 bs0
44+ where go f (Chunk b bs1) = case f b of
45+ T.Some t1 _ f1 -> t1 : go f1 bs1
46+ go _ _ = []
47+ decodeStream _ = []
41 return $ bgroup "DecodeUtf8"
48 return $ bgroup "DecodeUtf8"
42 [ bench "Strict" $ nf T.decodeUtf8 bs
49 [ bench "Strict" $ nf T.decodeUtf8 bs
50+ , bench "Stream" $ nf decodeStream lbs
43− , bench "IConv" $ iconv bs
51+ , bench "IConv" $ whnfIO $ iconv bs
44 , bench "StrictLength" $ nf (T.length . T.decodeUtf8) bs
52 , bench "StrictLength" $ nf (T.length . T.decodeUtf8) bs
45 , bench "StrictInitLength" $ nf (T.length . T.init . T.decodeUtf8) bs
53 , bench "StrictInitLength" $ nf (T.length . T.init . T.decodeUtf8) bs
46 , bench "Lazy" $ nf TL.decodeUtf8 lbs
54 , bench "Lazy" $ nf TL.decodeUtf8 lbs
@@ -52,7 +60,7 @@ benchmark kind fp = do
52 , bench "LazyStringUtf8Length" $ nf (length . U8.toString) lbs
60 , bench "LazyStringUtf8Length" $ nf (length . U8.toString) lbs
53 ]
61 ]
54
62
55−iconv :: ByteString -> IO CInt
63+iconv :: B.ByteString -> IO CInt
56iconv (PS fp off len) = withForeignPtr fp $ \ptr ->
64iconv (PS fp off len) = withForeignPtr fp $ \ptr ->
57 time_iconv (ptr `plusPtr` off) (fromIntegral len)
65 time_iconv (ptr `plusPtr` off) (fromIntegral len)
58
66
benchmarks/haskell/Benchmarks/FileRead.hs+11−11
@@ -8,8 +8,8 @@ module Benchmarks.FileRead
8 ( benchmark
8 ( benchmark
9 ) where
9 ) where
10
10
11−import Control.Exception (evaluate)
11+import Control.Applicative ((<$>))
12−import Criterion (Benchmark, bgroup, bench)
12+import Criterion (Benchmark, bgroup, bench, whnfIO)
13import qualified Data.ByteString as SB
13import qualified Data.ByteString as SB
14import qualified Data.ByteString.Lazy as LB
14import qualified Data.ByteString.Lazy as LB
15import qualified Data.Text as T
15import qualified Data.Text as T
@@ -21,13 +21,13 @@ import qualified Data.Text.Lazy.IO as LT
21
21
22benchmark :: FilePath -> IO Benchmark
22benchmark :: FilePath -> IO Benchmark
23benchmark p = return $ bgroup "FileRead"
23benchmark p = return $ bgroup "FileRead"
24− [ bench "String" $ readFile p >>= evaluate . length
24+ [ bench "String" $ whnfIO $ length <$> readFile p
25− , bench "ByteString" $ SB.readFile p >>= evaluate . SB.length
25+ , bench "ByteString" $ whnfIO $ SB.length <$> SB.readFile p
26− , bench "LazyByteString" $ LB.readFile p >>= evaluate . LB.length
26+ , bench "LazyByteString" $ whnfIO $ LB.length <$> LB.readFile p
27− , bench "Text" $ T.readFile p >>= evaluate . T.length
27+ , bench "Text" $ whnfIO $ T.length <$> T.readFile p
28− , bench "LazyText" $ LT.readFile p >>= evaluate . LT.length
28+ , bench "LazyText" $ whnfIO $ LT.length <$> LT.readFile p
29− , bench "TextByteString" $
29+ , bench "TextByteString" $ whnfIO $
30− SB.readFile p >>= evaluate . T.length . T.decodeUtf8
30+ (T.length . T.decodeUtf8) <$> SB.readFile p
31− , bench "LazyTextByteString" $
31+ , bench "LazyTextByteString" $ whnfIO $
32− LB.readFile p >>= evaluate . LT.length . LT.decodeUtf8
32+ (LT.length . LT.decodeUtf8) <$> LB.readFile p
33 ]
33 ]
benchmarks/haskell/Benchmarks/FoldLines.hs+2−2
@@ -10,7 +10,7 @@ module Benchmarks.FoldLines
10 ( benchmark
10 ( benchmark
11 ) where
11 ) where
12
12
13−import Criterion (Benchmark, bgroup, bench)
13+import Criterion (Benchmark, bgroup, bench, whnfIO)
14import System.IO
14import System.IO
15import qualified Data.ByteString as B
15import qualified Data.ByteString as B
16import qualified Data.Text as T
16import qualified Data.Text as T
@@ -22,7 +22,7 @@ benchmark fp = return $ bgroup "ReadLines"
22 , bench "ByteString" $ withHandle $ foldLinesB (\n _ -> n + 1) (0 :: Int)
22 , bench "ByteString" $ withHandle $ foldLinesB (\n _ -> n + 1) (0 :: Int)
23 ]
23 ]
24 where
24 where
25− withHandle f = do
25+ withHandle f = whnfIO $ do
26 h <- openFile fp ReadMode
26 h <- openFile fp ReadMode
27 hSetBuffering h (BlockBuffering (Just 16384))
27 hSetBuffering h (BlockBuffering (Just 16384))
28 x <- f h
28 x <- f h
benchmarks/haskell/Benchmarks/Mul.hsnew file+138
@@ -0,0 +1,138 @@
1+module Benchmarks.Mul (benchmark) where
2+
3+import Control.Exception (evaluate)
4+import Criterion.Main
5+import Data.Int (Int32, Int64)
6+import Data.Text.Internal (mul32, mul64)
7+import qualified Data.Vector.Unboxed as U
8+
9+oldMul :: Int64 -> Int64 -> Int64
10+oldMul m n
11+ | n == 0 = 0
12+ | m <= maxBound `quot` n = m * n
13+ | otherwise = error "overflow"
14+
15+benchmark :: IO Benchmark
16+benchmark = do
17+ _ <- evaluate testVector32
18+ _ <- evaluate testVector64
19+ return $ bgroup "Mul" [
20+ bench "oldMul" $ whnf (U.map (uncurry oldMul)) testVector64
21+ , bench "mul64" $ whnf (U.map (uncurry mul64)) testVector64
22+ , bench "*64" $ whnf (U.map (uncurry (*))) testVector64
23+ , bench "mul32" $ whnf (U.map (uncurry mul32)) testVector32
24+ , bench "*32" $ whnf (U.map (uncurry (*))) testVector32
25+ ]
26+
27+testVector64 :: U.Vector (Int64,Int64)
28+testVector64 = U.fromList [
29+ (0,1248868987182846646),(169004623633872,24458),(482549039517835,7614),
30+ (372,8157063115504364),(27,107095594861148252),(3,63249878517962420),
31+ (4363,255694473572912),(86678474,1732634806),(1572453024,1800489338),
32+ (9384523143,77053781),(49024709555,75095046),(7,43457620410239131),
33+ (8,8201563008844571),(387719037,1520696708),(189869238220197,1423),
34+ (46788016849611,23063),(503077742109974359,0),(104,1502010908706487),
35+ (30478140346,207525518),(80961140129236192,14),(4283,368012829143675),
36+ (1028719181728108146,6),(318904,5874863049591),(56724427166898,110794),
37+ (234539368,31369110449),(2,251729663598178612),(103291548194451219,5),
38+ (76013,5345328755566),(1769631,2980846129318),(40898,60598477385754),
39+ (0,98931348893227155),(573555872156917492,3),(318821187115,4476566),
40+ (11152874213584,243582),(40274276,16636653248),(127,4249988676030597),
41+ (103543712111871836,5),(71,16954462148248238),(3963027173504,216570),
42+ (13000,503523808916753),(17038308,20018685905),(0,510350226577891549),
43+ (175898,3875698895405),(425299191292676,5651),(17223451323664536,50),
44+ (61755131,14247665326),(0,1018195131697569303),(36433751497238985,20),
45+ (3473607861601050,1837),(1392342328,1733971838),(225770297367,3249655),
46+ (14,127545244155254102),(1751488975299136,2634),(3949208,504190668767),
47+ (153329,831454434345),(1066212122928663658,2),(351224,2663633539556),
48+ (344565,53388869217),(35825609350446863,54),(276011553660081475,10),
49+ (1969754174790470349,3),(35,68088438338633),(506710,3247689556438),
50+ (11099382291,327739909),(105787303549,32824363),(210366111,14759049409),
51+ (688893241579,3102676),(8490,70047474429581),(152085,29923000251880),
52+ (5046974599257095,400),(4183167795,263434071),(10089728,502781960687),
53+ (44831977765,4725378),(91,8978094664238578),(30990165721,44053350),
54+ (1772377,149651820860),(243420621763408572,4),(32,5790357453815138),
55+ (27980806337993771,5),(47696295759774,20848),(1745874142313778,1098),
56+ (46869334770121,1203),(886995283,1564424789),(40679396544,76002479),
57+ (1,672849481568486995),(337656187205,3157069),(816980552858963,6003),
58+ (2271434085804831543,1),(0,1934521023868747186),(6266220038281,15825),
59+ (4160,107115946987394),(524,246808621791561),(0,1952519482439636339),
60+ (128,2865935904539691),(1044,3211982069426297),(16000511542473,88922),
61+ (1253596745404082,2226),(27041,56836278958002),(23201,49247489754471),
62+ (175906590497,21252392),(185163584757182295,24),(34742225226802197,150),
63+ (2363228,250824838408),(216327527109550,45),(24,81574076994520675),
64+ (28559899906542,15356),(10890139774837133,511),(2293,707179303654492),
65+ (2749366833,40703233),(0,4498229704622845986),(439,4962056468281937),
66+ (662,1453820621089921),(16336770612459631,220),(24282989393,74239137),
67+ (2724564648490195,3),(743672760,124992589),(4528103,704330948891),
68+ (6050483122491561,250),(13322953,13594265152),(181794,22268101450214),
69+ (25957941712,75384092),(43352,7322262295009),(32838,52609059549923),
70+ (33003585202001564,2),(103019,68430142267402),(129918230800,8742978),
71+ (0,2114347379589080688),(2548,905723041545274),(222745067962838382,0),
72+ (1671683850790425181,1),(455,4836932776795684),(794227702827214,6620),
73+ (212534135175874,1365),(96432431858,29784975),(466626763743380,3484),
74+ (29793949,53041519613),(8359,309952753409844),(3908960585331901,26),
75+ (45185288970365760,114),(10131829775,68110174),(58039242399640479,83),
76+ (628092278238719399,6),(1,196469106875361889),(302336625,16347502444),
77+ (148,3748088684181047),(1,1649096568849015456),(1019866864,2349753026),
78+ (8211344830,569363306),(65647579546873,34753),(2340190,1692053129069),
79+ (64263301,30758930355),(48681618072372209,110),(7074794736,47640197),
80+ (249634721521,7991792),(1162917363807215,232),(7446433349,420634045),
81+ (63398619383,60709817),(51359004508011,14200),(131788797028647,7072),
82+ (52079887791430043,7),(7,136277667582599838),(28582879735696,50327),
83+ (1404582800566278,833),(469164435,15017166943),(99567079957578263,49),
84+ (1015285971,3625801566),(321504843,4104079293),(5196954,464515406632),
85+ (114246832260876,7468),(8149664437,487119673),(12265299,378168974869),
86+ (37711995764,30766513),(3971137243,710996152),(483120070302,603162),
87+ (103009942,61645547145),(8476344625340,6987),(547948761229739,1446),
88+ (42234,18624767306301),(13486714173011,58948),(4,198309153268019840),
89+ (9913176974,325539248),(28246225540203,116822),(2882463945582154,18),
90+ (959,25504987505398),(3,1504372236378217710),(13505229956793,374987),
91+ (751661959,457611342),(27375926,36219151769),(482168869,5301952074),
92+ (1,1577425863241520640),(714116235611821,1164),(904492524250310488,0),
93+ (5983514941763398,68),(10759472423,23540686),(72539568471529,34919),
94+ (4,176090672310337473),(938702842110356453,1),(673652445,3335287382),
95+ (3111998893666122,917),(1568013,3168419765469)]
96+
97+testVector32 :: U.Vector (Int32,Int32)
98+testVector32 = U.fromList [
99+ (39242,410),(0,100077553),(2206,9538),(509400240,1),(38048,6368),
100+ (1789,651480),(2399,157032),(701,170017),(5241456,14),(11212,70449),
101+ (1,227804876),(749687254,1),(74559,2954),(1158,147957),(410604456,1),
102+ (170851,1561),(92643422,1),(6192,180509),(7,24202210),(3440,241481),
103+ (5753677,5),(294327,1622),(252,4454673),(127684121,11),(28315800,30),
104+ (340370905,0),(1,667887987),(592782090,1),(49023,27641),(750,290387),
105+ (72886,3847),(0,301047933),(3050276,473),(1,788366142),(59457,15813),
106+ (637726933,1),(1135,344317),(853616,264),(696816,493),(7038,12046),
107+ (125219574,4),(803694088,1),(107081726,1),(39294,21699),(16361,38191),
108+ (132561123,12),(1760,23499),(847543,484),(175687349,1),(2963,252678),
109+ (6248,224553),(27596,4606),(5422922,121),(1542,485890),(131,583035),
110+ (59096,4925),(3637115,132),(0,947225435),(86854,6794),(2984745,339),
111+ (760129569,1),(1,68260595),(380835652,2),(430575,2579),(54514,7211),
112+ (15550606,3),(9,27367402),(3007053,207),(7060988,60),(28560,27130),
113+ (1355,21087),(10880,53059),(14563646,4),(461886361,1),(2,169260724),
114+ (241454126,2),(406797,1),(61631630,16),(44473,5943),(63869104,12),
115+ (950300,1528),(2113,62333),(120817,9358),(100261456,1),(426764723,1),
116+ (119,12723684),(3,53358711),(4448071,18),(1,230278091),(238,232102),
117+ (8,57316440),(42437979,10),(6769,19555),(48590,22006),(11500585,79),
118+ (2808,97638),(42,26952545),(11,32104194),(23954638,1),(785427272,0),
119+ (513,81379),(31333960,37),(897772,1009),(4,25679692),(103027993,12),
120+ (104972702,11),(546,443401),(7,65137092),(88574269,3),(872139069,0),
121+ (2,97417121),(378802603,0),(141071401,4),(22613,10575),(2191743,118),
122+ (470,116119),(7062,38166),(231056,1847),(43901963,9),(2400,70640),
123+ (63553,1555),(34,11249573),(815174,1820),(997894011,0),(98881794,2),
124+ (5448,43132),(27956,9),(904926,1357),(112608626,3),(124,613021),
125+ (282086,1966),(99,10656881),(113799,1501),(433318,2085),(442,948171),
126+ (165380,1043),(28,14372905),(14880,50462),(2386,219918),(229,1797565),
127+ (1174961,298),(3925,41833),(3903515,299),(15690452,111),(360860521,3),
128+ (7440846,81),(2541026,507),(0,492448477),(6869,82469),(245,8322939),
129+ (3503496,253),(123495298,0),(150963,2299),(33,4408482),(1,200911107),
130+ (305,252121),(13,123369189),(215846,8181),(2440,65387),(776764401,1),
131+ (1241172,434),(8,15493155),(81953961,6),(17884993,5),(26,6893822),
132+ (0,502035190),(1,582451018),(2,514870139),(227,3625619),(49,12720258),
133+ (1456769,207),(94797661,10),(234407,893),(26843,5783),(15688,24547),
134+ (4091,86268),(4339448,151),(21360,6294),(397046497,2),(1227,205936),
135+ (9966,21959),(160046791,1),(0,159992224),(27,24974797),(19177,29334),
136+ (4136148,42),(21179785,53),(61256583,31),(385,344176),(7,11934915),
137+ (1,18992566),(3488065,5),(768021,224),(36288474,7),(8624,117561),
138+ (8,20341439),(5903,261475),(561,1007618),(1738,392327),(633049,1708)]
benchmarks/haskell/Benchmarks/Programs/BigTable.hs+2−2
@@ -11,7 +11,7 @@ module Benchmarks.Programs.BigTable
11 ( benchmark
11 ( benchmark
12 ) where
12 ) where
13
13
14−import Criterion (Benchmark, bench)
14+import Criterion (Benchmark, bench, whnfIO)
15import Data.Monoid (mappend, mconcat)
15import Data.Monoid (mappend, mconcat)
16import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)
16import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)
17import Data.Text.Lazy.IO (hPutStr)
17import Data.Text.Lazy.IO (hPutStr)
@@ -19,7 +19,7 @@ import System.IO (Handle)
19import qualified Data.Text as T
19import qualified Data.Text as T
20
20
21benchmark :: Handle -> IO Benchmark
21benchmark :: Handle -> IO Benchmark
22−benchmark sink = return $ bench "BigTable" $ do
22+benchmark sink = return $ bench "BigTable" $ whnfIO $ do
23 hPutStr sink "Content-Type: text/html\n\n<table>"
23 hPutStr sink "Content-Type: text/html\n\n<table>"
24 hPutStr sink . toLazyText . makeTable =<< rows
24 hPutStr sink . toLazyText . makeTable =<< rows
25 hPutStr sink "</table>"
25 hPutStr sink "</table>"
benchmarks/haskell/Benchmarks/Programs/Cut.hs+2−2
@@ -16,7 +16,7 @@ module Benchmarks.Programs.Cut
16 ( benchmark
16 ( benchmark
17 ) where
17 ) where
18
18
19−import Criterion (Benchmark, bgroup, bench)
19+import Criterion (Benchmark, bgroup, bench, whnfIO)
20import System.IO (Handle, hPutStr)
20import System.IO (Handle, hPutStr)
21import qualified Data.ByteString as B
21import qualified Data.ByteString as B
22import qualified Data.ByteString.Char8 as BC
22import qualified Data.ByteString.Char8 as BC
@@ -40,7 +40,7 @@ benchmark p sink from to = return $ bgroup "Cut"
40 , bench' "LazyTextByteString" lazyTextByteString
40 , bench' "LazyTextByteString" lazyTextByteString
41 ]
41 ]
42 where
42 where
43− bench' n s = bench n (s p sink from to)
43+ bench' n s = bench n $ whnfIO (s p sink from to)
44
44
45string :: FilePath -> Handle -> Int -> Int -> IO ()
45string :: FilePath -> Handle -> Int -> Int -> IO ()
46string fp sink from to = do
46string fp sink from to = do
benchmarks/haskell/Benchmarks/Programs/Fold.hs+2−2
@@ -21,7 +21,7 @@ import Data.List (foldl')
21import Data.List (intersperse)
21import Data.List (intersperse)
22import Data.Monoid (mempty, mappend, mconcat)
22import Data.Monoid (mempty, mappend, mconcat)
23import System.IO (Handle)
23import System.IO (Handle)
24−import Criterion (Benchmark, bench)
24+import Criterion (Benchmark, bench, whnfIO)
25import qualified Data.Text as T
25import qualified Data.Text as T
26import qualified Data.Text.IO as T
26import qualified Data.Text.IO as T
27import qualified Data.Text.Lazy.Builder as TLB
27import qualified Data.Text.Lazy.Builder as TLB
@@ -30,7 +30,7 @@ import qualified Data.Text.Lazy.IO as TL
30
30
31benchmark :: FilePath -> Handle -> IO Benchmark
31benchmark :: FilePath -> Handle -> IO Benchmark
32benchmark i o = return $
32benchmark i o = return $
33− bench "Fold" $ T.readFile i >>= TL.hPutStr o . fold 80
33+ bench "Fold" $ whnfIO $ T.readFile i >>= TL.hPutStr o . fold 80
34
34
35-- | We represent a paragraph by a word list
35-- | We represent a paragraph by a word list
36--
36--
benchmarks/haskell/Benchmarks/Programs/Sort.hs+10−9
@@ -17,7 +17,7 @@ module Benchmarks.Programs.Sort
17 ( benchmark
17 ( benchmark
18 ) where
18 ) where
19
19
20−import Criterion (Benchmark, bgroup, bench)
20+import Criterion (Benchmark, bgroup, bench, whnfIO)
21import Data.Monoid (mconcat)
21import Data.Monoid (mconcat)
22import System.IO (Handle, hPutStr)
22import System.IO (Handle, hPutStr)
23import qualified Data.ByteString as B
23import qualified Data.ByteString as B
@@ -35,16 +35,17 @@ import qualified Data.Text.Lazy.IO as TL
35
35
36benchmark :: FilePath -> Handle -> IO Benchmark
36benchmark :: FilePath -> Handle -> IO Benchmark
37benchmark i o = return $ bgroup "Sort"
37benchmark i o = return $ bgroup "Sort"
38− [ bench "String" $ readFile i >>= hPutStr o . string
38+ [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string
39− , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString
39+ , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString
40+ , bench "LazyByteString" $ whnfIO $
40− , bench "LazyByteString" $ BL.readFile i >>= BL.hPutStr o . lazyByteString
41+ BL.readFile i >>= BL.hPutStr o . lazyByteString
41− , bench "Text" $ T.readFile i >>= T.hPutStr o . text
42+ , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text
42− , bench "LazyText" $ TL.readFile i >>= TL.hPutStr o . lazyText
43+ , bench "LazyText" $ whnfIO $ TL.readFile i >>= TL.hPutStr o . lazyText
43− , bench "TextByteString" $ B.readFile i >>=
44+ , bench "TextByteString" $ whnfIO $ B.readFile i >>=
44 B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8
45 B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8
45− , bench "LazyTextByteString" $ BL.readFile i >>=
46+ , bench "LazyTextByteString" $ whnfIO $ BL.readFile i >>=
46 BL.hPutStr o . TL.encodeUtf8 . lazyText . TL.decodeUtf8
47 BL.hPutStr o . TL.encodeUtf8 . lazyText . TL.decodeUtf8
47− , bench "TextBuilder" $ B.readFile i >>=
48+ , bench "TextBuilder" $ whnfIO $ B.readFile i >>=
48 BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8
49 BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8
49 ]
50 ]
50
51
benchmarks/haskell/Benchmarks/Programs/StripTags.hs+5−5
@@ -15,7 +15,7 @@ module Benchmarks.Programs.StripTags
15 ( benchmark
15 ( benchmark
16 ) where
16 ) where
17
17
18−import Criterion (Benchmark, bgroup, bench)
18+import Criterion (Benchmark, bgroup, bench, whnfIO)
19import Data.List (mapAccumL)
19import Data.List (mapAccumL)
20import System.IO (Handle, hPutStr)
20import System.IO (Handle, hPutStr)
21import qualified Data.ByteString as B
21import qualified Data.ByteString as B
@@ -26,10 +26,10 @@ import qualified Data.Text.IO as T
26
26
27benchmark :: FilePath -> Handle -> IO Benchmark
27benchmark :: FilePath -> Handle -> IO Benchmark
28benchmark i o = return $ bgroup "StripTags"
28benchmark i o = return $ bgroup "StripTags"
29− [ bench "String" $ readFile i >>= hPutStr o . string
29+ [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string
30− , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString
30+ , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString
31− , bench "Text" $ T.readFile i >>= T.hPutStr o . text
31+ , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text
32− , bench "TextByteString" $
32+ , bench "TextByteString" $ whnfIO $
33 B.readFile i >>= B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8
33 B.readFile i >>= B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8
34 ]
34 ]
35
35
benchmarks/haskell/Benchmarks/Programs/Throughput.hs+8−8
@@ -18,7 +18,7 @@ module Benchmarks.Programs.Throughput
18 ( benchmark
18 ( benchmark
19 ) where
19 ) where
20
20
21−import Criterion (Benchmark, bgroup, bench)
21+import Criterion (Benchmark, bgroup, bench, whnfIO)
22import System.IO (Handle, hPutStr)
22import System.IO (Handle, hPutStr)
23import qualified Data.ByteString as B
23import qualified Data.ByteString as B
24import qualified Data.ByteString.Lazy as BL
24import qualified Data.ByteString.Lazy as BL
@@ -29,13 +29,13 @@ import qualified Data.Text.Lazy.IO as TL
29
29
30benchmark :: FilePath -> Handle -> IO Benchmark
30benchmark :: FilePath -> Handle -> IO Benchmark
31benchmark fp sink = return $ bgroup "Throughput"
31benchmark fp sink = return $ bgroup "Throughput"
32− [ bench "String" $ readFile fp >>= hPutStr sink
32+ [ bench "String" $ whnfIO $ readFile fp >>= hPutStr sink
33− , bench "ByteString" $ B.readFile fp >>= B.hPutStr sink
33+ , bench "ByteString" $ whnfIO $ B.readFile fp >>= B.hPutStr sink
34− , bench "LazyByteString" $ BL.readFile fp >>= BL.hPutStr sink
34+ , bench "LazyByteString" $ whnfIO $ BL.readFile fp >>= BL.hPutStr sink
35− , bench "Text" $ T.readFile fp >>= T.hPutStr sink
35+ , bench "Text" $ whnfIO $ T.readFile fp >>= T.hPutStr sink
36− , bench "LazyText" $ TL.readFile fp >>= TL.hPutStr sink
36+ , bench "LazyText" $ whnfIO $ TL.readFile fp >>= TL.hPutStr sink
37− , bench "TextByteString" $
37+ , bench "TextByteString" $ whnfIO $
38 B.readFile fp >>= B.hPutStr sink . T.encodeUtf8 . T.decodeUtf8
38 B.readFile fp >>= B.hPutStr sink . T.encodeUtf8 . T.decodeUtf8
39− , bench "LazyTextByteString" $
39+ , bench "LazyTextByteString" $ whnfIO $
40 BL.readFile fp >>= BL.hPutStr sink . TL.encodeUtf8 . TL.decodeUtf8
40 BL.readFile fp >>= BL.hPutStr sink . TL.encodeUtf8 . TL.decodeUtf8
41 ]
41 ]
benchmarks/haskell/Benchmarks/Pure.hs+18−8
@@ -18,7 +18,6 @@ import Data.Monoid (mappend, mempty)
18import GHC.Base (Char (..), Int (..), chr#, ord#, (+#))
18import GHC.Base (Char (..), Int (..), chr#, ord#, (+#))
19import qualified Data.ByteString.Char8 as BS
19import qualified Data.ByteString.Char8 as BS
20import qualified Data.ByteString.Lazy.Char8 as BL
20import qualified Data.ByteString.Lazy.Char8 as BL
21−import qualified Data.ByteString.Lazy.Internal as BL
22import qualified Data.ByteString.UTF8 as UTF8
21import qualified Data.ByteString.UTF8 as UTF8
23import qualified Data.List as L
22import qualified Data.List as L
24import qualified Data.Text as T
23import qualified Data.Text as T
@@ -27,8 +26,8 @@ import qualified Data.Text.Lazy as TL
27import qualified Data.Text.Lazy.Builder as TB
26import qualified Data.Text.Lazy.Builder as TB
28import qualified Data.Text.Lazy.Encoding as TL
27import qualified Data.Text.Lazy.Encoding as TL
29
28
30−benchmark :: FilePath -> IO Benchmark
29+benchmark :: String -> FilePath -> IO Benchmark
31−benchmark fp = do
30+benchmark kind fp = do
32 -- Evaluate stuff before actually running the benchmark, we don't want to
31 -- Evaluate stuff before actually running the benchmark, we don't want to
33 -- count it here.
32 -- count it here.
34
33
@@ -100,6 +99,10 @@ benchmark fp = do
100 , benchBSL $ nf BL.unpack bla
99 , benchBSL $ nf BL.unpack bla
101 , benchS $ nf UTF8.toString bsa
100 , benchS $ nf UTF8.toString bsa
102 ]
101 ]
102+ , bgroup "decode'"
103+ [ benchT $ nf T.decodeUtf8' bsa
104+ , benchTL $ nf TL.decodeUtf8' bla
105+ ]
103 , bgroup "drop"
106 , bgroup "drop"
104 [ benchT $ nf (T.drop (ta_len `div` 3)) ta
107 [ benchT $ nf (T.drop (ta_len `div` 3)) ta
105 , benchTL $ nf (TL.drop (tla_len `div` 3)) tla
108 , benchTL $ nf (TL.drop (tla_len `div` 3)) tla
@@ -259,6 +262,13 @@ benchmark fp = do
259 , benchBSL $ nf (BL.map toUpper) bla
262 , benchBSL $ nf (BL.map toUpper) bla
260 , benchS $ nf (L.map toUpper) sa
263 , benchS $ nf (L.map toUpper) sa
261 ]
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+ ]
262 , bgroup "words"
272 , bgroup "words"
263 [ benchT $ nf T.words ta
273 [ benchT $ nf T.words ta
264 , benchTL $ nf TL.words tla
274 , benchTL $ nf TL.words tla
@@ -405,11 +415,11 @@ benchmark fp = do
405 ]
415 ]
406 ]
416 ]
407 where
417 where
408− benchS = bench "String"
418+ benchS = bench ("String+" ++ kind)
409− benchT = bench "Text"
419+ benchT = bench ("Text+" ++ kind)
410− benchTL = bench "LazyText"
420+ benchTL = bench ("LazyText+" ++ kind)
411− benchBS = bench "ByteString"
421+ benchBS = bench ("ByteString+" ++ kind)
412− benchBSL = bench "LazyByteString"
422+ benchBSL = bench ("LazyByteString+" ++ kind)
413
423
414 c = 'й'
424 c = 'й'
415 p0 = (== c)
425 p0 = (== c)
benchmarks/haskell/Benchmarks/ReadNumbers.hs+2−5
@@ -25,8 +25,7 @@ import Data.List (foldl')
25import Numeric (readDec, readFloat, readHex)
25import Numeric (readDec, readFloat, readHex)
26import qualified Data.ByteString.Char8 as B
26import qualified Data.ByteString.Char8 as B
27import qualified Data.ByteString.Lazy.Char8 as BL
27import qualified Data.ByteString.Lazy.Char8 as BL
28−import qualified Data.ByteString.Lex.Double as B
28+import qualified Data.ByteString.Lex.Fractional as B
29−import qualified Data.ByteString.Lex.Lazy.Double as BL
30import qualified Data.Text as T
29import qualified Data.Text as T
31import qualified Data.Text.IO as T
30import qualified Data.Text.IO as T
32import qualified Data.Text.Lazy as TL
31import qualified Data.Text.Lazy as TL
@@ -63,12 +62,10 @@ benchmark fp = do
63 whnf (double . text TL.rational) tl
62 whnf (double . text TL.rational) tl
64
63
65 , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b
64 , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b
66− , bench "DoubleByteString" $ whnf (double . byteString B.readDouble) b
65+ , bench "DoubleByteString" $ whnf (double . byteString B.readDecimal) b
67
66
68 , bench "DecimalLazyByteString" $
67 , bench "DecimalLazyByteString" $
69 whnf (int . byteString BL.readInt) bl
68 whnf (int . byteString BL.readInt) bl
70− , bench "DoubleLazyByteString" $
71− whnf (double . byteString BL.readDouble) bl
72 ]
69 ]
73 where
70 where
74 -- Used for fixing types
71 -- Used for fixing types
benchmarks/haskell/Benchmarks/Replace.hs+19−7
@@ -1,3 +1,4 @@
1+{-# LANGUAGE BangPatterns #-}
1-- | Replace a string by another string
2-- | Replace a string by another string
2--
3--
3-- Tested in this benchmark:
4-- Tested in this benchmark:
@@ -12,6 +13,9 @@ import Criterion (Benchmark, bgroup, bench, nf)
12import qualified Data.ByteString.Char8 as B
13import qualified Data.ByteString.Char8 as B
13import qualified Data.ByteString.Lazy as BL
14import qualified Data.ByteString.Lazy as BL
14import qualified Data.ByteString.Lazy.Search as BL
15import qualified Data.ByteString.Lazy.Search as BL
16+import qualified Data.ByteString.Search as B
17+import qualified Data.Text as T
18+import qualified Data.Text.Encoding as T
15import qualified Data.Text.Lazy as TL
19import qualified Data.Text.Lazy as TL
16import qualified Data.Text.Lazy.Encoding as TL
20import qualified Data.Text.Lazy.Encoding as TL
17import qualified Data.Text.Lazy.IO as TL
21import qualified Data.Text.Lazy.IO as TL
@@ -20,12 +24,20 @@ benchmark :: FilePath -> String -> String -> IO Benchmark
20benchmark fp pat sub = do
24benchmark fp pat sub = do
21 tl <- TL.readFile fp
25 tl <- TL.readFile fp
22 bl <- BL.readFile fp
26 bl <- BL.readFile fp
27+ let !t = TL.toStrict tl
28+ !b = T.encodeUtf8 t
23− return $ bgroup "Replace"
29+ return $ bgroup "Replace" [
24− [ bench "LazyText" $ nf (TL.length . TL.replace tpat tsub) tl
30+ bench "Text" $ nf (T.length . T.replace tpat tsub) t
25− , bench "LazyByteString" $ nf (BL.length . BL.replace bpat bsub) bl
31+ , bench "ByteString" $ nf (BL.length . B.replace bpat bsub) b
32+ , bench "LazyText" $ nf (TL.length . TL.replace tlpat tlsub) tl
33+ , bench "LazyByteString" $ nf (BL.length . BL.replace blpat blsub) bl
26 ]
34 ]
27 where
35 where
36+ tpat = T.pack pat
37+ tsub = T.pack sub
28− tpat = TL.pack pat
38+ tlpat = TL.pack pat
29− tsub = TL.pack sub
39+ tlsub = TL.pack sub
30− bpat = B.concat $ BL.toChunks $ TL.encodeUtf8 tpat
40+ bpat = T.encodeUtf8 tpat
41+ bsub = T.encodeUtf8 tsub
42+ blpat = B.concat $ BL.toChunks $ TL.encodeUtf8 tlpat
31− bsub = B.concat $ BL.toChunks $ TL.encodeUtf8 tsub
43+ blsub = B.concat $ BL.toChunks $ TL.encodeUtf8 tlsub
benchmarks/haskell/Benchmarks/Stream.hs+20−10
@@ -13,16 +13,16 @@ module Benchmarks.Stream
13
13
14import Control.DeepSeq (NFData (..))
14import Control.DeepSeq (NFData (..))
15import Criterion (Benchmark, bgroup, bench, nf)
15import Criterion (Benchmark, bgroup, bench, nf)
16−import Data.Text.Fusion.Internal (Step (..), Stream (..))
16+import Data.Text.Internal.Fusion.Types (Step (..), Stream (..))
17import qualified Data.Text.Encoding as T
17import qualified Data.Text.Encoding as T
18import qualified Data.Text.Encoding.Error as E
18import qualified Data.Text.Encoding.Error as E
19−import qualified Data.Text.Encoding.Fusion as T
19+import qualified Data.Text.Internal.Encoding.Fusion as T
20−import qualified Data.Text.Encoding.Fusion.Common as F
20+import qualified Data.Text.Internal.Encoding.Fusion.Common as F
21−import qualified Data.Text.Fusion as T
21+import qualified Data.Text.Internal.Fusion as F
22import qualified Data.Text.IO as T
22import qualified Data.Text.IO as T
23import qualified Data.Text.Lazy.Encoding as TL
23import qualified Data.Text.Lazy.Encoding as TL
24−import qualified Data.Text.Lazy.Encoding.Fusion as TL
24+import qualified Data.Text.Internal.Lazy.Encoding.Fusion as TL
25−import qualified Data.Text.Lazy.Fusion as TL
25+import qualified Data.Text.Internal.Lazy.Fusion as FL
26import qualified Data.Text.Lazy.IO as TL
26import qualified Data.Text.Lazy.IO as TL
27
27
28instance NFData a => NFData (Stream a) where
28instance NFData a => NFData (Stream a) where
@@ -53,14 +53,25 @@ benchmark fp = do
53 !utf32beL = TL.encodeUtf32BE tl
53 !utf32beL = TL.encodeUtf32BE tl
54
54
55 -- For the functions which operate on streams
55 -- For the functions which operate on streams
56− let !s = T.stream t
56+ let !s = F.stream t
57
57
58 return $ bgroup "Stream"
58 return $ bgroup "Stream"
59
59
60 -- Fusion
60 -- Fusion
61 [ bgroup "stream" $
61 [ bgroup "stream" $
62− [ bench "Text" $ nf T.stream t
62+ [ bench "Text" $ nf F.stream t
63+ , bench "LazyText" $ nf FL.stream tl
64+ ]
65+ -- must perform exactly the same as stream above due to
66+ -- stream/unstream (i.e. stream after unstream) fusion
67+ , bgroup "stream-fusion" $
68+ [ bench "Text" $ nf (F.stream . F.unstream . F.stream) t
63− , bench "LazyText" $ nf TL.stream tl
69+ , bench "LazyText" $ nf (FL.stream . FL.unstream . FL.stream) tl
70+ ]
71+ -- measure the overhead of unstream after stream
72+ , bgroup "stream-unstream" $
73+ [ bench "Text" $ nf (F.unstream . F.stream) t
74+ , bench "LazyText" $ nf (FL.unstream . FL.stream) tl
64 ]
75 ]
65
76
66 -- Encoding.Fusion
77 -- Encoding.Fusion
@@ -86,7 +97,6 @@ benchmark fp = do
86 ]
97 ]
87
98
88 -- Encoding.Fusion.Common
99 -- Encoding.Fusion.Common
89− , bench "restreamUtf8" $ nf F.restreamUtf8 s
90 , bench "restreamUtf16LE" $ nf F.restreamUtf16LE s
100 , bench "restreamUtf16LE" $ nf F.restreamUtf16LE s
91 , bench "restreamUtf16BE" $ nf F.restreamUtf16BE s
101 , bench "restreamUtf16BE" $ nf F.restreamUtf16BE s
92 , bench "restreamUtf32LE" $ nf F.restreamUtf32LE s
102 , bench "restreamUtf32LE" $ nf F.restreamUtf32LE s
benchmarks/text-benchmarks.cabal+27−7
@@ -3,7 +3,7 @@ version: 0.0.0.0
3synopsis: Benchmarks for the text package
3synopsis: Benchmarks for the text package
4description: Benchmarks for the text package
4description: Benchmarks for the text package
5homepage: https://bitbucket.org/bos/text
5homepage: https://bitbucket.org/bos/text
6−license: BSD3
6+license: BSD2
7license-file: ../LICENSE
7license-file: ../LICENSE
8author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
8author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
9 Bryan O'Sullivan <bos@serpentine.com>,
9 Bryan O'Sullivan <bos@serpentine.com>,
@@ -15,26 +15,46 @@ 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+
23+flag llvm
24+ description: use LLVM
25+ default: False
26+ manual: True
27+
18executable text-benchmarks
28executable text-benchmarks
19 hs-source-dirs: haskell ..
29 hs-source-dirs: haskell ..
20 c-sources: ../cbits/cbits.c
30 c-sources: ../cbits/cbits.c
21 cbits/time_iconv.c
31 cbits/time_iconv.c
32+ include-dirs: ../include
22 main-is: Benchmarks.hs
33 main-is: Benchmarks.hs
23− ghc-options: -Wall -O2
34+ ghc-options: -Wall -O2 -rtsopts
35+ if flag(llvm)
36+ ghc-options: -fllvm
24− cpp-options: -DHAVE_DEEPSEQ
37+ cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP
25 build-depends: base == 4.*,
38 build-depends: base == 4.*,
26 binary,
39 binary,
27 blaze-builder,
40 blaze-builder,
28− bytestring,
41+ bytestring-lexing >= 0.5.0,
29− bytestring-lexing,
30 containers,
42 containers,
31− criterion >= 0.6.0.1,
43+ criterion >= 0.10.0.0,
32 deepseq,
44 deepseq,
33 directory,
45 directory,
34 filepath,
46 filepath,
35 ghc-prim,
47 ghc-prim,
48+ integer-gmp,
36 stringsearch,
49 stringsearch,
37− utf8-string
50+ utf8-string,
51+ vector
52+
53+ if flag(bytestring-builder)
54+ build-depends: bytestring >= 0.9 && < 0.10.4,
55+ bytestring-builder >= 0.10.4
56+ else
57+ build-depends: bytestring >= 0.10.4
38
58
39executable text-multilang
59executable text-multilang
40 hs-source-dirs: haskell
60 hs-source-dirs: haskell
cbits/cbits.c+155−15
@@ -9,6 +9,7 @@
9#include <string.h>
9#include <string.h>
10#include <stdint.h>
10#include <stdint.h>
11#include <stdio.h>
11#include <stdio.h>
12+#include "text_cbits.h"
12
13
13void _hs_text_memcpy(void *dest, size_t doff, const void *src, size_t soff,
14void _hs_text_memcpy(void *dest, size_t doff, const void *src, size_t soff,
14 size_t n)
15 size_t n)
@@ -67,8 +68,8 @@ decode(uint32_t *state, uint32_t* codep, uint32_t byte) {
67 * an UTF16 array
68 * an UTF16 array
68 */
69 */
69void
70void
70−_hs_text_decode_latin1(uint16_t *dest, const uint8_t const *src,
71+_hs_text_decode_latin1(uint16_t *dest, const uint8_t *src,
71− const uint8_t const *srcend)
72+ const uint8_t *srcend)
72{
73{
73 const uint8_t *p = src;
74 const uint8_t *p = src;
74
75
@@ -103,20 +104,48 @@ _hs_text_decode_latin1(uint16_t *dest, const uint8_t const *src,
103 * A best-effort decoder. Runs until it hits either end of input or
104 * A best-effort decoder. Runs until it hits either end of input or
104 * the start of an invalid byte sequence.
105 * the start of an invalid byte sequence.
105 *
106 *
106− * At exit, updates *destoff with the next offset to write to, and
107+ * At exit, we update *destoff with the next offset to write to, *src
107− * returns the next source offset to read from.
108+ * with the next source location past the last one successfully
109+ * decoded, and return the next source location to read from.
110+ *
111+ * Moreover, we expose the internal decoder state (state0 and
112+ * codepoint0), allowing one to restart the decoder after it
113+ * terminates (say, due to a partial codepoint).
114+ *
115+ * In particular, there are a few possible outcomes,
116+ *
117+ * 1) We decoded the buffer entirely:
118+ * In this case we return srcend
119+ * state0 == UTF8_ACCEPT
120+ *
121+ * 2) We met an invalid encoding
122+ * In this case we return the address of the first invalid byte
123+ * state0 == UTF8_REJECT
124+ *
125+ * 3) We reached the end of the buffer while decoding a codepoint
126+ * In this case we return a pointer to the first byte of the partial codepoint
127+ * state0 != UTF8_ACCEPT, UTF8_REJECT
128+ *
108 */
129 */
130+#if defined(__GNUC__) || defined(__clang__)
109−uint8_t const *
131+static inline uint8_t const *
110−_hs_text_decode_utf8(uint16_t *dest, size_t *destoff,
132+_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,
133+ const uint8_t **src, const uint8_t *srcend,
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,
111− const uint8_t const *src, const uint8_t const *srcend)
140+ const uint8_t **src, const uint8_t *srcend,
141+ uint32_t *codepoint0, uint32_t *state0)
112{
142{
113 uint16_t *d = dest + *destoff;
143 uint16_t *d = dest + *destoff;
114− const uint8_t const *s = src;
144+ const uint8_t *s = *src, *last = *src;
115− uint32_t state = UTF8_ACCEPT;
145+ uint32_t state = *state0;
146+ uint32_t codepoint = *codepoint0;
116
147
117 while (s < srcend) {
148 while (s < srcend) {
118− uint32_t codepoint;
119−
120#if defined(__i386__) || defined(__x86_64__)
149#if defined(__i386__) || defined(__x86_64__)
121 /*
150 /*
122 * This code will only work on a little-endian system that
151 * This code will only work on a little-endian system that
@@ -144,6 +173,7 @@ _hs_text_decode_utf8(uint16_t *dest, size_t *destoff,
144 *d++ = (uint16_t) ((codepoint >> 16) & 0xff);
173 *d++ = (uint16_t) ((codepoint >> 16) & 0xff);
145 *d++ = (uint16_t) ((codepoint >> 24) & 0xff);
174 *d++ = (uint16_t) ((codepoint >> 24) & 0xff);
146 }
175 }
176+ last = s;
147 }
177 }
148#endif
178#endif
149
179
@@ -159,13 +189,123 @@ _hs_text_decode_utf8(uint16_t *dest, size_t *destoff,
159 *d++ = (uint16_t) (0xD7C0 + (codepoint >> 10));
189 *d++ = (uint16_t) (0xD7C0 + (codepoint >> 10));
160 *d++ = (uint16_t) (0xDC00 + (codepoint & 0x3FF));
190 *d++ = (uint16_t) (0xDC00 + (codepoint & 0x3FF));
161 }
191 }
192+ last = s;
162 }
193 }
163
194
164− /* Error recovery - if we're not in a valid finishing state, back up. */
165− if (state != UTF8_ACCEPT)
166− s -= 1;
167−
168 *destoff = d - dest;
195 *destoff = d - dest;
196+ *codepoint0 = codepoint;
197+ *state0 = state;
198+ *src = last;
169
199
170 return s;
200 return s;
171}
201}
202+
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+/*
217+ * Helper to decode buffer and discard final decoder state
218+ */
219+const uint8_t *
220+_hs_text_decode_utf8(uint16_t *const dest, size_t *destoff,
221+ const uint8_t *src, const uint8_t *const srcend)
222+{
223+ uint32_t codepoint;
224+ uint32_t state = UTF8_ACCEPT;
225+ uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, &src, srcend,
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+}
changelog.mdnew file+164
@@ -0,0 +1,164 @@
1+1.2.2.1
2+
3+* The switch to `integer-pure` in 1.2.2.0 was apparently mistaken.
4+ The build flag has been renamed accordingly. Your army of diligent
5+ maintainers apologizes for the churn.
6+
7+* Spec compliance: toCaseFold now follows the Unicode 8.0 spec
8+ (updated from 7.0)
9+
10+* An STG lint error has been fixed
11+
12+1.2.2.0
13+
14+* The `integer-simple` package, upon which this package optionally
15+ depended, has been replaced with `integer-pure`. The build flag has
16+ been renamed accordingly.
17+
18+* Bug fix: For the `Binary` instance, If UTF-8 decoding fails during a
19+ `get`, the error is propagated via `fail` instead of an uncatchable
20+ crash.
21+
22+* New function: `takeWhileEnd`
23+
24+* New instances for the `Text` types:
25+ * if `base` >= 4.7: `PrintfArg`
26+ * if `base` >= 4.9: `Semigroup`
27+
28+1.2.1.3
29+
30+* Bug fix: As it turns out, moving the literal rewrite rules to simplifier
31+ phase 2 does not prevent competition with the `unpack` rule, which is
32+ also active in this phase. Unfortunately this was hidden due to a silly
33+ test environment mistake. Moving literal rules back to phase 1 finally
34+ fixes GHC Trac #10528 correctly.
35+
36+1.2.1.2
37+
38+* Bug fix: Run literal rewrite rules in simplifier phase 2.
39+ The behavior of the simplifier changed in GHC 7.10.2,
40+ causing these rules to fail to fire, leading to poor code generation
41+ and long compilation times. See
42+ [GHC Trac #10528](https://ghc.haskell.org/trac/ghc/ticket/10528).
43+
44+1.2.1.1
45+
46+* Expose unpackCString#, which you should never use.
47+
48+1.2.1.0
49+
50+* Added Binary instances for both Text types. (If you have previously
51+ been using the text-binary package to get a Binary instance, it is
52+ now obsolete.)
53+
54+1.2.0.6
55+
56+* Fixed a space leak in UTF-8 decoding
57+
58+1.2.0.5
59+
60+* Feature parity: repeat, cycle, iterate are now implemented for lazy
61+ Text, and the Data instance is more complete
62+
63+* Build speed: an inliner space explosion has been fixed with toCaseFold
64+
65+* Bug fix: encoding Int to a Builder would infinite-loop if the
66+ integer-simple package was used
67+
68+* Deprecation: OnEncodeError and EncodeError are deprecated, as they
69+ are never used
70+
71+* Internals: some types that are used internally in fusion-related
72+ functions have moved around, been renamed, or been deleted (we don't
73+ bump the major version if .Internal modules change)
74+
75+* Spec compliance: toCaseFold now follows the Unicode 7.0 spec
76+ (updated from 6.3)
77+
78+1.2.0.4
79+
80+* Fixed an incompatibility with base < 4.5
81+
82+1.2.0.3
83+
84+* Update formatRealFloat to correspond to the definition in versions
85+ of base newer than 4.5 (https://github.com/bos/text/issues/105)
86+
87+1.2.0.2
88+
89+* Bumped lower bound on deepseq to 1.4 for compatibility with the
90+ upcoming GHC 7.10
91+
92+1.2.0.1
93+
94+* Fixed a buffer overflow in rendering of large Integers
95+ (https://github.com/bos/text/issues/99)
96+
97+1.2.0.0
98+
99+* Fixed an integer overflow in the replace function
100+ (https://github.com/bos/text/issues/81)
101+
102+* Fixed a hang in lazy decodeUtf8With
103+ (https://github.com/bos/text/issues/87)
104+
105+* Reduced codegen bloat caused by use of empty and single-character
106+ literals
107+
108+* Added an instance of IsList for GHC 7.8 and above
109+
110+1.1.1.0
111+
112+* The Data.Data instance now allows gunfold to work, via a virtual
113+ pack constructor
114+
115+* dropEnd, takeEnd: new functions
116+
117+* Comparing the length of a Text against a number can now
118+ short-circuit in more cases
119+
120+1.1.0.1
121+
122+* streamDecodeUtf8: fixed gh-70, did not return all unconsumed bytes
123+ in single-byte chunks
124+
125+1.1.0.0
126+
127+* encodeUtf8: Performance is improved by up to 4x.
128+
129+* encodeUtf8Builder, encodeUtf8BuilderEscaped: new functions,
130+ available only if bytestring >= 0.10.4.0 is installed, that allow
131+ very fast and flexible encoding of a Text value to a bytestring
132+ Builder.
133+
134+ As an example of the performance gain to be had, the
135+ encodeUtf8BuilderEscaped function helps to double the speed of JSON
136+ encoding in the latest version of aeson! (Note: if all you need is a
137+ plain ByteString, encodeUtf8 is still the faster way to go.)
138+
139+* All of the internal module hierarchy is now publicly exposed. If a
140+ module is in the .Internal hierarchy, or is documented as internal,
141+ use at your own risk - there are no API stability guarantees for
142+ internal modules!
143+
144+1.0.0.1
145+
146+* decodeUtf8: Fixed a regression that caused us to incorrectly
147+ identify truncated UTF-8 as valid (gh-61)
148+
149+1.0.0.0
150+
151+* Added support for Unicode 6.3.0 to case conversion functions
152+
153+* New function toTitle converts words in a string to title case
154+
155+* New functions peekCStringLen and withCStringLen simplify
156+ interoperability with C functionns
157+
158+* Added support for decoding UTF-8 in stream-friendly fashion
159+
160+* Fixed a bug in mapAccumL
161+
162+* Added trusted Haskell support
163+
164+* Removed support for GHC 6.10 (released in 2008) and older
include/text_cbits.hnew file+11
@@ -0,0 +1,11 @@
1+/*
2+ * Copyright (c) 2013 Bryan O'Sullivan <bos@serpentine.com>.
3+ */
4+
5+#ifndef _text_cbits_h
6+#define _text_cbits_h
7+
8+#define UTF8_ACCEPT 0
9+#define UTF8_REJECT 12
10+
11+#endif
scripts/Arsec.hs+4−9
@@ -1,6 +1,7 @@
1module Arsec
1module Arsec
2 (
2 (
3+ Comment
3− comment
4+ , comment
4 , semi
5 , semi
5 , showC
6 , showC
6 , unichar
7 , unichar
@@ -23,13 +24,7 @@ import Text.ParserCombinators.Parsec.Combinator hiding (optional)
23import Text.ParserCombinators.Parsec.Error
24import Text.ParserCombinators.Parsec.Error
24import Text.ParserCombinators.Parsec.Prim hiding ((<|>), many)
25import Text.ParserCombinators.Parsec.Prim hiding ((<|>), many)
25
26
26−instance Applicative (GenParser s a) where
27+type Comment = String
27− pure = return
28− (<*>) = ap
29−
30−instance Alternative (GenParser s a) where
31− empty = mzero
32− (<|>) = mplus
33
28
34unichar :: Parser Char
29unichar :: Parser Char
35unichar = chr . fst . head . readHex <$> many1 hexDigit
30unichar = chr . fst . head . readHex <$> many1 hexDigit
@@ -40,7 +35,7 @@ unichars = manyTill (unichar <* spaces) semi
40semi :: Parser ()
35semi :: Parser ()
41semi = char ';' *> spaces *> pure ()
36semi = char ';' *> spaces *> pure ()
42
37
43−comment :: Parser String
38+comment :: Parser Comment
44comment = (char '#' *> manyTill anyToken (char '\n')) <|> string "\n"
39comment = (char '#' *> manyTill anyToken (char '\n')) <|> string "\n"
45
40
46showC :: Char -> String
41showC :: Char -> String
scripts/CaseFolding.hs+11−7
@@ -4,7 +4,8 @@
4
4
5module CaseFolding
5module CaseFolding
6 (
6 (
7+ CaseFolding(..)
7− Fold(..)
8+ , Fold(..)
8 , parseCF
9 , parseCF
9 , mapCF
10 , mapCF
10 ) where
11 ) where
@@ -18,22 +19,25 @@ data Fold = Fold {
18 , name :: String
19 , name :: String
19 } deriving (Eq, Ord, Show)
20 } deriving (Eq, Ord, Show)
20
21
22+data CaseFolding = CF { cfComments :: [Comment], cfFolding :: [Fold] }
23+ deriving (Show)
24+
21−entries :: Parser [Fold]
25+entries :: Parser CaseFolding
22−entries = many comment *> many (entry <* many comment)
26+entries = CF <$> many comment <*> many (entry <* many comment)
23 where
27 where
24 entry = Fold <$> unichar <* semi
28 entry = Fold <$> unichar <* semi
25 <*> oneOf "CFST" <* semi
29 <*> oneOf "CFST" <* semi
26 <*> unichars
30 <*> unichars
27 <*> (string "# " *> manyTill anyToken (char '\n'))
31 <*> (string "# " *> manyTill anyToken (char '\n'))
28
32
29−parseCF :: FilePath -> IO (Either ParseError [Fold])
33+parseCF :: FilePath -> IO (Either ParseError CaseFolding)
30parseCF name = parse entries name <$> readFile name
34parseCF name = parse entries name <$> readFile name
31
35
32−mapCF :: [Fold] -> [String]
36+mapCF :: CaseFolding -> [String]
33−mapCF ms = typ ++ (map nice . filter p $ ms) ++ [last]
37+mapCF (CF _ ms) = typ ++ (map nice . filter p $ ms) ++ [last]
34 where
38 where
35 typ = ["foldMapping :: forall s. Char -> s -> Step (CC s) Char"
39 typ = ["foldMapping :: forall s. Char -> s -> Step (CC s) Char"
36− ,"{-# INLINE foldMapping #-}"]
40+ ,"{-# NOINLINE foldMapping #-}"]
37 last = "foldMapping c s = Yield (toLower c) (CC s '\\0' '\\0')"
41 last = "foldMapping c s = Yield (toLower c) (CC s '\\0' '\\0')"
38 nice c = "-- " ++ name c ++ "\n" ++
42 nice c = "-- " ++ name c ++ "\n" ++
39 "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+11−5
@@ -8,7 +8,7 @@ import SpecialCasing
8main = do
8main = do
9 args <- getArgs
9 args <- getArgs
10 let oname = case args of
10 let oname = case args of
11− [] -> "../Data/Text/Fusion/CaseMapping.hs"
11+ [] -> "../Data/Text/Internal/Fusion/CaseMapping.hs"
12 [o] -> o
12 [o] -> o
13 psc <- parseSC "SpecialCasing.txt"
13 psc <- parseSC "SpecialCasing.txt"
14 pcf <- parseCF "CaseFolding.txt"
14 pcf <- parseCF "CaseFolding.txt"
@@ -19,14 +19,20 @@ main = do
19 Left err -> print err >> return undefined
19 Left err -> print err >> return undefined
20 Right ms -> return ms
20 Right ms -> return ms
21 h <- openFile oname WriteMode
21 h <- openFile oname WriteMode
22+ let comments = map ("--" ++) $
23+ take 2 (cfComments cfs) ++ take 2 (scComments scs)
24+ mapM_ (hPutStrLn h) $
22− mapM_ (hPutStrLn h) ["{-# LANGUAGE Rank2Types #-}"
25+ ["{-# LANGUAGE Rank2Types #-}"
23 ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"
26 ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"
24− ,"-- Generated by scripts/SpecialCasing.hs"
27+ ,"-- Generated by scripts/CaseMapping.hs"] ++
28+ comments ++
29+ [""
25− ,"module Data.Text.Fusion.CaseMapping where"
30+ ,"module Data.Text.Internal.Fusion.CaseMapping where"
26 ,"import Data.Char"
31 ,"import Data.Char"
27− ,"import Data.Text.Fusion.Internal"
32+ ,"import Data.Text.Internal.Fusion.Types"
28 ,""]
33 ,""]
29 mapM_ (hPutStrLn h) (mapSC "upper" upper toUpper scs)
34 mapM_ (hPutStrLn h) (mapSC "upper" upper toUpper scs)
30 mapM_ (hPutStrLn h) (mapSC "lower" lower toLower scs)
35 mapM_ (hPutStrLn h) (mapSC "lower" lower toLower scs)
36+ mapM_ (hPutStrLn h) (mapSC "title" title toTitle scs)
31 mapM_ (hPutStrLn h) (mapCF cfs)
37 mapM_ (hPutStrLn h) (mapCF cfs)
32 hClose h
38 hClose h
scripts/SpecialCasing.hs+13−7
@@ -4,13 +4,17 @@
4
4
5module SpecialCasing
5module SpecialCasing
6 (
6 (
7+ SpecialCasing(..)
7− Case(..)
8+ , Case(..)
8 , parseSC
9 , parseSC
9 , mapSC
10 , mapSC
10 ) where
11 ) where
11
12
12import Arsec
13import Arsec
13
14
15+data SpecialCasing = SC { scComments :: [Comment], scCasing :: [Case] }
16+ deriving (Show)
17+
14data Case = Case {
18data Case = Case {
15 code :: Char
19 code :: Char
16 , lower :: [Char]
20 , lower :: [Char]
@@ -20,8 +24,8 @@ data Case = Case {
20 , name :: String
24 , name :: String
21 } deriving (Eq, Ord, Show)
25 } deriving (Eq, Ord, Show)
22
26
23−entries :: Parser [Case]
27+entries :: Parser SpecialCasing
24−entries = many comment *> many (entry <* many comment)
28+entries = SC <$> many comment <*> many (entry <* many comment)
25 where
29 where
26 entry = Case <$> unichar <* semi
30 entry = Case <$> unichar <* semi
27 <*> unichars
31 <*> unichars
@@ -30,14 +34,16 @@ entries = many comment *> many (entry <* many comment)
30 <*> manyTill anyToken (string "# ")
34 <*> manyTill anyToken (string "# ")
31 <*> manyTill anyToken (char '\n')
35 <*> manyTill anyToken (char '\n')
32
36
33−parseSC :: FilePath -> IO (Either ParseError [Case])
37+parseSC :: FilePath -> IO (Either ParseError SpecialCasing)
34parseSC name = parse entries name <$> readFile name
38parseSC name = parse entries name <$> readFile name
35
39
36−mapSC :: String -> (Case -> String) -> (Char -> Char) -> [Case] -> [String]
40+mapSC :: String -> (Case -> String) -> (Char -> Char) -> SpecialCasing
41+ -> [String]
37−mapSC which access twiddle ms = typ ++ (map nice . filter p $ ms) ++ [last]
42+mapSC which access twiddle (SC _ ms) =
43+ typ ++ (map nice . filter p $ ms) ++ [last]
38 where
44 where
39 typ = [which ++ "Mapping :: forall s. Char -> s -> Step (CC s) Char"
45 typ = [which ++ "Mapping :: forall s. Char -> s -> Step (CC s) Char"
40− ,"{-# INLINE " ++ which ++ "Mapping #-}"]
46+ ,"{-# NOINLINE " ++ which ++ "Mapping #-}"]
41 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')"
42 nice c = "-- " ++ name c ++ "\n" ++
48 nice c = "-- " ++ name c ++ "\n" ++
43 which ++ "Mapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"
49 which ++ "Mapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"
tests/LiteralRuleTest.hsnew file+21
@@ -0,0 +1,21 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module LiteralRuleTest where
4+
5+import Data.Text (Text)
6+
7+-- This should produce 8 firings of the "TEXT literal" rule
8+strings :: [Text]
9+strings = [ "abstime", "aclitem", "bit", "bool", "box", "bpchar", "bytea", "char" ]
10+
11+-- This should produce 7 firings of the "TEXT literal UTF8" rule
12+utf8Strings :: [Text]
13+utf8Strings = [ "\0abstime", "\0aclitem", "\xfefe bit", "\0bool", "\0box", "\0bpchar", "\0bytea" ]
14+
15+-- This should produce 4 firings of the "TEXT empty literal" rule
16+empties :: [Text]
17+empties = [ "", "", "", "" ]
18+
19+-- This should produce 5 firings of the "TEXT empty literal" rule
20+--singletons :: [Text]
21+--singletons = [ "a", "b", "c", "d", "e" ]
tests/Makefile+6−1
@@ -1,5 +1,10 @@
1count = 1000
1count = 1000
2
2
3+all: coverage literal-rule-test
4+
5+literal-rule-test:
6+ ./literal-rule-test.sh
7+
3coverage: build coverage/hpc_index.html
8coverage: build coverage/hpc_index.html
4
9
5build: text-test-data
10build: text-test-data
@@ -32,4 +37,4 @@ coverage/hpc_index.html: coverage/coverage.tix
32clean:
37clean:
33 rm -rf dist coverage .hpc
38 rm -rf dist coverage .hpc
34
39
35−.PHONY: build coverage
40+.PHONY: build coverage all literal-rule-test
tests/Tests/Properties.hs+234−73
@@ -1,57 +1,59 @@
1−-- | General quicktest properties for the text library
1+-- | QuickCheck properties for the text library.
2−--
2+
3{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
3{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
4− ScopedTypeVariables, TypeSynonymInstances, CPP #-}
4+ ScopedTypeVariables, TypeSynonymInstances #-}
5−{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}
5+{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}
6−{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
7module Tests.Properties
6module Tests.Properties
8 (
7 (
9 tests
8 tests
10 ) where
9 ) where
11
10
12−import Test.QuickCheck
11+import Control.Applicative ((<$>), (<*>))
13−import Test.QuickCheck.Monadic
14−import Text.Show.Functions ()
15−
16import Control.Arrow ((***), second)
12import Control.Arrow ((***), second)
17−import Control.Exception (catch)
13+import Data.Bits ((.&.))
18import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
14import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
19import Data.Int (Int8, Int16, Int32, Int64)
15import Data.Int (Int8, Int16, Int32, Int64)
20import Data.Monoid (Monoid(..))
16import Data.Monoid (Monoid(..))
21−import Data.String (fromString)
17+import Data.String (IsString(fromString))
22import Data.Text.Encoding.Error
18import Data.Text.Encoding.Error
23import Data.Text.Foreign
19import Data.Text.Foreign
24−import Data.Text.Fusion.Size
20+import Data.Text.Internal.Encoding.Utf8
21+import Data.Text.Internal.Fusion.Size
22+import Data.Text.Internal.Search (indices)
25import Data.Text.Lazy.Read as TL
23import Data.Text.Lazy.Read as TL
26import Data.Text.Read as T
24import Data.Text.Read as T
27−import Data.Text.Search (indices)
28import Data.Word (Word, Word8, Word16, Word32, Word64)
25import Data.Word (Word, Word8, Word16, Word32, Word64)
29−import Numeric (showHex)
26+import Numeric (showEFloat, showFFloat, showGFloat, showHex)
30−import Prelude hiding (catch, replicate)
27+import Prelude hiding (replicate)
31import Test.Framework (Test, testGroup)
28import Test.Framework (Test, testGroup)
32import Test.Framework.Providers.QuickCheck2 (testProperty)
29import 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
33import qualified Data.Bits as Bits (shiftL, shiftR)
37import qualified Data.Bits as Bits (shiftL, shiftR)
34import qualified Data.ByteString as B
38import qualified Data.ByteString as B
35import qualified Data.ByteString.Lazy as BL
39import qualified Data.ByteString.Lazy as BL
36import qualified Data.List as L
40import qualified Data.List as L
37import qualified Data.Text as T
41import qualified Data.Text as T
38import qualified Data.Text.Encoding as E
42import qualified Data.Text.Encoding as E
39−import qualified Data.Text.Fusion as S
40−import qualified Data.Text.Fusion.Common as S
41import qualified Data.Text.IO as T
43import qualified Data.Text.IO as T
44+import qualified Data.Text.Internal.Fusion as S
45+import qualified Data.Text.Internal.Fusion.Common as S
46+import qualified Data.Text.Internal.Lazy.Fusion as SL
47+import qualified Data.Text.Internal.Lazy.Search as S (indices)
48+import qualified Data.Text.Internal.Unsafe.Shift as U
42import qualified Data.Text.Lazy as TL
49import qualified Data.Text.Lazy as TL
43import qualified Data.Text.Lazy.Builder as TB
50import qualified Data.Text.Lazy.Builder as TB
44import qualified Data.Text.Lazy.Builder.Int as TB
51import qualified Data.Text.Lazy.Builder.Int as TB
45import qualified Data.Text.Lazy.Builder.RealFloat as TB
52import qualified Data.Text.Lazy.Builder.RealFloat as TB
46import qualified Data.Text.Lazy.Encoding as EL
53import qualified Data.Text.Lazy.Encoding as EL
47−import qualified Data.Text.Lazy.Fusion as SL
48import qualified Data.Text.Lazy.IO as TL
54import qualified Data.Text.Lazy.IO as TL
49−import qualified Data.Text.Lazy.Search as S (indices)
50−import qualified Data.Text.UnsafeShift as U
51import qualified System.IO as IO
55import qualified System.IO as IO
52−
56+import qualified Tests.Properties.Mul as Mul
53−import Tests.QuickCheckUtils
54−import Tests.Utils
55import qualified Tests.SlowFunctions as Slow
57import qualified Tests.SlowFunctions as Slow
56
58
57t_pack_unpack = (T.unpack . T.pack) `eq` id
59t_pack_unpack = (T.unpack . T.pack) `eq` id
@@ -93,23 +95,88 @@ tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id
93t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
95t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
94tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
96tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
95
97
96−-- This is a poor attempt to ensure that the error handling paths on
98+t_utf8_incr = forAll genUnicode $ \s (Positive n) -> (recode n `eq` id) s
97−-- decode are exercised in some way. Proper testing would be rather
99+ where recode n = T.concat . map fst . feedChunksOf n E.streamDecodeUtf8 .
98−-- more involved.
100+ E.encodeUtf8
101+
102+feedChunksOf :: Int -> (B.ByteString -> E.Decoding) -> B.ByteString
103+ -> [(T.Text, B.ByteString)]
104+feedChunksOf n f bs
105+ | B.null bs = []
106+ | otherwise = let (x,y) = B.splitAt n bs
107+ E.Some t b f' = f x
108+ in (t,b) : feedChunksOf n f' y
109+
110+t_utf8_undecoded = forAll genUnicode $ \t ->
111+ let b = E.encodeUtf8 t
112+ ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
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+
99−t_utf8_err :: DecodeErr -> B.ByteString -> Property
122+t_utf8_err :: Badness -> DecodeErr -> Property
100−t_utf8_err (DE _ de) bs = monadicIO $ do
123+t_utf8_err bad de = 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
101− l <- run $ let len = T.length (E.decodeUtf8With de bs)
132+ l <- run $ let len = T.length (E.decodeUtf8With onErr bs)
102− in (len `seq` return (Right len)) `catch`
133+ in (len `seq` return (Right len)) `Exception.catch`
103− (\(e::UnicodeException) -> return (Left e))
134+ (\(e::UnicodeException) -> return (Left e))
104− case l of
135+ assert $ case l of
105− Left err -> assert $ length (show err) >= 0
136+ Left err -> length (show err) >= 0
106− Right n -> assert $ n >= 0
137+ Right _ -> de /= Strict
107
138
108t_utf8_err' :: B.ByteString -> Property
139t_utf8_err' :: B.ByteString -> Property
109t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of
140t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of
110 Left err -> length (show err) >= 0
141 Left err -> length (show err) >= 0
111 Right t -> T.length t >= 0
142 Right t -> T.length t >= 0
112
143
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+
113s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
180s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
114 where _types = s :: String
181 where _types = s :: String
115sf_Eq p s =
182sf_Eq p s =
@@ -130,8 +197,10 @@ t_Show = show `eq` (show . T.pack)
130tl_Show = show `eq` (show . TL.pack)
197tl_Show = show `eq` (show . TL.pack)
131t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))
198t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))
132tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))
199tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))
200+t_mconcat = unsquare $
133−t_mconcat = mconcat `eq` (unpackS . mconcat . L.map T.pack)
201+ mconcat `eq` (unpackS . mconcat . L.map T.pack)
202+tl_mconcat = unsquare $
134−tl_mconcat = mconcat `eq` (unpackS . mconcat . L.map TL.pack)
203+ mconcat `eq` (unpackS . mconcat . L.map TL.pack)
135t_mempty = mempty == (unpackS (mempty :: T.Text))
204t_mempty = mempty == (unpackS (mempty :: T.Text))
136tl_mempty = mempty == (unpackS (mempty :: TL.Text))
205tl_mempty = mempty == (unpackS (mempty :: TL.Text))
137t_IsString = fromString `eqP` (T.unpack . fromString)
206t_IsString = fromString `eqP` (T.unpack . fromString)
@@ -195,11 +264,14 @@ s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)
195sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)
264sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)
196t_map f = map f `eqP` (unpackS . T.map f)
265t_map f = map f `eqP` (unpackS . T.map f)
197tl_map f = map f `eqP` (unpackS . TL.map f)
266tl_map f = map f `eqP` (unpackS . TL.map f)
267+s_intercalate c = unsquare $
198−s_intercalate c = L.intercalate c `eq`
268+ L.intercalate c `eq`
199 (unpackS . S.intercalate (packS c) . map packS)
269 (unpackS . S.intercalate (packS c) . map packS)
270+t_intercalate c = unsquare $
200−t_intercalate c = L.intercalate c `eq`
271+ L.intercalate c `eq`
201 (unpackS . T.intercalate (packS c) . map packS)
272 (unpackS . T.intercalate (packS c) . map packS)
273+tl_intercalate c = unsquare $
202−tl_intercalate c = L.intercalate c `eq`
274+ L.intercalate c `eq`
203 (unpackS . TL.intercalate (TL.pack c) . map TL.pack)
275 (unpackS . TL.intercalate (TL.pack c) . map TL.pack)
204s_intersperse c = L.intersperse c `eqP`
276s_intersperse c = L.intersperse c `eqP`
205 (unpackS . S.intersperse c)
277 (unpackS . S.intersperse c)
@@ -207,10 +279,14 @@ s_intersperse_s c = L.intersperse c `eqP`
207 (unpackS . S.unstream . S.intersperse c)
279 (unpackS . S.unstream . S.intersperse c)
208sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`
280sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`
209 (unpackS . S.intersperse c . S.filter p)
281 (unpackS . S.intersperse c . S.filter p)
282+t_intersperse c = unsquare $
210−t_intersperse c = L.intersperse c `eqP` (unpackS . T.intersperse c)
283+ L.intersperse c `eqP` (unpackS . T.intersperse c)
284+tl_intersperse c = unsquare $
211−tl_intersperse c = L.intersperse c `eqP` (unpackS . TL.intersperse c)
285+ L.intersperse c `eqP` (unpackS . TL.intersperse c)
286+t_transpose = unsquare $
212−t_transpose = L.transpose `eq` (map unpackS . T.transpose . map packS)
287+ L.transpose `eq` (map unpackS . T.transpose . map packS)
288+tl_transpose = unsquare $
213−tl_transpose = L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)
289+ L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)
214t_reverse = L.reverse `eqP` (unpackS . T.reverse)
290t_reverse = L.reverse `eqP` (unpackS . T.reverse)
215tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)
291tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)
216t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)
292t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)
@@ -222,7 +298,7 @@ tl_replace s d = (L.intercalate d . splitOn s) `eqP`
222
298
223splitOn :: (Eq a) => [a] -> [a] -> [[a]]
299splitOn :: (Eq a) => [a] -> [a] -> [[a]]
224splitOn pat src0
300splitOn pat src0
225− | l == 0 = error "empty"
301+ | l == 0 = error "splitOn: empty"
226 | otherwise = go src0
302 | otherwise = go src0
227 where
303 where
228 l = length pat
304 l = length pat
@@ -307,17 +383,24 @@ sf_foldr p f z = (L.foldr f z . L.filter p) `eqP` (S.foldr f z . S.filter p)
307 where _types = f :: Char -> Char -> Char
383 where _types = f :: Char -> Char -> Char
308t_foldr f z = L.foldr f z `eqP` T.foldr f z
384t_foldr f z = L.foldr f z `eqP` T.foldr f z
309 where _types = f :: Char -> Char -> Char
385 where _types = f :: Char -> Char -> Char
386+tl_foldr f z = unsquare $
310−tl_foldr f z = L.foldr f z `eqP` TL.foldr f z
387+ L.foldr f z `eqP` TL.foldr f z
311 where _types = f :: Char -> Char -> Char
388 where _types = f :: Char -> Char -> Char
389+sf_foldr1 p f = unsquare $
312−sf_foldr1 p f = (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)
390+ (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)
313t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f
391t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f
392+tl_foldr1 f = unsquare $
314−tl_foldr1 f = L.foldr1 f `eqP` TL.foldr1 f
393+ L.foldr1 f `eqP` TL.foldr1 f
315
394
395+s_concat_s = unsquare $
316−s_concat_s = L.concat `eq` (unpackS . S.unstream . S.concat . map packS)
396+ L.concat `eq` (unpackS . S.unstream . S.concat . map packS)
397+sf_concat p = unsquare $
317−sf_concat p = (L.concat . map (L.filter p)) `eq`
398+ (L.concat . map (L.filter p)) `eq`
318 (unpackS . S.concat . map (S.filter p . packS))
399 (unpackS . S.concat . map (S.filter p . packS))
400+t_concat = unsquare $
319−t_concat = L.concat `eq` (unpackS . T.concat . map packS)
401+ L.concat `eq` (unpackS . T.concat . map packS)
402+tl_concat = unsquare $
320−tl_concat = L.concat `eq` (unpackS . TL.concat . map TL.pack)
403+ L.concat `eq` (unpackS . TL.concat . map TL.pack)
321sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`
404sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`
322 (unpackS . S.concatMap (packS . f) . S.filter p)
405 (unpackS . S.concatMap (packS . f) . S.filter p)
323t_concatMap f = unsquare $
406t_concatMap f = unsquare $
@@ -357,6 +440,10 @@ t_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z)
357tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)
440tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)
358 where _types = f :: Int -> Char -> (Int,Char)
441 where _types = f :: Int -> Char -> (Int,Char)
359
442
443+tl_repeat n = (L.take m . L.repeat) `eq`
444+ (unpackS . TL.take (fromIntegral m) . TL.repeat)
445+ where m = fromIntegral (n :: Word8)
446+
360replicate n l = concat (L.replicate n l)
447replicate n l = concat (L.replicate n l)
361
448
362s_replicate n = replicate m `eq`
449s_replicate n = replicate m `eq`
@@ -368,6 +455,14 @@ tl_replicate n = replicate m `eq`
368 (unpackS . TL.replicate (fromIntegral m) . packS)
455 (unpackS . TL.replicate (fromIntegral m) . packS)
369 where m = fromIntegral (n :: Word8)
456 where m = fromIntegral (n :: Word8)
370
457
458+tl_cycle n = (L.take m . L.cycle) `eq`
459+ (unpackS . TL.take (fromIntegral m) . TL.cycle . packS)
460+ where m = fromIntegral (n :: Word8)
461+
462+tl_iterate f n = (L.take m . L.iterate f) `eq`
463+ (unpackS . TL.take (fromIntegral m) . TL.iterate f)
464+ where m = fromIntegral (n :: Word8)
465+
371unf :: Int -> Char -> Maybe (Char, Char)
466unf :: Int -> Char -> Maybe (Char, Char)
372unf n c | fromEnum c * 100 > n = Nothing
467unf n c | fromEnum c * 100 > n = Nothing
373 | otherwise = Just (c, succ c)
468 | otherwise = Just (c, succ c)
@@ -394,14 +489,22 @@ s_take_s m = L.take n `eqP` (unpackS . S.unstream . S.take n)
394sf_take p n = (L.take n . L.filter p) `eqP`
489sf_take p n = (L.take n . L.filter p) `eqP`
395 (unpackS . S.take n . S.filter p)
490 (unpackS . S.take n . S.filter p)
396t_take n = L.take n `eqP` (unpackS . T.take n)
491t_take n = L.take n `eqP` (unpackS . T.take n)
492+t_takeEnd n = (L.reverse . L.take n . L.reverse) `eqP`
493+ (unpackS . T.takeEnd n)
397tl_take n = L.take n `eqP` (unpackS . TL.take (fromIntegral n))
494tl_take n = L.take n `eqP` (unpackS . TL.take (fromIntegral n))
495+tl_takeEnd n = (L.reverse . L.take (fromIntegral n) . L.reverse) `eqP`
496+ (unpackS . TL.takeEnd n)
398s_drop n = L.drop n `eqP` (unpackS . S.drop n)
497s_drop n = L.drop n `eqP` (unpackS . S.drop n)
399s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)
498s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)
400 where n = small m
499 where n = small m
401sf_drop p n = (L.drop n . L.filter p) `eqP`
500sf_drop p n = (L.drop n . L.filter p) `eqP`
402 (unpackS . S.drop n . S.filter p)
501 (unpackS . S.drop n . S.filter p)
403t_drop n = L.drop n `eqP` (unpackS . T.drop n)
502t_drop n = L.drop n `eqP` (unpackS . T.drop n)
503+t_dropEnd n = (L.reverse . L.drop n . L.reverse) `eqP`
504+ (unpackS . T.dropEnd n)
404tl_drop n = L.drop n `eqP` (unpackS . TL.drop (fromIntegral n))
505tl_drop n = L.drop n `eqP` (unpackS . TL.drop (fromIntegral n))
506+tl_dropEnd n = (L.reverse . L.drop n . L.reverse) `eqP`
507+ (unpackS . TL.dropEnd (fromIntegral n))
405s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)
508s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)
406 where n = small m
509 where n = small m
407s_take_drop_s m = (L.take n . L.drop n) `eqP`
510s_take_drop_s m = (L.take n . L.drop n) `eqP`
@@ -413,6 +516,10 @@ sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
413 (unpackS . S.takeWhile p . S.filter q)
516 (unpackS . S.takeWhile p . S.filter q)
414t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
517t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
415tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
518tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
519+t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
520+ (unpackS . T.takeWhileEnd p)
521+tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
522+ (unpackS . TL.takeWhileEnd p)
416s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
523s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
417s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
524s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
418sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
525sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
@@ -465,24 +572,27 @@ tl_groupBy p = L.groupBy p `eqP` (map unpackS . TL.groupBy p)
465t_inits = L.inits `eqP` (map unpackS . T.inits)
572t_inits = L.inits `eqP` (map unpackS . T.inits)
466tl_inits = L.inits `eqP` (map unpackS . TL.inits)
573tl_inits = L.inits `eqP` (map unpackS . TL.inits)
467t_tails = L.tails `eqP` (map unpackS . T.tails)
574t_tails = L.tails `eqP` (map unpackS . T.tails)
575+tl_tails = unsquare $
468−tl_tails = L.tails `eqP` (map unpackS . TL.tails)
576+ L.tails `eqP` (map unpackS . TL.tails)
469−t_findAppendId (NotEmpty s) = unsquare $ \ts ->
577+t_findAppendId = unsquare $ \(NotEmpty s) ts ->
470 let t = T.intercalate s ts
578 let t = T.intercalate s ts
471 in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)
579 in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)
472−tl_findAppendId (NotEmpty s) = unsquare $ \ts ->
580+tl_findAppendId = unsquare $ \(NotEmpty s) ts ->
473 let t = TL.intercalate s ts
581 let t = TL.intercalate s ts
474 in all (==t) $ map (uncurry TL.append) (TL.breakOnAll s t)
582 in all (==t) $ map (uncurry TL.append) (TL.breakOnAll s t)
583+t_findContains = unsquare $ \(NotEmpty s) ->
475−t_findContains (NotEmpty s) = all (T.isPrefixOf s . snd) . T.breakOnAll s .
584+ all (T.isPrefixOf s . snd) . T.breakOnAll s . T.intercalate s
476− T.intercalate s
477−tl_findContains (NotEmpty s) = all (TL.isPrefixOf s . snd) .
585+tl_findContains = unsquare $ \(NotEmpty s) -> all (TL.isPrefixOf s . snd) .
478 TL.breakOnAll s . TL.intercalate s
586 TL.breakOnAll s . TL.intercalate s
479sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c
587sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c
480t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s
588t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s
481tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s
589tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s
482
590
591+t_splitOn_split s = unsquare $
483−t_splitOn_split s = (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s
592+ (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s
593+tl_splitOn_split s = unsquare $
484−tl_splitOn_split s = ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`
594+ ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`
485− (map TL.fromStrict . T.splitOn s)) . T.intercalate s
595+ (map TL.fromStrict . T.splitOn s)) . T.intercalate s
486t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)
596t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)
487tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)
597tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)
488
598
@@ -524,10 +634,14 @@ t_lines' = lines' `eqP` (map unpackS . T.lines')
524t_words = L.words `eqP` (map unpackS . T.words)
634t_words = L.words `eqP` (map unpackS . T.words)
525
635
526tl_words = L.words `eqP` (map unpackS . TL.words)
636tl_words = L.words `eqP` (map unpackS . TL.words)
637+t_unlines = unsquare $
527−t_unlines = L.unlines `eq` (unpackS . T.unlines . map packS)
638+ L.unlines `eq` (unpackS . T.unlines . map packS)
639+tl_unlines = unsquare $
528−tl_unlines = L.unlines `eq` (unpackS . TL.unlines . map packS)
640+ L.unlines `eq` (unpackS . TL.unlines . map packS)
641+t_unwords = unsquare $
529−t_unwords = L.unwords `eq` (unpackS . T.unwords . map packS)
642+ L.unwords `eq` (unpackS . T.unwords . map packS)
643+tl_unwords = unsquare $
530−tl_unwords = L.unwords `eq` (unpackS . TL.unwords . map packS)
644+ L.unwords `eq` (unpackS . TL.unwords . map packS)
531
645
532s_isPrefixOf s = L.isPrefixOf s `eqP`
646s_isPrefixOf s = L.isPrefixOf s `eqP`
533 (S.isPrefixOf (S.stream $ packS s) . S.stream)
647 (S.isPrefixOf (S.stream $ packS s) . S.stream)
@@ -604,8 +718,9 @@ t_indices (NotEmpty s) = Slow.indices s `eq` indices s
604tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
718tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
605 where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)
719 where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)
606 conc = T.concat . TL.toChunks
720 conc = T.concat . TL.toChunks
607−t_indices_occurs (NotEmpty t) ts = let s = T.intercalate t ts
721+t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
722+ let s = T.intercalate t ts
608− in Slow.indices t s == indices t s
723+ in Slow.indices t s == indices t s
609
724
610-- Bit shifts.
725-- Bit shifts.
611shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
726shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
@@ -641,6 +756,7 @@ tb_decimal :: (Integral a, Show a) => a -> Bool
641tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)
756tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)
642
757
643tb_decimal_integer (a::Integer) = tb_decimal a
758tb_decimal_integer (a::Integer) = tb_decimal a
759+tb_decimal_integer_big (Big a) = tb_decimal a
644tb_decimal_int (a::Int) = tb_decimal a
760tb_decimal_int (a::Int) = tb_decimal a
645tb_decimal_int8 (a::Int8) = tb_decimal a
761tb_decimal_int8 (a::Int8) = tb_decimal a
646tb_decimal_int16 (a::Int16) = tb_decimal a
762tb_decimal_int16 (a::Int16) = tb_decimal a
@@ -652,6 +768,11 @@ tb_decimal_word16 (a::Word16) = tb_decimal a
652tb_decimal_word32 (a::Word32) = tb_decimal a
768tb_decimal_word32 (a::Word32) = tb_decimal a
653tb_decimal_word64 (a::Word64) = tb_decimal a
769tb_decimal_word64 (a::Word64) = tb_decimal a
654
770
771+tb_decimal_big_int (BigBounded (a::Int)) = tb_decimal a
772+tb_decimal_big_int64 (BigBounded (a::Int64)) = tb_decimal a
773+tb_decimal_big_word (BigBounded (a::Word)) = tb_decimal a
774+tb_decimal_big_word64 (BigBounded (a::Word64)) = tb_decimal a
775+
655tb_hex :: (Integral a, Show a) => a -> Bool
776tb_hex :: (Integral a, Show a) => a -> Bool
656tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")
777tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")
657
778
@@ -673,6 +794,21 @@ tb_realfloat = (TB.toLazyText . TB.realFloat) `eq` (TL.pack . show)
673tb_realfloat_float (a::Float) = tb_realfloat a
794tb_realfloat_float (a::Float) = tb_realfloat a
674tb_realfloat_double (a::Double) = tb_realfloat a
795tb_realfloat_double (a::Double) = tb_realfloat a
675
796
797+showFloat :: (RealFloat a) => TB.FPFormat -> Maybe Int -> a -> ShowS
798+showFloat TB.Exponent = showEFloat
799+showFloat TB.Fixed = showFFloat
800+showFloat TB.Generic = showGFloat
801+
802+tb_formatRealFloat :: (RealFloat a, Show a) =>
803+ a -> TB.FPFormat -> Precision a -> Property
804+tb_formatRealFloat a fmt prec =
805+ TB.formatRealFloat fmt p a ===
806+ TB.fromString (showFloat fmt p a "")
807+ where p = precision a prec
808+
809+tb_formatRealFloat_float (a::Float) = tb_formatRealFloat a
810+tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a
811+
676-- Reading.
812-- Reading.
677
813
678t_decimal (n::Int) s =
814t_decimal (n::Int) s =
@@ -681,16 +817,18 @@ t_decimal (n::Int) s =
681tl_decimal (n::Int) s =
817tl_decimal (n::Int) s =
682 TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
818 TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
683 where t = TL.dropWhile isDigit s
819 where t = TL.dropWhile isDigit s
684−t_hexadecimal (n::Positive Int) s ox =
820+t_hexadecimal m s ox =
685 T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
821 T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
686 where t = T.dropWhile isHexDigit s
822 where t = T.dropWhile isHexDigit s
687 p = if ox then "0x" else ""
823 p = if ox then "0x" else ""
688−tl_hexadecimal (n::Positive Int) s ox =
824+ n = getPositive m :: Int
825+tl_hexadecimal m s ox =
689 TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
826 TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
690 where t = TL.dropWhile isHexDigit s
827 where t = TL.dropWhile isHexDigit s
691 p = if ox then "0x" else ""
828 p = if ox then "0x" else ""
829+ n = getPositive m :: Int
692
830
693−isFloaty c = c `elem` "+-.0123456789eE"
831+isFloaty c = c `elem` ("+-.0123456789eE" :: String)
694
832
695t_read_rational p tol (n::Double) s =
833t_read_rational p tol (n::Double) s =
696 case p (T.pack (show n) `T.append` t) of
834 case p (T.pack (show n) `T.append` t) of
@@ -733,6 +871,8 @@ t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) == t
733 where n = small m
871 where n = small m
734t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
872t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
735
873
874+t_copy t = T.copy t == t
875+
736-- Regression tests.
876-- Regression tests.
737s_filter_eq s = S.filter p t == S.streamList (filter p s)
877s_filter_eq s = S.filter p t == S.streamList (filter p s)
738 where p = (/= S.last t)
878 where p = (/= S.last t)
@@ -769,6 +909,8 @@ tests =
769 testProperty "tl_latin1" tl_latin1,
909 testProperty "tl_latin1" tl_latin1,
770 testProperty "t_utf8" t_utf8,
910 testProperty "t_utf8" t_utf8,
771 testProperty "t_utf8'" t_utf8',
911 testProperty "t_utf8'" t_utf8',
912+ testProperty "t_utf8_incr" t_utf8_incr,
913+ testProperty "t_utf8_undecoded" t_utf8_undecoded,
772 testProperty "tl_utf8" tl_utf8,
914 testProperty "tl_utf8" tl_utf8,
773 testProperty "tl_utf8'" tl_utf8',
915 testProperty "tl_utf8'" tl_utf8',
774 testProperty "t_utf16LE" t_utf16LE,
916 testProperty "t_utf16LE" t_utf16LE,
@@ -968,9 +1110,12 @@ tests =
968 ],
1110 ],
969
1111
970 testGroup "unfolds" [
1112 testGroup "unfolds" [
1113+ testProperty "tl_repeat" tl_repeat,
971 testProperty "s_replicate" s_replicate,
1114 testProperty "s_replicate" s_replicate,
972 testProperty "t_replicate" t_replicate,
1115 testProperty "t_replicate" t_replicate,
973 testProperty "tl_replicate" tl_replicate,
1116 testProperty "tl_replicate" tl_replicate,
1117+ testProperty "tl_cycle" tl_cycle,
1118+ testProperty "tl_iterate" tl_iterate,
974 testProperty "t_unfoldr" t_unfoldr,
1119 testProperty "t_unfoldr" t_unfoldr,
975 testProperty "tl_unfoldr" tl_unfoldr,
1120 testProperty "tl_unfoldr" tl_unfoldr,
976 testProperty "t_unfoldrN" t_unfoldrN,
1121 testProperty "t_unfoldrN" t_unfoldrN,
@@ -984,12 +1129,16 @@ tests =
984 testProperty "s_take_s" s_take_s,
1129 testProperty "s_take_s" s_take_s,
985 testProperty "sf_take" sf_take,
1130 testProperty "sf_take" sf_take,
986 testProperty "t_take" t_take,
1131 testProperty "t_take" t_take,
1132+ testProperty "t_takeEnd" t_takeEnd,
987 testProperty "tl_take" tl_take,
1133 testProperty "tl_take" tl_take,
1134+ testProperty "tl_takeEnd" tl_takeEnd,
988 testProperty "s_drop" s_drop,
1135 testProperty "s_drop" s_drop,
989 testProperty "s_drop_s" s_drop_s,
1136 testProperty "s_drop_s" s_drop_s,
990 testProperty "sf_drop" sf_drop,
1137 testProperty "sf_drop" sf_drop,
991 testProperty "t_drop" t_drop,
1138 testProperty "t_drop" t_drop,
1139+ testProperty "t_dropEnd" t_dropEnd,
992 testProperty "tl_drop" tl_drop,
1140 testProperty "tl_drop" tl_drop,
1141+ testProperty "tl_dropEnd" tl_dropEnd,
993 testProperty "s_take_drop" s_take_drop,
1142 testProperty "s_take_drop" s_take_drop,
994 testProperty "s_take_drop_s" s_take_drop_s,
1143 testProperty "s_take_drop_s" s_take_drop_s,
995 testProperty "s_takeWhile" s_takeWhile,
1144 testProperty "s_takeWhile" s_takeWhile,
@@ -997,6 +1146,8 @@ tests =
997 testProperty "sf_takeWhile" sf_takeWhile,
1146 testProperty "sf_takeWhile" sf_takeWhile,
998 testProperty "t_takeWhile" t_takeWhile,
1147 testProperty "t_takeWhile" t_takeWhile,
999 testProperty "tl_takeWhile" tl_takeWhile,
1148 testProperty "tl_takeWhile" tl_takeWhile,
1149+ testProperty "t_takeWhileEnd" t_takeWhileEnd,
1150+ testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1000 testProperty "sf_dropWhile" sf_dropWhile,
1151 testProperty "sf_dropWhile" sf_dropWhile,
1001 testProperty "s_dropWhile" s_dropWhile,
1152 testProperty "s_dropWhile" s_dropWhile,
1002 testProperty "s_dropWhile_s" s_dropWhile_s,
1153 testProperty "s_dropWhile_s" s_dropWhile_s,
@@ -1142,11 +1293,16 @@ tests =
1142 testProperty "tb_decimal_int32" tb_decimal_int32,
1293 testProperty "tb_decimal_int32" tb_decimal_int32,
1143 testProperty "tb_decimal_int64" tb_decimal_int64,
1294 testProperty "tb_decimal_int64" tb_decimal_int64,
1144 testProperty "tb_decimal_integer" tb_decimal_integer,
1295 testProperty "tb_decimal_integer" tb_decimal_integer,
1296+ testProperty "tb_decimal_integer_big" tb_decimal_integer_big,
1145 testProperty "tb_decimal_word" tb_decimal_word,
1297 testProperty "tb_decimal_word" tb_decimal_word,
1146 testProperty "tb_decimal_word8" tb_decimal_word8,
1298 testProperty "tb_decimal_word8" tb_decimal_word8,
1147 testProperty "tb_decimal_word16" tb_decimal_word16,
1299 testProperty "tb_decimal_word16" tb_decimal_word16,
1148 testProperty "tb_decimal_word32" tb_decimal_word32,
1300 testProperty "tb_decimal_word32" tb_decimal_word32,
1149− testProperty "tb_decimal_word64" tb_decimal_word64
1301+ testProperty "tb_decimal_word64" tb_decimal_word64,
1302+ testProperty "tb_decimal_big_int" tb_decimal_big_int,
1303+ testProperty "tb_decimal_big_word" tb_decimal_big_word,
1304+ testProperty "tb_decimal_big_int64" tb_decimal_big_int64,
1305+ testProperty "tb_decimal_big_word64" tb_decimal_big_word64
1150 ],
1306 ],
1151 testGroup "hexadecimal" [
1307 testGroup "hexadecimal" [
1152 testProperty "tb_hexadecimal_int" tb_hexadecimal_int,
1308 testProperty "tb_hexadecimal_int" tb_hexadecimal_int,
@@ -1163,7 +1319,9 @@ tests =
1163 ],
1319 ],
1164 testGroup "realfloat" [
1320 testGroup "realfloat" [
1165 testProperty "tb_realfloat_double" tb_realfloat_double,
1321 testProperty "tb_realfloat_double" tb_realfloat_double,
1166− testProperty "tb_realfloat_float" tb_realfloat_float
1322+ testProperty "tb_realfloat_float" tb_realfloat_float,
1323+ testProperty "tb_formatRealFloat_float" tb_formatRealFloat_float,
1324+ testProperty "tb_formatRealFloat_double" tb_formatRealFloat_double
1167 ],
1325 ],
1168 testProperty "tb_fromText" tb_fromText,
1326 testProperty "tb_fromText" tb_fromText,
1169 testProperty "tb_singleton" tb_singleton
1327 testProperty "tb_singleton" tb_singleton
@@ -1197,6 +1355,9 @@ tests =
1197 testProperty "t_dropWord16" t_dropWord16,
1355 testProperty "t_dropWord16" t_dropWord16,
1198 testProperty "t_takeWord16" t_takeWord16,
1356 testProperty "t_takeWord16" t_takeWord16,
1199 testProperty "t_take_drop_16" t_take_drop_16,
1357 testProperty "t_take_drop_16" t_take_drop_16,
1200− testProperty "t_use_from" t_use_from
1358+ testProperty "t_use_from" t_use_from,
1359+ testProperty "t_copy" t_copy
1201− ]
1360+ ],
1361+
1362+ testGroup "mul" Mul.tests
1202 ]
1363 ]
tests/Tests/Properties/Mul.hsnew file+40
@@ -0,0 +1,40 @@
1+{-# LANGUAGE ScopedTypeVariables #-}
2+
3+module Tests.Properties.Mul (tests) where
4+
5+import Control.Applicative ((<$>), pure)
6+import Control.Exception as E (SomeException, catch, evaluate)
7+import Data.Int (Int32, Int64)
8+import Data.Text.Internal (mul, mul32, mul64)
9+import System.IO.Unsafe (unsafePerformIO)
10+import Test.Framework (Test)
11+import Test.Framework.Providers.QuickCheck2 (testProperty)
12+import Test.QuickCheck hiding ((.&.))
13+
14+mulRef :: (Integral a, Bounded a) => a -> a -> Maybe a
15+mulRef a b
16+ | ab < bot || ab > top = Nothing
17+ | otherwise = Just (fromIntegral ab)
18+ where ab = fromIntegral a * fromIntegral b
19+ top = fromIntegral (maxBound `asTypeOf` a) :: Integer
20+ bot = fromIntegral (minBound `asTypeOf` a) :: Integer
21+
22+eval :: (a -> b -> c) -> a -> b -> Maybe c
23+eval f a b = unsafePerformIO $
24+ (Just <$> evaluate (f a b)) `E.catch` (\(_::SomeException) -> pure Nothing)
25+
26+t_mul32 :: Int32 -> Int32 -> Property
27+t_mul32 a b = mulRef a b === eval mul32 a b
28+
29+t_mul64 :: Int64 -> Int64 -> Property
30+t_mul64 a b = mulRef a b === eval mul64 a b
31+
32+t_mul :: Int -> Int -> Property
33+t_mul a b = mulRef a b === eval mul a b
34+
35+tests :: [Test]
36+tests = [
37+ testProperty "t_mul" t_mul
38+ , testProperty "t_mul32" t_mul32
39+ , testProperty "t_mul64" t_mul64
40+ ]
tests/Tests/QuickCheckUtils.hs+107−84
@@ -10,107 +10,91 @@ module Tests.QuickCheckUtils
10 , unsquare
10 , unsquare
11 , smallArbitrary
11 , smallArbitrary
12
12
13+ , BigBounded(..)
14+ , BigInt(..)
13− , NotEmpty (..)
15+ , NotEmpty(..)
14
16
15− , Small (..)
17+ , Small(..)
16 , small
18 , small
17
19
20+ , Precision(..)
21+ , precision
22+
18 , integralRandomR
23 , integralRandomR
19
24
20− , DecodeErr (..)
25+ , DecodeErr(..)
26+ , genDecodeErr
21
27
22− , Stringy (..)
28+ , Stringy(..)
23 , eq
29 , eq
24 , eqP
30 , eqP
25
31
26− , Encoding (..)
32+ , Encoding(..)
27
33
28 , write_read
34 , write_read
29 ) where
35 ) where
30
36
37+import Control.Applicative ((<$>))
31import Control.Arrow (first, (***))
38import Control.Arrow (first, (***))
32import Control.DeepSeq (NFData (..), deepseq)
39import Control.DeepSeq (NFData (..), deepseq)
33import Control.Exception (bracket)
40import Control.Exception (bracket)
34−import Data.Bits ((.&.))
35−import Data.Char (chr)
36−import Data.Word (Word8, Word16)
37import Data.String (IsString, fromString)
41import Data.String (IsString, fromString)
38import Data.Text.Foreign (I16)
42import Data.Text.Foreign (I16)
43+import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))
44+import Data.Word (Word8, Word16)
39import Debug.Trace (trace)
45import Debug.Trace (trace)
40−import System.Random (Random (..), RandomGen)
46+import System.Random (Random(..), RandomGen)
41−import Test.QuickCheck hiding ((.&.))
47+import Test.QuickCheck hiding (Fixed(..), Small (..), (.&.))
42import Test.QuickCheck.Monadic (assert, monadicIO, run)
48import Test.QuickCheck.Monadic (assert, monadicIO, run)
49+import Test.QuickCheck.Unicode (string)
50+import Tests.Utils
43import qualified Data.ByteString as B
51import qualified Data.ByteString as B
44import qualified Data.Text as T
52import qualified Data.Text as T
45import qualified Data.Text.Encoding.Error as T
53import qualified Data.Text.Encoding.Error as T
46−import qualified Data.Text.Fusion as TF
54+import qualified Data.Text.Internal.Fusion as TF
47−import qualified Data.Text.Fusion.Common as TF
55+import 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
48import qualified Data.Text.Lazy as TL
58import qualified Data.Text.Lazy as TL
49−import qualified Data.Text.Lazy.Fusion as TLF
50−import qualified Data.Text.Lazy.Internal as TL
51import qualified System.IO as IO
59import qualified System.IO as IO
52
60
53−import Tests.Utils
61+#if !MIN_VERSION_base(4,4,0)
62+import Data.Int (Int64)
63+import Data.Word (Word, Word64)
64+#endif
65+
66+genUnicode :: IsString a => Gen a
67+genUnicode = fromString <$> string
54
68
55instance Random I16 where
69instance Random I16 where
56 randomR = integralRandomR
70 randomR = integralRandomR
57 random = randomR (minBound,maxBound)
71 random = randomR (minBound,maxBound)
58
72
59instance Arbitrary I16 where
73instance Arbitrary I16 where
60− arbitrary = choose (minBound,maxBound)
74+ arbitrary = arbitrarySizedIntegral
75+ shrink = shrinkIntegral
61
76
62instance Arbitrary B.ByteString where
77instance Arbitrary B.ByteString where
63 arbitrary = B.pack `fmap` arbitrary
78 arbitrary = B.pack `fmap` arbitrary
79+ shrink = map B.pack . shrink . B.unpack
64
80
65−genUnicode :: IsString a => Gen a
81+#if !MIN_VERSION_base(4,4,0)
66−genUnicode = fmap fromString string where
82+instance Random Int64 where
67− string = sized $ \n ->
83+ randomR = integralRandomR
68− do k <- choose (0,n)
84+ random = randomR (minBound,maxBound)
69− sequence [ char | _ <- [1..k] ]
85+
70−
86+instance Random Word where
71− excluding :: [a -> Bool] -> Gen a -> Gen a
87+ randomR = integralRandomR
72− excluding bad gen = loop
88+ random = randomR (minBound,maxBound)
73− where
89+
74− loop = do
90+instance Random Word8 where
75− x <- gen
91+ randomR = integralRandomR
76− if or (map ($ x) bad)
92+ random = randomR (minBound,maxBound)
77− then loop
93+
78− else return x
94+instance Random Word64 where
79−
95+ randomR = integralRandomR
80− reserved = [lowSurrogate, highSurrogate, noncharacter]
96+ random = randomR (minBound,maxBound)
81− lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF
97+#endif
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)
114
98
115-- For tests that have O(n^2) running times or input sizes, resize
99-- For tests that have O(n^2) running times or input sizes, resize
116-- their inputs to the square root of the originals.
100-- their inputs to the square root of the originals.
@@ -123,9 +107,25 @@ smallArbitrary = sized $ \n -> resize (smallish n) arbitrary
123
107
124instance Arbitrary T.Text where
108instance Arbitrary T.Text where
125 arbitrary = T.pack `fmap` arbitrary
109 arbitrary = T.pack `fmap` arbitrary
110+ shrink = map T.pack . shrink . T.unpack
126
111
127instance Arbitrary TL.Text where
112instance Arbitrary TL.Text where
128 arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary
113 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,15 +138,23 @@ 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
141
142
142instance Arbitrary (NotEmpty T.Text) where
143instance Arbitrary (NotEmpty T.Text) where
143 arbitrary = (fmap T.pack) `fmap` arbitrary
144 arbitrary = (fmap T.pack) `fmap` arbitrary
145+ shrink = shrinkNotEmpty T.null
144
146
145instance Arbitrary (NotEmpty TL.Text) where
147instance Arbitrary (NotEmpty TL.Text) where
146 arbitrary = (fmap TL.pack) `fmap` arbitrary
148 arbitrary = (fmap TL.pack) `fmap` arbitrary
149+ shrink = shrinkNotEmpty TL.null
147
150
148instance Arbitrary (NotEmpty B.ByteString) where
151instance Arbitrary (NotEmpty B.ByteString) where
149 arbitrary = (fmap B.pack) `fmap` arbitrary
152 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') ]
150
158
151data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7
159data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7
152 | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15
160 | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15
@@ -187,23 +195,25 @@ instance Random Small where
187 random = randomR (minBound,maxBound)
195 random = randomR (minBound,maxBound)
188
196
189instance Arbitrary Small where
197instance Arbitrary Small where
190− arbitrary = choose (minBound,maxBound)
198+ arbitrary = choose (minBound, maxBound)
199+ shrink = shrinkIntegral
191
200
192integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
201integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
193integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
202integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
194 fromIntegral b :: Integer) g of
203 fromIntegral b :: Integer) g of
195 (x,h) -> (fromIntegral x, h)
204 (x,h) -> (fromIntegral x, h)
196
205
197−data DecodeErr = DE String T.OnDecodeError
206+data DecodeErr = Lenient | Ignore | Strict | Replace
207+ deriving (Show, Eq)
198
208
199−instance Show DecodeErr where
209+genDecodeErr :: DecodeErr -> Gen T.OnDecodeError
200− show (DE d _) = "DE " ++ d
210+genDecodeErr Lenient = return T.lenientDecode
211+genDecodeErr Ignore = return T.ignore
212+genDecodeErr Strict = return T.strictDecode
213+genDecodeErr Replace = arbitrary
201
214
202instance Arbitrary DecodeErr where
215instance Arbitrary DecodeErr where
203− arbitrary = oneof [ return $ DE "lenient" T.lenientDecode
216+ arbitrary = elements [Lenient, Ignore, Strict, Replace]
204− , return $ DE "ignore" T.ignore
205− , return $ DE "strict" T.strictDecode
206− , DE "replace" `fmap` arbitrary ]
207
217
208class Stringy s where
218class Stringy s where
209 packS :: String -> s
219 packS :: String -> s
@@ -257,6 +267,30 @@ eqP f g s w = eql "orig" (f s) (g t) &&
257 | a =^= b = True
267 | a =^= b = True
258 | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
268 | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
259
269
270+instance Arbitrary FPFormat where
271+ arbitrary = elements [Exponent, Fixed, Generic]
272+
273+newtype Precision a = Precision (Maybe Int)
274+ deriving (Eq, Show)
275+
276+precision :: a -> Precision a -> Maybe Int
277+precision _ (Precision prec) = prec
278+
279+arbitraryPrecision :: Int -> Gen (Precision a)
280+arbitraryPrecision maxDigits = Precision <$> do
281+ n <- choose (-1,maxDigits)
282+ return $ if n == -1
283+ then Nothing
284+ else Just n
285+
286+instance Arbitrary (Precision Float) where
287+ arbitrary = arbitraryPrecision 11
288+ shrink = map Precision . shrink . precision undefined
289+
290+instance Arbitrary (Precision Double) where
291+ arbitrary = arbitraryPrecision 22
292+ shrink = map Precision . shrink . precision undefined
293+
260-- Work around lack of Show instance for TextEncoding.
294-- Work around lack of Show instance for TextEncoding.
261data Encoding = E String IO.TextEncoding
295data Encoding = E String IO.TextEncoding
262
296
@@ -274,17 +308,6 @@ windowsNewlineMode = IO.NewlineMode
274 { IO.inputNL = IO.CRLF, IO.outputNL = IO.CRLF
308 { IO.inputNL = IO.CRLF, IO.outputNL = IO.CRLF
275 }
309 }
276
310
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−
288instance Arbitrary IO.NewlineMode where
311instance Arbitrary IO.NewlineMode where
289 arbitrary = oneof . map return $
312 arbitrary = oneof . map return $
290 [ IO.noNewlineTranslation, IO.universalNewlineMode, IO.nativeNewlineMode
313 [ IO.noNewlineTranslation, IO.universalNewlineMode, IO.nativeNewlineMode
tests/Tests/Regressions.hs+15−1
@@ -8,7 +8,7 @@ module Tests.Regressions
8
8
9import Control.Exception (SomeException, handle)
9import Control.Exception (SomeException, handle)
10import System.IO
10import System.IO
11−import Test.HUnit (assertBool, assertFailure)
11+import Test.HUnit (assertBool, assertEqual, assertFailure)
12import qualified Data.ByteString as B
12import qualified Data.ByteString as B
13import Data.ByteString.Char8 ()
13import Data.ByteString.Char8 ()
14import qualified Data.ByteString.Lazy as LB
14import qualified Data.ByteString.Lazy as LB
@@ -17,6 +17,7 @@ import qualified Data.Text.Encoding as TE
17import qualified Data.Text.IO as T
17import qualified Data.Text.IO as T
18import qualified Data.Text.Lazy as LT
18import qualified Data.Text.Lazy as LT
19import qualified Data.Text.Lazy.Encoding as LE
19import qualified Data.Text.Lazy.Encoding as LE
20+import qualified Data.Text.Unsafe as T
20import qualified Test.Framework as F
21import qualified Test.Framework as F
21import qualified Test.Framework.Providers.HUnit as F
22import qualified Test.Framework.Providers.HUnit as F
22
23
@@ -59,10 +60,23 @@ utf8_decode_unsafe = do
59 let t = TE.decodeUtf8With (\_ _ -> Just '\xdc00') "\x80"
60 let t = TE.decodeUtf8With (\_ _ -> Just '\xdc00') "\x80"
60 assertBool "broken error recovery shouldn't break us" (t == "\xfffd")
61 assertBool "broken error recovery shouldn't break us" (t == "\xfffd")
61
62
63+-- Reported by Eric Seidel: we mishandled mapping Chars that fit in a
64+-- single Word16 to Chars that require two.
65+mapAccumL_resize :: IO ()
66+mapAccumL_resize = do
67+ let f a _ = (a, '\65536')
68+ count = 5
69+ val = T.mapAccumL f (0::Int) (T.replicate count "a")
70+ assertEqual "mapAccumL should correctly fill buffers for two-word results"
71+ (0, T.replicate count "\65536") val
72+ assertEqual "mapAccumL should correctly size buffers for two-word results"
73+ (count * 2) (T.lengthWord16 (snd val))
74+
62tests :: F.Test
75tests :: F.Test
63tests = F.testGroup "Regressions"
76tests = F.testGroup "Regressions"
64 [ F.testCase "hGetContents_crash" hGetContents_crash
77 [ F.testCase "hGetContents_crash" hGetContents_crash
65 , F.testCase "lazy_encode_crash" lazy_encode_crash
78 , F.testCase "lazy_encode_crash" lazy_encode_crash
79+ , F.testCase "mapAccumL_resize" mapAccumL_resize
66 , F.testCase "replicate_crash" replicate_crash
80 , F.testCase "replicate_crash" replicate_crash
67 , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe
81 , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe
68 ]
82 ]
tests/cabal.confignew file+6
@@ -0,0 +1,6 @@
1+-- These flags help to speed up building the test suite.
2+
3+documentation: False
4+executable-stripping: False
5+flags: developer
6+library-profiling: False
tests/literal-rule-test.shnew file+29
@@ -0,0 +1,29 @@
1+#!/bin/bash -e
2+
3+failed=0
4+
5+function check_firings() {
6+ rule=$1
7+ expected=$2
8+ build="ghc -O -ddump-rule-firings LiteralRuleTest.hs"
9+ build="$build -i.. -I../include"
10+ touch LiteralRuleTest.hs
11+ echo -n "Want to see $expected firings of rule $rule... " >&2
12+ firings=$($build 2>&1 | grep "Rule fired: $rule\$" | wc -l)
13+ rm -f LiteralRuleTest.{o.hi}
14+
15+ if [ $firings != $expected ]; then
16+ echo "failed, saw $firings" >&2
17+ failed=1
18+ else
19+ echo "pass" >&2
20+ fi
21+}
22+
23+check_firings "TEXT literal" 8
24+check_firings "TEXT literal UTF8" 7
25+check_firings "TEXT empty literal" 4
26+# This is broken at the moment. "TEXT literal" rule fires instead.
27+#check_firings "TEXT singleton literal" 5
28+
29+exit $failed
tests/text-tests.cabal+46−26
@@ -2,8 +2,8 @@ name: text-tests
2version: 0.0.0.0
2version: 0.0.0.0
3synopsis: Functional tests for the text package
3synopsis: Functional tests for the text package
4description: Functional tests for the text package
4description: Functional tests for the text package
5−homepage: https://bitbucket.org/bos/text
5+homepage: https://github.com/bos/text
6−license: BSD3
6+license: BSD2
7license-file: ../LICENSE
7license-file: ../LICENSE
8author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
8author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
9 Bryan O'Sullivan <bos@serpentine.com>,
9 Bryan O'Sullivan <bos@serpentine.com>,
@@ -18,10 +18,20 @@ cabal-version: >=1.8
18flag hpc
18flag hpc
19 description: Enable HPC to generate coverage reports
19 description: Enable HPC to generate coverage reports
20 default: False
20 default: False
21+ manual: True
21
22
22executable text-tests
23executable text-tests
23 main-is: Tests.hs
24 main-is: Tests.hs
24
25
26+ other-modules:
27+ Tests.IO
28+ Tests.Properties
29+ Tests.Properties.Mul
30+ Tests.QuickCheckUtils
31+ Tests.Regressions
32+ Tests.SlowFunctions
33+ Tests.Utils
34+
25 ghc-options:
35 ghc-options:
26 -Wall -threaded -O0 -rtsopts
36 -Wall -threaded -O0 -rtsopts
27
37
@@ -30,16 +40,18 @@ executable text-tests
30 -fhpc
40 -fhpc
31
41
32 cpp-options:
42 cpp-options:
43+ -DTEST_SUITE
33 -DASSERTS
44 -DASSERTS
34 -DHAVE_DEEPSEQ
45 -DHAVE_DEEPSEQ
35
46
36 build-depends:
47 build-depends:
37 HUnit >= 1.2,
48 HUnit >= 1.2,
38− QuickCheck >= 2.4,
49+ QuickCheck >= 2.7,
39 base == 4.*,
50 base == 4.*,
40 bytestring,
51 bytestring,
41 deepseq,
52 deepseq,
42 directory,
53 directory,
54+ quickcheck-unicode,
43 random,
55 random,
44 test-framework >= 0.4,
56 test-framework >= 0.4,
45 test-framework-hunit >= 0.2,
57 test-framework-hunit >= 0.2,
@@ -64,52 +76,59 @@ executable text-tests-stdio
64library
76library
65 hs-source-dirs: ..
77 hs-source-dirs: ..
66 c-sources: ../cbits/cbits.c
78 c-sources: ../cbits/cbits.c
79+ include-dirs: ../include
80+ ghc-options: -Wall
67 exposed-modules:
81 exposed-modules:
68 Data.Text
82 Data.Text
69 Data.Text.Array
83 Data.Text.Array
70 Data.Text.Encoding
84 Data.Text.Encoding
71 Data.Text.Encoding.Error
85 Data.Text.Encoding.Error
72− Data.Text.Encoding.Fusion
86+ Data.Text.Internal.Encoding.Fusion
73− Data.Text.Encoding.Fusion.Common
87+ Data.Text.Internal.Encoding.Fusion.Common
74− Data.Text.Encoding.Utf16
88+ Data.Text.Internal.Encoding.Utf16
75− Data.Text.Encoding.Utf32
89+ Data.Text.Internal.Encoding.Utf32
76− Data.Text.Encoding.Utf8
90+ Data.Text.Internal.Encoding.Utf8
77 Data.Text.Foreign
91 Data.Text.Foreign
78− Data.Text.Fusion
92+ Data.Text.Internal.Fusion
79− Data.Text.Fusion.CaseMapping
93+ Data.Text.Internal.Fusion.CaseMapping
80− Data.Text.Fusion.Common
94+ Data.Text.Internal.Fusion.Common
81− Data.Text.Fusion.Internal
95+ Data.Text.Internal.Fusion.Size
82− Data.Text.Fusion.Size
96+ Data.Text.Internal.Fusion.Types
83 Data.Text.IO
97 Data.Text.IO
84− Data.Text.IO.Internal
98+ Data.Text.Internal.IO
85 Data.Text.Internal
99 Data.Text.Internal
86 Data.Text.Lazy
100 Data.Text.Lazy
87 Data.Text.Lazy.Builder
101 Data.Text.Lazy.Builder
88− Data.Text.Lazy.Builder.Functions
102+ Data.Text.Internal.Builder.Functions
89 Data.Text.Lazy.Builder.Int
103 Data.Text.Lazy.Builder.Int
104+ Data.Text.Internal.Builder.Int.Digits
105+ Data.Text.Internal.Builder
90 Data.Text.Lazy.Builder.RealFloat
106 Data.Text.Lazy.Builder.RealFloat
91− Data.Text.Lazy.Builder.RealFloat.Functions
107+ Data.Text.Internal.Builder.RealFloat.Functions
92 Data.Text.Lazy.Encoding
108 Data.Text.Lazy.Encoding
93− Data.Text.Lazy.Encoding.Fusion
109+ Data.Text.Internal.Lazy.Encoding.Fusion
94− Data.Text.Lazy.Fusion
110+ Data.Text.Internal.Lazy.Fusion
95 Data.Text.Lazy.IO
111 Data.Text.Lazy.IO
96− Data.Text.Lazy.Internal
112+ Data.Text.Internal.Lazy
97 Data.Text.Lazy.Read
113 Data.Text.Lazy.Read
98− Data.Text.Lazy.Search
114+ Data.Text.Internal.Lazy.Search
99− Data.Text.Private
115+ Data.Text.Internal.Private
100 Data.Text.Read
116 Data.Text.Read
101− Data.Text.Search
117+ Data.Text.Show
118+ Data.Text.Internal.Read
119+ Data.Text.Internal.Search
102 Data.Text.Unsafe
120 Data.Text.Unsafe
103− Data.Text.Unsafe.Base
121+ Data.Text.Internal.Unsafe
104− Data.Text.UnsafeChar
122+ Data.Text.Internal.Unsafe.Char
105− Data.Text.UnsafeShift
123+ Data.Text.Internal.Unsafe.Shift
106− Data.Text.Util
124+ Data.Text.Internal.Functions
107
125
108 if flag(hpc)
126 if flag(hpc)
109 ghc-options:
127 ghc-options:
110 -fhpc
128 -fhpc
111
129
112 cpp-options:
130 cpp-options:
131+ -DTEST_SUITE
113 -DHAVE_DEEPSEQ
132 -DHAVE_DEEPSEQ
114 -DASSERTS
133 -DASSERTS
115 -DINTEGER_GMP
134 -DINTEGER_GMP
@@ -117,6 +136,7 @@ library
117 build-depends:
136 build-depends:
118 array,
137 array,
119 base == 4.*,
138 base == 4.*,
139+ binary,
120 bytestring,
140 bytestring,
121 deepseq,
141 deepseq,
122 ghc-prim,
142 ghc-prim,
text.cabal+78−70
@@ -1,5 +1,5 @@
1name: text
1name: text
2−version: 0.11.2.3
2+version: 1.2.2.1
3homepage: https://github.com/bos/text
3homepage: https://github.com/bos/text
4bug-reports: https://github.com/bos/text/issues
4bug-reports: https://github.com/bos/text/issues
5synopsis: An efficient packed Unicode text type.
5synopsis: An efficient packed Unicode text type.
@@ -30,17 +30,8 @@ description:
30 non-standard encodings, text breaking, and locales), see
30 non-standard encodings, text breaking, and locales), see
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− &#8212;&#8212; RELEASE NOTES &#8212;&#8212;
35− .
36− Changes in 0.11.2.0:
37− .
38− * String literals are now converted directly from the format in
39− which GHC stores them into 'Text', without an intermediate
40− transformation through 'String', and without inlining of
41− conversion code at each site where a string literal is declared.
42− .
43−license: BSD3
34+license: BSD2
44license-file: LICENSE
35license-file: LICENSE
45author: Bryan O'Sullivan <bos@serpentine.com>
36author: Bryan O'Sullivan <bos@serpentine.com>
46maintainer: Bryan O'Sullivan <bos@serpentine.com>
37maintainer: Bryan O'Sullivan <bos@serpentine.com>
@@ -56,28 +47,41 @@ extra-source-files:
56 benchmarks/cbits/*.c
47 benchmarks/cbits/*.c
57 benchmarks/haskell/*.hs
48 benchmarks/haskell/*.hs
58 benchmarks/haskell/Benchmarks/*.hs
49 benchmarks/haskell/Benchmarks/*.hs
50+ benchmarks/haskell/Benchmarks/Programs/*.hs
59 benchmarks/python/*.py
51 benchmarks/python/*.py
60 benchmarks/ruby/*.rb
52 benchmarks/ruby/*.rb
61 benchmarks/text-benchmarks.cabal
53 benchmarks/text-benchmarks.cabal
54+ changelog.md
55+ include/*.h
62 scripts/*.hs
56 scripts/*.hs
63 tests-and-benchmarks.markdown
57 tests-and-benchmarks.markdown
64 tests/*.hs
58 tests/*.hs
65 tests/.ghci
59 tests/.ghci
66 tests/Makefile
60 tests/Makefile
67 tests/Tests/*.hs
61 tests/Tests/*.hs
62+ tests/Tests/Properties/*.hs
63+ tests/cabal.config
68 tests/scripts/*.sh
64 tests/scripts/*.sh
69 tests/text-tests.cabal
65 tests/text-tests.cabal
70
66
67+flag bytestring-builder
68+ description: Depend on the bytestring-builder package for backwards compatibility.
69+ default: False
70+ manual: False
71+
71flag developer
72flag developer
72 description: operate in developer mode
73 description: operate in developer mode
73 default: False
74 default: False
75+ manual: True
74
76
75flag integer-simple
77flag integer-simple
76 description: Use the simple integer library instead of GMP
78 description: Use the simple integer library instead of GMP
77 default: False
79 default: False
80+ manual: False
78
81
79library
82library
80− c-sources: cbits/cbits.c
83+ c-sources: cbits/cbits.c
84+ include-dirs: include
81
85
82 exposed-modules:
86 exposed-modules:
83 Data.Text
87 Data.Text
@@ -87,6 +91,32 @@ library
87 Data.Text.Foreign
91 Data.Text.Foreign
88 Data.Text.IO
92 Data.Text.IO
89 Data.Text.Internal
93 Data.Text.Internal
94+ Data.Text.Internal.Builder
95+ Data.Text.Internal.Builder.Functions
96+ Data.Text.Internal.Builder.Int.Digits
97+ Data.Text.Internal.Builder.RealFloat.Functions
98+ Data.Text.Internal.Encoding.Fusion
99+ Data.Text.Internal.Encoding.Fusion.Common
100+ Data.Text.Internal.Encoding.Utf16
101+ Data.Text.Internal.Encoding.Utf32
102+ Data.Text.Internal.Encoding.Utf8
103+ Data.Text.Internal.Functions
104+ Data.Text.Internal.Fusion
105+ Data.Text.Internal.Fusion.CaseMapping
106+ Data.Text.Internal.Fusion.Common
107+ Data.Text.Internal.Fusion.Size
108+ Data.Text.Internal.Fusion.Types
109+ Data.Text.Internal.IO
110+ Data.Text.Internal.Lazy
111+ Data.Text.Internal.Lazy.Encoding.Fusion
112+ Data.Text.Internal.Lazy.Fusion
113+ Data.Text.Internal.Lazy.Search
114+ Data.Text.Internal.Private
115+ Data.Text.Internal.Read
116+ Data.Text.Internal.Search
117+ Data.Text.Internal.Unsafe
118+ Data.Text.Internal.Unsafe.Char
119+ Data.Text.Internal.Unsafe.Shift
90 Data.Text.Lazy
120 Data.Text.Lazy
91 Data.Text.Lazy.Builder
121 Data.Text.Lazy.Builder
92 Data.Text.Lazy.Builder.Int
122 Data.Text.Lazy.Builder.Int
@@ -96,100 +126,78 @@ library
96 Data.Text.Lazy.Internal
126 Data.Text.Lazy.Internal
97 Data.Text.Lazy.Read
127 Data.Text.Lazy.Read
98 Data.Text.Read
128 Data.Text.Read
99− other-modules:
100− Data.Text.Encoding.Fusion
101− Data.Text.Encoding.Fusion.Common
102− Data.Text.Encoding.Utf16
103− Data.Text.Encoding.Utf32
104− Data.Text.Encoding.Utf8
105− Data.Text.Fusion
106− Data.Text.Fusion.CaseMapping
107− Data.Text.Fusion.Common
108− Data.Text.Fusion.Internal
109− Data.Text.Fusion.Size
110− Data.Text.IO.Internal
111− Data.Text.Lazy.Builder.Functions
112− Data.Text.Lazy.Builder.RealFloat.Functions
113− Data.Text.Lazy.Encoding.Fusion
114− Data.Text.Lazy.Fusion
115− Data.Text.Lazy.Search
116− Data.Text.Private
117− Data.Text.Search
118 Data.Text.Unsafe
129 Data.Text.Unsafe
119− Data.Text.Unsafe.Base
130+
120− Data.Text.UnsafeChar
131+ other-modules:
121− Data.Text.UnsafeShift
132+ Data.Text.Show
122− Data.Text.Util
123
133
124 build-depends:
134 build-depends:
125− array,
135+ array >= 0.3,
126− base < 5,
136+ base >= 4.2 && < 5,
127− bytestring >= 0.9
137+ binary,
128− if impl(ghc >= 6.10)
138+ deepseq >= 1.1.0.0,
139+ ghc-prim >= 0.2
140+
141+ if flag(bytestring-builder)
129− build-depends:
142+ build-depends: bytestring >= 0.9 && < 0.10.4,
130− ghc-prim, base >= 4, deepseq >= 1.1.0.0
143+ bytestring-builder >= 0.10.4
131− cpp-options: -DHAVE_DEEPSEQ
132 else
144 else
133− build-depends: extensible-exceptions
145+ build-depends: bytestring >= 0.10.4
134− extensions: ScopedTypeVariables
135
146
147+ cpp-options: -DHAVE_DEEPSEQ
136− ghc-options: -Wall -funbox-strict-fields -O2
148+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
137− if impl(ghc >= 6.8)
138− ghc-options: -fwarn-tabs
139 if flag(developer)
149 if flag(developer)
140 ghc-prof-options: -auto-all
150 ghc-prof-options: -auto-all
141 ghc-options: -Werror
151 ghc-options: -Werror
142 cpp-options: -DASSERTS
152 cpp-options: -DASSERTS
143
153
144− if impl(ghc >= 6.11)
145− if flag(integer-simple)
154+ if flag(integer-simple)
146− cpp-options: -DINTEGER_SIMPLE
155+ cpp-options: -DINTEGER_SIMPLE
147− build-depends: integer-simple >= 0.1 && < 0.5
156+ build-depends: integer-simple >= 0.1 && < 0.5
148− else
157+ else
149− cpp-options: -DINTEGER_GMP
150− build-depends: integer-gmp >= 0.2
151−
152− if impl(ghc >= 6.9) && impl(ghc < 6.11)
153 cpp-options: -DINTEGER_GMP
158 cpp-options: -DINTEGER_GMP
154− build-depends: integer >= 0.1 && < 0.2
159+ build-depends: integer-gmp >= 0.2
155
160
156test-suite tests
161test-suite tests
157 type: exitcode-stdio-1.0
162 type: exitcode-stdio-1.0
158 hs-source-dirs: tests .
163 hs-source-dirs: tests .
159 main-is: Tests.hs
164 main-is: Tests.hs
160 c-sources: cbits/cbits.c
165 c-sources: cbits/cbits.c
166+ include-dirs: include
161
167
162 ghc-options:
168 ghc-options:
163 -Wall -threaded -O0 -rtsopts
169 -Wall -threaded -O0 -rtsopts
164
170
165 cpp-options:
171 cpp-options:
166− -DASSERTS -DHAVE_DEEPSEQ
172+ -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE
167
173
168 build-depends:
174 build-depends:
169 HUnit >= 1.2,
175 HUnit >= 1.2,
170− QuickCheck >= 2.4,
176+ QuickCheck >= 2.7,
171 array,
177 array,
172 base,
178 base,
173− bytestring,
179+ binary,
174 deepseq,
180 deepseq,
175 directory,
181 directory,
176 ghc-prim,
182 ghc-prim,
183+ quickcheck-unicode,
177 random,
184 random,
178 test-framework >= 0.4,
185 test-framework >= 0.4,
179 test-framework-hunit >= 0.2,
186 test-framework-hunit >= 0.2,
180 test-framework-quickcheck2 >= 0.2
187 test-framework-quickcheck2 >= 0.2
181
188
182− if impl(ghc >= 6.11)
189+ if flag(bytestring-builder)
183− if flag(integer-simple)
184− cpp-options: -DINTEGER_SIMPLE
185− build-depends: integer-simple >= 0.1 && < 0.5
190+ build-depends: bytestring >= 0.9 && < 0.10.4,
191+ bytestring-builder >= 0.10.4
186− else
192+ else
187− cpp-options: -DINTEGER_GMP
188− build-depends: integer-gmp >= 0.2
193+ build-depends: bytestring >= 0.10.4
189
194
190− if impl(ghc >= 6.9) && impl(ghc < 6.11)
195+ if flag(integer-simple)
196+ cpp-options: -DINTEGER_SIMPLE
197+ build-depends: integer-simple >= 0.1 && < 0.5
198+ else
191 cpp-options: -DINTEGER_GMP
199 cpp-options: -DINTEGER_GMP
192− build-depends: integer >= 0.1 && < 0.2
200+ build-depends: integer-gmp >= 0.2
193
201
194source-repository head
202source-repository head
195 type: git
203 type: git