git.iko.soy/text
on f91d749 help sign in
bb3d862
swap
0 ahead, 332 behind
78 files changed+1282−2923
since splitsnapshots
unifiedsplit
.gitignore−3 .hgtags−21 Data/Text.hs+151−271 Data/Text/Array.hs+10−10 Data/Text/Encoding.hs+91−135 Data/Text/Encoding/Error.hs+3−8 Data/Text/Internal/Encoding/Fusion.hs → Data/Text/Encoding/Fusion.hs+14−17 Data/Text/Internal/Encoding/Fusion/Common.hs → Data/Text/Encoding/Fusion/Common.hs+8−10 Data/Text/Internal/Encoding/Utf16.hs → Data/Text/Encoding/Utf16.hs+4−7 Data/Text/Internal/Encoding/Utf32.hs → Data/Text/Encoding/Utf32.hs+4−7 Data/Text/Internal/Encoding/Utf8.hs → Data/Text/Encoding/Utf8.hs+6−13 Data/Text/Foreign.hs+2−1 Data/Text/Internal/Fusion.hs → Data/Text/Fusion.hs+39−52 Data/Text/Internal/Fusion/CaseMapping.hs → Data/Text/Fusion/CaseMapping.hs+21−293 Data/Text/Internal/Fusion/Common.hs → Data/Text/Fusion/Common.hs+84−75 Data/Text/Internal/Fusion/Types.hs → Data/Text/Fusion/Internal.hs+18−16 Data/Text/Fusion/Size.hs+146 Data/Text/IO.hs+3−3 Data/Text/Internal/IO.hs → Data/Text/IO/Internal.hs+5−9 Data/Text/Internal.hs+13−77 Data/Text/Internal/Builder/RealFloat/Functions.hs−57 Data/Text/Internal/Fusion/Size.hs−157 Data/Text/Internal/Lazy.hs−119 Data/Text/Internal/Read.hs−62 Data/Text/Lazy.hs+35−209 Data/Text/Lazy/Builder.hs+3−3 Data/Text/Internal/Builder/Functions.hs → Data/Text/Lazy/Builder/Functions.hs+3−8 Data/Text/Lazy/Builder/Int.hs+18−25 Data/Text/Internal/Builder/Int/Digits.hs → Data/Text/Lazy/Builder/Int/Digits.hs+3−7 Data/Text/Internal/Builder.hs → Data/Text/Lazy/Builder/Internal.hs+19−27 Data/Text/Lazy/Builder/RealFloat.hs+2−2 Data/Text/Lazy/Builder/RealFloat/Functions.hs+25 Data/Text/Lazy/Encoding.hs+11−35 Data/Text/Internal/Lazy/Encoding/Fusion.hs → Data/Text/Lazy/Encoding/Fusion.hs+12−15 Data/Text/Internal/Lazy/Fusion.hs → Data/Text/Lazy/Fusion.hs+9−12 Data/Text/Lazy/IO.hs+2−2 Data/Text/Lazy/Internal.hs+105−7 Data/Text/Lazy/Read.hs+33−8 Data/Text/Internal/Lazy/Search.hs → Data/Text/Lazy/Search.hs+6−9 Data/Text/Internal/Private.hs → Data/Text/Private.hs+6−6 Data/Text/Read.hs+33−6 Data/Text/Internal/Search.hs → Data/Text/Search.hs+5−4 Data/Text/Show.hs−89 Data/Text/Unsafe.hs+5−15 Data/Text/Internal/Unsafe.hs → Data/Text/Unsafe/Base.hs+6−11 Data/Text/Internal/Unsafe/Char.hs → Data/Text/UnsafeChar.hs+5−8 Data/Text/Internal/Unsafe/Shift.hs → Data/Text/UnsafeShift.hs+4−7 Data/Text/Internal/Functions.hs → Data/Text/Util.hs+2−6 benchmarks/haskell/Benchmarks.hs+1−6 benchmarks/haskell/Benchmarks/DecodeUtf8.hs+2−2 benchmarks/haskell/Benchmarks/FileRead.hs+11−11 benchmarks/haskell/Benchmarks/FoldLines.hs+2−2 benchmarks/haskell/Benchmarks/Mul.hs−138 benchmarks/haskell/Benchmarks/Programs/BigTable.hs+2−2 benchmarks/haskell/Benchmarks/Programs/Cut.hs+2−2 benchmarks/haskell/Benchmarks/Programs/Fold.hs+2−2 benchmarks/haskell/Benchmarks/Programs/Sort.hs+9−10 benchmarks/haskell/Benchmarks/Programs/StripTags.hs+5−5 benchmarks/haskell/Benchmarks/Programs/Throughput.hs+8−8 benchmarks/haskell/Benchmarks/Pure.hs−7 benchmarks/haskell/Benchmarks/ReadNumbers.hs+5−2 benchmarks/haskell/Benchmarks/Stream.hs+9−20 benchmarks/text-benchmarks.cabal+6−18 cbits/cbits.c+6−86 changelog+16 changelog.md−164 scripts/CaseFolding.hs+1−1 scripts/CaseMapping.hs+4−4 scripts/SpecialCasing.hs+1−1 tests/LiteralRuleTest.hs−21 tests/Makefile+1−6 tests/Tests/Properties.hs+79−186 tests/Tests/Properties/Mul.hs−40 tests/Tests/QuickCheckUtils.hs+77−98 tests/cabal.config−6 tests/literal-rule-test.sh−29 tests/text-tests.cabal+28−45 text.cabal+31−57
.gitignoredeleted−3
@@ -1,3 +0,0 @@
1−dist
2−cabal-dev
3−cabal.sandbox.config
.hgtags−21
@@ -43,24 +43,3 @@ b75d3041d275e8e76b26605b0d426a572ddf1249 0.11.1.3
43437fa79662b66aade97fe49394977213fe6432942e 0.11.3.0
4444d99cd091cdf71ce807a4255f6cc509c3154f51ea 0.11.3.1
454531f57612fd425d1bb56352ce6b79e41ce6699a45 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+151−271
@@ -3,9 +3,6 @@
33#if __GLASGOW_HASKELL__ >= 702
44{-# LANGUAGE Trustworthy #-}
55#endif
6−#if __GLASGOW_HASKELL__ >= 708
7−{-# LANGUAGE TypeFamilies #-}
8−#endif
96
107-- |
118-- Module : Data.Text
@@ -14,7 +11,8 @@
1411-- (c) 2008, 2009 Tom Harper
1512--
1613-- License : BSD-style
17−-- Maintainer : bos@serpentine.com
14+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
15+-- duncan@haskell.org
1816-- Stability : experimental
1917-- Portability : GHC
2018--
@@ -32,8 +30,8 @@
3230--
3331-- To use an extended and very rich family of functions for working
3432-- with Unicode text (including normalization, regular expressions,
35−-- non-standard encodings, text breaking, and locales), see
36−-- <http://hackage.haskell.org/package/text-icu the text-icu package >.
33+-- non-standard encodings, text breaking, and locales), see the
34+-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>
3735
3836module Data.Text
3937 (
@@ -125,11 +123,8 @@ module Data.Text
125123
126124 -- ** Breaking strings
127125 , take
128− , takeEnd
129126 , drop
130− , dropEnd
131127 , takeWhile
132− , takeWhileEnd
133128 , dropWhile
134129 , dropWhileEnd
135130 , dropAround
@@ -192,94 +187,82 @@ module Data.Text
192187
193188 -- * Low level operations
194189 , copy
195− , unpackCString#
196190 ) where
197191
198192import Prelude (Char, Bool(..), Int, Maybe(..), String,
199193 Eq(..), Ord(..), Ordering(..), (++),
200− Read(..),
201− (&&), (||), (+), (-), (.), ($), ($!), (>>),
202− not, return, otherwise, quot)
194+ Read(..), Show(..),
195+ (&&), (||), (+), (-), (.), ($), ($!), (>>), (*),
196+ maxBound, not, return, otherwise, quot)
203197#if defined(HAVE_DEEPSEQ)
204−import Control.DeepSeq (NFData(rnf))
198+import Control.DeepSeq (NFData)
205199#endif
206200#if defined(ASSERTS)
207201import Control.Exception (assert)
208202#endif
209203import Data.Char (isSpace)
210−import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
211− Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
204+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))
205+import Data.Data (mkNoRepType)
212206import Control.Monad (foldM)
213−import Control.Monad.ST (ST)
214207import qualified Data.Text.Array as A
215208import qualified Data.List as L
216−import Data.Binary (Binary(get, put))
217209import Data.Monoid (Monoid(..))
218−#if MIN_VERSION_base(4,9,0)
219−import Data.Semigroup (Semigroup(..))
220−#endif
221210import Data.String (IsString(..))
222−import qualified Data.Text.Internal.Fusion as S
223−import qualified Data.Text.Internal.Fusion.Common as S
224−import Data.Text.Encoding (decodeUtf8', encodeUtf8)
225−import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
226−import Data.Text.Internal.Private (span_)
227−import Data.Text.Internal (Text(..), empty, firstf, mul, safe, text)
228−import Data.Text.Show (singleton, unpack, unpackCString#)
211+import qualified Data.Text.Fusion as S
212+import qualified Data.Text.Fusion.Common as S
213+import Data.Text.Fusion (stream, reverseStream, unstream)
214+import Data.Text.Private (span_)
215+import Data.Text.Internal (Text(..), empty, firstf, safe, text, textP)
229216import qualified Prelude as P
230217import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
231− reverseIter_, unsafeHead, unsafeTail)
232−import Data.Text.Internal.Unsafe.Char (unsafeChr)
233−import qualified Data.Text.Internal.Functions as F
234−import qualified Data.Text.Internal.Encoding.Utf16 as U16
235−import Data.Text.Internal.Search (indices)
218+ unsafeHead, unsafeTail)
219+import Data.Text.UnsafeChar (unsafeChr)
220+import qualified Data.Text.Util as U
221+import qualified Data.Text.Encoding.Utf16 as U16
222+import Data.Text.Search (indices)
236223#if defined(__HADDOCK__)
237224import Data.ByteString (ByteString)
238225import qualified Data.Text.Lazy as L
239226import Data.Int (Int64)
240227#endif
241−import GHC.Base (eqInt, neInt, gtInt, geInt, ltInt, leInt)
242−#if __GLASGOW_HASKELL__ >= 708
243−import qualified GHC.Exts as Exts
244−#endif
245−#if MIN_VERSION_base(4,7,0)
246−import Text.Printf (PrintfArg, formatArg, formatString)
228+#if __GLASGOW_HASKELL__ >= 702
229+import qualified GHC.CString as GHC
230+#else
231+import qualified GHC.Base as GHC
247232#endif
233+import GHC.Prim (Addr#)
248234
249235-- $strict
250236--
251237-- This package provides both strict and lazy 'Text' types. The
252−-- strict type is provided by the "Data.Text" module, while the lazy
253−-- type is provided by the "Data.Text.Lazy" module. Internally, the
238+-- strict type is provided by the 'Data.Text' package, while the lazy
239+-- type is provided by the 'Data.Text.Lazy' package. Internally, the
254240-- lazy @Text@ type consists of a list of strict chunks.
255241--
256242-- The strict 'Text' type requires that an entire string fit into
257−-- memory at once. The lazy 'Data.Text.Lazy.Text' type is capable of
258−-- streaming strings that are larger than memory using a small memory
259−-- footprint. In many cases, the overhead of chunked streaming makes
260−-- the lazy 'Data.Text.Lazy.Text' type slower than its strict
261−-- counterpart, but this is not always the case. Sometimes, the time
262−-- complexity of a function in one module may be different from the
263−-- other, due to their differing internal structures.
243+-- memory at once. The lazy @Text@ type is capable of streaming
244+-- strings that are larger than memory using a small memory footprint.
245+-- In many cases, the overhead of chunked streaming makes the lazy
246+-- @Text@ type slower than its strict counterpart, but this is not
247+-- always the case. Sometimes, the time complexity of a function in
248+-- one module may be different from the other, due to their differing
249+-- internal structures.
264250--
265251-- Each module provides an almost identical API, with the main
266252-- difference being that the strict module uses 'Int' values for
267−-- lengths and counts, while the lazy module uses 'Data.Int.Int64'
268−-- lengths.
253+-- lengths and counts, while the lazy module uses 'Int64' lengths.
269254
270255-- $replacement
271256--
272257-- A 'Text' value is a sequence of Unicode scalar values, as defined
273−-- in
274−-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35 §3.9, definition D76 of the Unicode 5.2 standard >.
275−-- As such, a 'Text' cannot contain values in the range U+D800 to
276−-- U+DFFF inclusive. Haskell implementations admit all Unicode code
277−-- points
278−-- (<http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=13 §3.4, definition D10 >)
279−-- as 'Char' values, including code points from this invalid range.
280−-- This means that there are some 'Char' values that are not valid
281−-- Unicode scalar values, and the functions in this module must handle
282−-- those cases.
258+-- in &#xa7;3.9, definition D76 of the Unicode 5.2 standard:
259+-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35>. As
260+-- such, a 'Text' cannot contain values in the range U+D800 to U+DFFF
261+-- inclusive. Haskell implementations admit all Unicode code points
262+-- (&#xa7;3.4, definition D10) as 'Char' values, including code points
263+-- from this invalid range. This means that there are some 'Char'
264+-- values that are not valid Unicode scalar values, and the functions
265+-- in this module must handle those cases.
283266--
284267-- Within this module, many functions construct a 'Text' from one or
285268-- more 'Char' values. Those functions will substitute 'Char' values
@@ -293,8 +276,8 @@ import Text.Printf (PrintfArg, formatArg, formatString)
293276-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate
294277-- code points, and so cannot be represented. The functions replace
295278-- invalid scalar values, instead of dropping them, as a security
296−-- measure. For details, see
297−-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters Unicode Technical Report 36, §3.5 >.)
279+-- measure. For details, see Unicode Technical Report 36, &#xa7;3.5:
280+-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters>)
298281
299282-- $fusion
300283--
@@ -312,11 +295,11 @@ import Text.Printf (PrintfArg, formatArg, formatString)
312295-- > countChars = T.length . T.toUpper . E.decodeUtf8
313296--
314297-- From the type signatures involved, this looks like it should
315−-- allocate one 'Data.ByteString.ByteString' value, and two 'Text'
316−-- values. However, when a module is compiled with optimisation
317−-- enabled under GHC, the two intermediate 'Text' values will be
318−-- optimised away, and the function will be compiled down to a single
319−-- loop over the source 'Data.ByteString.ByteString'.
298+-- allocate one 'ByteString' value, and two 'Text' values. However,
299+-- when a module is compiled with optimisation enabled under GHC, the
300+-- two intermediate 'Text' values will be optimised away, and the
301+-- function will be compiled down to a single loop over the source
302+-- 'ByteString'.
320303--
321304-- Functions that can be fused by the compiler are documented with the
322305-- phrase \"Subject to fusion\".
@@ -330,82 +313,41 @@ instance Eq Text where
330313instance Ord Text where
331314 compare = compareText
332315
316+instance Show Text where
317+ showsPrec p ps r = showsPrec p (unpack ps) r
318+
333319instance Read Text where
334320 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
335321
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−
344322instance Monoid Text where
345323 mempty = empty
346−#if MIN_VERSION_base(4,9,0)
347− mappend = (<>) -- future-proof definition
348−#else
349324 mappend = append
350−#endif
351325 mconcat = concat
352326
353327instance IsString Text where
354328 fromString = pack
355329
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−
363330#if defined(HAVE_DEEPSEQ)
364−instance NFData Text where rnf !_ = ()
331+instance NFData Text
365332#endif
366333
367−instance Binary Text where
368− put t = put (encodeUtf8 t)
369− get = do
370− bs <- get
371− case decodeUtf8' bs of
372− P.Left exn -> P.fail (P.show exn)
373− P.Right a -> P.return a
374−
375−-- | This instance preserves data abstraction at the cost of inefficiency.
334+-- This instance preserves data abstraction at the cost of inefficiency.
376335-- We omit reflection services for the sake of data abstraction.
377336--
378−-- This instance was created by copying the updated behavior of
379−-- @"Data.Set".@'Data.Set.Set' and @"Data.Map".@'Data.Map.Map'. If you
380−-- feel a mistake has been made, please feel free to submit
381−-- improvements.
337+-- This instance was created by copying the behavior of Data.Set and
338+-- Data.Map. If you feel a mistake has been made, please feel free to
339+-- submit improvements.
382340--
383−-- The original discussion is archived here:
384−-- <http://groups.google.com/group/haskell-cafe/browse_thread/thread/b5bbb1b28a7e525d/0639d46852575b93 could we get a Data instance for Data.Text.Text? >
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, ... >
341+-- 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
389345
390346instance Data Text where
391347 gfoldl f z txt = z pack `f` (unpack txt)
392− toConstr _ = packConstr
393− gunfold k z c = case constrIndex c of
394− 1 -> k (z pack)
395− _ -> P.error "gunfold"
396− dataTypeOf _ = textDataType
397−
398−#if MIN_VERSION_base(4,7,0)
399−-- | Only defined for @base-4.7.0.0@ and later
400−instance PrintfArg Text where
401− formatArg txt = formatString $ unpack txt
402−#endif
403−
404−packConstr :: Constr
405−packConstr = mkConstr textDataType "pack" [] Prefix
406−
407−textDataType :: DataType
408−textDataType = mkDataType "Data.Text.Text" [packConstr]
348+ toConstr _ = P.error "Data.Text.Text.toConstr"
349+ gunfold _ _ = P.error "Data.Text.Text.gunfold"
350+ dataTypeOf _ = mkNoRepType "Data.Text.Text"
409351
410352-- | /O(n)/ Compare two 'Text' values lexicographically.
411353compareText :: Text -> Text -> Ordering
@@ -430,6 +372,30 @@ pack :: String -> Text
430372pack = unstream . S.map safe . S.streamList
431373{-# INLINE [1] pack #-}
432374
375+-- | /O(n)/ Convert a Text into a String. Subject to fusion.
376+unpack :: Text -> String
377+unpack = S.unstreamList . stream
378+{-# INLINE [1] unpack #-}
379+
380+-- | /O(n)/ Convert a literal string into a Text. Subject to fusion.
381+unpackCString# :: Addr# -> Text
382+unpackCString# addr# = unstream (S.streamCString# addr#)
383+{-# NOINLINE unpackCString# #-}
384+
385+{-# RULES "TEXT literal" forall a.
386+ unstream (S.map safe (S.streamList (GHC.unpackCString# a)))
387+ = unpackCString# a #-}
388+
389+{-# RULES "TEXT literal UTF8" forall a.
390+ unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))
391+ = unpackCString# a #-}
392+
393+-- | /O(1)/ Convert a character into a Text. Subject to fusion.
394+-- Performs replacement on invalid scalar values.
395+singleton :: Char -> Text
396+singleton = unstream . S.singleton . safe
397+{-# INLINE [1] singleton #-}
398+
433399-- -----------------------------------------------------------------------------
434400-- * Basic functions
435401
@@ -460,13 +426,12 @@ append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
460426 | otherwise = overflowError "append"
461427 where
462428 len = len1+len2
463− x :: ST s (A.MArray s)
464429 x = do
465430 arr <- A.new len
466431 A.copyI arr 0 arr1 off1 len1
467432 A.copyI arr len1 arr2 off2 len
468433 return arr
469−{-# NOINLINE append #-}
434+{-# INLINE append #-}
470435
471436{-# RULES
472437"TEXT append -> fused" [~1] forall t1 t2.
@@ -486,8 +451,8 @@ head t = S.head (stream t)
486451uncons :: Text -> Maybe (Char, Text)
487452uncons t@(Text arr off len)
488453 | len <= 0 = Nothing
489− | otherwise = Just $ let !(Iter c d) = iter t 0
490− in (c, text arr (off+d) (len-d))
454+ | otherwise = Just (c, textP arr (off+d) (len-d))
455+ where Iter c d = iter t 0
491456{-# INLINE [1] uncons #-}
492457
493458-- | Lifted from Control.Arrow and specialized.
@@ -517,7 +482,7 @@ last (Text arr off len)
517482tail :: Text -> Text
518483tail t@(Text arr off len)
519484 | len <= 0 = emptyError "tail"
520− | otherwise = text arr (off+d) (len-d)
485+ | otherwise = textP arr (off+d) (len-d)
521486 where d = iter_ t 0
522487{-# INLINE [1] tail #-}
523488
@@ -532,8 +497,8 @@ tail t@(Text arr off len)
532497-- be non-empty. Subject to fusion.
533498init :: Text -> Text
534499init (Text arr off len) | len <= 0 = emptyError "init"
535− | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)
536− | otherwise = text arr off (len-1)
500+ | n >= 0xDC00 && n <= 0xDFFF = textP arr off (len-2)
501+ | otherwise = textP arr off (len-1)
537502 where
538503 n = A.unsafeIndex arr (off+len-1)
539504{-# INLINE [1] init #-}
@@ -572,9 +537,7 @@ isSingleton = S.isSingleton . stream
572537-- Subject to fusion.
573538length :: Text -> Int
574539length t = S.length (stream t)
575−{-# INLINE [0] length #-}
576−-- length needs to be phased after the compareN/length rules otherwise
577−-- it may inline before the rules have an opportunity to fire.
540+{-# INLINE length #-}
578541
579542-- | /O(n)/ Compare the count of characters in a 'Text' to a number.
580543-- Subject to fusion.
@@ -593,32 +556,32 @@ compareLength t n = S.compareLengthI (stream t) n
593556
594557{-# RULES
595558"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.
596− eqInt (length t) n = compareLength t n == EQ
559+ (==) (length t) n = compareLength t n == EQ
597560 #-}
598561
599562{-# RULES
600563"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.
601− neInt (length t) n = compareLength t n /= EQ
564+ (/=) (length t) n = compareLength t n /= EQ
602565 #-}
603566
604567{-# RULES
605568"TEXT <N/length -> compareLength/==LT" [~1] forall t n.
606− ltInt (length t) n = compareLength t n == LT
569+ (<) (length t) n = compareLength t n == LT
607570 #-}
608571
609572{-# RULES
610573"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.
611− leInt (length t) n = compareLength t n /= GT
574+ (<=) (length t) n = compareLength t n /= GT
612575 #-}
613576
614577{-# RULES
615578"TEXT >N/length -> compareLength/==GT" [~1] forall t n.
616− gtInt (length t) n = compareLength t n == GT
579+ (>) (length t) n = compareLength t n == GT
617580 #-}
618581
619582{-# RULES
620583"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.
621− geInt (length t) n = compareLength t n /= LT
584+ (>=) (length t) n = compareLength t n /= LT
622585 #-}
623586
624587-- -----------------------------------------------------------------------------
@@ -634,7 +597,7 @@ map f t = unstream (S.map (safe . f) (stream t))
634597-- 'Text's and concatenates the list after interspersing the first
635598-- argument between each element of the list.
636599intercalate :: Text -> [Text] -> Text
637−intercalate t = concat . (F.intersperse t)
600+intercalate t = concat . (U.intersperse t)
638601{-# INLINE intercalate #-}
639602
640603-- | /O(n)/ The 'intersperse' function takes a character and places it
@@ -649,48 +612,22 @@ reverse :: Text -> Text
649612reverse t = S.reverse (stream t)
650613{-# INLINE reverse #-}
651614
652−-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
653−-- @haystack@ with @replacement@.
654−--
655−-- This function behaves as though it was defined as follows:
656−--
657−-- @
658−-- replace needle replacement haystack =
659−-- 'intercalate' replacement ('splitOn' needle haystack)
660−-- @
661−--
662−-- As this suggests, each occurrence is replaced exactly once. So if
663−-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
664−-- be replaced recursively:
665−--
666−-- > replace "oo" "foo" "oo" == "foo"
667−--
668−-- In cases where several instances of @needle@ overlap, only the
669−-- first one will be replaced:
670−--
671−-- > replace "ofo" "bar" "ofofo" == "barfo"
615+-- | /O(m+n)/ Replace every occurrence of one substring with another.
672616--
673617-- In (unlikely) bad cases, this function's time complexity degrades
674618-- towards /O(n*m)/.
675−replace :: Text
676− -- ^ @needle@ to search for. If this string is empty, an
677− -- error will occur.
678− -> Text
679− -- ^ @replacement@ to replace @needle@ with.
680− -> Text
681− -- ^ @haystack@ in which to search.
682− -> Text
619+replace :: Text -> Text -> Text -> Text
683620replace needle@(Text _ _ neeLen)
684621 (Text repArr repOff repLen)
685622 haystack@(Text hayArr hayOff hayLen)
686623 | neeLen == 0 = emptyError "replace"
687624 | L.null ixs = haystack
688625 | len > 0 = Text (A.run x) 0 len
626+ | len < 0 = overflowError "replace"
689627 | otherwise = empty
690628 where
691629 ixs = indices needle haystack
692− len = hayLen - (neeLen - repLen) `mul` L.length ixs
693− x :: ST s (A.MArray s)
630+ len = hayLen - (neeLen - repLen) * L.length ixs
694631 x = do
695632 marr <- A.new len
696633 let loop (i:is) o d = do
@@ -720,8 +657,9 @@ replace needle@(Text _ _ neeLen)
720657-- /Note/: In some languages, case conversion is a locale- and
721658-- context-dependent operation. The case conversion functions in this
722659-- module are /not/ locale sensitive. Programs that require locale
723−-- sensitivity should use appropriate versions of the
724−-- <http://hackage.haskell.org/package/text-icu-0.6.3.7/docs/Data-Text-ICU.html#g:4 case mapping functions from the text-icu package >.
660+-- sensitivity should use appropriate versions of the case mapping
661+-- functions from the @text-icu@ package:
662+-- <http://hackage.haskell.org/package/text-icu>
725663
726664-- | /O(n)/ Convert a string to folded case. Subject to fusion.
727665--
@@ -741,7 +679,7 @@ replace needle@(Text _ _ neeLen)
741679-- instead of itself.
742680toCaseFold :: Text -> Text
743681toCaseFold t = unstream (S.toCaseFold (stream t))
744−{-# INLINE toCaseFold #-}
682+{-# INLINE [0] toCaseFold #-}
745683
746684-- | /O(n)/ Convert a string to lower case, using simple case
747685-- conversion. Subject to fusion.
@@ -901,7 +839,6 @@ concat ts = case ts' of
901839 where
902840 ts' = L.filter (not . null) ts
903841 len = sumP "concat" $ L.map lengthWord16 ts'
904− go :: ST s (A.MArray s)
905842 go = do
906843 arr <- A.new len
907844 let step i (Text a o l) =
@@ -915,13 +852,13 @@ concatMap f = concat . foldr ((:) . f) []
915852{-# INLINE concatMap #-}
916853
917854-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
918−-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
855+-- 'Text' @t@ satisifes the predicate @p@. Subject to fusion.
919856any :: (Char -> Bool) -> Text -> Bool
920857any p t = S.any p (stream t)
921858{-# INLINE any #-}
922859
923860-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
924−-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
861+-- 'Text' @t@ satisify the predicate @p@. Subject to fusion.
925862all :: (Char -> Bool) -> Text -> Bool
926863all p t = S.all p (stream t)
927864{-# INLINE all #-}
@@ -1012,10 +949,10 @@ replicate n t@(Text a o l)
1012949 | n <= 0 || l <= 0 = empty
1013950 | n == 1 = t
1014951 | isSingleton t = replicateChar n (unsafeHead t)
1015− | otherwise = Text (A.run x) 0 len
952+ | n <= maxBound `quot` l = Text (A.run x) 0 len
953+ | otherwise = overflowError "replicate"
1016954 where
1017− len = l `mul` n
1018− x :: ST s (A.MArray s)
955+ len = l * n
1019956 x = do
1020957 arr <- A.new len
1021958 let loop !d !i | i >= n = return arr
@@ -1066,16 +1003,14 @@ take :: Int -> Text -> Text
10661003take n t@(Text arr off len)
10671004 | n <= 0 = empty
10681005 | n >= len = t
1069− | otherwise = text arr off (iterN n t)
1006+ | otherwise = Text arr off (loop 0 0)
1007+ where
1008+ loop !i !cnt
1009+ | i >= len || cnt >= n = i
1010+ | otherwise = loop (i+d) (cnt+1)
1011+ where d = iter_ t i
10701012{-# INLINE [1] take #-}
10711013
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−
10791014{-# RULES
10801015"TEXT take -> fused" [~1] forall n t.
10811016 take n t = unstream (S.take n (stream t))
@@ -1083,27 +1018,6 @@ iterN n t@(Text _arr _off len) = loop 0 0
10831018 unstream (S.take n (stream t)) = take n t
10841019 #-}
10851020
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−
11071021-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
11081022-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
11091023-- is greater than the length of the 'Text'. Subject to fusion.
@@ -1111,8 +1025,11 @@ drop :: Int -> Text -> Text
11111025drop n t@(Text arr off len)
11121026 | n <= 0 = t
11131027 | n >= len = empty
1114− | otherwise = text arr (off+i) (len-i)
1115− where i = iterN n t
1028+ | otherwise = loop 0 0
1029+ where loop !i !cnt
1030+ | i >= len || cnt >= n = Text arr (off+i) (len-i)
1031+ | otherwise = loop (i+d) (cnt+1)
1032+ where d = iter_ t i
11161033{-# INLINE [1] drop #-}
11171034
11181035{-# RULES
@@ -1122,18 +1039,6 @@ drop n t@(Text arr off len)
11221039 unstream (S.drop n (stream t)) = drop n t
11231040 #-}
11241041
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−
11371042-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
11381043-- returns the longest prefix (possibly empty) of elements that
11391044-- satisfy @p@. Subject to fusion.
@@ -1141,7 +1046,7 @@ takeWhile :: (Char -> Bool) -> Text -> Text
11411046takeWhile p t@(Text arr off len) = loop 0
11421047 where loop !i | i >= len = t
11431048 | p c = loop (i+d)
1144− | otherwise = text arr off i
1049+ | otherwise = textP arr off i
11451050 where Iter c d = iter t i
11461051{-# INLINE [1] takeWhile #-}
11471052
@@ -1152,27 +1057,6 @@ takeWhile p t@(Text arr off len) = loop 0
11521057 unstream (S.takeWhile p (stream t)) = takeWhile p t
11531058 #-}
11541059
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−
11761060-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
11771061-- 'takeWhile' @p@ @t@. Subject to fusion.
11781062dropWhile :: (Char -> Bool) -> Text -> Text
@@ -1191,9 +1075,8 @@ dropWhile p t@(Text arr off len) = loop 0 0
11911075 #-}
11921076
11931077-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1194−-- dropping characters that satisfy the predicate @p@ from the end of
1078+-- dropping characters that fail the predicate @p@ from the end of
11951079-- @t@. Subject to fusion.
1196−--
11971080-- Examples:
11981081--
11991082-- > dropWhileEnd (=='.') "foo..." == "foo"
@@ -1213,7 +1096,7 @@ dropWhileEnd p t@(Text arr off len) = loop (len-1) len
12131096 #-}
12141097
12151098-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1216−-- dropping characters that satisfy the predicate @p@ from both the
1099+-- dropping characters that fail the predicate @p@ from both the
12171100-- beginning and end of @t@. Subject to fusion.
12181101dropAround :: (Char -> Bool) -> Text -> Text
12191102dropAround p = dropWhile p . dropWhileEnd p
@@ -1248,8 +1131,13 @@ splitAt :: Int -> Text -> (Text, Text)
12481131splitAt n t@(Text arr off len)
12491132 | n <= 0 = (empty, t)
12501133 | n >= len = (t, empty)
1251− | otherwise = let k = iterN n t
1252− in (text arr off k, text arr (off+k) (len-k))
1134+ | otherwise = (Text arr off k, Text arr (off+k) (len-k))
1135+ where k = loop 0 0
1136+ loop !i !cnt
1137+ | i >= len || cnt >= n = i
1138+ | otherwise = loop (i+d) (cnt+1)
1139+ where d = iter_ t i
1140+{-# INLINE splitAt #-}
12531141
12541142-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
12551143-- a pair whose first element is the longest prefix (possibly empty)
@@ -1308,9 +1196,9 @@ tails t | null t = [empty]
13081196-- copies to create substrings; they just construct new 'Text's that
13091197-- are slices of the original.
13101198
1311−-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'
1312−-- argument (which cannot be empty), consuming the delimiter. An empty
1313−-- delimiter is invalid, and will cause an error to be raised.
1199+-- | /O(m+n)/ Break a 'Text' into pieces separated by the first
1200+-- 'Text' argument, consuming the delimiter. An empty delimiter is
1201+-- invalid, and will cause an error to be raised.
13141202--
13151203-- Examples:
13161204--
@@ -1323,23 +1211,16 @@ tails t | null t = [empty]
13231211-- > intercalate s . splitOn s == id
13241212-- > splitOn (singleton c) == split (==c)
13251213--
1326−-- (Note: the string @s@ to split on above cannot be empty.)
1327−--
13281214-- In (unlikely) bad cases, this function's time complexity degrades
13291215-- towards /O(n*m)/.
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]
1216+splitOn :: Text -> Text -> [Text]
13361217splitOn pat@(Text _ _ l) src@(Text arr off len)
13371218 | l <= 0 = emptyError "splitOn"
13381219 | isSingleton pat = split (== unsafeHead pat) src
13391220 | otherwise = go 0 (indices pat src)
13401221 where
1341− go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs
1342− go s _ = [text arr (s+off) (len-s)]
1222+ go !s (x:xs) = textP arr (s+off) (x-s) : go (x+l) xs
1223+ go s _ = [textP arr (s+off) (len-s)]
13431224{-# INLINE [1] splitOn #-}
13441225
13451226{-# RULES
@@ -1431,7 +1312,7 @@ breakOn pat src@(Text arr off len)
14311312 | null pat = emptyError "breakOn"
14321313 | otherwise = case indices pat src of
14331314 [] -> (src, empty)
1434− (x:_) -> (text arr off x, text arr (off+x) (len-x))
1315+ (x:_) -> (textP arr off x, textP arr (off+x) (len-x))
14351316{-# INLINE breakOn #-}
14361317
14371318-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
@@ -1473,7 +1354,7 @@ breakOnAll pat src@(Text arr off slen)
14731354 | otherwise = L.map step (indices pat src)
14741355 where
14751356 step x = (chunk 0 x, chunk x (slen-x))
1476− chunk !n !l = text arr (n+off) l
1357+ chunk !n !l = textP arr (n+off) l
14771358{-# INLINE breakOnAll #-}
14781359
14791360-------------------------------------------------------------------------------
@@ -1540,7 +1421,7 @@ countChar c t = S.countChar c (stream t)
15401421-- equivalent to a pair of 'unpack' operations.
15411422zip :: Text -> Text -> [(Char,Char)]
15421423zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1543−{-# INLINE zip #-}
1424+{-# INLINE [0] zip #-}
15441425
15451426-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
15461427-- given as the first argument, instead of a tupling function.
@@ -1548,7 +1429,7 @@ zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
15481429zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
15491430zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
15501431 where g a b = safe (f a b)
1551−{-# INLINE zipWith #-}
1432+{-# INLINE [0] zipWith #-}
15521433
15531434-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
15541435-- representing white space.
@@ -1673,7 +1554,7 @@ isInfixOf needle haystack
16731554-- > fnordLength _ = -1
16741555stripPrefix :: Text -> Text -> Maybe Text
16751556stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1676− | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)
1557+ | p `isPrefixOf` t = Just $! textP arr (off+plen) (len-plen)
16771558 | otherwise = Nothing
16781559
16791560-- | /O(n)/ Find the longest non-empty common prefix of two strings
@@ -1693,8 +1574,8 @@ commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
16931574 where
16941575 go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
16951576 | i > 0 = Just (Text arr0 off0 i,
1696− text arr0 (off0+i) (len0-i),
1697− text arr1 (off1+j) (len1-j))
1577+ textP arr0 (off0+i) (len0-i),
1578+ textP arr1 (off1+j) (len1-j))
16981579 | otherwise = Nothing
16991580 where Iter a d0 = iter t0 i
17001581 Iter b d1 = iter t1 j
@@ -1719,7 +1600,7 @@ commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
17191600-- > quuxLength _ = -1
17201601stripSuffix :: Text -> Text -> Maybe Text
17211602stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
1722− | p `isSuffixOf` t = Just $! text arr off (len-plen)
1603+ | p `isSuffixOf` t = Just $! textP arr off (len-plen)
17231604 | otherwise = Nothing
17241605
17251606-- | Add a list of non-negative numbers. Errors out on overflow.
@@ -1748,7 +1629,6 @@ overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
17481629copy :: Text -> Text
17491630copy (Text arr off len) = Text (A.run go) 0 len
17501631 where
1751− go :: ST s (A.MArray s)
17521632 go = do
17531633 marr <- A.new len
17541634 A.copyI marr 0 arr off len
Data/Text/Array.hs+10−10
@@ -6,7 +6,8 @@
66-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
77--
88-- License : BSD-style
9−-- Maintainer : bos@serpentine.com
9+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
10+-- duncan@haskell.org
1011-- Stability : experimental
1112-- Portability : portable
1213--
@@ -20,13 +21,13 @@
2021-- > import qualified Data.Text.Array as A
2122--
2223-- The names in this module resemble those in the 'Data.Array' family
23−-- of modules, but are shorter due to the assumption of qualified
24+-- of modules, but are shorter due to the assumption of qualifid
2425-- naming.
2526module Data.Text.Array
2627 (
2728 -- * Types
28− Array(Array, aBA)
29− , MArray(MArray, maBA)
29+ Array(aBA)
30+ , MArray(maBA)
3031
3132 -- * Functions
3233 , copyM
@@ -65,8 +66,8 @@ import Control.Monad.ST.Unsafe (unsafeIOToST)
6566import Control.Monad.ST (unsafeIOToST)
6667#endif
6768import Data.Bits ((.&.), xor)
68−import Data.Text.Internal.Unsafe (inlinePerformIO)
69−import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
69+import Data.Text.Unsafe.Base (inlinePerformIO)
70+import Data.Text.UnsafeShift (shiftL, shiftR)
7071#if __GLASGOW_HASKELL__ >= 703
7172import Foreign.C.Types (CInt(CInt), CSize(CSize))
7273#else
@@ -74,7 +75,7 @@ import Foreign.C.Types (CInt, CSize)
7475#endif
7576import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
7677 indexWord16Array#, newByteArray#,
77− unsafeFreezeByteArray#, writeWord16Array#)
78+ unsafeCoerce#, writeWord16Array#)
7879import GHC.ST (ST(..), runST)
7980import GHC.Word (Word16(..))
8081import Prelude hiding (length, read)
@@ -130,9 +131,8 @@ array_size_error = error "Data.Text.Array.new: size overflow"
130131
131132-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
132133unsafeFreeze :: MArray s -> ST s Array
133−unsafeFreeze MArray{..} = ST $ \s1# ->
134− case unsafeFreezeByteArray# maBA s1# of
135− (# s2#, ba# #) -> (# s2#, Array ba#
134+unsafeFreeze MArray{..} = ST $ \s# ->
135+ (# s#, Array (unsafeCoerce# maBA)
136136#if defined(ASSERTS)
137137 maLen
138138#endif
Data/Text/Encoding.hs+91−135
@@ -10,7 +10,8 @@
1010-- (c) 2008, 2009 Tom Harper
1111--
1212-- License : BSD-style
13−-- Maintainer : bos@serpentine.com
13+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
14+-- duncan@haskell.org
1415-- Stability : experimental
1516-- Portability : portable
1617--
@@ -54,45 +55,36 @@ module Data.Text.Encoding
5455 , encodeUtf16BE
5556 , encodeUtf32LE
5657 , encodeUtf32BE
57−
58− -- * Encoding Text using ByteString Builders
59− , encodeUtf8Builder
60− , encodeUtf8BuilderEscaped
6158 ) where
6259
60+import Control.Exception (evaluate, try)
6361#if __GLASGOW_HASKELL__ >= 702
6462import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
6563#else
6664import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)
6765#endif
68−
69−import Control.Exception (evaluate, try)
7066import Control.Monad.ST (runST)
7167import Data.Bits ((.&.))
7268import Data.ByteString as B
73−import Data.ByteString.Internal as B hiding (c2w)
69+import Data.ByteString.Internal as B
70+import Data.Text ()
7471import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
75−import Data.Text.Internal (Text(..), safe, text)
76−import Data.Text.Internal.Private (runText)
77−import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
78−import Data.Text.Internal.Unsafe.Shift (shiftR)
79−import Data.Text.Show ()
80−import Data.Text.Unsafe (unsafeDupablePerformIO)
72+import Data.Text.Internal (Text(..), safe, textP)
73+import Data.Text.Private (runText)
74+import Data.Text.UnsafeChar (ord, unsafeWrite)
75+import Data.Text.UnsafeShift (shiftL, shiftR)
8176import Data.Word (Word8, Word32)
82−import Foreign.C.Types (CSize(..))
77+import Foreign.C.Types (CSize)
8378import Foreign.ForeignPtr (withForeignPtr)
8479import Foreign.Marshal.Utils (with)
8580import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
8681import Foreign.Storable (Storable, peek, poke)
87−import GHC.Base (ByteArray#, MutableByteArray#)
88−import qualified Data.ByteString.Builder as B
89−import qualified Data.ByteString.Builder.Internal as B hiding (empty, append)
90−import qualified Data.ByteString.Builder.Prim as BP
91−import qualified Data.ByteString.Builder.Prim.Internal as BP
82+import GHC.Base (MutableByteArray#)
9283import qualified Data.Text.Array as A
93−import qualified Data.Text.Internal.Encoding.Fusion as E
94−import qualified Data.Text.Internal.Encoding.Utf16 as U16
95−import qualified Data.Text.Internal.Fusion as F
84+import qualified Data.Text.Encoding.Fusion as E
85+import qualified Data.Text.Encoding.Utf16 as U16
86+import qualified Data.Text.Fusion as F
87+import Data.Text.Unsafe (unsafeDupablePerformIO)
9688
9789#include "text_cbits.h"
9890
@@ -111,6 +103,8 @@ import qualified Data.Text.Internal.Fusion as F
111103
112104-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
113105-- encoded text.
106+--
107+-- This function is deprecated. Use 'decodeLatin1' instead.
114108decodeASCII :: ByteString -> Text
115109decodeASCII = decodeUtf8
116110{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
@@ -120,7 +114,7 @@ decodeASCII = decodeUtf8
120114-- 'decodeLatin1' is semantically equivalent to
121115-- @Data.Text.pack . Data.ByteString.Char8.unpack@
122116decodeLatin1 :: ByteString -> Text
123−decodeLatin1 (PS fp off len) = text a 0 len
117+decodeLatin1 (PS fp off len) = textP a 0 len
124118 where
125119 a = A.run (A.new len >>= unsafeIOToST . go)
126120 go dest = withForeignPtr fp $ \ptr -> do
@@ -152,7 +146,7 @@ decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
152146 loop (ptr `plusPtr` off)
153147 (unsafeIOToST . go) =<< A.new len
154148 where
155− desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
149+ desc = "Data.Text.Encoding.decodeUtf8: Invalid UTF-8 stream"
156150{- INLINE[0] decodeUtf8With #-}
157151
158152-- $stream
@@ -161,15 +155,11 @@ decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
161155-- a 'ByteString' that represents a possibly incomplete input (e.g. a
162156-- packet from a network stream) that may not end on a UTF-8 boundary.
163157--
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.
158+-- The first element of the result is the maximal chunk of 'Text' that
159+-- can be decoded from the given input. The second is a function which
160+-- accepts another 'ByteString'. That string will be assumed to
161+-- directly follow the string that was passed as input to the original
162+-- function, and it will in turn be decoded.
173163--
174164-- To help understand the use of these functions, consider the Unicode
175165-- string @\"hi &#9731;\"@. If encoded as UTF-8, this becomes @\"hi
@@ -182,17 +172,15 @@ decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
182172-- as we receive each one.
183173--
184174-- @
185−-- ghci> let s0\@('Some' _ _ f0) = 'streamDecodeUtf8' \"hi \\xe2\"
186−-- ghci> s0
187−-- 'Some' \"hi \" \"\\xe2\" _
175+-- let 'Some' t0 f0 = 'streamDecodeUtf8' \"hi \\xe2\"
176+-- t0 == \"hi \" :: 'Text'
188177-- @
189178--
190179-- We use the continuation @f0@ to decode our second packet.
191180--
192181-- @
193−-- ghci> let s1\@('Some' _ _ f1) = f0 \"\\x98\"
194−-- ghci> s1
195−-- 'Some' \"\" \"\\xe2\\x98\"
182+-- let 'Some' t1 f1 = f0 \"\\x98\"
183+-- t1 == \"\"
196184-- @
197185--
198186-- We could not give @f0@ enough input to decode anything, so it
@@ -200,9 +188,8 @@ decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
200188-- the last byte of input, it will make progress.
201189--
202190-- @
203−-- ghci> let s2\@('Some' _ _ f2) = f1 \"\\x83\"
204−-- ghci> s2
205−-- 'Some' \"\\x2603\" \"\" _
191+-- let 'Some' t2 f2 = f1 \"\\x83\"
192+-- t2 == \"&#9731;\"
206193-- @
207194--
208195-- If given invalid input, an exception will be thrown by the function
@@ -234,13 +221,12 @@ streamDecodeUtf8 = streamDecodeUtf8With strictDecode
234221-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
235222-- encoded text.
236223streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
237−streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
224+streamDecodeUtf8With onErr = decodeChunk 0 0
238225 where
239226 -- We create a slightly larger than necessary buffer to accommodate a
240227 -- 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) =
228+ decodeChunk :: CodePoint -> DecoderState -> ByteString -> Decoding
229+ decodeChunk codepoint0 state0 bs@(PS fp off len) =
244230 runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)
245231 where
246232 decodeChunkToBuffer :: A.MArray s -> IO Decoding
@@ -259,7 +245,6 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
259245 UTF8_REJECT -> do
260246 -- We encountered an encoding error
261247 x <- peek curPtr'
262− poke statePtr 0
263248 case onErr desc (Just x) of
264249 Nothing -> loop $ curPtr' `plusPtr` 1
265250 Just c -> do
@@ -267,6 +252,7 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
267252 w <- unsafeSTToIO $
268253 unsafeWrite dest (fromIntegral destOff) (safe c)
269254 poke destOffPtr (destOff + fromIntegral w)
255+ poke statePtr 0
270256 loop $ curPtr' `plusPtr` 1
271257
272258 _ -> do
@@ -275,16 +261,13 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
275261 codepoint <- peek codepointPtr
276262 chunkText <- unsafeSTToIO $ do
277263 arr <- A.unsafeFreeze dest
278− return $! text arr 0 (fromIntegral n)
264+ return $! textP arr 0 (fromIntegral n)
279265 lastPtr <- peek curPtrPtr
280266 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)
267+ return $ Some chunkText (B.drop left bs)
268+ (decodeChunk codepoint state)
286269 in loop (ptr `plusPtr` off)
287− desc = "Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"
270+ desc = "Data.Text.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"
288271
289272-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
290273-- to be valid.
@@ -307,85 +290,61 @@ decodeUtf8' :: ByteString -> Either UnicodeException Text
307290decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode
308291{-# INLINE decodeUtf8' #-}
309292
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−
371293-- | Encode text using UTF-8 encoding.
372294encodeUtf8 :: Text -> ByteString
373−encodeUtf8 (Text arr off len)
374− | len == 0 = B.empty
375− | otherwise = unsafeDupablePerformIO $ do
376− fp <- mallocByteString (len*4)
377− withForeignPtr fp $ \ptr ->
378− with ptr $ \destPtr -> do
379− c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
380− newDest <- peek destPtr
381− let utf8len = newDest `minusPtr` ptr
382− if utf8len >= len `shiftR` 1
383− then return (PS fp 0 utf8len)
384− else do
385− fp' <- mallocByteString utf8len
386− withForeignPtr fp' $ \ptr' -> do
387− memcpy ptr' ptr (fromIntegral utf8len)
388− return (PS fp' 0 utf8len)
295+encodeUtf8 (Text arr off len) = unsafeDupablePerformIO $ do
296+ let size0 = max len 4
297+ mallocByteString size0 >>= start size0 off 0
298+ where
299+ start size n0 m0 fp = withForeignPtr fp $ loop n0 m0
300+ where
301+ loop n1 m1 ptr = go n1 m1
302+ where
303+ offLen = off + len
304+ go !n !m
305+ | n == offLen = return (PS fp 0 m)
306+ | otherwise = do
307+ let poke8 k v = poke (ptr `plusPtr` k) (fromIntegral v :: Word8)
308+ ensure k act
309+ | size-m >= k = act
310+ | otherwise = {-# SCC "resizeUtf8/ensure" #-} do
311+ let newSize = size `shiftL` 1
312+ fp' <- mallocByteString newSize
313+ withForeignPtr fp' $ \ptr' ->
314+ memcpy ptr' ptr (fromIntegral m)
315+ start newSize n m fp'
316+ {-# INLINE ensure #-}
317+ case A.unsafeIndex arr n of
318+ w| w <= 0x7F -> ensure 1 $ do
319+ poke (ptr `plusPtr` m) (fromIntegral w :: Word8)
320+ -- A single ASCII octet is likely to start a run of
321+ -- them. We see better performance when we
322+ -- special-case this assumption.
323+ let end = ptr `plusPtr` size
324+ ascii !t !u
325+ | t == offLen || u == end || v >= 0x80 =
326+ go t (u `minusPtr` ptr)
327+ | otherwise = do
328+ poke u (fromIntegral v :: Word8)
329+ ascii (t+1) (u `plusPtr` 1)
330+ where v = A.unsafeIndex arr t
331+ ascii (n+1) (ptr `plusPtr` (m+1))
332+ | w <= 0x7FF -> ensure 2 $ do
333+ poke8 m $ (w `shiftR` 6) + 0xC0
334+ poke8 (m+1) $ (w .&. 0x3f) + 0x80
335+ go (n+1) (m+2)
336+ | 0xD800 <= w && w <= 0xDBFF -> ensure 4 $ do
337+ let c = ord $ U16.chr2 w (A.unsafeIndex arr (n+1))
338+ poke8 m $ (c `shiftR` 18) + 0xF0
339+ poke8 (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80
340+ poke8 (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80
341+ poke8 (m+3) $ (c .&. 0x3F) + 0x80
342+ go (n+2) (m+4)
343+ | otherwise -> ensure 3 $ do
344+ poke8 m $ (w `shiftR` 12) + 0xE0
345+ poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
346+ poke8 (m+2) $ (w .&. 0x3F) + 0x80
347+ go (n+1) (m+3)
389348
390349-- | Decode text from little endian UTF-16 encoding.
391350decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
@@ -474,6 +433,3 @@ foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_stat
474433
475434foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
476435 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
477−
478−foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
479− :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()
Data/Text/Encoding/Error.hs+3−8
@@ -1,7 +1,5 @@
11{-# LANGUAGE CPP, DeriveDataTypeable #-}
2−#if __GLASGOW_HASKELL__ >= 704
3−{-# LANGUAGE Safe #-}
4−#elif __GLASGOW_HASKELL__ >= 702
2+#if __GLASGOW_HASKELL__ >= 702
53{-# LANGUAGE Trustworthy #-}
64#endif
75-- |
@@ -9,7 +7,8 @@
97-- Copyright : (c) Bryan O'Sullivan 2009
108--
119-- License : BSD-style
12−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
1312-- Stability : experimental
1413-- Portability : GHC
1514--
@@ -68,7 +67,6 @@ type OnError a b = String -> Maybe a -> Maybe b
6867type OnDecodeError = OnError Word8 Char
6968
7069-- | A handler for an encoding error.
71−{-# DEPRECATED OnEncodeError "This exception is never used in practice, and will be removed." #-}
7270type OnEncodeError = OnError Char Word8
7371
7472-- | An exception type for representing Unicode encoding errors.
@@ -81,8 +79,6 @@ data UnicodeException =
8179 -- under the given encoding, or ran out of input in mid-encode.
8280 deriving (Eq, Typeable)
8381
84−{-# DEPRECATED EncodeError "This constructor is never used, and will be removed." #-}
85−
8682showUnicodeException :: UnicodeException -> String
8783showUnicodeException (DecodeError desc (Just w))
8884 = "Cannot decode byte '\\x" ++ showHex w ("': " ++ desc)
@@ -112,7 +108,6 @@ lenientDecode :: OnDecodeError
112108lenientDecode _ _ = Just '\xfffd'
113109
114110-- | Throw a 'UnicodeException' if encoding fails.
115−{-# DEPRECATED strictEncode "This function always throws an exception, and will be removed." #-}
116111strictEncode :: OnEncodeError
117112strictEncode desc c = throw (EncodeError desc c)
118113
Data/Text/Internal/Encoding/Fusion.hs → Data/Text/Encoding/Fusion.hsrenamed+14−17
@@ -1,24 +1,21 @@
11{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
22
33-- |
4−-- Module : Data.Text.Internal.Encoding.Fusion
4+-- Module : Data.Text.Encoding.Fusion
55-- Copyright : (c) Tom Harper 2008-2009,
66-- (c) Bryan O'Sullivan 2009,
77-- (c) Duncan Coutts 2009
88--
99-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
1112-- Stability : experimental
1213-- Portability : portable
1314--
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−--
1815-- Fusible 'Stream'-oriented functions for converting between 'Text'
1916-- and several common encodings.
2017
21−module Data.Text.Internal.Encoding.Fusion
18+module Data.Text.Encoding.Fusion
2219 (
2320 -- * Streaming
2421 streamASCII
@@ -31,27 +28,27 @@ module Data.Text.Internal.Encoding.Fusion
3128 -- * Unstreaming
3229 , unstream
3330
34− , module Data.Text.Internal.Encoding.Fusion.Common
31+ , module Data.Text.Encoding.Fusion.Common
3532 ) where
3633
3734#if defined(ASSERTS)
3835import Control.Exception (assert)
3936#endif
4037import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)
41−import Data.Text.Internal.Fusion (Step(..), Stream(..))
42−import Data.Text.Internal.Fusion.Size
38+import Data.Text.Fusion (Step(..), Stream(..))
39+import Data.Text.Fusion.Size
4340import Data.Text.Encoding.Error
44−import Data.Text.Internal.Encoding.Fusion.Common
45−import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)
46−import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
41+import Data.Text.Encoding.Fusion.Common
42+import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)
43+import Data.Text.UnsafeShift (shiftL, shiftR)
4744import Data.Word (Word8, Word16, Word32)
4845import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
4946import Foreign.Storable (pokeByteOff)
5047import qualified Data.ByteString as B
5148import qualified Data.ByteString.Unsafe as B
52−import qualified Data.Text.Internal.Encoding.Utf8 as U8
53−import qualified Data.Text.Internal.Encoding.Utf16 as U16
54−import qualified Data.Text.Internal.Encoding.Utf32 as U32
49+import qualified Data.Text.Encoding.Utf8 as U8
50+import qualified Data.Text.Encoding.Utf16 as U16
51+import qualified Data.Text.Encoding.Utf32 as U32
5552import Data.Text.Unsafe (unsafeDupablePerformIO)
5653
5754streamASCII :: ByteString -> Stream Char
@@ -204,5 +201,5 @@ decodeError func kind onErr mb i =
204201 case onErr desc mb of
205202 Nothing -> Skip i
206203 Just c -> Yield c i
207− where desc = "Data.Text.Internal.Encoding.Fusion." ++ func ++ ": Invalid " ++
204+ where desc = "Data.Text.Encoding.Fusion." ++ func ++ ": Invalid " ++
208205 kind ++ " stream"
Data/Text/Internal/Encoding/Fusion/Common.hs → Data/Text/Encoding/Fusion/Common.hsrenamed+8−10
@@ -1,24 +1,22 @@
11{-# LANGUAGE BangPatterns #-}
22
33-- |
4−-- Module : Data.Text.Internal.Encoding.Fusion.Common
4+-- Module : Data.Text.Encoding.Fusion.Common
55-- Copyright : (c) Tom Harper 2008-2009,
66-- (c) Bryan O'Sullivan 2009,
77-- (c) Duncan Coutts 2009,
88-- (c) Jasper Van der Jeugt 2011
99--
1010-- License : BSD-style
11−-- Maintainer : bos@serpentine.com
11+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
12+-- duncan@haskell.org
1213-- Stability : experimental
1314-- Portability : portable
1415--
15−-- /Warning/: this is an internal module, and does not have a stable
16−-- API or name. Use at your own risk!
17−--
1816-- Fusible 'Stream'-oriented functions for converting between 'Text'
1917-- and several common encodings.
2018
21−module Data.Text.Internal.Encoding.Fusion.Common
19+module Data.Text.Encoding.Fusion.Common
2220 (
2321 -- * Restreaming
2422 -- Restreaming is the act of converting from one 'Stream'
@@ -30,10 +28,10 @@ module Data.Text.Internal.Encoding.Fusion.Common
3028 ) where
3129
3230import Data.Bits ((.&.))
33−import Data.Text.Internal.Fusion (Step(..), Stream(..))
34−import Data.Text.Internal.Fusion.Types (RS(..))
35−import Data.Text.Internal.Unsafe.Char (ord)
36−import Data.Text.Internal.Unsafe.Shift (shiftR)
31+import Data.Text.Fusion (Step(..), Stream(..))
32+import Data.Text.Fusion.Internal (RS(..))
33+import Data.Text.UnsafeChar (ord)
34+import Data.Text.UnsafeShift (shiftR)
3735import Data.Word (Word8)
3836
3937restreamUtf16BE :: Stream Char -> Stream Word8
Data/Text/Internal/Encoding/Utf16.hs → Data/Text/Encoding/Utf16.hsrenamed+4−7
@@ -1,22 +1,19 @@
11{-# LANGUAGE MagicHash, BangPatterns #-}
22
33-- |
4−-- Module : Data.Text.Internal.Encoding.Utf16
4+-- Module : Data.Text.Encoding.Utf16
55-- Copyright : (c) 2008, 2009 Tom Harper,
66-- (c) 2009 Bryan O'Sullivan,
77-- (c) 2009 Duncan Coutts
88--
99-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
1112-- Stability : experimental
1213-- Portability : GHC
1314--
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−--
1815-- Basic UTF-16 validation and character manipulation.
19−module Data.Text.Internal.Encoding.Utf16
16+module Data.Text.Encoding.Utf16
2017 (
2118 chr2
2219 , validate1
Data/Text/Internal/Encoding/Utf32.hs → Data/Text/Encoding/Utf32.hsrenamed+4−7
@@ -1,20 +1,17 @@
11-- |
2−-- Module : Data.Text.Internal.Encoding.Utf32
2+-- Module : Data.Text.Encoding.Utf32
33-- Copyright : (c) 2008, 2009 Tom Harper,
44-- (c) 2009, 2010 Bryan O'Sullivan,
55-- (c) 2009 Duncan Coutts
66--
77-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
910-- Stability : experimental
1011-- Portability : portable
1112--
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−--
1613-- Basic UTF-32 validation.
17−module Data.Text.Internal.Encoding.Utf32
14+module Data.Text.Encoding.Utf32
1815 (
1916 validate
2017 ) where
Data/Text/Internal/Encoding/Utf8.hs → Data/Text/Encoding/Utf8.hsrenamed+6−13
@@ -1,22 +1,19 @@
11{-# LANGUAGE CPP, MagicHash, BangPatterns #-}
22
33-- |
4−-- Module : Data.Text.Internal.Encoding.Utf8
4+-- Module : Data.Text.Encoding.Utf8
55-- Copyright : (c) 2008, 2009 Tom Harper,
66-- (c) 2009, 2010 Bryan O'Sullivan,
77-- (c) 2009 Duncan Coutts
88--
99-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
1112-- Stability : experimental
1213-- Portability : GHC
1314--
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−--
1815-- Basic UTF-8 validation and character manipulation.
19−module Data.Text.Internal.Encoding.Utf8
16+module Data.Text.Encoding.Utf8
2017 (
2118 -- Decomposition
2219 ord2
@@ -33,16 +30,12 @@ module Data.Text.Internal.Encoding.Utf8
3330 , validate4
3431 ) where
3532
36−#if defined(TEST_SUITE)
37−# undef ASSERTS
38−#endif
39−
4033#if defined(ASSERTS)
4134import Control.Exception (assert)
4235#endif
4336import Data.Bits ((.&.))
44−import Data.Text.Internal.Unsafe.Char (ord)
45−import Data.Text.Internal.Unsafe.Shift (shiftR)
37+import Data.Text.UnsafeChar (ord)
38+import Data.Text.UnsafeShift (shiftR)
4639import GHC.Exts
4740import GHC.Word (Word8(..))
4841
Data/Text/Foreign.hs+2−1
@@ -4,7 +4,8 @@
44-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
55--
66-- License : BSD-style
7−-- Maintainer : bos@serpentine.com
7+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
8+-- duncan@haskell.org
89-- Stability : experimental
910-- Portability : GHC
1011--
Data/Text/Internal/Fusion.hs → Data/Text/Fusion.hsrenamed+39−52
@@ -1,23 +1,20 @@
11{-# LANGUAGE BangPatterns, MagicHash #-}
22
33-- |
4−-- Module : Data.Text.Internal.Fusion
4+-- Module : Data.Text.Fusion
55-- Copyright : (c) Tom Harper 2008-2009,
66-- (c) Bryan O'Sullivan 2009-2010,
77-- (c) Duncan Coutts 2009
88--
99-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
1112-- Stability : experimental
1213-- Portability : GHC
1314--
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−--
1815-- Text manipulation functions represented as fusible operations over
1916-- streams.
20−module Data.Text.Internal.Fusion
17+module Data.Text.Fusion
2118 (
2219 -- * Types
2320 Stream(..)
@@ -54,21 +51,21 @@ import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,
5451 fromIntegral, otherwise)
5552import Data.Bits ((.&.))
5653import Data.Text.Internal (Text(..))
57−import Data.Text.Internal.Private (runText)
58−import Data.Text.Internal.Unsafe.Char (ord, unsafeChr, unsafeWrite)
59−import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
54+import Data.Text.Private (runText)
55+import Data.Text.UnsafeChar (ord, unsafeChr, unsafeWrite)
56+import Data.Text.UnsafeShift (shiftL, shiftR)
6057import qualified Data.Text.Array as A
61−import qualified Data.Text.Internal.Fusion.Common as S
62−import Data.Text.Internal.Fusion.Types
63−import Data.Text.Internal.Fusion.Size
58+import qualified Data.Text.Fusion.Common as S
59+import Data.Text.Fusion.Internal
60+import Data.Text.Fusion.Size
6461import qualified Data.Text.Internal as I
65−import qualified Data.Text.Internal.Encoding.Utf16 as U16
62+import qualified Data.Text.Encoding.Utf16 as U16
6663
6764default(Int)
6865
6966-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
7067stream :: Text -> Stream Char
71−stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)
68+stream (Text arr off len) = Stream next off (maxSize len)
7269 where
7370 !end = off+len
7471 next !i
@@ -83,7 +80,7 @@ stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)
8380-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate
8481-- backwards.
8582reverseStream :: Text -> Stream Char
86−reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `shiftR` 1) len)
83+reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)
8784 where
8885 {-# INLINE next #-}
8986 next !i
@@ -98,35 +95,25 @@ reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `sh
9895-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
9996unstream :: Stream Char -> Text
10097unstream (Stream next0 s0 len) = runText $ \done -> do
101− -- Before encoding each char we perform a buffer realloc check assuming
102− -- worst case encoding size of two 16-bit units for the char. Just add an
103− -- extra space to the buffer so that we do not end up reallocating even when
104− -- all the chars are encoded as single unit.
105− let mlen = upperBound 4 len + 1
98+ let mlen = upperBound 4 len
10699 arr0 <- A.new mlen
107− let outer !arr !maxi = encode
100+ let outer arr top = loop
108101 where
109− -- keep the common case loop as small as possible
110− encode !si !di =
111− case next0 si of
112− Done -> done arr di
113− Skip si' -> encode si' di
114− Yield c si'
115− -- simply check for the worst case
116− | maxi < di + 1 -> realloc si di
117− | otherwise -> do
118− n <- unsafeWrite arr di c
119− encode si' (di + n)
120−
121− -- keep uncommon case separate from the common case code
122− {-# NOINLINE realloc #-}
123− realloc !si !di = do
124− let newlen = (maxi + 1) * 2
125− arr' <- A.new newlen
126− A.copyM arr' 0 arr 0 di
127− outer arr' (newlen - 1) si di
128−
129− outer arr0 (mlen - 1) s0 0
102+ loop !s !i =
103+ case next0 s of
104+ Done -> done arr i
105+ Skip s' -> loop s' i
106+ Yield x s'
107+ | j >= top -> {-# SCC "unstream/resize" #-} do
108+ let top' = (top + 1) `shiftL` 1
109+ arr' <- A.new top'
110+ A.copyM arr' 0 arr 0 top
111+ outer arr' top' s i
112+ | otherwise -> do d <- unsafeWrite arr i x
113+ loop s' (i+d)
114+ where j | ord x < 0x10000 = i
115+ | otherwise = i + 1
116+ outer arr0 mlen s0 0
130117{-# INLINE [0] unstream #-}
131118{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
132119
@@ -142,7 +129,7 @@ length = S.lengthI
142129reverse :: Stream Char -> Text
143130reverse (Stream next s len0)
144131 | isEmpty len0 = I.empty
145− | otherwise = I.text arr off' len'
132+ | otherwise = I.textP arr off' len'
146133 where
147134 len0' = upperBound 4 (larger len0 4)
148135 (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')
@@ -176,15 +163,15 @@ reverse (Stream next s len0)
176163-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with
177164-- the input and result reversed.
178165reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
179−reverseScanr f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
166+reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low
180167 where
181168 {-# INLINE next #-}
182− next (Scan1 z s) = Yield z (Scan2 z s)
183− next (Scan2 z s) = case next0 s of
184− Yield x s' -> let !x' = f x z
185− in Yield x' (Scan2 x' s')
186− Skip s' -> Skip (Scan2 z s')
187− Done -> Done
169+ next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)
170+ next (S2 :*: z :*: s) = case next0 s of
171+ Yield x s' -> let !x' = f x z
172+ in Yield x' (S2 :*: x' :*: s')
173+ Skip s' -> Skip (S2 :*: z :*: s')
174+ Done -> Done
188175{-# INLINE reverseScanr #-}
189176
190177-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
@@ -220,7 +207,7 @@ countChar = S.countCharI
220207-- function to each element of a 'Text', passing an accumulating
221208-- parameter from left to right, and returns a final 'Text'.
222209mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)
223−mapAccumL f z0 (Stream next0 s0 len) = (nz, I.text na 0 nl)
210+mapAccumL f z0 (Stream next0 s0 len) = (nz,I.textP na 0 nl)
224211 where
225212 (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)
226213 where mlen = upperBound 4 len
Data/Text/Internal/Fusion/CaseMapping.hs → Data/Text/Fusion/CaseMapping.hsrenamed+21−293
@@ -1,17 +1,17 @@
11{-# LANGUAGE Rank2Types #-}
22-- AUTOMATICALLY GENERATED - DO NOT EDIT
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]
3+-- Generated by scripts/SpecialCasing.hs
4+-- CaseFolding-6.3.0.txt
5+-- Date: 2012-12-20, 22:14:35 GMT [MD]
6+-- SpecialCasing-6.3.0.txt
7+-- Date: 2013-05-08, 13:54:51 GMT [MD]
88
9−module Data.Text.Internal.Fusion.CaseMapping where
9+module Data.Text.Fusion.CaseMapping where
1010import Data.Char
11−import Data.Text.Internal.Fusion.Types
11+import Data.Text.Fusion.Internal
1212
1313upperMapping :: forall s. Char -> s -> Step (CC s) Char
14−{-# NOINLINE upperMapping #-}
14+{-# INLINE upperMapping #-}
1515-- LATIN SMALL LETTER SHARP S
1616upperMapping '\x00df' s = Yield '\x0053' (CC s '\x0053' '\x0000')
1717-- LATIN SMALL LIGATURE FF
@@ -218,12 +218,12 @@ upperMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0399')
218218upperMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0399')
219219upperMapping c s = Yield (toUpper c) (CC s '\0' '\0')
220220lowerMapping :: forall s. Char -> s -> Step (CC s) Char
221−{-# NOINLINE lowerMapping #-}
221+{-# INLINE lowerMapping #-}
222222-- LATIN CAPITAL LETTER I WITH DOT ABOVE
223223lowerMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')
224224lowerMapping c s = Yield (toLower c) (CC s '\0' '\0')
225225titleMapping :: forall s. Char -> s -> Step (CC s) Char
226−{-# NOINLINE titleMapping #-}
226+{-# INLINE titleMapping #-}
227227-- LATIN SMALL LETTER SHARP S
228228titleMapping '\x00df' s = Yield '\x0053' (CC s '\x0073' '\x0000')
229229-- LATIN SMALL LIGATURE FF
@@ -322,7 +322,7 @@ titleMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0345')
322322titleMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0345')
323323titleMapping c s = Yield (toTitle c) (CC s '\0' '\0')
324324foldMapping :: forall s. Char -> s -> Step (CC s) Char
325−{-# NOINLINE foldMapping #-}
325+{-# INLINE foldMapping #-}
326326-- MICRO SIGN
327327foldMapping '\x00b5' s = Yield '\x03bc' (CC s '\x0000' '\x0000')
328328-- LATIN SMALL LETTER SHARP S
@@ -359,18 +359,10 @@ foldMapping '\x03f1' s = Yield '\x03c1' (CC s '\x0000' '\x0000')
359359foldMapping '\x03f5' s = Yield '\x03b5' (CC s '\x0000' '\x0000')
360360-- ARMENIAN SMALL LIGATURE ECH YIWN
361361foldMapping '\x0587' s = Yield '\x0565' (CC s '\x0582' '\x0000')
362−-- 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')
362+-- GEORGIAN CAPITAL LETTER YN
363+foldMapping '\x10c7' s = Yield '\x2d27' (CC s '\x0000' '\x0000')
364+-- GEORGIAN CAPITAL LETTER AEN
365+foldMapping '\x10cd' s = Yield '\x2d2d' (CC s '\x0000' '\x0000')
374366-- LATIN SMALL LETTER H WITH LINE BELOW
375367foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')
376368-- LATIN SMALL LETTER T WITH DIAERESIS
@@ -545,174 +537,12 @@ foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')
545537foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')
546538-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
547539foldMapping '\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')
540+-- COPTIC CAPITAL LETTER BOHAIRIC KHEI
541+foldMapping '\x2cf2' s = Yield '\x2cf3' (CC s '\x0000' '\x0000')
542+-- LATIN CAPITAL LETTER C WITH BAR
543+foldMapping '\xa792' s = Yield '\xa793' (CC s '\x0000' '\x0000')
544+-- LATIN CAPITAL LETTER H WITH HOOK
545+foldMapping '\xa7aa' s = Yield '\x0266' (CC s '\x0000' '\x0000')
716546-- LATIN SMALL LIGATURE FF
717547foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')
718548-- LATIN SMALL LIGATURE FI
@@ -737,106 +567,4 @@ foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')
737567foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')
738568-- ARMENIAN SMALL LIGATURE MEN XEH
739569foldMapping '\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')
842570foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
Data/Text/Internal/Fusion/Common.hs → Data/Text/Fusion/Common.hsrenamed+84−75
@@ -1,20 +1,17 @@
11{-# LANGUAGE BangPatterns, MagicHash, Rank2Types #-}
22-- |
3−-- Module : Data.Text.Internal.Fusion.Common
3+-- Module : Data.Text.Fusion.Common
44-- Copyright : (c) Bryan O'Sullivan 2009, 2012
55--
66-- License : BSD-style
7−-- Maintainer : bos@serpentine.com
7+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
8+-- duncan@haskell.org
89-- Stability : experimental
910-- Portability : GHC
1011--
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−--
1512-- Common stream fusion functionality for text.
1613
17−module Data.Text.Internal.Fusion.Common
14+module Data.Text.Fusion.Common
1815 (
1916 -- * Creation and elimination
2017 singleton
@@ -71,6 +68,9 @@ module Data.Text.Internal.Fusion.Common
7168 -- ** Scans
7269 , scanl
7370
71+ -- ** Accumulating maps
72+ -- , mapAccumL
73+
7474 -- ** Generation and unfolding
7575 , replicateCharI
7676 , replicateI
@@ -103,16 +103,16 @@ module Data.Text.Internal.Fusion.Common
103103
104104import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
105105 Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),
106− (&&), fromIntegral, otherwise)
106+ (&&), fromIntegral, not, otherwise)
107107import qualified Data.List as L
108108import qualified Prelude as P
109109import Data.Bits (shiftL)
110110import Data.Char (isLetter)
111111import Data.Int (Int64)
112−import Data.Text.Internal.Fusion.Types
113−import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,
112+import Data.Text.Fusion.Internal
113+import Data.Text.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,
114114 upperMapping)
115−import Data.Text.Internal.Fusion.Size
115+import Data.Text.Fusion.Size
116116import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)
117117import GHC.Types (Char(..), Int(..))
118118
@@ -120,7 +120,7 @@ singleton :: Char -> Stream Char
120120singleton c = Stream next False 1
121121 where next False = Yield c True
122122 next True = Done
123−{-# INLINE [0] singleton #-}
123+{-# INLINE singleton #-}
124124
125125streamList :: [a] -> Stream a
126126{-# INLINE [0] streamList #-}
@@ -184,9 +184,6 @@ cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
184184 Yield x s' -> Yield x (C0 s')
185185{-# INLINE [0] cons #-}
186186
187−data Snoc a = N
188− | J !a
189−
190187-- | /O(n)/ Adds a character to the end of a stream.
191188snoc :: Stream Char -> Char -> Stream Char
192189snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
@@ -315,13 +312,12 @@ lengthI (Stream next s0 _len) = loop_length 0 s0
315312--
316313-- This function gives the same answer as comparing against the result
317314-- of 'lengthI', but can short circuit if the count of characters is
318−-- greater than the number or if the stream can't possibly be as long
319−-- as the number supplied, and hence be more efficient.
315+-- greater than the number, and hence be more efficient.
320316compareLengthI :: Integral a => Stream Char -> a -> Ordering
321317compareLengthI (Stream next s0 len) n =
322− case compareSize len (fromIntegral n) of
323− Just o -> o
318+ case exactly len of
324319 Nothing -> loop_cmp 0 s0
320+ Just i -> compare (fromIntegral i) n
325321 where
326322 loop_cmp !z s = case next s of
327323 Done -> compare z n
@@ -473,20 +469,17 @@ toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len
473469 next (CC s a b) = Yield a (CC s b '\0')
474470{-# INLINE [0] toTitle #-}
475471
476−data Justify i s = Just1 !i !s
477− | Just2 !i !s
478−
479472justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
480473justifyLeftI k c (Stream next0 s0 len) =
481− Stream next (Just1 0 s0) (larger (fromIntegral k) len)
474+ Stream next (s0 :*: S1 :*: 0) (larger (fromIntegral k) len)
482475 where
483− next (Just1 n s) =
476+ next (s :*: S1 :*: n) =
484477 case next0 s of
485− Done -> next (Just2 n s)
486− Skip s' -> Skip (Just1 n s')
487− Yield x s' -> Yield x (Just1 (n+1) s')
488− next (Just2 n s)
489− | n < k = Yield c (Just2 (n+1) s)
478+ Done -> next (s :*: S2 :*: n)
479+ Skip s' -> Skip (s' :*: S1 :*: n)
480+ Yield x s' -> Yield x (s' :*: S1 :*: n+1)
481+ next (s :*: S2 :*: n)
482+ | n < k = Yield c (s :*: S2 :*: n+1)
490483 | otherwise = Done
491484 {-# INLINE next #-}
492485{-# INLINE [0] justifyLeftI #-}
@@ -593,7 +586,7 @@ concatMap f = foldr (append . f) empty
593586{-# INLINE [0] concatMap #-}
594587
595588-- | /O(n)/ any @p @xs determines if any character in the stream
596−-- @xs@ satisfies the predicate @p@.
589+-- @xs@ satisifes the predicate @p@.
597590any :: (Char -> Bool) -> Stream Char -> Bool
598591any p (Stream next0 s0 _len) = loop_any s0
599592 where
@@ -605,7 +598,7 @@ any p (Stream next0 s0 _len) = loop_any s0
605598{-# INLINE [0] any #-}
606599
607600-- | /O(n)/ all @p @xs determines if all characters in the 'Text'
608−-- @xs@ satisfy the predicate @p@.
601+-- @xs@ satisify the predicate @p@.
609602all :: (Char -> Bool) -> Stream Char -> Bool
610603all p (Stream next0 s0 _len) = loop_all s0
611604 where
@@ -654,27 +647,50 @@ minimum (Stream next0 s0 _len) = loop0_minimum s0
654647-- * Building streams
655648
656649scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
657−scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
650+scanl f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low
658651 where
659652 {-# INLINE next #-}
660− next (Scan1 z s) = Yield z (Scan2 z s)
661− next (Scan2 z s) = case next0 s of
662− Yield x s' -> let !x' = f z x
663− in Yield x' (Scan2 x' s')
664− Skip s' -> Skip (Scan2 z s')
665− Done -> Done
653+ next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)
654+ next (S2 :*: z :*: s) = case next0 s of
655+ Yield x s' -> let !x' = f z x
656+ in Yield x' (S2 :*: x' :*: s')
657+ Skip s' -> Skip (S2 :*: z :*: s')
658+ Done -> Done
666659{-# INLINE [0] scanl #-}
667660
661+-- -----------------------------------------------------------------------------
662+-- ** Accumulating maps
663+
664+{-
665+-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a
666+-- function to each element of a stream, passing an accumulating
667+-- parameter from left to right, and returns a final stream.
668+--
669+-- /Note/: Unlike the version over lists, this function does not
670+-- return a final value for the accumulator, because the nature of
671+-- streams precludes it.
672+mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b
673+mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :*: z0) len -- HINT depends on f
674+ where
675+ {-# INLINE next #-}
676+ next (s :*: z) = case next0 s of
677+ Yield x s' -> let (z',y) = f z x
678+ in Yield y (s' :*: z')
679+ Skip s' -> Skip (s' :*: z)
680+ Done -> Done
681+{-# INLINE [0] mapAccumL #-}
682+-}
683+
668684-- -----------------------------------------------------------------------------
669685-- ** Generating and unfolding streams
670686
671687replicateCharI :: Integral a => a -> Char -> Stream Char
672−replicateCharI !n !c
688+replicateCharI n c
673689 | n < 0 = empty
674690 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
675691 where
676− next !i | i >= n = Done
677− | otherwise = Yield c (i + 1)
692+ next i | i >= n = Done
693+ | otherwise = Yield c (i + 1)
678694{-# INLINE [0] replicateCharI #-}
679695
680696data RI s = RI !s {-# UNPACK #-} !Int64
@@ -739,27 +755,24 @@ take n0 (Stream next0 s0 len) =
739755 Yield x s' -> Yield x ((n-1) :*: s')
740756{-# INLINE [0] take #-}
741757
742−data Drop a s = NS !s
743− | JS !a !s
744−
745758-- | /O(n)/ drop n, applied to a stream, returns the suffix of the
746759-- stream after the first @n@ characters, or the empty stream if @n@
747760-- is greater than the length of the stream.
748761drop :: Integral a => a -> Stream Char -> Stream Char
749762drop n0 (Stream next0 s0 len) =
750− Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))
763+ Stream next (J n0 :*: s0) (len - fromIntegral (max 0 n0))
751764 where
752765 {-# INLINE next #-}
753− next (JS n s)
754− | n <= 0 = Skip (NS s)
766+ next (J n :*: s)
767+ | n <= 0 = Skip (N :*: s)
755768 | otherwise = case next0 s of
756769 Done -> Done
757− Skip s' -> Skip (JS n s')
758− Yield _ s' -> Skip (JS (n-1) s')
759− next (NS s) = case next0 s of
770+ Skip s' -> Skip (J n :*: s')
771+ Yield _ s' -> Skip (J (n-1) :*: s')
772+ next (N :*: s) = case next0 s of
760773 Done -> Done
761− Skip s' -> Skip (NS s')
762− Yield x s' -> Yield x (NS s')
774+ Skip s' -> Skip (N :*: s')
775+ Yield x s' -> Yield x (N :*: s')
763776{-# INLINE [0] drop #-}
764777
765778-- | takeWhile, applied to a predicate @p@ and a stream, returns the
@@ -777,18 +790,18 @@ takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
777790
778791-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
779792dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
780−dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
793+dropWhile p (Stream next0 s0 len) = Stream next (S1 :*: s0) len -- HINT maybe too high
781794 where
782795 {-# INLINE next #-}
783− next (L s) = case next0 s of
796+ next (S1 :*: s) = case next0 s of
784797 Done -> Done
785− Skip s' -> Skip (L s')
786− Yield x s' | p x -> Skip (L s')
787− | otherwise -> Yield x (R s')
788− next (R s) = case next0 s of
798+ Skip s' -> Skip (S1 :*: s')
799+ Yield x s' | p x -> Skip (S1 :*: s')
800+ | otherwise -> Yield x (S2 :*: s')
801+ next (S2 :*: s) = case next0 s of
789802 Done -> Done
790− Skip s' -> Skip (R s')
791− Yield x s' -> Yield x (R s')
803+ Skip s' -> Skip (S2 :*: s')
804+ Yield x s' -> Yield x (S2 :*: s')
792805{-# INLINE [0] dropWhile #-}
793806
794807-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
@@ -895,25 +908,21 @@ findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0
895908-------------------------------------------------------------------------------
896909-- * Zipping
897910
898−-- | Strict triple.
899−data Zip a b m = Z1 !a !b
900− | Z2 !a !b !m
901−
902911-- | zipWith generalises 'zip' by zipping with the function given as
903912-- the first argument, instead of a tupling function.
904913zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
905914zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
906− Stream next (Z1 sa0 sb0) (smaller len1 len2)
915+ Stream next (sa0 :*: sb0 :*: N) (smaller len1 len2)
907916 where
908− next (Z1 sa sb) = case next0 sa of
909− Done -> Done
910− Skip sa' -> Skip (Z1 sa' sb)
911− Yield a sa' -> Skip (Z2 sa' sb a)
912−
913− next (Z2 sa' sb a) = case next1 sb of
914− Done -> Done
915− Skip sb' -> Skip (Z2 sa' sb' a)
916− Yield b sb' -> Yield (f a b) (Z1 sa' sb')
917+ next (sa :*: sb :*: N) = case next0 sa of
918+ Done -> Done
919+ Skip sa' -> Skip (sa' :*: sb :*: N)
920+ Yield a sa' -> Skip (sa' :*: sb :*: J a)
921+
922+ next (sa' :*: sb :*: J a) = case next1 sb of
923+ Done -> Done
924+ Skip sb' -> Skip (sa' :*: sb' :*: J a)
925+ Yield b sb' -> Yield (f a b) (sa' :*: sb' :*: N)
917926{-# INLINE [0] zipWith #-}
918927
919928-- | /O(n)/ The 'countCharI' function returns the number of times the
@@ -929,7 +938,7 @@ countCharI a (Stream next s0 _len) = loop 0 s0
929938{-# INLINE [0] countCharI #-}
930939
931940streamError :: String -> String -> a
932−streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg
941+streamError func msg = P.error $ "Data.Text.Fusion.Common." ++ func ++ ": " ++ msg
933942
934943emptyError :: String -> a
935944emptyError func = internalError func "Empty input"
Data/Text/Internal/Fusion/Types.hs → Data/Text/Fusion/Internal.hsrenamed+18−16
@@ -1,56 +1,58 @@
11{-# LANGUAGE BangPatterns, ExistentialQuantification #-}
22-- |
3−-- Module : Data.Text.Internal.Fusion.Types
3+-- Module : Data.Text.Fusion.Internal
44-- Copyright : (c) Tom Harper 2008-2009,
55-- (c) Bryan O'Sullivan 2009,
66-- (c) Duncan Coutts 2009,
77-- (c) Jasper Van der Jeugt 2011
88--
99-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
1112-- Stability : experimental
1213-- Portability : GHC
1314--
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−--
1815-- Core stream fusion functionality for text.
1916
20−module Data.Text.Internal.Fusion.Types
17+module Data.Text.Fusion.Internal
2118 (
2219 CC(..)
20+ , M(..)
21+ , M8
2322 , PairS(..)
24− , Scan(..)
2523 , RS(..)
2624 , Step(..)
2725 , Stream(..)
26+ , Switch(..)
2827 , empty
2928 ) where
3029
31−import Data.Text.Internal.Fusion.Size
30+import Data.Text.Fusion.Size
3231import Data.Word (Word8)
3332
3433-- | Specialised tuple for case conversion.
3534data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char
3635
37−-- | Restreaming state.
36+-- | Specialised, strict Maybe-like type.
37+data M a = N
38+ | J !a
39+
40+type M8 = M Word8
41+
42+-- Restreaming state.
3843data RS s
3944 = RS0 !s
4045 | RS1 !s {-# UNPACK #-} !Word8
4146 | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
4247 | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
4348
44−-- | Strict pair.
49+infixl 2 :*:
4550data PairS a b = !a :*: !b
4651 -- deriving (Eq, Ord, Show)
47−infixl 2 :*:
4852
49−-- | An intermediate result in a scan.
50−data Scan s = Scan1 {-# UNPACK #-} !Char !s
51− | Scan2 {-# UNPACK #-} !Char !s
53+-- | Allow a function over a stream to switch between two states.
54+data Switch = S1 | S2
5255
53−-- | Intermediate result in a processing pipeline.
5456data Step s a = Done
5557 | Skip !s
5658 | Yield !a !s
Data/Text/Fusion/Size.hsnew file+146
@@ -0,0 +1,146 @@
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 `quot` 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−3
@@ -50,9 +50,9 @@ import qualified Control.Exception as E
5050import Control.Monad (liftM2, when)
5151import Data.IORef (readIORef, writeIORef)
5252import qualified Data.Text as T
53−import Data.Text.Internal.Fusion (stream)
54−import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))
55−import Data.Text.Internal.IO (hGetLineWith, readChunk)
53+import Data.Text.Fusion (stream)
54+import Data.Text.Fusion.Internal (Step(..), Stream(..))
55+import Data.Text.IO.Internal (hGetLineWith, readChunk)
5656import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBufElem, CharBuffer,
5757 RawCharBuffer, emptyBuffer, isEmptyBuffer, newCharBuffer,
5858 writeCharBuf)
Data/Text/Internal/IO.hs → Data/Text/IO/Internal.hsrenamed+5−9
@@ -1,6 +1,6 @@
11{-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}
22-- |
3−-- Module : Data.Text.Internal.IO
3+-- Module : Data.Text.IO.Internal
44-- Copyright : (c) 2009, 2010 Bryan O'Sullivan,
55-- (c) 2009 Simon Marlow
66-- License : BSD-style
@@ -8,13 +8,9 @@
88-- Stability : experimental
99-- Portability : GHC
1010--
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−--
1511-- Low-level support for text I\/O.
1612
17−module Data.Text.Internal.IO
13+module Data.Text.IO.Internal
1814 (
1915 hGetLineWith
2016 , readChunk
@@ -23,9 +19,9 @@ module Data.Text.Internal.IO
2319import qualified Control.Exception as E
2420import Data.IORef (readIORef, writeIORef)
2521import Data.Text (Text)
26−import Data.Text.Internal.Fusion (unstream)
27−import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))
28−import Data.Text.Internal.Fusion.Size (exactSize, maxSize)
22+import Data.Text.Fusion (unstream)
23+import Data.Text.Fusion.Internal (Step(..), Stream(..))
24+import Data.Text.Fusion.Size (exactSize, maxSize)
2925import Data.Text.Unsafe (inlinePerformIO)
3026import Foreign.Storable (peekElemOff)
3127import GHC.IO.Buffer (Buffer(..), CharBuffer, RawCharBuffer, bufferAdjustL,
Data/Text/Internal.hs+13−77
@@ -1,5 +1,4 @@
1−{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples #-}
2−{-# OPTIONS_HADDOCK not-home #-}
1+{-# LANGUAGE CPP, DeriveDataTypeable #-}
32
43-- |
54-- Module : Data.Text.Internal
@@ -8,7 +7,8 @@
87-- (c) 2009 Duncan Coutts
98--
109-- License : BSD-style
11−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
1212-- Stability : experimental
1313-- Portability : GHC
1414--
@@ -20,10 +20,6 @@
2020-- with the internals, as the functions here do just about nothing to
2121-- preserve data invariants. You have been warned!
2222
23−#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
24−#include "MachDeps.h"
25−#endif
26−
2723module Data.Text.Internal
2824 (
2925 -- * Types
@@ -36,13 +32,8 @@ module Data.Text.Internal
3632 , safe
3733 -- * Code that must be here for accessibility
3834 , empty
39− , empty_
4035 -- * Utilities
4136 , firstf
42− -- * Checked multiplication
43− , mul
44− , mul32
45− , mul64
4637 -- * Debugging
4738 , showText
4839 ) where
@@ -50,11 +41,10 @@ module Data.Text.Internal
5041#if defined(ASSERTS)
5142import Control.Exception (assert)
5243#endif
53−import Data.Bits
54−import Data.Int (Int32, Int64)
55−import Data.Text.Internal.Unsafe.Char (ord)
56−import Data.Typeable (Typeable)
44+import Data.Bits ((.&.))
5745import qualified Data.Text.Array as A
46+import Data.Text.UnsafeChar (ord)
47+import Data.Typeable (Typeable)
5848
5949-- | A space efficient, packed, unboxed Unicode text type.
6050data Text = Text
@@ -64,8 +54,8 @@ data Text = Text
6454 deriving (Typeable)
6555
6656-- | Smart constructor.
67−text_ :: A.Array -> Int -> Int -> Text
68−text_ arr off len =
57+text :: A.Array -> Int -> Int -> Text
58+text arr off len =
6959#if defined(ASSERTS)
7060 let c = A.unsafeIndex arr off
7161 alen = A.length arr
@@ -75,28 +65,19 @@ text_ arr off len =
7565 assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $
7666#endif
7767 Text arr off len
78−{-# INLINE text_ #-}
68+{-# INLINE text #-}
7969
8070-- | /O(1)/ The empty 'Text'.
8171empty :: Text
8272empty = Text A.empty 0 0
8373{-# INLINE [1] empty #-}
8474
85−-- | A non-inlined version of 'empty'.
86−empty_ :: Text
87−empty_ = Text A.empty 0 0
88−{-# NOINLINE empty_ #-}
89−
9075-- | Construct a 'Text' without invisibly pinning its byte array in
9176-- 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−
9777textP :: A.Array -> Int -> Int -> Text
98−{-# DEPRECATED textP "Use text instead" #-}
99−textP = text
78+textP arr off len | len == 0 = empty
79+ | otherwise = text arr off len
80+{-# INLINE textP #-}
10081
10182-- | A useful 'show'-like function for debugging purposes.
10283showText :: Text -> String
@@ -116,58 +97,13 @@ safe :: Char -> Char
11697safe c
11798 | ord c .&. 0x1ff800 /= 0xd800 = c
11899 | otherwise = '\xfffd'
119−{-# INLINE [0] safe #-}
100+{-# INLINE safe #-}
120101
121102-- | Apply a function to the first element of an optional pair.
122103firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)
123104firstf f (Just (a, b)) = Just (f a, b)
124105firstf _ Nothing = Nothing
125106
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−
171107-- $internals
172108--
173109-- Internally, the 'Text' type is represented as an array of 'Word16'
Data/Text/Internal/Builder/RealFloat/Functions.hsdeleted−57
@@ -1,57 +0,0 @@
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/Internal/Fusion/Size.hsdeleted−157
@@ -1,157 +0,0 @@
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/Internal/Lazy.hsdeleted−119
@@ -1,119 +0,0 @@
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/Internal/Read.hsdeleted−62
@@ -1,62 +0,0 @@
1−-- |
2−-- Module : Data.Text.Internal.Read
3−-- Copyright : (c) 2014 Bryan O'Sullivan
4−--
5−-- License : BSD-style
6−-- Maintainer : bos@serpentine.com
7−-- Stability : experimental
8−-- Portability : GHC
9−--
10−-- Common internal functions for reading textual data.
11−module Data.Text.Internal.Read
12− (
13− IReader
14− , IParser(..)
15− , T(..)
16− , digitToInt
17− , hexDigitToInt
18− , perhaps
19− ) where
20−
21−import Control.Applicative as App (Applicative(..))
22−import Control.Arrow (first)
23−import Control.Monad (ap)
24−import Data.Char (ord)
25−
26−type IReader t a = t -> Either String (a,t)
27−
28−newtype IParser t a = P {
29− runP :: IReader t a
30− }
31−
32−instance Functor (IParser t) where
33− fmap f m = P $ fmap (first f) . runP m
34−
35−instance Applicative (IParser t) where
36− pure a = P $ \t -> Right (a,t)
37− {-# INLINE pure #-}
38− (<*>) = ap
39−
40−instance Monad (IParser t) where
41− return = App.pure
42− m >>= k = P $ \t -> case runP m t of
43− Left err -> Left err
44− Right (a,t') -> runP (k a) t'
45− {-# INLINE (>>=) #-}
46− fail msg = P $ \_ -> Left msg
47−
48−data T = T !Integer !Int
49−
50−perhaps :: a -> IParser t a -> IParser t a
51−perhaps def m = P $ \t -> case runP m t of
52− Left _ -> Right (def,t)
53− r@(Right _) -> r
54−
55−hexDigitToInt :: Char -> Int
56−hexDigitToInt c
57− | c >= '0' && c <= '9' = ord c - ord '0'
58− | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)
59− | otherwise = ord c - (ord 'A' - 10)
60−
61−digitToInt :: Char -> Int
62−digitToInt c = ord c - ord '0'
Data/Text/Lazy.hs+35−209
@@ -3,16 +3,13 @@
33#if __GLASGOW_HASKELL__ >= 702
44{-# LANGUAGE Trustworthy #-}
55#endif
6−#if __GLASGOW_HASKELL__ >= 708
7−{-# LANGUAGE TypeFamilies #-}
8−#endif
9−
106-- |
117-- Module : Data.Text.Lazy
128-- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan
139--
1410-- License : BSD-style
15−-- Maintainer : bos@serpentine.com
11+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
12+-- duncan@haskell.org
1613-- Stability : experimental
1714-- Portability : GHC
1815--
@@ -125,10 +122,7 @@ module Data.Text.Lazy
125122 , mapAccumR
126123
127124 -- ** Generation and unfolding
128− , repeat
129125 , replicate
130− , cycle
131− , iterate
132126 , unfoldr
133127 , unfoldrN
134128
@@ -136,11 +130,8 @@ module Data.Text.Lazy
136130
137131 -- ** Breaking strings
138132 , take
139− , takeEnd
140133 , drop
141− , dropEnd
142134 , takeWhile
143− , takeWhileEnd
144135 , dropWhile
145136 , dropWhileEnd
146137 , dropAround
@@ -211,39 +202,27 @@ import Control.DeepSeq (NFData(..))
211202import Data.Int (Int64)
212203import qualified Data.List as L
213204import Data.Char (isSpace)
214−import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
215− Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
216−import Data.Binary (Binary(get, put))
205+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))
206+import Data.Data (mkNoRepType)
217207import Data.Monoid (Monoid(..))
218−#if MIN_VERSION_base(4,9,0)
219−import Data.Semigroup (Semigroup(..))
220−#endif
221208import Data.String (IsString(..))
222209import qualified Data.Text as T
223210import qualified Data.Text.Internal as T
224−import qualified Data.Text.Internal.Fusion.Common as S
211+import qualified Data.Text.Fusion.Common as S
225212import qualified Data.Text.Unsafe as T
226−import qualified Data.Text.Internal.Lazy.Fusion as S
227−import Data.Text.Internal.Fusion.Types (PairS(..))
228−import Data.Text.Internal.Lazy.Fusion (stream, unstream)
229−import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks,
230− foldrChunks, smallChunkSize)
231−import Data.Text.Internal (firstf, safe, text)
232−import Data.Text.Lazy.Encoding (decodeUtf8', encodeUtf8)
233−import qualified Data.Text.Internal.Functions as F
234−import Data.Text.Internal.Lazy.Search (indices)
213+import qualified Data.Text.Lazy.Fusion as S
214+import Data.Text.Fusion.Internal (PairS(..))
215+import Data.Text.Lazy.Fusion (stream, unstream)
216+import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldlChunks, foldrChunks)
217+import Data.Text.Internal (firstf, safe, textP)
218+import qualified Data.Text.Util as U
219+import Data.Text.Lazy.Search (indices)
235220#if __GLASGOW_HASKELL__ >= 702
236221import qualified GHC.CString as GHC
237222#else
238223import qualified GHC.Base as GHC
239224#endif
240−#if __GLASGOW_HASKELL__ >= 708
241−import qualified GHC.Exts as Exts
242−#endif
243225import GHC.Prim (Addr#)
244−#if MIN_VERSION_base(4,7,0)
245−import Text.Printf (PrintfArg, formatArg, formatString)
246−#endif
247226
248227-- $fusion
249228--
@@ -341,71 +320,25 @@ instance Show Text where
341320instance Read Text where
342321 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
343322
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−
352323instance Monoid Text where
353324 mempty = empty
354−#if MIN_VERSION_base(4,9,0)
355− mappend = (<>) -- future-proof definition
356−#else
357325 mappend = append
358−#endif
359326 mconcat = concat
360327
361328instance IsString Text where
362329 fromString = pack
363330
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−
371331#if defined(HAVE_DEEPSEQ)
372332instance NFData Text where
373333 rnf Empty = ()
374334 rnf (Chunk _ ts) = rnf ts
375335#endif
376336
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'
390337instance Data Text where
391338 gfoldl f z txt = z pack `f` (unpack txt)
392− toConstr _ = packConstr
393− gunfold k z c = case constrIndex c of
394− 1 -> k (z pack)
395− _ -> error "Data.Text.Lazy.Text.gunfold"
396− dataTypeOf _ = textDataType
397−
398−#if MIN_VERSION_base(4,7,0)
399−-- | Only defined for @base-4.7.0.0@ and later
400−instance PrintfArg Text where
401− formatArg txt = formatString $ unpack txt
402−#endif
403−
404−packConstr :: Constr
405−packConstr = mkConstr textDataType "pack" [] Prefix
406−
407−textDataType :: DataType
408−textDataType = mkDataType "Data.Text.Lazy.Text" [packConstr]
339+ toConstr _ = error "Data.Text.Lazy.Text.toConstr"
340+ gunfold _ _ = error "Data.Text.Lazy.Text.gunfold"
341+ dataTypeOf _ = mkNoRepType "Data.Text.Lazy.Text"
409342
410343-- | /O(n)/ Convert a 'String' into a 'Text'.
411344--
@@ -433,14 +366,6 @@ unpackCString# addr# = unstream (S.streamCString# addr#)
433366 unstream (S.streamList (L.map safe (GHC.unpackCStringUtf8# a)))
434367 = unpackCString# a #-}
435368
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−
444369-- | /O(1)/ Convert a character into a Text. Subject to fusion.
445370-- Performs replacement on invalid scalar values.
446371singleton :: Char -> Text
@@ -545,7 +470,7 @@ tail Empty = emptyError "tail"
545470 unstream (S.tail (stream t)) = tail t
546471 #-}
547472
548−-- | /O(n\/c)/ Returns all but the last character of a 'Text', which must
473+-- | /O(1)/ Returns all but the last character of a 'Text', which must
549474-- be non-empty. Subject to fusion.
550475init :: Text -> Text
551476init (Chunk t0 ts0) = go t0 ts0
@@ -581,7 +506,7 @@ isSingleton :: Text -> Bool
581506isSingleton = S.isSingleton . stream
582507{-# INLINE isSingleton #-}
583508
584−-- | /O(n\/c)/ Returns the last character of a 'Text', which must be
509+-- | /O(1)/ Returns the last character of a 'Text', which must be
585510-- non-empty. Subject to fusion.
586511last :: Text -> Char
587512last Empty = emptyError "last"
@@ -636,7 +561,7 @@ map f t = unstream (S.map (safe . f) (stream t))
636561-- 'Text's and concatenates the list after interspersing the first
637562-- argument between each element of the list.
638563intercalate :: Text -> [Text] -> Text
639−intercalate t = concat . (F.intersperse t)
564+intercalate t = concat . (U.intersperse t)
640565{-# INLINE intercalate #-}
641566
642567-- | /O(n)/ The 'intersperse' function takes a character and places it
@@ -715,36 +640,13 @@ reverse = rev Empty
715640 where rev a Empty = a
716641 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts
717642
718−-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
719−-- @haystack@ with @replacement@.
720−--
721−-- This function behaves as though it was defined as follows:
722−--
723−-- @
724−-- replace needle replacement haystack =
725−-- 'intercalate' replacement ('splitOn' needle haystack)
726−-- @
727−--
728−-- As this suggests, each occurrence is replaced exactly once. So if
729−-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
730−-- be replaced recursively:
731−--
732−-- > replace "oo" "foo" "oo" == "foo"
733−--
734−-- In cases where several instances of @needle@ overlap, only the
735−-- first one will be replaced:
736−--
737−-- > replace "ofo" "bar" "ofofo" == "barfo"
643+-- | /O(m+n)/ Replace every occurrence of one substring with another.
738644--
739645-- In (unlikely) bad cases, this function's time complexity degrades
740646-- towards /O(n*m)/.
741−replace :: Text
742− -- ^ @needle@ to search for. If this string is empty, an
743− -- error will occur.
744− -> Text
745− -- ^ @replacement@ to replace @needle@ with.
746− -> Text
747− -- ^ @haystack@ in which to search.
647+replace :: Text -- ^ Text to search for
648+ -> Text -- ^ Replacement text
649+ -> Text -- ^ Input text
748650 -> Text
749651replace s d = intercalate d . splitOn s
750652{-# INLINE replace #-}
@@ -881,13 +783,13 @@ concatMap f = concat . foldr ((:) . f) []
881783{-# INLINE concatMap #-}
882784
883785-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
884−-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
786+-- 'Text' @t@ satisifes the predicate @p@. Subject to fusion.
885787any :: (Char -> Bool) -> Text -> Bool
886788any p t = S.any p (stream t)
887789{-# INLINE any #-}
888790
889791-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
890−-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
792+-- 'Text' @t@ satisify the predicate @p@. Subject to fusion.
891793all :: (Char -> Bool) -> Text -> Bool
892794all p t = S.all p (stream t)
893795{-# INLINE all #-}
@@ -970,12 +872,6 @@ mapAccumR f = go
970872 go z Empty = (z, Empty)
971873{-# INLINE mapAccumR #-}
972874
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−
979875-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
980876-- @t@ repeated @n@ times.
981877replicate :: Int64 -> Text -> Text
@@ -985,22 +881,7 @@ replicate n t
985881 | otherwise = concat (rep 0)
986882 where rep !i | i >= n = []
987883 | otherwise = t : rep (i+1)
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
884+{-# INLINE replicate #-}
1004885
1005886-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
1006887-- value of every element. Subject to fusion.
@@ -1055,22 +936,6 @@ take i t0 = take' i t0
1055936 unstream (S.take n (stream t)) = take n t
1056937 #-}
1057938
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−
1074939-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1075940-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1076941-- is greater than the length of the 'Text'. Subject to fusion.
@@ -1093,23 +958,6 @@ drop i t0
1093958 unstream (S.drop n (stream t)) = drop n t
1094959 #-}
1095960
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−
1113961-- | /O(n)/ 'dropWords' @n@ returns the suffix with @n@ 'Word16'
1114962-- values dropped, or the empty 'Text' if @n@ is greater than the
1115963-- number of 'Word16' values present.
@@ -1120,7 +968,7 @@ dropWords i t0
1120968 where drop' 0 ts = ts
1121969 drop' _ Empty = Empty
1122970 drop' n (Chunk (T.Text arr off len) ts)
1123− | n < len' = chunk (text arr (off+n') (len-n')) ts
971+ | n < len' = chunk (textP arr (off+n') (len-n')) ts
1124972 | otherwise = drop' (n - len') ts
1125973 where len' = fromIntegral len
1126974 n' = fromIntegral n
@@ -1144,20 +992,6 @@ takeWhile p t0 = takeWhile' t0
1144992"LAZY TEXT takeWhile -> unfused" [1] forall p t.
1145993 unstream (S.takeWhile p (stream t)) = takeWhile p t
1146994 #-}
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 #-}
1161995
1162996-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1163997-- 'takeWhile' @p@ @t@. Subject to fusion.
@@ -1176,11 +1010,9 @@ dropWhile p t0 = dropWhile' t0
11761010"LAZY TEXT dropWhile -> unfused" [1] forall p t.
11771011 unstream (S.dropWhile p (stream t)) = dropWhile p t
11781012 #-}
1179−
11801013-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1181−-- dropping characters that satisfy the predicate @p@ from the end of
1014+-- dropping characters that fail the predicate @p@ from the end of
11821015-- @t@.
1183−--
11841016-- Examples:
11851017--
11861018-- > dropWhileEnd (=='.') "foo..." == "foo"
@@ -1197,7 +1029,7 @@ dropWhileEnd p = go
11971029{-# INLINE dropWhileEnd #-}
11981030
11991031-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1200−-- dropping characters that satisfy the predicate @p@ from both the
1032+-- dropping characters that fail the predicate @p@ from both the
12011033-- beginning and end of @t@. Subject to fusion.
12021034dropAround :: (Char -> Bool) -> Text -> Text
12031035dropAround p = dropWhile p . dropWhileEnd p
@@ -1247,8 +1079,8 @@ splitAtWord _ Empty = empty :*: empty
12471079splitAtWord x (Chunk c@(T.Text arr off len) cs)
12481080 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
12491081 in Chunk c h :*: t
1250− | otherwise = chunk (text arr off y) empty :*:
1251− chunk (text arr (off+y) (len-y)) cs
1082+ | otherwise = chunk (textP arr off y) empty :*:
1083+ chunk (textP arr (off+y) (len-y)) cs
12521084 where y = fromIntegral x
12531085
12541086-- | /O(n+m)/ Find the first instance of @needle@ (which must be
@@ -1392,10 +1224,9 @@ tails ts@(Chunk t ts')
13921224-- copies to create substrings; they just construct new 'Text's that
13931225-- are slices of the original.
13941226
1395−-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'
1396−-- argument (which cannot be an empty string), consuming the
1397−-- delimiter. An empty delimiter is invalid, and will cause an error
1398−-- to be raised.
1227+-- | /O(m+n)/ Break a 'Text' into pieces separated by the first
1228+-- 'Text' argument, consuming the delimiter. An empty delimiter is
1229+-- invalid, and will cause an error to be raised.
13991230--
14001231-- Examples:
14011232--
@@ -1408,18 +1239,13 @@ tails ts@(Chunk t ts')
14081239-- > intercalate s . splitOn s == id
14091240-- > splitOn (singleton c) == split (==c)
14101241--
1411−-- (Note: the string @s@ to split on above cannot be empty.)
1412−--
14131242-- This function is strict in its first argument, and lazy in its
14141243-- second.
14151244--
14161245-- In (unlikely) bad cases, this function's time complexity degrades
14171246-- towards /O(n*m)/.
1418−splitOn :: Text
1419− -- ^ String to split on. If this string is empty, an error
1420− -- will occur.
1421− -> Text
1422− -- ^ Input text.
1247+splitOn :: Text -- ^ Text to split on
1248+ -> Text -- ^ Input text
14231249 -> [Text]
14241250splitOn pat src
14251251 | null pat = emptyError "splitOn"
Data/Text/Lazy/Builder.hs+3−3
@@ -8,7 +8,7 @@
88-- Module : Data.Text.Lazy.Builder
99-- Copyright : (c) 2013 Bryan O'Sullivan
1010-- (c) 2010 Johan Tibell
11−-- License : BSD-style (see LICENSE)
11+-- License : BSD3-style (see LICENSE)
1212--
1313-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
1414-- Stability : experimental
@@ -34,7 +34,7 @@
3434--
3535-- > singleton 'a' <> singleton 'b' <> singleton 'c'
3636--
37−-- since the '<>' from recent versions of 'Data.Monoid' associates
37+-- since the '<>' from recent versions of 'Data.Monoid' associates
3838-- to the right.
3939
4040-----------------------------------------------------------------------------
@@ -55,4 +55,4 @@ module Data.Text.Lazy.Builder
5555 , flush
5656 ) where
5757
58−import Data.Text.Internal.Builder
58+import Data.Text.Lazy.Builder.Internal
Data/Text/Internal/Builder/Functions.hs → Data/Text/Lazy/Builder/Functions.hsrenamed+3−8
@@ -1,7 +1,7 @@
11{-# LANGUAGE MagicHash #-}
22
33-- |
4−-- Module : Data.Text.Internal.Builder.Functions
4+-- Module : Data.Text.Lazy.Builder.Functions
55-- Copyright : (c) 2011 MailRank, Inc.
66--
77-- License : BSD-style
@@ -9,13 +9,9 @@
99-- Stability : experimental
1010-- Portability : GHC
1111--
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−--
1612-- Useful functions and combinators.
1713
18−module Data.Text.Internal.Builder.Functions
14+module Data.Text.Lazy.Builder.Functions
1915 (
2016 (<>)
2117 , i2d
@@ -23,8 +19,7 @@ module Data.Text.Internal.Builder.Functions
2319
2420import Data.Monoid (mappend)
2521import Data.Text.Lazy.Builder (Builder)
26−import GHC.Base (chr#,ord#,(+#),Int(I#),Char(C#))
27−import Prelude ()
22+import GHC.Base
2823
2924-- | Unsafe conversion for decimal digits.
3025{-# INLINE i2d #-}
Data/Text/Lazy/Builder/Int.hs+18−25
@@ -1,5 +1,4 @@
1−{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,
2− UnboxedTuples #-}
1+{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, UnboxedTuples #-}
32#if __GLASGOW_HASKELL__ >= 702
43{-# LANGUAGE Trustworthy #-}
54#endif
@@ -7,7 +6,7 @@
76-- Module: Data.Text.Lazy.Builder.Int
87-- Copyright: (c) 2013 Bryan O'Sullivan
98-- (c) 2011 MailRank, Inc.
10−-- License: BSD-style
9+-- License: BSD3
1110-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
1211-- Stability: experimental
1312-- Portability: portable
@@ -23,9 +22,9 @@ module Data.Text.Lazy.Builder.Int
2322import Data.Int (Int8, Int16, Int32, Int64)
2423import Data.Monoid (mempty)
2524import qualified Data.ByteString.Unsafe as B
26−import Data.Text.Internal.Builder.Functions ((<>), i2d)
27−import Data.Text.Internal.Builder
28−import Data.Text.Internal.Builder.Int.Digits (digits)
25+import Data.Text.Lazy.Builder.Functions ((<>), i2d)
26+import Data.Text.Lazy.Builder.Internal
27+import Data.Text.Lazy.Builder.Int.Digits (digits)
2928import Data.Text.Array
3029import Data.Word (Word, Word8, Word16, Word32, Word64)
3130import GHC.Base (quotInt, remInt)
@@ -35,7 +34,7 @@ import Control.Monad.ST
3534
3635#ifdef __GLASGOW_HASKELL__
3736# if defined(INTEGER_GMP)
38−import GHC.Integer.GMP.Internals (Integer(S#))
37+import GHC.Integer.GMP.Internals
3938# elif defined(INTEGER_SIMPLE)
4039import GHC.Integer
4140# else
@@ -50,19 +49,18 @@ import GHC.Integer
5049#endif
5150
5251decimal :: Integral a => a -> Builder
53−{-# RULES "decimal/Int8" decimal = boundedDecimal :: Int8 -> Builder #-}
52+{-# SPECIALIZE decimal :: Int8 -> Builder #-}
5453{-# RULES "decimal/Int" decimal = boundedDecimal :: Int -> Builder #-}
5554{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}
5655{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}
5756{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}
58−{-# RULES "decimal/Word" decimal = positive :: Data.Word.Word -> Builder #-}
57+{-# RULES "decimal/Word" decimal = positive :: Word -> Builder #-}
5958{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}
6059{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}
6160{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}
6261{-# RULES "decimal/Word64" decimal = positive :: Word64 -> Builder #-}
6362{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}
6463decimal i = decimal' (<= -128) i
65−{-# NOINLINE decimal #-}
6664
6765boundedDecimal :: (Integral a, Bounded a) => a -> Builder
6866{-# SPECIALIZE boundedDecimal :: Int -> Builder #-}
@@ -134,15 +132,8 @@ i2w v = zero + fromIntegral v
134132
135133countDigits :: (Integral a) => a -> Int
136134{-# 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)
135+countDigits v0 = go 1 (fromIntegral v0 :: Word64)
136+ where go !k v
146137 | v < 10 = k
147138 | v < 100 = k + 1
148139 | v < 1000 = k + 2
@@ -178,7 +169,6 @@ hexadecimal i
178169 where
179170 go n | n < 16 = hexDigit n
180171 | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)
181−{-# NOINLINE[0] hexadecimal #-}
182172
183173hexInteger :: Integer -> Builder
184174hexInteger i
@@ -194,12 +184,19 @@ hexDigit n
194184 | otherwise = singleton $! toEnum (fromIntegral n + 87)
195185{-# INLINE hexDigit #-}
196186
187+int :: Int -> Builder
188+int = decimal
189+{-# INLINE int #-}
190+
197191data T = T !Integer !Int
198192
199193integer :: Int -> Integer -> Builder
200194#ifdef INTEGER_GMP
201195integer 10 (S# i#) = decimal (I# i#)
202196integer 16 (S# i#) = hexadecimal (I# i#)
197+#else
198+integer 10 i = decimal i
199+integer 16 i = hexadecimal i
203200#endif
204201integer base i
205202 | i < 0 = singleton '-' <> go (-i)
@@ -247,11 +244,7 @@ integer base i
247244 PAIR(x,y) -> pblock q <> pblock r <> putB ns
248245 where q = fromInteger x
249246 r = fromInteger y
250− putB _ = Data.Monoid.mempty
251−
252− int :: Int -> Builder
253− int x | base == 10 = decimal x
254− | otherwise = hexadecimal x
247+ putB _ = mempty
255248
256249 pblock = loop maxDigits
257250 where
Data/Text/Internal/Builder/Int/Digits.hs → Data/Text/Lazy/Builder/Int/Digits.hsrenamed+3−7
@@ -1,20 +1,16 @@
11{-# LANGUAGE OverloadedStrings #-}
22
3−-- Module: Data.Text.Internal.Builder.Int.Digits
3+-- Module: Data.Text.Lazy.Builder.Int.Digits
44-- Copyright: (c) 2013 Bryan O'Sullivan
5−-- License: BSD-style
5+-- License: BSD3
66-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
77-- Stability: experimental
88-- Portability: portable
99--
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−--
1410-- This module exists because the C preprocessor does things that we
1511-- shall not speak of when confronted with Haskell multiline strings.
1612
17−module Data.Text.Internal.Builder.Int.Digits (digits) where
13+module Data.Text.Lazy.Builder.Int.Digits (digits) where
1814
1915import Data.ByteString.Char8 (ByteString)
2016
Data/Text/Internal/Builder.hs → Data/Text/Lazy/Builder/Internal.hsrenamed+19−27
@@ -1,21 +1,16 @@
11{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
2−{-# OPTIONS_HADDOCK not-home #-}
32
43-----------------------------------------------------------------------------
54-- |
6−-- Module : Data.Text.Internal.Builder
5+-- Module : Data.Text.Lazy.Builder.Internal
76-- Copyright : (c) 2013 Bryan O'Sullivan
87-- (c) 2010 Johan Tibell
9−-- License : BSD-style (see LICENSE)
8+-- License : BSD3-style (see LICENSE)
109--
1110-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
1211-- Stability : experimental
1312-- Portability : portable to Hugs and GHC
1413--
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−--
1914-- Efficient construction of lazy @Text@ values. The principal
2015-- operations on a @Builder@ are @singleton@, @fromText@, and
2116-- @fromLazyText@, which construct new builders, and 'mappend', which
@@ -35,7 +30,7 @@
3530--
3631-----------------------------------------------------------------------------
3732
38−module Data.Text.Internal.Builder
33+module Data.Text.Lazy.Builder.Internal
3934 ( -- * Public API
4035 -- ** The Builder type
4136 Builder
@@ -58,14 +53,13 @@ module Data.Text.Internal.Builder
5853 ) where
5954
6055import Control.Monad.ST (ST, runST)
56+import Data.Bits ((.&.))
6157import Data.Monoid (Monoid(..))
62−#if MIN_VERSION_base(4,9,0)
63−import Data.Semigroup (Semigroup(..))
64−#endif
6558import Data.Text.Internal (Text(..))
66−import Data.Text.Internal.Lazy (smallChunkSize)
59+import Data.Text.Lazy.Internal (smallChunkSize)
6760import Data.Text.Unsafe (inlineInterleaveST)
68−import Data.Text.Internal.Unsafe.Char (unsafeWrite)
61+import Data.Text.UnsafeChar (ord, unsafeWrite)
62+import Data.Text.UnsafeShift (shiftR)
6963import Prelude hiding (map, putChar)
7064
7165import qualified Data.String as String
@@ -92,22 +86,12 @@ newtype Builder = Builder {
9286 -> ST s [S.Text]
9387 }
9488
95−#if MIN_VERSION_base(4,9,0)
96−instance Semigroup Builder where
97− (<>) = append
98− {-# INLINE (<>) #-}
99−#endif
100−
10189instance Monoid Builder where
10290 mempty = empty
10391 {-# INLINE mempty #-}
104−#if MIN_VERSION_base(4,9,0)
105− mappend = (<>) -- future-proof definition
106−#else
10792 mappend = append
108−#endif
10993 {-# INLINE mappend #-}
110− mconcat = foldr mappend Data.Monoid.mempty
94+ mconcat = foldr mappend mempty
11195 {-# INLINE mconcat #-}
11296
11397instance String.IsString Builder where
@@ -138,7 +122,17 @@ empty = Builder (\ k buf -> k buf)
138122-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@
139123--
140124singleton :: Char -> Builder
141−singleton c = writeAtMost 2 $ \ marr o -> unsafeWrite marr o c
125+singleton c = writeAtMost 2 $ \ marr o ->
126+ if n < 0x10000
127+ then A.unsafeWrite marr o (fromIntegral n) >> return 1
128+ else do
129+ A.unsafeWrite marr o lo
130+ A.unsafeWrite marr (o+1) hi
131+ return 2
132+ where n = ord c
133+ m = n - 0x10000
134+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800
135+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
142136{-# INLINE singleton #-}
143137
144138------------------------------------------------------------------------
@@ -242,8 +236,6 @@ flush = Builder $ \ k buf@(Buffer p o u l) ->
242236 !t = Text arr o u
243237 ts <- inlineInterleaveST (k b)
244238 return $! t : ts
245−{-# INLINE [1] flush #-}
246−-- defer inlining so that flush/flush rule may fire.
247239
248240------------------------------------------------------------------------
249241
Data/Text/Lazy/Builder/RealFloat.hs+2−2
@@ -19,9 +19,9 @@ module Data.Text.Lazy.Builder.RealFloat
1919
2020import Data.Array.Base (unsafeAt)
2121import Data.Array.IArray
22−import Data.Text.Internal.Builder.Functions ((<>), i2d)
22+import Data.Text.Lazy.Builder.Functions ((<>), i2d)
2323import Data.Text.Lazy.Builder.Int (decimal)
24−import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)
24+import Data.Text.Lazy.Builder.RealFloat.Functions (roundTo)
2525import Data.Text.Lazy.Builder
2626import qualified Data.Text as T
2727
Data/Text/Lazy/Builder/RealFloat/Functions.hsnew file+25
@@ -0,0 +1,25 @@
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+11−35
@@ -7,7 +7,8 @@
77-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
88--
99-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
1112-- Stability : experimental
1213-- Portability : portable
1314--
@@ -45,28 +46,19 @@ module Data.Text.Lazy.Encoding
4546 , encodeUtf16BE
4647 , encodeUtf32LE
4748 , encodeUtf32BE
48−
49− -- * Encoding Text using ByteString Builders
50− , encodeUtf8Builder
51− , encodeUtf8BuilderEscaped
5249 ) where
5350
5451import Control.Exception (evaluate, try)
55−import Data.Monoid (Monoid(..))
5652import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
57−import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldrChunks)
58−import Data.Word (Word8)
53+import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldrChunks)
5954import 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
6355import qualified Data.ByteString.Lazy as B
6456import qualified Data.ByteString.Lazy.Internal as B
6557import qualified Data.ByteString.Unsafe as B
66−import qualified Data.Text as T
6758import qualified Data.Text.Encoding as TE
68−import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E
69−import qualified Data.Text.Internal.Lazy.Fusion as F
59+import qualified Data.Text.Lazy as L
60+import qualified Data.Text.Lazy.Encoding.Fusion as E
61+import qualified Data.Text.Lazy.Fusion as F
7062import Data.Text.Unsafe (unsafeDupablePerformIO)
7163
7264-- $strict
@@ -84,6 +76,8 @@ import Data.Text.Unsafe (unsafeDupablePerformIO)
8476
8577-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
8678-- encoded text.
79+--
80+-- This function is deprecated. Use 'decodeLatin1' instead.
8781decodeASCII :: B.ByteString -> Text
8882decodeASCII = decodeUtf8
8983{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
@@ -105,7 +99,7 @@ decodeUtf8With onErr (B.Chunk b0 bs0) =
10599 | S.null l = empty
106100 | otherwise = case onErr desc (Just (B.unsafeHead l)) of
107101 Nothing -> empty
108− Just c -> Chunk (T.singleton c) Empty
102+ Just c -> L.singleton c
109103 desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"
110104decodeUtf8With _ _ = empty
111105
@@ -142,26 +136,8 @@ decodeUtf8' bs = unsafeDupablePerformIO $ do
142136{-# INLINE decodeUtf8' #-}
143137
144138encodeUtf8 :: Text -> B.ByteString
145−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
139+encodeUtf8 (Chunk c cs) = B.Chunk (TE.encodeUtf8 c) (encodeUtf8 cs)
140+encodeUtf8 Empty = B.Empty
165141
166142-- | Decode text from little endian UTF-16 encoding.
167143decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text
Data/Text/Internal/Lazy/Encoding/Fusion.hs → Data/Text/Lazy/Encoding/Fusion.hsrenamed+12−15
@@ -5,18 +5,15 @@
55-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
66--
77-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
910-- Stability : experimental
1011-- Portability : portable
1112--
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−--
1613-- Fusible 'Stream'-oriented functions for converting between lazy
1714-- 'Text' and several common encodings.
1815
19−module Data.Text.Internal.Lazy.Encoding.Fusion
16+module Data.Text.Lazy.Encoding.Fusion
2017 (
2118 -- * Streaming
2219 -- streamASCII
@@ -29,22 +26,22 @@ module Data.Text.Internal.Lazy.Encoding.Fusion
2926 -- * Unstreaming
3027 , unstream
3128
32− , module Data.Text.Internal.Encoding.Fusion.Common
29+ , module Data.Text.Encoding.Fusion.Common
3330 ) where
3431
3532import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)
3633import qualified Data.ByteString as B
3734import qualified Data.ByteString.Unsafe as B
38−import Data.Text.Internal.Encoding.Fusion.Common
35+import Data.Text.Encoding.Fusion.Common
3936import Data.Text.Encoding.Error
40−import Data.Text.Internal.Fusion (Step(..), Stream(..))
41−import Data.Text.Internal.Fusion.Size
42−import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)
43−import Data.Text.Internal.Unsafe.Shift (shiftL)
37+import Data.Text.Fusion (Step(..), Stream(..))
38+import Data.Text.Fusion.Size
39+import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)
40+import Data.Text.UnsafeShift (shiftL)
4441import Data.Word (Word8, Word16, Word32)
45−import qualified Data.Text.Internal.Encoding.Utf8 as U8
46−import qualified Data.Text.Internal.Encoding.Utf16 as U16
47−import qualified Data.Text.Internal.Encoding.Utf32 as U32
42+import qualified Data.Text.Encoding.Utf8 as U8
43+import qualified Data.Text.Encoding.Utf16 as U16
44+import qualified Data.Text.Encoding.Utf32 as U32
4845import Data.Text.Unsafe (unsafeDupablePerformIO)
4946import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
5047import Foreign.Storable (pokeByteOff)
Data/Text/Internal/Lazy/Fusion.hs → Data/Text/Lazy/Fusion.hsrenamed+9−12
@@ -4,17 +4,14 @@
44-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
55--
66-- License : BSD-style
7−-- Maintainer : bos@serpentine.com
7+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
8+-- duncan@haskell.org
89-- Stability : experimental
910-- Portability : GHC
1011--
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−--
1512-- Core stream fusion functionality for text.
1613
17−module Data.Text.Internal.Lazy.Fusion
14+module Data.Text.Lazy.Fusion
1815 (
1916 stream
2017 , unstream
@@ -26,15 +23,15 @@ module Data.Text.Internal.Lazy.Fusion
2623 ) where
2724
2825import Prelude hiding (length)
29−import qualified Data.Text.Internal.Fusion.Common as S
26+import qualified Data.Text.Fusion.Common as S
3027import Control.Monad.ST (runST)
31−import Data.Text.Internal.Fusion.Types
32−import Data.Text.Internal.Fusion.Size (isEmpty, unknownSize)
33−import Data.Text.Internal.Lazy
28+import Data.Text.Fusion.Internal
29+import Data.Text.Fusion.Size (isEmpty, unknownSize)
30+import Data.Text.Lazy.Internal
3431import qualified Data.Text.Internal as I
3532import qualified Data.Text.Array as A
36−import Data.Text.Internal.Unsafe.Char (unsafeWrite)
37−import Data.Text.Internal.Unsafe.Shift (shiftL)
33+import Data.Text.UnsafeChar (unsafeWrite)
34+import Data.Text.UnsafeShift (shiftL)
3835import Data.Text.Unsafe (Iter(..), iter)
3936import Data.Int (Int64)
4037
Data/Text/Lazy/IO.hs+2−2
@@ -50,8 +50,8 @@ import qualified Data.Text.Lazy as L
5050import qualified Control.Exception as E
5151import Control.Monad (when)
5252import Data.IORef (readIORef)
53−import Data.Text.Internal.IO (hGetLineWith, readChunk)
54−import Data.Text.Internal.Lazy (chunk, empty)
53+import Data.Text.IO.Internal (hGetLineWith, readChunk)
54+import Data.Text.Lazy.Internal (chunk, empty)
5555import GHC.IO.Buffer (isEmptyBuffer)
5656import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException)
5757import GHC.IO.Handle.Internals (augmentIOError, hClose_help,
Data/Text/Lazy/Internal.hs+105−7
@@ -1,20 +1,118 @@
11{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
22-- |
33-- Module : Data.Text.Lazy.Internal
4−-- Copyright : (c) 2013 Bryan O'Sullivan
4+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
55--
66-- License : BSD-style
7−-- Maintainer : bos@serpentine.com
7+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
8+-- duncan@haskell.org
89-- Stability : experimental
910-- Portability : GHC
1011--
11−-- This module has been renamed to 'Data.Text.Internal.Lazy'. This
12−-- name for the module will be removed in the next major release.
12+-- A module containing private 'Text' internals. This exposes the
13+-- 'Text' representation and low level construction functions.
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!
1319
1420module Data.Text.Lazy.Internal
15− {-# DEPRECATED "Use Data.Text.Internal.Lazy instead" #-}
1621 (
17− module Data.Text.Internal.Lazy
22+ Text(..)
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
1838 ) where
1939
20−import Data.Text.Internal.Lazy
40+import Data.Text ()
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+33−8
@@ -1,7 +1,5 @@
11{-# LANGUAGE OverloadedStrings, CPP #-}
2−#if __GLASGOW_HASKELL__ >= 704
3−{-# LANGUAGE Safe #-}
4−#elif __GLASGOW_HASKELL__ >= 702
2+#if __GLASGOW_HASKELL__ >= 702
53{-# LANGUAGE Trustworthy #-}
64#endif
75
@@ -26,17 +24,15 @@ module Data.Text.Lazy.Read
2624 ) where
2725
2826import Control.Monad (liftM)
29−import Data.Char (isDigit, isHexDigit)
27+import Data.Char (isDigit, isHexDigit, ord)
3028import Data.Int (Int8, Int16, Int32, Int64)
3129import Data.Ratio ((%))
32−import Data.Text.Internal.Read
3330import Data.Text.Lazy as T
3431import Data.Word (Word, Word8, Word16, Word32, Word64)
3532
3633-- | Read some text. If the read succeeds, return its value and the
3734-- remaining text, otherwise an error message.
38−type Reader a = IReader Text a
39−type Parser = IParser Text
35+type Reader a = Text -> Either String (a,Text)
4036
4137-- | Read a decimal integer. The input must begin with at least one
4238-- decimal digit, and is consumed until a non-digit or end of string
@@ -56,7 +52,7 @@ decimal :: Integral a => Reader a
5652{-# SPECIALIZE decimal :: Reader Int32 #-}
5753{-# SPECIALIZE decimal :: Reader Int64 #-}
5854{-# SPECIALIZE decimal :: Reader Integer #-}
59−{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}
55+{-# SPECIALIZE decimal :: Reader Word #-}
6056{-# SPECIALIZE decimal :: Reader Word8 #-}
6157{-# SPECIALIZE decimal :: Reader Word16 #-}
6258{-# SPECIALIZE decimal :: Reader Word32 #-}
@@ -105,6 +101,15 @@ hex txt
105101 where (h,t) = T.span isHexDigit txt
106102 go n d = (n * 16 + fromIntegral (hexDigitToInt d))
107103
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+
108113-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and
109114-- apply it to the result of applying the given reader.
110115signed :: Num a => Reader a -> Reader a
@@ -164,11 +169,31 @@ signa p = do
164169 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
165170 if sign == '+' then p else negate `liftM` p
166171
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+
167190char :: (Char -> Bool) -> Parser Char
168191char p = P $ \t -> case T.uncons t of
169192 Just (c,t') | p c -> Right (c,t')
170193 _ -> Left "character does not match"
171194
195+data T = T !Integer !Int
196+
172197floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a
173198{-# INLINE floaty #-}
174199floaty f = runP $ do
Data/Text/Internal/Lazy/Search.hs → Data/Text/Lazy/Search.hsrenamed+6−9
@@ -5,19 +5,16 @@
55-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
66--
77-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
910-- Stability : experimental
1011-- Portability : GHC
1112--
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−--
1613-- Fast substring search for lazy 'Text', based on work by Boyer,
1714-- Moore, Horspool, Sunday, and Lundh. Adapted from the strict
1815-- implementation.
1916
20−module Data.Text.Internal.Lazy.Search
17+module Data.Text.Lazy.Search
2118 (
2219 indices
2320 ) where
@@ -26,10 +23,10 @@ import qualified Data.Text.Array as A
2623import Data.Int (Int64)
2724import Data.Word (Word16, Word64)
2825import qualified Data.Text.Internal as T
29−import Data.Text.Internal.Fusion.Types (PairS(..))
30−import Data.Text.Internal.Lazy (Text(..), foldlChunks)
26+import Data.Text.Fusion.Internal (PairS(..))
27+import Data.Text.Lazy.Internal (Text(..), foldlChunks)
3128import Data.Bits ((.|.), (.&.))
32−import Data.Text.Internal.Unsafe.Shift (shiftL)
29+import Data.Text.UnsafeShift (shiftL)
3330
3431-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
3532-- @needle@ within @haystack@.
Data/Text/Internal/Private.hs → Data/Text/Private.hsrenamed+6−6
@@ -1,7 +1,7 @@
11{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples #-}
22
33-- |
4−-- Module : Data.Text.Internal.Private
4+-- Module : Data.Text.Private
55-- Copyright : (c) 2011 Bryan O'Sullivan
66--
77-- License : BSD-style
@@ -9,21 +9,21 @@
99-- Stability : experimental
1010-- Portability : GHC
1111
12−module Data.Text.Internal.Private
12+module Data.Text.Private
1313 (
1414 runText
1515 , span_
1616 ) where
1717
1818import Control.Monad.ST (ST, runST)
19−import Data.Text.Internal (Text(..), text)
19+import Data.Text.Internal (Text(..), textP)
2020import Data.Text.Unsafe (Iter(..), iter)
2121import qualified Data.Text.Array as A
2222
2323span_ :: (Char -> Bool) -> Text -> (# Text, Text #)
2424span_ p t@(Text arr off len) = (# hd,tl #)
25− where hd = text arr off k
26− tl = text arr (off+k) (len-k)
25+ where hd = textP arr off k
26+ tl = textP arr (off+k) (len-k)
2727 !k = loop 0
2828 loop !i | i < len && p c = loop (i+d)
2929 | otherwise = i
@@ -33,5 +33,5 @@ span_ p t@(Text arr off len) = (# hd,tl #)
3333runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text
3434runText act = runST (act $ \ !marr !len -> do
3535 arr <- A.unsafeFreeze marr
36− return $! text arr 0 len)
36+ return $! textP arr 0 len)
3737{-# INLINE runText #-}
Data/Text/Read.hs+33−6
@@ -24,18 +24,16 @@ module Data.Text.Read
2424 ) where
2525
2626import Control.Monad (liftM)
27−import Data.Char (isDigit, isHexDigit)
27+import Data.Char (isDigit, isHexDigit, ord)
2828import Data.Int (Int8, Int16, Int32, Int64)
2929import Data.Ratio ((%))
3030import Data.Text as T
31−import Data.Text.Internal.Private (span_)
32−import Data.Text.Internal.Read
31+import Data.Text.Private (span_)
3332import Data.Word (Word, Word8, Word16, Word32, Word64)
3433
3534-- | Read some text. If the read succeeds, return its value and the
3635-- remaining text, otherwise an error message.
37−type Reader a = IReader Text a
38−type Parser a = IParser Text a
36+type Reader a = Text -> Either String (a,Text)
3937
4038-- | Read a decimal integer. The input must begin with at least one
4139-- decimal digit, and is consumed until a non-digit or end of string
@@ -55,7 +53,7 @@ decimal :: Integral a => Reader a
5553{-# SPECIALIZE decimal :: Reader Int32 #-}
5654{-# SPECIALIZE decimal :: Reader Int64 #-}
5755{-# SPECIALIZE decimal :: Reader Integer #-}
58−{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}
56+{-# SPECIALIZE decimal :: Reader Word #-}
5957{-# SPECIALIZE decimal :: Reader Word8 #-}
6058{-# SPECIALIZE decimal :: Reader Word16 #-}
6159{-# SPECIALIZE decimal :: Reader Word32 #-}
@@ -113,6 +111,15 @@ hex txt
113111 where (# h,t #) = span_ isHexDigit txt
114112 go n d = (n * 16 + fromIntegral (hexDigitToInt d))
115113
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+
116123-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and
117124-- apply it to the result of applying the given reader.
118125signed :: Num a => Reader a -> Reader a
@@ -172,11 +179,31 @@ signa p = do
172179 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
173180 if sign == '+' then p else negate `liftM` p
174181
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+
175200char :: (Char -> Bool) -> Parser Char
176201char p = P $ \t -> case T.uncons t of
177202 Just (c,t') | p c -> Right (c,t')
178203 _ -> Left "character does not match"
179204
205+data T = T !Integer !Int
206+
180207floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a
181208{-# INLINE floaty #-}
182209floaty f = runP $ do
Data/Text/Internal/Search.hs → Data/Text/Search.hsrenamed+5−4
@@ -1,11 +1,12 @@
11{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
22
33-- |
4−-- Module : Data.Text.Internal.Search
4+-- Module : Data.Text.Search
55-- Copyright : (c) Bryan O'Sullivan 2009
66--
77-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
910-- Stability : experimental
1011-- Portability : GHC
1112--
@@ -26,7 +27,7 @@
2627-- * F. Lundh: The Fast Search Algorithm.
2728-- <http://effbot.org/zone/stringlib.htm> (2006)
2829
29−module Data.Text.Internal.Search
30+module Data.Text.Search
3031 (
3132 indices
3233 ) where
@@ -35,7 +36,7 @@ import qualified Data.Text.Array as A
3536import Data.Word (Word64)
3637import Data.Text.Internal (Text(..))
3738import Data.Bits ((.|.), (.&.))
38−import Data.Text.Internal.Unsafe.Shift (shiftL)
39+import Data.Text.UnsafeShift (shiftL)
3940
4041data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
4142
Data/Text/Show.hsdeleted−89
@@ -1,89 +0,0 @@
1−{-# LANGUAGE CPP, MagicHash #-}
2−{-# OPTIONS_GHC -fno-warn-orphans #-}
3−#if __GLASGOW_HASKELL__ >= 702
4−{-# LANGUAGE Trustworthy #-}
5−#endif
6−
7−-- |
8−-- Module : Data.Text.Show
9−-- Copyright : (c) 2009-2015 Bryan O'Sullivan
10−--
11−-- License : BSD-style
12−-- Maintainer : bos@serpentine.com
13−-- Stability : experimental
14−-- Portability : GHC
15−
16−module Data.Text.Show
17− (
18− singleton
19− , unpack
20− , unpackCString#
21− ) where
22−
23−import Control.Monad.ST (ST)
24−import Data.Text.Internal (Text(..), empty_, safe)
25−import Data.Text.Internal.Fusion (stream, unstream)
26−import Data.Text.Internal.Unsafe.Char (unsafeWrite)
27−import GHC.Prim (Addr#)
28−import qualified Data.Text.Array as A
29−import qualified Data.Text.Internal.Fusion.Common as S
30−
31−#if __GLASGOW_HASKELL__ >= 702
32−import qualified GHC.CString as GHC
33−#else
34−import qualified GHC.Base as GHC
35−#endif
36−
37−instance Show Text where
38− showsPrec p ps r = showsPrec p (unpack ps) r
39−
40−-- | /O(n)/ Convert a 'Text' into a 'String'. Subject to fusion.
41−unpack :: Text -> String
42−unpack = S.unstreamList . stream
43−{-# INLINE [1] unpack #-}
44−
45−-- | /O(n)/ Convert a literal string into a 'Text'. Subject to
46−-- fusion.
47−--
48−-- This is exposed solely for people writing GHC rewrite rules.
49−unpackCString# :: Addr# -> Text
50−unpackCString# addr# = unstream (S.streamCString# addr#)
51−{-# NOINLINE unpackCString# #-}
52−
53−{-# RULES "TEXT literal" [1] forall a.
54− unstream (S.map safe (S.streamList (GHC.unpackCString# a)))
55− = unpackCString# a #-}
56−
57−{-# RULES "TEXT literal UTF8" [1] forall a.
58− unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))
59− = unpackCString# a #-}
60−
61−{-# RULES "TEXT empty literal" [1]
62− unstream (S.map safe (S.streamList []))
63− = empty_ #-}
64−
65−{-# RULES "TEXT singleton literal" [1] forall a.
66− unstream (S.map safe (S.streamList [a]))
67− = singleton_ a #-}
68−
69−-- | /O(1)/ Convert a character into a Text. Subject to fusion.
70−-- Performs replacement on invalid scalar values.
71−singleton :: Char -> Text
72−singleton = unstream . S.singleton . safe
73−{-# INLINE [1] singleton #-}
74−
75−{-# RULES "TEXT singleton" forall a.
76− unstream (S.singleton (safe a))
77− = singleton_ a #-}
78−
79−-- This is intended to reduce inlining bloat.
80−singleton_ :: Char -> Text
81−singleton_ c = Text (A.run x) 0 len
82− where x :: ST s (A.MArray s)
83− x = do arr <- A.new len
84− _ <- unsafeWrite arr 0 d
85− return arr
86− len | d < '\x10000' = 1
87− | otherwise = 2
88− d = safe c
89−{-# NOINLINE singleton_ #-}
Data/Text/Unsafe.hs+5−15
@@ -3,7 +3,8 @@
33-- Module : Data.Text.Unsafe
44-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
55-- License : BSD-style
6−-- Maintainer : bos@serpentine.com
6+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
7+-- duncan@haskell.org
78-- Stability : experimental
89-- Portability : portable
910--
@@ -18,7 +19,6 @@ module Data.Text.Unsafe
1819 , iter
1920 , iter_
2021 , reverseIter
21− , reverseIter_
2222 , unsafeHead
2323 , unsafeTail
2424 , lengthWord16
@@ -29,10 +29,10 @@ module Data.Text.Unsafe
2929#if defined(ASSERTS)
3030import Control.Exception (assert)
3131#endif
32−import Data.Text.Internal.Encoding.Utf16 (chr2)
32+import Data.Text.Encoding.Utf16 (chr2)
3333import Data.Text.Internal (Text(..))
34−import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)
35−import Data.Text.Internal.Unsafe.Char (unsafeChr)
34+import Data.Text.Unsafe.Base (inlineInterleaveST, inlinePerformIO)
35+import Data.Text.UnsafeChar (unsafeChr)
3636import qualified Data.Text.Array as A
3737import GHC.IO (unsafeDupablePerformIO)
3838
@@ -95,16 +95,6 @@ reverseIter (Text arr off _len) i
9595 k = j - 1
9696{-# INLINE reverseIter #-}
9797
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−
10898-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
10999-- is useful for sizing a target array appropriately before using
110100-- 'unsafeCopyToPtr'.
Data/Text/Internal/Unsafe.hs → Data/Text/Unsafe/Base.hsrenamed+6−11
@@ -1,21 +1,16 @@
11{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
2−{-# OPTIONS_HADDOCK not-home #-}
3−
42-- |
5−-- Module : Data.Text.Internal.Unsafe
3+-- Module : Data.Text.Unsafe.Base
64-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
75-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
6+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
7+-- duncan@haskell.org
98-- Stability : experimental
109-- Portability : portable
1110--
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−--
16−-- A module containing /unsafe/ operations, for /very very careful/ use
17−-- in /heavily tested/ code.
18−module Data.Text.Internal.Unsafe
11+-- A module containing unsafe operations, for very very careful use in
12+-- heavily tested code.
13+module Data.Text.Unsafe.Base
1914 (
2015 inlineInterleaveST
2116 , inlinePerformIO
Data/Text/Internal/Unsafe/Char.hs → Data/Text/UnsafeChar.hsrenamed+5−8
@@ -1,22 +1,19 @@
11{-# LANGUAGE CPP, MagicHash #-}
22
33-- |
4−-- Module : Data.Text.Internal.Unsafe.Char
4+-- Module : Data.Text.UnsafeChar
55-- Copyright : (c) 2008, 2009 Tom Harper,
66-- (c) 2009, 2010 Bryan O'Sullivan,
77-- (c) 2009 Duncan Coutts
88--
99-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
1112-- Stability : experimental
1213-- Portability : GHC
1314--
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−--
1815-- Fast character manipulation functions.
19−module Data.Text.Internal.Unsafe.Char
16+module Data.Text.UnsafeChar
2017 (
2118 ord
2219 , unsafeChr
@@ -31,7 +28,7 @@ import Control.Exception (assert)
3128#endif
3229import Control.Monad.ST (ST)
3330import Data.Bits ((.&.))
34−import Data.Text.Internal.Unsafe.Shift (shiftR)
31+import Data.Text.UnsafeShift (shiftR)
3532import GHC.Exts (Char(..), Int(..), chr#, ord#, word2Int#)
3633import GHC.Word (Word8(..), Word16(..), Word32(..))
3734import qualified Data.Text.Array as A
Data/Text/Internal/Unsafe/Shift.hs → Data/Text/UnsafeShift.hsrenamed+4−7
@@ -1,21 +1,18 @@
11{-# LANGUAGE MagicHash #-}
22
33-- |
4−-- Module : Data.Text.Internal.Unsafe.Shift
4+-- Module : Data.Text.UnsafeShift
55-- Copyright : (c) Bryan O'Sullivan 2009
66--
77-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
910-- Stability : experimental
1011-- Portability : GHC
1112--
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−--
1613-- Fast, unchecked bit shifting functions.
1714
18−module Data.Text.Internal.Unsafe.Shift
15+module Data.Text.UnsafeShift
1916 (
2017 UnsafeShift(..)
2118 ) where
Data/Text/Internal/Functions.hs → Data/Text/Util.hsrenamed+2−6
@@ -1,7 +1,7 @@
11{-# LANGUAGE CPP, DeriveDataTypeable #-}
22
33-- |
4−-- Module : Data.Text.Internal.Functions
4+-- Module : Data.Text.Util
55-- Copyright : 2010 Bryan O'Sullivan
66--
77-- License : BSD-style
@@ -9,13 +9,9 @@
99-- Stability : experimental
1010-- Portability : GHC
1111--
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−--
1612-- Useful functions.
1713
18−module Data.Text.Internal.Functions
14+module Data.Text.Util
1915 (
2016 intersperse
2117 ) where
benchmarks/haskell/Benchmarks.hs+1−6
@@ -15,7 +15,6 @@ import qualified Benchmarks.EncodeUtf8 as EncodeUtf8
1515import qualified Benchmarks.Equality as Equality
1616import qualified Benchmarks.FileRead as FileRead
1717import qualified Benchmarks.FoldLines as FoldLines
18−import qualified Benchmarks.Mul as Mul
1918import qualified Benchmarks.Pure as Pure
2019import qualified Benchmarks.ReadNumbers as ReadNumbers
2120import qualified Benchmarks.Replace as Replace
@@ -50,11 +49,7 @@ benchmarks = do
5049 , Equality.benchmark (tf "japanese.txt")
5150 , FileRead.benchmark (tf "russian.txt")
5251 , FoldLines.benchmark (tf "russian.txt")
53− , Mul.benchmark
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")
52+ , Pure.benchmark "tiny "(tf "tiny.txt")
5853 , Pure.benchmark "japanese" (tf "japanese.txt")
5954 , ReadNumbers.benchmark (tf "numbers.txt")
6055 , Replace.benchmark (tf "russian.txt") "принимая" "своем"
benchmarks/haskell/Benchmarks/DecodeUtf8.hs+2−2
@@ -25,7 +25,7 @@ import Foreign.Ptr (Ptr, plusPtr)
2525import Foreign.ForeignPtr (withForeignPtr)
2626import Data.Word (Word8)
2727import qualified Criterion as C
28−import Criterion (Benchmark, bgroup, nf, whnfIO)
28+import Criterion (Benchmark, bgroup, nf)
2929import qualified Codec.Binary.UTF8.Generic as U8
3030import qualified Data.ByteString as B
3131import qualified Data.ByteString.Lazy as BL
@@ -48,7 +48,7 @@ benchmark kind fp = do
4848 return $ bgroup "DecodeUtf8"
4949 [ bench "Strict" $ nf T.decodeUtf8 bs
5050 , bench "Stream" $ nf decodeStream lbs
51− , bench "IConv" $ whnfIO $ iconv bs
51+ , bench "IConv" $ iconv bs
5252 , bench "StrictLength" $ nf (T.length . T.decodeUtf8) bs
5353 , bench "StrictInitLength" $ nf (T.length . T.init . T.decodeUtf8) bs
5454 , bench "Lazy" $ nf TL.decodeUtf8 lbs
benchmarks/haskell/Benchmarks/FileRead.hs+11−11
@@ -8,8 +8,8 @@ module Benchmarks.FileRead
88 ( benchmark
99 ) where
1010
11−import Control.Applicative ((<$>))
12−import Criterion (Benchmark, bgroup, bench, whnfIO)
11+import Control.Exception (evaluate)
12+import Criterion (Benchmark, bgroup, bench)
1313import qualified Data.ByteString as SB
1414import qualified Data.ByteString.Lazy as LB
1515import qualified Data.Text as T
@@ -21,13 +21,13 @@ import qualified Data.Text.Lazy.IO as LT
2121
2222benchmark :: FilePath -> IO Benchmark
2323benchmark p = return $ bgroup "FileRead"
24− [ bench "String" $ whnfIO $ length <$> readFile p
25− , bench "ByteString" $ whnfIO $ SB.length <$> SB.readFile p
26− , bench "LazyByteString" $ whnfIO $ LB.length <$> LB.readFile p
27− , bench "Text" $ whnfIO $ T.length <$> T.readFile p
28− , bench "LazyText" $ whnfIO $ LT.length <$> LT.readFile p
29− , bench "TextByteString" $ whnfIO $
30− (T.length . T.decodeUtf8) <$> SB.readFile p
31− , bench "LazyTextByteString" $ whnfIO $
32− (LT.length . LT.decodeUtf8) <$> LB.readFile p
24+ [ bench "String" $ readFile p >>= evaluate . length
25+ , bench "ByteString" $ SB.readFile p >>= evaluate . SB.length
26+ , bench "LazyByteString" $ LB.readFile p >>= evaluate . LB.length
27+ , bench "Text" $ T.readFile p >>= evaluate . T.length
28+ , bench "LazyText" $ LT.readFile p >>= evaluate . LT.length
29+ , bench "TextByteString" $
30+ SB.readFile p >>= evaluate . T.length . T.decodeUtf8
31+ , bench "LazyTextByteString" $
32+ LB.readFile p >>= evaluate . LT.length . LT.decodeUtf8
3333 ]
benchmarks/haskell/Benchmarks/FoldLines.hs+2−2
@@ -10,7 +10,7 @@ module Benchmarks.FoldLines
1010 ( benchmark
1111 ) where
1212
13−import Criterion (Benchmark, bgroup, bench, whnfIO)
13+import Criterion (Benchmark, bgroup, bench)
1414import System.IO
1515import qualified Data.ByteString as B
1616import qualified Data.Text as T
@@ -22,7 +22,7 @@ benchmark fp = return $ bgroup "ReadLines"
2222 , bench "ByteString" $ withHandle $ foldLinesB (\n _ -> n + 1) (0 :: Int)
2323 ]
2424 where
25− withHandle f = whnfIO $ do
25+ withHandle f = do
2626 h <- openFile fp ReadMode
2727 hSetBuffering h (BlockBuffering (Just 16384))
2828 x <- f h
benchmarks/haskell/Benchmarks/Mul.hsdeleted−138
@@ -1,138 +0,0 @@
1−module Benchmarks.Mul (benchmark) where
2−
3−import Control.Exception (evaluate)
4−import Criterion.Main
5−import Data.Int (Int32, Int64)
6−import Data.Text.Internal (mul32, mul64)
7−import qualified Data.Vector.Unboxed as U
8−
9−oldMul :: Int64 -> Int64 -> Int64
10−oldMul m n
11− | n == 0 = 0
12− | m <= maxBound `quot` n = m * n
13− | otherwise = error "overflow"
14−
15−benchmark :: IO Benchmark
16−benchmark = do
17− _ <- evaluate testVector32
18− _ <- evaluate testVector64
19− return $ bgroup "Mul" [
20− bench "oldMul" $ whnf (U.map (uncurry oldMul)) testVector64
21− , bench "mul64" $ whnf (U.map (uncurry mul64)) testVector64
22− , bench "*64" $ whnf (U.map (uncurry (*))) testVector64
23− , bench "mul32" $ whnf (U.map (uncurry mul32)) testVector32
24− , bench "*32" $ whnf (U.map (uncurry (*))) testVector32
25− ]
26−
27−testVector64 :: U.Vector (Int64,Int64)
28−testVector64 = U.fromList [
29− (0,1248868987182846646),(169004623633872,24458),(482549039517835,7614),
30− (372,8157063115504364),(27,107095594861148252),(3,63249878517962420),
31− (4363,255694473572912),(86678474,1732634806),(1572453024,1800489338),
32− (9384523143,77053781),(49024709555,75095046),(7,43457620410239131),
33− (8,8201563008844571),(387719037,1520696708),(189869238220197,1423),
34− (46788016849611,23063),(503077742109974359,0),(104,1502010908706487),
35− (30478140346,207525518),(80961140129236192,14),(4283,368012829143675),
36− (1028719181728108146,6),(318904,5874863049591),(56724427166898,110794),
37− (234539368,31369110449),(2,251729663598178612),(103291548194451219,5),
38− (76013,5345328755566),(1769631,2980846129318),(40898,60598477385754),
39− (0,98931348893227155),(573555872156917492,3),(318821187115,4476566),
40− (11152874213584,243582),(40274276,16636653248),(127,4249988676030597),
41− (103543712111871836,5),(71,16954462148248238),(3963027173504,216570),
42− (13000,503523808916753),(17038308,20018685905),(0,510350226577891549),
43− (175898,3875698895405),(425299191292676,5651),(17223451323664536,50),
44− (61755131,14247665326),(0,1018195131697569303),(36433751497238985,20),
45− (3473607861601050,1837),(1392342328,1733971838),(225770297367,3249655),
46− (14,127545244155254102),(1751488975299136,2634),(3949208,504190668767),
47− (153329,831454434345),(1066212122928663658,2),(351224,2663633539556),
48− (344565,53388869217),(35825609350446863,54),(276011553660081475,10),
49− (1969754174790470349,3),(35,68088438338633),(506710,3247689556438),
50− (11099382291,327739909),(105787303549,32824363),(210366111,14759049409),
51− (688893241579,3102676),(8490,70047474429581),(152085,29923000251880),
52− (5046974599257095,400),(4183167795,263434071),(10089728,502781960687),
53− (44831977765,4725378),(91,8978094664238578),(30990165721,44053350),
54− (1772377,149651820860),(243420621763408572,4),(32,5790357453815138),
55− (27980806337993771,5),(47696295759774,20848),(1745874142313778,1098),
56− (46869334770121,1203),(886995283,1564424789),(40679396544,76002479),
57− (1,672849481568486995),(337656187205,3157069),(816980552858963,6003),
58− (2271434085804831543,1),(0,1934521023868747186),(6266220038281,15825),
59− (4160,107115946987394),(524,246808621791561),(0,1952519482439636339),
60− (128,2865935904539691),(1044,3211982069426297),(16000511542473,88922),
61− (1253596745404082,2226),(27041,56836278958002),(23201,49247489754471),
62− (175906590497,21252392),(185163584757182295,24),(34742225226802197,150),
63− (2363228,250824838408),(216327527109550,45),(24,81574076994520675),
64− (28559899906542,15356),(10890139774837133,511),(2293,707179303654492),
65− (2749366833,40703233),(0,4498229704622845986),(439,4962056468281937),
66− (662,1453820621089921),(16336770612459631,220),(24282989393,74239137),
67− (2724564648490195,3),(743672760,124992589),(4528103,704330948891),
68− (6050483122491561,250),(13322953,13594265152),(181794,22268101450214),
69− (25957941712,75384092),(43352,7322262295009),(32838,52609059549923),
70− (33003585202001564,2),(103019,68430142267402),(129918230800,8742978),
71− (0,2114347379589080688),(2548,905723041545274),(222745067962838382,0),
72− (1671683850790425181,1),(455,4836932776795684),(794227702827214,6620),
73− (212534135175874,1365),(96432431858,29784975),(466626763743380,3484),
74− (29793949,53041519613),(8359,309952753409844),(3908960585331901,26),
75− (45185288970365760,114),(10131829775,68110174),(58039242399640479,83),
76− (628092278238719399,6),(1,196469106875361889),(302336625,16347502444),
77− (148,3748088684181047),(1,1649096568849015456),(1019866864,2349753026),
78− (8211344830,569363306),(65647579546873,34753),(2340190,1692053129069),
79− (64263301,30758930355),(48681618072372209,110),(7074794736,47640197),
80− (249634721521,7991792),(1162917363807215,232),(7446433349,420634045),
81− (63398619383,60709817),(51359004508011,14200),(131788797028647,7072),
82− (52079887791430043,7),(7,136277667582599838),(28582879735696,50327),
83− (1404582800566278,833),(469164435,15017166943),(99567079957578263,49),
84− (1015285971,3625801566),(321504843,4104079293),(5196954,464515406632),
85− (114246832260876,7468),(8149664437,487119673),(12265299,378168974869),
86− (37711995764,30766513),(3971137243,710996152),(483120070302,603162),
87− (103009942,61645547145),(8476344625340,6987),(547948761229739,1446),
88− (42234,18624767306301),(13486714173011,58948),(4,198309153268019840),
89− (9913176974,325539248),(28246225540203,116822),(2882463945582154,18),
90− (959,25504987505398),(3,1504372236378217710),(13505229956793,374987),
91− (751661959,457611342),(27375926,36219151769),(482168869,5301952074),
92− (1,1577425863241520640),(714116235611821,1164),(904492524250310488,0),
93− (5983514941763398,68),(10759472423,23540686),(72539568471529,34919),
94− (4,176090672310337473),(938702842110356453,1),(673652445,3335287382),
95− (3111998893666122,917),(1568013,3168419765469)]
96−
97−testVector32 :: U.Vector (Int32,Int32)
98−testVector32 = U.fromList [
99− (39242,410),(0,100077553),(2206,9538),(509400240,1),(38048,6368),
100− (1789,651480),(2399,157032),(701,170017),(5241456,14),(11212,70449),
101− (1,227804876),(749687254,1),(74559,2954),(1158,147957),(410604456,1),
102− (170851,1561),(92643422,1),(6192,180509),(7,24202210),(3440,241481),
103− (5753677,5),(294327,1622),(252,4454673),(127684121,11),(28315800,30),
104− (340370905,0),(1,667887987),(592782090,1),(49023,27641),(750,290387),
105− (72886,3847),(0,301047933),(3050276,473),(1,788366142),(59457,15813),
106− (637726933,1),(1135,344317),(853616,264),(696816,493),(7038,12046),
107− (125219574,4),(803694088,1),(107081726,1),(39294,21699),(16361,38191),
108− (132561123,12),(1760,23499),(847543,484),(175687349,1),(2963,252678),
109− (6248,224553),(27596,4606),(5422922,121),(1542,485890),(131,583035),
110− (59096,4925),(3637115,132),(0,947225435),(86854,6794),(2984745,339),
111− (760129569,1),(1,68260595),(380835652,2),(430575,2579),(54514,7211),
112− (15550606,3),(9,27367402),(3007053,207),(7060988,60),(28560,27130),
113− (1355,21087),(10880,53059),(14563646,4),(461886361,1),(2,169260724),
114− (241454126,2),(406797,1),(61631630,16),(44473,5943),(63869104,12),
115− (950300,1528),(2113,62333),(120817,9358),(100261456,1),(426764723,1),
116− (119,12723684),(3,53358711),(4448071,18),(1,230278091),(238,232102),
117− (8,57316440),(42437979,10),(6769,19555),(48590,22006),(11500585,79),
118− (2808,97638),(42,26952545),(11,32104194),(23954638,1),(785427272,0),
119− (513,81379),(31333960,37),(897772,1009),(4,25679692),(103027993,12),
120− (104972702,11),(546,443401),(7,65137092),(88574269,3),(872139069,0),
121− (2,97417121),(378802603,0),(141071401,4),(22613,10575),(2191743,118),
122− (470,116119),(7062,38166),(231056,1847),(43901963,9),(2400,70640),
123− (63553,1555),(34,11249573),(815174,1820),(997894011,0),(98881794,2),
124− (5448,43132),(27956,9),(904926,1357),(112608626,3),(124,613021),
125− (282086,1966),(99,10656881),(113799,1501),(433318,2085),(442,948171),
126− (165380,1043),(28,14372905),(14880,50462),(2386,219918),(229,1797565),
127− (1174961,298),(3925,41833),(3903515,299),(15690452,111),(360860521,3),
128− (7440846,81),(2541026,507),(0,492448477),(6869,82469),(245,8322939),
129− (3503496,253),(123495298,0),(150963,2299),(33,4408482),(1,200911107),
130− (305,252121),(13,123369189),(215846,8181),(2440,65387),(776764401,1),
131− (1241172,434),(8,15493155),(81953961,6),(17884993,5),(26,6893822),
132− (0,502035190),(1,582451018),(2,514870139),(227,3625619),(49,12720258),
133− (1456769,207),(94797661,10),(234407,893),(26843,5783),(15688,24547),
134− (4091,86268),(4339448,151),(21360,6294),(397046497,2),(1227,205936),
135− (9966,21959),(160046791,1),(0,159992224),(27,24974797),(19177,29334),
136− (4136148,42),(21179785,53),(61256583,31),(385,344176),(7,11934915),
137− (1,18992566),(3488065,5),(768021,224),(36288474,7),(8624,117561),
138− (8,20341439),(5903,261475),(561,1007618),(1738,392327),(633049,1708)]
benchmarks/haskell/Benchmarks/Programs/BigTable.hs+2−2
@@ -11,7 +11,7 @@ module Benchmarks.Programs.BigTable
1111 ( benchmark
1212 ) where
1313
14−import Criterion (Benchmark, bench, whnfIO)
14+import Criterion (Benchmark, bench)
1515import Data.Monoid (mappend, mconcat)
1616import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)
1717import Data.Text.Lazy.IO (hPutStr)
@@ -19,7 +19,7 @@ import System.IO (Handle)
1919import qualified Data.Text as T
2020
2121benchmark :: Handle -> IO Benchmark
22−benchmark sink = return $ bench "BigTable" $ whnfIO $ do
22+benchmark sink = return $ bench "BigTable" $ do
2323 hPutStr sink "Content-Type: text/html\n\n<table>"
2424 hPutStr sink . toLazyText . makeTable =<< rows
2525 hPutStr sink "</table>"
benchmarks/haskell/Benchmarks/Programs/Cut.hs+2−2
@@ -16,7 +16,7 @@ module Benchmarks.Programs.Cut
1616 ( benchmark
1717 ) where
1818
19−import Criterion (Benchmark, bgroup, bench, whnfIO)
19+import Criterion (Benchmark, bgroup, bench)
2020import System.IO (Handle, hPutStr)
2121import qualified Data.ByteString as B
2222import qualified Data.ByteString.Char8 as BC
@@ -40,7 +40,7 @@ benchmark p sink from to = return $ bgroup "Cut"
4040 , bench' "LazyTextByteString" lazyTextByteString
4141 ]
4242 where
43− bench' n s = bench n $ whnfIO (s p sink from to)
43+ bench' n s = bench n (s p sink from to)
4444
4545string :: FilePath -> Handle -> Int -> Int -> IO ()
4646string fp sink from to = do
benchmarks/haskell/Benchmarks/Programs/Fold.hs+2−2
@@ -21,7 +21,7 @@ import Data.List (foldl')
2121import Data.List (intersperse)
2222import Data.Monoid (mempty, mappend, mconcat)
2323import System.IO (Handle)
24−import Criterion (Benchmark, bench, whnfIO)
24+import Criterion (Benchmark, bench)
2525import qualified Data.Text as T
2626import qualified Data.Text.IO as T
2727import qualified Data.Text.Lazy.Builder as TLB
@@ -30,7 +30,7 @@ import qualified Data.Text.Lazy.IO as TL
3030
3131benchmark :: FilePath -> Handle -> IO Benchmark
3232benchmark i o = return $
33− bench "Fold" $ whnfIO $ T.readFile i >>= TL.hPutStr o . fold 80
33+ bench "Fold" $ T.readFile i >>= TL.hPutStr o . fold 80
3434
3535-- | We represent a paragraph by a word list
3636--
benchmarks/haskell/Benchmarks/Programs/Sort.hs+9−10
@@ -17,7 +17,7 @@ module Benchmarks.Programs.Sort
1717 ( benchmark
1818 ) where
1919
20−import Criterion (Benchmark, bgroup, bench, whnfIO)
20+import Criterion (Benchmark, bgroup, bench)
2121import Data.Monoid (mconcat)
2222import System.IO (Handle, hPutStr)
2323import qualified Data.ByteString as B
@@ -35,17 +35,16 @@ import qualified Data.Text.Lazy.IO as TL
3535
3636benchmark :: FilePath -> Handle -> IO Benchmark
3737benchmark i o = return $ bgroup "Sort"
38− [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string
39− , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString
40− , bench "LazyByteString" $ whnfIO $
41− BL.readFile i >>= BL.hPutStr o . lazyByteString
42− , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text
43− , bench "LazyText" $ whnfIO $ TL.readFile i >>= TL.hPutStr o . lazyText
44− , bench "TextByteString" $ whnfIO $ B.readFile i >>=
38+ [ bench "String" $ readFile i >>= hPutStr o . string
39+ , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString
40+ , bench "LazyByteString" $ BL.readFile i >>= BL.hPutStr o . lazyByteString
41+ , bench "Text" $ T.readFile i >>= T.hPutStr o . text
42+ , bench "LazyText" $ TL.readFile i >>= TL.hPutStr o . lazyText
43+ , bench "TextByteString" $ B.readFile i >>=
4544 B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8
46− , bench "LazyTextByteString" $ whnfIO $ BL.readFile i >>=
45+ , bench "LazyTextByteString" $ BL.readFile i >>=
4746 BL.hPutStr o . TL.encodeUtf8 . lazyText . TL.decodeUtf8
48− , bench "TextBuilder" $ whnfIO $ B.readFile i >>=
47+ , bench "TextBuilder" $ B.readFile i >>=
4948 BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8
5049 ]
5150
benchmarks/haskell/Benchmarks/Programs/StripTags.hs+5−5
@@ -15,7 +15,7 @@ module Benchmarks.Programs.StripTags
1515 ( benchmark
1616 ) where
1717
18−import Criterion (Benchmark, bgroup, bench, whnfIO)
18+import Criterion (Benchmark, bgroup, bench)
1919import Data.List (mapAccumL)
2020import System.IO (Handle, hPutStr)
2121import qualified Data.ByteString as B
@@ -26,10 +26,10 @@ import qualified Data.Text.IO as T
2626
2727benchmark :: FilePath -> Handle -> IO Benchmark
2828benchmark i o = return $ bgroup "StripTags"
29− [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string
30− , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString
31− , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text
32− , bench "TextByteString" $ whnfIO $
29+ [ bench "String" $ readFile i >>= hPutStr o . string
30+ , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString
31+ , bench "Text" $ T.readFile i >>= T.hPutStr o . text
32+ , bench "TextByteString" $
3333 B.readFile i >>= B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8
3434 ]
3535
benchmarks/haskell/Benchmarks/Programs/Throughput.hs+8−8
@@ -18,7 +18,7 @@ module Benchmarks.Programs.Throughput
1818 ( benchmark
1919 ) where
2020
21−import Criterion (Benchmark, bgroup, bench, whnfIO)
21+import Criterion (Benchmark, bgroup, bench)
2222import System.IO (Handle, hPutStr)
2323import qualified Data.ByteString as B
2424import qualified Data.ByteString.Lazy as BL
@@ -29,13 +29,13 @@ import qualified Data.Text.Lazy.IO as TL
2929
3030benchmark :: FilePath -> Handle -> IO Benchmark
3131benchmark fp sink = return $ bgroup "Throughput"
32− [ bench "String" $ whnfIO $ readFile fp >>= hPutStr sink
33− , bench "ByteString" $ whnfIO $ B.readFile fp >>= B.hPutStr sink
34− , bench "LazyByteString" $ whnfIO $ BL.readFile fp >>= BL.hPutStr sink
35− , bench "Text" $ whnfIO $ T.readFile fp >>= T.hPutStr sink
36− , bench "LazyText" $ whnfIO $ TL.readFile fp >>= TL.hPutStr sink
37− , bench "TextByteString" $ whnfIO $
32+ [ bench "String" $ readFile fp >>= hPutStr sink
33+ , bench "ByteString" $ B.readFile fp >>= B.hPutStr sink
34+ , bench "LazyByteString" $ BL.readFile fp >>= BL.hPutStr sink
35+ , bench "Text" $ T.readFile fp >>= T.hPutStr sink
36+ , bench "LazyText" $ TL.readFile fp >>= TL.hPutStr sink
37+ , bench "TextByteString" $
3838 B.readFile fp >>= B.hPutStr sink . T.encodeUtf8 . T.decodeUtf8
39− , bench "LazyTextByteString" $ whnfIO $
39+ , bench "LazyTextByteString" $
4040 BL.readFile fp >>= BL.hPutStr sink . TL.encodeUtf8 . TL.decodeUtf8
4141 ]
benchmarks/haskell/Benchmarks/Pure.hs−7
@@ -262,13 +262,6 @@ benchmark kind fp = do
262262 , benchBSL $ nf (BL.map toUpper) bla
263263 , benchS $ nf (L.map toUpper) sa
264264 ]
265− , bgroup "uncons"
266− [ benchT $ nf T.uncons ta
267− , benchTL $ nf TL.uncons tla
268− , benchBS $ nf BS.uncons bsa
269− , benchBSL $ nf BL.uncons bla
270− , benchS $ nf L.uncons sa
271− ]
272265 , bgroup "words"
273266 [ benchT $ nf T.words ta
274267 , benchTL $ nf TL.words tla
benchmarks/haskell/Benchmarks/ReadNumbers.hs+5−2
@@ -25,7 +25,8 @@ import Data.List (foldl')
2525import Numeric (readDec, readFloat, readHex)
2626import qualified Data.ByteString.Char8 as B
2727import qualified Data.ByteString.Lazy.Char8 as BL
28−import qualified Data.ByteString.Lex.Fractional as B
28+import qualified Data.ByteString.Lex.Double as B
29+import qualified Data.ByteString.Lex.Lazy.Double as BL
2930import qualified Data.Text as T
3031import qualified Data.Text.IO as T
3132import qualified Data.Text.Lazy as TL
@@ -62,10 +63,12 @@ benchmark fp = do
6263 whnf (double . text TL.rational) tl
6364
6465 , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b
65− , bench "DoubleByteString" $ whnf (double . byteString B.readDecimal) b
66+ , bench "DoubleByteString" $ whnf (double . byteString B.readDouble) b
6667
6768 , bench "DecimalLazyByteString" $
6869 whnf (int . byteString BL.readInt) bl
70+ , bench "DoubleLazyByteString" $
71+ whnf (double . byteString BL.readDouble) bl
6972 ]
7073 where
7174 -- Used for fixing types
benchmarks/haskell/Benchmarks/Stream.hs+9−20
@@ -13,16 +13,16 @@ module Benchmarks.Stream
1313
1414import Control.DeepSeq (NFData (..))
1515import Criterion (Benchmark, bgroup, bench, nf)
16−import Data.Text.Internal.Fusion.Types (Step (..), Stream (..))
16+import Data.Text.Fusion.Internal (Step (..), Stream (..))
1717import qualified Data.Text.Encoding as T
1818import qualified Data.Text.Encoding.Error as E
19−import qualified Data.Text.Internal.Encoding.Fusion as T
20−import qualified Data.Text.Internal.Encoding.Fusion.Common as F
21−import qualified Data.Text.Internal.Fusion as F
19+import qualified Data.Text.Encoding.Fusion as T
20+import qualified Data.Text.Encoding.Fusion.Common as F
21+import qualified Data.Text.Fusion as T
2222import qualified Data.Text.IO as T
2323import qualified Data.Text.Lazy.Encoding as TL
24−import qualified Data.Text.Internal.Lazy.Encoding.Fusion as TL
25−import qualified Data.Text.Internal.Lazy.Fusion as FL
24+import qualified Data.Text.Lazy.Encoding.Fusion as TL
25+import qualified Data.Text.Lazy.Fusion as TL
2626import qualified Data.Text.Lazy.IO as TL
2727
2828instance NFData a => NFData (Stream a) where
@@ -53,25 +53,14 @@ benchmark fp = do
5353 !utf32beL = TL.encodeUtf32BE tl
5454
5555 -- For the functions which operate on streams
56− let !s = F.stream t
56+ let !s = T.stream t
5757
5858 return $ bgroup "Stream"
5959
6060 -- Fusion
6161 [ bgroup "stream" $
62− [ bench "Text" $ nf F.stream t
63− , bench "LazyText" $ nf FL.stream tl
64− ]
65− -- must perform exactly the same as stream above due to
66− -- stream/unstream (i.e. stream after unstream) fusion
67− , bgroup "stream-fusion" $
68− [ bench "Text" $ nf (F.stream . F.unstream . F.stream) t
69− , bench "LazyText" $ nf (FL.stream . FL.unstream . FL.stream) tl
70− ]
71− -- measure the overhead of unstream after stream
72− , bgroup "stream-unstream" $
73− [ bench "Text" $ nf (F.unstream . F.stream) t
74− , bench "LazyText" $ nf (FL.unstream . FL.stream) tl
62+ [ bench "Text" $ nf T.stream t
63+ , bench "LazyText" $ nf TL.stream tl
7564 ]
7665
7766 -- Encoding.Fusion
benchmarks/text-benchmarks.cabal+6−18
@@ -3,7 +3,7 @@ version: 0.0.0.0
33synopsis: Benchmarks for the text package
44description: Benchmarks for the text package
55homepage: https://bitbucket.org/bos/text
6−license: BSD2
6+license: BSD3
77license-file: ../LICENSE
88author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
99 Bryan O'Sullivan <bos@serpentine.com>,
@@ -15,15 +15,9 @@ build-type: Simple
1515
1616cabal-version: >=1.2
1717
18−flag bytestring-builder
19− description: Depend on the bytestring-builder package for backwards compatibility.
20− default: False
21− manual: False
22−
2318flag llvm
2419 description: use LLVM
2520 default: False
26− manual: True
2721
2822executable text-benchmarks
2923 hs-source-dirs: haskell ..
@@ -31,30 +25,24 @@ executable text-benchmarks
3125 cbits/time_iconv.c
3226 include-dirs: ../include
3327 main-is: Benchmarks.hs
34− ghc-options: -Wall -O2 -rtsopts
28+ ghc-options: -Wall -O2
3529 if flag(llvm)
3630 ghc-options: -fllvm
3731 cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP
3832 build-depends: base == 4.*,
3933 binary,
4034 blaze-builder,
41− bytestring-lexing >= 0.5.0,
35+ bytestring,
36+ bytestring-lexing,
4237 containers,
43− criterion >= 0.10.0.0,
38+ criterion >= 0.6.0.1,
4439 deepseq,
4540 directory,
4641 filepath,
4742 ghc-prim,
4843 integer-gmp,
4944 stringsearch,
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
45+ utf8-string
5846
5947executable text-multilang
6048 hs-source-dirs: haskell
cbits/cbits.c+6−86
@@ -68,8 +68,8 @@ decode(uint32_t *state, uint32_t* codep, uint32_t byte) {
6868 * an UTF16 array
6969 */
7070void
71−_hs_text_decode_latin1(uint16_t *dest, const uint8_t *src,
72− const uint8_t *srcend)
71+_hs_text_decode_latin1(uint16_t *dest, const uint8_t const *src,
72+ const uint8_t const *srcend)
7373{
7474 const uint8_t *p = src;
7575
@@ -130,14 +130,14 @@ _hs_text_decode_latin1(uint16_t *dest, const uint8_t *src,
130130#if defined(__GNUC__) || defined(__clang__)
131131static inline uint8_t const *
132132_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,
133− const uint8_t **src, const uint8_t *srcend,
133+ const uint8_t const **src, const uint8_t const *srcend,
134134 uint32_t *codepoint0, uint32_t *state0)
135135 __attribute((always_inline));
136136#endif
137137
138138static inline uint8_t const *
139139_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,
140− const uint8_t **src, const uint8_t *srcend,
140+ const uint8_t const **src, const uint8_t const *srcend,
141141 uint32_t *codepoint0, uint32_t *state0)
142142{
143143 uint16_t *d = dest + *destoff;
@@ -202,8 +202,8 @@ _hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,
202202
203203uint8_t const *
204204_hs_text_decode_utf8_state(uint16_t *const dest, size_t *destoff,
205− const uint8_t **src,
206− const uint8_t *srcend,
205+ const uint8_t const **src,
206+ const uint8_t const *srcend,
207207 uint32_t *codepoint0, uint32_t *state0)
208208{
209209 uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, src, srcend,
@@ -229,83 +229,3 @@ _hs_text_decode_utf8(uint16_t *const dest, size_t *destoff,
229229 ret -= 1;
230230 return ret;
231231}
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−}
changelognew file+16
@@ -0,0 +1,16 @@
1+1.0.0.0
2+
3+ * Added support for Unicode 6.3.0 to case conversion functions
4+
5+ * New function toTitle converts words in a string to title case
6+
7+ * New functions peekCStringLen and withCStringLen simplify
8+ interoperability with C functionns
9+
10+ * Added support for decoding UTF-8 in stream-friendly fashion
11+
12+ * Fixed a bug in mapAccumL
13+
14+ * Added trusted Haskell support
15+
16+ * Removed support for GHC 6.10 (released in 2008) and older
changelog.mddeleted−164
@@ -1,164 +0,0 @@
1−1.2.2.1
2−
3−* The switch to `integer-pure` in 1.2.2.0 was apparently mistaken.
4− The build flag has been renamed accordingly. Your army of diligent
5− maintainers apologizes for the churn.
6−
7−* Spec compliance: toCaseFold now follows the Unicode 8.0 spec
8− (updated from 7.0)
9−
10−* An STG lint error has been fixed
11−
12−1.2.2.0
13−
14−* The `integer-simple` package, upon which this package optionally
15− depended, has been replaced with `integer-pure`. The build flag has
16− been renamed accordingly.
17−
18−* Bug fix: For the `Binary` instance, If UTF-8 decoding fails during a
19− `get`, the error is propagated via `fail` instead of an uncatchable
20− crash.
21−
22−* New function: `takeWhileEnd`
23−
24−* New instances for the `Text` types:
25− * if `base` >= 4.7: `PrintfArg`
26− * if `base` >= 4.9: `Semigroup`
27−
28−1.2.1.3
29−
30−* Bug fix: As it turns out, moving the literal rewrite rules to simplifier
31− phase 2 does not prevent competition with the `unpack` rule, which is
32− also active in this phase. Unfortunately this was hidden due to a silly
33− test environment mistake. Moving literal rules back to phase 1 finally
34− fixes GHC Trac #10528 correctly.
35−
36−1.2.1.2
37−
38−* Bug fix: Run literal rewrite rules in simplifier phase 2.
39− The behavior of the simplifier changed in GHC 7.10.2,
40− causing these rules to fail to fire, leading to poor code generation
41− and long compilation times. See
42− [GHC Trac #10528](https://ghc.haskell.org/trac/ghc/ticket/10528).
43−
44−1.2.1.1
45−
46−* Expose unpackCString#, which you should never use.
47−
48−1.2.1.0
49−
50−* Added Binary instances for both Text types. (If you have previously
51− been using the text-binary package to get a Binary instance, it is
52− now obsolete.)
53−
54−1.2.0.6
55−
56−* Fixed a space leak in UTF-8 decoding
57−
58−1.2.0.5
59−
60−* Feature parity: repeat, cycle, iterate are now implemented for lazy
61− Text, and the Data instance is more complete
62−
63−* Build speed: an inliner space explosion has been fixed with toCaseFold
64−
65−* Bug fix: encoding Int to a Builder would infinite-loop if the
66− integer-simple package was used
67−
68−* Deprecation: OnEncodeError and EncodeError are deprecated, as they
69− are never used
70−
71−* Internals: some types that are used internally in fusion-related
72− functions have moved around, been renamed, or been deleted (we don't
73− bump the major version if .Internal modules change)
74−
75−* Spec compliance: toCaseFold now follows the Unicode 7.0 spec
76− (updated from 6.3)
77−
78−1.2.0.4
79−
80−* Fixed an incompatibility with base < 4.5
81−
82−1.2.0.3
83−
84−* Update formatRealFloat to correspond to the definition in versions
85− of base newer than 4.5 (https://github.com/bos/text/issues/105)
86−
87−1.2.0.2
88−
89−* Bumped lower bound on deepseq to 1.4 for compatibility with the
90− upcoming GHC 7.10
91−
92−1.2.0.1
93−
94−* Fixed a buffer overflow in rendering of large Integers
95− (https://github.com/bos/text/issues/99)
96−
97−1.2.0.0
98−
99−* Fixed an integer overflow in the replace function
100− (https://github.com/bos/text/issues/81)
101−
102−* Fixed a hang in lazy decodeUtf8With
103− (https://github.com/bos/text/issues/87)
104−
105−* Reduced codegen bloat caused by use of empty and single-character
106− literals
107−
108−* Added an instance of IsList for GHC 7.8 and above
109−
110−1.1.1.0
111−
112−* The Data.Data instance now allows gunfold to work, via a virtual
113− pack constructor
114−
115−* dropEnd, takeEnd: new functions
116−
117−* Comparing the length of a Text against a number can now
118− short-circuit in more cases
119−
120−1.1.0.1
121−
122−* streamDecodeUtf8: fixed gh-70, did not return all unconsumed bytes
123− in single-byte chunks
124−
125−1.1.0.0
126−
127−* encodeUtf8: Performance is improved by up to 4x.
128−
129−* encodeUtf8Builder, encodeUtf8BuilderEscaped: new functions,
130− available only if bytestring >= 0.10.4.0 is installed, that allow
131− very fast and flexible encoding of a Text value to a bytestring
132− Builder.
133−
134− As an example of the performance gain to be had, the
135− encodeUtf8BuilderEscaped function helps to double the speed of JSON
136− encoding in the latest version of aeson! (Note: if all you need is a
137− plain ByteString, encodeUtf8 is still the faster way to go.)
138−
139−* All of the internal module hierarchy is now publicly exposed. If a
140− module is in the .Internal hierarchy, or is documented as internal,
141− use at your own risk - there are no API stability guarantees for
142− internal modules!
143−
144−1.0.0.1
145−
146−* decodeUtf8: Fixed a regression that caused us to incorrectly
147− identify truncated UTF-8 as valid (gh-61)
148−
149−1.0.0.0
150−
151−* Added support for Unicode 6.3.0 to case conversion functions
152−
153−* New function toTitle converts words in a string to title case
154−
155−* New functions peekCStringLen and withCStringLen simplify
156− interoperability with C functionns
157−
158−* Added support for decoding UTF-8 in stream-friendly fashion
159−
160−* Fixed a bug in mapAccumL
161−
162−* Added trusted Haskell support
163−
164−* Removed support for GHC 6.10 (released in 2008) and older
scripts/CaseFolding.hs+1−1
@@ -37,7 +37,7 @@ mapCF :: CaseFolding -> [String]
3737mapCF (CF _ ms) = typ ++ (map nice . filter p $ ms) ++ [last]
3838 where
3939 typ = ["foldMapping :: forall s. Char -> s -> Step (CC s) Char"
40− ,"{-# NOINLINE foldMapping #-}"]
40+ ,"{-# INLINE foldMapping #-}"]
4141 last = "foldMapping c s = Yield (toLower c) (CC s '\\0' '\\0')"
4242 nice c = "-- " ++ name c ++ "\n" ++
4343 "foldMapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"
scripts/CaseMapping.hs+4−4
@@ -8,7 +8,7 @@ import SpecialCasing
88main = do
99 args <- getArgs
1010 let oname = case args of
11− [] -> "../Data/Text/Internal/Fusion/CaseMapping.hs"
11+ [] -> "../Data/Text/Fusion/CaseMapping.hs"
1212 [o] -> o
1313 psc <- parseSC "SpecialCasing.txt"
1414 pcf <- parseCF "CaseFolding.txt"
@@ -24,12 +24,12 @@ main = do
2424 mapM_ (hPutStrLn h) $
2525 ["{-# LANGUAGE Rank2Types #-}"
2626 ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"
27− ,"-- Generated by scripts/CaseMapping.hs"] ++
27+ ,"-- Generated by scripts/SpecialCasing.hs"] ++
2828 comments ++
2929 [""
30− ,"module Data.Text.Internal.Fusion.CaseMapping where"
30+ ,"module Data.Text.Fusion.CaseMapping where"
3131 ,"import Data.Char"
32− ,"import Data.Text.Internal.Fusion.Types"
32+ ,"import Data.Text.Fusion.Internal"
3333 ,""]
3434 mapM_ (hPutStrLn h) (mapSC "upper" upper toUpper scs)
3535 mapM_ (hPutStrLn h) (mapSC "lower" lower toLower scs)
scripts/SpecialCasing.hs+1−1
@@ -43,7 +43,7 @@ mapSC which access twiddle (SC _ ms) =
4343 typ ++ (map nice . filter p $ ms) ++ [last]
4444 where
4545 typ = [which ++ "Mapping :: forall s. Char -> s -> Step (CC s) Char"
46− ,"{-# NOINLINE " ++ which ++ "Mapping #-}"]
46+ ,"{-# INLINE " ++ which ++ "Mapping #-}"]
4747 last = which ++ "Mapping c s = Yield (to" ++ ucFirst which ++ " c) (CC s '\\0' '\\0')"
4848 nice c = "-- " ++ name c ++ "\n" ++
4949 which ++ "Mapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"
tests/LiteralRuleTest.hsdeleted−21
@@ -1,21 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−
3−module LiteralRuleTest where
4−
5−import Data.Text (Text)
6−
7−-- This should produce 8 firings of the "TEXT literal" rule
8−strings :: [Text]
9−strings = [ "abstime", "aclitem", "bit", "bool", "box", "bpchar", "bytea", "char" ]
10−
11−-- This should produce 7 firings of the "TEXT literal UTF8" rule
12−utf8Strings :: [Text]
13−utf8Strings = [ "\0abstime", "\0aclitem", "\xfefe bit", "\0bool", "\0box", "\0bpchar", "\0bytea" ]
14−
15−-- This should produce 4 firings of the "TEXT empty literal" rule
16−empties :: [Text]
17−empties = [ "", "", "", "" ]
18−
19−-- This should produce 5 firings of the "TEXT empty literal" rule
20−--singletons :: [Text]
21−--singletons = [ "a", "b", "c", "d", "e" ]
tests/Makefile+1−6
@@ -1,10 +1,5 @@
11count = 1000
22
3−all: coverage literal-rule-test
4−
5−literal-rule-test:
6− ./literal-rule-test.sh
7−
83coverage: build coverage/hpc_index.html
94
105build: text-test-data
@@ -37,4 +32,4 @@ coverage/hpc_index.html: coverage/coverage.tix
3732clean:
3833 rm -rf dist coverage .hpc
3934
40−.PHONY: build coverage all literal-rule-test
35+.PHONY: build coverage
tests/Tests/Properties.hs+79−186
@@ -1,61 +1,65 @@
1−-- | QuickCheck properties for the text library.
2−
3−{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
1+-- | General quicktest properties for the text library
2+--
3+{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, OverloadedStrings,
44 ScopedTypeVariables, TypeSynonymInstances #-}
5−{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}
5+{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}
6+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
67module Tests.Properties
78 (
89 tests
910 ) where
1011
12+import Test.QuickCheck
13+import Test.QuickCheck.Monadic
14+import Text.Show.Functions ()
15+
1116import Control.Applicative ((<$>), (<*>))
1217import Control.Arrow ((***), second)
13−import Data.Bits ((.&.))
18+import Control.Exception (catch)
1419import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
1520import Data.Int (Int8, Int16, Int32, Int64)
1621import Data.Monoid (Monoid(..))
17−import Data.String (IsString(fromString))
22+import Data.String (fromString)
1823import Data.Text.Encoding.Error
1924import Data.Text.Foreign
20−import Data.Text.Internal.Encoding.Utf8
21−import Data.Text.Internal.Fusion.Size
22−import Data.Text.Internal.Search (indices)
25+import Data.Text.Fusion.Size
2326import Data.Text.Lazy.Read as TL
2427import Data.Text.Read as T
28+import Data.Text.Search (indices)
2529import Data.Word (Word, Word8, Word16, Word32, Word64)
26−import Numeric (showEFloat, showFFloat, showGFloat, showHex)
27−import Prelude hiding (replicate)
30+import Numeric (showHex)
2831import Test.Framework (Test, testGroup)
2932import 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
3733import qualified Data.Bits as Bits (shiftL, shiftR)
3834import qualified Data.ByteString as B
3935import qualified Data.ByteString.Lazy as BL
4036import qualified Data.List as L
4137import qualified Data.Text as T
4238import qualified Data.Text.Encoding as E
39+import qualified Data.Text.Fusion as S
40+import qualified Data.Text.Fusion.Common as S
4341import 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
4942import qualified Data.Text.Lazy as TL
5043import qualified Data.Text.Lazy.Builder as TB
5144import qualified Data.Text.Lazy.Builder.Int as TB
5245import qualified Data.Text.Lazy.Builder.RealFloat as TB
5346import qualified Data.Text.Lazy.Encoding as EL
47+import qualified Data.Text.Lazy.Fusion as SL
5448import 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
5551import qualified System.IO as IO
56−import qualified Tests.Properties.Mul as Mul
52+
53+import Tests.QuickCheckUtils
54+import Tests.Utils
5755import qualified Tests.SlowFunctions as Slow
5856
57+#if MIN_VERSION_base(4,6,0)
58+import Prelude hiding (replicate)
59+#else
60+import Prelude hiding (catch, replicate)
61+#endif
62+
5963t_pack_unpack = (T.unpack . T.pack) `eq` id
6064tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
6165t_stream_unstream = (S.unstream . S.stream) `eq` id
@@ -95,23 +99,17 @@ tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id
9599t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
96100tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
97101
98−t_utf8_incr = forAll genUnicode $ \s (Positive n) -> (recode n `eq` id) s
99− where recode n = T.concat . map fst . feedChunksOf n E.streamDecodeUtf8 .
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
102+t_utf8_incr = do
103+ Positive n <- arbitrary
104+ forAll genUnicode $ recode n `eq` id
105+ where recode n = T.concat . feedChunksOf n E.streamDecodeUtf8 . E.encodeUtf8
106+ feedChunksOf :: Int -> (B.ByteString -> E.Decoding) -> B.ByteString
107+ -> [T.Text]
108+ feedChunksOf n f bs
109+ | B.null bs = []
110+ | otherwise = let (a,b) = B.splitAt n bs
111+ E.Some t _ f' = f a
112+ in t : feedChunksOf n f' b
115113
116114data Badness = Solo | Leading | Trailing
117115 deriving (Eq, Show)
@@ -126,11 +124,11 @@ t_utf8_err bad de = do
126124 Leading -> B.append <$> genInvalidUTF8 <*> genUTF8
127125 Trailing -> B.append <$> genUTF8 <*> genInvalidUTF8
128126 genUTF8 = E.encodeUtf8 <$> genUnicode
129− forAll gen $ \bs -> MkProperty $ do
127+ forAll gen $ \bs -> do
130128 onErr <- genDecodeErr de
131− unProperty . monadicIO $ do
129+ monadicIO $ do
132130 l <- run $ let len = T.length (E.decodeUtf8With onErr bs)
133− in (len `seq` return (Right len)) `Exception.catch`
131+ in (len `seq` return (Right len)) `catch`
134132 (\(e::UnicodeException) -> return (Left e))
135133 assert $ case l of
136134 Left err -> length (show err) >= 0
@@ -147,11 +145,6 @@ genInvalidUTF8 = B.pack <$> oneof [
147145 (:) <$> choose (0xC0, 0xC1) <*> upTo 1 contByte
148146 -- invalid leading byte of a 4-byte sequence
149147 , (:) <$> 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
155148 -- continuation bytes without a start byte
156149 , listOf1 contByte
157150 -- short 2-byte sequence
@@ -160,16 +153,6 @@ genInvalidUTF8 = B.pack <$> oneof [
160153 , (:) <$> choose (0xE0, 0xEF) <*> upTo 1 contByte
161154 -- short 4-byte sequence
162155 , (:) <$> 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]
173156 ]
174157 where
175158 contByte = (0x80 +) <$> choose (0, 0x3f)
@@ -197,10 +180,8 @@ t_Show = show `eq` (show . T.pack)
197180tl_Show = show `eq` (show . TL.pack)
198181t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))
199182tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))
200−t_mconcat = unsquare $
201− mconcat `eq` (unpackS . mconcat . L.map T.pack)
202−tl_mconcat = unsquare $
203− mconcat `eq` (unpackS . mconcat . L.map TL.pack)
183+t_mconcat = mconcat `eq` (unpackS . mconcat . L.map T.pack)
184+tl_mconcat = mconcat `eq` (unpackS . mconcat . L.map TL.pack)
204185t_mempty = mempty == (unpackS (mempty :: T.Text))
205186tl_mempty = mempty == (unpackS (mempty :: TL.Text))
206187t_IsString = fromString `eqP` (T.unpack . fromString)
@@ -264,14 +245,11 @@ s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)
264245sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)
265246t_map f = map f `eqP` (unpackS . T.map f)
266247tl_map f = map f `eqP` (unpackS . TL.map f)
267−s_intercalate c = unsquare $
268− L.intercalate c `eq`
248+s_intercalate c = L.intercalate c `eq`
269249 (unpackS . S.intercalate (packS c) . map packS)
270−t_intercalate c = unsquare $
271− L.intercalate c `eq`
250+t_intercalate c = L.intercalate c `eq`
272251 (unpackS . T.intercalate (packS c) . map packS)
273−tl_intercalate c = unsquare $
274− L.intercalate c `eq`
252+tl_intercalate c = L.intercalate c `eq`
275253 (unpackS . TL.intercalate (TL.pack c) . map TL.pack)
276254s_intersperse c = L.intersperse c `eqP`
277255 (unpackS . S.intersperse c)
@@ -279,14 +257,10 @@ s_intersperse_s c = L.intersperse c `eqP`
279257 (unpackS . S.unstream . S.intersperse c)
280258sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`
281259 (unpackS . S.intersperse c . S.filter p)
282−t_intersperse c = unsquare $
283− L.intersperse c `eqP` (unpackS . T.intersperse c)
284−tl_intersperse c = unsquare $
285− L.intersperse c `eqP` (unpackS . TL.intersperse c)
286−t_transpose = unsquare $
287− L.transpose `eq` (map unpackS . T.transpose . map packS)
288−tl_transpose = unsquare $
289− L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)
260+t_intersperse c = L.intersperse c `eqP` (unpackS . T.intersperse c)
261+tl_intersperse c = L.intersperse c `eqP` (unpackS . TL.intersperse c)
262+t_transpose = L.transpose `eq` (map unpackS . T.transpose . map packS)
263+tl_transpose = L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)
290264t_reverse = L.reverse `eqP` (unpackS . T.reverse)
291265tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)
292266t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)
@@ -383,24 +357,17 @@ sf_foldr p f z = (L.foldr f z . L.filter p) `eqP` (S.foldr f z . S.filter p)
383357 where _types = f :: Char -> Char -> Char
384358t_foldr f z = L.foldr f z `eqP` T.foldr f z
385359 where _types = f :: Char -> Char -> Char
386−tl_foldr f z = unsquare $
387− L.foldr f z `eqP` TL.foldr f z
360+tl_foldr f z = L.foldr f z `eqP` TL.foldr f z
388361 where _types = f :: Char -> Char -> Char
389−sf_foldr1 p f = unsquare $
390− (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)
362+sf_foldr1 p f = (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)
391363t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f
392−tl_foldr1 f = unsquare $
393− L.foldr1 f `eqP` TL.foldr1 f
364+tl_foldr1 f = L.foldr1 f `eqP` TL.foldr1 f
394365
395−s_concat_s = unsquare $
396− L.concat `eq` (unpackS . S.unstream . S.concat . map packS)
397−sf_concat p = unsquare $
398− (L.concat . map (L.filter p)) `eq`
366+s_concat_s = L.concat `eq` (unpackS . S.unstream . S.concat . map packS)
367+sf_concat p = (L.concat . map (L.filter p)) `eq`
399368 (unpackS . S.concat . map (S.filter p . packS))
400−t_concat = unsquare $
401− L.concat `eq` (unpackS . T.concat . map packS)
402−tl_concat = unsquare $
403− L.concat `eq` (unpackS . TL.concat . map TL.pack)
369+t_concat = L.concat `eq` (unpackS . T.concat . map packS)
370+tl_concat = L.concat `eq` (unpackS . TL.concat . map TL.pack)
404371sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`
405372 (unpackS . S.concatMap (packS . f) . S.filter p)
406373t_concatMap f = unsquare $
@@ -440,10 +407,6 @@ t_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z)
440407tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)
441408 where _types = f :: Int -> Char -> (Int,Char)
442409
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−
447410replicate n l = concat (L.replicate n l)
448411
449412s_replicate n = replicate m `eq`
@@ -455,14 +418,6 @@ tl_replicate n = replicate m `eq`
455418 (unpackS . TL.replicate (fromIntegral m) . packS)
456419 where m = fromIntegral (n :: Word8)
457420
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−
466421unf :: Int -> Char -> Maybe (Char, Char)
467422unf n c | fromEnum c * 100 > n = Nothing
468423 | otherwise = Just (c, succ c)
@@ -489,22 +444,14 @@ s_take_s m = L.take n `eqP` (unpackS . S.unstream . S.take n)
489444sf_take p n = (L.take n . L.filter p) `eqP`
490445 (unpackS . S.take n . S.filter p)
491446t_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)
494447tl_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)
497448s_drop n = L.drop n `eqP` (unpackS . S.drop n)
498449s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)
499450 where n = small m
500451sf_drop p n = (L.drop n . L.filter p) `eqP`
501452 (unpackS . S.drop n . S.filter p)
502453t_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)
505454tl_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))
508455s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)
509456 where n = small m
510457s_take_drop_s m = (L.take n . L.drop n) `eqP`
@@ -516,10 +463,6 @@ sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
516463 (unpackS . S.takeWhile p . S.filter q)
517464t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
518465tl_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)
523466s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
524467s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
525468sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
@@ -572,27 +515,24 @@ tl_groupBy p = L.groupBy p `eqP` (map unpackS . TL.groupBy p)
572515t_inits = L.inits `eqP` (map unpackS . T.inits)
573516tl_inits = L.inits `eqP` (map unpackS . TL.inits)
574517t_tails = L.tails `eqP` (map unpackS . T.tails)
575−tl_tails = unsquare $
576− L.tails `eqP` (map unpackS . TL.tails)
577−t_findAppendId = unsquare $ \(NotEmpty s) ts ->
518+tl_tails = L.tails `eqP` (map unpackS . TL.tails)
519+t_findAppendId (NotEmpty s) = unsquare $ \ts ->
578520 let t = T.intercalate s ts
579521 in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)
580−tl_findAppendId = unsquare $ \(NotEmpty s) ts ->
522+tl_findAppendId (NotEmpty s) = unsquare $ \ts ->
581523 let t = TL.intercalate s ts
582524 in all (==t) $ map (uncurry TL.append) (TL.breakOnAll s t)
583−t_findContains = unsquare $ \(NotEmpty s) ->
584− all (T.isPrefixOf s . snd) . T.breakOnAll s . T.intercalate s
585−tl_findContains = unsquare $ \(NotEmpty s) -> all (TL.isPrefixOf s . snd) .
525+t_findContains (NotEmpty s) = all (T.isPrefixOf s . snd) . T.breakOnAll s .
526+ T.intercalate s
527+tl_findContains (NotEmpty s) = all (TL.isPrefixOf s . snd) .
586528 TL.breakOnAll s . TL.intercalate s
587529sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c
588530t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s
589531tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s
590532
591−t_splitOn_split s = unsquare $
592− (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s
593−tl_splitOn_split s = unsquare $
594− ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`
595− (map TL.fromStrict . T.splitOn s)) . T.intercalate s
533+t_splitOn_split s = (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s
534+tl_splitOn_split s = ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`
535+ (map TL.fromStrict . T.splitOn s)) . T.intercalate s
596536t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)
597537tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)
598538
@@ -634,14 +574,10 @@ t_lines' = lines' `eqP` (map unpackS . T.lines')
634574t_words = L.words `eqP` (map unpackS . T.words)
635575
636576tl_words = L.words `eqP` (map unpackS . TL.words)
637−t_unlines = unsquare $
638− L.unlines `eq` (unpackS . T.unlines . map packS)
639−tl_unlines = unsquare $
640− L.unlines `eq` (unpackS . TL.unlines . map packS)
641−t_unwords = unsquare $
642− L.unwords `eq` (unpackS . T.unwords . map packS)
643−tl_unwords = unsquare $
644− L.unwords `eq` (unpackS . TL.unwords . map packS)
577+t_unlines = L.unlines `eq` (unpackS . T.unlines . map packS)
578+tl_unlines = L.unlines `eq` (unpackS . TL.unlines . map packS)
579+t_unwords = L.unwords `eq` (unpackS . T.unwords . map packS)
580+tl_unwords = L.unwords `eq` (unpackS . TL.unwords . map packS)
645581
646582s_isPrefixOf s = L.isPrefixOf s `eqP`
647583 (S.isPrefixOf (S.stream $ packS s) . S.stream)
@@ -718,9 +654,8 @@ t_indices (NotEmpty s) = Slow.indices s `eq` indices s
718654tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
719655 where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)
720656 conc = T.concat . TL.toChunks
721−t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
722− let s = T.intercalate t ts
723− in Slow.indices t s == indices t s
657+t_indices_occurs (NotEmpty t) ts = let s = T.intercalate t ts
658+ in Slow.indices t s == indices t s
724659
725660-- Bit shifts.
726661shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
@@ -756,7 +691,6 @@ tb_decimal :: (Integral a, Show a) => a -> Bool
756691tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)
757692
758693tb_decimal_integer (a::Integer) = tb_decimal a
759−tb_decimal_integer_big (Big a) = tb_decimal a
760694tb_decimal_int (a::Int) = tb_decimal a
761695tb_decimal_int8 (a::Int8) = tb_decimal a
762696tb_decimal_int16 (a::Int16) = tb_decimal a
@@ -768,11 +702,6 @@ tb_decimal_word16 (a::Word16) = tb_decimal a
768702tb_decimal_word32 (a::Word32) = tb_decimal a
769703tb_decimal_word64 (a::Word64) = tb_decimal a
770704
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−
776705tb_hex :: (Integral a, Show a) => a -> Bool
777706tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")
778707
@@ -794,21 +723,6 @@ tb_realfloat = (TB.toLazyText . TB.realFloat) `eq` (TL.pack . show)
794723tb_realfloat_float (a::Float) = tb_realfloat a
795724tb_realfloat_double (a::Double) = tb_realfloat a
796725
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−
812726-- Reading.
813727
814728t_decimal (n::Int) s =
@@ -817,18 +731,16 @@ t_decimal (n::Int) s =
817731tl_decimal (n::Int) s =
818732 TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
819733 where t = TL.dropWhile isDigit s
820−t_hexadecimal m s ox =
734+t_hexadecimal (n::Positive Int) s ox =
821735 T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
822736 where t = T.dropWhile isHexDigit s
823737 p = if ox then "0x" else ""
824− n = getPositive m :: Int
825−tl_hexadecimal m s ox =
738+tl_hexadecimal (n::Positive Int) s ox =
826739 TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
827740 where t = TL.dropWhile isHexDigit s
828741 p = if ox then "0x" else ""
829− n = getPositive m :: Int
830742
831−isFloaty c = c `elem` ("+-.0123456789eE" :: String)
743+isFloaty c = c `elem` "+-.0123456789eE"
832744
833745t_read_rational p tol (n::Double) s =
834746 case p (T.pack (show n) `T.append` t) of
@@ -910,7 +822,6 @@ tests =
910822 testProperty "t_utf8" t_utf8,
911823 testProperty "t_utf8'" t_utf8',
912824 testProperty "t_utf8_incr" t_utf8_incr,
913− testProperty "t_utf8_undecoded" t_utf8_undecoded,
914825 testProperty "tl_utf8" tl_utf8,
915826 testProperty "tl_utf8'" tl_utf8',
916827 testProperty "t_utf16LE" t_utf16LE,
@@ -1110,12 +1021,9 @@ tests =
11101021 ],
11111022
11121023 testGroup "unfolds" [
1113− testProperty "tl_repeat" tl_repeat,
11141024 testProperty "s_replicate" s_replicate,
11151025 testProperty "t_replicate" t_replicate,
11161026 testProperty "tl_replicate" tl_replicate,
1117− testProperty "tl_cycle" tl_cycle,
1118− testProperty "tl_iterate" tl_iterate,
11191027 testProperty "t_unfoldr" t_unfoldr,
11201028 testProperty "tl_unfoldr" tl_unfoldr,
11211029 testProperty "t_unfoldrN" t_unfoldrN,
@@ -1129,16 +1037,12 @@ tests =
11291037 testProperty "s_take_s" s_take_s,
11301038 testProperty "sf_take" sf_take,
11311039 testProperty "t_take" t_take,
1132− testProperty "t_takeEnd" t_takeEnd,
11331040 testProperty "tl_take" tl_take,
1134− testProperty "tl_takeEnd" tl_takeEnd,
11351041 testProperty "s_drop" s_drop,
11361042 testProperty "s_drop_s" s_drop_s,
11371043 testProperty "sf_drop" sf_drop,
11381044 testProperty "t_drop" t_drop,
1139− testProperty "t_dropEnd" t_dropEnd,
11401045 testProperty "tl_drop" tl_drop,
1141− testProperty "tl_dropEnd" tl_dropEnd,
11421046 testProperty "s_take_drop" s_take_drop,
11431047 testProperty "s_take_drop_s" s_take_drop_s,
11441048 testProperty "s_takeWhile" s_takeWhile,
@@ -1146,8 +1050,6 @@ tests =
11461050 testProperty "sf_takeWhile" sf_takeWhile,
11471051 testProperty "t_takeWhile" t_takeWhile,
11481052 testProperty "tl_takeWhile" tl_takeWhile,
1149− testProperty "t_takeWhileEnd" t_takeWhileEnd,
1150− testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
11511053 testProperty "sf_dropWhile" sf_dropWhile,
11521054 testProperty "s_dropWhile" s_dropWhile,
11531055 testProperty "s_dropWhile_s" s_dropWhile_s,
@@ -1293,16 +1195,11 @@ tests =
12931195 testProperty "tb_decimal_int32" tb_decimal_int32,
12941196 testProperty "tb_decimal_int64" tb_decimal_int64,
12951197 testProperty "tb_decimal_integer" tb_decimal_integer,
1296− testProperty "tb_decimal_integer_big" tb_decimal_integer_big,
12971198 testProperty "tb_decimal_word" tb_decimal_word,
12981199 testProperty "tb_decimal_word8" tb_decimal_word8,
12991200 testProperty "tb_decimal_word16" tb_decimal_word16,
13001201 testProperty "tb_decimal_word32" tb_decimal_word32,
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
1202+ testProperty "tb_decimal_word64" tb_decimal_word64
13061203 ],
13071204 testGroup "hexadecimal" [
13081205 testProperty "tb_hexadecimal_int" tb_hexadecimal_int,
@@ -1319,9 +1216,7 @@ tests =
13191216 ],
13201217 testGroup "realfloat" [
13211218 testProperty "tb_realfloat_double" tb_realfloat_double,
1322− testProperty "tb_realfloat_float" tb_realfloat_float,
1323− testProperty "tb_formatRealFloat_float" tb_formatRealFloat_float,
1324− testProperty "tb_formatRealFloat_double" tb_formatRealFloat_double
1219+ testProperty "tb_realfloat_float" tb_realfloat_float
13251220 ],
13261221 testProperty "tb_fromText" tb_fromText,
13271222 testProperty "tb_singleton" tb_singleton
@@ -1357,7 +1252,5 @@ tests =
13571252 testProperty "t_take_drop_16" t_take_drop_16,
13581253 testProperty "t_use_from" t_use_from,
13591254 testProperty "t_copy" t_copy
1360− ],
1361−
1362− testGroup "mul" Mul.tests
1255+ ]
13631256 ]
tests/Tests/Properties/Mul.hsdeleted−40
@@ -1,40 +0,0 @@
1−{-# LANGUAGE ScopedTypeVariables #-}
2−
3−module Tests.Properties.Mul (tests) where
4−
5−import Control.Applicative ((<$>), pure)
6−import Control.Exception as E (SomeException, catch, evaluate)
7−import Data.Int (Int32, Int64)
8−import Data.Text.Internal (mul, mul32, mul64)
9−import System.IO.Unsafe (unsafePerformIO)
10−import Test.Framework (Test)
11−import Test.Framework.Providers.QuickCheck2 (testProperty)
12−import Test.QuickCheck hiding ((.&.))
13−
14−mulRef :: (Integral a, Bounded a) => a -> a -> Maybe a
15−mulRef a b
16− | ab < bot || ab > top = Nothing
17− | otherwise = Just (fromIntegral ab)
18− where ab = fromIntegral a * fromIntegral b
19− top = fromIntegral (maxBound `asTypeOf` a) :: Integer
20− bot = fromIntegral (minBound `asTypeOf` a) :: Integer
21−
22−eval :: (a -> b -> c) -> a -> b -> Maybe c
23−eval f a b = unsafePerformIO $
24− (Just <$> evaluate (f a b)) `E.catch` (\(_::SomeException) -> pure Nothing)
25−
26−t_mul32 :: Int32 -> Int32 -> Property
27−t_mul32 a b = mulRef a b === eval mul32 a b
28−
29−t_mul64 :: Int64 -> Int64 -> Property
30−t_mul64 a b = mulRef a b === eval mul64 a b
31−
32−t_mul :: Int -> Int -> Property
33−t_mul a b = mulRef a b === eval mul a b
34−
35−tests :: [Test]
36−tests = [
37− testProperty "t_mul" t_mul
38− , testProperty "t_mul32" t_mul32
39− , testProperty "t_mul64" t_mul64
40− ]
tests/Tests/QuickCheckUtils.hs+77−98
@@ -10,91 +10,108 @@ module Tests.QuickCheckUtils
1010 , unsquare
1111 , smallArbitrary
1212
13− , BigBounded(..)
14− , BigInt(..)
15− , NotEmpty(..)
13+ , NotEmpty (..)
1614
17− , Small(..)
15+ , Small (..)
1816 , small
1917
20− , Precision(..)
21− , precision
22−
2318 , integralRandomR
2419
25− , DecodeErr(..)
20+ , DecodeErr (..)
2621 , genDecodeErr
2722
28− , Stringy(..)
23+ , Stringy (..)
2924 , eq
3025 , eqP
3126
32− , Encoding(..)
27+ , Encoding (..)
3328
3429 , write_read
3530 ) where
3631
37−import Control.Applicative ((<$>))
3832import Control.Arrow (first, (***))
3933import Control.DeepSeq (NFData (..), deepseq)
4034import Control.Exception (bracket)
35+import Data.Bits ((.&.))
36+import Data.Char (chr)
37+import Data.Word (Word8, Word16)
4138import Data.String (IsString, fromString)
4239import Data.Text.Foreign (I16)
43−import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))
44−import Data.Word (Word8, Word16)
4540import Debug.Trace (trace)
46−import System.Random (Random(..), RandomGen)
47−import Test.QuickCheck hiding (Fixed(..), Small (..), (.&.))
41+import System.Random (Random (..), RandomGen)
42+import Test.QuickCheck hiding ((.&.))
4843import Test.QuickCheck.Monadic (assert, monadicIO, run)
49−import Test.QuickCheck.Unicode (string)
50−import Tests.Utils
5144import qualified Data.ByteString as B
5245import qualified Data.Text as T
5346import qualified Data.Text.Encoding.Error as T
54−import qualified Data.Text.Internal.Fusion 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
47+import qualified Data.Text.Fusion as TF
48+import qualified Data.Text.Fusion.Common as TF
5849import qualified Data.Text.Lazy as TL
50+import qualified Data.Text.Lazy.Fusion as TLF
51+import qualified Data.Text.Lazy.Internal as TL
5952import qualified System.IO as IO
6053
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+import Tests.Utils
6855
6956instance Random I16 where
7057 randomR = integralRandomR
7158 random = randomR (minBound,maxBound)
7259
7360instance Arbitrary I16 where
74− arbitrary = arbitrarySizedIntegral
75− shrink = shrinkIntegral
61+ arbitrary = choose (minBound,maxBound)
7662
7763instance Arbitrary B.ByteString where
7864 arbitrary = B.pack `fmap` arbitrary
79− shrink = map B.pack . shrink . B.unpack
80−
81−#if !MIN_VERSION_base(4,4,0)
82−instance Random Int64 where
83− randomR = integralRandomR
84− random = randomR (minBound,maxBound)
85−
86−instance Random Word where
87− randomR = integralRandomR
88− random = randomR (minBound,maxBound)
89−
90−instance Random Word8 where
91− randomR = integralRandomR
92− random = randomR (minBound,maxBound)
9365
94−instance Random Word64 where
95− randomR = integralRandomR
96− random = randomR (minBound,maxBound)
97−#endif
66+genUnicode :: IsString a => Gen a
67+genUnicode = fmap fromString string where
68+ string = sized $ \n ->
69+ do k <- choose (0,n)
70+ sequence [ char | _ <- [1..k] ]
71+
72+ excluding :: [a -> Bool] -> Gen a -> Gen a
73+ excluding bad gen = loop
74+ where
75+ loop = do
76+ x <- gen
77+ if or (map ($ x) bad)
78+ then loop
79+ else return x
80+
81+ reserved = [lowSurrogate, highSurrogate, noncharacter]
82+ lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF
83+ highSurrogate c = c >= 0xD800 && c <= 0xDBFF
84+ noncharacter c = masked == 0xFFFE || masked == 0xFFFF
85+ where
86+ masked = c .&. 0xFFFF
87+
88+ ascii = choose (0,0x7F)
89+ plane0 = choose (0xF0, 0xFFFF)
90+ plane1 = oneof [ choose (0x10000, 0x10FFF)
91+ , choose (0x11000, 0x11FFF)
92+ , choose (0x12000, 0x12FFF)
93+ , choose (0x13000, 0x13FFF)
94+ , choose (0x1D000, 0x1DFFF)
95+ , choose (0x1F000, 0x1FFFF)
96+ ]
97+ plane2 = oneof [ choose (0x20000, 0x20FFF)
98+ , choose (0x21000, 0x21FFF)
99+ , choose (0x22000, 0x22FFF)
100+ , choose (0x23000, 0x23FFF)
101+ , choose (0x24000, 0x24FFF)
102+ , choose (0x25000, 0x25FFF)
103+ , choose (0x26000, 0x26FFF)
104+ , choose (0x27000, 0x27FFF)
105+ , choose (0x28000, 0x28FFF)
106+ , choose (0x29000, 0x29FFF)
107+ , choose (0x2A000, 0x2AFFF)
108+ , choose (0x2B000, 0x2BFFF)
109+ , choose (0x2F000, 0x2FFFF)
110+ ]
111+ plane14 = choose (0xE0000, 0xE0FFF)
112+ planes = [ascii, plane0, plane1, plane2, plane14]
113+
114+ char = chr `fmap` excluding reserved (oneof planes)
98115
99116-- For tests that have O(n^2) running times or input sizes, resize
100117-- their inputs to the square root of the originals.
@@ -107,25 +124,9 @@ smallArbitrary = sized $ \n -> resize (smallish n) arbitrary
107124
108125instance Arbitrary T.Text where
109126 arbitrary = T.pack `fmap` arbitrary
110− shrink = map T.pack . shrink . T.unpack
111127
112128instance Arbitrary TL.Text where
113129 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)
129130
130131newtype NotEmpty a = NotEmpty { notEmpty :: a }
131132 deriving (Eq, Ord)
@@ -138,23 +139,15 @@ instance Functor NotEmpty where
138139
139140instance Arbitrary a => Arbitrary (NotEmpty [a]) where
140141 arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))
141− shrink = shrinkNotEmpty null
142142
143143instance Arbitrary (NotEmpty T.Text) where
144144 arbitrary = (fmap T.pack) `fmap` arbitrary
145− shrink = shrinkNotEmpty T.null
146145
147146instance Arbitrary (NotEmpty TL.Text) where
148147 arbitrary = (fmap TL.pack) `fmap` arbitrary
149− shrink = shrinkNotEmpty TL.null
150148
151149instance Arbitrary (NotEmpty B.ByteString) where
152150 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') ]
158151
159152data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7
160153 | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15
@@ -195,8 +188,7 @@ instance Random Small where
195188 random = randomR (minBound,maxBound)
196189
197190instance Arbitrary Small where
198− arbitrary = choose (minBound, maxBound)
199− shrink = shrinkIntegral
191+ arbitrary = choose (minBound,maxBound)
200192
201193integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
202194integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
@@ -267,30 +259,6 @@ eqP f g s w = eql "orig" (f s) (g t) &&
267259 | a =^= b = True
268260 | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
269261
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−
294262-- Work around lack of Show instance for TextEncoding.
295263data Encoding = E String IO.TextEncoding
296264
@@ -308,6 +276,17 @@ windowsNewlineMode = IO.NewlineMode
308276 { IO.inputNL = IO.CRLF, IO.outputNL = IO.CRLF
309277 }
310278
279+-- Newline and NewlineMode have standard Show instance from GHC 7 onwards
280+#if __GLASGOW_HASKELL__ < 700
281+instance Show IO.Newline where
282+ show IO.CRLF = "CRLF"
283+ show IO.LF = "LF"
284+
285+instance Show IO.NewlineMode where
286+ show (IO.NewlineMode i o) = "NewlineMode { inputNL = " ++ show i ++
287+ ", outputNL = " ++ show o ++ " }"
288+# endif
289+
311290instance Arbitrary IO.NewlineMode where
312291 arbitrary = oneof . map return $
313292 [ IO.noNewlineTranslation, IO.universalNewlineMode, IO.nativeNewlineMode
tests/cabal.configdeleted−6
@@ -1,6 +0,0 @@
1−-- These flags help to speed up building the test suite.
2−
3−documentation: False
4−executable-stripping: False
5−flags: developer
6−library-profiling: False
tests/literal-rule-test.shdeleted−29
@@ -1,29 +0,0 @@
1−#!/bin/bash -e
2−
3−failed=0
4−
5−function check_firings() {
6− rule=$1
7− expected=$2
8− build="ghc -O -ddump-rule-firings LiteralRuleTest.hs"
9− build="$build -i.. -I../include"
10− touch LiteralRuleTest.hs
11− echo -n "Want to see $expected firings of rule $rule... " >&2
12− firings=$($build 2>&1 | grep "Rule fired: $rule\$" | wc -l)
13− rm -f LiteralRuleTest.{o.hi}
14−
15− if [ $firings != $expected ]; then
16− echo "failed, saw $firings" >&2
17− failed=1
18− else
19− echo "pass" >&2
20− fi
21−}
22−
23−check_firings "TEXT literal" 8
24−check_firings "TEXT literal UTF8" 7
25−check_firings "TEXT empty literal" 4
26−# This is broken at the moment. "TEXT literal" rule fires instead.
27−#check_firings "TEXT singleton literal" 5
28−
29−exit $failed
tests/text-tests.cabal+28−45
@@ -2,8 +2,8 @@ name: text-tests
22version: 0.0.0.0
33synopsis: Functional tests for the text package
44description: Functional tests for the text package
5−homepage: https://github.com/bos/text
6−license: BSD2
5+homepage: https://bitbucket.org/bos/text
6+license: BSD3
77license-file: ../LICENSE
88author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
99 Bryan O'Sullivan <bos@serpentine.com>,
@@ -18,20 +18,10 @@ cabal-version: >=1.8
1818flag hpc
1919 description: Enable HPC to generate coverage reports
2020 default: False
21− manual: True
2221
2322executable text-tests
2423 main-is: Tests.hs
2524
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−
3525 ghc-options:
3626 -Wall -threaded -O0 -rtsopts
3727
@@ -40,18 +30,16 @@ executable text-tests
4030 -fhpc
4131
4232 cpp-options:
43− -DTEST_SUITE
4433 -DASSERTS
4534 -DHAVE_DEEPSEQ
4635
4736 build-depends:
4837 HUnit >= 1.2,
49− QuickCheck >= 2.7,
38+ QuickCheck >= 2.4,
5039 base == 4.*,
5140 bytestring,
5241 deepseq,
5342 directory,
54− quickcheck-unicode,
5543 random,
5644 test-framework >= 0.4,
5745 test-framework-hunit >= 0.2,
@@ -77,58 +65,54 @@ library
7765 hs-source-dirs: ..
7866 c-sources: ../cbits/cbits.c
7967 include-dirs: ../include
80− ghc-options: -Wall
8168 exposed-modules:
8269 Data.Text
8370 Data.Text.Array
8471 Data.Text.Encoding
8572 Data.Text.Encoding.Error
86− Data.Text.Internal.Encoding.Fusion
87− Data.Text.Internal.Encoding.Fusion.Common
88− Data.Text.Internal.Encoding.Utf16
89− Data.Text.Internal.Encoding.Utf32
90− Data.Text.Internal.Encoding.Utf8
73+ Data.Text.Encoding.Fusion
74+ Data.Text.Encoding.Fusion.Common
75+ Data.Text.Encoding.Utf16
76+ Data.Text.Encoding.Utf32
77+ Data.Text.Encoding.Utf8
9178 Data.Text.Foreign
92− Data.Text.Internal.Fusion
93− Data.Text.Internal.Fusion.CaseMapping
94− Data.Text.Internal.Fusion.Common
95− Data.Text.Internal.Fusion.Size
96− Data.Text.Internal.Fusion.Types
79+ Data.Text.Fusion
80+ Data.Text.Fusion.CaseMapping
81+ Data.Text.Fusion.Common
82+ Data.Text.Fusion.Internal
83+ Data.Text.Fusion.Size
9784 Data.Text.IO
98− Data.Text.Internal.IO
85+ Data.Text.IO.Internal
9986 Data.Text.Internal
10087 Data.Text.Lazy
10188 Data.Text.Lazy.Builder
102− Data.Text.Internal.Builder.Functions
89+ Data.Text.Lazy.Builder.Functions
10390 Data.Text.Lazy.Builder.Int
104− Data.Text.Internal.Builder.Int.Digits
105− Data.Text.Internal.Builder
91+ Data.Text.Lazy.Builder.Int.Digits
92+ Data.Text.Lazy.Builder.Internal
10693 Data.Text.Lazy.Builder.RealFloat
107− Data.Text.Internal.Builder.RealFloat.Functions
94+ Data.Text.Lazy.Builder.RealFloat.Functions
10895 Data.Text.Lazy.Encoding
109− Data.Text.Internal.Lazy.Encoding.Fusion
110− Data.Text.Internal.Lazy.Fusion
96+ Data.Text.Lazy.Encoding.Fusion
97+ Data.Text.Lazy.Fusion
11198 Data.Text.Lazy.IO
112− Data.Text.Internal.Lazy
99+ Data.Text.Lazy.Internal
113100 Data.Text.Lazy.Read
114− Data.Text.Internal.Lazy.Search
115− Data.Text.Internal.Private
101+ Data.Text.Lazy.Search
102+ Data.Text.Private
116103 Data.Text.Read
117− Data.Text.Show
118− Data.Text.Internal.Read
119− Data.Text.Internal.Search
104+ Data.Text.Search
120105 Data.Text.Unsafe
121− Data.Text.Internal.Unsafe
122− Data.Text.Internal.Unsafe.Char
123− Data.Text.Internal.Unsafe.Shift
124− Data.Text.Internal.Functions
106+ Data.Text.Unsafe.Base
107+ Data.Text.UnsafeChar
108+ Data.Text.UnsafeShift
109+ Data.Text.Util
125110
126111 if flag(hpc)
127112 ghc-options:
128113 -fhpc
129114
130115 cpp-options:
131− -DTEST_SUITE
132116 -DHAVE_DEEPSEQ
133117 -DASSERTS
134118 -DINTEGER_GMP
@@ -136,7 +120,6 @@ library
136120 build-depends:
137121 array,
138122 base == 4.*,
139− binary,
140123 bytestring,
141124 deepseq,
142125 ghc-prim,
text.cabal+31−57
@@ -1,5 +1,5 @@
11name: text
2−version: 1.2.2.1
2+version: 1.0.0.0
33homepage: https://github.com/bos/text
44bug-reports: https://github.com/bos/text/issues
55synopsis: An efficient packed Unicode text type.
@@ -31,7 +31,7 @@ description:
3131 the @text-icu@ package:
3232 <http://hackage.haskell.org/package/text-icu>
3333
34−license: BSD2
34+license: BSD3
3535license-file: LICENSE
3636author: Bryan O'Sullivan <bos@serpentine.com>
3737maintainer: Bryan O'Sullivan <bos@serpentine.com>
@@ -51,7 +51,7 @@ extra-source-files:
5151 benchmarks/python/*.py
5252 benchmarks/ruby/*.rb
5353 benchmarks/text-benchmarks.cabal
54− changelog.md
54+ changelog
5555 include/*.h
5656 scripts/*.hs
5757 tests-and-benchmarks.markdown
@@ -59,25 +59,16 @@ extra-source-files:
5959 tests/.ghci
6060 tests/Makefile
6161 tests/Tests/*.hs
62− tests/Tests/Properties/*.hs
63− tests/cabal.config
6462 tests/scripts/*.sh
6563 tests/text-tests.cabal
6664
67−flag bytestring-builder
68− description: Depend on the bytestring-builder package for backwards compatibility.
69− default: False
70− manual: False
71−
7265flag developer
7366 description: operate in developer mode
7467 default: False
75− manual: True
7668
7769flag integer-simple
7870 description: Use the simple integer library instead of GMP
7971 default: False
80− manual: False
8172
8273library
8374 c-sources: cbits/cbits.c
@@ -91,32 +82,6 @@ library
9182 Data.Text.Foreign
9283 Data.Text.IO
9384 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
12085 Data.Text.Lazy
12186 Data.Text.Lazy.Builder
12287 Data.Text.Lazy.Builder.Int
@@ -127,23 +92,39 @@ library
12792 Data.Text.Lazy.Read
12893 Data.Text.Read
12994 Data.Text.Unsafe
130−
13195 other-modules:
132− Data.Text.Show
96+ Data.Text.Encoding.Fusion
97+ Data.Text.Encoding.Fusion.Common
98+ Data.Text.Encoding.Utf16
99+ Data.Text.Encoding.Utf32
100+ Data.Text.Encoding.Utf8
101+ Data.Text.Fusion
102+ Data.Text.Fusion.CaseMapping
103+ Data.Text.Fusion.Common
104+ Data.Text.Fusion.Internal
105+ Data.Text.Fusion.Size
106+ Data.Text.IO.Internal
107+ Data.Text.Lazy.Builder.Functions
108+ Data.Text.Lazy.Builder.Int.Digits
109+ Data.Text.Lazy.Builder.Internal
110+ Data.Text.Lazy.Builder.RealFloat.Functions
111+ Data.Text.Lazy.Encoding.Fusion
112+ Data.Text.Lazy.Fusion
113+ Data.Text.Lazy.Search
114+ Data.Text.Private
115+ Data.Text.Search
116+ Data.Text.Unsafe.Base
117+ Data.Text.UnsafeChar
118+ Data.Text.UnsafeShift
119+ Data.Text.Util
133120
134121 build-depends:
135122 array >= 0.3,
136123 base >= 4.2 && < 5,
137− binary,
124+ bytestring >= 0.9,
138125 deepseq >= 1.1.0.0,
139126 ghc-prim >= 0.2
140127
141− if flag(bytestring-builder)
142− build-depends: bytestring >= 0.9 && < 0.10.4,
143− bytestring-builder >= 0.10.4
144− else
145− build-depends: bytestring >= 0.10.4
146−
147128 cpp-options: -DHAVE_DEEPSEQ
148129 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
149130 if flag(developer)
@@ -169,29 +150,22 @@ test-suite tests
169150 -Wall -threaded -O0 -rtsopts
170151
171152 cpp-options:
172− -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE
153+ -DASSERTS -DHAVE_DEEPSEQ
173154
174155 build-depends:
175156 HUnit >= 1.2,
176− QuickCheck >= 2.7,
157+ QuickCheck >= 2.4,
177158 array,
178159 base,
179− binary,
160+ bytestring,
180161 deepseq,
181162 directory,
182163 ghc-prim,
183− quickcheck-unicode,
184164 random,
185165 test-framework >= 0.4,
186166 test-framework-hunit >= 0.2,
187167 test-framework-quickcheck2 >= 0.2
188168
189− if flag(bytestring-builder)
190− build-depends: bytestring >= 0.9 && < 0.10.4,
191− bytestring-builder >= 0.10.4
192− else
193− build-depends: bytestring >= 0.10.4
194−
195169 if flag(integer-simple)
196170 cpp-options: -DINTEGER_SIMPLE
197171 build-depends: integer-simple >= 0.1 && < 0.5