on 1689fcb help sign in
.gitignoredeleted−3
since splitsnapshots
unifiedsplit
@@ -1,3 +0,0 @@
1−dist
2−cabal-dev
3−cabal.sandbox.config
.hgignoredeleted−14
@@ -1,14 +0,0 @@
1−^(?:dist|benchmarks/dist|tests/coverage|tests/dist)$
2−^benchmarks/.*\.txt$
3−^tests/text-testdata.tar.bz2$
4−^tests/(?:\.hpc|bm|qc|qc-hpc|stdio-hpc|text/test)$
5−\.(?:aux|eventlog|h[ip]|log|[oa]|orig|prof|ps|rej|swp|tix)$
6−~$
7−
8−syntax: glob
9−.\#*
10−cabal-dev
11−cabal.sandbox.config
12−\.cabal-sandbox
13−scripts/CaseFolding.txt
14−scripts/SpecialCasing.txt
.hgtagsdeleted−66
@@ -1,66 +0,0 @@
1−0edd5dc96024e6c0f56f175ffa673f9178cece8c 0.9.0.0
2−1de0da99d31ba212e179d88957cf5f3b9c4facd7 0.7.0.1
3−30575507578cf04b5b1501ee23b1faa83315eb88 0.1
4−321e61f17630dbd346c1c9991831572f964b7d5a 0.4
5−34cef27f87287cd3c17d78ac99e9de2d6c8a1200 0.6
6−3cbff6d9bca135a85e428a7f6c4e15739a562b8b 0.7.1.0
7−587c8661393f83cb2b9452f6cc1d6885e52fe544 0.8.1.0
8−61c322bd5b6446255870422f854266396169a7e5 0.5
9−9adb5edd9b6407335e8772ea86036b938471fc89 0.2
10−b4fdbef1c1027a70b95c1a81747d968890acc3f6 0.3
11−de7cb0cb2a72606126c357b860bb0dbf7f145ad2 0.9.0.1
12−f2c9b1c019e3277926378d7b5a604f1c995f0202 0.7
13−f3d625f2d0730cb6adf8506a1f37762178c9aea6 0.10.0.0
14−99ea36957b1d47145d70f2ee8b13f1ddfd09245c 0.10.0.1
15−1b7889216e78b00d69b32c48782111bcd935978d 0.10.0.2
16−75157eaec6eb38574ad5c347e75c48dcb7262dee 0.11.0.0
17−0d7bc7bd77ec5a8f6d064de59d459e5eaf906b0f 0.11.0.1
18−a9d582a75dea9a4417883019d5110a35e4c07265 0.11.0.2
19−36b2a3aa661892ea25101199220383ba6d579abb 0.11.0.3
20−06e407bcdc9a3905abf9551062ecc6f92abcdde5 0.11.0.4
21−94bcf16e812f6fb49b87598673e17270f48c2bf1 0.11.0.5
22−784a32ffbec0b77adb43e9a64328db0482007309 0.11.0.6
23−c808123a3d37f25004d2aad8f3a395acfcf9122f 0.11.0.7
24−679826e742b239c5dd0c1fa4ebe98aa4bfe02a00 0.11.0.8
25−b49eebfa5673da89a23939d523c9de9edbd410b0 0.11.1.0
26−9c820a2ecaea01bc614d8e6bccf90e57431bdcbb 0.11.1.1
27−ed3a60ec627af6ba8af321009aa00224b3296e47 0.11.1.2
28−b75d3041d275e8e76b26605b0d426a572ddf1249 0.11.1.3
29−53906ad0c7e64f6c9a5df569e7cc642579aab8fc 0.11.1.5
30−9d6d3a9690ade506897c072060eb92868e229d5c 0.11.1.6
31−5ac062eace36b333566d1676979a57039a188840 0.11.1.7
32−9f01361a73071936b6ab0bdb879f1a45cca6577a 0.11.1.8
33−5dce2a934be53e74310fedffb51d7bd3e61fa993 0.11.1.9
34−9f47a2cfc9e51fd622d7553f08ad2ac1faad0438 0.11.1.10
35−9f47a2cfc9e51fd622d7553f08ad2ac1faad0438 0.11.1.10
36−407937739e9e764f1ae0f1f9ca454c42dca38772 0.11.1.10
37−8b981edd27befa4c2dd334fcb7db22ac67e22b67 0.11.1.11
38−204da16b5098531bdf858c388e2620238ef2aa5e 0.11.1.12
39−6a3d847a56a69d0514a79cb212cb218271ad0917 0.11.1.13
40−1d2c6fa9092c6a4000b2abdd9d01f3efcd477be5 0.11.2.0
41−78219784cf3652cc662805bf2971bd62d80210a9 0.11.2.1
42−4297307ebc11ad677cfba6b40319e7e5e2c0cfee 0.11.2.3
43−7fa79662b66aade97fe49394977213fe6432942e 0.11.3.0
44−d99cd091cdf71ce807a4255f6cc509c3154f51ea 0.11.3.1
45−31f57612fd425d1bb56352ce6b79e41ce6699a45 1.0.0.0
46−7cba97c86467c1881dfced68613891f3c65561b0 1.0.0.1
47−62674a9bbc83145d1d7be28a05d456ab6bb5ff89 1.1.0.0
48−68a32d80c0829da164d1e6b3acedcc3efeda0957 1.1.0.1
49−6d863daafbf0e1289ec0a0eb9b4be2a0a9cb8d3d 1.1.1.0
50−fb7299f22449750c653ac64dee4bd63c13ea6e4c 1.1.1.1
51−eb170cb533b63534d166b5fd5344b36676adf140 1.1.1.2
52−e749e05f715d02445803f653cd3d97d5395d7c6f 1.1.1.3
53−b0dff8ca1142595bab489a768ca62e6a6805aac4 1.1.1.4
54−f8a60279237c1c28e094868740d9188dd94fcc9e 1.2.0.0
55−6231451979b2d33e28038b75f2dab19c9731f5c3 1.2.0.1
56−99a3503b4ad001fc1894e90286e96d7dea1e9195 1.2.0.2
57−47f138edf15576b9adaeed64784e30811099f202 1.2.0.3
58−0b064b0c69106bbcd13cb0099e72ae5fa2347bf0 1.2.0.4
59−8bbb3e222a0037035d893f731b0a23be449f7346 1.2.0.5
60−18c7f8e19872762b7e28ee1871e72f70ea54e3cd 1.2.0.6
61−42f751b87b4a187db93f595a8166d51746ff57d4 1.2.1.0
62−78227a84740b70dcd4cf7a65f3bcf603d87e48e2 1.2.1.1
63−40f268e6735749ef36f487e1d928eaa957bb431d 1.2.1.2
64−631fd055e27fa10983e17e9ad36d1b285b85c661 1.2.1.3
65−8221a68ed5ec37028357df9c6c25f52320e54ad9 1.2.2.0
66−ce1c5ac65eb9f5580114b4e380092b05a485e95d 1.2.2.1
Data/Text.hs+327−1053
@@ -1,48 +1,29 @@
1−{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, UnboxedTuples #-}
1+{-# LANGUAGE BangPatterns #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
3−#if __GLASGOW_HASKELL__ >= 702
4−{-# LANGUAGE Trustworthy #-}
5−#endif
6−#if __GLASGOW_HASKELL__ >= 708
7−{-# LANGUAGE TypeFamilies #-}
8−#endif
9
3
10-- |
4-- |
11-- Module : Data.Text
5-- Module : Data.Text
6+-- Copyright : (c) Tom Harper 2008-2009,
12−-- Copyright : (c) 2009, 2010, 2011, 2012 Bryan O'Sullivan,
7+-- (c) Bryan O'Sullivan 2009,
13−-- (c) 2009 Duncan Coutts,
8+-- (c) Duncan Coutts 2009
14−-- (c) 2008, 2009 Tom Harper
15--
9--
16-- License : BSD-style
10-- License : BSD-style
17−-- Maintainer : bos@serpentine.com
11+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,
12+-- duncan@haskell.org
18-- Stability : experimental
13-- Stability : experimental
19-- Portability : GHC
14-- Portability : GHC
20--
15--
21−-- A time and space-efficient implementation of Unicode text.
16+-- A time and space-efficient implementation of Unicode text using
22−-- Suitable for performance critical use, both in terms of large data
17+-- packed Word16 arrays. Suitable for performance critical use, both
23−-- quantities and high speed.
18+-- in terms of large data quantities and high speed.
24−--
25−-- /Note/: Read below the synopsis for important notes on the use of
26−-- this module.
27--
19--
28-- This module is intended to be imported @qualified@, to avoid name
20-- This module is intended to be imported @qualified@, to avoid name
29-- clashes with "Prelude" functions, e.g.
21-- clashes with "Prelude" functions, e.g.
30--
22--
31-- > import qualified Data.Text as T
23-- > import qualified Data.Text as T
32−--
33−-- To use an extended and very rich family of functions for working
34−-- 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 >.
37
24
38module Data.Text
25module Data.Text
39 (
26 (
40− -- * Strict vs lazy types
41− -- $strict
42−
43− -- * Acceptable data
44− -- $replacement
45−
46 -- * Fusion
27 -- * Fusion
47 -- $fusion
28 -- $fusion
48
29
@@ -66,7 +47,6 @@ module Data.Text
66 , init
47 , init
67 , null
48 , null
68 , length
49 , length
69− , compareLength
70
50
71 -- * Transformations
51 -- * Transformations
72 , map
52 , map
@@ -74,19 +54,12 @@ module Data.Text
74 , intersperse
54 , intersperse
75 , transpose
55 , transpose
76 , reverse
56 , reverse
77− , replace
78
57
79− -- ** Case conversion
58+ -- * Case conversion
80 -- $case
59 -- $case
81 , toCaseFold
60 , toCaseFold
82 , toLower
61 , toLower
83 , toUpper
62 , toUpper
84− , toTitle
85−
86− -- ** Justification
87− , justifyLeft
88− , justifyRight
89− , center
90
63
91 -- * Folds
64 -- * Folds
92 , foldl
65 , foldl
@@ -125,32 +98,21 @@ module Data.Text
125
98
126 -- ** Breaking strings
99 -- ** Breaking strings
127 , take
100 , take
128− , takeEnd
129 , drop
101 , drop
130− , dropEnd
131 , takeWhile
102 , takeWhile
132− , takeWhileEnd
133 , dropWhile
103 , dropWhile
134− , dropWhileEnd
135− , dropAround
136− , strip
137− , stripStart
138− , stripEnd
139 , splitAt
104 , splitAt
140− , breakOn
141− , breakOnEnd
142− , break
143 , span
105 , span
106+ , break
144 , group
107 , group
145 , groupBy
108 , groupBy
146 , inits
109 , inits
147 , tails
110 , tails
148
111
149 -- ** Breaking into many substrings
112 -- ** Breaking into many substrings
150− -- $split
151− , splitOn
152 , split
113 , split
153− , chunksOf
114+ , splitWith
115+ , breakSubstring
154
116
155 -- ** Breaking into lines and words
117 -- ** Breaking into lines and words
156 , lines
118 , lines
@@ -164,309 +126,137 @@ module Data.Text
164 , isSuffixOf
126 , isSuffixOf
165 , isInfixOf
127 , isInfixOf
166
128
167− -- ** View patterns
168− , stripPrefix
169− , stripSuffix
170− , commonPrefixes
171−
172 -- * Searching
129 -- * Searching
130+ , elem
173 , filter
131 , filter
174− , breakOnAll
175 , find
132 , find
176 , partition
133 , partition
177
134
178 -- , findSubstring
135 -- , findSubstring
179−
136+
180 -- * Indexing
137 -- * Indexing
181− -- $index
182 , index
138 , index
183 , findIndex
139 , findIndex
140+ , findIndices
141+ , elemIndex
142+ , elemIndices
184 , count
143 , count
185
144
186− -- * Zipping
145+ -- * Zipping and unzipping
187 , zip
146 , zip
188 , zipWith
147 , zipWith
189
148
190 -- -* Ordered text
149 -- -* Ordered text
191 -- , sort
150 -- , sort
192−
193− -- * Low level operations
194− , copy
195− , unpackCString#
196 ) where
151 ) where
197
152
198−import Prelude (Char, Bool(..), Int, Maybe(..), String,
153+import Prelude (Char, Bool(..), Functor(..), Int, Maybe(..), String,
199− Eq(..), Ord(..), Ordering(..), (++),
154+ Eq(..), Ord(..), (++),
200− Read(..),
155+ Read(..), Show(..),
201− (&&), (||), (+), (-), (.), ($), ($!), (>>),
156+ (&&), (||), (+), (-), (.), ($),
202− not, return, otherwise, quot)
157+ not, return, otherwise)
203−#if defined(HAVE_DEEPSEQ)
204−import Control.DeepSeq (NFData(rnf))
205−#endif
206−#if defined(ASSERTS)
207import Control.Exception (assert)
158import Control.Exception (assert)
208−#endif
209import Data.Char (isSpace)
159import Data.Char (isSpace)
210−import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
211− Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
212−import Control.Monad (foldM)
213import Control.Monad.ST (ST)
160import Control.Monad.ST (ST)
214import qualified Data.Text.Array as A
161import qualified Data.Text.Array as A
215import qualified Data.List as L
162import qualified Data.List as L
216−import Data.Binary (Binary(get, put))
217import Data.Monoid (Monoid(..))
163import Data.Monoid (Monoid(..))
218−#if MIN_VERSION_base(4,9,0)
219−import Data.Semigroup (Semigroup(..))
164+import Data.Word (Word16)
220−#endif
221import Data.String (IsString(..))
165import 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#)
229−import qualified Prelude as P
230−import 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)
236−#if defined(__HADDOCK__)
237−import Data.ByteString (ByteString)
238−import qualified Data.Text.Lazy as L
239−import Data.Int (Int64)
240−#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)
247−#endif
248−
249−-- $strict
250−--
251−-- 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
254−-- lazy @Text@ type consists of a list of strict chunks.
255−--
256−-- 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.
264−--
265−-- Each module provides an almost identical API, with the main
266−-- difference being that the strict module uses 'Int' values for
267−-- lengths and counts, while the lazy module uses 'Data.Int.Int64'
268−-- lengths.
269
166
270−-- $replacement
167+import qualified Data.Text.Fusion as S
271−--
168+import qualified Data.Text.Fusion.Common as S
272−-- A 'Text' value is a sequence of Unicode scalar values, as defined
169+import Data.Text.Fusion (stream, reverseStream, unstream)
273−-- in
170+
274−-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35 §3.9, definition D76 of the Unicode 5.2 standard >.
171+import Data.Text.Internal (Text(..), empty, text, textP)
275−-- As such, a 'Text' cannot contain values in the range U+D800 to
172+import qualified Prelude as P
276−-- U+DFFF inclusive. Haskell implementations admit all Unicode code
173+import Data.Text.Unsafe (iter, iter_, unsafeHead, unsafeTail)
277−-- points
174+import Data.Text.UnsafeChar (unsafeChr)
278−-- (<http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=13 §3.4, definition D10 >)
175+import qualified Data.Text.Encoding.Utf16 as U16
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.
283−--
284−-- Within this module, many functions construct a 'Text' from one or
285−-- more 'Char' values. Those functions will substitute 'Char' values
286−-- that are not valid Unicode scalar values with the replacement
287−-- character \"&#xfffd;\" (U+FFFD). Functions that perform this
288−-- inspection and replacement are documented with the phrase
289−-- \"Performs replacement on invalid scalar values\".
290−--
291−-- (One reason for this policy of replacement is that internally, a
292−-- 'Text' value is represented as packed UTF-16 data. Values in the
293−-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate
294−-- code points, and so cannot be represented. The functions replace
295−-- 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 >.)
298
176
299-- $fusion
177-- $fusion
300--
178--
301−-- Most of the functions in this module are subject to /fusion/,
179+-- Most of the functions in this module are subject to /array fusion/,
302−-- meaning that a pipeline of such functions will usually allocate at
180+-- meaning that a pipeline of functions will usually allocate at most
303−-- most one 'Text' value.
181+-- one 'Text' value.
304−--
305−-- As an example, consider the following pipeline:
306−--
307−-- > import Data.Text as T
308−-- > import Data.Text.Encoding as E
309−-- > import Data.ByteString (ByteString)
310−-- >
311−-- > countChars :: ByteString -> Int
312−-- > countChars = T.length . T.toUpper . E.decodeUtf8
313−--
314−-- 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'.
320−--
321−-- Functions that can be fused by the compiler are documented with the
322−-- phrase \"Subject to fusion\".
323
182
324instance Eq Text where
183instance Eq Text where
325− Text arrA offA lenA == Text arrB offB lenB
184+ t1 == t2 = stream t1 == stream t2
326− | lenA == lenB = A.equal arrA offA arrB offB lenA
327− | otherwise = False
328 {-# INLINE (==) #-}
185 {-# INLINE (==) #-}
329
186
330instance Ord Text where
187instance Ord Text where
331− compare = compareText
188+ compare t1 t2 = compare (stream t1) (stream t2)
189+ {-# INLINE compare #-}
190+
191+instance Show Text where
192+ showsPrec p ps r = showsPrec p (unpack ps) r
332
193
333instance Read Text where
194instance Read Text where
334 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
195 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
335
196
336−#if MIN_VERSION_base(4,9,0)
337−-- Semigroup orphan instances for older GHCs are provided by
338−-- 'semigroups` package
339−
340−instance Semigroup Text where
341− (<>) = append
342−#endif
343−
344instance Monoid Text where
197instance Monoid Text where
345 mempty = empty
198 mempty = empty
346−#if MIN_VERSION_base(4,9,0)
347− mappend = (<>) -- future-proof definition
348−#else
349 mappend = append
199 mappend = append
350−#endif
351 mconcat = concat
200 mconcat = concat
352
201
353instance IsString Text where
202instance IsString Text where
354 fromString = pack
203 fromString = pack
355
204
356−#if __GLASGOW_HASKELL__ >= 708
357−instance Exts.IsList Text where
358− type Item Text = Char
359− fromList = pack
360− toList = unpack
361−#endif
362−
363−#if defined(HAVE_DEEPSEQ)
364−instance NFData Text where rnf !_ = ()
365−#endif
366−
367−instance Binary Text where
368− put t = put (encodeUtf8 t)
369− get = do
370− bs <- get
371− case decodeUtf8' bs of
372− P.Left exn -> P.fail (P.show exn)
373− P.Right a -> P.return a
374−
375−-- | This instance preserves data abstraction at the cost of inefficiency.
376−-- We omit reflection services for the sake of data abstraction.
377−--
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.
382−--
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, ... >
389−
390−instance Data Text where
391− 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]
409−
410−-- | /O(n)/ Compare two 'Text' values lexicographically.
411−compareText :: Text -> Text -> Ordering
412−compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)
413− | lenA == 0 && lenB == 0 = EQ
414− | otherwise = go 0 0
415− where
416− go !i !j
417− | i >= lenA || j >= lenB = compare lenA lenB
418− | a < b = LT
419− | a > b = GT
420− | otherwise = go (i+di) (j+dj)
421− where Iter a di = iter ta i
422− Iter b dj = iter tb j
423−
424-- -----------------------------------------------------------------------------
205-- -----------------------------------------------------------------------------
425-- * Conversion to/from 'Text'
206-- * Conversion to/from 'Text'
426
207
427−-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to
208+-- | /O(n)/ Convert a 'String' into a 'Text'.
428−-- fusion. Performs replacement on invalid scalar values.
209+--
210+-- This function is subject to array fusion.
429pack :: String -> Text
211pack :: String -> Text
430−pack = unstream . S.map safe . S.streamList
212+pack = unstream . S.streamList
431{-# INLINE [1] pack #-}
213{-# INLINE [1] pack #-}
432
214
215+-- | /O(n)/ Convert a Text into a String.
216+-- Subject to array fusion.
217+unpack :: Text -> String
218+unpack = S.unstreamList . stream
219+{-# INLINE [1] unpack #-}
220+
221+-- | /O(1)/ Convert a character into a Text.
222+-- Subject to array fusion.
223+singleton :: Char -> Text
224+singleton = unstream . S.singleton
225+{-# INLINE [1] singleton #-}
226+
433-- -----------------------------------------------------------------------------
227-- -----------------------------------------------------------------------------
434-- * Basic functions
228-- * Basic functions
435
229
436-- | /O(n)/ Adds a character to the front of a 'Text'. This function
230-- | /O(n)/ Adds a character to the front of a 'Text'. This function
437-- is more costly than its 'List' counterpart because it requires
231-- is more costly than its 'List' counterpart because it requires
438−-- copying a new array. Subject to fusion. Performs replacement on
232+-- copying a new array. Subject to array fusion.
439−-- invalid scalar values.
440cons :: Char -> Text -> Text
233cons :: Char -> Text -> Text
441−cons c t = unstream (S.cons (safe c) (stream t))
234+cons c t = unstream (S.cons c (stream t))
442{-# INLINE cons #-}
235{-# INLINE cons #-}
443
236
444−infixr 5 `cons`
445−
446-- | /O(n)/ Adds a character to the end of a 'Text'. This copies the
237-- | /O(n)/ Adds a character to the end of a 'Text'. This copies the
447−-- entire array in the process, unless fused. Subject to fusion.
238+-- entire array in the process. Subject to array fusion.
448−-- Performs replacement on invalid scalar values.
449snoc :: Text -> Char -> Text
239snoc :: Text -> Char -> Text
450−snoc t c = unstream (S.snoc (stream t) (safe c))
240+snoc t c = unstream (S.snoc (stream t) c)
451{-# INLINE snoc #-}
241{-# INLINE snoc #-}
452
242
453-- | /O(n)/ Appends one 'Text' to the other by copying both of them
243-- | /O(n)/ Appends one 'Text' to the other by copying both of them
454−-- into a new 'Text'. Subject to fusion.
244+-- into a new 'Text'. Subject to array fusion.
455append :: Text -> Text -> Text
245append :: Text -> Text -> Text
456−append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
246+append (Text arr1 off1 len1) (Text arr2 off2 len2) = Text (A.run x) 0 len
457− | len1 == 0 = b
458− | len2 == 0 = a
459− | len > 0 = Text (A.run x) 0 len
460− | otherwise = overflowError "append"
461 where
247 where
462 len = len1+len2
248 len = len1+len2
463− x :: ST s (A.MArray s)
464 x = do
249 x = do
465− arr <- A.new len
250+ arr <- A.unsafeNew len :: ST s (A.MArray s Word16)
466− A.copyI arr 0 arr1 off1 len1
251+ copy arr1 off1 (len1+off1) arr 0
467− A.copyI arr len1 arr2 off2 len
252+ copy arr2 off2 (len2+off2) arr len1
468 return arr
253 return arr
254+ where
255+ copy arr i top arr' j
256+ | i >= top = return ()
257+ | otherwise = do A.unsafeWrite arr' j (arr `A.unsafeIndex` i)
258+ copy arr (i+1) top arr' (j+1)
469−{-# NOINLINE append #-}
259+{-# INLINE append #-}
470
260
471{-# RULES
261{-# RULES
472"TEXT append -> fused" [~1] forall t1 t2.
262"TEXT append -> fused" [~1] forall t1 t2.
@@ -476,26 +266,33 @@ append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
476 #-}
266 #-}
477
267
478-- | /O(1)/ Returns the first character of a 'Text', which must be
268-- | /O(1)/ Returns the first character of a 'Text', which must be
479−-- non-empty. Subject to fusion.
269+-- non-empty. Subject to array fusion.
480head :: Text -> Char
270head :: Text -> Char
481head t = S.head (stream t)
271head t = S.head (stream t)
482{-# INLINE head #-}
272{-# INLINE head #-}
483
273
484-- | /O(1)/ Returns the first character and rest of a 'Text', or
274-- | /O(1)/ Returns the first character and rest of a 'Text', or
485−-- 'Nothing' if empty. Subject to fusion.
275+-- 'Nothing' if empty. Subject to array fusion.
486uncons :: Text -> Maybe (Char, Text)
276uncons :: Text -> Maybe (Char, Text)
487uncons t@(Text arr off len)
277uncons t@(Text arr off len)
488 | len <= 0 = Nothing
278 | len <= 0 = Nothing
489− | otherwise = Just $ let !(Iter c d) = iter t 0
490− in (c, text arr (off+d) (len-d))
279+ | otherwise = Just (c, textP arr (off+d) (len-d))
280+ where (c,d) = iter t 0
491−{-# INLINE [1] uncons #-}
281+{-# INLINE uncons #-}
492
282
493-- | Lifted from Control.Arrow and specialized.
283-- | Lifted from Control.Arrow and specialized.
494second :: (b -> c) -> (a,b) -> (a,c)
284second :: (b -> c) -> (a,b) -> (a,c)
495second f (a, b) = (a, f b)
285second f (a, b) = (a, f b)
496
286
287+{-# RULES
288+"TEXT uncons -> fused" [~1] forall t.
289+ uncons t = fmap (second unstream) (S.uncons (stream t))
290+"TEXT uncons -> unfused" [1] forall t.
291+ fmap (second unstream) (S.uncons (stream t)) = uncons t
292+ #-}
293+
497-- | /O(1)/ Returns the last character of a 'Text', which must be
294-- | /O(1)/ Returns the last character of a 'Text', which must be
498−-- non-empty. Subject to fusion.
295+-- non-empty. Subject to array fusion.
499last :: Text -> Char
296last :: Text -> Char
500last (Text arr off len)
297last (Text arr off len)
501 | len <= 0 = emptyError "last"
298 | len <= 0 = emptyError "last"
@@ -513,11 +310,11 @@ last (Text arr off len)
513 #-}
310 #-}
514
311
515-- | /O(1)/ Returns all characters after the head of a 'Text', which
312-- | /O(1)/ Returns all characters after the head of a 'Text', which
516−-- must be non-empty. Subject to fusion.
313+-- must be non-empty. Subject to array fusion.
517tail :: Text -> Text
314tail :: Text -> Text
518tail t@(Text arr off len)
315tail t@(Text arr off len)
519 | len <= 0 = emptyError "tail"
316 | len <= 0 = emptyError "tail"
520− | otherwise = text arr (off+d) (len-d)
317+ | otherwise = textP arr (off+d) (len-d)
521 where d = iter_ t 0
318 where d = iter_ t 0
522{-# INLINE [1] tail #-}
319{-# INLINE [1] tail #-}
523
320
@@ -529,11 +326,11 @@ tail t@(Text arr off len)
529 #-}
326 #-}
530
327
531-- | /O(1)/ Returns all but the last character of a 'Text', which must
328-- | /O(1)/ Returns all but the last character of a 'Text', which must
532−-- be non-empty. Subject to fusion.
329+-- be non-empty. Subject to array fusion.
533init :: Text -> Text
330init :: Text -> Text
534init (Text arr off len) | len <= 0 = emptyError "init"
331init (Text arr off len) | len <= 0 = emptyError "init"
535− | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)
332+ | n >= 0xDC00 && n <= 0xDFFF = textP arr off (len-2)
536− | otherwise = text arr off (len-1)
333+ | otherwise = textP arr off (len-1)
537 where
334 where
538 n = A.unsafeIndex arr (off+len-1)
335 n = A.unsafeIndex arr (off+len-1)
539{-# INLINE [1] init #-}
336{-# INLINE [1] init #-}
@@ -545,14 +342,10 @@ init (Text arr off len) | len <= 0 = emptyError "init"
545 unstream (S.init (stream t)) = init t
342 unstream (S.init (stream t)) = init t
546 #-}
343 #-}
547
344
548−-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
345+-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to array
549-- fusion.
346-- fusion.
550null :: Text -> Bool
347null :: Text -> Bool
551−null (Text _arr _off len) =
348+null (Text _arr _off len) = assert (len >= 0) $ len <= 0
552−#if defined(ASSERTS)
553− assert (len >= 0) $
554−#endif
555− len <= 0
556{-# INLINE [1] null #-}
349{-# INLINE [1] null #-}
557
350
558{-# RULES
351{-# RULES
@@ -562,171 +355,53 @@ null (Text _arr _off len) =
562 S.null (stream t) = null t
355 S.null (stream t) = null t
563 #-}
356 #-}
564
357
565−-- | /O(1)/ Tests whether a 'Text' contains exactly one character.
566−-- Subject to fusion.
567−isSingleton :: Text -> Bool
568−isSingleton = S.isSingleton . stream
569−{-# INLINE isSingleton #-}
570−
571-- | /O(n)/ Returns the number of characters in a 'Text'.
358-- | /O(n)/ Returns the number of characters in a 'Text'.
572−-- Subject to fusion.
359+-- Subject to array fusion.
573length :: Text -> Int
360length :: Text -> Int
574length t = S.length (stream t)
361length t = S.length (stream t)
575−{-# INLINE [0] length #-}
362+{-# INLINE length #-}
576−-- length needs to be phased after the compareN/length rules otherwise
577−-- it may inline before the rules have an opportunity to fire.
578−
579−-- | /O(n)/ Compare the count of characters in a 'Text' to a number.
580−-- Subject to fusion.
581−--
582−-- This function gives the same answer as comparing against the result
583−-- of 'length', but can short circuit if the count of characters is
584−-- greater than the number, and hence be more efficient.
585−compareLength :: Text -> Int -> Ordering
586−compareLength t n = S.compareLengthI (stream t) n
587−{-# INLINE [1] compareLength #-}
588−
589−{-# RULES
590−"TEXT compareN/length -> compareLength" [~1] forall t n.
591− compare (length t) n = compareLength t n
592− #-}
593−
594−{-# RULES
595−"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.
596− eqInt (length t) n = compareLength t n == EQ
597− #-}
598−
599−{-# RULES
600−"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.
601− neInt (length t) n = compareLength t n /= EQ
602− #-}
603−
604−{-# RULES
605−"TEXT <N/length -> compareLength/==LT" [~1] forall t n.
606− ltInt (length t) n = compareLength t n == LT
607− #-}
608−
609−{-# RULES
610−"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.
611− leInt (length t) n = compareLength t n /= GT
612− #-}
613−
614−{-# RULES
615−"TEXT >N/length -> compareLength/==GT" [~1] forall t n.
616− gtInt (length t) n = compareLength t n == GT
617− #-}
618−
619−{-# RULES
620−"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.
621− geInt (length t) n = compareLength t n /= LT
622− #-}
623
363
624-- -----------------------------------------------------------------------------
364-- -----------------------------------------------------------------------------
625-- * Transformations
365-- * Transformations
626−-- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to
366+-- | /O(n)/ 'map' @f @xs is the 'Text' obtained by applying @f@ to
627−-- each element of @t@. Subject to fusion. Performs replacement on
367+-- each element of @xs@. Subject to array fusion.
628−-- invalid scalar values.
629map :: (Char -> Char) -> Text -> Text
368map :: (Char -> Char) -> Text -> Text
630−map f t = unstream (S.map (safe . f) (stream t))
369+map f t = unstream (S.map f (stream t))
631{-# INLINE [1] map #-}
370{-# INLINE [1] map #-}
632
371
633-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of
372-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of
634-- 'Text's and concatenates the list after interspersing the first
373-- 'Text's and concatenates the list after interspersing the first
635-- argument between each element of the list.
374-- argument between each element of the list.
636intercalate :: Text -> [Text] -> Text
375intercalate :: Text -> [Text] -> Text
637−intercalate t = concat . (F.intersperse t)
376+intercalate t ts = unstream (S.intercalate (stream t) (L.map stream ts))
638{-# INLINE intercalate #-}
377{-# INLINE intercalate #-}
639
378
640-- | /O(n)/ The 'intersperse' function takes a character and places it
379-- | /O(n)/ The 'intersperse' function takes a character and places it
641−-- between the characters of a 'Text'. Subject to fusion. Performs
380+-- between the characters of a 'Text'. Subject to array fusion.
642−-- replacement on invalid scalar values.
643intersperse :: Char -> Text -> Text
381intersperse :: Char -> Text -> Text
644−intersperse c t = unstream (S.intersperse (safe c) (stream t))
382+intersperse c t = unstream (S.intersperse c (stream t))
645{-# INLINE intersperse #-}
383{-# INLINE intersperse #-}
646
384
647−-- | /O(n)/ Reverse the characters of a string. Subject to fusion.
385+-- | /O(n)/ Reverse the characters of a string. Subject to array fusion.
648reverse :: Text -> Text
386reverse :: Text -> Text
649reverse t = S.reverse (stream t)
387reverse t = S.reverse (stream t)
650{-# INLINE reverse #-}
388{-# INLINE reverse #-}
651
389
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"
672−--
673−-- In (unlikely) bad cases, this function's time complexity degrades
674−-- 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
683−replace needle@(Text _ _ neeLen)
684− (Text repArr repOff repLen)
685− haystack@(Text hayArr hayOff hayLen)
686− | neeLen == 0 = emptyError "replace"
687− | L.null ixs = haystack
688− | len > 0 = Text (A.run x) 0 len
689− | otherwise = empty
690− where
691− ixs = indices needle haystack
692− len = hayLen - (neeLen - repLen) `mul` L.length ixs
693− x :: ST s (A.MArray s)
694− x = do
695− marr <- A.new len
696− let loop (i:is) o d = do
697− let d0 = d + i - o
698− d1 = d0 + repLen
699− A.copyI marr d hayArr (hayOff+o) d0
700− A.copyI marr d0 repArr repOff d1
701− loop is (i + neeLen) d1
702− loop [] o d = A.copyI marr d hayArr (hayOff+o) len
703− loop ixs 0 0
704− return marr
705−
706-- ----------------------------------------------------------------------------
390-- ----------------------------------------------------------------------------
707-- ** Case conversions (folds)
391-- ** Case conversions (folds)
708
392
709-- $case
393-- $case
710--
394--
711−-- When case converting 'Text' values, do not use combinators like
395+-- With Unicode text, it is incorrect to use combinators like @map
712−-- @map toUpper@ to case convert each character of a string
396+-- toUpper@ to case convert each character of a string individually.
713−-- individually, as this gives incorrect results according to the
397+-- Instead, use the whole-string case conversion functions from this
714−-- rules of some writing systems. The whole-string case conversion
398+-- module. For correctness in different writing systems, these
715−-- functions from this module, such as @toUpper@, obey the correct
716−-- case conversion rules. As a result, these functions may map one
717−-- input character to two or three output characters. For examples,
399+-- functions may map one input character to two or three output
718−-- see the documentation of each function.
400+-- characters.
719−--
720−-- /Note/: In some languages, case conversion is a locale- and
721−-- context-dependent operation. The case conversion functions in this
722−-- 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 >.
725
401
726−-- | /O(n)/ Convert a string to folded case. Subject to fusion.
402+-- | /O(n)/ Convert a string to folded case. This function is mainly
727−--
728−-- This function is mainly useful for performing caseless (also known
403+-- useful for performing caseless (or case insensitive) string
729−-- as case insensitive) string comparisons.
404+-- comparisons.
730--
405--
731-- A string @x@ is a caseless match for a string @y@ if and only if:
406-- A string @x@ is a caseless match for a string @y@ if and only if:
732--
407--
@@ -734,112 +409,31 @@ replace needle@(Text _ _ neeLen)
734--
409--
735-- The result string may be longer than the input string, and may
410-- The result string may be longer than the input string, and may
736-- differ from applying 'toLower' to the input string. For instance,
411-- differ from applying 'toLower' to the input string. For instance,
737−-- the Armenian small ligature \"&#xfb13;\" (men now, U+FB13) is case
412+-- the Armenian small ligature men now (U+FB13) is case folded to the
738−-- folded to the sequence \"&#x574;\" (men, U+0574) followed by
739−-- \"&#x576;\" (now, U+0576), while the Greek \"&#xb5;\" (micro sign,
413+-- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is
740−-- U+00B5) is case folded to \"&#x3bc;\" (small letter mu, U+03BC)
414+-- case folded to the Greek small letter letter mu (U+03BC) instead of
741−-- instead of itself.
415+-- itself.
742toCaseFold :: Text -> Text
416toCaseFold :: Text -> Text
743toCaseFold t = unstream (S.toCaseFold (stream t))
417toCaseFold t = unstream (S.toCaseFold (stream t))
744−{-# INLINE toCaseFold #-}
418+{-# INLINE [0] toCaseFold #-}
745
419
746-- | /O(n)/ Convert a string to lower case, using simple case
420-- | /O(n)/ Convert a string to lower case, using simple case
747−-- conversion. Subject to fusion.
748−--
749−-- The result string may be longer than the input string. For
421+-- conversion. The result string may be longer than the input string.
750−-- instance, \"&#x130;\" (Latin capital letter I with dot above,
422+-- For instance, the Latin capital letter I with dot above (U+0130)
751−-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)
423+-- maps to the bigram Latin small letter i (U+0069) followed by
752−-- followed by \" &#x307;\" (combining dot above, U+0307).
424+-- combining dot above (U+0307).
753toLower :: Text -> Text
425toLower :: Text -> Text
754toLower t = unstream (S.toLower (stream t))
426toLower t = unstream (S.toLower (stream t))
755{-# INLINE toLower #-}
427{-# INLINE toLower #-}
756
428
757-- | /O(n)/ Convert a string to upper case, using simple case
429-- | /O(n)/ Convert a string to upper case, using simple case
758−-- conversion. Subject to fusion.
759−--
760−-- The result string may be longer than the input string. For
430+-- conversion. The result string may be longer than the input string.
761−-- instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the
431+-- For instance, the German eszett (U+00DF) maps to the two-letter
762−-- two-letter sequence \"SS\".
432+-- sequence SS.
763toUpper :: Text -> Text
433toUpper :: Text -> Text
764toUpper t = unstream (S.toUpper (stream t))
434toUpper t = unstream (S.toUpper (stream t))
765{-# INLINE toUpper #-}
435{-# INLINE toUpper #-}
766
436
767−-- | /O(n)/ Convert a string to title case, using simple case
768−-- conversion. Subject to fusion.
769−--
770−-- The first letter of the input is converted to title case, as is
771−-- every subsequent letter that immediately follows a non-letter.
772−-- Every letter that immediately follows another letter is converted
773−-- to lower case.
774−--
775−-- The result string may be longer than the input string. For example,
776−-- the Latin small ligature &#xfb02; (U+FB02) is converted to the
777−-- sequence Latin capital letter F (U+0046) followed by Latin small
778−-- letter l (U+006C).
779−--
780−-- /Note/: this function does not take language or culture specific
781−-- rules into account. For instance, in English, different style
782−-- guides disagree on whether the book name \"The Hill of the Red
783−-- Fox\" is correctly title cased&#x2014;but this function will
784−-- capitalize /every/ word.
785−toTitle :: Text -> Text
786−toTitle t = unstream (S.toTitle (stream t))
787−{-# INLINE toTitle #-}
788−
789−-- | /O(n)/ Left-justify a string to the given length, using the
790−-- specified fill character on the right. Subject to fusion.
791−-- Performs replacement on invalid scalar values.
792−--
793−-- Examples:
794−--
795−-- > justifyLeft 7 'x' "foo" == "fooxxxx"
796−-- > justifyLeft 3 'x' "foobar" == "foobar"
797−justifyLeft :: Int -> Char -> Text -> Text
798−justifyLeft k c t
799− | len >= k = t
800− | otherwise = t `append` replicateChar (k-len) c
801− where len = length t
802−{-# INLINE [1] justifyLeft #-}
803−
804−{-# RULES
805−"TEXT justifyLeft -> fused" [~1] forall k c t.
806− justifyLeft k c t = unstream (S.justifyLeftI k c (stream t))
807−"TEXT justifyLeft -> unfused" [1] forall k c t.
808− unstream (S.justifyLeftI k c (stream t)) = justifyLeft k c t
809− #-}
810−
811−-- | /O(n)/ Right-justify a string to the given length, using the
812−-- specified fill character on the left. Performs replacement on
813−-- invalid scalar values.
814−--
815−-- Examples:
816−--
817−-- > justifyRight 7 'x' "bar" == "xxxxbar"
818−-- > justifyRight 3 'x' "foobar" == "foobar"
819−justifyRight :: Int -> Char -> Text -> Text
820−justifyRight k c t
821− | len >= k = t
822− | otherwise = replicateChar (k-len) c `append` t
823− where len = length t
824−{-# INLINE justifyRight #-}
825−
826−-- | /O(n)/ Center a string to the given length, using the specified
827−-- fill character on either side. Performs replacement on invalid
828−-- scalar values.
829−--
830−-- Examples:
831−--
832−-- > center 8 'x' "HS" = "xxxHSxxx"
833−center :: Int -> Char -> Text -> Text
834−center k c t
835− | len >= k = t
836− | otherwise = replicateChar l c `append` t `append` replicateChar r c
837− where len = length t
838− d = k - len
839− r = d `quot` 2
840− l = d - r
841−{-# INLINE center #-}
842−
843-- | /O(n)/ The 'transpose' function transposes the rows and columns
437-- | /O(n)/ The 'transpose' function transposes the rows and columns
844-- of its 'Text' argument. Note that this function uses 'pack',
438-- of its 'Text' argument. Note that this function uses 'pack',
845-- 'unpack', and the list version of transpose, and is thus not very
439-- 'unpack', and the list version of transpose, and is thus not very
@@ -853,23 +447,26 @@ transpose ts = P.map pack (L.transpose (P.map unpack ts))
853-- | /O(n)/ 'foldl', applied to a binary operator, a starting value
447-- | /O(n)/ 'foldl', applied to a binary operator, a starting value
854-- (typically the left-identity of the operator), and a 'Text',
448-- (typically the left-identity of the operator), and a 'Text',
855-- reduces the 'Text' using the binary operator, from left to right.
449-- reduces the 'Text' using the binary operator, from left to right.
856−-- Subject to fusion.
450+-- Subject to array fusion.
857−foldl :: (a -> Char -> a) -> a -> Text -> a
451+foldl :: (b -> Char -> b) -> b -> Text -> b
858foldl f z t = S.foldl f z (stream t)
452foldl f z t = S.foldl f z (stream t)
859{-# INLINE foldl #-}
453{-# INLINE foldl #-}
860
454
861−-- | /O(n)/ A strict version of 'foldl'. Subject to fusion.
455+-- | /O(n)/ A strict version of 'foldl'.
456+-- Subject to array fusion.
862−foldl' :: (a -> Char -> a) -> a -> Text -> a
457+foldl' :: (b -> Char -> b) -> b -> Text -> b
863foldl' f z t = S.foldl' f z (stream t)
458foldl' f z t = S.foldl' f z (stream t)
864{-# INLINE foldl' #-}
459{-# INLINE foldl' #-}
865
460
866-- | /O(n)/ A variant of 'foldl' that has no starting value argument,
461-- | /O(n)/ A variant of 'foldl' that has no starting value argument,
867−-- and thus must be applied to a non-empty 'Text'. Subject to fusion.
462+-- and thus must be applied to a non-empty 'Text'. Subject to array
463+-- fusion.
868foldl1 :: (Char -> Char -> Char) -> Text -> Char
464foldl1 :: (Char -> Char -> Char) -> Text -> Char
869foldl1 f t = S.foldl1 f (stream t)
465foldl1 f t = S.foldl1 f (stream t)
870{-# INLINE foldl1 #-}
466{-# INLINE foldl1 #-}
871
467
872−-- | /O(n)/ A strict version of 'foldl1'. Subject to fusion.
468+-- | /O(n)/ A strict version of 'foldl1'.
469+-- Subject to array fusion.
873foldl1' :: (Char -> Char -> Char) -> Text -> Char
470foldl1' :: (Char -> Char -> Char) -> Text -> Char
874foldl1' f t = S.foldl1' f (stream t)
471foldl1' f t = S.foldl1' f (stream t)
875{-# INLINE foldl1' #-}
472{-# INLINE foldl1' #-}
@@ -877,13 +474,13 @@ foldl1' f t = S.foldl1' f (stream t)
877-- | /O(n)/ 'foldr', applied to a binary operator, a starting value
474-- | /O(n)/ 'foldr', applied to a binary operator, a starting value
878-- (typically the right-identity of the operator), and a 'Text',
475-- (typically the right-identity of the operator), and a 'Text',
879-- reduces the 'Text' using the binary operator, from right to left.
476-- reduces the 'Text' using the binary operator, from right to left.
880−-- Subject to fusion.
477+-- Subject to array fusion.
881−foldr :: (Char -> a -> a) -> a -> Text -> a
478+foldr :: (Char -> b -> b) -> b -> Text -> b
882foldr f z t = S.foldr f z (stream t)
479foldr f z t = S.foldr f z (stream t)
883{-# INLINE foldr #-}
480{-# INLINE foldr #-}
884
481
885−-- | /O(n)/ A variant of 'foldr' that has no starting value argument,
482+-- | /O(n)/ A variant of 'foldr' that has no starting value argument, and
886−-- and thus must be applied to a non-empty 'Text'. Subject to
483+-- thust must be applied to a non-empty 'Text'. Subject to array
887-- fusion.
484-- fusion.
888foldr1 :: (Char -> Char -> Char) -> Text -> Char
485foldr1 :: (Char -> Char -> Char) -> Text -> Char
889foldr1 f t = S.foldr1 f (stream t)
486foldr1 f t = S.foldr1 f (stream t)
@@ -892,48 +489,40 @@ foldr1 f t = S.foldr1 f (stream t)
892-- -----------------------------------------------------------------------------
489-- -----------------------------------------------------------------------------
893-- ** Special folds
490-- ** Special folds
894
491
895−-- | /O(n)/ Concatenate a list of 'Text's.
492+-- | /O(n)/ Concatenate a list of 'Text's. Subject to array fusion.
896concat :: [Text] -> Text
493concat :: [Text] -> Text
897−concat ts = case ts' of
494+concat ts = unstream (S.concat (L.map stream ts))
898− [] -> empty
495+{-# INLINE concat #-}
899− [t] -> t
900− _ -> Text (A.run go) 0 len
901− where
902− ts' = L.filter (not . null) ts
903− len = sumP "concat" $ L.map lengthWord16 ts'
904− go :: ST s (A.MArray s)
905− go = do
906− arr <- A.new len
907− let step i (Text a o l) =
908− let !j = i + l in A.copyI arr i a o j >> return j
909− foldM step 0 ts' >> return arr
910
496
911-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and
497-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and
912−-- concatenate the results.
498+-- concatenate the results. This function is subject to array fusion.
499+--
500+-- Note: if in 'concatMap' @f@ @t@, @f@ is defined in terms of fusible
501+-- functions, it will also be fusible.
913concatMap :: (Char -> Text) -> Text -> Text
502concatMap :: (Char -> Text) -> Text -> Text
914−concatMap f = concat . foldr ((:) . f) []
503+concatMap f t = unstream (S.concatMap (stream . f) (stream t))
915{-# INLINE concatMap #-}
504{-# INLINE concatMap #-}
916
505
917-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
506-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
918−-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
507+-- 'Text' @t@ satisifes the predicate @p@. Subject to array fusion.
919any :: (Char -> Bool) -> Text -> Bool
508any :: (Char -> Bool) -> Text -> Bool
920any p t = S.any p (stream t)
509any p t = S.any p (stream t)
921{-# INLINE any #-}
510{-# INLINE any #-}
922
511
923-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
512-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
924−-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
513+-- 'Text' @t@ satisify the predicate @p@. Subject to array fusion.
925all :: (Char -> Bool) -> Text -> Bool
514all :: (Char -> Bool) -> Text -> Bool
926all p t = S.all p (stream t)
515all p t = S.all p (stream t)
927{-# INLINE all #-}
516{-# INLINE all #-}
928
517
929-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which
518-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which
930−-- must be non-empty. Subject to fusion.
519+-- must be non-empty. Subject to array fusion.
931maximum :: Text -> Char
520maximum :: Text -> Char
932maximum t = S.maximum (stream t)
521maximum t = S.maximum (stream t)
933{-# INLINE maximum #-}
522{-# INLINE maximum #-}
934
523
935-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which
524-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which
936−-- must be non-empty. Subject to fusion.
525+-- must be non-empty. Subject to array fusion.
937minimum :: Text -> Char
526minimum :: Text -> Char
938minimum t = S.minimum (stream t)
527minimum t = S.minimum (stream t)
939{-# INLINE minimum #-}
528{-# INLINE minimum #-}
@@ -942,8 +531,8 @@ minimum t = S.minimum (stream t)
942-- * Building 'Text's
531-- * Building 'Text's
943
532
944-- | /O(n)/ 'scanl' is similar to 'foldl', but returns a list of
533-- | /O(n)/ 'scanl' is similar to 'foldl', but returns a list of
945−-- successive reduced values from the left. Subject to fusion.
534+-- successive reduced values from the left. This function is subject
946−-- Performs replacement on invalid scalar values.
535+-- to array fusion.
947--
536--
948-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
537-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
949--
538--
@@ -951,13 +540,11 @@ minimum t = S.minimum (stream t)
951--
540--
952-- > last (scanl f z xs) == foldl f z xs.
541-- > last (scanl f z xs) == foldl f z xs.
953scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
542scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
954−scanl f z t = unstream (S.scanl g z (stream t))
543+scanl f z t = unstream (S.scanl f z (stream t))
955− where g a b = safe (f a b)
956{-# INLINE scanl #-}
544{-# INLINE scanl #-}
957
545
958-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting
546-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting
959−-- value argument. Subject to fusion. Performs replacement on
547+-- value argument. This function is subject to array fusion.
960−-- invalid scalar values.
961--
548--
962-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
549-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
963scanl1 :: (Char -> Char -> Char) -> Text -> Text
550scanl1 :: (Char -> Char -> Char) -> Text -> Text
@@ -965,75 +552,49 @@ scanl1 f t | null t = empty
965 | otherwise = scanl f (unsafeHead t) (unsafeTail t)
552 | otherwise = scanl f (unsafeHead t) (unsafeTail t)
966{-# INLINE scanl1 #-}
553{-# INLINE scanl1 #-}
967
554
968−-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'. Performs
555+-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'.
969−-- replacement on invalid scalar values.
970--
556--
971-- > scanr f v == reverse . scanl (flip f) v . reverse
557-- > scanr f v == reverse . scanl (flip f) v . reverse
972scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
558scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
973−scanr f z = S.reverse . S.reverseScanr g z . reverseStream
559+scanr f z = S.reverse . S.reverseScanr f z . reverseStream
974− where g a b = safe (f a b)
975{-# INLINE scanr #-}
560{-# INLINE scanr #-}
976
561
977-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting
562-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting
978−-- value argument. Subject to fusion. Performs replacement on
563+-- value argument. This function is subject to array fusion.
979−-- invalid scalar values.
980scanr1 :: (Char -> Char -> Char) -> Text -> Text
564scanr1 :: (Char -> Char -> Char) -> Text -> Text
981scanr1 f t | null t = empty
565scanr1 f t | null t = empty
982 | otherwise = scanr f (last t) (init t)
566 | otherwise = scanr f (last t) (init t)
983{-# INLINE scanr1 #-}
567{-# INLINE scanr1 #-}
984
568
985−-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
569+-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a
986-- function to each element of a 'Text', passing an accumulating
570-- function to each element of a 'Text', passing an accumulating
987−-- parameter from left to right, and returns a final 'Text'. Performs
571+-- parameter from left to right, and returns a final 'Text'.
988−-- replacement on invalid scalar values.
989mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
572mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
990−mapAccumL f z0 = S.mapAccumL g z0 . stream
573+mapAccumL f s t = case uncons t of
991− where g a b = second safe (f a b)
574+ Nothing -> (s, empty)
575+ Just (x, xs) -> (s'', cons y ys)
576+ where (s', y ) = f s x
992−{-# INLINE mapAccumL #-}
577+ (s'',ys) = mapAccumL f s' xs
993
578
994-- | The 'mapAccumR' function behaves like a combination of 'map' and
579-- | The 'mapAccumR' function behaves like a combination of 'map' and
995−-- a strict 'foldr'; it applies a function to each element of a
580+-- 'foldr'; it applies a function to each element of a 'Text', passing
996−-- 'Text', passing an accumulating parameter from right to left, and
581+-- an accumulating parameter from right to left, and returning a final
997−-- returning a final value of this accumulator together with the new
582+-- value of this accumulator together with the new 'Text'.
998−-- 'Text'.
999−-- Performs replacement on invalid scalar values.
1000mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
583mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
1001−mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream
584+mapAccumR f s t = case uncons t of
1002− where g a b = second safe (f a b)
585+ Nothing -> (s, empty)
586+ Just (x, xs) -> (s'', cons y ys)
587+ where (s'',y ) = f s' x
1003−{-# INLINE mapAccumR #-}
588+ (s', ys) = mapAccumR f s xs
1004
589
1005-- -----------------------------------------------------------------------------
590-- -----------------------------------------------------------------------------
1006-- ** Generating and unfolding 'Text's
591-- ** Generating and unfolding 'Text's
1007
592
1008−-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
1009−-- @t@ repeated @n@ times.
1010−replicate :: Int -> Text -> Text
1011−replicate n t@(Text a o l)
1012− | n <= 0 || l <= 0 = empty
1013− | n == 1 = t
1014− | isSingleton t = replicateChar n (unsafeHead t)
1015− | otherwise = Text (A.run x) 0 len
1016− where
1017− len = l `mul` n
1018− x :: ST s (A.MArray s)
1019− x = do
1020− arr <- A.new len
1021− let loop !d !i | i >= n = return arr
1022− | otherwise = let m = d + l
1023− in A.copyI arr d a o m >> loop m (i+1)
1024− loop 0 0
1025−{-# INLINE [1] replicate #-}
1026−
1027−{-# RULES
1028−"TEXT replicate/singleton -> replicateChar" [~1] forall n c.
1029− replicate n (singleton c) = replicateChar n c
1030− #-}
1031−
1032−-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
593+-- | /O(n)/ 'replicate' @n@ @c@ is a 'Text' of length @n@ with @c@ the
1033-- value of every element. Subject to fusion.
594-- value of every element. Subject to fusion.
1034−replicateChar :: Int -> Char -> Text
595+replicate :: Int -> Char -> Text
1035−replicateChar n c = unstream (S.replicateCharI n (safe c))
596+replicate n c = unstream (S.replicate n c)
1036−{-# INLINE replicateChar #-}
597+{-# INLINE replicate #-}
1037
598
1038-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'
599-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'
1039-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a
600-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a
@@ -1041,9 +602,9 @@ replicateChar n c = unstream (S.replicateCharI n (safe c))
1041-- returns 'Nothing' if it is done producing the 'Text', otherwise
602-- returns 'Nothing' if it is done producing the 'Text', otherwise
1042-- 'Just' @(a,b)@. In this case, @a@ is the next 'Char' in the
603-- 'Just' @(a,b)@. In this case, @a@ is the next 'Char' in the
1043-- string, and @b@ is the seed value for further production. Subject
604-- string, and @b@ is the seed value for further production. Subject
1044−-- to fusion. Performs replacement on invalid scalar values.
605+-- to fusion.
1045unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
606unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
1046−unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
607+unfoldr f s = unstream (S.unfoldr f s)
1047{-# INLINE unfoldr #-}
608{-# INLINE unfoldr #-}
1048
609
1049-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed
610-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed
@@ -1051,9 +612,9 @@ unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
1051-- first argument to 'unfoldrN'. This function is more efficient than
612-- first argument to 'unfoldrN'. This function is more efficient than
1052-- 'unfoldr' when the maximum length of the result is known and
613-- 'unfoldr' when the maximum length of the result is known and
1053-- correct, otherwise its performance is similar to 'unfoldr'. Subject
614-- correct, otherwise its performance is similar to 'unfoldr'. Subject
1054−-- to fusion. Performs replacement on invalid scalar values.
615+-- to fusion.
1055unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text
616unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text
1056−unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)
617+unfoldrN n f s = unstream (S.unfoldrN n f s)
1057{-# INLINE unfoldrN #-}
618{-# INLINE unfoldrN #-}
1058
619
1059-- -----------------------------------------------------------------------------
620-- -----------------------------------------------------------------------------
@@ -1066,16 +627,14 @@ take :: Int -> Text -> Text
1066take n t@(Text arr off len)
627take n t@(Text arr off len)
1067 | n <= 0 = empty
628 | n <= 0 = empty
1068 | n >= len = t
629 | n >= len = t
1069− | otherwise = text arr off (iterN n t)
630+ | otherwise = Text arr off (loop 0 0)
631+ where
632+ loop !i !cnt
633+ | i >= len || cnt >= n = i
634+ | otherwise = loop (i+d) (cnt+1)
635+ where d = iter_ t i
1070{-# INLINE [1] take #-}
636{-# INLINE [1] take #-}
1071
637
1072−iterN :: Int -> Text -> Int
1073−iterN n t@(Text _arr _off len) = loop 0 0
1074− where loop !i !cnt
1075− | i >= len || cnt >= n = i
1076− | otherwise = loop (i+d) (cnt+1)
1077− where d = iter_ t i
1078−
1079{-# RULES
638{-# RULES
1080"TEXT take -> fused" [~1] forall n t.
639"TEXT take -> fused" [~1] forall n t.
1081 take n t = unstream (S.take n (stream t))
640 take n t = unstream (S.take n (stream t))
@@ -1083,36 +642,18 @@ iterN n t@(Text _arr _off len) = loop 0 0
1083 unstream (S.take n (stream t)) = take n t
642 unstream (S.take n (stream t)) = take n t
1084 #-}
643 #-}
1085
644
1086−-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after
1087−-- taking @n@ characters from the end of @t@.
1088−--
1089−-- Examples:
1090−--
1091−-- > takeEnd 3 "foobar" == "bar"
1092−takeEnd :: Int -> Text -> Text
1093−takeEnd n t@(Text arr off len)
1094− | n <= 0 = empty
1095− | n >= len = t
1096− | otherwise = text arr (off+i) (len-i)
1097− where i = iterNEnd n t
1098−
1099−iterNEnd :: Int -> Text -> Int
1100−iterNEnd n t@(Text _arr _off len) = loop (len-1) n
1101− where loop i !m
1102− | i <= 0 = 0
1103− | m <= 1 = i
1104− | otherwise = loop (i+d) (m-1)
1105− where d = reverseIter_ t i
1106−
1107-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
645-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1108−-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
646+-- 'Text' of length @n@, or the empty 'Text' if @n@ is greater than the
1109−-- is greater than the length of the 'Text'. Subject to fusion.
647+-- length of the 'Text'. Subject to fusion.
1110drop :: Int -> Text -> Text
648drop :: Int -> Text -> Text
1111drop n t@(Text arr off len)
649drop n t@(Text arr off len)
1112 | n <= 0 = t
650 | n <= 0 = t
1113 | n >= len = empty
651 | n >= len = empty
1114− | otherwise = text arr (off+i) (len-i)
652+ | otherwise = loop 0 0
1115− where i = iterN n t
653+ where loop !i !cnt
654+ | i >= len || cnt >= n = Text arr (off+i) (len-i)
655+ | otherwise = loop (i+d) (cnt+1)
656+ where d = iter_ t i
1116{-# INLINE [1] drop #-}
657{-# INLINE [1] drop #-}
1117
658
1118{-# RULES
659{-# RULES
@@ -1122,27 +663,15 @@ drop n t@(Text arr off len)
1122 unstream (S.drop n (stream t)) = drop n t
663 unstream (S.drop n (stream t)) = drop n t
1123 #-}
664 #-}
1124
665
1125−-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after
1126−-- dropping @n@ characters from the end of @t@.
1127−--
1128−-- Examples:
1129−--
1130−-- > dropEnd 3 "foobar" == "foo"
1131−dropEnd :: Int -> Text -> Text
1132−dropEnd n t@(Text arr off len)
1133− | n <= 0 = t
1134− | n >= len = empty
1135− | otherwise = text arr off (iterNEnd n t)
1136−
1137−-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
666+-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text', returns
1138−-- returns the longest prefix (possibly empty) of elements that
667+-- the longest prefix (possibly empty) of elements that satisfy @p@.
1139−-- satisfy @p@. Subject to fusion.
668+-- This function is subject to array fusion.
1140takeWhile :: (Char -> Bool) -> Text -> Text
669takeWhile :: (Char -> Bool) -> Text -> Text
1141takeWhile p t@(Text arr off len) = loop 0
670takeWhile p t@(Text arr off len) = loop 0
1142 where loop !i | i >= len = t
671 where loop !i | i >= len = t
1143 | p c = loop (i+d)
672 | p c = loop (i+d)
1144− | otherwise = text arr off i
673+ | otherwise = textP arr off i
1145− where Iter c d = iter t i
674+ where (c,d) = iter t i
1146{-# INLINE [1] takeWhile #-}
675{-# INLINE [1] takeWhile #-}
1147
676
1148{-# RULES
677{-# RULES
@@ -1152,35 +681,14 @@ takeWhile p t@(Text arr off len) = loop 0
1152 unstream (S.takeWhile p (stream t)) = takeWhile p t
681 unstream (S.takeWhile p (stream t)) = takeWhile p t
1153 #-}
682 #-}
1154
683
1155−-- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',
1156−-- returns the longest suffix (possibly empty) of elements that
1157−-- satisfy @p@. Subject to fusion.
1158−-- Examples:
1159−--
1160−-- > takeWhileEnd (=='o') "foo" == "oo"
1161−takeWhileEnd :: (Char -> Bool) -> Text -> Text
1162−takeWhileEnd p t@(Text arr off len) = loop (len-1) len
1163− where loop !i !l | l <= 0 = t
1164− | p c = loop (i+d) (l+d)
1165− | otherwise = text arr (off+l) (len-l)
1166− where (c,d) = reverseIter t i
1167−{-# INLINE [1] takeWhileEnd #-}
1168−
1169−{-# RULES
1170−"TEXT takeWhileEnd -> fused" [~1] forall p t.
1171− takeWhileEnd p t = S.reverse (S.takeWhile p (S.reverseStream t))
1172−"TEXT takeWhileEnd -> unfused" [1] forall p t.
1173− S.reverse (S.takeWhile p (S.reverseStream t)) = takeWhileEnd p t
1174− #-}
1175−
1176−-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
684+-- | /O(n)/ 'dropWhile' @p@ @xs@ returns the suffix remaining after
1177−-- 'takeWhile' @p@ @t@. Subject to fusion.
685+-- 'takeWhile' @p@ @xs@. This function is subject to array fusion.
1178dropWhile :: (Char -> Bool) -> Text -> Text
686dropWhile :: (Char -> Bool) -> Text -> Text
1179dropWhile p t@(Text arr off len) = loop 0 0
687dropWhile p t@(Text arr off len) = loop 0 0
1180 where loop !i !l | l >= len = empty
688 where loop !i !l | l >= len = empty
1181 | p c = loop (i+d) (l+d)
689 | p c = loop (i+d) (l+d)
1182 | otherwise = Text arr (off+i) (len-l)
690 | otherwise = Text arr (off+i) (len-l)
1183− where Iter c d = iter t i
691+ where (c,d) = iter t i
1184{-# INLINE [1] dropWhile #-}
692{-# INLINE [1] dropWhile #-}
1185
693
1186{-# RULES
694{-# RULES
@@ -1190,57 +698,6 @@ dropWhile p t@(Text arr off len) = loop 0 0
1190 unstream (S.dropWhile p (stream t)) = dropWhile p t
698 unstream (S.dropWhile p (stream t)) = dropWhile p t
1191 #-}
699 #-}
1192
700
1193−-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1194−-- dropping characters that satisfy the predicate @p@ from the end of
1195−-- @t@. Subject to fusion.
1196−--
1197−-- Examples:
1198−--
1199−-- > dropWhileEnd (=='.') "foo..." == "foo"
1200−dropWhileEnd :: (Char -> Bool) -> Text -> Text
1201−dropWhileEnd p t@(Text arr off len) = loop (len-1) len
1202− where loop !i !l | l <= 0 = empty
1203− | p c = loop (i+d) (l+d)
1204− | otherwise = Text arr off l
1205− where (c,d) = reverseIter t i
1206−{-# INLINE [1] dropWhileEnd #-}
1207−
1208−{-# RULES
1209−"TEXT dropWhileEnd -> fused" [~1] forall p t.
1210− dropWhileEnd p t = S.reverse (S.dropWhile p (S.reverseStream t))
1211−"TEXT dropWhileEnd -> unfused" [1] forall p t.
1212− S.reverse (S.dropWhile p (S.reverseStream t)) = dropWhileEnd p t
1213− #-}
1214−
1215−-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1216−-- dropping characters that satisfy the predicate @p@ from both the
1217−-- beginning and end of @t@. Subject to fusion.
1218−dropAround :: (Char -> Bool) -> Text -> Text
1219−dropAround p = dropWhile p . dropWhileEnd p
1220−{-# INLINE [1] dropAround #-}
1221−
1222−-- | /O(n)/ Remove leading white space from a string. Equivalent to:
1223−--
1224−-- > dropWhile isSpace
1225−stripStart :: Text -> Text
1226−stripStart = dropWhile isSpace
1227−{-# INLINE [1] stripStart #-}
1228−
1229−-- | /O(n)/ Remove trailing white space from a string. Equivalent to:
1230−--
1231−-- > dropWhileEnd isSpace
1232−stripEnd :: Text -> Text
1233−stripEnd = dropWhileEnd isSpace
1234−{-# INLINE [1] stripEnd #-}
1235−
1236−-- | /O(n)/ Remove leading and trailing white space from a string.
1237−-- Equivalent to:
1238−--
1239−-- > dropAround isSpace
1240−strip :: Text -> Text
1241−strip = dropAround isSpace
1242−{-# INLINE [1] strip #-}
1243−
1244-- | /O(n)/ 'splitAt' @n t@ returns a pair whose first element is a
701-- | /O(n)/ 'splitAt' @n t@ returns a pair whose first element is a
1245-- prefix of @t@ of length @n@, and whose second is the remainder of
702-- prefix of @t@ of length @n@, and whose second is the remainder of
1246-- the string. It is equivalent to @('take' n t, 'drop' n t)@.
703-- the string. It is equivalent to @('take' n t, 'drop' n t)@.
@@ -1248,20 +705,28 @@ splitAt :: Int -> Text -> (Text, Text)
1248splitAt n t@(Text arr off len)
705splitAt n t@(Text arr off len)
1249 | n <= 0 = (empty, t)
706 | n <= 0 = (empty, t)
1250 | n >= len = (t, empty)
707 | n >= len = (t, empty)
1251− | otherwise = let k = iterN n t
708+ | otherwise = (Text arr off k, Text arr (off+k) (len-k))
1252− in (text arr off k, text arr (off+k) (len-k))
709+ where k = loop 0 0
710+ loop !i !cnt
711+ | i >= len || cnt >= n = i
712+ | otherwise = loop (i+d) (cnt+1)
713+ where d = iter_ t i
714+{-# INLINE splitAt #-}
1253
715
1254−-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
716+-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns a
1255−-- a pair whose first element is the longest prefix (possibly empty)
717+-- pair whose first element is the longest prefix (possibly empty) of
1256−-- of @t@ of elements that satisfy @p@, and whose second is the
718+-- @t@ of elements that satisfy @p@, and whose second is the remainder
1257−-- remainder of the list.
719+-- of the list.
1258span :: (Char -> Bool) -> Text -> (Text, Text)
720span :: (Char -> Bool) -> Text -> (Text, Text)
1259−span p t = case span_ p t of
721+span p t@(Text arr off len) = (textP arr off k, textP arr (off+k) (len-k))
1260− (# hd,tl #) -> (hd,tl)
722+ where k = loop 0
723+ loop !i | i >= len || not (p c) = i
724+ | otherwise = loop (i+d)
725+ where (c,d) = iter t i
1261{-# INLINE span #-}
726{-# INLINE span #-}
1262
727
1263−-- | /O(n)/ 'break' is like 'span', but the prefix returned is
728+-- | /O(n)/ 'break' is like 'span', but the prefix returned is over
1264−-- over elements that fail the predicate @p@.
729+-- elements that fail the predicate @p@.
1265break :: (Char -> Bool) -> Text -> (Text, Text)
730break :: (Char -> Bool) -> Text -> (Text, Text)
1266break p = span (not . p)
731break p = span (not . p)
1267{-# INLINE break #-}
732{-# INLINE break #-}
@@ -1273,7 +738,7 @@ groupBy p = loop
1273 loop t@(Text arr off len)
738 loop t@(Text arr off len)
1274 | null t = []
739 | null t = []
1275 | otherwise = text arr off n : loop (text arr (off+n) (len-n))
740 | otherwise = text arr off n : loop (text arr (off+n) (len-n))
1276− where Iter c d = iter t 0
741+ where (c,d) = iter t 0
1277 n = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))
742 n = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))
1278
743
1279-- | Returns the /array/ index (in units of 'Word16') at which a
744-- | Returns the /array/ index (in units of 'Word16') at which a
@@ -1283,8 +748,8 @@ findAIndexOrEnd :: (Char -> Bool) -> Text -> Int
1283findAIndexOrEnd q t@(Text _arr _off len) = go 0
748findAIndexOrEnd q t@(Text _arr _off len) = go 0
1284 where go !i | i >= len || q c = i
749 where go !i | i >= len || q c = i
1285 | otherwise = go (i+d)
750 | otherwise = go (i+d)
1286− where Iter c d = iter t i
751+ where (c,d) = iter t i
1287−
752+
1288-- | /O(n)/ Group characters in a string by equality.
753-- | /O(n)/ Group characters in a string by equality.
1289group :: Text -> [Text]
754group :: Text -> [Text]
1290group = groupBy (==)
755group = groupBy (==)
@@ -1302,91 +767,59 @@ tails :: Text -> [Text]
1302tails t | null t = [empty]
767tails t | null t = [empty]
1303 | otherwise = t : tails (unsafeTail t)
768 | otherwise = t : tails (unsafeTail t)
1304
769
1305−-- $split
1306−--
1307−-- Splitting functions in this library do not perform character-wise
1308−-- copies to create substrings; they just construct new 'Text's that
1309−-- are slices of the original.
1310−
1311−-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'
770+-- | /O(n)/ Break a 'Text' into pieces separated by the 'Char'
1312−-- argument (which cannot be empty), consuming the delimiter. An empty
771+-- argument, consuming the delimiter. I.e.
1313−-- delimiter is invalid, and will cause an error to be raised.
1314−--
1315−-- Examples:
1316−--
1317−-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]
1318−-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]
1319−-- > splitOn "x" "x" == ["",""]
1320--
772--
773+-- > split '\n' "a\nb\nd\ne" == ["a","b","d","e"]
774+-- > split 'a' "aXaXaXa" == ["","X","X","X",""]
775+-- > split 'x' "x" == ["",""]
776+--
1321-- and
777-- and
1322--
778--
1323−-- > intercalate s . splitOn s == id
779+-- > intercalate (singleton c) . split c == id
1324−-- > splitOn (singleton c) == split (==c)
780+-- > split == splitWith . (==)
1325−--
781+--
1326−-- (Note: the string @s@ to split on above cannot be empty.)
782+-- As for all splitting functions in this library, this function does
1327−--
783+-- not copy the substrings, it just constructs new 'Text's that are
1328−-- In (unlikely) bad cases, this function's time complexity degrades
784+-- slices of the original.
1329−-- towards /O(n*m)/.
785+split :: Char -> Text -> [Text]
1330−splitOn :: Text
786+split c = splitWith (==c)
1331− -- ^ String to split on. If this string is empty, an error
1332− -- will occur.
1333− -> Text
1334− -- ^ Input text.
1335− -> [Text]
1336−splitOn pat@(Text _ _ l) src@(Text arr off len)
1337− | l <= 0 = emptyError "splitOn"
1338− | isSingleton pat = split (== unsafeHead pat) src
1339− | otherwise = go 0 (indices pat src)
1340− 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)]
1343−{-# INLINE [1] splitOn #-}
787+{-# INLINE split #-}
1344−
1345−{-# RULES
1346−"TEXT splitOn/singleton -> split/==" [~1] forall c t.
1347− splitOn (singleton c) t = split (==c) t
1348− #-}
1349
788
1350-- | /O(n)/ Splits a 'Text' into components delimited by separators,
789-- | /O(n)/ Splits a 'Text' into components delimited by separators,
1351-- where the predicate returns True for a separator element. The
790-- where the predicate returns True for a separator element. The
1352-- resulting components do not contain the separators. Two adjacent
791-- resulting components do not contain the separators. Two adjacent
1353-- separators result in an empty component in the output. eg.
792-- separators result in an empty component in the output. eg.
1354--
793--
1355−-- > split (=='a') "aabbaca" == ["","","bb","c",""]
794+-- > splitWith (=='a') "aabbaca" == ["","","bb","c",""]
1356−-- > split (=='a') "" == [""]
795+-- > splitWith (=='a') [] == []
1357−split :: (Char -> Bool) -> Text -> [Text]
796+splitWith :: (Char -> Bool) -> Text -> [Text]
1358−split _ t@(Text _off _arr 0) = [t]
797+splitWith _ (Text _off _arr 0) = []
1359−split p t = loop t
798+splitWith p t = loop t
1360 where loop s | null s' = [l]
799 where loop s | null s' = [l]
1361 | otherwise = l : loop (unsafeTail s')
800 | otherwise = l : loop (unsafeTail s')
1362− where (# l, s' #) = span_ (not . p) s
801+ where (l, s') = break p s
1363−{-# INLINE split #-}
802+{-# INLINE splitWith #-}
1364−
1365−-- | /O(n)/ Splits a 'Text' into components of length @k@. The last
1366−-- element may be shorter than the other chunks, depending on the
1367−-- length of the input. Examples:
1368−--
1369−-- > chunksOf 3 "foobarbaz" == ["foo","bar","baz"]
1370−-- > chunksOf 4 "haskell.org" == ["hask","ell.","org"]
1371−chunksOf :: Int -> Text -> [Text]
1372−chunksOf k = go
1373− where
1374− go t = case splitAt k t of
1375− (a,b) | null a -> []
1376− | otherwise -> a : go b
1377−{-# INLINE chunksOf #-}
1378
803
1379-- ----------------------------------------------------------------------------
804-- ----------------------------------------------------------------------------
1380-- * Searching
805-- * Searching
1381
806
807+-------------------------------------------------------------------------------
808+-- ** Searching by equality
809+
810+-- | /O(n)/ 'elem' is the 'Text' membership predicate.
811+elem :: Char -> Text -> Bool
812+elem c t = S.elem c (stream t)
813+{-# INLINE elem #-}
814+
1382-------------------------------------------------------------------------------
815-------------------------------------------------------------------------------
1383-- ** Searching with a predicate
816-- ** Searching with a predicate
1384
817
1385−-- | /O(n)/ The 'find' function takes a predicate and a 'Text', and
818+-- | /O(n)/ The 'find' function takes a predicate and a 'Text',
1386−-- returns the first element matching the predicate, or 'Nothing' if
819+-- and returns the first element in matching the predicate, or 'Nothing'
1387−-- there is no such element.
820+-- if there is no such element.
1388find :: (Char -> Bool) -> Text -> Maybe Char
821find :: (Char -> Bool) -> Text -> Maybe Char
1389−find p t = S.findBy p (stream t)
822+find p t = S.find p (stream t)
1390{-# INLINE find #-}
823{-# INLINE find #-}
1391
824
1392-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',
825-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',
@@ -1398,103 +831,49 @@ partition :: (Char -> Bool) -> Text -> (Text, Text)
1398partition p t = (filter p t, filter (not . p) t)
831partition p t = (filter p t, filter (not . p) t)
1399{-# INLINE partition #-}
832{-# INLINE partition #-}
1400
833
1401−-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
834+-- | /O(n)/ Break a string on a substring, returning a pair of the
1402−-- returns a 'Text' containing those characters that satisfy the
835+-- part of the string prior to the match, and the rest of the string.
1403−-- predicate.
1404−filter :: (Char -> Bool) -> Text -> Text
1405−filter p t = unstream (S.filter p (stream t))
1406−{-# INLINE filter #-}
1407−
1408−-- | /O(n+m)/ Find the first instance of @needle@ (which must be
1409−-- non-'null') in @haystack@. The first element of the returned tuple
1410−-- is the prefix of @haystack@ before @needle@ is matched. The second
1411−-- is the remainder of @haystack@, starting with the match.
1412−--
1413−-- Examples:
1414−--
1415−-- > breakOn "::" "a::b::c" ==> ("a", "::b::c")
1416−-- > breakOn "/" "foobar" ==> ("foobar", "")
1417−--
1418−-- Laws:
1419−--
1420−-- > append prefix match == haystack
1421−-- > where (prefix, match) = breakOn needle haystack
1422--
836--
1423−-- If you need to break a string by a substring repeatedly (e.g. you
837+-- The following relationship holds:
1424−-- want to break on every instance of a substring), use 'breakOnAll'
1425−-- instead, as it has lower startup overhead.
1426--
838--
1427−-- In (unlikely) bad cases, this function's time complexity degrades
839+-- > break (==c) l == breakSubstring (singleton c) l
1428−-- towards /O(n*m)/.
1429−breakOn :: Text -> Text -> (Text, Text)
1430−breakOn pat src@(Text arr off len)
1431− | null pat = emptyError "breakOn"
1432− | otherwise = case indices pat src of
1433− [] -> (src, empty)
1434− (x:_) -> (text arr off x, text arr (off+x) (len-x))
1435−{-# INLINE breakOn #-}
1436−
1437−-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
1438−-- string.
1439--
840--
1440−-- The first element of the returned tuple is the prefix of @haystack@
841+-- For example, to tokenise a string, dropping delimiters:
1441−-- up to and including the last match of @needle@. The second is the
1442−-- remainder of @haystack@, following the match.
1443--
842--
1444−-- > breakOnEnd "::" "a::b::c" ==> ("a::b::", "c")
843+-- > tokenise x y = h : if null t then [] else tokenise x (drop (length x) t)
1445−breakOnEnd :: Text -> Text -> (Text, Text)
844+-- > where (h,t) = breakSubstring x y
1446−breakOnEnd pat src = (reverse b, reverse a)
1447− where (a,b) = breakOn (reverse pat) (reverse src)
1448−{-# INLINE breakOnEnd #-}
1449−
1450−-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in
1451−-- @haystack@. Each element of the returned list consists of a pair:
1452--
845--
1453−-- * The entire string prior to the /k/th match (i.e. the prefix)
846+-- To skip to the first occurence of a string:
1454--
847--
1455−-- * The /k/th match, followed by the remainder of the string
848+-- > snd (breakSubstring x y)
1456--
849--
1457−-- Examples:
850+-- To take the parts of a string before a delimiter:
1458--
851--
1459−-- > breakOnAll "::" ""
852+-- > fst (breakSubstring x y)
1460−-- > ==> []
1461−-- > breakOnAll "/" "a/b/c/"
1462−-- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]
1463--
853--
1464−-- In (unlikely) bad cases, this function's time complexity degrades
1465−-- towards /O(n*m)/.
1466−--
1467−-- The @needle@ parameter may not be empty.
1468−breakOnAll :: Text -- ^ @needle@ to search for
854+breakSubstring :: Text -- ^ String to search for
1469− -> Text -- ^ @haystack@ in which to search
855+ -> Text -- ^ String to search in
1470− -> [(Text, Text)]
856+ -> (Text,Text) -- ^ Head and tail of string broken at substring
1471−breakOnAll pat src@(Text arr off slen)
857+
1472− | null pat = emptyError "breakOnAll"
858+breakSubstring pat src = search 0 src
1473− | otherwise = L.map step (indices pat src)
1474 where
859 where
1475− step x = (chunk 0 x, chunk x (slen-x))
860+ search !n !s
1476− chunk !n !l = text arr (n+off) l
861+ | null s = (src,empty) -- not found
862+ | pat `isPrefixOf` s = (take n src,s)
863+ | otherwise = search (n+1) (unsafeTail s)
864+{-# INLINE breakSubstring #-}
865+
866+-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
867+-- returns a 'Text' containing those characters that satisfy the
868+-- predicate.
869+filter :: (Char -> Bool) -> Text -> Text
870+filter p t = unstream (S.filter p (stream t))
1477−{-# INLINE breakOnAll #-}
871+{-# INLINE filter #-}
872+
1478
873
1479-------------------------------------------------------------------------------
874-------------------------------------------------------------------------------
1480-- ** Indexing 'Text's
875-- ** Indexing 'Text's
1481
876
1482−-- $index
1483−--
1484−-- If you think of a 'Text' value as an array of 'Char' values (which
1485−-- it is not), you run the risk of writing inefficient code.
1486−--
1487−-- An idiom that is common in some languages is to find the numeric
1488−-- offset of a character or substring, then use that number to split
1489−-- or trim the searched string. With a 'Text' value, this approach
1490−-- would require two /O(n)/ operations: one to perform the search, and
1491−-- one to operate from wherever the search ended.
1492−--
1493−-- For example, suppose you have a string that you want to split on
1494−-- the substring @\"::\"@, such as @\"foo::bar::quux\"@. Instead of
1495−-- searching for the index of @\"::\"@ and taking the substrings
1496−-- before and after that index, you would instead use @breakOnAll \"::\"@.
1497−
1498-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.
877-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.
1499index :: Text -> Int -> Char
878index :: Text -> Int -> Char
1500index t n = S.index (stream t) n
879index t n = S.index (stream t) n
@@ -1502,34 +881,39 @@ index t n = S.index (stream t) n
1502
881
1503-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'
882-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'
1504-- and returns the index of the first element in the 'Text' satisfying
883-- and returns the index of the first element in the 'Text' satisfying
1505−-- the predicate. Subject to fusion.
884+-- the predicate. This function is subject to fusion.
1506findIndex :: (Char -> Bool) -> Text -> Maybe Int
885findIndex :: (Char -> Bool) -> Text -> Maybe Int
1507findIndex p t = S.findIndex p (stream t)
886findIndex p t = S.findIndex p (stream t)
1508{-# INLINE findIndex #-}
887{-# INLINE findIndex #-}
1509
888
1510−-- | /O(n+m)/ The 'count' function returns the number of times the
889+-- | The 'findIndices' function extends 'findIndex', by returning the
1511−-- query string appears in the given 'Text'. An empty query string is
890+-- indices of all elements satisfying the predicate, in ascending
1512−-- invalid, and will cause an error to be raised.
891+-- order. This function is subject to fusion.
1513−--
892+findIndices :: (Char -> Bool) -> Text -> [Int]
1514−-- In (unlikely) bad cases, this function's time complexity degrades
893+findIndices p t = S.findIndices p (stream t)
1515−-- towards /O(n*m)/.
1516−count :: Text -> Text -> Int
1517−count pat src
1518− | null pat = emptyError "count"
1519− | isSingleton pat = countChar (unsafeHead pat) src
1520− | otherwise = L.length (indices pat src)
1521−{-# INLINE [1] count #-}
894+{-# INLINE findIndices #-}
1522−
1523−{-# RULES
1524−"TEXT count/singleton -> countChar" [~1] forall c t.
1525− count (singleton c) t = countChar c t
1526− #-}
1527
895
896+-- | /O(n)/ The 'elemIndex' function returns the index of the first
897+-- element in the given 'Text' which is equal to the query element, or
898+-- 'Nothing' if there is no such element. This function is subject to
899+-- fusion.
900+elemIndex :: Char -> Text -> Maybe Int
901+elemIndex c t = S.elemIndex c (stream t)
902+{-# INLINE elemIndex #-}
903+
904+-- | /O(n)/ The 'elemIndices' function returns the index of every
905+-- element in the given 'Text' which is equal to the query
906+-- element. This function is subject to fusion.
907+elemIndices :: Char -> Text -> [Int]
908+elemIndices c t = S.elemIndices c (stream t)
909+{-# INLINE elemIndices #-}
910+
1528−-- | /O(n)/ The 'countChar' function returns the number of times the
911+-- | /O(n)/ The 'count' function returns the number of times the query
1529−-- query element appears in the given 'Text'. Subject to fusion.
912+-- element appears in the given 'Text'. This function is subject to
913+-- fusion.
1530−countChar :: Char -> Text -> Int
914+count :: Char -> Text -> Int
1531−countChar c t = S.countChar c (stream t)
915+count c t = S.count c (stream t)
1532−{-# INLINE countChar #-}
916+{-# INLINE count #-}
1533
917
1534-------------------------------------------------------------------------------
918-------------------------------------------------------------------------------
1535-- * Zipping
919-- * Zipping
@@ -1540,15 +924,13 @@ countChar c t = S.countChar c (stream t)
1540-- equivalent to a pair of 'unpack' operations.
924-- equivalent to a pair of 'unpack' operations.
1541zip :: Text -> Text -> [(Char,Char)]
925zip :: Text -> Text -> [(Char,Char)]
1542zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
926zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1543−{-# INLINE zip #-}
927+{-# INLINE [0] zip #-}
1544
928
1545-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
929-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1546-- given as the first argument, instead of a tupling function.
930-- given as the first argument, instead of a tupling function.
1547−-- Performs replacement on invalid scalar values.
1548zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
931zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1549−zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
932+zipWith f t1 t2 = unstream (S.zipWith f (stream t1) (stream t2))
1550− where g a b = safe (f a b)
1551−{-# INLINE zipWith #-}
933+{-# INLINE [0] zipWith #-}
1552
934
1553-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
935-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1554-- representing white space.
936-- representing white space.
@@ -1564,7 +946,7 @@ words t@(Text arr off len) = loop 0 0
1564 then loop (start+1) (start+1)
946 then loop (start+1) (start+1)
1565 else Text arr (start+off) (n-start) : loop (n+d) (n+d)
947 else Text arr (start+off) (n-start) : loop (n+d) (n+d)
1566 | otherwise = loop start (n+d)
948 | otherwise = loop start (n+d)
1567− where Iter c d = iter t n
949+ where (c,d) = iter t n
1568{-# INLINE words #-}
950{-# INLINE words #-}
1569
951
1570-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at
952-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at
@@ -1574,10 +956,9 @@ lines ps | null ps = []
1574 | otherwise = h : if null t
956 | otherwise = h : if null t
1575 then []
957 then []
1576 else lines (unsafeTail t)
958 else lines (unsafeTail t)
1577− where (# h,t #) = span_ (/= '\n') ps
959+ where (h,t) = span (/= '\n') ps
1578{-# INLINE lines #-}
960{-# INLINE lines #-}
1579
961
1580−{-
1581-- | /O(n)/ Portably breaks a 'Text' up into a list of 'Text's at line
962-- | /O(n)/ Portably breaks a 'Text' up into a list of 'Text's at line
1582-- boundaries.
963-- boundaries.
1583--
964--
@@ -1585,6 +966,7 @@ lines ps | null ps = []
1585-- return immediately followed by a line feed, or a carriage return.
966-- return immediately followed by a line feed, or a carriage return.
1586-- This accounts for both Unix and Windows line ending conventions,
967-- This accounts for both Unix and Windows line ending conventions,
1587-- and for the old convention used on Mac OS 9 and earlier.
968-- and for the old convention used on Mac OS 9 and earlier.
969+{-
1588lines' :: Text -> [Text]
970lines' :: Text -> [Text]
1589lines' ps | null ps = []
971lines' ps | null ps = []
1590 | otherwise = h : case uncons t of
972 | otherwise = h : case uncons t of
@@ -1611,7 +993,8 @@ unwords = intercalate (singleton ' ')
1611{-# INLINE unwords #-}
993{-# INLINE unwords #-}
1612
994
1613-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns
995-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns
1614−-- 'True' iff the first is a prefix of the second. Subject to fusion.
996+-- 'True' iff the first is a prefix of the second. This function is
997+-- subject to fusion.
1615isPrefixOf :: Text -> Text -> Bool
998isPrefixOf :: Text -> Text -> Bool
1616isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =
999isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =
1617 alen <= blen && S.isPrefixOf (stream a) (stream b)
1000 alen <= blen && S.isPrefixOf (stream a) (stream b)
@@ -1620,6 +1003,8 @@ isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =
1620{-# RULES
1003{-# RULES
1621"TEXT isPrefixOf -> fused" [~1] forall s t.
1004"TEXT isPrefixOf -> fused" [~1] forall s t.
1622 isPrefixOf s t = S.isPrefixOf (stream s) (stream t)
1005 isPrefixOf s t = S.isPrefixOf (stream s) (stream t)
1006+"TEXT isPrefixOf -> unfused" [1] forall s t.
1007+ S.isPrefixOf (stream s) (stream t) = isPrefixOf s t
1623 #-}
1008 #-}
1624
1009
1625-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns
1010-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns
@@ -1632,124 +1017,13 @@ isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =
1632 | otherwise = Text barr (boff+d) alen
1017 | otherwise = Text barr (boff+d) alen
1633{-# INLINE isSuffixOf #-}
1018{-# INLINE isSuffixOf #-}
1634
1019
1635−-- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns
1020+-- | /O(n)/ The 'isInfixOf' function takes two 'Text's and returns
1636-- 'True' iff the first is contained, wholly and intact, anywhere
1021-- 'True' iff the first is contained, wholly and intact, anywhere
1637-- within the second.
1022-- within the second.
1638−--
1639−-- In (unlikely) bad cases, this function's time complexity degrades
1640−-- towards /O(n*m)/.
1641isInfixOf :: Text -> Text -> Bool
1023isInfixOf :: Text -> Text -> Bool
1642−isInfixOf needle haystack
1024+isInfixOf needle haystack = L.any (isPrefixOf needle) (tails haystack)
1643− | null needle = True
1025+{-# INLINE isInfixOf #-}
1644− | isSingleton needle = S.elem (unsafeHead needle) . S.stream $ haystack
1026+-- TODO: a better implementation
1645− | otherwise = not . L.null . indices needle $ haystack
1646−{-# INLINE [1] isInfixOf #-}
1647−
1648−{-# RULES
1649−"TEXT isInfixOf/singleton -> S.elem/S.stream" [~1] forall n h.
1650− isInfixOf (singleton n) h = S.elem n (S.stream h)
1651− #-}
1652−
1653−-------------------------------------------------------------------------------
1654−-- * View patterns
1655−
1656−-- | /O(n)/ Return the suffix of the second string if its prefix
1657−-- matches the entire first string.
1658−--
1659−-- Examples:
1660−--
1661−-- > stripPrefix "foo" "foobar" == Just "bar"
1662−-- > stripPrefix "" "baz" == Just "baz"
1663−-- > stripPrefix "foo" "quux" == Nothing
1664−--
1665−-- This is particularly useful with the @ViewPatterns@ extension to
1666−-- GHC, as follows:
1667−--
1668−-- > {-# LANGUAGE ViewPatterns #-}
1669−-- > import Data.Text as T
1670−-- >
1671−-- > fnordLength :: Text -> Int
1672−-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf
1673−-- > fnordLength _ = -1
1674−stripPrefix :: Text -> Text -> Maybe Text
1675−stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1676− | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)
1677− | otherwise = Nothing
1678−
1679−-- | /O(n)/ Find the longest non-empty common prefix of two strings
1680−-- and return it, along with the suffixes of each string at which they
1681−-- no longer match.
1682−--
1683−-- If the strings do not have a common prefix or either one is empty,
1684−-- this function returns 'Nothing'.
1685−--
1686−-- Examples:
1687−--
1688−-- > commonPrefixes "foobar" "fooquux" == Just ("foo","bar","quux")
1689−-- > commonPrefixes "veeble" "fetzer" == Nothing
1690−-- > commonPrefixes "" "baz" == Nothing
1691−commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)
1692−commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1693− where
1694− go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1695− | i > 0 = Just (Text arr0 off0 i,
1696− text arr0 (off0+i) (len0-i),
1697− text arr1 (off1+j) (len1-j))
1698− | otherwise = Nothing
1699− where Iter a d0 = iter t0 i
1700− Iter b d1 = iter t1 j
1701−
1702−-- | /O(n)/ Return the prefix of the second string if its suffix
1703−-- matches the entire first string.
1704−--
1705−-- Examples:
1706−--
1707−-- > stripSuffix "bar" "foobar" == Just "foo"
1708−-- > stripSuffix "" "baz" == Just "baz"
1709−-- > stripSuffix "foo" "quux" == Nothing
1710−--
1711−-- This is particularly useful with the @ViewPatterns@ extension to
1712−-- GHC, as follows:
1713−--
1714−-- > {-# LANGUAGE ViewPatterns #-}
1715−-- > import Data.Text as T
1716−-- >
1717−-- > quuxLength :: Text -> Int
1718−-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre
1719−-- > quuxLength _ = -1
1720−stripSuffix :: Text -> Text -> Maybe Text
1721−stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
1722− | p `isSuffixOf` t = Just $! text arr off (len-plen)
1723− | otherwise = Nothing
1724−
1725−-- | Add a list of non-negative numbers. Errors out on overflow.
1726−sumP :: String -> [Int] -> Int
1727−sumP fun = go 0
1728− where go !a (x:xs)
1729− | ax >= 0 = go ax xs
1730− | otherwise = overflowError fun
1731− where ax = a + x
1732− go a _ = a
1733
1027
1734emptyError :: String -> a
1028emptyError :: String -> a
1735−emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"
1029+emptyError fun = P.error ("Data.Text." ++ fun ++ ": empty input")
1736−
1737−overflowError :: String -> a
1738−overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
1739−
1740−-- | /O(n)/ Make a distinct copy of the given string, sharing no
1741−-- storage with the original string.
1742−--
1743−-- As an example, suppose you read a large string, of which you need
1744−-- only a small portion. If you do not use 'copy', the entire original
1745−-- array will be kept alive in memory by the smaller string. Making a
1746−-- copy \"breaks the link\" to the original array, allowing it to be
1747−-- garbage collected if there are no other live references to it.
1748−copy :: Text -> Text
1749−copy (Text arr off len) = Text (A.run go) 0 len
1750− where
1751− go :: ST s (A.MArray s)
1752− go = do
1753− marr <- A.new len
1754− A.copyI marr 0 arr off len
1755− return marr
Data/Text/Array.hs+266−165
@@ -1,12 +1,13 @@
1−{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash, Rank2Types,
1+{-# LANGUAGE BangPatterns, CPP, ExistentialQuantification, MagicHash,
2− RecordWildCards, UnboxedTuples, UnliftedFFITypes #-}
2+ Rank2Types, ScopedTypeVariables, UnboxedTuples #-}
3{-# OPTIONS_GHC -fno-warn-unused-matches #-}
3{-# OPTIONS_GHC -fno-warn-unused-matches #-}
4-- |
4-- |
5-- Module : Data.Text.Array
5-- Module : Data.Text.Array
6−-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
6+-- Copyright : (c) Bryan O'Sullivan 2009
7--
7--
8-- License : BSD-style
8-- License : BSD-style
9−-- Maintainer : bos@serpentine.com
9+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,
10+-- duncan@haskell.org
10-- Stability : experimental
11-- Stability : experimental
11-- Portability : portable
12-- Portability : portable
12--
13--
@@ -20,227 +21,327 @@
20-- > import qualified Data.Text.Array as A
21-- > import qualified Data.Text.Array as A
21--
22--
22-- The names in this module resemble those in the 'Data.Array' family
23-- The names in this module resemble those in the 'Data.Array' family
23−-- of modules, but are shorter due to the assumption of qualified
24+-- of modules, but are shorter due to the assumption of qualifid
24-- naming.
25-- naming.
25module Data.Text.Array
26module Data.Text.Array
26 (
27 (
27 -- * Types
28 -- * Types
28− Array(Array, aBA)
29+ IArray(..)
29− , MArray(MArray, maBA)
30+ , Elt(..)
31+ , Array
32+ , MArray
30
33
31 -- * Functions
34 -- * Functions
32− , copyM
33− , copyI
34 , empty
35 , empty
35− , equal
36+ , new
36−#if defined(ASSERTS)
37+ , unsafeNew
37− , length
38+ , unsafeFreeze
38−#endif
39 , run
39 , run
40 , run2
40 , run2
41 , toList
41 , toList
42− , unsafeFreeze
42+ , copy
43− , unsafeIndex
43+ , unsafeCopy
44− , new
45− , unsafeWrite
46 ) where
44 ) where
47
45
48−#if defined(ASSERTS)
46+#if 0
47+#define BOUNDS_CHECKING
49-- This fugly hack is brought by GHC's apparent reluctance to deal
48-- This fugly hack is brought by GHC's apparent reluctance to deal
50-- with MagicHash and UnboxedTuples when inferring types. Eek!
49-- with MagicHash and UnboxedTuples when inferring types. Eek!
51−# define CHECK_BOUNDS(_func_,_len_,_k_) \
50+#define CHECK_BOUNDS(_func_,_len_,_k_) \
52if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.Text.Array." ++ (_func_) ++ ": bounds error, offset " ++ show (_k_) ++ ", length " ++ show (_len_)) else
51if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.Text.Array." ++ (_func_) ++ ": bounds error, offset " ++ show (_k_) ++ ", length " ++ show (_len_)) else
53#else
52#else
54−# define CHECK_BOUNDS(_func_,_len_,_k_)
53+#define CHECK_BOUNDS(_func_,_len_,_k_)
55#endif
54#endif
56
55
56+#if defined(__GLASGOW_HASKELL__)
57#include "MachDeps.h"
57#include "MachDeps.h"
58
58
59−#if defined(ASSERTS)
60−import Control.Exception (assert)
61−#endif
62−#if __GLASGOW_HASKELL__ >= 702
63−import Control.Monad.ST.Unsafe (unsafeIOToST)
64−#else
65−import Control.Monad.ST (unsafeIOToST)
66−#endif
67−import Data.Bits ((.&.), xor)
68−import Data.Text.Internal.Unsafe (inlinePerformIO)
69−import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
70−#if __GLASGOW_HASKELL__ >= 703
71−import Foreign.C.Types (CInt(CInt), CSize(CSize))
72−#else
73−import Foreign.C.Types (CInt, CSize)
74−#endif
75−import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
59+import GHC.Base (ByteArray#, MutableByteArray#, Int(..), indexIntArray#,
76− indexWord16Array#, newByteArray#,
60+ indexWord16Array#, newByteArray#, readIntArray#,
61+ readWord16Array#, unsafeCoerce#, writeIntArray#,
77− unsafeFreezeByteArray#, writeWord16Array#)
62+ writeWord16Array#, (+#), (*#))
63+import GHC.Prim (Int#)
78import GHC.ST (ST(..), runST)
64import GHC.ST (ST(..), runST)
79import GHC.Word (Word16(..))
65import GHC.Word (Word16(..))
66+
67+#elif defined(__HUGS__)
68+
69+import Hugs.ByteArray (ByteArray, MutableByteArray, readByteArray,
70+ newMutableByteArray, readMutableByteArray,
71+ unsafeFreezeMutableByteArray, writeMutableByteArray)
72+import Foreign.Storable (Storable, sizeOf)
73+import Hugs.ST (ST(..), runST)
74+
75+#else
76+# error not implemented for this compiler
77+#endif
78+
79+import Control.Exception (assert)
80+import Data.Typeable (Typeable1(..), Typeable2(..), TyCon, mkTyCon, mkTyConApp)
81+import Data.Word (Word16)
80import Prelude hiding (length, read)
82import Prelude hiding (length, read)
81
83
84+#include "Typeable.h"
85+
82-- | Immutable array type.
86-- | Immutable array type.
83−data Array = Array {
87+data Array e = Array
84− aBA :: ByteArray#
85−#if defined(ASSERTS)
86− , aLen :: {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)
88+ {-# UNPACK #-} !Int -- length (in units of e, not bytes)
89+#if defined(__GLASGOW_HASKELL__)
90+ ByteArray#
91+#elif defined(__HUGS__)
92+ !ByteArray
87#endif
93#endif
88− }
94+
95+INSTANCE_TYPEABLE1(Array,arrayTc,"Array")
89
96
90-- | Mutable array type, for use in the ST monad.
97-- | Mutable array type, for use in the ST monad.
91−data MArray s = MArray {
98+data MArray s e = MArray
92− maBA :: MutableByteArray# s
93−#if defined(ASSERTS)
94− , maLen :: {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)
99+ {-# UNPACK #-} !Int -- length (in units of e, not bytes)
100+#if defined(__GLASGOW_HASKELL__)
101+ (MutableByteArray# s)
102+#elif defined(__HUGS__)
103+ !(MutableByteArray s)
95#endif
104#endif
96− }
97
105
98−#if defined(ASSERTS)
106+INSTANCE_TYPEABLE2(MArray,mArrayTc,"MArray")
107+
99-- | Operations supported by all arrays.
108-- | Operations supported by all arrays.
100class IArray a where
109class IArray a where
101 -- | Return the length of an array.
110 -- | Return the length of an array.
102 length :: a -> Int
111 length :: a -> Int
103
112
104−instance IArray Array where
113+instance IArray (Array e) where
105− length = aLen
114+ length (Array len _ba) = len
106 {-# INLINE length #-}
115 {-# INLINE length #-}
107
116
117+instance (Elt e, Show e) => Show (Array e) where
118+ show = show . toList
119+
108−instance IArray (MArray s) where
120+instance IArray (MArray s e) where
109− length = maLen
121+ length (MArray len _ba) = len
110 {-# INLINE length #-}
122 {-# INLINE length #-}
123+
124+check :: IArray a => String -> a -> Int -> (a -> Int -> b) -> b
125+check func ary i f
126+ | i >= 0 && i < length ary = f ary i
127+ | otherwise = error ("Data.Array.Flat." ++ func ++ ": index out of bounds")
128+{-# INLINE check #-}
129+
130+-- | Operations supported by all elements that can be stored in
131+-- arrays.
132+class Elt e where
133+ -- | Indicate how many bytes would be used for an array of the
134+ -- given size.
135+ bytesInArray :: Int -> e -> Int
136+ -- | Unchecked read of an immutable array. May return garbage or
137+ -- crash on an out-of-bounds access.
138+ unsafeIndex :: Array e -> Int -> e
139+ -- | Unchecked read of a mutable array. May return garbage or
140+ -- crash on an out-of-bounds access.
141+ unsafeRead :: MArray s e -> Int -> ST s e
142+ -- | Unchecked write of a mutable array. May return garbage or
143+ -- crash on an out-of-bounds access.
144+ unsafeWrite :: MArray s e -> Int -> e -> ST s ()
145+
146+ -- | Read an immutable array. An invalid index results in a
147+ -- runtime error.
148+ index :: Array e -> Int -> e
149+ index ary i = check "index" ary i unsafeIndex
150+ {-# INLINE index #-}
151+
152+ -- | Read a mutable array. An invalid index results in a runtime
153+ -- error.
154+ read :: Array e -> Int -> ST s e
155+ read ary i = check "read" ary i read
156+ {-# INLINE read #-}
157+
158+ -- | Write a mutable array. An invalid index results in a runtime
159+ -- error.
160+ write :: Array e -> Int -> ST s e
161+ write ary i = check "write" ary i write
162+ {-# INLINE write #-}
163+
164+-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
165+unsafeFreeze :: MArray s e -> ST s (Array e)
166+
167+#if defined(__GLASGOW_HASKELL__)
168+
169+iNT_SCALE :: Int# -> Int#
170+iNT_SCALE n# = scale# *# n# where I# scale# = SIZEOF_INT
171+
172+wORD16_SCALE :: Int# -> Int#
173+wORD16_SCALE n# = scale# *# n# where I# scale# = SIZEOF_WORD16
174+
175+-- | Create an uninitialized mutable array.
176+unsafeNew :: forall s e. Elt e => Int -> ST s (MArray s e)
177+unsafeNew n = assert (n >= 0) . ST $ \s1# ->
178+ case bytesInArray n (undefined :: e) of
179+ len@(I# len#) ->
180+#if defined(BOUNDS_CHECKING)
181+ if len < 0 then error (show ("unsafeNew",len)) else
111#endif
182#endif
183+ case newByteArray# len# s1# of
184+ (# s2#, marr# #) -> (# s2#, MArray n marr# #)
185+{-# INLINE unsafeNew #-}
186+
187+unsafeFreeze (MArray len mba#) = ST $ \s# ->
188+ (# s#, Array len (unsafeCoerce# mba#) #)
189+{-# INLINE unsafeFreeze #-}
190+
191+-- | Create a mutable array, with its elements initialized with the
192+-- given value.
193+new :: forall s e. Elt e => Int -> e -> ST s (MArray s e)
194+
195+#elif defined(__HUGS__)
196+
197+unsafeIndexArray :: Storable e => Array e -> Int -> e
198+unsafeIndexArray (Array off len arr) i =
199+ assert (i >= 0 && i < len) $ readByteArray arr (off + i)
200+
201+unsafeReadMArray :: Storable e => MArray s e -> Int -> ST s e
202+unsafeReadMArray (MArray _len marr) i =
203+ assert (i >= 0 && i < len) $ readMutableByteArray marr
204+
205+unsafeWriteMArray :: Storable e => MArray s e -> Int -> e -> ST s ()
206+unsafeWriteMArray (MArray len marr) i =
207+ assert (i >= 0 && i < len) $ writeMutableByteArray marr
112
208
113-- | Create an uninitialized mutable array.
209-- | Create an uninitialized mutable array.
114−new :: forall s. Int -> ST s (MArray s)
210+unsafeNew :: (Storable e) => Int -> ST s (MArray s e)
115−new n
211+unsafeNew n = new undefined
116− | n < 0 || n .&. highBit /= 0 = array_size_error
212+ where new :: (Storable e) => e -> ST s (MArray s e)
117− | otherwise = ST $ \s1# ->
213+ new unused = do
118− case newByteArray# len# s1# of
214+ marr <- newMutableByteArray (n * sizeOf unused)
119− (# s2#, marr# #) -> (# s2#, MArray marr#
215+ return (MArray n marr)
120−#if defined(ASSERTS)
216+
121− n
217+unsafeFreeze (MArray len mba) = do
218+ ba <- unsafeFreezeMutableByteArray mba
219+ return (Array 0 len ba)
220+
221+-- | Create a mutable array, with its elements initialized with the
222+-- given value.
223+new :: (Storable e) => Int -> e -> ST s (MArray s e)
122#endif
224#endif
123− #)
124− where !(I# len#) = bytesInArray n
125− highBit = maxBound `xor` (maxBound `shiftR` 1)
126−{-# INLINE new #-}
127
225
128−array_size_error :: a
226+new len initVal = do
129−array_size_error = error "Data.Text.Array.new: size overflow"
227+ marr <- unsafeNew len
228+ sequence_ [unsafeWrite marr i initVal | i <- [0..len-1]]
229+ return marr
230+
231+instance Elt Int where
232+#if defined(__GLASGOW_HASKELL__)
233+
234+ bytesInArray (I# i#) _ = I# (iNT_SCALE i#)
235+ {-# INLINE bytesInArray #-}
236+
237+ unsafeIndex (Array len ba#) i@(I# i#) =
238+ CHECK_BOUNDS("unsafeIndex",len,i)
239+ case indexIntArray# ba# i# of r# -> (I# r#)
240+ {-# INLINE unsafeIndex #-}
241+
242+ unsafeRead (MArray len mba#) i@(I# i#) = ST $ \s# ->
243+ CHECK_BOUNDS("unsafeRead",len,i)
244+ case readIntArray# mba# i# s# of
245+ (# s2#, r# #) -> (# s2#, I# r# #)
246+ {-# INLINE unsafeRead #-}
247+
248+ unsafeWrite (MArray len marr#) i@(I# i#) (I# e#) = ST $ \s1# ->
249+ CHECK_BOUNDS("unsafeWrite",len,i)
250+ case writeIntArray# marr# i# e# s1# of
251+ s2# -> (# s2#, () #)
252+ {-# INLINE unsafeWrite #-}
253+
254+#elif defined(__HUGS__)
255+
256+ bytesInArray n w = sizeOf w * n
257+ unsafeIndex = unsafeIndexArray
258+ unsafeRead = unsafeReadMArray
259+ unsafeWrite = unsafeWriteMArray
130
260
131−-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
132−unsafeFreeze :: MArray s -> ST s Array
133−unsafeFreeze MArray{..} = ST $ \s1# ->
134− case unsafeFreezeByteArray# maBA s1# of
135− (# s2#, ba# #) -> (# s2#, Array ba#
136−#if defined(ASSERTS)
137− maLen
138#endif
261#endif
139− #)
140−{-# INLINE unsafeFreeze #-}
141
262
142−-- | Indicate how many bytes would be used for an array of the given
263+instance Elt Word16 where
143−-- size.
264+#if defined(__GLASGOW_HASKELL__)
265+
144−bytesInArray :: Int -> Int
266+ bytesInArray (I# i#) _ = I# (wORD16_SCALE i#)
145−bytesInArray n = n `shiftL` 1
146−{-# INLINE bytesInArray #-}
267+ {-# INLINE bytesInArray #-}
147−
268+
148−-- | Unchecked read of an immutable array. May return garbage or
149−-- crash on an out-of-bounds access.
150−unsafeIndex :: Array -> Int -> Word16
269+ unsafeIndex (Array len ba#) i@(I# i#) =
151−unsafeIndex Array{..} i@(I# i#) =
152− CHECK_BOUNDS("unsafeIndex",aLen,i)
270+ CHECK_BOUNDS("unsafeIndex",len,i)
153− case indexWord16Array# aBA i# of r# -> (W16# r#)
271+ case indexWord16Array# ba# i# of r# -> (W16# r#)
154−{-# INLINE unsafeIndex #-}
272+ {-# INLINE unsafeIndex #-}
155−
273+
156−-- | Unchecked write of a mutable array. May return garbage or crash
274+ unsafeRead (MArray len mba#) i@(I# i#) = ST $ \s# ->
157−-- on an out-of-bounds access.
275+ CHECK_BOUNDS("unsafeRead",len,i)
158−unsafeWrite :: MArray s -> Int -> Word16 -> ST s ()
276+ case readWord16Array# mba# i# s# of
277+ (# s2#, r# #) -> (# s2#, W16# r# #)
278+ {-# INLINE unsafeRead #-}
279+
159−unsafeWrite MArray{..} i@(I# i#) (W16# e#) = ST $ \s1# ->
280+ unsafeWrite (MArray len marr#) i@(I# i#) (W16# e#) = ST $ \s1# ->
160− CHECK_BOUNDS("unsafeWrite",maLen,i)
281+ CHECK_BOUNDS("unsafeWrite",len,i)
161− case writeWord16Array# maBA i# e# s1# of
282+ case writeWord16Array# marr# i# e# s1# of
162− s2# -> (# s2#, () #)
283+ s2# -> (# s2#, () #)
163−{-# INLINE unsafeWrite #-}
284+ {-# INLINE unsafeWrite #-}
285+
286+#elif defined(__HUGS__)
287+
288+ bytesInArray n w = sizeOf w * n
289+ unsafeIndex = unsafeIndexArray
290+ unsafeRead = unsafeReadMArray
291+ unsafeWrite = unsafeWriteMArray
292+
293+#endif
164
294
165-- | Convert an immutable array to a list.
295-- | Convert an immutable array to a list.
166−toList :: Array -> Int -> Int -> [Word16]
296+toList :: Elt e => Array e -> [e]
167−toList ary off len = loop 0
297+toList a = loop 0
168− where loop i | i < len = unsafeIndex ary (off+i) : loop (i+1)
298+ where loop i | i < len = unsafeIndex a i : loop (i+1)
169 | otherwise = []
299 | otherwise = []
300+ len = length a
170
301
171-- | An empty immutable array.
302-- | An empty immutable array.
172−empty :: Array
303+empty :: Elt e => Array e
173−empty = runST (new 0 >>= unsafeFreeze)
304+empty = runST (unsafeNew 0 >>= unsafeFreeze)
174
305
175-- | Run an action in the ST monad and return an immutable array of
306-- | Run an action in the ST monad and return an immutable array of
176-- its result.
307-- its result.
177−run :: (forall s. ST s (MArray s)) -> Array
308+run :: Elt e => (forall s. ST s (MArray s e)) -> Array e
178run k = runST (k >>= unsafeFreeze)
309run k = runST (k >>= unsafeFreeze)
179
310
180-- | Run an action in the ST monad and return an immutable array of
311-- | Run an action in the ST monad and return an immutable array of
181-- its result paired with whatever else the action returns.
312-- its result paired with whatever else the action returns.
182−run2 :: (forall s. ST s (MArray s, a)) -> (Array, a)
313+run2 :: Elt e => (forall s. ST s (MArray s e, a)) -> (Array e, a)
183run2 k = runST (do
314run2 k = runST (do
184 (marr,b) <- k
315 (marr,b) <- k
185 arr <- unsafeFreeze marr
316 arr <- unsafeFreeze marr
186 return (arr,b))
317 return (arr,b))
318+
319+-- | Copy an array in its entirety. The destination array must be at
320+-- least as big as the source.
321+copy :: Elt e => MArray s e -- ^ source array
322+ -> MArray s e -- ^ destination array
323+ -> ST s ()
324+copy src dest
325+ | length dest >= length src = copy_loop 0
326+ | otherwise = fail "Data.Text.Array.copy: array too small"
327+ where
328+ len = length src
329+ copy_loop i
330+ | i >= len = return ()
331+ | otherwise = do unsafeRead src i >>= unsafeWrite dest i
332+ copy_loop (i+1)
187−{-# INLINE run2 #-}
333+{-# INLINE copy #-}
188−
334+
189−-- | Copy some elements of a mutable array.
335+-- | Unsafely copy the elements of an array.
190−copyM :: MArray s -- ^ Destination
336+unsafeCopy :: Elt e =>
191− -> Int -- ^ Destination offset
337+ MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()
192− -> MArray s -- ^ Source
338+unsafeCopy src sidx dest didx count =
193− -> Int -- ^ Source offset
194− -> Int -- ^ Count
195− -> ST s ()
196−copyM dest didx src sidx count
197− | count <= 0 = return ()
198− | otherwise =
199−#if defined(ASSERTS)
200 assert (sidx + count <= length src) .
339 assert (sidx + count <= length src) .
201− assert (didx + count <= length dest) .
340+ assert (didx + count <= length dest) $
202−#endif
341+ copy_loop sidx didx 0
203− unsafeIOToST $ memcpyM (maBA dest) (fromIntegral didx)
342+ where
204− (maBA src) (fromIntegral sidx)
343+ copy_loop !i !j !c
205− (fromIntegral count)
206−{-# INLINE copyM #-}
207−
208−-- | Copy some elements of an immutable array.
209−copyI :: MArray s -- ^ Destination
210− -> Int -- ^ Destination offset
211− -> Array -- ^ Source
212− -> Int -- ^ Source offset
213− -> Int -- ^ First offset in destination /not/ to
214− -- copy (i.e. /not/ length)
215− -> ST s ()
216−copyI dest i0 src j0 top
217− | i0 >= top = return ()
344+ | c >= count = return ()
218− | otherwise = unsafeIOToST $
345+ | otherwise = do unsafeRead src i >>= unsafeWrite dest j
219− memcpyI (maBA dest) (fromIntegral i0)
346+ copy_loop (i+1) (j+1) (c+1)
220− (aBA src) (fromIntegral j0)
221− (fromIntegral (top-i0))
222−{-# INLINE copyI #-}
223−
224−-- | Compare portions of two arrays for equality. No bounds checking
225−-- is performed.
226−equal :: Array -- ^ First
227− -> Int -- ^ Offset into first
228− -> Array -- ^ Second
229− -> Int -- ^ Offset into second
230− -> Int -- ^ Count
231− -> Bool
232−equal arrA offA arrB offB count = inlinePerformIO $ do
233− i <- memcmp (aBA arrA) (fromIntegral offA)
234− (aBA arrB) (fromIntegral offB) (fromIntegral count)
235− return $! i == 0
236−{-# INLINE equal #-}
347+{-# INLINE unsafeCopy #-}
237−
238−foreign import ccall unsafe "_hs_text_memcpy" memcpyI
239− :: MutableByteArray# s -> CSize -> ByteArray# -> CSize -> CSize -> IO ()
240−
241−foreign import ccall unsafe "_hs_text_memcmp" memcmp
242− :: ByteArray# -> CSize -> ByteArray# -> CSize -> CSize -> IO CInt
243−
244−foreign import ccall unsafe "_hs_text_memcpy" memcpyM
245− :: MutableByteArray# s -> CSize -> MutableByteArray# s -> CSize -> CSize
246− -> IO ()
Data/Text/Encoding.hs+23−375
@@ -1,40 +1,30 @@
1−{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, GeneralizedNewtypeDeriving, MagicHash,
2− UnliftedFFITypes #-}
3−#if __GLASGOW_HASKELL__ >= 702
4−{-# LANGUAGE Trustworthy #-}
5−#endif
6-- |
1-- |
7-- Module : Data.Text.Encoding
2-- Module : Data.Text.Encoding
3+-- Copyright : (c) Tom Harper 2008-2009,
8−-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan,
4+-- (c) Bryan O'Sullivan 2009,
9−-- (c) 2009 Duncan Coutts,
5+-- (c) Duncan Coutts 2009
10−-- (c) 2008, 2009 Tom Harper
11--
6--
12-- License : BSD-style
7-- License : BSD-style
13−-- Maintainer : bos@serpentine.com
8+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,
9+-- duncan@haskell.org
14-- Stability : experimental
10-- Stability : experimental
15-- Portability : portable
11-- Portability : portable
16--
12--
17-- Functions for converting 'Text' values to and from 'ByteString',
13-- Functions for converting 'Text' values to and from 'ByteString',
18-- using several standard encodings.
14-- using several standard encodings.
19--
15--
20−-- To gain access to a much larger family of encodings, use the
16+-- To make use of a much larger variety of encodings, use the @text-icu@
21−-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>
17+-- package.
22
18
23module Data.Text.Encoding
19module Data.Text.Encoding
24 (
20 (
25 -- * Decoding ByteStrings to Text
21 -- * Decoding ByteStrings to Text
26− -- $strict
27 decodeASCII
22 decodeASCII
28− , decodeLatin1
29 , decodeUtf8
23 , decodeUtf8
30 , decodeUtf16LE
24 , decodeUtf16LE
31 , decodeUtf16BE
25 , decodeUtf16BE
32 , decodeUtf32LE
26 , decodeUtf32LE
33 , decodeUtf32BE
27 , decodeUtf32BE
34−
35− -- ** Catchable failure
36− , decodeUtf8'
37−
38 -- ** Controllable error handling
28 -- ** Controllable error handling
39 , decodeUtf8With
29 , decodeUtf8With
40 , decodeUtf16LEWith
30 , decodeUtf16LEWith
@@ -42,350 +32,39 @@ module Data.Text.Encoding
42 , decodeUtf32LEWith
32 , decodeUtf32LEWith
43 , decodeUtf32BEWith
33 , decodeUtf32BEWith
44
34
45− -- ** Stream oriented decoding
46− -- $stream
47− , streamDecodeUtf8
48− , streamDecodeUtf8With
49− , Decoding(..)
50−
51 -- * Encoding Text to ByteStrings
35 -- * Encoding Text to ByteStrings
52 , encodeUtf8
36 , encodeUtf8
53 , encodeUtf16LE
37 , encodeUtf16LE
54 , encodeUtf16BE
38 , encodeUtf16BE
55 , encodeUtf32LE
39 , encodeUtf32LE
56 , encodeUtf32BE
40 , encodeUtf32BE
57−
58− -- * Encoding Text using ByteString Builders
59− , encodeUtf8Builder
60− , encodeUtf8BuilderEscaped
61 ) where
41 ) where
62−
42+
63−#if __GLASGOW_HASKELL__ >= 702
64−import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
65−#else
66−import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)
67−#endif
68−
69−import Control.Exception (evaluate, try)
70−import Control.Monad.ST (runST)
71−import Data.Bits ((.&.))
43+import Data.ByteString (ByteString)
72−import Data.ByteString as B
44+import qualified Data.Text.Fusion as F
73−import Data.ByteString.Internal as B hiding (c2w)
74−import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
45+import Data.Text.Encoding.Error (OnDecodeError, strictDecode)
75−import Data.Text.Internal (Text(..), safe, text)
46+import qualified Data.Text.Encoding.Fusion as E
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)
81−import Data.Word (Word8, Word32)
82−import Foreign.C.Types (CSize(..))
83−import Foreign.ForeignPtr (withForeignPtr)
84−import Foreign.Marshal.Utils (with)
85−import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
86−import 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
92−import 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
47+import Data.Text.Internal (Text)
95−import qualified Data.Text.Internal.Fusion as F
48+
96−
97−#include "text_cbits.h"
98−
99−-- $strict
100−--
101−-- All of the single-parameter functions for decoding bytestrings
102−-- encoded in one of the Unicode Transformation Formats (UTF) operate
103−-- in a /strict/ mode: each will throw an exception if given invalid
104−-- input.
105−--
106−-- Each function has a variant, whose name is suffixed with -'With',
107−-- that gives greater control over the handling of decoding errors.
108−-- For instance, 'decodeUtf8' will throw an exception, but
109−-- 'decodeUtf8With' allows the programmer to determine what to do on a
110−-- decoding error.
111−
112−-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
49+-- | Decode a 'ByteString' containing 7-bit ASCII encoded text.
113−-- encoded text.
114decodeASCII :: ByteString -> Text
50decodeASCII :: ByteString -> Text
115−decodeASCII = decodeUtf8
51+decodeASCII bs = F.unstream (E.streamASCII bs)
116−{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
52+{-# INLINE decodeASCII #-}
117−
118−-- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.
119−--
120−-- 'decodeLatin1' is semantically equivalent to
121−-- @Data.Text.pack . Data.ByteString.Char8.unpack@
122−decodeLatin1 :: ByteString -> Text
123−decodeLatin1 (PS fp off len) = text a 0 len
124− where
125− a = A.run (A.new len >>= unsafeIOToST . go)
126− go dest = withForeignPtr fp $ \ptr -> do
127− c_decode_latin1 (A.maBA dest) (ptr `plusPtr` off) (ptr `plusPtr` (off+len))
128− return dest
129
53
130-- | Decode a 'ByteString' containing UTF-8 encoded text.
54-- | Decode a 'ByteString' containing UTF-8 encoded text.
131decodeUtf8With :: OnDecodeError -> ByteString -> Text
55decodeUtf8With :: OnDecodeError -> ByteString -> Text
132−decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
56+decodeUtf8With onErr bs = F.unstream (E.streamUtf8 onErr bs)
133− let go dest = withForeignPtr fp $ \ptr ->
134− with (0::CSize) $ \destOffPtr -> do
135− let end = ptr `plusPtr` (off + len)
136− loop curPtr = do
137− curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end
138− if curPtr' == end
139− then do
140− n <- peek destOffPtr
141− unsafeSTToIO (done dest (fromIntegral n))
142− else do
143− x <- peek curPtr'
144− case onErr desc (Just x) of
145− Nothing -> loop $ curPtr' `plusPtr` 1
146− Just c -> do
147− destOff <- peek destOffPtr
148− w <- unsafeSTToIO $
149− unsafeWrite dest (fromIntegral destOff) (safe c)
150− poke destOffPtr (destOff + fromIntegral w)
151− loop $ curPtr' `plusPtr` 1
152− loop (ptr `plusPtr` off)
153− (unsafeIOToST . go) =<< A.new len
154− where
155− desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
156−{- INLINE[0] decodeUtf8With #-}
57+{-# INLINE decodeUtf8With #-}
157−
158−-- $stream
159−--
160−-- The 'streamDecodeUtf8' and 'streamDecodeUtf8With' functions accept
161−-- a 'ByteString' that represents a possibly incomplete input (e.g. a
162−-- packet from a network stream) that may not end on a UTF-8 boundary.
163−--
164−-- 1. The maximal prefix of 'Text' that could be decoded from the
165−-- given input.
166−--
167−-- 2. The suffix of the 'ByteString' that could not be decoded due to
168−-- insufficient input.
169−--
170−-- 3. A function that accepts another 'ByteString'. That string will
171−-- be assumed to directly follow the string that was passed as
172−-- input to the original function, and it will in turn be decoded.
173−--
174−-- To help understand the use of these functions, consider the Unicode
175−-- string @\"hi &#9731;\"@. If encoded as UTF-8, this becomes @\"hi
176−-- \\xe2\\x98\\x83\"@; the final @\'&#9731;\'@ is encoded as 3 bytes.
177−--
178−-- Now suppose that we receive this encoded string as 3 packets that
179−-- are split up on untidy boundaries: @[\"hi \\xe2\", \"\\x98\",
180−-- \"\\x83\"]@. We cannot decode the entire Unicode string until we
181−-- have received all three packets, but we would like to make progress
182−-- as we receive each one.
183−--
184−-- @
185−-- ghci> let s0\@('Some' _ _ f0) = 'streamDecodeUtf8' \"hi \\xe2\"
186−-- ghci> s0
187−-- 'Some' \"hi \" \"\\xe2\" _
188−-- @
189−--
190−-- We use the continuation @f0@ to decode our second packet.
191−--
192−-- @
193−-- ghci> let s1\@('Some' _ _ f1) = f0 \"\\x98\"
194−-- ghci> s1
195−-- 'Some' \"\" \"\\xe2\\x98\"
196−-- @
197−--
198−-- We could not give @f0@ enough input to decode anything, so it
199−-- returned an empty string. Once we feed our second continuation @f1@
200−-- the last byte of input, it will make progress.
201−--
202−-- @
203−-- ghci> let s2\@('Some' _ _ f2) = f1 \"\\x83\"
204−-- ghci> s2
205−-- 'Some' \"\\x2603\" \"\" _
206−-- @
207−--
208−-- If given invalid input, an exception will be thrown by the function
209−-- or continuation where it is encountered.
210
58
211−-- | A stream oriented decoding result.
212−data Decoding = Some Text ByteString (ByteString -> Decoding)
213−
214−instance Show Decoding where
215− showsPrec d (Some t bs _) = showParen (d > prec) $
216− showString "Some " . showsPrec prec' t .
217− showChar ' ' . showsPrec prec' bs .
218− showString " _"
219− where prec = 10; prec' = prec + 1
220−
221−newtype CodePoint = CodePoint Word32 deriving (Eq, Show, Num, Storable)
222−newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable)
223−
224−-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
59+-- | Decode a 'ByteString' containing UTF-8 encoded text.
225−-- encoded text that is known to be valid.
226−--
227−-- If the input contains any invalid UTF-8 data, an exception will be
228−-- thrown (either by this function or a continuation) that cannot be
229−-- caught in pure code. For more control over the handling of invalid
230−-- data, use 'streamDecodeUtf8With'.
231−streamDecodeUtf8 :: ByteString -> Decoding
232−streamDecodeUtf8 = streamDecodeUtf8With strictDecode
233−
234−-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
235−-- encoded text.
236−streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
237−streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
238− where
239− -- We create a slightly larger than necessary buffer to accommodate a
240− -- potential surrogate pair started in the last buffer
241− decodeChunk :: ByteString -> CodePoint -> DecoderState -> ByteString
242− -> Decoding
243− decodeChunk undecoded0 codepoint0 state0 bs@(PS fp off len) =
244− runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)
245− where
246− decodeChunkToBuffer :: A.MArray s -> IO Decoding
247− decodeChunkToBuffer dest = withForeignPtr fp $ \ptr ->
248− with (0::CSize) $ \destOffPtr ->
249− with codepoint0 $ \codepointPtr ->
250− with state0 $ \statePtr ->
251− with nullPtr $ \curPtrPtr ->
252− let end = ptr `plusPtr` (off + len)
253− loop curPtr = do
254− poke curPtrPtr curPtr
255− curPtr' <- c_decode_utf8_with_state (A.maBA dest) destOffPtr
256− curPtrPtr end codepointPtr statePtr
257− state <- peek statePtr
258− case state of
259− UTF8_REJECT -> do
260− -- We encountered an encoding error
261− x <- peek curPtr'
262− poke statePtr 0
263− case onErr desc (Just x) of
264− Nothing -> loop $ curPtr' `plusPtr` 1
265− Just c -> do
266− destOff <- peek destOffPtr
267− w <- unsafeSTToIO $
268− unsafeWrite dest (fromIntegral destOff) (safe c)
269− poke destOffPtr (destOff + fromIntegral w)
270− loop $ curPtr' `plusPtr` 1
271−
272− _ -> do
273− -- We encountered the end of the buffer while decoding
274− n <- peek destOffPtr
275− codepoint <- peek codepointPtr
276− chunkText <- unsafeSTToIO $ do
277− arr <- A.unsafeFreeze dest
278− return $! text arr 0 (fromIntegral n)
279− lastPtr <- peek curPtrPtr
280− let left = lastPtr `minusPtr` curPtr
281− !undecoded = case state of
282− UTF8_ACCEPT -> B.empty
283− _ -> B.append undecoded0 (B.drop left bs)
284− return $ Some chunkText undecoded
285− (decodeChunk undecoded codepoint state)
286− in loop (ptr `plusPtr` off)
287− desc = "Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"
288−
289−-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
290−-- to be valid.
291−--
292−-- If the input contains any invalid UTF-8 data, an exception will be
293−-- thrown that cannot be caught in pure code. For more control over
294−-- the handling of invalid data, use 'decodeUtf8'' or
295−-- 'decodeUtf8With'.
296decodeUtf8 :: ByteString -> Text
60decodeUtf8 :: ByteString -> Text
297decodeUtf8 = decodeUtf8With strictDecode
61decodeUtf8 = decodeUtf8With strictDecode
298−{-# INLINE[0] decodeUtf8 #-}
62+{-# INLINE decodeUtf8 #-}
299−{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
300− forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}
301−
302−-- | Decode a 'ByteString' containing UTF-8 encoded text.
303−--
304−-- If the input contains any invalid UTF-8 data, the relevant
305−-- exception will be returned, otherwise the decoded text.
306−decodeUtf8' :: ByteString -> Either UnicodeException Text
307−decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode
308−{-# INLINE decodeUtf8' #-}
309−
310−-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
311−encodeUtf8Builder :: Text -> B.Builder
312−encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
313−
314−-- | Encode text using UTF-8 encoding and escape the ASCII characters using
315−-- a 'BP.BoundedPrim'.
316−--
317−-- Use this function is to implement efficient encoders for text-based formats
318−-- like JSON or HTML.
319−{-# INLINE encodeUtf8BuilderEscaped #-}
320−-- TODO: Extend documentation with references to source code in @blaze-html@
321−-- or @aeson@ that uses this function.
322−encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
323−encodeUtf8BuilderEscaped be =
324− -- manual eta-expansion to ensure inlining works as expected
325− \txt -> B.builder (mkBuildstep txt)
326− where
327− bound = max 4 $ BP.sizeBound be
328−
329− mkBuildstep (Text arr off len) !k =
330− outerLoop off
331− where
332− iend = off + len
333−
334− outerLoop !i0 !br@(B.BufferRange op0 ope)
335− | i0 >= iend = k br
336− | outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining)
337− -- TODO: Use a loop with an integrated bound's check if outRemaining
338− -- is smaller than 8, as this will save on divisions.
339− | otherwise = return $ B.bufferFull bound op0 (outerLoop i0)
340− where
341− outRemaining = (ope `minusPtr` op0) `div` bound
342− inpRemaining = iend - i0
343−
344− goPartial !iendTmp = go i0 op0
345− where
346− go !i !op
347− | i < iendTmp = case A.unsafeIndex arr i of
348− w | w <= 0x7F -> do
349− BP.runB be (fromIntegral w) op >>= go (i + 1)
350− | w <= 0x7FF -> do
351− poke8 0 $ (w `shiftR` 6) + 0xC0
352− poke8 1 $ (w .&. 0x3f) + 0x80
353− go (i + 1) (op `plusPtr` 2)
354− | 0xD800 <= w && w <= 0xDBFF -> do
355− let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))
356− poke8 0 $ (c `shiftR` 18) + 0xF0
357− poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80
358− poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80
359− poke8 3 $ (c .&. 0x3F) + 0x80
360− go (i + 2) (op `plusPtr` 4)
361− | otherwise -> do
362− poke8 0 $ (w `shiftR` 12) + 0xE0
363− poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80
364− poke8 2 $ (w .&. 0x3F) + 0x80
365− go (i + 1) (op `plusPtr` 3)
366− | otherwise =
367− outerLoop i (B.BufferRange op ope)
368− where
369− poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)
370
63
371-- | Encode text using UTF-8 encoding.
64-- | Encode text using UTF-8 encoding.
372encodeUtf8 :: Text -> ByteString
65encodeUtf8 :: Text -> ByteString
373−encodeUtf8 (Text arr off len)
66+encodeUtf8 txt = E.unstream (E.restreamUtf8 (F.stream txt))
374− | len == 0 = B.empty
67+{-# INLINE encodeUtf8 #-}
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)
389
68
390-- | Decode text from little endian UTF-16 encoding.
69-- | Decode text from little endian UTF-16 encoding.
391decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
70decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
@@ -393,10 +72,6 @@ decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)
393{-# INLINE decodeUtf16LEWith #-}
72{-# INLINE decodeUtf16LEWith #-}
394
73
395-- | Decode text from little endian UTF-16 encoding.
74-- | Decode text from little endian UTF-16 encoding.
396−--
397−-- If the input contains any invalid little endian UTF-16 data, an
398−-- exception will be thrown. For more control over the handling of
399−-- invalid data, use 'decodeUtf16LEWith'.
400decodeUtf16LE :: ByteString -> Text
75decodeUtf16LE :: ByteString -> Text
401decodeUtf16LE = decodeUtf16LEWith strictDecode
76decodeUtf16LE = decodeUtf16LEWith strictDecode
402{-# INLINE decodeUtf16LE #-}
77{-# INLINE decodeUtf16LE #-}
@@ -407,10 +82,6 @@ decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)
407{-# INLINE decodeUtf16BEWith #-}
82{-# INLINE decodeUtf16BEWith #-}
408
83
409-- | Decode text from big endian UTF-16 encoding.
84-- | Decode text from big endian UTF-16 encoding.
410−--
411−-- If the input contains any invalid big endian UTF-16 data, an
412−-- exception will be thrown. For more control over the handling of
413−-- invalid data, use 'decodeUtf16BEWith'.
414decodeUtf16BE :: ByteString -> Text
85decodeUtf16BE :: ByteString -> Text
415decodeUtf16BE = decodeUtf16BEWith strictDecode
86decodeUtf16BE = decodeUtf16BEWith strictDecode
416{-# INLINE decodeUtf16BE #-}
87{-# INLINE decodeUtf16BE #-}
@@ -431,10 +102,6 @@ decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)
431{-# INLINE decodeUtf32LEWith #-}
102{-# INLINE decodeUtf32LEWith #-}
432
103
433-- | Decode text from little endian UTF-32 encoding.
104-- | Decode text from little endian UTF-32 encoding.
434−--
435−-- If the input contains any invalid little endian UTF-32 data, an
436−-- exception will be thrown. For more control over the handling of
437−-- invalid data, use 'decodeUtf32LEWith'.
438decodeUtf32LE :: ByteString -> Text
105decodeUtf32LE :: ByteString -> Text
439decodeUtf32LE = decodeUtf32LEWith strictDecode
106decodeUtf32LE = decodeUtf32LEWith strictDecode
440{-# INLINE decodeUtf32LE #-}
107{-# INLINE decodeUtf32LE #-}
@@ -445,10 +112,6 @@ decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)
445{-# INLINE decodeUtf32BEWith #-}
112{-# INLINE decodeUtf32BEWith #-}
446
113
447-- | Decode text from big endian UTF-32 encoding.
114-- | Decode text from big endian UTF-32 encoding.
448−--
449−-- If the input contains any invalid big endian UTF-32 data, an
450−-- exception will be thrown. For more control over the handling of
451−-- invalid data, use 'decodeUtf32BEWith'.
452decodeUtf32BE :: ByteString -> Text
115decodeUtf32BE :: ByteString -> Text
453decodeUtf32BE = decodeUtf32BEWith strictDecode
116decodeUtf32BE = decodeUtf32BEWith strictDecode
454{-# INLINE decodeUtf32BE #-}
117{-# INLINE decodeUtf32BE #-}
@@ -462,18 +125,3 @@ encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))
462encodeUtf32BE :: Text -> ByteString
125encodeUtf32BE :: Text -> ByteString
463encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
126encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
464{-# INLINE encodeUtf32BE #-}
127{-# INLINE encodeUtf32BE #-}
465−
466−foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8
467− :: MutableByteArray# s -> Ptr CSize
468− -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
469−
470−foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state
471− :: MutableByteArray# s -> Ptr CSize
472− -> Ptr (Ptr Word8) -> Ptr Word8
473− -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)
474−
475−foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
476− :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
477−
478−foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
479− :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()
Data/Text/Encoding/Error.hs+8−25
@@ -1,15 +1,11 @@
1−{-# LANGUAGE CPP, DeriveDataTypeable #-}
1+{-# LANGUAGE DeriveDataTypeable #-}
2−#if __GLASGOW_HASKELL__ >= 704
3−{-# LANGUAGE Safe #-}
4−#elif __GLASGOW_HASKELL__ >= 702
5−{-# LANGUAGE Trustworthy #-}
6−#endif
7-- |
2-- |
8-- Module : Data.Text.Encoding.Error
3-- Module : Data.Text.Encoding.Error
9-- Copyright : (c) Bryan O'Sullivan 2009
4-- Copyright : (c) Bryan O'Sullivan 2009
10--
5--
11-- License : BSD-style
6-- License : BSD-style
12−-- Maintainer : bos@serpentine.com
7+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,
8+-- duncan@haskell.org
13-- Stability : experimental
9-- Stability : experimental
14-- Portability : GHC
10-- Portability : GHC
15--
11--
@@ -39,7 +35,6 @@ module Data.Text.Encoding.Error
39 , replace
35 , replace
40 ) where
36 ) where
41
37
42−import Control.DeepSeq (NFData (..))
43import Control.Exception (Exception, throw)
38import Control.Exception (Exception, throw)
44import Data.Typeable (Typeable)
39import Data.Typeable (Typeable)
45import Data.Word (Word8)
40import Data.Word (Word8)
@@ -63,12 +58,7 @@ import Numeric (showHex)
63-- use the description provided to construct a more helpful error
58-- use the description provided to construct a more helpful error
64-- report.
59-- report.
65type OnError a b = String -> Maybe a -> Maybe b
60type OnError a b = String -> Maybe a -> Maybe b
66−
67−-- | A handler for a decoding error.
68type OnDecodeError = OnError Word8 Char
61type OnDecodeError = OnError Word8 Char
69−
70−-- | A handler for an encoding error.
71−{-# DEPRECATED OnEncodeError "This exception is never used in practice, and will be removed." #-}
72type OnEncodeError = OnError Char Word8
62type OnEncodeError = OnError Char Word8
73
63
74-- | An exception type for representing Unicode encoding errors.
64-- | An exception type for representing Unicode encoding errors.
@@ -79,9 +69,7 @@ data UnicodeException =
79 | EncodeError String (Maybe Char)
69 | EncodeError String (Maybe Char)
80 -- ^ Tried to encode a character that could not be represented
70 -- ^ Tried to encode a character that could not be represented
81 -- under the given encoding, or ran out of input in mid-encode.
71 -- under the given encoding, or ran out of input in mid-encode.
82− deriving (Eq, Typeable)
72+ deriving (Typeable)
83−
84−{-# DEPRECATED EncodeError "This constructor is never used, and will be removed." #-}
85
73
86showUnicodeException :: UnicodeException -> String
74showUnicodeException :: UnicodeException -> String
87showUnicodeException (DecodeError desc (Just w))
75showUnicodeException (DecodeError desc (Just w))
@@ -92,28 +80,23 @@ showUnicodeException (EncodeError desc (Just c))
92 = "Cannot encode character '\\x" ++ showHex (fromEnum c) ("': " ++ desc)
80 = "Cannot encode character '\\x" ++ showHex (fromEnum c) ("': " ++ desc)
93showUnicodeException (EncodeError desc Nothing)
81showUnicodeException (EncodeError desc Nothing)
94 = "Cannot encode input: " ++ desc
82 = "Cannot encode input: " ++ desc
95−
83+
96instance Show UnicodeException where
84instance Show UnicodeException where
97 show = showUnicodeException
85 show = showUnicodeException
98
86
99instance Exception UnicodeException
87instance Exception UnicodeException
100
88
101−instance NFData UnicodeException where
102− rnf (DecodeError desc w) = rnf desc `seq` rnf w `seq` ()
103− rnf (EncodeError desc c) = rnf desc `seq` rnf c `seq` ()
104−
105-- | Throw a 'UnicodeException' if decoding fails.
89-- | Throw a 'UnicodeException' if decoding fails.
106−strictDecode :: OnDecodeError
90+strictDecode :: OnError Word8 Char
107strictDecode desc c = throw (DecodeError desc c)
91strictDecode desc c = throw (DecodeError desc c)
108
92
109-- | Replace an invalid input byte with the Unicode replacement
93-- | Replace an invalid input byte with the Unicode replacement
110-- character U+FFFD.
94-- character U+FFFD.
111−lenientDecode :: OnDecodeError
95+lenientDecode :: OnError Word8 Char
112lenientDecode _ _ = Just '\xfffd'
96lenientDecode _ _ = Just '\xfffd'
113
97
114-- | Throw a 'UnicodeException' if encoding fails.
98-- | Throw a 'UnicodeException' if encoding fails.
115−{-# DEPRECATED strictEncode "This function always throws an exception, and will be removed." #-}
116−strictEncode :: OnEncodeError
99+strictEncode :: OnError Char Word8
117strictEncode desc c = throw (EncodeError desc c)
100strictEncode desc c = throw (EncodeError desc c)
118
101
119-- | Ignore an invalid input, substituting nothing in the output.
102-- | Ignore an invalid input, substituting nothing in the output.
Data/Text/Internal/Encoding/Fusion.hs → Data/Text/Encoding/Fusion.hsrenamed+28−37
@@ -1,24 +1,21 @@
1−{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
1+{-# LANGUAGE BangPatterns, Rank2Types #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Internal.Encoding.Fusion
4+-- Module : Data.Text.Encoding.Fusion
5-- Copyright : (c) Tom Harper 2008-2009,
5-- Copyright : (c) Tom Harper 2008-2009,
6-- (c) Bryan O'Sullivan 2009,
6-- (c) Bryan O'Sullivan 2009,
7-- (c) Duncan Coutts 2009
7-- (c) Duncan Coutts 2009
8--
8--
9-- License : BSD-style
9-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,
11+-- duncan@haskell.org
11-- Stability : experimental
12-- Stability : experimental
12-- Portability : portable
13-- Portability : portable
13--
14--
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−--
18-- Fusible 'Stream'-oriented functions for converting between 'Text'
15-- Fusible 'Stream'-oriented functions for converting between 'Text'
19-- and several common encodings.
16-- and several common encodings.
20
17
21−module Data.Text.Internal.Encoding.Fusion
18+module Data.Text.Encoding.Fusion
22 (
19 (
23 -- * Streaming
20 -- * Streaming
24 streamASCII
21 streamASCII
@@ -31,31 +28,29 @@ module Data.Text.Internal.Encoding.Fusion
31 -- * Unstreaming
28 -- * Unstreaming
32 , unstream
29 , unstream
33
30
34− , module Data.Text.Internal.Encoding.Fusion.Common
31+ , module Data.Text.Encoding.Fusion.Common
35 ) where
32 ) where
36
33
37−#if defined(ASSERTS)
38import Control.Exception (assert)
34import Control.Exception (assert)
39−#endif
35+import Data.ByteString as B
40import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)
36import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)
41−import Data.Text.Internal.Fusion (Step(..), Stream(..))
37+import Data.Text.Fusion (Step(..), Stream(..))
42−import Data.Text.Internal.Fusion.Size
43import Data.Text.Encoding.Error
38import Data.Text.Encoding.Error
44−import Data.Text.Internal.Encoding.Fusion.Common
39+import Data.Text.Encoding.Fusion.Common
45−import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)
40+import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)
46−import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
41+import Data.Text.UnsafeShift (shiftL)
47import Data.Word (Word8, Word16, Word32)
42import Data.Word (Word8, Word16, Word32)
48import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
43import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
49import Foreign.Storable (pokeByteOff)
44import Foreign.Storable (pokeByteOff)
45+import System.IO.Unsafe (unsafePerformIO)
50import qualified Data.ByteString as B
46import qualified Data.ByteString as B
51import qualified Data.ByteString.Unsafe as B
47import qualified Data.ByteString.Unsafe as B
52−import qualified Data.Text.Internal.Encoding.Utf8 as U8
48+import qualified Data.Text.Encoding.Utf8 as U8
53−import qualified Data.Text.Internal.Encoding.Utf16 as U16
49+import qualified Data.Text.Encoding.Utf16 as U16
54−import qualified Data.Text.Internal.Encoding.Utf32 as U32
50+import qualified Data.Text.Encoding.Utf32 as U32
55−import Data.Text.Unsafe (unsafeDupablePerformIO)
56
51
57streamASCII :: ByteString -> Stream Char
52streamASCII :: ByteString -> Stream Char
58−streamASCII bs = Stream next 0 (maxSize l)
53+streamASCII bs = Stream next 0 l
59 where
54 where
60 l = B.length bs
55 l = B.length bs
61 {-# INLINE next #-}
56 {-# INLINE next #-}
@@ -64,23 +59,24 @@ streamASCII bs = Stream next 0 (maxSize l)
64 | otherwise = Yield (unsafeChr8 x1) (i+1)
59 | otherwise = Yield (unsafeChr8 x1) (i+1)
65 where
60 where
66 x1 = B.unsafeIndex bs i
61 x1 = B.unsafeIndex bs i
67−{-# DEPRECATED streamASCII "Do not use this function" #-}
68{-# INLINE [0] streamASCII #-}
62{-# INLINE [0] streamASCII #-}
69
63
70-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8
64-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8
71-- encoding.
65-- encoding.
72streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
66streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
73−streamUtf8 onErr bs = Stream next 0 (maxSize l)
67+streamUtf8 onErr bs = Stream next 0 l
74 where
68 where
75 l = B.length bs
69 l = B.length bs
70+ {-# INLINE next #-}
76 next i
71 next i
77 | i >= l = Done
72 | i >= l = Done
78 | U8.validate1 x1 = Yield (unsafeChr8 x1) (i+1)
73 | U8.validate1 x1 = Yield (unsafeChr8 x1) (i+1)
79 | i+1 < l && U8.validate2 x1 x2 = Yield (U8.chr2 x1 x2) (i+2)
74 | i+1 < l && U8.validate2 x1 x2 = Yield (U8.chr2 x1 x2) (i+2)
80 | i+2 < l && U8.validate3 x1 x2 x3 = Yield (U8.chr3 x1 x2 x3) (i+3)
75 | i+2 < l && U8.validate3 x1 x2 x3 = Yield (U8.chr3 x1 x2 x3) (i+3)
81 | i+3 < l && U8.validate4 x1 x2 x3 x4 = Yield (U8.chr4 x1 x2 x3 x4) (i+4)
76 | i+3 < l && U8.validate4 x1 x2 x3 x4 = Yield (U8.chr4 x1 x2 x3 x4) (i+4)
82− | otherwise = decodeError "streamUtf8" "UTF-8" onErr (Just x1) (i+1)
77+ | otherwise = decodeError "streamUtf8" "UTF-8" onErr mx (i+1)
83 where
78 where
79+ mx = if i >= l then Nothing else Just x1
84 x1 = idx i
80 x1 = idx i
85 x2 = idx (i + 1)
81 x2 = idx (i + 1)
86 x3 = idx (i + 2)
82 x3 = idx (i + 2)
@@ -91,7 +87,7 @@ streamUtf8 onErr bs = Stream next 0 (maxSize l)
91-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
87-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
92-- endian UTF-16 encoding.
88-- endian UTF-16 encoding.
93streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
89streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
94−streamUtf16LE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))
90+streamUtf16LE onErr bs = Stream next 0 l
95 where
91 where
96 l = B.length bs
92 l = B.length bs
97 {-# INLINE next #-}
93 {-# INLINE next #-}
@@ -109,7 +105,7 @@ streamUtf16LE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))
109-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
105-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
110-- endian UTF-16 encoding.
106-- endian UTF-16 encoding.
111streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
107streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
112−streamUtf16BE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))
108+streamUtf16BE onErr bs = Stream next 0 l
113 where
109 where
114 l = B.length bs
110 l = B.length bs
115 {-# INLINE next #-}
111 {-# INLINE next #-}
@@ -127,7 +123,7 @@ streamUtf16BE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))
127-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
123-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
128-- endian UTF-32 encoding.
124-- endian UTF-32 encoding.
129streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
125streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
130−streamUtf32BE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))
126+streamUtf32BE onErr bs = Stream next 0 l
131 where
127 where
132 l = B.length bs
128 l = B.length bs
133 {-# INLINE next #-}
129 {-# INLINE next #-}
@@ -147,7 +143,7 @@ streamUtf32BE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))
147-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
143-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
148-- endian UTF-32 encoding.
144-- endian UTF-32 encoding.
149streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
145streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
150−streamUtf32LE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))
146+streamUtf32LE onErr bs = Stream next 0 l
151 where
147 where
152 l = B.length bs
148 l = B.length bs
153 {-# INLINE next #-}
149 {-# INLINE next #-}
@@ -166,9 +162,8 @@ streamUtf32LE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))
166
162
167-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.
163-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.
168unstream :: Stream Word8 -> ByteString
164unstream :: Stream Word8 -> ByteString
169−unstream (Stream next s0 len) = unsafeDupablePerformIO $ do
165+unstream (Stream next s0 len) = unsafePerformIO $ do
170− let mlen = upperBound 4 len
171− mallocByteString mlen >>= loop mlen 0 s0
166+ mallocByteString len >>= loop len 0 s0
172 where
167 where
173 loop !n !off !s fp = case next s of
168 loop !n !off !s fp = case next s of
174 Done -> trimUp fp n off
169 Done -> trimUp fp n off
@@ -187,11 +182,7 @@ unstream (Stream next s0 len) = unsafeDupablePerformIO $ do
187 {-# NOINLINE trimUp #-}
182 {-# NOINLINE trimUp #-}
188 trimUp fp _ off = return $! PS fp 0 off
183 trimUp fp _ off = return $! PS fp 0 off
189 copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)
184 copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)
190− copy0 !src !srcLen !destLen =
185+ copy0 !src !srcLen !destLen = assert (srcLen <= destLen) $ do
191−#if defined(ASSERTS)
192− assert (srcLen <= destLen) $
193−#endif
194− do
195 dest <- mallocByteString destLen
186 dest <- mallocByteString destLen
196 withForeignPtr src $ \src' ->
187 withForeignPtr src $ \src' ->
197 withForeignPtr dest $ \dest' ->
188 withForeignPtr dest $ \dest' ->
@@ -204,5 +195,5 @@ decodeError func kind onErr mb i =
204 case onErr desc mb of
195 case onErr desc mb of
205 Nothing -> Skip i
196 Nothing -> Skip i
206 Just c -> Yield c i
197 Just c -> Yield c i
207− where desc = "Data.Text.Internal.Encoding.Fusion." ++ func ++ ": Invalid " ++
198+ where desc = "Data.Text.Encoding.Fusion." ++ func ++ ": Invalid " ++
208 kind ++ " stream"
199 kind ++ " stream"
Data/Text/Encoding/Fusion/Common.hsnew file+162
@@ -0,0 +1,162 @@
1+{-# LANGUAGE BangPatterns #-}
2+
3+-- |
4+-- Module : Data.Text.Encoding.Fusion.Common
5+-- Copyright : (c) Tom Harper 2008-2009,
6+-- (c) Bryan O'Sullivan 2009,
7+-- (c) Duncan Coutts 2009
8+--
9+-- License : BSD-style
10+-- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,
11+-- duncan@haskell.org
12+-- Stability : experimental
13+-- Portability : portable
14+--
15+-- Fusible 'Stream'-oriented functions for converting between 'Text'
16+-- and several common encodings.
17+
18+module Data.Text.Encoding.Fusion.Common
19+ (
20+ -- * Restreaming
21+ -- Restreaming is the act of converting from one 'Stream'
22+ -- representation to another.
23+ restreamUtf8
24+ , restreamUtf16LE
25+ , restreamUtf16BE
26+ , restreamUtf32LE
27+ , restreamUtf32BE
28+ ) where
29+
30+import Data.Bits ((.&.))
31+import Data.Char (ord)
32+import Data.Text.Fusion (Step(..), Stream(..))
33+import Data.Text.Fusion.Internal (M(..), S(..))
34+import Data.Text.UnsafeShift (shiftR)
35+import Data.Word (Word8)
36+import qualified Data.Text.Encoding.Utf8 as U8
37+
38+-- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.
39+restreamUtf8 :: Stream Char -> Stream Word8
40+restreamUtf8 (Stream next0 s0 len) =
41+ Stream next (S s0 N N N) (len*2)
42+ where
43+ {-# INLINE next #-}
44+ next (S s N N N) = case next0 s of
45+ Done -> Done
46+ Skip s' -> Skip (S s' N N N)
47+ Yield x xs
48+ | n <= 0x7F -> Yield c (S xs N N N)
49+ | n <= 0x07FF -> Yield a2 (S xs (J b2) N N)
50+ | n <= 0xFFFF -> Yield a3 (S xs (J b3) (J c3) N)
51+ | otherwise -> Yield a4 (S xs (J b4) (J c4) (J d4))
52+ where
53+ n = ord x
54+ c = fromIntegral n
55+ (a2,b2) = U8.ord2 x
56+ (a3,b3,c3) = U8.ord3 x
57+ (a4,b4,c4,d4) = U8.ord4 x
58+ next (S s (J x2) N N) = Yield x2 (S s N N N)
59+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
60+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
61+ next _ = internalError "restreamUtf8"
62+{-# INLINE restreamUtf8 #-}
63+
64+restreamUtf16BE :: Stream Char -> Stream Word8
65+restreamUtf16BE (Stream next0 s0 len) =
66+ Stream next (S s0 N N N) (len*2)
67+ where
68+ {-# INLINE next #-}
69+ next (S s N N N) = case next0 s of
70+ Done -> Done
71+ Skip s' -> Skip (S s' N N N)
72+ Yield x xs
73+ | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $
74+ S xs (J $ fromIntegral n) N N
75+ | otherwise -> Yield c1 $
76+ S xs (J c2) (J c3) (J c4)
77+ where
78+ n = ord x
79+ n1 = n - 0x10000
80+ c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)
81+ c2 = fromIntegral (n1 `shiftR` 10)
82+ n2 = n1 .&. 0x3FF
83+ c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)
84+ c4 = fromIntegral n2
85+ next (S s (J x2) N N) = Yield x2 (S s N N N)
86+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
87+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
88+ next _ = internalError "restreamUtf16BE"
89+{-# INLINE restreamUtf16BE #-}
90+
91+restreamUtf16LE :: Stream Char -> Stream Word8
92+restreamUtf16LE (Stream next0 s0 len) =
93+ Stream next (S s0 N N N) (len*2)
94+ where
95+ {-# INLINE next #-}
96+ next (S s N N N) = case next0 s of
97+ Done -> Done
98+ Skip s' -> Skip (S s' N N N)
99+ Yield x xs
100+ | n < 0x10000 -> Yield (fromIntegral n) $
101+ S xs (J (fromIntegral $ shiftR n 8)) N N
102+ | otherwise -> Yield c1 $
103+ S xs (J c2) (J c3) (J c4)
104+ where
105+ n = ord x
106+ n1 = n - 0x10000
107+ c2 = fromIntegral (shiftR n1 18 + 0xD8)
108+ c1 = fromIntegral (shiftR n1 10)
109+ n2 = n1 .&. 0x3FF
110+ c4 = fromIntegral (shiftR n2 8 + 0xDC)
111+ c3 = fromIntegral n2
112+ next (S s (J x2) N N) = Yield x2 (S s N N N)
113+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
114+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
115+ next _ = internalError "restreamUtf16LE"
116+{-# INLINE restreamUtf16LE #-}
117+
118+restreamUtf32BE :: Stream Char -> Stream Word8
119+restreamUtf32BE (Stream next0 s0 len) =
120+ Stream next (S s0 N N N) (len*2)
121+ where
122+ {-# INLINE next #-}
123+ next (S s N N N) = case next0 s of
124+ Done -> Done
125+ Skip s' -> Skip (S s' N N N)
126+ Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))
127+ where
128+ n = ord x
129+ c1 = fromIntegral $ shiftR n 24
130+ c2 = fromIntegral $ shiftR n 16
131+ c3 = fromIntegral $ shiftR n 8
132+ c4 = fromIntegral n
133+ next (S s (J x2) N N) = Yield x2 (S s N N N)
134+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
135+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
136+ next _ = internalError "restreamUtf32BE"
137+{-# INLINE restreamUtf32BE #-}
138+
139+restreamUtf32LE :: Stream Char -> Stream Word8
140+restreamUtf32LE (Stream next0 s0 len) =
141+ Stream next (S s0 N N N) (len*2)
142+ where
143+ {-# INLINE next #-}
144+ next (S s N N N) = case next0 s of
145+ Done -> Done
146+ Skip s' -> Skip (S s' N N N)
147+ Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))
148+ where
149+ n = ord x
150+ c4 = fromIntegral $ shiftR n 24
151+ c3 = fromIntegral $ shiftR n 16
152+ c2 = fromIntegral $ shiftR n 8
153+ c1 = fromIntegral n
154+ next (S s (J x2) N N) = Yield x2 (S s N N N)
155+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
156+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
157+ next _ = internalError "restreamUtf32LE"
158+{-# INLINE restreamUtf32LE #-}
159+
160+internalError :: String -> a
161+internalError func =
162+ error $ "Data.Text.Encoding.Fusion.Common." ++ func ++ ": internal error"
Data/Text/Encoding/Utf16.hsnew file+42
@@ -0,0 +1,42 @@
1+{-# LANGUAGE MagicHash #-}
2+
3+-- |
4+-- Module : Data.Text.Encoding.Utf16
5+-- Copyright : (c) Tom Harper 2008-2009,
6+-- (c) Bryan O'Sullivan 2009,
7+-- (c) Duncan Coutts 2009
8+--
9+-- License : BSD-style
10+-- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,
11+-- duncan@haskell.org
12+-- Stability : experimental
13+-- Portability : GHC
14+--
15+-- Basic UTF-16 validation and character manipulation.
16+module Data.Text.Encoding.Utf16
17+ (
18+ chr2
19+ , validate1
20+ , validate2
21+ ) where
22+
23+import GHC.Exts
24+import GHC.Word (Word16(..))
25+
26+chr2 :: Word16 -> Word16 -> Char
27+chr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#))
28+ where
29+ x# = word2Int# a#
30+ y# = word2Int# b#
31+ upper# = uncheckedIShiftL# (x# -# 0xD800#) 10#
32+ lower# = y# -# 0xDC00#
33+{-# INLINE chr2 #-}
34+
35+validate1 :: Word16 -> Bool
36+validate1 x1 = (x1 >= 0 && x1 < 0xD800) || x1 > 0xDFFF
37+{-# INLINE validate1 #-}
38+
39+validate2 :: Word16 -> Word16 -> Bool
40+validate2 x1 x2 = x1 >= 0xD800 && x1 <= 0xDBFF &&
41+ x2 >= 0xDC00 && x2 <= 0xDFFF
42+{-# INLINE validate2 #-}
Data/Text/Encoding/Utf32.hsnew file+23
@@ -0,0 +1,23 @@
1+-- |
2+-- Module : Data.Text.Encoding.Utf16
3+-- Copyright : (c) Tom Harper 2008-2009,
4+-- (c) Bryan O'Sullivan 2009,
5+-- (c) Duncan Coutts 2009
6+--
7+-- License : BSD-style
8+-- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,
9+-- duncan@haskell.org
10+-- Stability : experimental
11+-- Portability : portable
12+--
13+-- Basic UTF-32 validation.
14+module Data.Text.Encoding.Utf32
15+ (
16+ validate
17+ ) where
18+
19+import Data.Word (Word32)
20+
21+validate :: Word32 -> Bool
22+validate x1 = (x1 >= 0x0 && x1 < 0xD800) || (x1 > 0xDFFF && x1 <= 0x10FFFF)
23+{-# INLINE validate #-}
Data/Text/Internal/Encoding/Utf8.hs → Data/Text/Encoding/Utf8.hsrenamed+49−65
@@ -1,22 +1,19 @@
1−{-# LANGUAGE CPP, MagicHash, BangPatterns #-}
1+{-# LANGUAGE MagicHash #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Internal.Encoding.Utf8
4+-- Module : Data.Text.Encoding.Utf16
5−-- Copyright : (c) 2008, 2009 Tom Harper,
5+-- Copyright : (c) Tom Harper 2008-2009,
6−-- (c) 2009, 2010 Bryan O'Sullivan,
6+-- (c) Bryan O'Sullivan 2009,
7−-- (c) 2009 Duncan Coutts
7+-- (c) Duncan Coutts 2009
8--
8--
9-- License : BSD-style
9-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,
11+-- duncan@haskell.org
11-- Stability : experimental
12-- Stability : experimental
12-- Portability : GHC
13-- Portability : GHC
13--
14--
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−--
18-- Basic UTF-8 validation and character manipulation.
15-- Basic UTF-8 validation and character manipulation.
19−module Data.Text.Internal.Encoding.Utf8
16+module Data.Text.Encoding.Utf8
20 (
17 (
21 -- Decomposition
18 -- Decomposition
22 ord2
19 ord2
@@ -33,16 +30,10 @@ module Data.Text.Internal.Encoding.Utf8
33 , validate4
30 , validate4
34 ) where
31 ) where
35
32
36−#if defined(TEST_SUITE)
37−# undef ASSERTS
38−#endif
39−
40−#if defined(ASSERTS)
41import Control.Exception (assert)
33import Control.Exception (assert)
42−#endif
34+import Data.Char (ord)
43import Data.Bits ((.&.))
35import Data.Bits ((.&.))
44−import Data.Text.Internal.Unsafe.Char (ord)
36+import Data.Text.UnsafeShift (shiftR)
45−import Data.Text.Internal.Unsafe.Shift (shiftR)
46import GHC.Exts
37import GHC.Exts
47import GHC.Word (Word8(..))
38import GHC.Word (Word8(..))
48
39
@@ -55,35 +46,23 @@ between :: Word8 -- ^ byte to check
55between x y z = x >= y && x <= z
46between x y z = x >= y && x <= z
56{-# INLINE between #-}
47{-# INLINE between #-}
57
48
58−ord2 :: Char -> (Word8,Word8)
49+ord2 :: Char -> (Word8,Word8)
59−ord2 c =
60−#if defined(ASSERTS)
61− assert (n >= 0x80 && n <= 0x07ff)
50+ord2 c = assert (n >= 0x80 && n <= 0x07ff) (x1,x2)
62−#endif
63− (x1,x2)
64 where
51 where
65 n = ord c
52 n = ord c
66 x1 = fromIntegral $ (n `shiftR` 6) + 0xC0
53 x1 = fromIntegral $ (n `shiftR` 6) + 0xC0
67 x2 = fromIntegral $ (n .&. 0x3F) + 0x80
54 x2 = fromIntegral $ (n .&. 0x3F) + 0x80
68
55
69−ord3 :: Char -> (Word8,Word8,Word8)
56+ord3 :: Char -> (Word8,Word8,Word8)
70−ord3 c =
71−#if defined(ASSERTS)
72− assert (n >= 0x0800 && n <= 0xffff)
57+ord3 c = assert (n >= 0x0800 && n <= 0xffff) (x1,x2,x3)
73−#endif
74− (x1,x2,x3)
75 where
58 where
76 n = ord c
59 n = ord c
77 x1 = fromIntegral $ (n `shiftR` 12) + 0xE0
60 x1 = fromIntegral $ (n `shiftR` 12) + 0xE0
78 x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
61 x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
79 x3 = fromIntegral $ (n .&. 0x3F) + 0x80
62 x3 = fromIntegral $ (n .&. 0x3F) + 0x80
80
63
81−ord4 :: Char -> (Word8,Word8,Word8,Word8)
64+ord4 :: Char -> (Word8,Word8,Word8,Word8)
82−ord4 c =
83−#if defined(ASSERTS)
84− assert (n >= 0x10000)
65+ord4 c = assert (n >= 0x10000) (x1,x2,x3,x4)
85−#endif
86− (x1,x2,x3,x4)
87 where
66 where
88 n = ord c
67 n = ord c
89 x1 = fromIntegral $ (n `shiftR` 18) + 0xF0
68 x1 = fromIntegral $ (n `shiftR` 18) + 0xF0
@@ -91,51 +70,54 @@ ord4 c =
91 x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
70 x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
92 x4 = fromIntegral $ (n .&. 0x3F) + 0x80
71 x4 = fromIntegral $ (n .&. 0x3F) + 0x80
93
72
94−chr2 :: Word8 -> Word8 -> Char
73+chr2 :: Word8 -> Word8 -> Char
95chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))
74chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))
96 where
75 where
97− !y1# = word2Int# x1#
76+ y1# = word2Int# x1#
98− !y2# = word2Int# x2#
77+ y2# = word2Int# x2#
99− !z1# = uncheckedIShiftL# (y1# -# 0xC0#) 6#
78+ z1# = uncheckedIShiftL# (y1# -# 0xC0#) 6#
100− !z2# = y2# -# 0x80#
79+ z2# = y2# -# 0x80#
101{-# INLINE chr2 #-}
80{-# INLINE chr2 #-}
102
81
103−chr3 :: Word8 -> Word8 -> Word8 -> Char
82+chr3 :: Word8 -> Word8 -> Word8 -> Char
104chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))
83chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))
105 where
84 where
106− !y1# = word2Int# x1#
85+ y1# = word2Int# x1#
107− !y2# = word2Int# x2#
86+ y2# = word2Int# x2#
108− !y3# = word2Int# x3#
87+ y3# = word2Int# x3#
109− !z1# = uncheckedIShiftL# (y1# -# 0xE0#) 12#
88+ z1# = uncheckedIShiftL# (y1# -# 0xE0#) 12#
110− !z2# = uncheckedIShiftL# (y2# -# 0x80#) 6#
89+ z2# = uncheckedIShiftL# (y2# -# 0x80#) 6#
111− !z3# = y3# -# 0x80#
90+ z3# = y3# -# 0x80#
112{-# INLINE chr3 #-}
91{-# INLINE chr3 #-}
113
92
114chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char
93chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char
115chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =
94chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =
116 C# (chr# (z1# +# z2# +# z3# +# z4#))
95 C# (chr# (z1# +# z2# +# z3# +# z4#))
117 where
96 where
118− !y1# = word2Int# x1#
97+ y1# = word2Int# x1#
119− !y2# = word2Int# x2#
98+ y2# = word2Int# x2#
120− !y3# = word2Int# x3#
99+ y3# = word2Int# x3#
121− !y4# = word2Int# x4#
100+ y4# = word2Int# x4#
122− !z1# = uncheckedIShiftL# (y1# -# 0xF0#) 18#
101+ z1# = uncheckedIShiftL# (y1# -# 0xF0#) 18#
123− !z2# = uncheckedIShiftL# (y2# -# 0x80#) 12#
102+ z2# = uncheckedIShiftL# (y2# -# 0x80#) 12#
124− !z3# = uncheckedIShiftL# (y3# -# 0x80#) 6#
103+ z3# = uncheckedIShiftL# (y3# -# 0x80#) 6#
125− !z4# = y4# -# 0x80#
104+ z4# = y4# -# 0x80#
126{-# INLINE chr4 #-}
105{-# INLINE chr4 #-}
127
106
128−validate1 :: Word8 -> Bool
107+validate1 :: Word8 -> Bool
129−validate1 x1 = x1 <= 0x7F
108+validate1 x1 = between x1 0x00 0x7F
130{-# INLINE validate1 #-}
109{-# INLINE validate1 #-}
131
110
132−validate2 :: Word8 -> Word8 -> Bool
111+validate2 :: Word8 -> Word8 -> Bool
133validate2 x1 x2 = between x1 0xC2 0xDF && between x2 0x80 0xBF
112validate2 x1 x2 = between x1 0xC2 0xDF && between x2 0x80 0xBF
134{-# INLINE validate2 #-}
113{-# INLINE validate2 #-}
135
114
136−validate3 :: Word8 -> Word8 -> Word8 -> Bool
115+validate3 :: Word8 -> Word8 -> Word8 -> Bool
137{-# INLINE validate3 #-}
116{-# INLINE validate3 #-}
138−validate3 x1 x2 x3 = validate3_1 || validate3_2 || validate3_3 || validate3_4
117+validate3 x1 x2 x3 = validate3_1 ||
118+ validate3_2 ||
119+ validate3_3 ||
120+ validate3_4
139 where
121 where
140 validate3_1 = (x1 == 0xE0) &&
122 validate3_1 = (x1 == 0xE0) &&
141 between x2 0xA0 0xBF &&
123 between x2 0xA0 0xBF &&
@@ -150,10 +132,12 @@ validate3 x1 x2 x3 = validate3_1 || validate3_2 || validate3_3 || validate3_4
150 between x2 0x80 0xBF &&
132 between x2 0x80 0xBF &&
151 between x3 0x80 0xBF
133 between x3 0x80 0xBF
152
134
153−validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool
135+validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool
154{-# INLINE validate4 #-}
136{-# INLINE validate4 #-}
155−validate4 x1 x2 x3 x4 = validate4_1 || validate4_2 || validate4_3
137+validate4 x1 x2 x3 x4 = validate4_1 ||
138+ validate4_2 ||
139+ validate4_3
156− where
140+ where
157 validate4_1 = x1 == 0xF0 &&
141 validate4_1 = x1 == 0xF0 &&
158 between x2 0x90 0xBF &&
142 between x2 0x90 0xBF &&
159 between x3 0x80 0xBF &&
143 between x3 0x80 0xBF &&
Data/Text/Foreign.hs+18−102
@@ -1,10 +1,11 @@
1−{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving #-}
1+{-# LANGUAGE BangPatterns #-}
2-- |
2-- |
3-- Module : Data.Text.Foreign
3-- Module : Data.Text.Foreign
4−-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
4+-- Copyright : (c) Bryan O'Sullivan 2009
5--
5--
6-- License : BSD-style
6-- License : BSD-style
7−-- Maintainer : bos@serpentine.com
7+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,
8+-- duncan@haskell.org
8-- Stability : experimental
9-- Stability : experimental
9-- Portability : GHC
10-- Portability : GHC
10--
11--
@@ -15,42 +16,23 @@ module Data.Text.Foreign
15 (
16 (
16 -- * Interoperability with native code
17 -- * Interoperability with native code
17 -- $interop
18 -- $interop
18− I16
19+
19 -- * Safe conversion functions
20 -- * Safe conversion functions
20− , fromPtr
21+ fromPtr
21 , useAsPtr
22 , useAsPtr
22− , asForeignPtr
23− -- ** Encoding as UTF-8
24− , peekCStringLen
25− , withCStringLen
26 -- * Unsafe conversion code
23 -- * Unsafe conversion code
27 , lengthWord16
24 , lengthWord16
28 , unsafeCopyToPtr
25 , unsafeCopyToPtr
29− -- * Low-level manipulation
30− -- $lowlevel
31− , dropWord16
32− , takeWord16
33 ) where
26 ) where
34
27
35−#if defined(ASSERTS)
36import Control.Exception (assert)
28import Control.Exception (assert)
37−#endif
38−#if __GLASGOW_HASKELL__ >= 702
39−import Control.Monad.ST.Unsafe (unsafeIOToST)
40−#else
41import Control.Monad.ST (unsafeIOToST)
29import Control.Monad.ST (unsafeIOToST)
42−#endif
43−import Data.ByteString.Unsafe (unsafePackCStringLen, unsafeUseAsCStringLen)
44−import Data.Text.Encoding (decodeUtf8, encodeUtf8)
45import Data.Text.Internal (Text(..), empty)
30import Data.Text.Internal (Text(..), empty)
46−import Data.Text.Unsafe (lengthWord16)
31+import qualified Data.Text.Array as A
47import Data.Word (Word16)
32import Data.Word (Word16)
48−import Foreign.C.String (CStringLen)
49−import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray, withForeignPtr)
50import Foreign.Marshal.Alloc (allocaBytes)
33import Foreign.Marshal.Alloc (allocaBytes)
51import Foreign.Ptr (Ptr, castPtr, plusPtr)
34import Foreign.Ptr (Ptr, castPtr, plusPtr)
52import Foreign.Storable (peek, poke)
35import Foreign.Storable (peek, poke)
53−import qualified Data.Text.Array as A
54
36
55-- $interop
37-- $interop
56--
38--
@@ -65,23 +47,15 @@ import qualified Data.Text.Array as A
65-- internal representations, such as UTF-8 or UTF-32, consider using
47-- internal representations, such as UTF-8 or UTF-32, consider using
66-- the functions in the 'Data.Text.Encoding' module.
48-- the functions in the 'Data.Text.Encoding' module.
67
49
68−-- | A type representing a number of UTF-16 code units.
69−newtype I16 = I16 Int
70− deriving (Bounded, Enum, Eq, Integral, Num, Ord, Read, Real, Show)
71−
72-- | /O(n)/ Create a new 'Text' from a 'Ptr' 'Word16' by copying the
50-- | /O(n)/ Create a new 'Text' from a 'Ptr' 'Word16' by copying the
73-- contents of the array.
51-- contents of the array.
74fromPtr :: Ptr Word16 -- ^ source array
52fromPtr :: Ptr Word16 -- ^ source array
75− -> I16 -- ^ length of source array (in 'Word16' units)
53+ -> Int -- ^ length of source array (in 'Word16' units)
76 -> IO Text
54 -> IO Text
77−fromPtr _ (I16 0) = return empty
55+fromPtr _ 0 = return empty
78−fromPtr ptr (I16 len) =
79−#if defined(ASSERTS)
80− assert (len > 0) $
81−#endif
82− return $! Text arr 0 len
56+fromPtr ptr len = assert (len > 0) $ return (Text arr 0 len)
83 where
57 where
84− arr = A.run (A.new len >>= copy)
58+ arr = A.run (A.unsafeNew len >>= copy)
85 copy marr = loop ptr 0
59 copy marr = loop ptr 0
86 where
60 where
87 loop !p !i | i == len = return marr
61 loop !p !i | i == len = return marr
@@ -89,44 +63,11 @@ fromPtr ptr (I16 len) =
89 A.unsafeWrite marr i =<< unsafeIOToST (peek p)
63 A.unsafeWrite marr i =<< unsafeIOToST (peek p)
90 loop (p `plusPtr` 2) (i + 1)
64 loop (p `plusPtr` 2) (i + 1)
91
65
92−-- $lowlevel
66+-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
93−--
67+-- is useful for sizing a target array appropriately before using
94−-- Foreign functions that use UTF-16 internally may return indices in
68+-- 'unsafeCopyToPtr'.
95−-- units of 'Word16' instead of characters. These functions may
69+lengthWord16 :: Text -> Int
96−-- safely be used with such indices, as they will adjust offsets if
70+lengthWord16 (Text _arr _off len) = len
97−-- necessary to preserve the validity of a Unicode string.
98−
99−-- | /O(1)/ Return the prefix of the 'Text' of @n@ 'Word16' units in
100−-- length.
101−--
102−-- If @n@ would cause the 'Text' to end inside a surrogate pair, the
103−-- end of the prefix will be advanced by one additional 'Word16' unit
104−-- to maintain its validity.
105−takeWord16 :: I16 -> Text -> Text
106−takeWord16 (I16 n) t@(Text arr off len)
107− | n <= 0 = empty
108− | n >= len || m >= len = t
109− | otherwise = Text arr off m
110− where
111− m | w < 0xDB00 || w > 0xD8FF = n
112− | otherwise = n+1
113− w = A.unsafeIndex arr (off+n-1)
114−
115−-- | /O(1)/ Return the suffix of the 'Text', with @n@ 'Word16' units
116−-- dropped from its beginning.
117−--
118−-- If @n@ would cause the 'Text' to begin inside a surrogate pair, the
119−-- beginning of the suffix will be advanced by one additional 'Word16'
120−-- unit to maintain its validity.
121−dropWord16 :: I16 -> Text -> Text
122−dropWord16 (I16 n) t@(Text arr off len)
123− | n <= 0 = t
124− | n >= len || m >= len = empty
125− | otherwise = Text arr (off+m) (len-m)
126− where
127− m | w < 0xD800 || w > 0xDBFF = n
128− | otherwise = n+1
129− w = A.unsafeIndex arr (off+n-1)
130
71
131-- | /O(n)/ Copy a 'Text' to an array. The array is assumed to be big
72-- | /O(n)/ Copy a 'Text' to an array. The array is assumed to be big
132-- enough to hold the contents of the entire 'Text'.
73-- enough to hold the contents of the entire 'Text'.
@@ -141,33 +82,8 @@ unsafeCopyToPtr (Text arr off len) ptr = loop ptr off
141
82
142-- | /O(n)/ Perform an action on a temporary, mutable copy of a
83-- | /O(n)/ Perform an action on a temporary, mutable copy of a
143-- 'Text'. The copy is freed as soon as the action returns.
84-- 'Text'. The copy is freed as soon as the action returns.
144−useAsPtr :: Text -> (Ptr Word16 -> I16 -> IO a) -> IO a
85+useAsPtr :: Text -> (Ptr Word16 -> Int -> IO a) -> IO a
145useAsPtr t@(Text _arr _off len) action =
86useAsPtr t@(Text _arr _off len) action =
146 allocaBytes (len * 2) $ \buf -> do
87 allocaBytes (len * 2) $ \buf -> do
147 unsafeCopyToPtr t buf
88 unsafeCopyToPtr t buf
148− action (castPtr buf) (fromIntegral len)
89+ action (castPtr buf) len
149−
150−-- | /O(n)/ Make a mutable copy of a 'Text'.
151−asForeignPtr :: Text -> IO (ForeignPtr Word16, I16)
152−asForeignPtr t@(Text _arr _off len) = do
153− fp <- mallocForeignPtrArray len
154− withForeignPtr fp $ unsafeCopyToPtr t
155− return (fp, I16 len)
156−
157−-- | /O(n)/ Decode a C string with explicit length, which is assumed
158−-- to have been encoded as UTF-8. If decoding fails, a
159−-- 'UnicodeException' is thrown.
160−peekCStringLen :: CStringLen -> IO Text
161−peekCStringLen cs = do
162− bs <- unsafePackCStringLen cs
163− return $! decodeUtf8 bs
164−
165−-- | Marshal a 'Text' into a C string encoded as UTF-8 in temporary
166−-- storage, with explicit length information. The encoded string may
167−-- contain NUL bytes, and is not followed by a trailing NUL byte.
168−--
169−-- The temporary storage is freed when the subcomputation terminates
170−-- (either normally or via an exception), so the pointer to the
171−-- temporary storage must /not/ be used after this function returns.
172−withCStringLen :: Text -> (CStringLen -> IO a) -> IO a
173−withCStringLen t act = unsafeUseAsCStringLen (encodeUtf8 t) act
Data/Text/Internal/Fusion.hs → Data/Text/Fusion.hsrenamed+88−98
@@ -1,23 +1,20 @@
1{-# LANGUAGE BangPatterns, MagicHash #-}
1{-# LANGUAGE BangPatterns, MagicHash #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Internal.Fusion
4+-- Module : Data.Text.Fusion
5-- Copyright : (c) Tom Harper 2008-2009,
5-- Copyright : (c) Tom Harper 2008-2009,
6−-- (c) Bryan O'Sullivan 2009-2010,
6+-- (c) Bryan O'Sullivan 2009,
7-- (c) Duncan Coutts 2009
7-- (c) Duncan Coutts 2009
8--
8--
9-- License : BSD-style
9-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,
11+-- duncan@haskell.org
11-- Stability : experimental
12-- Stability : experimental
12-- Portability : GHC
13-- Portability : GHC
13--
14--
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−--
18-- Text manipulation functions represented as fusible operations over
15-- Text manipulation functions represented as fusible operations over
19-- streams.
16-- streams.
20−module Data.Text.Internal.Fusion
17+module Data.Text.Fusion
21 (
18 (
22 -- * Types
19 -- * Types
23 Stream(..)
20 Stream(..)
@@ -37,40 +34,42 @@ module Data.Text.Internal.Fusion
37 -- ** Scans
34 -- ** Scans
38 , reverseScanr
35 , reverseScanr
39
36
40− -- ** Accumulating maps
41− , mapAccumL
42−
43 -- ** Generation and unfolding
37 -- ** Generation and unfolding
44 , unfoldrN
38 , unfoldrN
45
39
46 -- * Indexing
40 -- * Indexing
47 , index
41 , index
48 , findIndex
42 , findIndex
49− , countChar
43+ , findIndices
44+ , findIndexOrEnd
45+ , elemIndex
46+ , elemIndices
47+ , count
50 ) where
48 ) where
51
49
52−import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,
50+import Prelude (Bool(..), Char, Eq(..), Maybe(..), Monad(..), Int,
53 Num(..), Ord(..), ($), (&&),
51 Num(..), Ord(..), ($), (&&),
54 fromIntegral, otherwise)
52 fromIntegral, otherwise)
55import Data.Bits ((.&.))
53import Data.Bits ((.&.))
54+import Data.Char (ord)
56import Data.Text.Internal (Text(..))
55import Data.Text.Internal (Text(..))
57−import Data.Text.Internal.Private (runText)
58−import Data.Text.Internal.Unsafe.Char (ord, unsafeChr, unsafeWrite)
56+import Data.Text.UnsafeChar (unsafeChr, unsafeWrite)
59−import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
57+import Data.Text.UnsafeShift (shiftR)
60import qualified Data.Text.Array as A
58import qualified Data.Text.Array as A
61−import qualified Data.Text.Internal.Fusion.Common as S
59+import qualified Data.Text.Fusion.Common as S
62−import Data.Text.Internal.Fusion.Types
60+import Data.Text.Fusion.Internal
63−import Data.Text.Internal.Fusion.Size
64import qualified Data.Text.Internal as I
61import 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
63+import qualified Prelude as P
66
64
67default(Int)
65default(Int)
68
66
69-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
67-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
70stream :: Text -> Stream Char
68stream :: Text -> Stream Char
71−stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)
69+stream (Text arr off len) = Stream next off len
72 where
70 where
73− !end = off+len
71+ end = off+len
72+ {-# INLINE next #-}
74 next !i
73 next !i
75 | i >= end = Done
74 | i >= end = Done
76 | n >= 0xD800 && n <= 0xDBFF = Yield (U16.chr2 n n2) (i + 2)
75 | n >= 0xD800 && n <= 0xDBFF = Yield (U16.chr2 n n2) (i + 2)
@@ -83,7 +82,7 @@ stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)
83-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate
82-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate
84-- backwards.
83-- backwards.
85reverseStream :: Text -> Stream Char
84reverseStream :: Text -> Stream Char
86−reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `shiftR` 1) len)
85+reverseStream (Text arr off len) = Stream next (off+len-1) len
87 where
86 where
88 {-# INLINE next #-}
87 {-# INLINE next #-}
89 next !i
88 next !i
@@ -97,36 +96,21 @@ reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `sh
97
96
98-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
97-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
99unstream :: Stream Char -> Text
98unstream :: Stream Char -> Text
100−unstream (Stream next0 s0 len) = runText $ \done -> do
99+unstream (Stream next0 s0 len)
101− -- Before encoding each char we perform a buffer realloc check assuming
100+ | len == 0 = I.empty
102− -- worst case encoding size of two 16-bit units for the char. Just add an
101+ | otherwise = I.textP (P.fst a) 0 (P.snd a)
103− -- extra space to the buffer so that we do not end up reallocating even when
102+ where
104− -- all the chars are encoded as single unit.
103+ a = A.run2 (A.unsafeNew len >>= (\arr -> loop arr len s0 0))
105− let mlen = upperBound 4 len + 1
104+ loop arr !top !s !i
106− arr0 <- A.new mlen
105+ | i + 1 >= top = case next0 s of
107− let outer !arr !maxi = encode
106+ Done -> return (arr, i)
108− where
107+ _ -> do
109− -- keep the common case loop as small as possible
108+ arr' <- A.unsafeNew (top*2)
110− encode !si !di =
109+ A.copy arr arr' >> loop arr' (top*2) s i
111− case next0 si of
110+ | otherwise = case next0 s of
112− Done -> done arr di
111+ Done -> return (arr, i)
113− Skip si' -> encode si' di
112+ Skip s' -> loop arr top s' i
114− Yield c si'
113+ Yield x s' -> unsafeWrite arr i x >>= loop arr top s'
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
130{-# INLINE [0] unstream #-}
114{-# INLINE [0] unstream #-}
131{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
115{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
132
116
@@ -141,20 +125,20 @@ length = S.lengthI
141-- | /O(n)/ Reverse the characters of a string.
125-- | /O(n)/ Reverse the characters of a string.
142reverse :: Stream Char -> Text
126reverse :: Stream Char -> Text
143reverse (Stream next s len0)
127reverse (Stream next s len0)
144− | isEmpty len0 = I.empty
128+ | len0 == 0 = I.empty
145− | otherwise = I.text arr off' len'
129+ | otherwise = I.textP arr off' len'
146 where
130 where
147− len0' = upperBound 4 (larger len0 4)
131+ len0' = max len0 4
148− (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')
132+ (arr, (off', len')) = A.run2 (A.unsafeNew len0' >>= loop s (len0'-1) len0')
149 loop !s0 !i !len marr =
133 loop !s0 !i !len marr =
150 case next s0 of
134 case next s0 of
151 Done -> return (marr, (j, len-j))
135 Done -> return (marr, (j, len-j))
152 where j = i + 1
136 where j = i + 1
153 Skip s1 -> loop s1 i len marr
137 Skip s1 -> loop s1 i len marr
154− Yield x s1 | i < least -> {-# SCC "reverse/resize" #-} do
138+ Yield x s1 | i < least -> do
155− let newLen = len `shiftL` 1
139+ let newLen = len * 2
156− marr' <- A.new newLen
140+ marr' <- A.unsafeNew newLen
157− A.copyM marr' (newLen-len) marr 0 len
141+ A.unsafeCopy marr 0 marr' (newLen-len) len
158 write s1 (len+i) newLen marr'
142 write s1 (len+i) newLen marr'
159 | otherwise -> write s1 i len marr
143 | otherwise -> write s1 i len marr
160 where n = ord x
144 where n = ord x
@@ -176,15 +160,15 @@ reverse (Stream next s len0)
176-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with
160-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with
177-- the input and result reversed.
161-- the input and result reversed.
178reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
162reverseScanr :: (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
163+reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :!: z0 :!: s0) (len+1) -- HINT maybe too low
180 where
164 where
181 {-# INLINE next #-}
165 {-# INLINE next #-}
182− next (Scan1 z s) = Yield z (Scan2 z s)
166+ next (S1 :!: z :!: s) = Yield z (S2 :!: z :!: s)
183− next (Scan2 z s) = case next0 s of
167+ next (S2 :!: z :!: s) = case next0 s of
184− Yield x s' -> let !x' = f x z
168+ Yield x s' -> let !x' = f x z
185− in Yield x' (Scan2 x' s')
169+ in Yield x' (S2 :!: x' :!: s')
186− Skip s' -> Skip (Scan2 z s')
170+ Skip s' -> Skip (S2 :!: z :!: s')
187− Done -> Done
171+ Done -> Done
188{-# INLINE reverseScanr #-}
172{-# INLINE reverseScanr #-}
189
173
190-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
174-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
@@ -210,35 +194,41 @@ findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int
210findIndex = S.findIndexI
194findIndex = S.findIndexI
211{-# INLINE [0] findIndex #-}
195{-# INLINE [0] findIndex #-}
212
196
197+-- | The 'findIndices' function takes a predicate and a stream and
198+-- returns all indices of the elements in the stream
199+-- satisfying the predicate.
200+findIndices :: (Char -> Bool) -> Stream Char -> [Int]
201+findIndices = S.findIndicesI
202+{-# INLINE [0] findIndices #-}
203+
204+-- | The 'findIndexOrEnd' function takes a predicate and a stream and
205+-- returns the index of the first element in the stream
206+-- satisfying the predicate.
207+findIndexOrEnd :: (Char -> Bool) -> Stream Char -> Int
208+findIndexOrEnd p (Stream next s0 _len) = loop_findIndex 0 s0
209+ where
210+ loop_findIndex !i !s = case next s of
211+ Done -> i
212+ Skip s' -> loop_findIndex i s' -- hmm. not caught by QC
213+ Yield x s' | p x -> i
214+ | otherwise -> loop_findIndex (i+1) s'
215+{-# INLINE [0] findIndexOrEnd #-}
216+
217+-- | /O(n)/ The 'elemIndex' function returns the index of the first
218+-- element in the given stream which is equal to the query
219+-- element, or 'Nothing' if there is no such element.
220+elemIndex :: Char -> Stream Char -> Maybe Int
221+elemIndex = S.elemIndexI
222+{-# INLINE [0] elemIndex #-}
223+
224+-- | /O(n)/ The 'elemIndices' function returns the index of every
225+-- element in the given stream which is equal to the query element.
226+elemIndices :: Char -> Stream Char -> [Int]
227+elemIndices = S.elemIndicesI
228+{-# INLINE [0] elemIndices #-}
229+
213-- | /O(n)/ The 'count' function returns the number of times the query
230-- | /O(n)/ The 'count' function returns the number of times the query
214-- element appears in the given stream.
231-- element appears in the given stream.
215−countChar :: Char -> Stream Char -> Int
232+count :: Char -> Stream Char -> Int
216−countChar = S.countCharI
233+count = S.countI
217−{-# INLINE [0] countChar #-}
234+{-# INLINE [0] count #-}
218−
219−-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
220−-- function to each element of a 'Text', passing an accumulating
221−-- parameter from left to right, and returns a final 'Text'.
222−mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)
223−mapAccumL f z0 (Stream next0 s0 len) = (nz, I.text na 0 nl)
224− where
225− (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)
226− where mlen = upperBound 4 len
227− outer arr top = loop
228− where
229− loop !z !s !i =
230− case next0 s of
231− Done -> return (arr, (z,i))
232− Skip s' -> loop z s' i
233− Yield x s'
234− | j >= top -> {-# SCC "mapAccumL/resize" #-} do
235− let top' = (top + 1) `shiftL` 1
236− arr' <- A.new top'
237− A.copyM arr' 0 arr 0 top
238− outer arr' top' z s i
239− | otherwise -> do d <- unsafeWrite arr i c
240− loop z' s' (i+d)
241− where (z',c) = f z x
242− j | ord c < 0x10000 = i
243− | otherwise = i + 1
244−{-# INLINE [0] mapAccumL #-}
Data/Text/Fusion/CaseMapping.hsnew file+456
@@ -0,0 +1,456 @@
1+{-# LANGUAGE Rank2Types #-}
2+-- AUTOMATICALLY GENERATED - DO NOT EDIT
3+-- Generated by scripts/SpecialCasing.hs
4+module Data.Text.Fusion.CaseMapping where
5+import Data.Char
6+import Data.Text.Fusion.Internal
7+
8+upperMapping :: forall s. Char -> s -> Step (PairS (PairS s Char) Char) Char
9+{-# INLINE upperMapping #-}
10+-- LATIN SMALL LETTER SHARP S
11+upperMapping '\x00df' s = Yield '\x0053' (s :!: '\x0053' :!: '\x0000')
12+-- LATIN SMALL LIGATURE FF
13+upperMapping '\xfb00' s = Yield '\x0046' (s :!: '\x0046' :!: '\x0000')
14+-- LATIN SMALL LIGATURE FI
15+upperMapping '\xfb01' s = Yield '\x0046' (s :!: '\x0049' :!: '\x0000')
16+-- LATIN SMALL LIGATURE FL
17+upperMapping '\xfb02' s = Yield '\x0046' (s :!: '\x004c' :!: '\x0000')
18+-- LATIN SMALL LIGATURE FFI
19+upperMapping '\xfb03' s = Yield '\x0046' (s :!: '\x0046' :!: '\x0049')
20+-- LATIN SMALL LIGATURE FFL
21+upperMapping '\xfb04' s = Yield '\x0046' (s :!: '\x0046' :!: '\x004c')
22+-- LATIN SMALL LIGATURE LONG S T
23+upperMapping '\xfb05' s = Yield '\x0053' (s :!: '\x0054' :!: '\x0000')
24+-- LATIN SMALL LIGATURE ST
25+upperMapping '\xfb06' s = Yield '\x0053' (s :!: '\x0054' :!: '\x0000')
26+-- ARMENIAN SMALL LIGATURE ECH YIWN
27+upperMapping '\x0587' s = Yield '\x0535' (s :!: '\x0552' :!: '\x0000')
28+-- ARMENIAN SMALL LIGATURE MEN NOW
29+upperMapping '\xfb13' s = Yield '\x0544' (s :!: '\x0546' :!: '\x0000')
30+-- ARMENIAN SMALL LIGATURE MEN ECH
31+upperMapping '\xfb14' s = Yield '\x0544' (s :!: '\x0535' :!: '\x0000')
32+-- ARMENIAN SMALL LIGATURE MEN INI
33+upperMapping '\xfb15' s = Yield '\x0544' (s :!: '\x053b' :!: '\x0000')
34+-- ARMENIAN SMALL LIGATURE VEW NOW
35+upperMapping '\xfb16' s = Yield '\x054e' (s :!: '\x0546' :!: '\x0000')
36+-- ARMENIAN SMALL LIGATURE MEN XEH
37+upperMapping '\xfb17' s = Yield '\x0544' (s :!: '\x053d' :!: '\x0000')
38+-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE
39+upperMapping '\x0149' s = Yield '\x02bc' (s :!: '\x004e' :!: '\x0000')
40+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
41+upperMapping '\x0390' s = Yield '\x0399' (s :!: '\x0308' :!: '\x0301')
42+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
43+upperMapping '\x03b0' s = Yield '\x03a5' (s :!: '\x0308' :!: '\x0301')
44+-- LATIN SMALL LETTER J WITH CARON
45+upperMapping '\x01f0' s = Yield '\x004a' (s :!: '\x030c' :!: '\x0000')
46+-- LATIN SMALL LETTER H WITH LINE BELOW
47+upperMapping '\x1e96' s = Yield '\x0048' (s :!: '\x0331' :!: '\x0000')
48+-- LATIN SMALL LETTER T WITH DIAERESIS
49+upperMapping '\x1e97' s = Yield '\x0054' (s :!: '\x0308' :!: '\x0000')
50+-- LATIN SMALL LETTER W WITH RING ABOVE
51+upperMapping '\x1e98' s = Yield '\x0057' (s :!: '\x030a' :!: '\x0000')
52+-- LATIN SMALL LETTER Y WITH RING ABOVE
53+upperMapping '\x1e99' s = Yield '\x0059' (s :!: '\x030a' :!: '\x0000')
54+-- LATIN SMALL LETTER A WITH RIGHT HALF RING
55+upperMapping '\x1e9a' s = Yield '\x0041' (s :!: '\x02be' :!: '\x0000')
56+-- GREEK SMALL LETTER UPSILON WITH PSILI
57+upperMapping '\x1f50' s = Yield '\x03a5' (s :!: '\x0313' :!: '\x0000')
58+-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA
59+upperMapping '\x1f52' s = Yield '\x03a5' (s :!: '\x0313' :!: '\x0300')
60+-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA
61+upperMapping '\x1f54' s = Yield '\x03a5' (s :!: '\x0313' :!: '\x0301')
62+-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI
63+upperMapping '\x1f56' s = Yield '\x03a5' (s :!: '\x0313' :!: '\x0342')
64+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI
65+upperMapping '\x1fb6' s = Yield '\x0391' (s :!: '\x0342' :!: '\x0000')
66+-- GREEK SMALL LETTER ETA WITH PERISPOMENI
67+upperMapping '\x1fc6' s = Yield '\x0397' (s :!: '\x0342' :!: '\x0000')
68+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA
69+upperMapping '\x1fd2' s = Yield '\x0399' (s :!: '\x0308' :!: '\x0300')
70+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA
71+upperMapping '\x1fd3' s = Yield '\x0399' (s :!: '\x0308' :!: '\x0301')
72+-- GREEK SMALL LETTER IOTA WITH PERISPOMENI
73+upperMapping '\x1fd6' s = Yield '\x0399' (s :!: '\x0342' :!: '\x0000')
74+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI
75+upperMapping '\x1fd7' s = Yield '\x0399' (s :!: '\x0308' :!: '\x0342')
76+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA
77+upperMapping '\x1fe2' s = Yield '\x03a5' (s :!: '\x0308' :!: '\x0300')
78+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA
79+upperMapping '\x1fe3' s = Yield '\x03a5' (s :!: '\x0308' :!: '\x0301')
80+-- GREEK SMALL LETTER RHO WITH PSILI
81+upperMapping '\x1fe4' s = Yield '\x03a1' (s :!: '\x0313' :!: '\x0000')
82+-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI
83+upperMapping '\x1fe6' s = Yield '\x03a5' (s :!: '\x0342' :!: '\x0000')
84+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI
85+upperMapping '\x1fe7' s = Yield '\x03a5' (s :!: '\x0308' :!: '\x0342')
86+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI
87+upperMapping '\x1ff6' s = Yield '\x03a9' (s :!: '\x0342' :!: '\x0000')
88+-- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI
89+upperMapping '\x1f80' s = Yield '\x1f08' (s :!: '\x0399' :!: '\x0000')
90+-- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI
91+upperMapping '\x1f81' s = Yield '\x1f09' (s :!: '\x0399' :!: '\x0000')
92+-- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI
93+upperMapping '\x1f82' s = Yield '\x1f0a' (s :!: '\x0399' :!: '\x0000')
94+-- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI
95+upperMapping '\x1f83' s = Yield '\x1f0b' (s :!: '\x0399' :!: '\x0000')
96+-- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI
97+upperMapping '\x1f84' s = Yield '\x1f0c' (s :!: '\x0399' :!: '\x0000')
98+-- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI
99+upperMapping '\x1f85' s = Yield '\x1f0d' (s :!: '\x0399' :!: '\x0000')
100+-- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI
101+upperMapping '\x1f86' s = Yield '\x1f0e' (s :!: '\x0399' :!: '\x0000')
102+-- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
103+upperMapping '\x1f87' s = Yield '\x1f0f' (s :!: '\x0399' :!: '\x0000')
104+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI
105+upperMapping '\x1f88' s = Yield '\x1f08' (s :!: '\x0399' :!: '\x0000')
106+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI
107+upperMapping '\x1f89' s = Yield '\x1f09' (s :!: '\x0399' :!: '\x0000')
108+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI
109+upperMapping '\x1f8a' s = Yield '\x1f0a' (s :!: '\x0399' :!: '\x0000')
110+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI
111+upperMapping '\x1f8b' s = Yield '\x1f0b' (s :!: '\x0399' :!: '\x0000')
112+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI
113+upperMapping '\x1f8c' s = Yield '\x1f0c' (s :!: '\x0399' :!: '\x0000')
114+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI
115+upperMapping '\x1f8d' s = Yield '\x1f0d' (s :!: '\x0399' :!: '\x0000')
116+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI
117+upperMapping '\x1f8e' s = Yield '\x1f0e' (s :!: '\x0399' :!: '\x0000')
118+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
119+upperMapping '\x1f8f' s = Yield '\x1f0f' (s :!: '\x0399' :!: '\x0000')
120+-- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI
121+upperMapping '\x1f90' s = Yield '\x1f28' (s :!: '\x0399' :!: '\x0000')
122+-- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI
123+upperMapping '\x1f91' s = Yield '\x1f29' (s :!: '\x0399' :!: '\x0000')
124+-- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI
125+upperMapping '\x1f92' s = Yield '\x1f2a' (s :!: '\x0399' :!: '\x0000')
126+-- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI
127+upperMapping '\x1f93' s = Yield '\x1f2b' (s :!: '\x0399' :!: '\x0000')
128+-- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI
129+upperMapping '\x1f94' s = Yield '\x1f2c' (s :!: '\x0399' :!: '\x0000')
130+-- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI
131+upperMapping '\x1f95' s = Yield '\x1f2d' (s :!: '\x0399' :!: '\x0000')
132+-- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI
133+upperMapping '\x1f96' s = Yield '\x1f2e' (s :!: '\x0399' :!: '\x0000')
134+-- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
135+upperMapping '\x1f97' s = Yield '\x1f2f' (s :!: '\x0399' :!: '\x0000')
136+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI
137+upperMapping '\x1f98' s = Yield '\x1f28' (s :!: '\x0399' :!: '\x0000')
138+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI
139+upperMapping '\x1f99' s = Yield '\x1f29' (s :!: '\x0399' :!: '\x0000')
140+-- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI
141+upperMapping '\x1f9a' s = Yield '\x1f2a' (s :!: '\x0399' :!: '\x0000')
142+-- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI
143+upperMapping '\x1f9b' s = Yield '\x1f2b' (s :!: '\x0399' :!: '\x0000')
144+-- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI
145+upperMapping '\x1f9c' s = Yield '\x1f2c' (s :!: '\x0399' :!: '\x0000')
146+-- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI
147+upperMapping '\x1f9d' s = Yield '\x1f2d' (s :!: '\x0399' :!: '\x0000')
148+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI
149+upperMapping '\x1f9e' s = Yield '\x1f2e' (s :!: '\x0399' :!: '\x0000')
150+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
151+upperMapping '\x1f9f' s = Yield '\x1f2f' (s :!: '\x0399' :!: '\x0000')
152+-- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI
153+upperMapping '\x1fa0' s = Yield '\x1f68' (s :!: '\x0399' :!: '\x0000')
154+-- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI
155+upperMapping '\x1fa1' s = Yield '\x1f69' (s :!: '\x0399' :!: '\x0000')
156+-- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI
157+upperMapping '\x1fa2' s = Yield '\x1f6a' (s :!: '\x0399' :!: '\x0000')
158+-- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI
159+upperMapping '\x1fa3' s = Yield '\x1f6b' (s :!: '\x0399' :!: '\x0000')
160+-- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI
161+upperMapping '\x1fa4' s = Yield '\x1f6c' (s :!: '\x0399' :!: '\x0000')
162+-- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI
163+upperMapping '\x1fa5' s = Yield '\x1f6d' (s :!: '\x0399' :!: '\x0000')
164+-- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI
165+upperMapping '\x1fa6' s = Yield '\x1f6e' (s :!: '\x0399' :!: '\x0000')
166+-- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
167+upperMapping '\x1fa7' s = Yield '\x1f6f' (s :!: '\x0399' :!: '\x0000')
168+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI
169+upperMapping '\x1fa8' s = Yield '\x1f68' (s :!: '\x0399' :!: '\x0000')
170+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI
171+upperMapping '\x1fa9' s = Yield '\x1f69' (s :!: '\x0399' :!: '\x0000')
172+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI
173+upperMapping '\x1faa' s = Yield '\x1f6a' (s :!: '\x0399' :!: '\x0000')
174+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI
175+upperMapping '\x1fab' s = Yield '\x1f6b' (s :!: '\x0399' :!: '\x0000')
176+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI
177+upperMapping '\x1fac' s = Yield '\x1f6c' (s :!: '\x0399' :!: '\x0000')
178+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI
179+upperMapping '\x1fad' s = Yield '\x1f6d' (s :!: '\x0399' :!: '\x0000')
180+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI
181+upperMapping '\x1fae' s = Yield '\x1f6e' (s :!: '\x0399' :!: '\x0000')
182+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
183+upperMapping '\x1faf' s = Yield '\x1f6f' (s :!: '\x0399' :!: '\x0000')
184+-- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI
185+upperMapping '\x1fb3' s = Yield '\x0391' (s :!: '\x0399' :!: '\x0000')
186+-- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI
187+upperMapping '\x1fbc' s = Yield '\x0391' (s :!: '\x0399' :!: '\x0000')
188+-- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI
189+upperMapping '\x1fc3' s = Yield '\x0397' (s :!: '\x0399' :!: '\x0000')
190+-- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI
191+upperMapping '\x1fcc' s = Yield '\x0397' (s :!: '\x0399' :!: '\x0000')
192+-- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI
193+upperMapping '\x1ff3' s = Yield '\x03a9' (s :!: '\x0399' :!: '\x0000')
194+-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
195+upperMapping '\x1ffc' s = Yield '\x03a9' (s :!: '\x0399' :!: '\x0000')
196+-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI
197+upperMapping '\x1fb2' s = Yield '\x1fba' (s :!: '\x0399' :!: '\x0000')
198+-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI
199+upperMapping '\x1fb4' s = Yield '\x0386' (s :!: '\x0399' :!: '\x0000')
200+-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI
201+upperMapping '\x1fc2' s = Yield '\x1fca' (s :!: '\x0399' :!: '\x0000')
202+-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI
203+upperMapping '\x1fc4' s = Yield '\x0389' (s :!: '\x0399' :!: '\x0000')
204+-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI
205+upperMapping '\x1ff2' s = Yield '\x1ffa' (s :!: '\x0399' :!: '\x0000')
206+-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI
207+upperMapping '\x1ff4' s = Yield '\x038f' (s :!: '\x0399' :!: '\x0000')
208+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI
209+upperMapping '\x1fb7' s = Yield '\x0391' (s :!: '\x0342' :!: '\x0399')
210+-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI
211+upperMapping '\x1fc7' s = Yield '\x0397' (s :!: '\x0342' :!: '\x0399')
212+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI
213+upperMapping '\x1ff7' s = Yield '\x03a9' (s :!: '\x0342' :!: '\x0399')
214+upperMapping c s = Yield (toUpper c) (s :!: '\0' :!: '\0')
215+lowerMapping :: forall s. Char -> s -> Step (PairS (PairS s Char) Char) Char
216+{-# INLINE lowerMapping #-}
217+-- LATIN CAPITAL LETTER I WITH DOT ABOVE
218+lowerMapping '\x0130' s = Yield '\x0069' (s :!: '\x0307' :!: '\x0000')
219+lowerMapping c s = Yield (toLower c) (s :!: '\0' :!: '\0')
220+foldMapping :: forall s. Char -> s -> Step (PairS (PairS s Char) Char) Char
221+{-# INLINE foldMapping #-}
222+-- MICRO SIGN
223+foldMapping '\x00b5' s = Yield '\x03bc' (s :!: '\x0000' :!: '\x0000')
224+-- LATIN SMALL LETTER SHARP S
225+foldMapping '\x00df' s = Yield '\x0073' (s :!: '\x0073' :!: '\x0000')
226+-- LATIN CAPITAL LETTER I WITH DOT ABOVE
227+foldMapping '\x0130' s = Yield '\x0069' (s :!: '\x0307' :!: '\x0000')
228+-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE
229+foldMapping '\x0149' s = Yield '\x02bc' (s :!: '\x006e' :!: '\x0000')
230+-- LATIN SMALL LETTER LONG S
231+foldMapping '\x017f' s = Yield '\x0073' (s :!: '\x0000' :!: '\x0000')
232+-- LATIN SMALL LETTER J WITH CARON
233+foldMapping '\x01f0' s = Yield '\x006a' (s :!: '\x030c' :!: '\x0000')
234+-- COMBINING GREEK YPOGEGRAMMENI
235+foldMapping '\x0345' s = Yield '\x03b9' (s :!: '\x0000' :!: '\x0000')
236+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
237+foldMapping '\x0390' s = Yield '\x03b9' (s :!: '\x0308' :!: '\x0301')
238+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
239+foldMapping '\x03b0' s = Yield '\x03c5' (s :!: '\x0308' :!: '\x0301')
240+-- GREEK SMALL LETTER FINAL SIGMA
241+foldMapping '\x03c2' s = Yield '\x03c3' (s :!: '\x0000' :!: '\x0000')
242+-- GREEK BETA SYMBOL
243+foldMapping '\x03d0' s = Yield '\x03b2' (s :!: '\x0000' :!: '\x0000')
244+-- GREEK THETA SYMBOL
245+foldMapping '\x03d1' s = Yield '\x03b8' (s :!: '\x0000' :!: '\x0000')
246+-- GREEK PHI SYMBOL
247+foldMapping '\x03d5' s = Yield '\x03c6' (s :!: '\x0000' :!: '\x0000')
248+-- GREEK PI SYMBOL
249+foldMapping '\x03d6' s = Yield '\x03c0' (s :!: '\x0000' :!: '\x0000')
250+-- GREEK KAPPA SYMBOL
251+foldMapping '\x03f0' s = Yield '\x03ba' (s :!: '\x0000' :!: '\x0000')
252+-- GREEK RHO SYMBOL
253+foldMapping '\x03f1' s = Yield '\x03c1' (s :!: '\x0000' :!: '\x0000')
254+-- GREEK LUNATE EPSILON SYMBOL
255+foldMapping '\x03f5' s = Yield '\x03b5' (s :!: '\x0000' :!: '\x0000')
256+-- ARMENIAN SMALL LIGATURE ECH YIWN
257+foldMapping '\x0587' s = Yield '\x0565' (s :!: '\x0582' :!: '\x0000')
258+-- LATIN SMALL LETTER H WITH LINE BELOW
259+foldMapping '\x1e96' s = Yield '\x0068' (s :!: '\x0331' :!: '\x0000')
260+-- LATIN SMALL LETTER T WITH DIAERESIS
261+foldMapping '\x1e97' s = Yield '\x0074' (s :!: '\x0308' :!: '\x0000')
262+-- LATIN SMALL LETTER W WITH RING ABOVE
263+foldMapping '\x1e98' s = Yield '\x0077' (s :!: '\x030a' :!: '\x0000')
264+-- LATIN SMALL LETTER Y WITH RING ABOVE
265+foldMapping '\x1e99' s = Yield '\x0079' (s :!: '\x030a' :!: '\x0000')
266+-- LATIN SMALL LETTER A WITH RIGHT HALF RING
267+foldMapping '\x1e9a' s = Yield '\x0061' (s :!: '\x02be' :!: '\x0000')
268+-- LATIN SMALL LETTER LONG S WITH DOT ABOVE
269+foldMapping '\x1e9b' s = Yield '\x1e61' (s :!: '\x0000' :!: '\x0000')
270+-- LATIN CAPITAL LETTER SHARP S
271+foldMapping '\x1e9e' s = Yield '\x0073' (s :!: '\x0073' :!: '\x0000')
272+-- GREEK SMALL LETTER UPSILON WITH PSILI
273+foldMapping '\x1f50' s = Yield '\x03c5' (s :!: '\x0313' :!: '\x0000')
274+-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA
275+foldMapping '\x1f52' s = Yield '\x03c5' (s :!: '\x0313' :!: '\x0300')
276+-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA
277+foldMapping '\x1f54' s = Yield '\x03c5' (s :!: '\x0313' :!: '\x0301')
278+-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI
279+foldMapping '\x1f56' s = Yield '\x03c5' (s :!: '\x0313' :!: '\x0342')
280+-- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI
281+foldMapping '\x1f80' s = Yield '\x1f00' (s :!: '\x03b9' :!: '\x0000')
282+-- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI
283+foldMapping '\x1f81' s = Yield '\x1f01' (s :!: '\x03b9' :!: '\x0000')
284+-- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI
285+foldMapping '\x1f82' s = Yield '\x1f02' (s :!: '\x03b9' :!: '\x0000')
286+-- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI
287+foldMapping '\x1f83' s = Yield '\x1f03' (s :!: '\x03b9' :!: '\x0000')
288+-- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI
289+foldMapping '\x1f84' s = Yield '\x1f04' (s :!: '\x03b9' :!: '\x0000')
290+-- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI
291+foldMapping '\x1f85' s = Yield '\x1f05' (s :!: '\x03b9' :!: '\x0000')
292+-- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI
293+foldMapping '\x1f86' s = Yield '\x1f06' (s :!: '\x03b9' :!: '\x0000')
294+-- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
295+foldMapping '\x1f87' s = Yield '\x1f07' (s :!: '\x03b9' :!: '\x0000')
296+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI
297+foldMapping '\x1f88' s = Yield '\x1f00' (s :!: '\x03b9' :!: '\x0000')
298+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI
299+foldMapping '\x1f89' s = Yield '\x1f01' (s :!: '\x03b9' :!: '\x0000')
300+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI
301+foldMapping '\x1f8a' s = Yield '\x1f02' (s :!: '\x03b9' :!: '\x0000')
302+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI
303+foldMapping '\x1f8b' s = Yield '\x1f03' (s :!: '\x03b9' :!: '\x0000')
304+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI
305+foldMapping '\x1f8c' s = Yield '\x1f04' (s :!: '\x03b9' :!: '\x0000')
306+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI
307+foldMapping '\x1f8d' s = Yield '\x1f05' (s :!: '\x03b9' :!: '\x0000')
308+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI
309+foldMapping '\x1f8e' s = Yield '\x1f06' (s :!: '\x03b9' :!: '\x0000')
310+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
311+foldMapping '\x1f8f' s = Yield '\x1f07' (s :!: '\x03b9' :!: '\x0000')
312+-- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI
313+foldMapping '\x1f90' s = Yield '\x1f20' (s :!: '\x03b9' :!: '\x0000')
314+-- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI
315+foldMapping '\x1f91' s = Yield '\x1f21' (s :!: '\x03b9' :!: '\x0000')
316+-- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI
317+foldMapping '\x1f92' s = Yield '\x1f22' (s :!: '\x03b9' :!: '\x0000')
318+-- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI
319+foldMapping '\x1f93' s = Yield '\x1f23' (s :!: '\x03b9' :!: '\x0000')
320+-- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI
321+foldMapping '\x1f94' s = Yield '\x1f24' (s :!: '\x03b9' :!: '\x0000')
322+-- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI
323+foldMapping '\x1f95' s = Yield '\x1f25' (s :!: '\x03b9' :!: '\x0000')
324+-- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI
325+foldMapping '\x1f96' s = Yield '\x1f26' (s :!: '\x03b9' :!: '\x0000')
326+-- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
327+foldMapping '\x1f97' s = Yield '\x1f27' (s :!: '\x03b9' :!: '\x0000')
328+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI
329+foldMapping '\x1f98' s = Yield '\x1f20' (s :!: '\x03b9' :!: '\x0000')
330+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI
331+foldMapping '\x1f99' s = Yield '\x1f21' (s :!: '\x03b9' :!: '\x0000')
332+-- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI
333+foldMapping '\x1f9a' s = Yield '\x1f22' (s :!: '\x03b9' :!: '\x0000')
334+-- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI
335+foldMapping '\x1f9b' s = Yield '\x1f23' (s :!: '\x03b9' :!: '\x0000')
336+-- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI
337+foldMapping '\x1f9c' s = Yield '\x1f24' (s :!: '\x03b9' :!: '\x0000')
338+-- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI
339+foldMapping '\x1f9d' s = Yield '\x1f25' (s :!: '\x03b9' :!: '\x0000')
340+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI
341+foldMapping '\x1f9e' s = Yield '\x1f26' (s :!: '\x03b9' :!: '\x0000')
342+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
343+foldMapping '\x1f9f' s = Yield '\x1f27' (s :!: '\x03b9' :!: '\x0000')
344+-- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI
345+foldMapping '\x1fa0' s = Yield '\x1f60' (s :!: '\x03b9' :!: '\x0000')
346+-- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI
347+foldMapping '\x1fa1' s = Yield '\x1f61' (s :!: '\x03b9' :!: '\x0000')
348+-- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI
349+foldMapping '\x1fa2' s = Yield '\x1f62' (s :!: '\x03b9' :!: '\x0000')
350+-- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI
351+foldMapping '\x1fa3' s = Yield '\x1f63' (s :!: '\x03b9' :!: '\x0000')
352+-- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI
353+foldMapping '\x1fa4' s = Yield '\x1f64' (s :!: '\x03b9' :!: '\x0000')
354+-- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI
355+foldMapping '\x1fa5' s = Yield '\x1f65' (s :!: '\x03b9' :!: '\x0000')
356+-- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI
357+foldMapping '\x1fa6' s = Yield '\x1f66' (s :!: '\x03b9' :!: '\x0000')
358+-- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
359+foldMapping '\x1fa7' s = Yield '\x1f67' (s :!: '\x03b9' :!: '\x0000')
360+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI
361+foldMapping '\x1fa8' s = Yield '\x1f60' (s :!: '\x03b9' :!: '\x0000')
362+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI
363+foldMapping '\x1fa9' s = Yield '\x1f61' (s :!: '\x03b9' :!: '\x0000')
364+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI
365+foldMapping '\x1faa' s = Yield '\x1f62' (s :!: '\x03b9' :!: '\x0000')
366+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI
367+foldMapping '\x1fab' s = Yield '\x1f63' (s :!: '\x03b9' :!: '\x0000')
368+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI
369+foldMapping '\x1fac' s = Yield '\x1f64' (s :!: '\x03b9' :!: '\x0000')
370+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI
371+foldMapping '\x1fad' s = Yield '\x1f65' (s :!: '\x03b9' :!: '\x0000')
372+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI
373+foldMapping '\x1fae' s = Yield '\x1f66' (s :!: '\x03b9' :!: '\x0000')
374+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
375+foldMapping '\x1faf' s = Yield '\x1f67' (s :!: '\x03b9' :!: '\x0000')
376+-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI
377+foldMapping '\x1fb2' s = Yield '\x1f70' (s :!: '\x03b9' :!: '\x0000')
378+-- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI
379+foldMapping '\x1fb3' s = Yield '\x03b1' (s :!: '\x03b9' :!: '\x0000')
380+-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI
381+foldMapping '\x1fb4' s = Yield '\x03ac' (s :!: '\x03b9' :!: '\x0000')
382+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI
383+foldMapping '\x1fb6' s = Yield '\x03b1' (s :!: '\x0342' :!: '\x0000')
384+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI
385+foldMapping '\x1fb7' s = Yield '\x03b1' (s :!: '\x0342' :!: '\x03b9')
386+-- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI
387+foldMapping '\x1fbc' s = Yield '\x03b1' (s :!: '\x03b9' :!: '\x0000')
388+-- GREEK PROSGEGRAMMENI
389+foldMapping '\x1fbe' s = Yield '\x03b9' (s :!: '\x0000' :!: '\x0000')
390+-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI
391+foldMapping '\x1fc2' s = Yield '\x1f74' (s :!: '\x03b9' :!: '\x0000')
392+-- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI
393+foldMapping '\x1fc3' s = Yield '\x03b7' (s :!: '\x03b9' :!: '\x0000')
394+-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI
395+foldMapping '\x1fc4' s = Yield '\x03ae' (s :!: '\x03b9' :!: '\x0000')
396+-- GREEK SMALL LETTER ETA WITH PERISPOMENI
397+foldMapping '\x1fc6' s = Yield '\x03b7' (s :!: '\x0342' :!: '\x0000')
398+-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI
399+foldMapping '\x1fc7' s = Yield '\x03b7' (s :!: '\x0342' :!: '\x03b9')
400+-- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI
401+foldMapping '\x1fcc' s = Yield '\x03b7' (s :!: '\x03b9' :!: '\x0000')
402+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA
403+foldMapping '\x1fd2' s = Yield '\x03b9' (s :!: '\x0308' :!: '\x0300')
404+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA
405+foldMapping '\x1fd3' s = Yield '\x03b9' (s :!: '\x0308' :!: '\x0301')
406+-- GREEK SMALL LETTER IOTA WITH PERISPOMENI
407+foldMapping '\x1fd6' s = Yield '\x03b9' (s :!: '\x0342' :!: '\x0000')
408+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI
409+foldMapping '\x1fd7' s = Yield '\x03b9' (s :!: '\x0308' :!: '\x0342')
410+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA
411+foldMapping '\x1fe2' s = Yield '\x03c5' (s :!: '\x0308' :!: '\x0300')
412+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA
413+foldMapping '\x1fe3' s = Yield '\x03c5' (s :!: '\x0308' :!: '\x0301')
414+-- GREEK SMALL LETTER RHO WITH PSILI
415+foldMapping '\x1fe4' s = Yield '\x03c1' (s :!: '\x0313' :!: '\x0000')
416+-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI
417+foldMapping '\x1fe6' s = Yield '\x03c5' (s :!: '\x0342' :!: '\x0000')
418+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI
419+foldMapping '\x1fe7' s = Yield '\x03c5' (s :!: '\x0308' :!: '\x0342')
420+-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI
421+foldMapping '\x1ff2' s = Yield '\x1f7c' (s :!: '\x03b9' :!: '\x0000')
422+-- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI
423+foldMapping '\x1ff3' s = Yield '\x03c9' (s :!: '\x03b9' :!: '\x0000')
424+-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI
425+foldMapping '\x1ff4' s = Yield '\x03ce' (s :!: '\x03b9' :!: '\x0000')
426+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI
427+foldMapping '\x1ff6' s = Yield '\x03c9' (s :!: '\x0342' :!: '\x0000')
428+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI
429+foldMapping '\x1ff7' s = Yield '\x03c9' (s :!: '\x0342' :!: '\x03b9')
430+-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
431+foldMapping '\x1ffc' s = Yield '\x03c9' (s :!: '\x03b9' :!: '\x0000')
432+-- LATIN SMALL LIGATURE FF
433+foldMapping '\xfb00' s = Yield '\x0066' (s :!: '\x0066' :!: '\x0000')
434+-- LATIN SMALL LIGATURE FI
435+foldMapping '\xfb01' s = Yield '\x0066' (s :!: '\x0069' :!: '\x0000')
436+-- LATIN SMALL LIGATURE FL
437+foldMapping '\xfb02' s = Yield '\x0066' (s :!: '\x006c' :!: '\x0000')
438+-- LATIN SMALL LIGATURE FFI
439+foldMapping '\xfb03' s = Yield '\x0066' (s :!: '\x0066' :!: '\x0069')
440+-- LATIN SMALL LIGATURE FFL
441+foldMapping '\xfb04' s = Yield '\x0066' (s :!: '\x0066' :!: '\x006c')
442+-- LATIN SMALL LIGATURE LONG S T
443+foldMapping '\xfb05' s = Yield '\x0073' (s :!: '\x0074' :!: '\x0000')
444+-- LATIN SMALL LIGATURE ST
445+foldMapping '\xfb06' s = Yield '\x0073' (s :!: '\x0074' :!: '\x0000')
446+-- ARMENIAN SMALL LIGATURE MEN NOW
447+foldMapping '\xfb13' s = Yield '\x0574' (s :!: '\x0576' :!: '\x0000')
448+-- ARMENIAN SMALL LIGATURE MEN ECH
449+foldMapping '\xfb14' s = Yield '\x0574' (s :!: '\x0565' :!: '\x0000')
450+-- ARMENIAN SMALL LIGATURE MEN INI
451+foldMapping '\xfb15' s = Yield '\x0574' (s :!: '\x056b' :!: '\x0000')
452+-- ARMENIAN SMALL LIGATURE VEW NOW
453+foldMapping '\xfb16' s = Yield '\x057e' (s :!: '\x0576' :!: '\x0000')
454+-- ARMENIAN SMALL LIGATURE MEN XEH
455+foldMapping '\xfb17' s = Yield '\x0574' (s :!: '\x056d' :!: '\x0000')
456+foldMapping c s = Yield (toLower c) (s :!: '\0' :!: '\0')
Data/Text/Internal/Fusion/Common.hs → Data/Text/Fusion/Common.hsrenamed+191−303
@@ -1,26 +1,22 @@
1−{-# LANGUAGE BangPatterns, MagicHash, Rank2Types #-}
1+{-# LANGUAGE BangPatterns, Rank2Types #-}
2-- |
2-- |
3−-- Module : Data.Text.Internal.Fusion.Common
3+-- Module : Data.Text.Fusion.Common
4−-- Copyright : (c) Bryan O'Sullivan 2009, 2012
4+-- Copyright : (c) Bryan O'Sullivan 2009
5--
5--
6-- License : BSD-style
6-- License : BSD-style
7−-- Maintainer : bos@serpentine.com
7+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,
8+-- duncan@haskell.org
8-- Stability : experimental
9-- Stability : experimental
9-- Portability : GHC
10-- Portability : GHC
10--
11--
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−--
15-- Common stream fusion functionality for text.
12-- Common stream fusion functionality for text.
16
13
17−module Data.Text.Internal.Fusion.Common
14+module Data.Text.Fusion.Common
18 (
15 (
19 -- * Creation and elimination
16 -- * Creation and elimination
20 singleton
17 singleton
21 , streamList
18 , streamList
22 , unstreamList
19 , unstreamList
23− , streamCString#
24
20
25 -- * Basic interface
21 -- * Basic interface
26 , cons
22 , cons
@@ -33,8 +29,6 @@ module Data.Text.Internal.Fusion.Common
33 , init
29 , init
34 , null
30 , null
35 , lengthI
31 , lengthI
36− , compareLengthI
37− , isSingleton
38
32
39 -- * Transformations
33 -- * Transformations
40 , map
34 , map
@@ -45,12 +39,8 @@ module Data.Text.Internal.Fusion.Common
45 -- $case
39 -- $case
46 , toCaseFold
40 , toCaseFold
47 , toLower
41 , toLower
48− , toTitle
49 , toUpper
42 , toUpper
50
43
51− -- ** Justification
52− , justifyLeftI
53−
54 -- * Folds
44 -- * Folds
55 , foldl
45 , foldl
56 , foldl'
46 , foldl'
@@ -71,9 +61,11 @@ module Data.Text.Internal.Fusion.Common
71 -- ** Scans
61 -- ** Scans
72 , scanl
62 , scanl
73
63
64+ -- ** Accumulating maps
65+ , mapAccumL
66+
74 -- ** Generation and unfolding
67 -- ** Generation and unfolding
75− , replicateCharI
68+ , replicate
76− , replicateI
77 , unfoldr
69 , unfoldr
78 , unfoldrNI
70 , unfoldrNI
79
71
@@ -92,105 +84,70 @@ module Data.Text.Internal.Fusion.Common
92 , filter
84 , filter
93
85
94 -- * Indexing
86 -- * Indexing
95− , findBy
87+ , find
96 , indexI
88 , indexI
97 , findIndexI
89 , findIndexI
98− , countCharI
90+ , findIndicesI
91+ , elemIndexI
92+ , elemIndicesI
93+ , countI
99
94
100 -- * Zipping and unzipping
95 -- * Zipping and unzipping
101 , zipWith
96 , zipWith
102 ) where
97 ) where
103
98
104−import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
99+import Prelude (Bool(..), Char, Either(..), Eq(..), Int, Integral, Maybe(..),
105− Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),
100+ Ord(..), String, (.), ($), (+), (-), (*), (++), (&&),
106− (&&), fromIntegral, otherwise)
101+ fromIntegral, otherwise)
107import qualified Data.List as L
102import qualified Data.List as L
108import qualified Prelude as P
103import qualified Prelude as P
109−import Data.Bits (shiftL)
104+import Data.Text.Fusion.Internal
110−import Data.Char (isLetter)
105+import Data.Text.Fusion.CaseMapping (foldMapping, lowerMapping, upperMapping)
111−import Data.Int (Int64)
112−import Data.Text.Internal.Fusion.Types
113−import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,
114− upperMapping)
115−import Data.Text.Internal.Fusion.Size
116−import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)
117−import GHC.Types (Char(..), Int(..))
118
106
119singleton :: Char -> Stream Char
107singleton :: Char -> Stream Char
120−singleton c = Stream next False 1
108+singleton c = Stream next False 1 -- HINT maybe too low
121 where next False = Yield c True
109 where next False = Yield c True
122 next True = Done
110 next True = Done
123−{-# INLINE [0] singleton #-}
111+{-# INLINE singleton #-}
124
112
125streamList :: [a] -> Stream a
113streamList :: [a] -> Stream a
126{-# INLINE [0] streamList #-}
114{-# INLINE [0] streamList #-}
127−streamList s = Stream next s unknownSize
115+streamList [] = empty
116+streamList s = Stream next s unknownLength
128 where next [] = Done
117 where next [] = Done
129 next (x:xs) = Yield x xs
118 next (x:xs) = Yield x xs
119+ unknownLength = 8 -- random HINT
130
120
131unstreamList :: Stream a -> [a]
121unstreamList :: Stream a -> [a]
122+{-# INLINE [0] unstreamList #-}
132unstreamList (Stream next s0 _len) = unfold s0
123unstreamList (Stream next s0 _len) = unfold s0
133 where unfold !s = case next s of
124 where unfold !s = case next s of
134 Done -> []
125 Done -> []
135 Skip s' -> unfold s'
126 Skip s' -> unfold s'
136 Yield x s' -> x : unfold s'
127 Yield x s' -> x : unfold s'
137−{-# INLINE [0] unstreamList #-}
138
128
139{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}
129{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}
140
130
141−-- | Stream the UTF-8-like packed encoding used by GHC to represent
142−-- constant strings in generated code.
143−--
144−-- This encoding uses the byte sequence "\xc0\x80" to represent NUL,
145−-- and the string is NUL-terminated.
146−streamCString# :: Addr# -> Stream Char
147−streamCString# addr = Stream step 0 unknownSize
148− where
149− step !i
150− | b == 0 = Done
151− | b <= 0x7f = Yield (C# b#) (i+1)
152− | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1
153− in Yield c (i+2)
154− | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +
155− (next 1 `shiftL` 6) +
156− next 2
157− in Yield c (i+3)
158− | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +
159− (next 1 `shiftL` 12) +
160− (next 2 `shiftL` 6) +
161− next 3
162− in Yield c (i+4)
163− where b = I# (ord# b#)
164− next n = I# (ord# (at# (i+n))) - 0x80
165− !b# = at# i
166− at# (I# i#) = indexCharOffAddr# addr i#
167− chr (I# i#) = C# (chr# i#)
168−{-# INLINE [0] streamCString# #-}
169−
170-- ----------------------------------------------------------------------------
131-- ----------------------------------------------------------------------------
171-- * Basic stream functions
132-- * Basic stream functions
172
133
173−data C s = C0 !s
174− | C1 !s
175−
176-- | /O(n)/ Adds a character to the front of a Stream Char.
134-- | /O(n)/ Adds a character to the front of a Stream Char.
177cons :: Char -> Stream Char -> Stream Char
135cons :: Char -> Stream Char -> Stream Char
178−cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
136+cons w (Stream next0 s0 len) = Stream next (S2 :!: s0) (len+2) -- HINT maybe too high
179 where
137 where
180− next (C1 s) = Yield w (C0 s)
138+ {-# INLINE next #-}
181− next (C0 s) = case next0 s of
139+ next (S2 :!: s) = Yield w (S1 :!: s)
140+ next (S1 :!: s) = case next0 s of
182 Done -> Done
141 Done -> Done
183− Skip s' -> Skip (C0 s')
142+ Skip s' -> Skip (S1 :!: s')
184− Yield x s' -> Yield x (C0 s')
143+ Yield x s' -> Yield x (S1 :!: s')
185{-# INLINE [0] cons #-}
144{-# INLINE [0] cons #-}
186
145
187−data Snoc a = N
188− | J !a
189−
190-- | /O(n)/ Adds a character to the end of a stream.
146-- | /O(n)/ Adds a character to the end of a stream.
191snoc :: Stream Char -> Char -> Stream Char
147snoc :: Stream Char -> Char -> Stream Char
192−snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
148+snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+2) -- HINT maybe too high
193 where
149 where
150+ {-# INLINE next #-}
194 next (J xs) = case next0 xs of
151 next (J xs) = case next0 xs of
195 Done -> Yield w N
152 Done -> Yield w N
196 Skip xs' -> Skip (J xs')
153 Skip xs' -> Skip (J xs')
@@ -198,22 +155,20 @@ snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
198 next N = Done
155 next N = Done
199{-# INLINE [0] snoc #-}
156{-# INLINE [0] snoc #-}
200
157
201−data E l r = L !l
202− | R !r
203−
204-- | /O(n)/ Appends one Stream to the other.
158-- | /O(n)/ Appends one Stream to the other.
205append :: Stream Char -> Stream Char -> Stream Char
159append :: Stream Char -> Stream Char -> Stream Char
206append (Stream next0 s01 len1) (Stream next1 s02 len2) =
160append (Stream next0 s01 len1) (Stream next1 s02 len2) =
207− Stream next (L s01) (len1 + len2)
161+ Stream next (Left s01) (len1 + len2)
208 where
162 where
209− next (L s1) = case next0 s1 of
163+ {-# INLINE next #-}
210− Done -> Skip (R s02)
164+ next (Left s1) = case next0 s1 of
211− Skip s1' -> Skip (L s1')
165+ Done -> Skip (Right s02)
212− Yield x s1' -> Yield x (L s1')
166+ Skip s1' -> Skip (Left s1')
213− next (R s2) = case next1 s2 of
167+ Yield x s1' -> Yield x (Left s1')
168+ next (Right s2) = case next1 s2 of
214 Done -> Done
169 Done -> Done
215− Skip s2' -> Skip (R s2')
170+ Skip s2' -> Skip (Right s2')
216− Yield x s2' -> Yield x (R s2')
171+ Yield x s2' -> Yield x (Right s2')
217{-# INLINE [0] append #-}
172{-# INLINE [0] append #-}
218
173
219-- | /O(1)/ Returns the first character of a Text, which must be non-empty.
174-- | /O(1)/ Returns the first character of a Text, which must be non-empty.
@@ -223,21 +178,17 @@ head (Stream next s0 _len) = loop_head s0
223 where
178 where
224 loop_head !s = case next s of
179 loop_head !s = case next s of
225 Yield x _ -> x
180 Yield x _ -> x
226− Skip s' -> loop_head s'
181+ Skip s' -> loop_head s'
227− Done -> head_empty
182+ Done -> streamError "head" "Empty stream"
228{-# INLINE [0] head #-}
183{-# INLINE [0] head #-}
229
184
230−head_empty :: a
231−head_empty = streamError "head" "Empty stream"
232−{-# NOINLINE head_empty #-}
233−
234-- | /O(1)/ Returns the first character and remainder of a 'Stream
185-- | /O(1)/ Returns the first character and remainder of a 'Stream
235-- Char', or 'Nothing' if empty. Subject to array fusion.
186-- Char', or 'Nothing' if empty. Subject to array fusion.
236uncons :: Stream Char -> Maybe (Char, Stream Char)
187uncons :: Stream Char -> Maybe (Char, Stream Char)
237uncons (Stream next s0 len) = loop_uncons s0
188uncons (Stream next s0 len) = loop_uncons s0
238 where
189 where
239 loop_uncons !s = case next s of
190 loop_uncons !s = case next s of
240− Yield x s1 -> Just (x, Stream next s1 (len-1))
191+ Yield x s1 -> Just (x, Stream next s1 (len-1)) -- HINT maybe too high
241 Skip s' -> loop_uncons s'
192 Skip s' -> loop_uncons s'
242 Done -> Nothing
193 Done -> Nothing
243{-# INLINE [0] uncons #-}
194{-# INLINE [0] uncons #-}
@@ -260,34 +211,34 @@ last (Stream next s0 _len) = loop0_last s0
260-- | /O(1)/ Returns all characters after the head of a Stream Char, which must
211-- | /O(1)/ Returns all characters after the head of a Stream Char, which must
261-- be non-empty.
212-- be non-empty.
262tail :: Stream Char -> Stream Char
213tail :: Stream Char -> Stream Char
263−tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)
214+tail (Stream next0 s0 len) = Stream next (False :!: s0) (len-1) -- HINT maybe too high
264 where
215 where
265− next (C0 s) = case next0 s of
216+ {-# INLINE next #-}
266− Done -> emptyError "tail"
217+ next (False :!: s) = case next0 s of
267− Skip s' -> Skip (C0 s')
218+ Done -> emptyError "tail"
268− Yield _ s' -> Skip (C1 s')
219+ Skip s' -> Skip (False :!: s')
269− next (C1 s) = case next0 s of
220+ Yield _ s' -> Skip (True :!: s')
270− Done -> Done
221+ next (True :!: s) = case next0 s of
271− Skip s' -> Skip (C1 s')
222+ Done -> Done
272− Yield x s' -> Yield x (C1 s')
223+ Skip s' -> Skip (True :!: s')
224+ Yield x s' -> Yield x (True :!: s')
273{-# INLINE [0] tail #-}
225{-# INLINE [0] tail #-}
274
226
275−data Init s = Init0 !s
276− | Init1 {-# UNPACK #-} !Char !s
277
227
278-- | /O(1)/ Returns all but the last character of a Stream Char, which
228-- | /O(1)/ Returns all but the last character of a Stream Char, which
279-- must be non-empty.
229-- must be non-empty.
280init :: Stream Char -> Stream Char
230init :: Stream Char -> Stream Char
281−init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)
231+init (Stream next0 s0 len) = Stream next (N :!: s0) (len-1) -- HINT maybe too high
282 where
232 where
283− next (Init0 s) = case next0 s of
233+ {-# INLINE next #-}
234+ next (N :!: s) = case next0 s of
284 Done -> emptyError "init"
235 Done -> emptyError "init"
285− Skip s' -> Skip (Init0 s')
236+ Skip s' -> Skip (N :!: s')
286− Yield x s' -> Skip (Init1 x s')
237+ Yield x s' -> Skip (J x :!: s')
287− next (Init1 x s) = case next0 s of
238+ next (J x :!: s) = case next0 s of
288 Done -> Done
239 Done -> Done
289− Skip s' -> Skip (Init1 x s')
240+ Skip s' -> Skip (J x :!: s')
290− Yield x' s' -> Yield x (Init1 x' s')
241+ Yield x' s' -> Yield x (J x' :!: s')
291{-# INLINE [0] init #-}
242{-# INLINE [0] init #-}
292
243
293-- | /O(1)/ Tests whether a Stream Char is empty or not.
244-- | /O(1)/ Tests whether a Stream Char is empty or not.
@@ -300,7 +251,7 @@ null (Stream next s0 _len) = loop_null s0
300 Skip s' -> loop_null s'
251 Skip s' -> loop_null s'
301{-# INLINE[0] null #-}
252{-# INLINE[0] null #-}
302
253
303−-- | /O(n)/ Returns the number of characters in a string.
254+-- | /O(n)/ Returns the number of characters in a text.
304lengthI :: Integral a => Stream Char -> a
255lengthI :: Integral a => Stream Char -> a
305lengthI (Stream next s0 _len) = loop_length 0 s0
256lengthI (Stream next s0 _len) = loop_length 0 s0
306 where
257 where
@@ -310,46 +261,15 @@ lengthI (Stream next s0 _len) = loop_length 0 s0
310 Yield _ s' -> loop_length (z + 1) s'
261 Yield _ s' -> loop_length (z + 1) s'
311{-# INLINE[0] lengthI #-}
262{-# INLINE[0] lengthI #-}
312
263
313−-- | /O(n)/ Compares the count of characters in a string to a number.
314−-- Subject to fusion.
315−--
316−-- This function gives the same answer as comparing against the result
317−-- of 'lengthI', but can short circuit if the count of characters is
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.
320−compareLengthI :: Integral a => Stream Char -> a -> Ordering
321−compareLengthI (Stream next s0 len) n =
322− case compareSize len (fromIntegral n) of
323− Just o -> o
324− Nothing -> loop_cmp 0 s0
325− where
326− loop_cmp !z s = case next s of
327− Done -> compare z n
328− Skip s' -> loop_cmp z s'
329− Yield _ s' | z > n -> GT
330− | otherwise -> loop_cmp (z + 1) s'
331−{-# INLINE[0] compareLengthI #-}
332−
333−-- | /O(n)/ Indicate whether a string contains exactly one element.
334−isSingleton :: Stream Char -> Bool
335−isSingleton (Stream next s0 _len) = loop 0 s0
336− where
337− loop !z s = case next s of
338− Done -> z == (1::Int)
339− Skip s' -> loop z s'
340− Yield _ s'
341− | z >= 1 -> False
342− | otherwise -> loop (z+1) s'
343−{-# INLINE[0] isSingleton #-}
344−
345-- ----------------------------------------------------------------------------
264-- ----------------------------------------------------------------------------
346-- * Stream transformations
265-- * Stream transformations
347
266
348−-- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@
267+-- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@ to each element of
349−-- to each element of @xs@.
268+-- @xs@.
350map :: (Char -> Char) -> Stream Char -> Stream Char
269map :: (Char -> Char) -> Stream Char -> Stream Char
351−map f (Stream next0 s0 len) = Stream next s0 len
270+map f (Stream next0 s0 len) = Stream next s0 len -- HINT depends on f
352 where
271 where
272+ {-# INLINE next #-}
353 next !s = case next0 s of
273 next !s = case next0 s of
354 Done -> Done
274 Done -> Done
355 Skip s' -> Skip s'
275 Skip s' -> Skip s'
@@ -361,24 +281,22 @@ map f (Stream next0 s0 len) = Stream next s0 len
361 map f (map g s) = map (\x -> f (g x)) s
281 map f (map g s) = map (\x -> f (g x)) s
362 #-}
282 #-}
363
283
364−data I s = I1 !s
365− | I2 !s {-# UNPACK #-} !Char
366− | I3 !s
367−
368-- | /O(n)/ Take a character and place it between each of the
284-- | /O(n)/ Take a character and place it between each of the
369-- characters of a 'Stream Char'.
285-- characters of a 'Stream Char'.
370intersperse :: Char -> Stream Char -> Stream Char
286intersperse :: Char -> Stream Char -> Stream Char
371−intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len
287+intersperse c (Stream next0 s0 len) = Stream next (s0 :!: N :!: S1) len -- HINT maybe too low
372 where
288 where
373− next (I1 s) = case next0 s of
289+ {-# INLINE next #-}
290+ next (s :!: N :!: S1) = case next0 s of
374 Done -> Done
291 Done -> Done
375− Skip s' -> Skip (I1 s')
292+ Skip s' -> Skip (s' :!: N :!: S1)
376− Yield x s' -> Skip (I2 s' x)
293+ Yield x s' -> Skip (s' :!: J x :!: S1)
377− next (I2 s x) = Yield x (I3 s)
294+ next (s :!: J x :!: S1) = Yield x (s :!: N :!: S2)
378− next (I3 s) = case next0 s of
295+ next (s :!: N :!: S2) = case next0 s of
379 Done -> Done
296 Done -> Done
380− Skip s' -> Skip (I3 s')
297+ Skip s' -> Skip (s' :!: N :!: S2)
381− Yield x s' -> Yield c (I2 s' x)
298+ Yield x s' -> Yield c (s' :!: J x :!: S1)
299+ next _ = internalError "intersperse"
382{-# INLINE [0] intersperse #-}
300{-# INLINE [0] intersperse #-}
383
301
384-- ----------------------------------------------------------------------------
302-- ----------------------------------------------------------------------------
@@ -393,16 +311,17 @@ intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len
393-- functions may map one input character to two or three output
311-- functions may map one input character to two or three output
394-- characters.
312-- characters.
395
313
396−caseConvert :: (forall s. Char -> s -> Step (CC s) Char)
314+caseConvert :: (forall s. Char -> s -> Step (PairS (PairS s Char) Char) Char)
397 -> Stream Char -> Stream Char
315 -> Stream Char -> Stream Char
398−caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len
316+caseConvert remap (Stream next0 s0 len) = Stream next (s0 :!: '\0' :!: '\0') len
399 where
317 where
400− next (CC s '\0' _) =
318+ {-# INLINE next #-}
319+ next (s :!: '\0' :!: _) =
401 case next0 s of
320 case next0 s of
402 Done -> Done
321 Done -> Done
403− Skip s' -> Skip (CC s' '\0' '\0')
322+ Skip s' -> Skip (s' :!: '\0' :!: '\0')
404 Yield c s' -> remap c s'
323 Yield c s' -> remap c s'
405− next (CC s a b) = Yield a (CC s b '\0')
324+ next (s :!: a :!: b) = Yield a (s :!: b :!: '\0')
406
325
407-- | /O(n)/ Convert a string to folded case. This function is mainly
326-- | /O(n)/ Convert a string to folded case. This function is mainly
408-- useful for performing caseless (or case insensitive) string
327-- useful for performing caseless (or case insensitive) string
@@ -439,58 +358,6 @@ toLower :: Stream Char -> Stream Char
439toLower = caseConvert lowerMapping
358toLower = caseConvert lowerMapping
440{-# INLINE [0] toLower #-}
359{-# INLINE [0] toLower #-}
441
360
442−-- | /O(n)/ Convert a string to title case, using simple case
443−-- conversion.
444−--
445−-- The first letter of the input is converted to title case, as is
446−-- every subsequent letter that immediately follows a non-letter.
447−-- Every letter that immediately follows another letter is converted
448−-- to lower case.
449−--
450−-- The result string may be longer than the input string. For example,
451−-- the Latin small ligature &#xfb02; (U+FB02) is converted to the
452−-- sequence Latin capital letter F (U+0046) followed by Latin small
453−-- letter l (U+006C).
454−--
455−-- /Note/: this function does not take language or culture specific
456−-- rules into account. For instance, in English, different style
457−-- guides disagree on whether the book name \"The Hill of the Red
458−-- Fox\" is correctly title cased&#x2014;but this function will
459−-- capitalize /every/ word.
460−toTitle :: Stream Char -> Stream Char
461−toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len
462− where
463− next (CC (letter :*: s) '\0' _) =
464− case next0 s of
465− Done -> Done
466− Skip s' -> Skip (CC (letter :*: s') '\0' '\0')
467− Yield c s'
468− | letter' -> if letter
469− then lowerMapping c (letter' :*: s')
470− else titleMapping c (letter' :*: s')
471− | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')
472− where letter' = isLetter c
473− next (CC s a b) = Yield a (CC s b '\0')
474−{-# INLINE [0] toTitle #-}
475−
476−data Justify i s = Just1 !i !s
477− | Just2 !i !s
478−
479−justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
480−justifyLeftI k c (Stream next0 s0 len) =
481− Stream next (Just1 0 s0) (larger (fromIntegral k) len)
482− where
483− next (Just1 n s) =
484− 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)
490− | otherwise = Done
491− {-# INLINE next #-}
492−{-# INLINE [0] justifyLeftI #-}
493−
494-- ----------------------------------------------------------------------------
361-- ----------------------------------------------------------------------------
495-- * Reducing Streams (folds)
362-- * Reducing Streams (folds)
496
363
@@ -584,16 +451,14 @@ intercalate s = concat . (L.intersperse s)
584-- | /O(n)/ Concatenate a list of streams. Subject to array fusion.
451-- | /O(n)/ Concatenate a list of streams. Subject to array fusion.
585concat :: [Stream Char] -> Stream Char
452concat :: [Stream Char] -> Stream Char
586concat = L.foldr append empty
453concat = L.foldr append empty
587−{-# INLINE [0] concat #-}
588
454
589-- | Map a function over a stream that results in a stream and concatenate the
455-- | Map a function over a stream that results in a stream and concatenate the
590-- results.
456-- results.
591concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char
457concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char
592concatMap f = foldr (append . f) empty
458concatMap f = foldr (append . f) empty
593−{-# INLINE [0] concatMap #-}
594
459
595-- | /O(n)/ any @p @xs determines if any character in the stream
460-- | /O(n)/ any @p @xs determines if any character in the stream
596−-- @xs@ satisfies the predicate @p@.
461+-- @xs@ satisifes the predicate @p@.
597any :: (Char -> Bool) -> Stream Char -> Bool
462any :: (Char -> Bool) -> Stream Char -> Bool
598any p (Stream next0 s0 _len) = loop_any s0
463any p (Stream next0 s0 _len) = loop_any s0
599 where
464 where
@@ -605,7 +470,7 @@ any p (Stream next0 s0 _len) = loop_any s0
605{-# INLINE [0] any #-}
470{-# INLINE [0] any #-}
606
471
607-- | /O(n)/ all @p @xs determines if all characters in the 'Text'
472-- | /O(n)/ all @p @xs determines if all characters in the 'Text'
608−-- @xs@ satisfy the predicate @p@.
473+-- @xs@ satisify the predicate @p@.
609all :: (Char -> Bool) -> Stream Char -> Bool
474all :: (Char -> Bool) -> Stream Char -> Bool
610all p (Stream next0 s0 _len) = loop_all s0
475all p (Stream next0 s0 _len) = loop_all s0
611 where
476 where
@@ -654,42 +519,50 @@ minimum (Stream next0 s0 _len) = loop0_minimum s0
654-- * Building streams
519-- * Building streams
655
520
656scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
521scanl :: (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
522+scanl f z0 (Stream next0 s0 len) = Stream next (S1 :!: z0 :!: s0) (len+1) -- HINT maybe too low
658 where
523 where
659 {-# INLINE next #-}
524 {-# INLINE next #-}
660− next (Scan1 z s) = Yield z (Scan2 z s)
525+ next (S1 :!: z :!: s) = Yield z (S2 :!: z :!: s)
661− next (Scan2 z s) = case next0 s of
526+ next (S2 :!: z :!: s) = case next0 s of
662− Yield x s' -> let !x' = f z x
527+ Yield x s' -> let !x' = f z x
663− in Yield x' (Scan2 x' s')
528+ in Yield x' (S2 :!: x' :!: s')
664− Skip s' -> Skip (Scan2 z s')
529+ Skip s' -> Skip (S2 :!: z :!: s')
665− Done -> Done
530+ Done -> Done
666{-# INLINE [0] scanl #-}
531{-# INLINE [0] scanl #-}
667
532
668-- -----------------------------------------------------------------------------
533-- -----------------------------------------------------------------------------
669−-- ** Generating and unfolding streams
534+-- ** Accumulating maps
670
535
671−replicateCharI :: Integral a => a -> Char -> Stream Char
536+-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a
672−replicateCharI !n !c
537+-- function to each element of a stream, passing an accumulating
673− | n < 0 = empty
538+-- parameter from left to right, and returns a final stream.
674− | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
539+--
540+-- /Note/: Unlike the version over lists, this function does not
541+-- return a final value for the accumulator, because the nature of
542+-- streams precludes it.
543+mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b
544+mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :!: z0) len -- HINT depends on f
675 where
545 where
676− next !i | i >= n = Done
546+ {-# INLINE next #-}
677− | otherwise = Yield c (i + 1)
547+ next (s :!: z) = case next0 s of
678−{-# INLINE [0] replicateCharI #-}
548+ Yield x s' -> let (z',y) = f z x
549+ in Yield y (s' :!: z')
550+ Skip s' -> Skip (s' :!: z)
551+ Done -> Done
552+{-# INLINE [0] mapAccumL #-}
679
553
680−data RI s = RI !s {-# UNPACK #-} !Int64
554+-- -----------------------------------------------------------------------------
555+-- ** Generating and unfolding streams
681
556
682−replicateI :: Int64 -> Stream Char -> Stream Char
557+replicate :: Int -> Char -> Stream Char
683−replicateI n (Stream next0 s0 len) =
558+replicate n c
684− Stream next (RI s0 0) (fromIntegral (max 0 n) * len)
559+ | n < 0 = empty
560+ | otherwise = Stream next 0 n -- HINT maybe too low
685 where
561 where
686− next (RI s k)
562+ {-# INLINE next #-}
687− | k >= n = Done
563+ next i | i >= n = Done
688− | otherwise = case next0 s of
564+ | otherwise = Yield c (i + 1)
689− Done -> Skip (RI s0 (k+1))
565+{-# INLINE [0] replicate #-}
690− Skip s' -> Skip (RI s' k)
691− Yield x s' -> Yield x (RI s' k)
692−{-# INLINE [0] replicateI #-}
693
566
694-- | /O(n)/, where @n@ is the length of the result. The unfoldr function
567-- | /O(n)/, where @n@ is the length of the result. The unfoldr function
695-- is analogous to the List 'unfoldr'. unfoldr builds a stream
568-- is analogous to the List 'unfoldr'. unfoldr builds a stream
@@ -712,13 +585,13 @@ unfoldr f s0 = Stream next s0 1 -- HINT maybe too low
712-- 'unfoldr' when the length of the result is known.
585-- 'unfoldr' when the length of the result is known.
713unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char
586unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char
714unfoldrNI n f s0 | n < 0 = empty
587unfoldrNI n f s0 | n < 0 = empty
715− | otherwise = Stream next (0 :*: s0) (fromIntegral (n*2)) -- HINT maybe too high
588+ | otherwise = Stream next (0 :!: s0) (fromIntegral (n*2)) -- HINT maybe too high
716 where
589 where
717 {-# INLINE next #-}
590 {-# INLINE next #-}
718− next (z :*: s) = case f s of
591+ next (z :!: s) = case f s of
719 Nothing -> Done
592 Nothing -> Done
720 Just (w, s') | z >= n -> Done
593 Just (w, s') | z >= n -> Done
721− | otherwise -> Yield w ((z + 1) :*: s')
594+ | otherwise -> Yield w ((z + 1) :!: s')
722{-# INLINE unfoldrNI #-}
595{-# INLINE unfoldrNI #-}
723
596
724-------------------------------------------------------------------------------
597-------------------------------------------------------------------------------
@@ -728,38 +601,34 @@ unfoldrNI n f s0 | n < 0 = empty
728-- stream of length @n@, or the stream itself if @n@ is greater than the
601-- stream of length @n@, or the stream itself if @n@ is greater than the
729-- length of the stream.
602-- length of the stream.
730take :: Integral a => a -> Stream Char -> Stream Char
603take :: Integral a => a -> Stream Char -> Stream Char
731−take n0 (Stream next0 s0 len) =
604+take n0 (Stream next0 s0 len) = Stream next (n0 :!: s0) (min 0 (len - fromIntegral n0)) -- HINT maybe too high
732− Stream next (n0 :*: s0) (smaller len (fromIntegral (max 0 n0)))
733 where
605 where
734 {-# INLINE next #-}
606 {-# INLINE next #-}
735− next (n :*: s) | n <= 0 = Done
607+ next (n :!: s) | n <= 0 = Done
736 | otherwise = case next0 s of
608 | otherwise = case next0 s of
737 Done -> Done
609 Done -> Done
738− Skip s' -> Skip (n :*: s')
610+ Skip s' -> Skip (n :!: s')
739− Yield x s' -> Yield x ((n-1) :*: s')
611+ Yield x s' -> Yield x ((n-1) :!: s')
740{-# INLINE [0] take #-}
612{-# INLINE [0] take #-}
741
613
742−data Drop a s = NS !s
743− | JS !a !s
744−
745-- | /O(n)/ drop n, applied to a stream, returns the suffix of the
614-- | /O(n)/ drop n, applied to a stream, returns the suffix of the
746−-- stream after the first @n@ characters, or the empty stream if @n@
615+-- stream of length @n@, or the empty stream if @n@ is greater than the
747−-- is greater than the length of the stream.
616+-- length of the stream.
748drop :: Integral a => a -> Stream Char -> Stream Char
617drop :: Integral a => a -> Stream Char -> Stream Char
749drop n0 (Stream next0 s0 len) =
618drop n0 (Stream next0 s0 len) =
750− Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))
619+ Stream next (J (max 0 n0) :!: s0) (len - fromIntegral n0) -- HINT maybe too high
751 where
620 where
752 {-# INLINE next #-}
621 {-# INLINE next #-}
753− next (JS n s)
622+ next (J n :!: s)
754− | n <= 0 = Skip (NS s)
623+ | n == 0 = Skip (N :!: s)
755 | otherwise = case next0 s of
624 | otherwise = case next0 s of
756 Done -> Done
625 Done -> Done
757− Skip s' -> Skip (JS n s')
626+ Skip s' -> Skip (J n :!: s')
758− Yield _ s' -> Skip (JS (n-1) s')
627+ Yield _ s' -> Skip (J (n-1) :!: s')
759− next (NS s) = case next0 s of
628+ next (N :!: s) = case next0 s of
760 Done -> Done
629 Done -> Done
761− Skip s' -> Skip (NS s')
630+ Skip s' -> Skip (N :!: s')
762− Yield x s' -> Yield x (NS s')
631+ Yield x s' -> Yield x (N :!: s')
763{-# INLINE [0] drop #-}
632{-# INLINE [0] drop #-}
764
633
765-- | takeWhile, applied to a predicate @p@ and a stream, returns the
634-- | takeWhile, applied to a predicate @p@ and a stream, returns the
@@ -777,18 +646,18 @@ takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
777
646
778-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
647-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
779dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
648dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
780−dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
649+dropWhile p (Stream next0 s0 len) = Stream next (S1 :!: s0) len -- HINT maybe too high
781 where
650 where
782 {-# INLINE next #-}
651 {-# INLINE next #-}
783− next (L s) = case next0 s of
652+ next (S1 :!: s) = case next0 s of
784 Done -> Done
653 Done -> Done
785− Skip s' -> Skip (L s')
654+ Skip s' -> Skip (S1 :!: s')
786− Yield x s' | p x -> Skip (L s')
655+ Yield x s' | p x -> Skip (S1 :!: s')
787− | otherwise -> Yield x (R s')
656+ | otherwise -> Yield x (S2 :!: s')
788− next (R s) = case next0 s of
657+ next (S2 :!: s) = case next0 s of
789 Done -> Done
658 Done -> Done
790− Skip s' -> Skip (R s')
659+ Skip s' -> Skip (S2 :!: s')
791− Yield x s' -> Yield x (R s')
660+ Yield x s' -> Yield x (S2 :!: s')
792{-# INLINE [0] dropWhile #-}
661{-# INLINE [0] dropWhile #-}
793
662
794-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
663-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
@@ -804,6 +673,7 @@ isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
804 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
673 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
805 loop (next1 s1') (next2 s2')
674 loop (next1 s1') (next2 s2')
806{-# INLINE [0] isPrefixOf #-}
675{-# INLINE [0] isPrefixOf #-}
676+{-# SPECIALISE isPrefixOf :: Stream Char -> Stream Char -> Bool #-}
807
677
808-- ----------------------------------------------------------------------------
678-- ----------------------------------------------------------------------------
809-- * Searching
679-- * Searching
@@ -825,19 +695,19 @@ elem w (Stream next s0 _len) = loop_elem s0
825-------------------------------------------------------------------------------
695-------------------------------------------------------------------------------
826-- ** Searching with a predicate
696-- ** Searching with a predicate
827
697
828−-- | /O(n)/ The 'findBy' function takes a predicate and a stream,
698+-- | /O(n)/ The 'find' function takes a predicate and a stream,
829-- and returns the first element in matching the predicate, or 'Nothing'
699-- and returns the first element in matching the predicate, or 'Nothing'
830-- if there is no such element.
700-- if there is no such element.
831
701
832−findBy :: (Char -> Bool) -> Stream Char -> Maybe Char
702+find :: (Char -> Bool) -> Stream Char -> Maybe Char
833−findBy p (Stream next s0 _len) = loop_find s0
703+find p (Stream next s0 _len) = loop_find s0
834 where
704 where
835 loop_find !s = case next s of
705 loop_find !s = case next s of
836 Done -> Nothing
706 Done -> Nothing
837 Skip s' -> loop_find s'
707 Skip s' -> loop_find s'
838 Yield x s' | p x -> Just x
708 Yield x s' | p x -> Just x
839 | otherwise -> loop_find s'
709 | otherwise -> loop_find s'
840−{-# INLINE [0] findBy #-}
710+{-# INLINE [0] find #-}
841
711
842-- | /O(n)/ Stream index (subscript) operator, starting from 0.
712-- | /O(n)/ Stream index (subscript) operator, starting from 0.
843indexI :: Integral a => Stream Char -> a -> Char
713indexI :: Integral a => Stream Char -> a -> Char
@@ -858,6 +728,7 @@ indexI (Stream next s0 _len) n0
858filter :: (Char -> Bool) -> Stream Char -> Stream Char
728filter :: (Char -> Bool) -> Stream Char -> Stream Char
859filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
729filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
860 where
730 where
731+ {-# INLINE next #-}
861 next !s = case next0 s of
732 next !s = case next0 s of
862 Done -> Done
733 Done -> Done
863 Skip s' -> Skip s'
734 Skip s' -> Skip s'
@@ -866,7 +737,7 @@ filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
866{-# INLINE [0] filter #-}
737{-# INLINE [0] filter #-}
867
738
868{-# RULES
739{-# RULES
869− "STREAM filter/filter fusion" forall p q s.
740+ "Stream filter/filter fusion" forall p q s.
870 filter p (filter q s) = filter (\x -> q x && p x) s
741 filter p (filter q s) = filter (\x -> q x && p x) s
871 #-}
742 #-}
872
743
@@ -895,41 +766,58 @@ findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0
895-------------------------------------------------------------------------------
766-------------------------------------------------------------------------------
896-- * Zipping
767-- * Zipping
897
768
898−-- | Strict triple.
899−data Zip a b m = Z1 !a !b
900− | Z2 !a !b !m
901−
902-- | zipWith generalises 'zip' by zipping with the function given as
769-- | zipWith generalises 'zip' by zipping with the function given as
903-- the first argument, instead of a tupling function.
770-- the first argument, instead of a tupling function.
904zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
771zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
905−zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
772+zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) = Stream next (sa0 :!: sb0 :!: N) (min len1 len2)
906− Stream next (Z1 sa0 sb0) (smaller len1 len2)
907 where
773 where
908− next (Z1 sa sb) = case next0 sa of
774+ {-# INLINE next #-}
909− Done -> Done
775+ next (sa :!: sb :!: N) = case next0 sa of
910− Skip sa' -> Skip (Z1 sa' sb)
776+ Done -> Done
911− Yield a sa' -> Skip (Z2 sa' sb a)
777+ Skip sa' -> Skip (sa' :!: sb :!: N)
912−
778+ Yield a sa' -> Skip (sa' :!: sb :!: J a)
913− next (Z2 sa' sb a) = case next1 sb of
779+
914− Done -> Done
780+ next (sa' :!: sb :!: J a) = case next1 sb of
915− Skip sb' -> Skip (Z2 sa' sb' a)
781+ Done -> Done
916− Yield b sb' -> Yield (f a b) (Z1 sa' sb')
782+ Skip sb' -> Skip (sa' :!: sb' :!: J a)
783+ Yield b sb' -> Yield (f a b) (sa' :!: sb' :!: N)
917{-# INLINE [0] zipWith #-}
784{-# INLINE [0] zipWith #-}
918
785
919−-- | /O(n)/ The 'countCharI' function returns the number of times the
786+-- | /O(n)/ The 'elemIndexI' function returns the index of the first
920−-- query element appears in the given stream.
787+-- element in the given stream which is equal to the query
921−countCharI :: Integral a => Char -> Stream Char -> a
788+-- element, or 'Nothing' if there is no such element.
922−countCharI a (Stream next s0 _len) = loop 0 s0
789+elemIndexI :: Integral a => Char -> Stream Char -> Maybe a
790+elemIndexI a s = case elemIndicesI a s of
791+ (i:_) -> Just i
792+ _ -> Nothing
793+{-# INLINE [0] elemIndexI #-}
794+
795+-- | /O(n)/ The 'elemIndicesI' function returns the index of every
796+-- element in the given stream which is equal to the query element.
797+elemIndicesI :: Integral a => Char -> Stream Char -> [a]
798+elemIndicesI a (Stream next s0 _len) = loop 0 s0
799+ where
800+ loop !i !s = case next s of
801+ Done -> []
802+ Skip s' -> loop i s'
803+ Yield x s' | a == x -> i : loop (i+1) s'
804+ | otherwise -> loop (i+1) s'
805+{-# INLINE [0] elemIndicesI #-}
806+
807+-- | /O(n)/ The 'count' function returns the number of times the query
808+-- element appears in the given stream.
809+countI :: Integral a => Char -> Stream Char -> a
810+countI a (Stream next s0 _len) = loop 0 s0
923 where
811 where
924 loop !i !s = case next s of
812 loop !i !s = case next s of
925 Done -> i
813 Done -> i
926 Skip s' -> loop i s'
814 Skip s' -> loop i s'
927 Yield x s' | a == x -> loop (i+1) s'
815 Yield x s' | a == x -> loop (i+1) s'
928 | otherwise -> loop i s'
816 | otherwise -> loop i s'
929−{-# INLINE [0] countCharI #-}
817+{-# INLINE [0] countI #-}
930
818
931streamError :: String -> String -> a
819streamError :: String -> String -> a
932−streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg
820+streamError func msg = P.error $ "Data.Text.Fusion.Common." ++ func ++ ": " ++ msg
933
821
934emptyError :: String -> a
822emptyError :: String -> a
935emptyError func = internalError func "Empty input"
823emptyError func = internalError func "Empty input"
Data/Text/Internal/Fusion/Types.hs → Data/Text/Fusion/Internal.hsrenamed+29−33
@@ -1,66 +1,60 @@
1{-# LANGUAGE BangPatterns, ExistentialQuantification #-}
1{-# LANGUAGE BangPatterns, ExistentialQuantification #-}
2-- |
2-- |
3−-- Module : Data.Text.Internal.Fusion.Types
3+-- Module : Data.Text.Fusion.Internal
4-- Copyright : (c) Tom Harper 2008-2009,
4-- Copyright : (c) Tom Harper 2008-2009,
5-- (c) Bryan O'Sullivan 2009,
5-- (c) Bryan O'Sullivan 2009,
6−-- (c) Duncan Coutts 2009,
6+-- (c) Duncan Coutts 2009
7−-- (c) Jasper Van der Jeugt 2011
8--
7--
9-- License : BSD-style
8-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
9+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,
10+-- duncan@haskell.org
11-- Stability : experimental
11-- Stability : experimental
12-- Portability : GHC
12-- Portability : GHC
13--
13--
14−-- /Warning/: this is an internal module, and does not have a stable
15−-- API or name. Functions in this module may not check or enforce
16−-- preconditions expected by public modules. Use at your own risk!
17−--
18-- Core stream fusion functionality for text.
14-- Core stream fusion functionality for text.
19
15
20−module Data.Text.Internal.Fusion.Types
16+module Data.Text.Fusion.Internal
21 (
17 (
22− CC(..)
18+ M(..)
19+ , M8
23 , PairS(..)
20 , PairS(..)
24− , Scan(..)
21+ , S(..)
25− , RS(..)
26 , Step(..)
22 , Step(..)
27 , Stream(..)
23 , Stream(..)
24+ , Switch(..)
28 , empty
25 , empty
29 ) where
26 ) where
30
27
31−import Data.Text.Internal.Fusion.Size
32import Data.Word (Word8)
28import Data.Word (Word8)
33
29
34−-- | Specialised tuple for case conversion.
30+-- | Specialised, strict Maybe-like type.
35−data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char
31+data M a = N
32+ | J {-# UNPACK #-} !a
33+ deriving (Eq, Ord, Show)
34+
35+type M8 = M Word8
36
36
37−-- | Restreaming state.
37+-- Restreaming state.
38−data RS s
38+data S s = S {-# UNPACK #-} !s
39− = RS0 !s
39+ {-# UNPACK #-} !M8 {-# UNPACK #-} !M8 {-# UNPACK #-} !M8
40− | RS1 !s {-# UNPACK #-} !Word8
40+ deriving (Eq, Ord, Show)
41− | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
42− | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
43
41
44−-- | Strict pair.
42+infixl 2 :!:
45−data PairS a b = !a :*: !b
43+data PairS a b = !a :!: !b
46− -- deriving (Eq, Ord, Show)
44+ deriving (Eq, Ord, Read, Show)
47−infixl 2 :*:
48
45
49−-- | An intermediate result in a scan.
46+-- | Allow a function over a stream to switch between two states.
50−data Scan s = Scan1 {-# UNPACK #-} !Char !s
47+data Switch = S1 | S2
51− | Scan2 {-# UNPACK #-} !Char !s
48+ deriving (Eq, Ord, Show)
52
49
53−-- | Intermediate result in a processing pipeline.
54data Step s a = Done
50data Step s a = Done
55 | Skip !s
51 | Skip !s
56 | Yield !a !s
52 | Yield !a !s
57
53
58−{-
54+instance Show a => Show (Step s a)
59−instance (Show a) => Show (Step s a)
60 where show Done = "Done"
55 where show Done = "Done"
61 show (Skip _) = "Skip"
56 show (Skip _) = "Skip"
62 show (Yield x _) = "Yield " ++ show x
57 show (Yield x _) = "Yield " ++ show x
63−-}
64
58
65instance (Eq a) => Eq (Stream a) where
59instance (Eq a) => Eq (Stream a) where
66 (==) = eq
60 (==) = eq
@@ -84,7 +78,7 @@ data Stream a =
84 forall s. Stream
78 forall s. Stream
85 (s -> Step s a) -- stepper function
79 (s -> Step s a) -- stepper function
86 !s -- current state
80 !s -- current state
87− !Size -- size hint
81+ {-# UNPACK #-}!Int -- length hint
88
82
89-- | /O(n)/ Determines if two streams are equal.
83-- | /O(n)/ Determines if two streams are equal.
90eq :: (Eq a) => Stream a -> Stream a -> Bool
84eq :: (Eq a) => Stream a -> Stream a -> Bool
@@ -99,6 +93,7 @@ eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
99 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
93 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
100 loop (next1 s1') (next2 s2')
94 loop (next1 s1') (next2 s2')
101{-# INLINE [0] eq #-}
95{-# INLINE [0] eq #-}
96+{-# SPECIALISE eq :: Stream Char -> Stream Char -> Bool #-}
102
97
103cmp :: (Ord a) => Stream a -> Stream a -> Ordering
98cmp :: (Ord a) => Stream a -> Stream a -> Ordering
104cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
99cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
@@ -114,6 +109,7 @@ cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
114 EQ -> loop (next1 s1') (next2 s2')
109 EQ -> loop (next1 s1') (next2 s2')
115 other -> other
110 other -> other
116{-# INLINE [0] cmp #-}
111{-# INLINE [0] cmp #-}
112+{-# SPECIALISE cmp :: Stream Char -> Stream Char -> Ordering #-}
117
113
118-- | The empty stream.
114-- | The empty stream.
119empty :: Stream a
115empty :: Stream a
Data/Text/IO.hsdeleted−338
@@ -1,338 +0,0 @@
1−{-# LANGUAGE BangPatterns, CPP, RecordWildCards, ScopedTypeVariables #-}
2−#if __GLASGOW_HASKELL__ >= 702
3−{-# LANGUAGE Trustworthy #-}
4−#endif
5−-- |
6−-- Module : Data.Text.IO
7−-- Copyright : (c) 2009, 2010 Bryan O'Sullivan,
8−-- (c) 2009 Simon Marlow
9−-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
11−-- Stability : experimental
12−-- Portability : GHC
13−--
14−-- Efficient locale-sensitive support for text I\/O.
15−--
16−-- Skip past the synopsis for some important notes on performance and
17−-- portability across different versions of GHC.
18−
19−module Data.Text.IO
20− (
21− -- * Performance
22− -- $performance
23−
24− -- * Locale support
25− -- $locale
26− -- * File-at-a-time operations
27− readFile
28− , writeFile
29− , appendFile
30− -- * Operations on handles
31− , hGetContents
32− , hGetChunk
33− , hGetLine
34− , hPutStr
35− , hPutStrLn
36− -- * Special cases for standard input and output
37− , interact
38− , getContents
39− , getLine
40− , putStr
41− , putStrLn
42− ) where
43−
44−import Data.Text (Text)
45−import Prelude hiding (appendFile, getContents, getLine, interact,
46− putStr, putStrLn, readFile, writeFile)
47−import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,
48− withFile)
49−import qualified Control.Exception as E
50−import Control.Monad (liftM2, when)
51−import Data.IORef (readIORef, writeIORef)
52−import 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)
56−import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBufElem, CharBuffer,
57− RawCharBuffer, emptyBuffer, isEmptyBuffer, newCharBuffer,
58− writeCharBuf)
59−import GHC.IO.Exception (IOException(ioe_type), IOErrorType(InappropriateType))
60−import GHC.IO.Handle.Internals (augmentIOError, hClose_help, wantReadableHandle,
61− wantWritableHandle)
62−import GHC.IO.Handle.Text (commitBuffer')
63−import GHC.IO.Handle.Types (BufferList(..), BufferMode(..), Handle__(..),
64− HandleType(..), Newline(..))
65−import System.IO (hGetBuffering, hFileSize, hSetBuffering, hTell)
66−import System.IO.Error (isEOFError)
67−
68−-- $performance
69−-- #performance#
70−--
71−-- The functions in this module obey the runtime system's locale,
72−-- character set encoding, and line ending conversion settings.
73−--
74−-- If you know in advance that you will be working with data that has
75−-- a specific encoding (e.g. UTF-8), and your application is highly
76−-- performance sensitive, you may find that it is faster to perform
77−-- I\/O with bytestrings and to encode and decode yourself than to use
78−-- the functions in this module.
79−--
80−-- Whether this will hold depends on the version of GHC you are using,
81−-- the platform you are working on, the data you are working with, and
82−-- the encodings you are using, so be sure to test for yourself.
83−
84−-- | The 'readFile' function reads a file and returns the contents of
85−-- the file as a string. The entire file is read strictly, as with
86−-- 'getContents'.
87−readFile :: FilePath -> IO Text
88−readFile name = openFile name ReadMode >>= hGetContents
89−
90−-- | Write a string to a file. The file is truncated to zero length
91−-- before writing begins.
92−writeFile :: FilePath -> Text -> IO ()
93−writeFile p = withFile p WriteMode . flip hPutStr
94−
95−-- | Write a string the end of a file.
96−appendFile :: FilePath -> Text -> IO ()
97−appendFile p = withFile p AppendMode . flip hPutStr
98−
99−catchError :: String -> Handle -> Handle__ -> IOError -> IO Text
100−catchError caller h Handle__{..} err
101− | isEOFError err = do
102− buf <- readIORef haCharBuffer
103− return $ if isEmptyBuffer buf
104− then T.empty
105− else T.singleton '\r'
106− | otherwise = E.throwIO (augmentIOError err caller h)
107−
108−-- | /Experimental./ Read a single chunk of strict text from a
109−-- 'Handle'. The size of the chunk depends on the amount of input
110−-- currently buffered.
111−--
112−-- This function blocks only if there is no data available, and EOF
113−-- has not yet been reached. Once EOF is reached, this function
114−-- returns an empty string instead of throwing an exception.
115−hGetChunk :: Handle -> IO Text
116−hGetChunk h = wantReadableHandle "hGetChunk" h readSingleChunk
117− where
118− readSingleChunk hh@Handle__{..} = do
119− buf <- readIORef haCharBuffer
120− t <- readChunk hh buf `E.catch` catchError "hGetChunk" h hh
121− return (hh, t)
122−
123−-- | Read the remaining contents of a 'Handle' as a string. The
124−-- 'Handle' is closed once the contents have been read, or if an
125−-- exception is thrown.
126−--
127−-- Internally, this function reads a chunk at a time from the
128−-- lower-level buffering abstraction, and concatenates the chunks into
129−-- a single string once the entire file has been read.
130−--
131−-- As a result, it requires approximately twice as much memory as its
132−-- result to construct its result. For files more than a half of
133−-- available RAM in size, this may result in memory exhaustion.
134−hGetContents :: Handle -> IO Text
135−hGetContents h = do
136− chooseGoodBuffering h
137− wantReadableHandle "hGetContents" h readAll
138− where
139− readAll hh@Handle__{..} = do
140− let readChunks = do
141− buf <- readIORef haCharBuffer
142− t <- readChunk hh buf `E.catch` catchError "hGetContents" h hh
143− if T.null t
144− then return [t]
145− else (t:) `fmap` readChunks
146− ts <- readChunks
147− (hh', _) <- hClose_help hh
148− return (hh'{haType=ClosedHandle}, T.concat ts)
149−
150−-- | Use a more efficient buffer size if we're reading in
151−-- block-buffered mode with the default buffer size. When we can
152−-- determine the size of the handle we're reading, set the buffer size
153−-- to that, so that we can read the entire file in one chunk.
154−-- Otherwise, use a buffer size of at least 16KB.
155−chooseGoodBuffering :: Handle -> IO ()
156−chooseGoodBuffering h = do
157− bufMode <- hGetBuffering h
158− case bufMode of
159− BlockBuffering Nothing -> do
160− d <- E.catch (liftM2 (-) (hFileSize h) (hTell h)) $ \(e::IOException) ->
161− if ioe_type e == InappropriateType
162− then return 16384 -- faster than the 2KB default
163− else E.throwIO e
164− when (d > 0) . hSetBuffering h . BlockBuffering . Just . fromIntegral $ d
165− _ -> return ()
166−
167−-- | Read a single line from a handle.
168−hGetLine :: Handle -> IO Text
169−hGetLine = hGetLineWith T.concat
170−
171−-- | Write a string to a handle.
172−hPutStr :: Handle -> Text -> IO ()
173−-- This function is lifted almost verbatim from GHC.IO.Handle.Text.
174−hPutStr h t = do
175− (buffer_mode, nl) <-
176− wantWritableHandle "hPutStr" h $ \h_ -> do
177− bmode <- getSpareBuffer h_
178− return (bmode, haOutputNL h_)
179− let str = stream t
180− case buffer_mode of
181− (NoBuffering, _) -> hPutChars h str
182− (LineBuffering, buf) -> writeLines h nl buf str
183− (BlockBuffering _, buf)
184− | nl == CRLF -> writeBlocksCRLF h buf str
185− | otherwise -> writeBlocksRaw h buf str
186−
187−hPutChars :: Handle -> Stream Char -> IO ()
188−hPutChars h (Stream next0 s0 _len) = loop s0
189− where
190− loop !s = case next0 s of
191− Done -> return ()
192− Skip s' -> loop s'
193− Yield x s' -> hPutChar h x >> loop s'
194−
195−-- The following functions are largely lifted from GHC.IO.Handle.Text,
196−-- but adapted to a coinductive stream of data instead of an inductive
197−-- list.
198−--
199−-- We have several variations of more or less the same code for
200−-- performance reasons. Splitting the original buffered write
201−-- function into line- and block-oriented versions gave us a 2.1x
202−-- performance improvement. Lifting out the raw/cooked newline
203−-- handling gave a few more percent on top.
204−
205−writeLines :: Handle -> Newline -> Buffer CharBufElem -> Stream Char -> IO ()
206−writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0
207− where
208− outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
209− where
210− inner !s !n =
211− case next0 s of
212− Done -> commit n False{-no flush-} True{-release-} >> return ()
213− Skip s' -> inner s' n
214− Yield x s'
215− | n + 1 >= len -> commit n True{-needs flush-} False >>= outer s
216− | x == '\n' -> do
217− n' <- if nl == CRLF
218− then do n1 <- writeCharBuf raw n '\r'
219− writeCharBuf raw n1 '\n'
220− else writeCharBuf raw n x
221− commit n' True{-needs flush-} False >>= outer s'
222− | otherwise -> writeCharBuf raw n x >>= inner s'
223− commit = commitBuffer h raw len
224−
225−writeBlocksCRLF :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
226−writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0
227− where
228− outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
229− where
230− inner !s !n =
231− case next0 s of
232− Done -> commit n False{-no flush-} True{-release-} >> return ()
233− Skip s' -> inner s' n
234− Yield x s'
235− | n + 1 >= len -> commit n True{-needs flush-} False >>= outer s
236− | x == '\n' -> do n1 <- writeCharBuf raw n '\r'
237− writeCharBuf raw n1 '\n' >>= inner s'
238− | otherwise -> writeCharBuf raw n x >>= inner s'
239− commit = commitBuffer h raw len
240−
241−writeBlocksRaw :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
242−writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0
243− where
244− outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
245− where
246− inner !s !n =
247− case next0 s of
248− Done -> commit n False{-no flush-} True{-release-} >> return ()
249− Skip s' -> inner s' n
250− Yield x s'
251− | n + 1 >= len -> commit n True{-needs flush-} False >>= outer s
252− | otherwise -> writeCharBuf raw n x >>= inner s'
253− commit = commitBuffer h raw len
254−
255−-- This function is completely lifted from GHC.IO.Handle.Text.
256−getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)
257−getSpareBuffer Handle__{haCharBuffer=ref,
258− haBuffers=spare_ref,
259− haBufferMode=mode}
260− = do
261− case mode of
262− NoBuffering -> return (mode, error "no buffer!")
263− _ -> do
264− bufs <- readIORef spare_ref
265− buf <- readIORef ref
266− case bufs of
267− BufferListCons b rest -> do
268− writeIORef spare_ref rest
269− return ( mode, emptyBuffer b (bufSize buf) WriteBuffer)
270− BufferListNil -> do
271− new_buf <- newCharBuffer (bufSize buf) WriteBuffer
272− return (mode, new_buf)
273−
274−
275−-- This function is completely lifted from GHC.IO.Handle.Text.
276−commitBuffer :: Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool
277− -> IO CharBuffer
278−commitBuffer hdl !raw !sz !count flush release =
279− wantWritableHandle "commitAndReleaseBuffer" hdl $
280− commitBuffer' raw sz count flush release
281−{-# INLINE commitBuffer #-}
282−
283−-- | Write a string to a handle, followed by a newline.
284−hPutStrLn :: Handle -> Text -> IO ()
285−hPutStrLn h t = hPutStr h t >> hPutChar h '\n'
286−
287−-- | The 'interact' function takes a function of type @Text -> Text@
288−-- as its argument. The entire input from the standard input device is
289−-- passed to this function as its argument, and the resulting string
290−-- is output on the standard output device.
291−interact :: (Text -> Text) -> IO ()
292−interact f = putStr . f =<< getContents
293−
294−-- | Read all user input on 'stdin' as a single string.
295−getContents :: IO Text
296−getContents = hGetContents stdin
297−
298−-- | Read a single line of user input from 'stdin'.
299−getLine :: IO Text
300−getLine = hGetLine stdin
301−
302−-- | Write a string to 'stdout'.
303−putStr :: Text -> IO ()
304−putStr = hPutStr stdout
305−
306−-- | Write a string to 'stdout', followed by a newline.
307−putStrLn :: Text -> IO ()
308−putStrLn = hPutStrLn stdout
309−
310−-- $locale
311−--
312−-- /Note/: The behaviour of functions in this module depends on the
313−-- version of GHC you are using.
314−--
315−-- Beginning with GHC 6.12, text I\/O is performed using the system or
316−-- handle's current locale and line ending conventions.
317−--
318−-- Under GHC 6.10 and earlier, the system I\/O libraries do not
319−-- support locale-sensitive I\/O or line ending conversion. On these
320−-- versions of GHC, functions in this library all use UTF-8. What
321−-- does this mean in practice?
322−--
323−-- * All data that is read will be decoded as UTF-8.
324−--
325−-- * Before data is written, it is first encoded as UTF-8.
326−--
327−-- * On both reading and writing, the platform's native newline
328−-- conversion is performed.
329−--
330−-- If you must use a non-UTF-8 locale on an older version of GHC, you
331−-- will have to perform the transcoding yourself, e.g. as follows:
332−--
333−-- > import qualified Data.ByteString as B
334−-- > import Data.Text (Text)
335−-- > import Data.Text.Encoding (encodeUtf16)
336−-- >
337−-- > putStr_Utf16LE :: Text -> IO ()
338−-- > putStr_Utf16LE t = B.putStr (encodeUtf16LE t)
Data/Text/Internal.hs+28−145
@@ -1,188 +1,71 @@
1−{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples #-}
1+{-# LANGUAGE DeriveDataTypeable #-}
2−{-# OPTIONS_HADDOCK not-home #-}
3
2
4-- |
3-- |
5-- Module : Data.Text.Internal
4-- Module : Data.Text.Internal
6−-- Copyright : (c) 2008, 2009 Tom Harper,
5+-- Copyright : (c) Tom Harper 2008-2009,
7−-- (c) 2009, 2010 Bryan O'Sullivan,
6+-- (c) Bryan O'Sullivan 2009,
8−-- (c) 2009 Duncan Coutts
7+-- (c) Duncan Coutts 2009
9--
8--
10-- License : BSD-style
9-- License : BSD-style
11−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,
11+-- duncan@haskell.org
12-- Stability : experimental
12-- Stability : experimental
13-- Portability : GHC
13-- Portability : GHC
14--
14--
15−-- A module containing private 'Text' internals. This exposes the
15+-- Semi-public internals. Most users should not need to use this
16−-- 'Text' representation and low level construction functions.
16+-- module.
17−-- Modules which extend the 'Text' system may need to use this module.
18−--
19−-- You should not use this module unless you are determined to monkey
20−-- with the internals, as the functions here do just about nothing to
21−-- preserve data invariants. You have been warned!
22−
23−#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
24−#include "MachDeps.h"
25−#endif
26
17
27module Data.Text.Internal
18module Data.Text.Internal
28 (
19 (
29 -- * Types
20 -- * Types
30− -- $internals
31 Text(..)
21 Text(..)
32 -- * Construction
22 -- * Construction
33 , text
23 , text
34 , textP
24 , textP
35− -- * Safety
36− , safe
37 -- * Code that must be here for accessibility
25 -- * Code that must be here for accessibility
38 , empty
26 , empty
39− , empty_
40− -- * Utilities
41− , firstf
42− -- * Checked multiplication
43− , mul
44− , mul32
45− , mul64
46 -- * Debugging
27 -- * Debugging
47 , showText
28 , showText
48 ) where
29 ) where
49
30
50−#if defined(ASSERTS)
51import Control.Exception (assert)
31import Control.Exception (assert)
52−#endif
53−import Data.Bits
54−import Data.Int (Int32, Int64)
55−import Data.Text.Internal.Unsafe.Char (ord)
56−import Data.Typeable (Typeable)
57import qualified Data.Text.Array as A
32import qualified Data.Text.Array as A
33+import Data.Typeable (Typeable)
34+import Data.Word (Word16)
58
35
59-- | A space efficient, packed, unboxed Unicode text type.
36-- | A space efficient, packed, unboxed Unicode text type.
60data Text = Text
37data Text = Text
61− {-# UNPACK #-} !A.Array -- payload (Word16 elements)
38+ {-# UNPACK #-} !(A.Array Word16) -- payload
62− {-# UNPACK #-} !Int -- offset (units of Word16, not Char)
39+ {-# UNPACK #-} !Int -- offset
63− {-# UNPACK #-} !Int -- length (units of Word16, not Char)
40+ {-# UNPACK #-} !Int -- length
64 deriving (Typeable)
41 deriving (Typeable)
65
42
66-- | Smart constructor.
43-- | Smart constructor.
67−text_ :: A.Array -> Int -> Int -> Text
44+text :: A.Array Word16 -> Int -> Int -> Text
68−text_ arr off len =
45+text arr off len =
69−#if defined(ASSERTS)
46+ assert (len >= 0) .
70− let c = A.unsafeIndex arr off
47+ assert (off >= 0) .
71− alen = A.length arr
48+ assert (alen == 0 || off < alen) .
72− in assert (len >= 0) .
49+ assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $
73− assert (off >= 0) .
50+ Text arr off len
74− assert (alen == 0 || len == 0 || off < alen) .
51+ where c = A.unsafeIndex arr off
75− assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $
52+ alen = A.length arr
76−#endif
53+{-# INLINE text #-}
77− Text arr off len
78−{-# INLINE text_ #-}
79
54
80-- | /O(1)/ The empty 'Text'.
55-- | /O(1)/ The empty 'Text'.
81empty :: Text
56empty :: Text
82empty = Text A.empty 0 0
57empty = Text A.empty 0 0
83{-# INLINE [1] empty #-}
58{-# INLINE [1] empty #-}
84
59
85−-- | A non-inlined version of 'empty'.
86−empty_ :: Text
87−empty_ = Text A.empty 0 0
88−{-# NOINLINE empty_ #-}
89−
90-- | Construct a 'Text' without invisibly pinning its byte array in
60-- | Construct a 'Text' without invisibly pinning its byte array in
91-- memory if its length has dwindled to zero.
61-- memory if its length has dwindled to zero.
92−text :: A.Array -> Int -> Int -> Text
62+textP :: A.Array Word16 -> Int -> Int -> Text
93−text arr off len | len == 0 = empty
63+textP arr off len | len == 0 = empty
94− | otherwise = text_ arr off len
64+ | otherwise = text arr off len
95−{-# INLINE text #-}
65+{-# INLINE textP #-}
96−
97−textP :: A.Array -> Int -> Int -> Text
98−{-# DEPRECATED textP "Use text instead" #-}
99−textP = text
100
66
101-- | A useful 'show'-like function for debugging purposes.
67-- | A useful 'show'-like function for debugging purposes.
102showText :: Text -> String
68showText :: Text -> String
103showText (Text arr off len) =
69showText (Text arr off len) =
104− "Text " ++ show (A.toList arr off len) ++ ' ' :
70+ "Text " ++ (show . take (off+len) . A.toList) arr ++ ' ' :
105 show off ++ ' ' : show len
71 show off ++ ' ' : show len
106−
107−-- | Map a 'Char' to a 'Text'-safe value.
108−--
109−-- UTF-16 surrogate code points are not included in the set of Unicode
110−-- scalar values, but are unfortunately admitted as valid 'Char'
111−-- values by Haskell. They cannot be represented in a 'Text'. This
112−-- function remaps those code points to the Unicode replacement
113−-- character (U+FFFD, \'&#xfffd;\'), and leaves other code points
114−-- unchanged.
115−safe :: Char -> Char
116−safe c
117− | ord c .&. 0x1ff800 /= 0xd800 = c
118− | otherwise = '\xfffd'
119−{-# INLINE [0] safe #-}
120−
121−-- | Apply a function to the first element of an optional pair.
122−firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)
123−firstf f (Just (a, b)) = Just (f a, b)
124−firstf _ Nothing = Nothing
125−
126−-- | Checked multiplication. Calls 'error' if the result would
127−-- overflow.
128−mul :: Int -> Int -> Int
129−#if WORD_SIZE_IN_BITS == 64
130−mul a b = fromIntegral $ fromIntegral a `mul64` fromIntegral b
131−#else
132−mul a b = fromIntegral $ fromIntegral a `mul32` fromIntegral b
133−#endif
134−{-# INLINE mul #-}
135−infixl 7 `mul`
136−
137−-- | Checked multiplication. Calls 'error' if the result would
138−-- overflow.
139−mul64 :: Int64 -> Int64 -> Int64
140−mul64 a b
141− | a >= 0 && b >= 0 = mul64_ a b
142− | a >= 0 = -mul64_ a (-b)
143− | b >= 0 = -mul64_ (-a) b
144− | otherwise = mul64_ (-a) (-b)
145−{-# INLINE mul64 #-}
146−infixl 7 `mul64`
147−
148−mul64_ :: Int64 -> Int64 -> Int64
149−mul64_ a b
150− | ahi > 0 && bhi > 0 = error "overflow"
151− | top > 0x7fffffff = error "overflow"
152− | total < 0 = error "overflow"
153− | otherwise = total
154− where (# ahi, alo #) = (# a `shiftR` 32, a .&. 0xffffffff #)
155− (# bhi, blo #) = (# b `shiftR` 32, b .&. 0xffffffff #)
156− top = ahi * blo + alo * bhi
157− total = (top `shiftL` 32) + alo * blo
158−{-# INLINE mul64_ #-}
159−
160−-- | Checked multiplication. Calls 'error' if the result would
161−-- overflow.
162−mul32 :: Int32 -> Int32 -> Int32
163−mul32 a b = case fromIntegral a * fromIntegral b of
164− ab | ab < min32 || ab > max32 -> error "overflow"
165− | otherwise -> fromIntegral ab
166− where min32 = -0x80000000 :: Int64
167− max32 = 0x7fffffff
168−{-# INLINE mul32 #-}
169−infixl 7 `mul32`
170−
171−-- $internals
172−--
173−-- Internally, the 'Text' type is represented as an array of 'Word16'
174−-- UTF-16 code units. The offset and length fields in the constructor
175−-- are in these units, /not/ units of 'Char'.
176−--
177−-- Invariants that all functions must maintain:
178−--
179−-- * Since the 'Text' type uses UTF-16 internally, it cannot represent
180−-- characters in the reserved surrogate code point range U+D800 to
181−-- U+DFFF. To maintain this invariant, the 'safe' function maps
182−-- 'Char' values in this range to the replacement character (U+FFFD,
183−-- \'&#xfffd;\').
184−--
185−-- * A leading (or \"high\") surrogate code unit (0xD800–0xDBFF) must
186−-- always be followed by a trailing (or \"low\") surrogate code unit
187−-- (0xDC00-0xDFFF). A trailing surrogate code unit must always be
188−-- preceded by a leading surrogate code unit.
Data/Text/Internal/Builder.hsdeleted−329
@@ -1,329 +0,0 @@
1−{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
2−{-# OPTIONS_HADDOCK not-home #-}
3−
4−-----------------------------------------------------------------------------
5−-- |
6−-- Module : Data.Text.Internal.Builder
7−-- Copyright : (c) 2013 Bryan O'Sullivan
8−-- (c) 2010 Johan Tibell
9−-- License : BSD-style (see LICENSE)
10−--
11−-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
12−-- Stability : experimental
13−-- Portability : portable to Hugs and GHC
14−--
15−-- /Warning/: this is an internal module, and does not have a stable
16−-- API or name. Functions in this module may not check or enforce
17−-- preconditions expected by public modules. Use at your own risk!
18−--
19−-- Efficient construction of lazy @Text@ values. The principal
20−-- operations on a @Builder@ are @singleton@, @fromText@, and
21−-- @fromLazyText@, which construct new builders, and 'mappend', which
22−-- concatenates two builders.
23−--
24−-- To get maximum performance when building lazy @Text@ values using a
25−-- builder, associate @mappend@ calls to the right. For example,
26−-- prefer
27−--
28−-- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')
29−--
30−-- to
31−--
32−-- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'
33−--
34−-- as the latter associates @mappend@ to the left.
35−--
36−-----------------------------------------------------------------------------
37−
38−module Data.Text.Internal.Builder
39− ( -- * Public API
40− -- ** The Builder type
41− Builder
42− , toLazyText
43− , toLazyTextWith
44−
45− -- ** Constructing Builders
46− , singleton
47− , fromText
48− , fromLazyText
49− , fromString
50−
51− -- ** Flushing the buffer state
52− , flush
53−
54− -- * Internal functions
55− , append'
56− , ensureFree
57− , writeN
58− ) where
59−
60−import Control.Monad.ST (ST, runST)
61−import Data.Monoid (Monoid(..))
62−#if MIN_VERSION_base(4,9,0)
63−import Data.Semigroup (Semigroup(..))
64−#endif
65−import Data.Text.Internal (Text(..))
66−import Data.Text.Internal.Lazy (smallChunkSize)
67−import Data.Text.Unsafe (inlineInterleaveST)
68−import Data.Text.Internal.Unsafe.Char (unsafeWrite)
69−import Prelude hiding (map, putChar)
70−
71−import qualified Data.String as String
72−import qualified Data.Text as S
73−import qualified Data.Text.Array as A
74−import qualified Data.Text.Lazy as L
75−
76−------------------------------------------------------------------------
77−
78−-- | A @Builder@ is an efficient way to build lazy @Text@ values.
79−-- There are several functions for constructing builders, but only one
80−-- to inspect them: to extract any data, you have to turn them into
81−-- lazy @Text@ values using @toLazyText@.
82−--
83−-- Internally, a builder constructs a lazy @Text@ by filling arrays
84−-- piece by piece. As each buffer is filled, it is \'popped\' off, to
85−-- become a new chunk of the resulting lazy @Text@. All this is
86−-- hidden from the user of the @Builder@.
87−newtype Builder = Builder {
88− -- Invariant (from Data.Text.Lazy):
89− -- The lists include no null Texts.
90− runBuilder :: forall s. (Buffer s -> ST s [S.Text])
91− -> Buffer s
92− -> ST s [S.Text]
93− }
94−
95−#if MIN_VERSION_base(4,9,0)
96−instance Semigroup Builder where
97− (<>) = append
98− {-# INLINE (<>) #-}
99−#endif
100−
101−instance Monoid Builder where
102− mempty = empty
103− {-# INLINE mempty #-}
104−#if MIN_VERSION_base(4,9,0)
105− mappend = (<>) -- future-proof definition
106−#else
107− mappend = append
108−#endif
109− {-# INLINE mappend #-}
110− mconcat = foldr mappend Data.Monoid.mempty
111− {-# INLINE mconcat #-}
112−
113−instance String.IsString Builder where
114− fromString = fromString
115− {-# INLINE fromString #-}
116−
117−instance Show Builder where
118− show = show . toLazyText
119−
120−instance Eq Builder where
121− a == b = toLazyText a == toLazyText b
122−
123−instance Ord Builder where
124− a <= b = toLazyText a <= toLazyText b
125−
126−------------------------------------------------------------------------
127−
128−-- | /O(1)./ The empty @Builder@, satisfying
129−--
130−-- * @'toLazyText' 'empty' = 'L.empty'@
131−--
132−empty :: Builder
133−empty = Builder (\ k buf -> k buf)
134−{-# INLINE empty #-}
135−
136−-- | /O(1)./ A @Builder@ taking a single character, satisfying
137−--
138−-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@
139−--
140−singleton :: Char -> Builder
141−singleton c = writeAtMost 2 $ \ marr o -> unsafeWrite marr o c
142−{-# INLINE singleton #-}
143−
144−------------------------------------------------------------------------
145−
146−-- | /O(1)./ The concatenation of two builders, an associative
147−-- operation with identity 'empty', satisfying
148−--
149−-- * @'toLazyText' ('append' x y) = 'L.append' ('toLazyText' x) ('toLazyText' y)@
150−--
151−append :: Builder -> Builder -> Builder
152−append (Builder f) (Builder g) = Builder (f . g)
153−{-# INLINE [0] append #-}
154−
155−-- TODO: Experiment to find the right threshold.
156−copyLimit :: Int
157−copyLimit = 128
158−
159−-- This function attempts to merge small @Text@ values instead of
160−-- treating each value as its own chunk. We may not always want this.
161−
162−-- | /O(1)./ A @Builder@ taking a 'S.Text', satisfying
163−--
164−-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@
165−--
166−fromText :: S.Text -> Builder
167−fromText t@(Text arr off l)
168− | S.null t = empty
169− | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)
170− | otherwise = flush `append` mapBuilder (t :)
171−{-# INLINE [1] fromText #-}
172−
173−{-# RULES
174−"fromText/pack" forall s .
175− fromText (S.pack s) = fromString s
176− #-}
177−
178−-- | /O(1)./ A Builder taking a @String@, satisfying
179−--
180−-- * @'toLazyText' ('fromString' s) = 'L.fromChunks' [S.pack s]@
181−--
182−fromString :: String -> Builder
183−fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
184− let loop !marr !o !u !l [] = k (Buffer marr o u l)
185− loop marr o u l s@(c:cs)
186− | l <= 1 = do
187− arr <- A.unsafeFreeze marr
188− let !t = Text arr o u
189− marr' <- A.new chunkSize
190− ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
191− return $ t : ts
192− | otherwise = do
193− n <- unsafeWrite marr (o+u) c
194− loop marr o (u+n) (l-n) cs
195− in loop p0 o0 u0 l0 str
196− where
197− chunkSize = smallChunkSize
198−{-# INLINE fromString #-}
199−
200−-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying
201−--
202−-- * @'toLazyText' ('fromLazyText' t) = t@
203−--
204−fromLazyText :: L.Text -> Builder
205−fromLazyText ts = flush `append` mapBuilder (L.toChunks ts ++)
206−{-# INLINE fromLazyText #-}
207−
208−------------------------------------------------------------------------
209−
210−-- Our internal buffer type
211−data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s)
212− {-# UNPACK #-} !Int -- offset
213− {-# UNPACK #-} !Int -- used units
214− {-# UNPACK #-} !Int -- length left
215−
216−------------------------------------------------------------------------
217−
218−-- | /O(n)./ Extract a lazy @Text@ from a @Builder@ with a default
219−-- buffer size. The construction work takes place if and when the
220−-- relevant part of the lazy @Text@ is demanded.
221−toLazyText :: Builder -> L.Text
222−toLazyText = toLazyTextWith smallChunkSize
223−
224−-- | /O(n)./ Extract a lazy @Text@ from a @Builder@, using the given
225−-- size for the initial buffer. The construction work takes place if
226−-- and when the relevant part of the lazy @Text@ is demanded.
227−--
228−-- If the initial buffer is too small to hold all data, subsequent
229−-- buffers will be the default buffer size.
230−toLazyTextWith :: Int -> Builder -> L.Text
231−toLazyTextWith chunkSize m = L.fromChunks (runST $
232− newBuffer chunkSize >>= runBuilder (m `append` flush) (const (return [])))
233−
234−-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,
235−-- yielding a new chunk in the result lazy @Text@.
236−flush :: Builder
237−flush = Builder $ \ k buf@(Buffer p o u l) ->
238− if u == 0
239− then k buf
240− else do arr <- A.unsafeFreeze p
241− let !b = Buffer p (o+u) 0 l
242− !t = Text arr o u
243− ts <- inlineInterleaveST (k b)
244− return $! t : ts
245−{-# INLINE [1] flush #-}
246−-- defer inlining so that flush/flush rule may fire.
247−
248−------------------------------------------------------------------------
249−
250−-- | Sequence an ST operation on the buffer
251−withBuffer :: (forall s. Buffer s -> ST s (Buffer s)) -> Builder
252−withBuffer f = Builder $ \k buf -> f buf >>= k
253−{-# INLINE withBuffer #-}
254−
255−-- | Get the size of the buffer
256−withSize :: (Int -> Builder) -> Builder
257−withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->
258− runBuilder (f l) k buf
259−{-# INLINE withSize #-}
260−
261−-- | Map the resulting list of texts.
262−mapBuilder :: ([S.Text] -> [S.Text]) -> Builder
263−mapBuilder f = Builder (fmap f .)
264−
265−------------------------------------------------------------------------
266−
267−-- | Ensure that there are at least @n@ many elements available.
268−ensureFree :: Int -> Builder
269−ensureFree !n = withSize $ \ l ->
270− if n <= l
271− then empty
272− else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize)))
273−{-# INLINE [0] ensureFree #-}
274−
275−writeAtMost :: Int -> (forall s. A.MArray s -> Int -> ST s Int) -> Builder
276−writeAtMost n f = ensureFree n `append'` withBuffer (writeBuffer f)
277−{-# INLINE [0] writeAtMost #-}
278−
279−-- | Ensure that @n@ many elements are available, and then use @f@ to
280−-- write some elements into the memory.
281−writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder
282−writeN n f = writeAtMost n (\ p o -> f p o >> return n)
283−{-# INLINE writeN #-}
284−
285−writeBuffer :: (A.MArray s -> Int -> ST s Int) -> Buffer s -> ST s (Buffer s)
286−writeBuffer f (Buffer p o u l) = do
287− n <- f p (o+u)
288− return $! Buffer p o (u+n) (l-n)
289−{-# INLINE writeBuffer #-}
290−
291−newBuffer :: Int -> ST s (Buffer s)
292−newBuffer size = do
293− arr <- A.new size
294− return $! Buffer arr 0 0 size
295−{-# INLINE newBuffer #-}
296−
297−------------------------------------------------------------------------
298−-- Some nice rules for Builder
299−
300−-- This function makes GHC understand that 'writeN' and 'ensureFree'
301−-- are *not* recursive in the precense of the rewrite rules below.
302−-- This is not needed with GHC 7+.
303−append' :: Builder -> Builder -> Builder
304−append' (Builder f) (Builder g) = Builder (f . g)
305−{-# INLINE append' #-}
306−
307−{-# RULES
308−
309−"append/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)
310− (g::forall s. A.MArray s -> Int -> ST s Int) ws.
311− append (writeAtMost a f) (append (writeAtMost b g) ws) =
312− append (writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->
313− g marr (o+n) >>= \ m ->
314− let s = n+m in s `seq` return s)) ws
315−
316−"writeAtMost/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)
317− (g::forall s. A.MArray s -> Int -> ST s Int).
318− append (writeAtMost a f) (writeAtMost b g) =
319− writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->
320− g marr (o+n) >>= \ m ->
321− let s = n+m in s `seq` return s)
322−
323−"ensureFree/ensureFree" forall a b .
324− append (ensureFree a) (ensureFree b) = ensureFree (max a b)
325−
326−"flush/flush"
327− append flush flush = flush
328−
329− #-}
Data/Text/Internal/Builder/Functions.hsdeleted−40
@@ -1,40 +0,0 @@
1−{-# LANGUAGE MagicHash #-}
2−
3−-- |
4−-- Module : Data.Text.Internal.Builder.Functions
5−-- Copyright : (c) 2011 MailRank, Inc.
6−--
7−-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
9−-- Stability : experimental
10−-- Portability : GHC
11−--
12−-- /Warning/: this is an internal module, and does not have a stable
13−-- API or name. Functions in this module may not check or enforce
14−-- preconditions expected by public modules. Use at your own risk!
15−--
16−-- Useful functions and combinators.
17−
18−module Data.Text.Internal.Builder.Functions
19− (
20− (<>)
21− , i2d
22− ) where
23−
24−import Data.Monoid (mappend)
25−import Data.Text.Lazy.Builder (Builder)
26−import GHC.Base (chr#,ord#,(+#),Int(I#),Char(C#))
27−import Prelude ()
28−
29−-- | Unsafe conversion for decimal digits.
30−{-# INLINE i2d #-}
31−i2d :: Int -> Char
32−i2d (I# i#) = C# (chr# (ord# '0'# +# i#))
33−
34−-- | The normal 'mappend' function with right associativity instead of
35−-- left.
36−(<>) :: Builder -> Builder -> Builder
37−(<>) = mappend
38−{-# INLINE (<>) #-}
39−
40−infixr 4 <>
Data/Text/Internal/Builder/Int/Digits.hsdeleted−26
@@ -1,26 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−
3−-- Module: Data.Text.Internal.Builder.Int.Digits
4−-- Copyright: (c) 2013 Bryan O'Sullivan
5−-- License: BSD-style
6−-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
7−-- Stability: experimental
8−-- Portability: portable
9−--
10−-- /Warning/: this is an internal module, and does not have a stable
11−-- API or name. Functions in this module may not check or enforce
12−-- preconditions expected by public modules. Use at your own risk!
13−--
14−-- This module exists because the C preprocessor does things that we
15−-- shall not speak of when confronted with Haskell multiline strings.
16−
17−module Data.Text.Internal.Builder.Int.Digits (digits) where
18−
19−import Data.ByteString.Char8 (ByteString)
20−
21−digits :: ByteString
22−digits = "0001020304050607080910111213141516171819\
23− \2021222324252627282930313233343536373839\
24− \4041424344454647484950515253545556575859\
25− \6061626364656667686970717273747576777879\
26− \8081828384858687888990919293949596979899"
Data/Text/Internal/Builder/RealFloat/Functions.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/Encoding/Fusion/Common.hsdeleted−123
@@ -1,123 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−
3−-- |
4−-- Module : Data.Text.Internal.Encoding.Fusion.Common
5−-- Copyright : (c) Tom Harper 2008-2009,
6−-- (c) Bryan O'Sullivan 2009,
7−-- (c) Duncan Coutts 2009,
8−-- (c) Jasper Van der Jeugt 2011
9−--
10−-- License : BSD-style
11−-- Maintainer : bos@serpentine.com
12−-- Stability : experimental
13−-- Portability : portable
14−--
15−-- /Warning/: this is an internal module, and does not have a stable
16−-- API or name. Use at your own risk!
17−--
18−-- Fusible 'Stream'-oriented functions for converting between 'Text'
19−-- and several common encodings.
20−
21−module Data.Text.Internal.Encoding.Fusion.Common
22− (
23− -- * Restreaming
24− -- Restreaming is the act of converting from one 'Stream'
25− -- representation to another.
26− restreamUtf16LE
27− , restreamUtf16BE
28− , restreamUtf32LE
29− , restreamUtf32BE
30− ) where
31−
32−import 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)
37−import Data.Word (Word8)
38−
39−restreamUtf16BE :: Stream Char -> Stream Word8
40−restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
41− where
42− next (RS0 s) = case next0 s of
43− Done -> Done
44− Skip s' -> Skip (RS0 s')
45− Yield x s'
46− | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $
47− RS1 s' (fromIntegral n)
48− | otherwise -> Yield c1 $ RS3 s' c2 c3 c4
49− where
50− n = ord x
51− n1 = n - 0x10000
52− c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)
53− c2 = fromIntegral (n1 `shiftR` 10)
54− n2 = n1 .&. 0x3FF
55− c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)
56− c4 = fromIntegral n2
57− next (RS1 s x2) = Yield x2 (RS0 s)
58− next (RS2 s x2 x3) = Yield x2 (RS1 s x3)
59− next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)
60− {-# INLINE next #-}
61−{-# INLINE restreamUtf16BE #-}
62−
63−restreamUtf16LE :: Stream Char -> Stream Word8
64−restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
65− where
66− next (RS0 s) = case next0 s of
67− Done -> Done
68− Skip s' -> Skip (RS0 s')
69− Yield x s'
70− | n < 0x10000 -> Yield (fromIntegral n) $
71− RS1 s' (fromIntegral $ shiftR n 8)
72− | otherwise -> Yield c1 $ RS3 s' c2 c3 c4
73− where
74− n = ord x
75− n1 = n - 0x10000
76− c2 = fromIntegral (shiftR n1 18 + 0xD8)
77− c1 = fromIntegral (shiftR n1 10)
78− n2 = n1 .&. 0x3FF
79− c4 = fromIntegral (shiftR n2 8 + 0xDC)
80− c3 = fromIntegral n2
81− next (RS1 s x2) = Yield x2 (RS0 s)
82− next (RS2 s x2 x3) = Yield x2 (RS1 s x3)
83− next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)
84− {-# INLINE next #-}
85−{-# INLINE restreamUtf16LE #-}
86−
87−restreamUtf32BE :: Stream Char -> Stream Word8
88−restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
89− where
90− next (RS0 s) = case next0 s of
91− Done -> Done
92− Skip s' -> Skip (RS0 s')
93− Yield x s' -> Yield c1 (RS3 s' c2 c3 c4)
94− where
95− n = ord x
96− c1 = fromIntegral $ shiftR n 24
97− c2 = fromIntegral $ shiftR n 16
98− c3 = fromIntegral $ shiftR n 8
99− c4 = fromIntegral n
100− next (RS1 s x2) = Yield x2 (RS0 s)
101− next (RS2 s x2 x3) = Yield x2 (RS1 s x3)
102− next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)
103− {-# INLINE next #-}
104−{-# INLINE restreamUtf32BE #-}
105−
106−restreamUtf32LE :: Stream Char -> Stream Word8
107−restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
108− where
109− next (RS0 s) = case next0 s of
110− Done -> Done
111− Skip s' -> Skip (RS0 s')
112− Yield x s' -> Yield c1 (RS3 s' c2 c3 c4)
113− where
114− n = ord x
115− c4 = fromIntegral $ shiftR n 24
116− c3 = fromIntegral $ shiftR n 16
117− c2 = fromIntegral $ shiftR n 8
118− c1 = fromIntegral n
119− next (RS1 s x2) = Yield x2 (RS0 s)
120− next (RS2 s x2 x3) = Yield x2 (RS1 s x3)
121− next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)
122− {-# INLINE next #-}
123−{-# INLINE restreamUtf32LE #-}
Data/Text/Internal/Encoding/Utf16.hsdeleted−45
@@ -1,45 +0,0 @@
1−{-# LANGUAGE MagicHash, BangPatterns #-}
2−
3−-- |
4−-- Module : Data.Text.Internal.Encoding.Utf16
5−-- Copyright : (c) 2008, 2009 Tom Harper,
6−-- (c) 2009 Bryan O'Sullivan,
7−-- (c) 2009 Duncan Coutts
8−--
9−-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
11−-- Stability : experimental
12−-- Portability : GHC
13−--
14−-- /Warning/: this is an internal module, and does not have a stable
15−-- API or name. Functions in this module may not check or enforce
16−-- preconditions expected by public modules. Use at your own risk!
17−--
18−-- Basic UTF-16 validation and character manipulation.
19−module Data.Text.Internal.Encoding.Utf16
20− (
21− chr2
22− , validate1
23− , validate2
24− ) where
25−
26−import GHC.Exts
27−import GHC.Word (Word16(..))
28−
29−chr2 :: Word16 -> Word16 -> Char
30−chr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#))
31− where
32− !x# = word2Int# a#
33− !y# = word2Int# b#
34− !upper# = uncheckedIShiftL# (x# -# 0xD800#) 10#
35− !lower# = y# -# 0xDC00#
36−{-# INLINE chr2 #-}
37−
38−validate1 :: Word16 -> Bool
39−validate1 x1 = x1 < 0xD800 || x1 > 0xDFFF
40−{-# INLINE validate1 #-}
41−
42−validate2 :: Word16 -> Word16 -> Bool
43−validate2 x1 x2 = x1 >= 0xD800 && x1 <= 0xDBFF &&
44− x2 >= 0xDC00 && x2 <= 0xDFFF
45−{-# INLINE validate2 #-}
Data/Text/Internal/Encoding/Utf32.hsdeleted−26
@@ -1,26 +0,0 @@
1−-- |
2−-- Module : Data.Text.Internal.Encoding.Utf32
3−-- Copyright : (c) 2008, 2009 Tom Harper,
4−-- (c) 2009, 2010 Bryan O'Sullivan,
5−-- (c) 2009 Duncan Coutts
6−--
7−-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
9−-- Stability : experimental
10−-- Portability : portable
11−--
12−-- /Warning/: this is an internal module, and does not have a stable
13−-- API or name. Functions in this module may not check or enforce
14−-- preconditions expected by public modules. Use at your own risk!
15−--
16−-- Basic UTF-32 validation.
17−module Data.Text.Internal.Encoding.Utf32
18− (
19− validate
20− ) where
21−
22−import Data.Word (Word32)
23−
24−validate :: Word32 -> Bool
25−validate x1 = x1 < 0xD800 || (x1 > 0xDFFF && x1 <= 0x10FFFF)
26−{-# INLINE validate #-}
Data/Text/Internal/Functions.hsdeleted−31
@@ -1,31 +0,0 @@
1−{-# LANGUAGE CPP, DeriveDataTypeable #-}
2−
3−-- |
4−-- Module : Data.Text.Internal.Functions
5−-- Copyright : 2010 Bryan O'Sullivan
6−--
7−-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
9−-- Stability : experimental
10−-- Portability : GHC
11−--
12−-- /Warning/: this is an internal module, and does not have a stable
13−-- API or name. Functions in this module may not check or enforce
14−-- preconditions expected by public modules. Use at your own risk!
15−--
16−-- Useful functions.
17−
18−module Data.Text.Internal.Functions
19− (
20− intersperse
21− ) where
22−
23−-- | A lazier version of Data.List.intersperse. The other version
24−-- causes space leaks!
25−intersperse :: a -> [a] -> [a]
26−intersperse _ [] = []
27−intersperse sep (x:xs) = x : go xs
28− where
29− go [] = []
30− go (y:ys) = sep : y: go ys
31−{-# INLINE intersperse #-}
Data/Text/Internal/Fusion/CaseMapping.hsdeleted−842
@@ -1,842 +0,0 @@
1−{-# LANGUAGE Rank2Types #-}
2−-- 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]
8−
9−module Data.Text.Internal.Fusion.CaseMapping where
10−import Data.Char
11−import Data.Text.Internal.Fusion.Types
12−
13−upperMapping :: forall s. Char -> s -> Step (CC s) Char
14−{-# NOINLINE upperMapping #-}
15−-- LATIN SMALL LETTER SHARP S
16−upperMapping '\x00df' s = Yield '\x0053' (CC s '\x0053' '\x0000')
17−-- LATIN SMALL LIGATURE FF
18−upperMapping '\xfb00' s = Yield '\x0046' (CC s '\x0046' '\x0000')
19−-- LATIN SMALL LIGATURE FI
20−upperMapping '\xfb01' s = Yield '\x0046' (CC s '\x0049' '\x0000')
21−-- LATIN SMALL LIGATURE FL
22−upperMapping '\xfb02' s = Yield '\x0046' (CC s '\x004c' '\x0000')
23−-- LATIN SMALL LIGATURE FFI
24−upperMapping '\xfb03' s = Yield '\x0046' (CC s '\x0046' '\x0049')
25−-- LATIN SMALL LIGATURE FFL
26−upperMapping '\xfb04' s = Yield '\x0046' (CC s '\x0046' '\x004c')
27−-- LATIN SMALL LIGATURE LONG S T
28−upperMapping '\xfb05' s = Yield '\x0053' (CC s '\x0054' '\x0000')
29−-- LATIN SMALL LIGATURE ST
30−upperMapping '\xfb06' s = Yield '\x0053' (CC s '\x0054' '\x0000')
31−-- ARMENIAN SMALL LIGATURE ECH YIWN
32−upperMapping '\x0587' s = Yield '\x0535' (CC s '\x0552' '\x0000')
33−-- ARMENIAN SMALL LIGATURE MEN NOW
34−upperMapping '\xfb13' s = Yield '\x0544' (CC s '\x0546' '\x0000')
35−-- ARMENIAN SMALL LIGATURE MEN ECH
36−upperMapping '\xfb14' s = Yield '\x0544' (CC s '\x0535' '\x0000')
37−-- ARMENIAN SMALL LIGATURE MEN INI
38−upperMapping '\xfb15' s = Yield '\x0544' (CC s '\x053b' '\x0000')
39−-- ARMENIAN SMALL LIGATURE VEW NOW
40−upperMapping '\xfb16' s = Yield '\x054e' (CC s '\x0546' '\x0000')
41−-- ARMENIAN SMALL LIGATURE MEN XEH
42−upperMapping '\xfb17' s = Yield '\x0544' (CC s '\x053d' '\x0000')
43−-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE
44−upperMapping '\x0149' s = Yield '\x02bc' (CC s '\x004e' '\x0000')
45−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
46−upperMapping '\x0390' s = Yield '\x0399' (CC s '\x0308' '\x0301')
47−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
48−upperMapping '\x03b0' s = Yield '\x03a5' (CC s '\x0308' '\x0301')
49−-- LATIN SMALL LETTER J WITH CARON
50−upperMapping '\x01f0' s = Yield '\x004a' (CC s '\x030c' '\x0000')
51−-- LATIN SMALL LETTER H WITH LINE BELOW
52−upperMapping '\x1e96' s = Yield '\x0048' (CC s '\x0331' '\x0000')
53−-- LATIN SMALL LETTER T WITH DIAERESIS
54−upperMapping '\x1e97' s = Yield '\x0054' (CC s '\x0308' '\x0000')
55−-- LATIN SMALL LETTER W WITH RING ABOVE
56−upperMapping '\x1e98' s = Yield '\x0057' (CC s '\x030a' '\x0000')
57−-- LATIN SMALL LETTER Y WITH RING ABOVE
58−upperMapping '\x1e99' s = Yield '\x0059' (CC s '\x030a' '\x0000')
59−-- LATIN SMALL LETTER A WITH RIGHT HALF RING
60−upperMapping '\x1e9a' s = Yield '\x0041' (CC s '\x02be' '\x0000')
61−-- GREEK SMALL LETTER UPSILON WITH PSILI
62−upperMapping '\x1f50' s = Yield '\x03a5' (CC s '\x0313' '\x0000')
63−-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA
64−upperMapping '\x1f52' s = Yield '\x03a5' (CC s '\x0313' '\x0300')
65−-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA
66−upperMapping '\x1f54' s = Yield '\x03a5' (CC s '\x0313' '\x0301')
67−-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI
68−upperMapping '\x1f56' s = Yield '\x03a5' (CC s '\x0313' '\x0342')
69−-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI
70−upperMapping '\x1fb6' s = Yield '\x0391' (CC s '\x0342' '\x0000')
71−-- GREEK SMALL LETTER ETA WITH PERISPOMENI
72−upperMapping '\x1fc6' s = Yield '\x0397' (CC s '\x0342' '\x0000')
73−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA
74−upperMapping '\x1fd2' s = Yield '\x0399' (CC s '\x0308' '\x0300')
75−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA
76−upperMapping '\x1fd3' s = Yield '\x0399' (CC s '\x0308' '\x0301')
77−-- GREEK SMALL LETTER IOTA WITH PERISPOMENI
78−upperMapping '\x1fd6' s = Yield '\x0399' (CC s '\x0342' '\x0000')
79−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI
80−upperMapping '\x1fd7' s = Yield '\x0399' (CC s '\x0308' '\x0342')
81−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA
82−upperMapping '\x1fe2' s = Yield '\x03a5' (CC s '\x0308' '\x0300')
83−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA
84−upperMapping '\x1fe3' s = Yield '\x03a5' (CC s '\x0308' '\x0301')
85−-- GREEK SMALL LETTER RHO WITH PSILI
86−upperMapping '\x1fe4' s = Yield '\x03a1' (CC s '\x0313' '\x0000')
87−-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI
88−upperMapping '\x1fe6' s = Yield '\x03a5' (CC s '\x0342' '\x0000')
89−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI
90−upperMapping '\x1fe7' s = Yield '\x03a5' (CC s '\x0308' '\x0342')
91−-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI
92−upperMapping '\x1ff6' s = Yield '\x03a9' (CC s '\x0342' '\x0000')
93−-- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI
94−upperMapping '\x1f80' s = Yield '\x1f08' (CC s '\x0399' '\x0000')
95−-- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI
96−upperMapping '\x1f81' s = Yield '\x1f09' (CC s '\x0399' '\x0000')
97−-- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI
98−upperMapping '\x1f82' s = Yield '\x1f0a' (CC s '\x0399' '\x0000')
99−-- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI
100−upperMapping '\x1f83' s = Yield '\x1f0b' (CC s '\x0399' '\x0000')
101−-- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI
102−upperMapping '\x1f84' s = Yield '\x1f0c' (CC s '\x0399' '\x0000')
103−-- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI
104−upperMapping '\x1f85' s = Yield '\x1f0d' (CC s '\x0399' '\x0000')
105−-- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI
106−upperMapping '\x1f86' s = Yield '\x1f0e' (CC s '\x0399' '\x0000')
107−-- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
108−upperMapping '\x1f87' s = Yield '\x1f0f' (CC s '\x0399' '\x0000')
109−-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI
110−upperMapping '\x1f88' s = Yield '\x1f08' (CC s '\x0399' '\x0000')
111−-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI
112−upperMapping '\x1f89' s = Yield '\x1f09' (CC s '\x0399' '\x0000')
113−-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI
114−upperMapping '\x1f8a' s = Yield '\x1f0a' (CC s '\x0399' '\x0000')
115−-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI
116−upperMapping '\x1f8b' s = Yield '\x1f0b' (CC s '\x0399' '\x0000')
117−-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI
118−upperMapping '\x1f8c' s = Yield '\x1f0c' (CC s '\x0399' '\x0000')
119−-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI
120−upperMapping '\x1f8d' s = Yield '\x1f0d' (CC s '\x0399' '\x0000')
121−-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI
122−upperMapping '\x1f8e' s = Yield '\x1f0e' (CC s '\x0399' '\x0000')
123−-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
124−upperMapping '\x1f8f' s = Yield '\x1f0f' (CC s '\x0399' '\x0000')
125−-- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI
126−upperMapping '\x1f90' s = Yield '\x1f28' (CC s '\x0399' '\x0000')
127−-- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI
128−upperMapping '\x1f91' s = Yield '\x1f29' (CC s '\x0399' '\x0000')
129−-- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI
130−upperMapping '\x1f92' s = Yield '\x1f2a' (CC s '\x0399' '\x0000')
131−-- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI
132−upperMapping '\x1f93' s = Yield '\x1f2b' (CC s '\x0399' '\x0000')
133−-- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI
134−upperMapping '\x1f94' s = Yield '\x1f2c' (CC s '\x0399' '\x0000')
135−-- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI
136−upperMapping '\x1f95' s = Yield '\x1f2d' (CC s '\x0399' '\x0000')
137−-- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI
138−upperMapping '\x1f96' s = Yield '\x1f2e' (CC s '\x0399' '\x0000')
139−-- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
140−upperMapping '\x1f97' s = Yield '\x1f2f' (CC s '\x0399' '\x0000')
141−-- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI
142−upperMapping '\x1f98' s = Yield '\x1f28' (CC s '\x0399' '\x0000')
143−-- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI
144−upperMapping '\x1f99' s = Yield '\x1f29' (CC s '\x0399' '\x0000')
145−-- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI
146−upperMapping '\x1f9a' s = Yield '\x1f2a' (CC s '\x0399' '\x0000')
147−-- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI
148−upperMapping '\x1f9b' s = Yield '\x1f2b' (CC s '\x0399' '\x0000')
149−-- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI
150−upperMapping '\x1f9c' s = Yield '\x1f2c' (CC s '\x0399' '\x0000')
151−-- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI
152−upperMapping '\x1f9d' s = Yield '\x1f2d' (CC s '\x0399' '\x0000')
153−-- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI
154−upperMapping '\x1f9e' s = Yield '\x1f2e' (CC s '\x0399' '\x0000')
155−-- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
156−upperMapping '\x1f9f' s = Yield '\x1f2f' (CC s '\x0399' '\x0000')
157−-- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI
158−upperMapping '\x1fa0' s = Yield '\x1f68' (CC s '\x0399' '\x0000')
159−-- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI
160−upperMapping '\x1fa1' s = Yield '\x1f69' (CC s '\x0399' '\x0000')
161−-- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI
162−upperMapping '\x1fa2' s = Yield '\x1f6a' (CC s '\x0399' '\x0000')
163−-- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI
164−upperMapping '\x1fa3' s = Yield '\x1f6b' (CC s '\x0399' '\x0000')
165−-- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI
166−upperMapping '\x1fa4' s = Yield '\x1f6c' (CC s '\x0399' '\x0000')
167−-- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI
168−upperMapping '\x1fa5' s = Yield '\x1f6d' (CC s '\x0399' '\x0000')
169−-- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI
170−upperMapping '\x1fa6' s = Yield '\x1f6e' (CC s '\x0399' '\x0000')
171−-- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
172−upperMapping '\x1fa7' s = Yield '\x1f6f' (CC s '\x0399' '\x0000')
173−-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI
174−upperMapping '\x1fa8' s = Yield '\x1f68' (CC s '\x0399' '\x0000')
175−-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI
176−upperMapping '\x1fa9' s = Yield '\x1f69' (CC s '\x0399' '\x0000')
177−-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI
178−upperMapping '\x1faa' s = Yield '\x1f6a' (CC s '\x0399' '\x0000')
179−-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI
180−upperMapping '\x1fab' s = Yield '\x1f6b' (CC s '\x0399' '\x0000')
181−-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI
182−upperMapping '\x1fac' s = Yield '\x1f6c' (CC s '\x0399' '\x0000')
183−-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI
184−upperMapping '\x1fad' s = Yield '\x1f6d' (CC s '\x0399' '\x0000')
185−-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI
186−upperMapping '\x1fae' s = Yield '\x1f6e' (CC s '\x0399' '\x0000')
187−-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
188−upperMapping '\x1faf' s = Yield '\x1f6f' (CC s '\x0399' '\x0000')
189−-- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI
190−upperMapping '\x1fb3' s = Yield '\x0391' (CC s '\x0399' '\x0000')
191−-- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI
192−upperMapping '\x1fbc' s = Yield '\x0391' (CC s '\x0399' '\x0000')
193−-- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI
194−upperMapping '\x1fc3' s = Yield '\x0397' (CC s '\x0399' '\x0000')
195−-- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI
196−upperMapping '\x1fcc' s = Yield '\x0397' (CC s '\x0399' '\x0000')
197−-- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI
198−upperMapping '\x1ff3' s = Yield '\x03a9' (CC s '\x0399' '\x0000')
199−-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
200−upperMapping '\x1ffc' s = Yield '\x03a9' (CC s '\x0399' '\x0000')
201−-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI
202−upperMapping '\x1fb2' s = Yield '\x1fba' (CC s '\x0399' '\x0000')
203−-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI
204−upperMapping '\x1fb4' s = Yield '\x0386' (CC s '\x0399' '\x0000')
205−-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI
206−upperMapping '\x1fc2' s = Yield '\x1fca' (CC s '\x0399' '\x0000')
207−-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI
208−upperMapping '\x1fc4' s = Yield '\x0389' (CC s '\x0399' '\x0000')
209−-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI
210−upperMapping '\x1ff2' s = Yield '\x1ffa' (CC s '\x0399' '\x0000')
211−-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI
212−upperMapping '\x1ff4' s = Yield '\x038f' (CC s '\x0399' '\x0000')
213−-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI
214−upperMapping '\x1fb7' s = Yield '\x0391' (CC s '\x0342' '\x0399')
215−-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI
216−upperMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0399')
217−-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI
218−upperMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0399')
219−upperMapping c s = Yield (toUpper c) (CC s '\0' '\0')
220−lowerMapping :: forall s. Char -> s -> Step (CC s) Char
221−{-# NOINLINE lowerMapping #-}
222−-- LATIN CAPITAL LETTER I WITH DOT ABOVE
223−lowerMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')
224−lowerMapping c s = Yield (toLower c) (CC s '\0' '\0')
225−titleMapping :: forall s. Char -> s -> Step (CC s) Char
226−{-# NOINLINE titleMapping #-}
227−-- LATIN SMALL LETTER SHARP S
228−titleMapping '\x00df' s = Yield '\x0053' (CC s '\x0073' '\x0000')
229−-- LATIN SMALL LIGATURE FF
230−titleMapping '\xfb00' s = Yield '\x0046' (CC s '\x0066' '\x0000')
231−-- LATIN SMALL LIGATURE FI
232−titleMapping '\xfb01' s = Yield '\x0046' (CC s '\x0069' '\x0000')
233−-- LATIN SMALL LIGATURE FL
234−titleMapping '\xfb02' s = Yield '\x0046' (CC s '\x006c' '\x0000')
235−-- LATIN SMALL LIGATURE FFI
236−titleMapping '\xfb03' s = Yield '\x0046' (CC s '\x0066' '\x0069')
237−-- LATIN SMALL LIGATURE FFL
238−titleMapping '\xfb04' s = Yield '\x0046' (CC s '\x0066' '\x006c')
239−-- LATIN SMALL LIGATURE LONG S T
240−titleMapping '\xfb05' s = Yield '\x0053' (CC s '\x0074' '\x0000')
241−-- LATIN SMALL LIGATURE ST
242−titleMapping '\xfb06' s = Yield '\x0053' (CC s '\x0074' '\x0000')
243−-- ARMENIAN SMALL LIGATURE ECH YIWN
244−titleMapping '\x0587' s = Yield '\x0535' (CC s '\x0582' '\x0000')
245−-- ARMENIAN SMALL LIGATURE MEN NOW
246−titleMapping '\xfb13' s = Yield '\x0544' (CC s '\x0576' '\x0000')
247−-- ARMENIAN SMALL LIGATURE MEN ECH
248−titleMapping '\xfb14' s = Yield '\x0544' (CC s '\x0565' '\x0000')
249−-- ARMENIAN SMALL LIGATURE MEN INI
250−titleMapping '\xfb15' s = Yield '\x0544' (CC s '\x056b' '\x0000')
251−-- ARMENIAN SMALL LIGATURE VEW NOW
252−titleMapping '\xfb16' s = Yield '\x054e' (CC s '\x0576' '\x0000')
253−-- ARMENIAN SMALL LIGATURE MEN XEH
254−titleMapping '\xfb17' s = Yield '\x0544' (CC s '\x056d' '\x0000')
255−-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE
256−titleMapping '\x0149' s = Yield '\x02bc' (CC s '\x004e' '\x0000')
257−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
258−titleMapping '\x0390' s = Yield '\x0399' (CC s '\x0308' '\x0301')
259−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
260−titleMapping '\x03b0' s = Yield '\x03a5' (CC s '\x0308' '\x0301')
261−-- LATIN SMALL LETTER J WITH CARON
262−titleMapping '\x01f0' s = Yield '\x004a' (CC s '\x030c' '\x0000')
263−-- LATIN SMALL LETTER H WITH LINE BELOW
264−titleMapping '\x1e96' s = Yield '\x0048' (CC s '\x0331' '\x0000')
265−-- LATIN SMALL LETTER T WITH DIAERESIS
266−titleMapping '\x1e97' s = Yield '\x0054' (CC s '\x0308' '\x0000')
267−-- LATIN SMALL LETTER W WITH RING ABOVE
268−titleMapping '\x1e98' s = Yield '\x0057' (CC s '\x030a' '\x0000')
269−-- LATIN SMALL LETTER Y WITH RING ABOVE
270−titleMapping '\x1e99' s = Yield '\x0059' (CC s '\x030a' '\x0000')
271−-- LATIN SMALL LETTER A WITH RIGHT HALF RING
272−titleMapping '\x1e9a' s = Yield '\x0041' (CC s '\x02be' '\x0000')
273−-- GREEK SMALL LETTER UPSILON WITH PSILI
274−titleMapping '\x1f50' s = Yield '\x03a5' (CC s '\x0313' '\x0000')
275−-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA
276−titleMapping '\x1f52' s = Yield '\x03a5' (CC s '\x0313' '\x0300')
277−-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA
278−titleMapping '\x1f54' s = Yield '\x03a5' (CC s '\x0313' '\x0301')
279−-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI
280−titleMapping '\x1f56' s = Yield '\x03a5' (CC s '\x0313' '\x0342')
281−-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI
282−titleMapping '\x1fb6' s = Yield '\x0391' (CC s '\x0342' '\x0000')
283−-- GREEK SMALL LETTER ETA WITH PERISPOMENI
284−titleMapping '\x1fc6' s = Yield '\x0397' (CC s '\x0342' '\x0000')
285−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA
286−titleMapping '\x1fd2' s = Yield '\x0399' (CC s '\x0308' '\x0300')
287−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA
288−titleMapping '\x1fd3' s = Yield '\x0399' (CC s '\x0308' '\x0301')
289−-- GREEK SMALL LETTER IOTA WITH PERISPOMENI
290−titleMapping '\x1fd6' s = Yield '\x0399' (CC s '\x0342' '\x0000')
291−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI
292−titleMapping '\x1fd7' s = Yield '\x0399' (CC s '\x0308' '\x0342')
293−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA
294−titleMapping '\x1fe2' s = Yield '\x03a5' (CC s '\x0308' '\x0300')
295−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA
296−titleMapping '\x1fe3' s = Yield '\x03a5' (CC s '\x0308' '\x0301')
297−-- GREEK SMALL LETTER RHO WITH PSILI
298−titleMapping '\x1fe4' s = Yield '\x03a1' (CC s '\x0313' '\x0000')
299−-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI
300−titleMapping '\x1fe6' s = Yield '\x03a5' (CC s '\x0342' '\x0000')
301−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI
302−titleMapping '\x1fe7' s = Yield '\x03a5' (CC s '\x0308' '\x0342')
303−-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI
304−titleMapping '\x1ff6' s = Yield '\x03a9' (CC s '\x0342' '\x0000')
305−-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI
306−titleMapping '\x1fb2' s = Yield '\x1fba' (CC s '\x0345' '\x0000')
307−-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI
308−titleMapping '\x1fb4' s = Yield '\x0386' (CC s '\x0345' '\x0000')
309−-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI
310−titleMapping '\x1fc2' s = Yield '\x1fca' (CC s '\x0345' '\x0000')
311−-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI
312−titleMapping '\x1fc4' s = Yield '\x0389' (CC s '\x0345' '\x0000')
313−-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI
314−titleMapping '\x1ff2' s = Yield '\x1ffa' (CC s '\x0345' '\x0000')
315−-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI
316−titleMapping '\x1ff4' s = Yield '\x038f' (CC s '\x0345' '\x0000')
317−-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI
318−titleMapping '\x1fb7' s = Yield '\x0391' (CC s '\x0342' '\x0345')
319−-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI
320−titleMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0345')
321−-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI
322−titleMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0345')
323−titleMapping c s = Yield (toTitle c) (CC s '\0' '\0')
324−foldMapping :: forall s. Char -> s -> Step (CC s) Char
325−{-# NOINLINE foldMapping #-}
326−-- MICRO SIGN
327−foldMapping '\x00b5' s = Yield '\x03bc' (CC s '\x0000' '\x0000')
328−-- LATIN SMALL LETTER SHARP S
329−foldMapping '\x00df' s = Yield '\x0073' (CC s '\x0073' '\x0000')
330−-- LATIN CAPITAL LETTER I WITH DOT ABOVE
331−foldMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')
332−-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE
333−foldMapping '\x0149' s = Yield '\x02bc' (CC s '\x006e' '\x0000')
334−-- LATIN SMALL LETTER LONG S
335−foldMapping '\x017f' s = Yield '\x0073' (CC s '\x0000' '\x0000')
336−-- LATIN SMALL LETTER J WITH CARON
337−foldMapping '\x01f0' s = Yield '\x006a' (CC s '\x030c' '\x0000')
338−-- COMBINING GREEK YPOGEGRAMMENI
339−foldMapping '\x0345' s = Yield '\x03b9' (CC s '\x0000' '\x0000')
340−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
341−foldMapping '\x0390' s = Yield '\x03b9' (CC s '\x0308' '\x0301')
342−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
343−foldMapping '\x03b0' s = Yield '\x03c5' (CC s '\x0308' '\x0301')
344−-- GREEK SMALL LETTER FINAL SIGMA
345−foldMapping '\x03c2' s = Yield '\x03c3' (CC s '\x0000' '\x0000')
346−-- GREEK BETA SYMBOL
347−foldMapping '\x03d0' s = Yield '\x03b2' (CC s '\x0000' '\x0000')
348−-- GREEK THETA SYMBOL
349−foldMapping '\x03d1' s = Yield '\x03b8' (CC s '\x0000' '\x0000')
350−-- GREEK PHI SYMBOL
351−foldMapping '\x03d5' s = Yield '\x03c6' (CC s '\x0000' '\x0000')
352−-- GREEK PI SYMBOL
353−foldMapping '\x03d6' s = Yield '\x03c0' (CC s '\x0000' '\x0000')
354−-- GREEK KAPPA SYMBOL
355−foldMapping '\x03f0' s = Yield '\x03ba' (CC s '\x0000' '\x0000')
356−-- GREEK RHO SYMBOL
357−foldMapping '\x03f1' s = Yield '\x03c1' (CC s '\x0000' '\x0000')
358−-- GREEK LUNATE EPSILON SYMBOL
359−foldMapping '\x03f5' s = Yield '\x03b5' (CC s '\x0000' '\x0000')
360−-- ARMENIAN SMALL LIGATURE ECH YIWN
361−foldMapping '\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')
374−-- LATIN SMALL LETTER H WITH LINE BELOW
375−foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')
376−-- LATIN SMALL LETTER T WITH DIAERESIS
377−foldMapping '\x1e97' s = Yield '\x0074' (CC s '\x0308' '\x0000')
378−-- LATIN SMALL LETTER W WITH RING ABOVE
379−foldMapping '\x1e98' s = Yield '\x0077' (CC s '\x030a' '\x0000')
380−-- LATIN SMALL LETTER Y WITH RING ABOVE
381−foldMapping '\x1e99' s = Yield '\x0079' (CC s '\x030a' '\x0000')
382−-- LATIN SMALL LETTER A WITH RIGHT HALF RING
383−foldMapping '\x1e9a' s = Yield '\x0061' (CC s '\x02be' '\x0000')
384−-- LATIN SMALL LETTER LONG S WITH DOT ABOVE
385−foldMapping '\x1e9b' s = Yield '\x1e61' (CC s '\x0000' '\x0000')
386−-- LATIN CAPITAL LETTER SHARP S
387−foldMapping '\x1e9e' s = Yield '\x0073' (CC s '\x0073' '\x0000')
388−-- GREEK SMALL LETTER UPSILON WITH PSILI
389−foldMapping '\x1f50' s = Yield '\x03c5' (CC s '\x0313' '\x0000')
390−-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA
391−foldMapping '\x1f52' s = Yield '\x03c5' (CC s '\x0313' '\x0300')
392−-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA
393−foldMapping '\x1f54' s = Yield '\x03c5' (CC s '\x0313' '\x0301')
394−-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI
395−foldMapping '\x1f56' s = Yield '\x03c5' (CC s '\x0313' '\x0342')
396−-- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI
397−foldMapping '\x1f80' s = Yield '\x1f00' (CC s '\x03b9' '\x0000')
398−-- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI
399−foldMapping '\x1f81' s = Yield '\x1f01' (CC s '\x03b9' '\x0000')
400−-- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI
401−foldMapping '\x1f82' s = Yield '\x1f02' (CC s '\x03b9' '\x0000')
402−-- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI
403−foldMapping '\x1f83' s = Yield '\x1f03' (CC s '\x03b9' '\x0000')
404−-- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI
405−foldMapping '\x1f84' s = Yield '\x1f04' (CC s '\x03b9' '\x0000')
406−-- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI
407−foldMapping '\x1f85' s = Yield '\x1f05' (CC s '\x03b9' '\x0000')
408−-- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI
409−foldMapping '\x1f86' s = Yield '\x1f06' (CC s '\x03b9' '\x0000')
410−-- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
411−foldMapping '\x1f87' s = Yield '\x1f07' (CC s '\x03b9' '\x0000')
412−-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI
413−foldMapping '\x1f88' s = Yield '\x1f00' (CC s '\x03b9' '\x0000')
414−-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI
415−foldMapping '\x1f89' s = Yield '\x1f01' (CC s '\x03b9' '\x0000')
416−-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI
417−foldMapping '\x1f8a' s = Yield '\x1f02' (CC s '\x03b9' '\x0000')
418−-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI
419−foldMapping '\x1f8b' s = Yield '\x1f03' (CC s '\x03b9' '\x0000')
420−-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI
421−foldMapping '\x1f8c' s = Yield '\x1f04' (CC s '\x03b9' '\x0000')
422−-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI
423−foldMapping '\x1f8d' s = Yield '\x1f05' (CC s '\x03b9' '\x0000')
424−-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI
425−foldMapping '\x1f8e' s = Yield '\x1f06' (CC s '\x03b9' '\x0000')
426−-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
427−foldMapping '\x1f8f' s = Yield '\x1f07' (CC s '\x03b9' '\x0000')
428−-- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI
429−foldMapping '\x1f90' s = Yield '\x1f20' (CC s '\x03b9' '\x0000')
430−-- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI
431−foldMapping '\x1f91' s = Yield '\x1f21' (CC s '\x03b9' '\x0000')
432−-- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI
433−foldMapping '\x1f92' s = Yield '\x1f22' (CC s '\x03b9' '\x0000')
434−-- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI
435−foldMapping '\x1f93' s = Yield '\x1f23' (CC s '\x03b9' '\x0000')
436−-- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI
437−foldMapping '\x1f94' s = Yield '\x1f24' (CC s '\x03b9' '\x0000')
438−-- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI
439−foldMapping '\x1f95' s = Yield '\x1f25' (CC s '\x03b9' '\x0000')
440−-- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI
441−foldMapping '\x1f96' s = Yield '\x1f26' (CC s '\x03b9' '\x0000')
442−-- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
443−foldMapping '\x1f97' s = Yield '\x1f27' (CC s '\x03b9' '\x0000')
444−-- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI
445−foldMapping '\x1f98' s = Yield '\x1f20' (CC s '\x03b9' '\x0000')
446−-- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI
447−foldMapping '\x1f99' s = Yield '\x1f21' (CC s '\x03b9' '\x0000')
448−-- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI
449−foldMapping '\x1f9a' s = Yield '\x1f22' (CC s '\x03b9' '\x0000')
450−-- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI
451−foldMapping '\x1f9b' s = Yield '\x1f23' (CC s '\x03b9' '\x0000')
452−-- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI
453−foldMapping '\x1f9c' s = Yield '\x1f24' (CC s '\x03b9' '\x0000')
454−-- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI
455−foldMapping '\x1f9d' s = Yield '\x1f25' (CC s '\x03b9' '\x0000')
456−-- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI
457−foldMapping '\x1f9e' s = Yield '\x1f26' (CC s '\x03b9' '\x0000')
458−-- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
459−foldMapping '\x1f9f' s = Yield '\x1f27' (CC s '\x03b9' '\x0000')
460−-- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI
461−foldMapping '\x1fa0' s = Yield '\x1f60' (CC s '\x03b9' '\x0000')
462−-- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI
463−foldMapping '\x1fa1' s = Yield '\x1f61' (CC s '\x03b9' '\x0000')
464−-- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI
465−foldMapping '\x1fa2' s = Yield '\x1f62' (CC s '\x03b9' '\x0000')
466−-- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI
467−foldMapping '\x1fa3' s = Yield '\x1f63' (CC s '\x03b9' '\x0000')
468−-- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI
469−foldMapping '\x1fa4' s = Yield '\x1f64' (CC s '\x03b9' '\x0000')
470−-- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI
471−foldMapping '\x1fa5' s = Yield '\x1f65' (CC s '\x03b9' '\x0000')
472−-- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI
473−foldMapping '\x1fa6' s = Yield '\x1f66' (CC s '\x03b9' '\x0000')
474−-- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
475−foldMapping '\x1fa7' s = Yield '\x1f67' (CC s '\x03b9' '\x0000')
476−-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI
477−foldMapping '\x1fa8' s = Yield '\x1f60' (CC s '\x03b9' '\x0000')
478−-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI
479−foldMapping '\x1fa9' s = Yield '\x1f61' (CC s '\x03b9' '\x0000')
480−-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI
481−foldMapping '\x1faa' s = Yield '\x1f62' (CC s '\x03b9' '\x0000')
482−-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI
483−foldMapping '\x1fab' s = Yield '\x1f63' (CC s '\x03b9' '\x0000')
484−-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI
485−foldMapping '\x1fac' s = Yield '\x1f64' (CC s '\x03b9' '\x0000')
486−-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI
487−foldMapping '\x1fad' s = Yield '\x1f65' (CC s '\x03b9' '\x0000')
488−-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI
489−foldMapping '\x1fae' s = Yield '\x1f66' (CC s '\x03b9' '\x0000')
490−-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
491−foldMapping '\x1faf' s = Yield '\x1f67' (CC s '\x03b9' '\x0000')
492−-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI
493−foldMapping '\x1fb2' s = Yield '\x1f70' (CC s '\x03b9' '\x0000')
494−-- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI
495−foldMapping '\x1fb3' s = Yield '\x03b1' (CC s '\x03b9' '\x0000')
496−-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI
497−foldMapping '\x1fb4' s = Yield '\x03ac' (CC s '\x03b9' '\x0000')
498−-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI
499−foldMapping '\x1fb6' s = Yield '\x03b1' (CC s '\x0342' '\x0000')
500−-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI
501−foldMapping '\x1fb7' s = Yield '\x03b1' (CC s '\x0342' '\x03b9')
502−-- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI
503−foldMapping '\x1fbc' s = Yield '\x03b1' (CC s '\x03b9' '\x0000')
504−-- GREEK PROSGEGRAMMENI
505−foldMapping '\x1fbe' s = Yield '\x03b9' (CC s '\x0000' '\x0000')
506−-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI
507−foldMapping '\x1fc2' s = Yield '\x1f74' (CC s '\x03b9' '\x0000')
508−-- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI
509−foldMapping '\x1fc3' s = Yield '\x03b7' (CC s '\x03b9' '\x0000')
510−-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI
511−foldMapping '\x1fc4' s = Yield '\x03ae' (CC s '\x03b9' '\x0000')
512−-- GREEK SMALL LETTER ETA WITH PERISPOMENI
513−foldMapping '\x1fc6' s = Yield '\x03b7' (CC s '\x0342' '\x0000')
514−-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI
515−foldMapping '\x1fc7' s = Yield '\x03b7' (CC s '\x0342' '\x03b9')
516−-- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI
517−foldMapping '\x1fcc' s = Yield '\x03b7' (CC s '\x03b9' '\x0000')
518−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA
519−foldMapping '\x1fd2' s = Yield '\x03b9' (CC s '\x0308' '\x0300')
520−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA
521−foldMapping '\x1fd3' s = Yield '\x03b9' (CC s '\x0308' '\x0301')
522−-- GREEK SMALL LETTER IOTA WITH PERISPOMENI
523−foldMapping '\x1fd6' s = Yield '\x03b9' (CC s '\x0342' '\x0000')
524−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI
525−foldMapping '\x1fd7' s = Yield '\x03b9' (CC s '\x0308' '\x0342')
526−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA
527−foldMapping '\x1fe2' s = Yield '\x03c5' (CC s '\x0308' '\x0300')
528−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA
529−foldMapping '\x1fe3' s = Yield '\x03c5' (CC s '\x0308' '\x0301')
530−-- GREEK SMALL LETTER RHO WITH PSILI
531−foldMapping '\x1fe4' s = Yield '\x03c1' (CC s '\x0313' '\x0000')
532−-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI
533−foldMapping '\x1fe6' s = Yield '\x03c5' (CC s '\x0342' '\x0000')
534−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI
535−foldMapping '\x1fe7' s = Yield '\x03c5' (CC s '\x0308' '\x0342')
536−-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI
537−foldMapping '\x1ff2' s = Yield '\x1f7c' (CC s '\x03b9' '\x0000')
538−-- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI
539−foldMapping '\x1ff3' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')
540−-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI
541−foldMapping '\x1ff4' s = Yield '\x03ce' (CC s '\x03b9' '\x0000')
542−-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI
543−foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')
544−-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI
545−foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')
546−-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
547−foldMapping '\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')
716−-- LATIN SMALL LIGATURE FF
717−foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')
718−-- LATIN SMALL LIGATURE FI
719−foldMapping '\xfb01' s = Yield '\x0066' (CC s '\x0069' '\x0000')
720−-- LATIN SMALL LIGATURE FL
721−foldMapping '\xfb02' s = Yield '\x0066' (CC s '\x006c' '\x0000')
722−-- LATIN SMALL LIGATURE FFI
723−foldMapping '\xfb03' s = Yield '\x0066' (CC s '\x0066' '\x0069')
724−-- LATIN SMALL LIGATURE FFL
725−foldMapping '\xfb04' s = Yield '\x0066' (CC s '\x0066' '\x006c')
726−-- LATIN SMALL LIGATURE LONG S T
727−foldMapping '\xfb05' s = Yield '\x0073' (CC s '\x0074' '\x0000')
728−-- LATIN SMALL LIGATURE ST
729−foldMapping '\xfb06' s = Yield '\x0073' (CC s '\x0074' '\x0000')
730−-- ARMENIAN SMALL LIGATURE MEN NOW
731−foldMapping '\xfb13' s = Yield '\x0574' (CC s '\x0576' '\x0000')
732−-- ARMENIAN SMALL LIGATURE MEN ECH
733−foldMapping '\xfb14' s = Yield '\x0574' (CC s '\x0565' '\x0000')
734−-- ARMENIAN SMALL LIGATURE MEN INI
735−foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')
736−-- ARMENIAN SMALL LIGATURE VEW NOW
737−foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')
738−-- ARMENIAN SMALL LIGATURE MEN XEH
739−foldMapping '\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')
842−foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
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/IO.hsdeleted−166
@@ -1,166 +0,0 @@
1−{-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}
2−-- |
3−-- Module : Data.Text.Internal.IO
4−-- Copyright : (c) 2009, 2010 Bryan O'Sullivan,
5−-- (c) 2009 Simon Marlow
6−-- License : BSD-style
7−-- Maintainer : bos@serpentine.com
8−-- Stability : experimental
9−-- Portability : GHC
10−--
11−-- /Warning/: this is an internal module, and does not have a stable
12−-- API or name. Functions in this module may not check or enforce
13−-- preconditions expected by public modules. Use at your own risk!
14−--
15−-- Low-level support for text I\/O.
16−
17−module Data.Text.Internal.IO
18− (
19− hGetLineWith
20− , readChunk
21− ) where
22−
23−import qualified Control.Exception as E
24−import Data.IORef (readIORef, writeIORef)
25−import 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)
29−import Data.Text.Unsafe (inlinePerformIO)
30−import Foreign.Storable (peekElemOff)
31−import GHC.IO.Buffer (Buffer(..), CharBuffer, RawCharBuffer, bufferAdjustL,
32− bufferElems, charSize, isEmptyBuffer, readCharBuf,
33− withRawBuffer, writeCharBuf)
34−import GHC.IO.Handle.Internals (ioe_EOF, readTextDevice, wantReadableHandle_)
35−import GHC.IO.Handle.Types (Handle__(..), Newline(..))
36−import System.IO (Handle)
37−import System.IO.Error (isEOFError)
38−import qualified Data.Text as T
39−
40−-- | Read a single line of input from a handle, constructing a list of
41−-- decoded chunks as we go. When we're done, transform them into the
42−-- destination type.
43−hGetLineWith :: ([Text] -> t) -> Handle -> IO t
44−hGetLineWith f h = wantReadableHandle_ "hGetLine" h go
45− where
46− go hh@Handle__{..} = readIORef haCharBuffer >>= fmap f . hGetLineLoop hh []
47−
48−hGetLineLoop :: Handle__ -> [Text] -> CharBuffer -> IO [Text]
49−hGetLineLoop hh@Handle__{..} = go where
50− go ts buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } = do
51− let findEOL raw r | r == w = return (False, w)
52− | otherwise = do
53− (c,r') <- readCharBuf raw r
54− if c == '\n'
55− then return (True, r)
56− else findEOL raw r'
57− (eol, off) <- findEOL raw0 r0
58− (t,r') <- if haInputNL == CRLF
59− then unpack_nl raw0 r0 off
60− else do t <- unpack raw0 r0 off
61− return (t,off)
62− if eol
63− then do writeIORef haCharBuffer (bufferAdjustL (off+1) buf)
64− return $ reverse (t:ts)
65− else do
66− let buf1 = bufferAdjustL r' buf
67− maybe_buf <- maybeFillReadBuffer hh buf1
68− case maybe_buf of
69− -- Nothing indicates we caught an EOF, and we may have a
70− -- partial line to return.
71− Nothing -> do
72− -- we reached EOF. There might be a lone \r left
73− -- in the buffer, so check for that and
74− -- append it to the line if necessary.
75− let pre | isEmptyBuffer buf1 = T.empty
76− | otherwise = T.singleton '\r'
77− writeIORef haCharBuffer buf1{ bufL=0, bufR=0 }
78− let str = reverse . filter (not . T.null) $ pre:t:ts
79− if null str
80− then ioe_EOF
81− else return str
82− Just new_buf -> go (t:ts) new_buf
83−
84−-- This function is lifted almost verbatim from GHC.IO.Handle.Text.
85−maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)
86−maybeFillReadBuffer handle_ buf
87− = E.catch (Just `fmap` getSomeCharacters handle_ buf) $ \e ->
88− if isEOFError e
89− then return Nothing
90− else ioError e
91−
92−unpack :: RawCharBuffer -> Int -> Int -> IO Text
93−unpack !buf !r !w
94− | charSize /= 4 = sizeError "unpack"
95− | r >= w = return T.empty
96− | otherwise = withRawBuffer buf go
97− where
98− go pbuf = return $! unstream (Stream next r (exactSize (w-r)))
99− where
100− next !i | i >= w = Done
101− | otherwise = Yield (ix i) (i+1)
102− ix i = inlinePerformIO $ peekElemOff pbuf i
103−
104−unpack_nl :: RawCharBuffer -> Int -> Int -> IO (Text, Int)
105−unpack_nl !buf !r !w
106− | charSize /= 4 = sizeError "unpack_nl"
107− | r >= w = return (T.empty, 0)
108− | otherwise = withRawBuffer buf $ go
109− where
110− go pbuf = do
111− let !t = unstream (Stream next r (maxSize (w-r)))
112− w' = w - 1
113− return $ if ix w' == '\r'
114− then (t,w')
115− else (t,w)
116− where
117− next !i | i >= w = Done
118− | c == '\r' = let i' = i + 1
119− in if i' < w
120− then if ix i' == '\n'
121− then Yield '\n' (i+2)
122− else Yield '\n' i'
123− else Done
124− | otherwise = Yield c (i+1)
125− where c = ix i
126− ix i = inlinePerformIO $ peekElemOff pbuf i
127−
128−-- This function is completely lifted from GHC.IO.Handle.Text.
129−getSomeCharacters :: Handle__ -> CharBuffer -> IO CharBuffer
130−getSomeCharacters handle_@Handle__{..} buf@Buffer{..} =
131− case bufferElems buf of
132− -- buffer empty: read some more
133− 0 -> {-# SCC "readTextDevice" #-} readTextDevice handle_ buf
134−
135− -- if the buffer has a single '\r' in it and we're doing newline
136− -- translation: read some more
137− 1 | haInputNL == CRLF -> do
138− (c,_) <- readCharBuf bufRaw bufL
139− if c == '\r'
140− then do -- shuffle the '\r' to the beginning. This is only safe
141− -- if we're about to call readTextDevice, otherwise it
142− -- would mess up flushCharBuffer.
143− -- See [note Buffer Flushing], GHC.IO.Handle.Types
144− _ <- writeCharBuf bufRaw 0 '\r'
145− let buf' = buf{ bufL=0, bufR=1 }
146− readTextDevice handle_ buf'
147− else do
148− return buf
149−
150− -- buffer has some chars in it already: just return it
151− _otherwise -> {-# SCC "otherwise" #-} return buf
152−
153−-- | Read a single chunk of strict text from a buffer. Used by both
154−-- the strict and lazy implementations of hGetContents.
155−readChunk :: Handle__ -> CharBuffer -> IO Text
156−readChunk hh@Handle__{..} buf = do
157− buf'@Buffer{..} <- getSomeCharacters hh buf
158− (t,r) <- if haInputNL == CRLF
159− then unpack_nl bufRaw bufL bufR
160− else do t <- unpack bufRaw bufL bufR
161− return (t,bufR)
162− writeIORef haCharBuffer (bufferAdjustL r buf')
163− return t
164−
165−sizeError :: String -> a
166−sizeError loc = error $ "Data.Text.IO." ++ loc ++ ": bad internal buffer size"
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/Lazy/Encoding/Fusion.hsdeleted−324
@@ -1,324 +0,0 @@
1−{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
2−
3−-- |
4−-- Module : Data.Text.Lazy.Encoding.Fusion
5−-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
6−--
7−-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
9−-- Stability : experimental
10−-- Portability : portable
11−--
12−-- /Warning/: this is an internal module, and does not have a stable
13−-- API or name. Functions in this module may not check or enforce
14−-- preconditions expected by public modules. Use at your own risk!
15−--
16−-- Fusible 'Stream'-oriented functions for converting between lazy
17−-- 'Text' and several common encodings.
18−
19−module Data.Text.Internal.Lazy.Encoding.Fusion
20− (
21− -- * Streaming
22− -- streamASCII
23− streamUtf8
24− , streamUtf16LE
25− , streamUtf16BE
26− , streamUtf32LE
27− , streamUtf32BE
28−
29− -- * Unstreaming
30− , unstream
31−
32− , module Data.Text.Internal.Encoding.Fusion.Common
33− ) where
34−
35−import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)
36−import qualified Data.ByteString as B
37−import qualified Data.ByteString.Unsafe as B
38−import Data.Text.Internal.Encoding.Fusion.Common
39−import 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)
44−import 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
48−import Data.Text.Unsafe (unsafeDupablePerformIO)
49−import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
50−import Foreign.Storable (pokeByteOff)
51−import Data.ByteString.Internal (mallocByteString, memcpy)
52−#if defined(ASSERTS)
53−import Control.Exception (assert)
54−#endif
55−import qualified Data.ByteString.Internal as B
56−
57−data S = S0
58− | S1 {-# UNPACK #-} !Word8
59− | S2 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
60− | S3 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
61− | S4 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
62−
63−data T = T !ByteString !S {-# UNPACK #-} !Int
64−
65−-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using
66−-- UTF-8 encoding.
67−streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
68−streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize
69− where
70− next (T bs@(Chunk ps _) S0 i)
71− | i < len && U8.validate1 a =
72− Yield (unsafeChr8 a) (T bs S0 (i+1))
73− | i + 1 < len && U8.validate2 a b =
74− Yield (U8.chr2 a b) (T bs S0 (i+2))
75− | i + 2 < len && U8.validate3 a b c =
76− Yield (U8.chr3 a b c) (T bs S0 (i+3))
77− | i + 3 < len && U8.validate4 a b c d =
78− Yield (U8.chr4 a b c d) (T bs S0 (i+4))
79− where len = B.length ps
80− a = B.unsafeIndex ps i
81− b = B.unsafeIndex ps (i+1)
82− c = B.unsafeIndex ps (i+2)
83− d = B.unsafeIndex ps (i+3)
84− next st@(T bs s i) =
85− case s of
86− S1 a | U8.validate1 a -> Yield (unsafeChr8 a) es
87− S2 a b | U8.validate2 a b -> Yield (U8.chr2 a b) es
88− S3 a b c | U8.validate3 a b c -> Yield (U8.chr3 a b c) es
89− S4 a b c d | U8.validate4 a b c d -> Yield (U8.chr4 a b c d) es
90− _ -> consume st
91− where es = T bs S0 i
92− consume (T bs@(Chunk ps rest) s i)
93− | i >= B.length ps = consume (T rest s 0)
94− | otherwise =
95− case s of
96− S0 -> next (T bs (S1 x) (i+1))
97− S1 a -> next (T bs (S2 a x) (i+1))
98− S2 a b -> next (T bs (S3 a b x) (i+1))
99− S3 a b c -> next (T bs (S4 a b c x) (i+1))
100− S4 a b c d -> decodeError "streamUtf8" "UTF-8" onErr (Just a)
101− (T bs (S3 b c d) (i+1))
102− where x = B.unsafeIndex ps i
103− consume (T Empty S0 _) = Done
104− consume st = decodeError "streamUtf8" "UTF-8" onErr Nothing st
105−{-# INLINE [0] streamUtf8 #-}
106−
107−-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
108−-- endian UTF-16 encoding.
109−streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
110−streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
111− where
112− next (T bs@(Chunk ps _) S0 i)
113− | i + 1 < len && U16.validate1 x1 =
114− Yield (unsafeChr x1) (T bs S0 (i+2))
115− | i + 3 < len && U16.validate2 x1 x2 =
116− Yield (U16.chr2 x1 x2) (T bs S0 (i+4))
117− where len = B.length ps
118− x1 = c (idx i) (idx (i + 1))
119− x2 = c (idx (i + 2)) (idx (i + 3))
120− c w1 w2 = w1 + (w2 `shiftL` 8)
121− idx = fromIntegral . B.unsafeIndex ps :: Int -> Word16
122− next st@(T bs s i) =
123− case s of
124− S2 w1 w2 | U16.validate1 (c w1 w2) ->
125− Yield (unsafeChr (c w1 w2)) es
126− S4 w1 w2 w3 w4 | U16.validate2 (c w1 w2) (c w3 w4) ->
127− Yield (U16.chr2 (c w1 w2) (c w3 w4)) es
128− _ -> consume st
129− where es = T bs S0 i
130− c :: Word8 -> Word8 -> Word16
131− c w1 w2 = fromIntegral w1 + (fromIntegral w2 `shiftL` 8)
132− consume (T bs@(Chunk ps rest) s i)
133− | i >= B.length ps = consume (T rest s 0)
134− | otherwise =
135− case s of
136− S0 -> next (T bs (S1 x) (i+1))
137− S1 w1 -> next (T bs (S2 w1 x) (i+1))
138− S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))
139− S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))
140− S4 w1 w2 w3 w4 -> decodeError "streamUtf16LE" "UTF-16LE" onErr (Just w1)
141− (T bs (S3 w2 w3 w4) (i+1))
142− where x = B.unsafeIndex ps i
143− consume (T Empty S0 _) = Done
144− consume st = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing st
145−{-# INLINE [0] streamUtf16LE #-}
146−
147−-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
148−-- endian UTF-16 encoding.
149−streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
150−streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
151− where
152− next (T bs@(Chunk ps _) S0 i)
153− | i + 1 < len && U16.validate1 x1 =
154− Yield (unsafeChr x1) (T bs S0 (i+2))
155− | i + 3 < len && U16.validate2 x1 x2 =
156− Yield (U16.chr2 x1 x2) (T bs S0 (i+4))
157− where len = B.length ps
158− x1 = c (idx i) (idx (i + 1))
159− x2 = c (idx (i + 2)) (idx (i + 3))
160− c w1 w2 = (w1 `shiftL` 8) + w2
161− idx = fromIntegral . B.unsafeIndex ps :: Int -> Word16
162− next st@(T bs s i) =
163− case s of
164− S2 w1 w2 | U16.validate1 (c w1 w2) ->
165− Yield (unsafeChr (c w1 w2)) es
166− S4 w1 w2 w3 w4 | U16.validate2 (c w1 w2) (c w3 w4) ->
167− Yield (U16.chr2 (c w1 w2) (c w3 w4)) es
168− _ -> consume st
169− where es = T bs S0 i
170− c :: Word8 -> Word8 -> Word16
171− c w1 w2 = (fromIntegral w1 `shiftL` 8) + fromIntegral w2
172− consume (T bs@(Chunk ps rest) s i)
173− | i >= B.length ps = consume (T rest s 0)
174− | otherwise =
175− case s of
176− S0 -> next (T bs (S1 x) (i+1))
177− S1 w1 -> next (T bs (S2 w1 x) (i+1))
178− S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))
179− S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))
180− S4 w1 w2 w3 w4 -> decodeError "streamUtf16BE" "UTF-16BE" onErr (Just w1)
181− (T bs (S3 w2 w3 w4) (i+1))
182− where x = B.unsafeIndex ps i
183− consume (T Empty S0 _) = Done
184− consume st = decodeError "streamUtf16BE" "UTF-16BE" onErr Nothing st
185−{-# INLINE [0] streamUtf16BE #-}
186−
187−-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
188−-- endian UTF-32 encoding.
189−streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
190−streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
191− where
192− next (T bs@(Chunk ps _) S0 i)
193− | i + 3 < len && U32.validate x =
194− Yield (unsafeChr32 x) (T bs S0 (i+4))
195− where len = B.length ps
196− x = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4
197− x1 = idx i
198− x2 = idx (i+1)
199− x3 = idx (i+2)
200− x4 = idx (i+3)
201− idx = fromIntegral . B.unsafeIndex ps :: Int -> Word32
202− next st@(T bs s i) =
203− case s of
204− S4 w1 w2 w3 w4 | U32.validate (c w1 w2 w3 w4) ->
205− Yield (unsafeChr32 (c w1 w2 w3 w4)) es
206− _ -> consume st
207− where es = T bs S0 i
208− c :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
209− c w1 w2 w3 w4 = shifted
210− where
211− shifted = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4
212− x1 = fromIntegral w1
213− x2 = fromIntegral w2
214− x3 = fromIntegral w3
215− x4 = fromIntegral w4
216− consume (T bs@(Chunk ps rest) s i)
217− | i >= B.length ps = consume (T rest s 0)
218− | otherwise =
219− case s of
220− S0 -> next (T bs (S1 x) (i+1))
221− S1 w1 -> next (T bs (S2 w1 x) (i+1))
222− S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))
223− S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))
224− S4 w1 w2 w3 w4 -> decodeError "streamUtf32BE" "UTF-32BE" onErr (Just w1)
225− (T bs (S3 w2 w3 w4) (i+1))
226− where x = B.unsafeIndex ps i
227− consume (T Empty S0 _) = Done
228− consume st = decodeError "streamUtf32BE" "UTF-32BE" onErr Nothing st
229−{-# INLINE [0] streamUtf32BE #-}
230−
231−-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
232−-- endian UTF-32 encoding.
233−streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
234−streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
235− where
236− next (T bs@(Chunk ps _) S0 i)
237− | i + 3 < len && U32.validate x =
238− Yield (unsafeChr32 x) (T bs S0 (i+4))
239− where len = B.length ps
240− x = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1
241− x1 = idx i
242− x2 = idx (i+1)
243− x3 = idx (i+2)
244− x4 = idx (i+3)
245− idx = fromIntegral . B.unsafeIndex ps :: Int -> Word32
246− next st@(T bs s i) =
247− case s of
248− S4 w1 w2 w3 w4 | U32.validate (c w1 w2 w3 w4) ->
249− Yield (unsafeChr32 (c w1 w2 w3 w4)) es
250− _ -> consume st
251− where es = T bs S0 i
252− c :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
253− c w1 w2 w3 w4 = shifted
254− where
255− shifted = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1
256− x1 = fromIntegral w1
257− x2 = fromIntegral w2
258− x3 = fromIntegral w3
259− x4 = fromIntegral w4
260− consume (T bs@(Chunk ps rest) s i)
261− | i >= B.length ps = consume (T rest s 0)
262− | otherwise =
263− case s of
264− S0 -> next (T bs (S1 x) (i+1))
265− S1 w1 -> next (T bs (S2 w1 x) (i+1))
266− S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))
267− S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))
268− S4 w1 w2 w3 w4 -> decodeError "streamUtf32LE" "UTF-32LE" onErr (Just w1)
269− (T bs (S3 w2 w3 w4) (i+1))
270− where x = B.unsafeIndex ps i
271− consume (T Empty S0 _) = Done
272− consume st = decodeError "streamUtf32LE" "UTF-32LE" onErr Nothing st
273−{-# INLINE [0] streamUtf32LE #-}
274−
275−-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
276−unstreamChunks :: Int -> Stream Word8 -> ByteString
277−unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)
278− where chunk s1 len1 = unsafeDupablePerformIO $ do
279− let len = max 4 (min len1 chunkSize)
280− mallocByteString len >>= loop len 0 s1
281− where
282− loop !n !off !s fp = case next s of
283− Done | off == 0 -> return Empty
284− | otherwise -> return $! Chunk (trimUp fp off) Empty
285− Skip s' -> loop n off s' fp
286− Yield x s'
287− | off == chunkSize -> do
288− let !newLen = n - off
289− return $! Chunk (trimUp fp off) (chunk s newLen)
290− | off == n -> realloc fp n off s' x
291− | otherwise -> do
292− withForeignPtr fp $ \p -> pokeByteOff p off x
293− loop n (off+1) s' fp
294− {-# NOINLINE realloc #-}
295− realloc fp n off s x = do
296− let n' = min (n+n) chunkSize
297− fp' <- copy0 fp n n'
298− withForeignPtr fp' $ \p -> pokeByteOff p off x
299− loop n' (off+1) s fp'
300− trimUp fp off = B.PS fp 0 off
301− copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)
302− copy0 !src !srcLen !destLen =
303−#if defined(ASSERTS)
304− assert (srcLen <= destLen) $
305−#endif
306− do
307− dest <- mallocByteString destLen
308− withForeignPtr src $ \src' ->
309− withForeignPtr dest $ \dest' ->
310− memcpy dest' src' (fromIntegral srcLen)
311− return dest
312−
313−-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
314−unstream :: Stream Word8 -> ByteString
315−unstream = unstreamChunks defaultChunkSize
316−
317−decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8
318− -> s -> Step s Char
319−decodeError func kind onErr mb i =
320− case onErr desc mb of
321− Nothing -> Skip i
322− Just c -> Yield c i
323− where desc = "Data.Text.Lazy.Encoding.Fusion." ++ func ++ ": Invalid " ++
324− kind ++ " stream"
Data/Text/Internal/Lazy/Fusion.hsdeleted−120
@@ -1,120 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−-- |
3−-- Module : Data.Text.Lazy.Fusion
4−-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
5−--
6−-- License : BSD-style
7−-- Maintainer : bos@serpentine.com
8−-- Stability : experimental
9−-- Portability : GHC
10−--
11−-- /Warning/: this is an internal module, and does not have a stable
12−-- API or name. Functions in this module may not check or enforce
13−-- preconditions expected by public modules. Use at your own risk!
14−--
15−-- Core stream fusion functionality for text.
16−
17−module Data.Text.Internal.Lazy.Fusion
18− (
19− stream
20− , unstream
21− , unstreamChunks
22− , length
23− , unfoldrN
24− , index
25− , countChar
26− ) where
27−
28−import Prelude hiding (length)
29−import qualified Data.Text.Internal.Fusion.Common as S
30−import 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
34−import qualified Data.Text.Internal as I
35−import qualified Data.Text.Array as A
36−import Data.Text.Internal.Unsafe.Char (unsafeWrite)
37−import Data.Text.Internal.Unsafe.Shift (shiftL)
38−import Data.Text.Unsafe (Iter(..), iter)
39−import Data.Int (Int64)
40−
41−default(Int64)
42−
43−-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
44−stream :: Text -> Stream Char
45−stream text = Stream next (text :*: 0) unknownSize
46− where
47− next (Empty :*: _) = Done
48− next (txt@(Chunk t@(I.Text _ _ len) ts) :*: i)
49− | i >= len = next (ts :*: 0)
50− | otherwise = Yield c (txt :*: i+d)
51− where Iter c d = iter t i
52−{-# INLINE [0] stream #-}
53−
54−-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given
55−-- chunk size.
56−unstreamChunks :: Int -> Stream Char -> Text
57−unstreamChunks !chunkSize (Stream next s0 len0)
58− | isEmpty len0 = Empty
59− | otherwise = outer s0
60− where
61− outer so = {-# SCC "unstreamChunks/outer" #-}
62− case next so of
63− Done -> Empty
64− Skip s' -> outer s'
65− Yield x s' -> runST $ do
66− a <- A.new unknownLength
67− unsafeWrite a 0 x >>= inner a unknownLength s'
68− where unknownLength = 4
69− where
70− inner marr !len s !i
71− | i + 1 >= chunkSize = finish marr i s
72− | i + 1 >= len = {-# SCC "unstreamChunks/resize" #-} do
73− let newLen = min (len `shiftL` 1) chunkSize
74− marr' <- A.new newLen
75− A.copyM marr' 0 marr 0 len
76− inner marr' newLen s i
77− | otherwise =
78− {-# SCC "unstreamChunks/inner" #-}
79− case next s of
80− Done -> finish marr i s
81− Skip s' -> inner marr len s' i
82− Yield x s' -> do d <- unsafeWrite marr i x
83− inner marr len s' (i+d)
84− finish marr len s' = do
85− arr <- A.unsafeFreeze marr
86− return (I.Text arr 0 len `Chunk` outer s')
87−{-# INLINE [0] unstreamChunks #-}
88−
89−-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using
90−-- 'defaultChunkSize'.
91−unstream :: Stream Char -> Text
92−unstream = unstreamChunks defaultChunkSize
93−{-# INLINE [0] unstream #-}
94−
95−-- | /O(n)/ Returns the number of characters in a text.
96−length :: Stream Char -> Int64
97−length = S.lengthI
98−{-# INLINE[0] length #-}
99−
100−{-# RULES "LAZY STREAM stream/unstream fusion" forall s.
101− stream (unstream s) = s #-}
102−
103−-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
104−-- value. However, the length of the result is limited by the
105−-- first argument to 'unfoldrN'. This function is more efficient than
106−-- 'unfoldr' when the length of the result is known.
107−unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Stream Char
108−unfoldrN n = S.unfoldrNI n
109−{-# INLINE [0] unfoldrN #-}
110−
111−-- | /O(n)/ stream index (subscript) operator, starting from 0.
112−index :: Stream Char -> Int64 -> Char
113−index = S.indexI
114−{-# INLINE [0] index #-}
115−
116−-- | /O(n)/ The 'count' function returns the number of times the query
117−-- element appears in the given stream.
118−countChar :: Char -> Stream Char -> Int64
119−countChar = S.countCharI
120−{-# INLINE [0] countChar #-}
Data/Text/Internal/Lazy/Search.hsdeleted−134
@@ -1,134 +0,0 @@
1−{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
2−
3−-- |
4−-- Module : Data.Text.Lazy.Search
5−-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
6−--
7−-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
9−-- Stability : experimental
10−-- Portability : GHC
11−--
12−-- /Warning/: this is an internal module, and does not have a stable
13−-- API or name. Functions in this module may not check or enforce
14−-- preconditions expected by public modules. Use at your own risk!
15−--
16−-- Fast substring search for lazy 'Text', based on work by Boyer,
17−-- Moore, Horspool, Sunday, and Lundh. Adapted from the strict
18−-- implementation.
19−
20−module Data.Text.Internal.Lazy.Search
21− (
22− indices
23− ) where
24−
25−import qualified Data.Text.Array as A
26−import Data.Int (Int64)
27−import Data.Word (Word16, Word64)
28−import qualified Data.Text.Internal as T
29−import Data.Text.Internal.Fusion.Types (PairS(..))
30−import Data.Text.Internal.Lazy (Text(..), foldlChunks)
31−import Data.Bits ((.|.), (.&.))
32−import Data.Text.Internal.Unsafe.Shift (shiftL)
33−
34−-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
35−-- @needle@ within @haystack@.
36−--
37−-- This function is strict in @needle@, and lazy (as far as possible)
38−-- in the chunks of @haystack@.
39−--
40−-- In (unlikely) bad cases, this algorithm's complexity degrades
41−-- towards /O(n*m)/.
42−indices :: Text -- ^ Substring to search for (@needle@)
43− -> Text -- ^ Text to search in (@haystack@)
44− -> [Int64]
45−indices needle@(Chunk n ns) _haystack@(Chunk k ks)
46− | nlen <= 0 = []
47− | nlen == 1 = indicesOne (nindex 0) 0 k ks
48− | otherwise = advance k ks 0 0
49− where
50− advance x@(T.Text _ _ l) xs = scan
51− where
52− scan !g !i
53− | i >= m = case xs of
54− Empty -> []
55− Chunk y ys -> advance y ys g (i-m)
56− | lackingHay (i + nlen) x xs = []
57− | c == z && candidateMatch 0 = g : scan (g+nlen) (i+nlen)
58− | otherwise = scan (g+delta) (i+delta)
59− where
60− m = fromIntegral l
61− c = hindex (i + nlast)
62− delta | nextInPattern = nlen + 1
63− | c == z = skip + 1
64− | otherwise = 1
65− nextInPattern = mask .&. swizzle (hindex (i+nlen)) == 0
66− candidateMatch !j
67− | j >= nlast = True
68− | hindex (i+j) /= nindex j = False
69− | otherwise = candidateMatch (j+1)
70− hindex = index x xs
71− nlen = wordLength needle
72− nlast = nlen - 1
73− nindex = index n ns
74− z = foldlChunks fin 0 needle
75− where fin _ (T.Text farr foff flen) = A.unsafeIndex farr (foff+flen-1)
76− (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)
77− swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)
78− buildTable (T.Text xarr xoff xlen) xs = go
79− where
80− go !(g::Int64) !i !msk !skp
81− | i >= xlast = case xs of
82− Empty -> (msk .|. swizzle z) :*: skp
83− Chunk y ys -> buildTable y ys g 0 msk' skp'
84− | otherwise = go (g+1) (i+1) msk' skp'
85− where c = A.unsafeIndex xarr (xoff+i)
86− msk' = msk .|. swizzle c
87− skp' | c == z = nlen - g - 2
88− | otherwise = skp
89− xlast = xlen - 1
90− -- | Check whether an attempt to index into the haystack at the
91− -- given offset would fail.
92− lackingHay q = go 0
93− where
94− go p (T.Text _ _ l) ps = p' < q && case ps of
95− Empty -> True
96− Chunk r rs -> go p' r rs
97− where p' = p + fromIntegral l
98−indices _ _ = []
99−
100−-- | Fast index into a partly unpacked 'Text'. We take into account
101−-- the possibility that the caller might try to access one element
102−-- past the end.
103−index :: T.Text -> Text -> Int64 -> Word16
104−index (T.Text arr off len) xs !i
105− | j < len = A.unsafeIndex arr (off+j)
106− | otherwise = case xs of
107− Empty
108− -- out of bounds, but legal
109− | j == len -> 0
110− -- should never happen, due to lackingHay above
111− | otherwise -> emptyError "index"
112− Chunk c cs -> index c cs (i-fromIntegral len)
113− where j = fromIntegral i
114−
115−-- | A variant of 'indices' that scans linearly for a single 'Word16'.
116−indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]
117−indicesOne c = chunk
118− where
119− chunk !i (T.Text oarr ooff olen) os = go 0
120− where
121− go h | h >= olen = case os of
122− Empty -> []
123− Chunk y ys -> chunk (i+fromIntegral olen) y ys
124− | on == c = i + fromIntegral h : go (h+1)
125− | otherwise = go (h+1)
126− where on = A.unsafeIndex oarr (ooff+h)
127−
128−-- | The number of 'Word16' values in a 'Text'.
129−wordLength :: Text -> Int64
130−wordLength = foldlChunks sumLength 0
131− where sumLength i (T.Text _ _ l) = i + fromIntegral l
132−
133−emptyError :: String -> a
134−emptyError fun = error ("Data.Text.Lazy.Search." ++ fun ++ ": empty input")
Data/Text/Internal/Private.hsdeleted−37
@@ -1,37 +0,0 @@
1−{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples #-}
2−
3−-- |
4−-- Module : Data.Text.Internal.Private
5−-- Copyright : (c) 2011 Bryan O'Sullivan
6−--
7−-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
9−-- Stability : experimental
10−-- Portability : GHC
11−
12−module Data.Text.Internal.Private
13− (
14− runText
15− , span_
16− ) where
17−
18−import Control.Monad.ST (ST, runST)
19−import Data.Text.Internal (Text(..), text)
20−import Data.Text.Unsafe (Iter(..), iter)
21−import qualified Data.Text.Array as A
22−
23−span_ :: (Char -> Bool) -> Text -> (# Text, Text #)
24−span_ p t@(Text arr off len) = (# hd,tl #)
25− where hd = text arr off k
26− tl = text arr (off+k) (len-k)
27− !k = loop 0
28− loop !i | i < len && p c = loop (i+d)
29− | otherwise = i
30− where Iter c d = iter t i
31−{-# INLINE span_ #-}
32−
33−runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text
34−runText act = runST (act $ \ !marr !len -> do
35− arr <- A.unsafeFreeze marr
36− return $! text arr 0 len)
37−{-# INLINE runText #-}
Data/Text/Internal/Read.hsdeleted−62
@@ -1,62 +0,0 @@
1−-- |
2−-- Module : Data.Text.Internal.Read
3−-- Copyright : (c) 2014 Bryan O'Sullivan
4−--
5−-- License : BSD-style
6−-- Maintainer : bos@serpentine.com
7−-- Stability : experimental
8−-- Portability : GHC
9−--
10−-- Common internal functions for reading textual data.
11−module Data.Text.Internal.Read
12− (
13− IReader
14− , IParser(..)
15− , T(..)
16− , digitToInt
17− , hexDigitToInt
18− , perhaps
19− ) where
20−
21−import Control.Applicative as App (Applicative(..))
22−import Control.Arrow (first)
23−import Control.Monad (ap)
24−import Data.Char (ord)
25−
26−type IReader t a = t -> Either String (a,t)
27−
28−newtype IParser t a = P {
29− runP :: IReader t a
30− }
31−
32−instance Functor (IParser t) where
33− fmap f m = P $ fmap (first f) . runP m
34−
35−instance Applicative (IParser t) where
36− pure a = P $ \t -> Right (a,t)
37− {-# INLINE pure #-}
38− (<*>) = ap
39−
40−instance Monad (IParser t) where
41− return = App.pure
42− m >>= k = P $ \t -> case runP m t of
43− Left err -> Left err
44− Right (a,t') -> runP (k a) t'
45− {-# INLINE (>>=) #-}
46− fail msg = P $ \_ -> Left msg
47−
48−data T = T !Integer !Int
49−
50−perhaps :: a -> IParser t a -> IParser t a
51−perhaps def m = P $ \t -> case runP m t of
52− Left _ -> Right (def,t)
53− r@(Right _) -> r
54−
55−hexDigitToInt :: Char -> Int
56−hexDigitToInt c
57− | c >= '0' && c <= '9' = ord c - ord '0'
58− | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)
59− | otherwise = ord c - (ord 'A' - 10)
60−
61−digitToInt :: Char -> Int
62−digitToInt c = ord c - ord '0'
Data/Text/Internal/Search.hsdeleted−89
@@ -1,89 +0,0 @@
1−{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
2−
3−-- |
4−-- Module : Data.Text.Internal.Search
5−-- Copyright : (c) Bryan O'Sullivan 2009
6−--
7−-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
9−-- Stability : experimental
10−-- Portability : GHC
11−--
12−-- Fast substring search for 'Text', based on work by Boyer, Moore,
13−-- Horspool, Sunday, and Lundh.
14−--
15−-- References:
16−--
17−-- * R. S. Boyer, J. S. Moore: A Fast String Searching Algorithm.
18−-- Communications of the ACM, 20, 10, 762-772 (1977)
19−--
20−-- * R. N. Horspool: Practical Fast Searching in Strings. Software -
21−-- Practice and Experience 10, 501-506 (1980)
22−--
23−-- * D. M. Sunday: A Very Fast Substring Search Algorithm.
24−-- Communications of the ACM, 33, 8, 132-142 (1990)
25−--
26−-- * F. Lundh: The Fast Search Algorithm.
27−-- <http://effbot.org/zone/stringlib.htm> (2006)
28−
29−module Data.Text.Internal.Search
30− (
31− indices
32− ) where
33−
34−import qualified Data.Text.Array as A
35−import Data.Word (Word64)
36−import Data.Text.Internal (Text(..))
37−import Data.Bits ((.|.), (.&.))
38−import Data.Text.Internal.Unsafe.Shift (shiftL)
39−
40−data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
41−
42−-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
43−-- @needle@ within @haystack@. The offsets returned represent
44−-- uncorrected indices in the low-level \"needle\" array, to which its
45−-- offset must be added.
46−--
47−-- In (unlikely) bad cases, this algorithm's complexity degrades
48−-- towards /O(n*m)/.
49−indices :: Text -- ^ Substring to search for (@needle@)
50− -> Text -- ^ Text to search in (@haystack@)
51− -> [Int]
52−indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)
53− | nlen == 1 = scanOne (nindex 0)
54− | nlen <= 0 || ldiff < 0 = []
55− | otherwise = scan 0
56− where
57− ldiff = hlen - nlen
58− nlast = nlen - 1
59− z = nindex nlast
60− nindex k = A.unsafeIndex narr (noff+k)
61− hindex k = A.unsafeIndex harr (hoff+k)
62− hindex' k | k == hlen = 0
63− | otherwise = A.unsafeIndex harr (hoff+k)
64− buildTable !i !msk !skp
65− | i >= nlast = (msk .|. swizzle z) :* skp
66− | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'
67− where c = nindex i
68− skp' | c == z = nlen - i - 2
69− | otherwise = skp
70− swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)
71− scan !i
72− | i > ldiff = []
73− | c == z && candidateMatch 0 = i : scan (i + nlen)
74− | otherwise = scan (i + delta)
75− where c = hindex (i + nlast)
76− candidateMatch !j
77− | j >= nlast = True
78− | hindex (i+j) /= nindex j = False
79− | otherwise = candidateMatch (j+1)
80− delta | nextInPattern = nlen + 1
81− | c == z = skip + 1
82− | otherwise = 1
83− where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0
84− !(mask :* skip) = buildTable 0 0 (nlen-2)
85− scanOne c = loop 0
86− where loop !i | i >= hlen = []
87− | hindex i == c = i : loop (i+1)
88− | otherwise = loop (i+1)
89−{-# INLINE indices #-}
Data/Text/Internal/Unsafe.hsdeleted−56
@@ -1,56 +0,0 @@
1−{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
2−{-# OPTIONS_HADDOCK not-home #-}
3−
4−-- |
5−-- Module : Data.Text.Internal.Unsafe
6−-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
7−-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
9−-- Stability : experimental
10−-- Portability : portable
11−--
12−-- /Warning/: this is an internal module, and does not have a stable
13−-- API or name. Functions in this module may not check or enforce
14−-- preconditions expected by public modules. Use at your own risk!
15−--
16−-- A module containing /unsafe/ operations, for /very very careful/ use
17−-- in /heavily tested/ code.
18−module Data.Text.Internal.Unsafe
19− (
20− inlineInterleaveST
21− , inlinePerformIO
22− ) where
23−
24−import GHC.ST (ST(..))
25−#if defined(__GLASGOW_HASKELL__)
26−import GHC.IO (IO(IO))
27−import GHC.Base (realWorld#)
28−#endif
29−
30−
31−-- | Just like unsafePerformIO, but we inline it. Big performance gains as
32−-- it exposes lots of things to further inlining. /Very unsafe/. In
33−-- particular, you should do no memory allocation inside an
34−-- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@.
35−--
36−{-# INLINE inlinePerformIO #-}
37−inlinePerformIO :: IO a -> a
38−#if defined(__GLASGOW_HASKELL__)
39−inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
40−#else
41−inlinePerformIO = unsafePerformIO
42−#endif
43−
44−-- | Allow an 'ST' computation to be deferred lazily. When passed an
45−-- action of type 'ST' @s@ @a@, the action will only be performed when
46−-- the value of @a@ is demanded.
47−--
48−-- This function is identical to the normal unsafeInterleaveST, but is
49−-- inlined and hence faster.
50−--
51−-- /Note/: This operation is highly unsafe, as it can introduce
52−-- externally visible non-determinism into an 'ST' action.
53−inlineInterleaveST :: ST s a -> ST s a
54−inlineInterleaveST (ST m) = ST $ \ s ->
55− let r = case m s of (# _, res #) -> res in (# s, r #)
56−{-# INLINE inlineInterleaveST #-}
Data/Text/Lazy.hs+208−978
@@ -1,56 +1,36 @@
1{-# OPTIONS_GHC -fno-warn-orphans #-}
1{-# OPTIONS_GHC -fno-warn-orphans #-}
2−{-# LANGUAGE BangPatterns, MagicHash, CPP #-}
3−#if __GLASGOW_HASKELL__ >= 702
4−{-# LANGUAGE Trustworthy #-}
5−#endif
6−#if __GLASGOW_HASKELL__ >= 708
7−{-# LANGUAGE TypeFamilies #-}
8−#endif
9−
10-- |
2-- |
11-- Module : Data.Text.Lazy
3-- Module : Data.Text.Lazy
12−-- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan
4+-- Copyright : (c) Bryan O'Sullivan 2009
13--
5--
14-- License : BSD-style
6-- License : BSD-style
15−-- Maintainer : bos@serpentine.com
7+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,
8+-- duncan@haskell.org
16-- Stability : experimental
9-- Stability : experimental
17-- Portability : GHC
10-- Portability : GHC
18--
11--
19-- A time and space-efficient implementation of Unicode text using
12-- A time and space-efficient implementation of Unicode text using
20−-- lists of packed arrays.
13+-- lists of packed arrays. This representation is suitable for high
21−--
22−-- /Note/: Read below the synopsis for important notes on the use of
23−-- this module.
24−--
25−-- The representation used by this module is suitable for high
26-- performance use and for streaming large quantities of data. It
14-- performance use and for streaming large quantities of data. It
27-- provides a means to manipulate a large body of text without
15-- provides a means to manipulate a large body of text without
28-- requiring that the entire content be resident in memory.
16-- requiring that the entire content be resident in memory.
29--
17--
30-- Some operations, such as 'concat', 'append', 'reverse' and 'cons',
18-- Some operations, such as 'concat', 'append', 'reverse' and 'cons',
31−-- have better time complexity than their "Data.Text" equivalents, due
19+-- have better complexity than their "Data.Text" equivalents, due to
32−-- to the underlying representation being a list of chunks. For other
20+-- optimisations resulting from the list spine structure. And for
33−-- operations, lazy 'Text's are usually within a few percent of strict
21+-- other operations lazy 'Text's are usually within a few percent of
34−-- ones, but often with better heap usage if used in a streaming
22+-- strict ones, but with better heap usage. For data larger than
35−-- fashion. For data larger than available memory, or if you have
23+-- available memory, or if you have tight memory constraints, this
36−-- tight memory constraints, this module will be the only option.
24+-- module will be the only option.
37--
25--
38-- This module is intended to be imported @qualified@, to avoid name
26-- This module is intended to be imported @qualified@, to avoid name
39-- clashes with "Prelude" functions. eg.
27-- clashes with "Prelude" functions. eg.
40--
28--
41−-- > import qualified Data.Text.Lazy as L
29+-- > import qualified Data.Text.Lazy as B
42
30
43module Data.Text.Lazy
31module Data.Text.Lazy
44 (
32 (
45− -- * Fusion
46− -- $fusion
47−
48− -- * Acceptable data
49− -- $replacement
50−
51− -- * Types
52 Text
33 Text
53−
54 -- * Creation and elimination
34 -- * Creation and elimination
55 , pack
35 , pack
56 , unpack
36 , unpack
@@ -58,10 +38,6 @@ module Data.Text.Lazy
58 , empty
38 , empty
59 , fromChunks
39 , fromChunks
60 , toChunks
40 , toChunks
61− , toStrict
62− , fromStrict
63− , foldrChunks
64− , foldlChunks
65
41
66 -- * Basic interface
42 -- * Basic interface
67 , cons
43 , cons
@@ -74,7 +50,6 @@ module Data.Text.Lazy
74 , init
50 , init
75 , null
51 , null
76 , length
52 , length
77− , compareLength
78
53
79 -- * Transformations
54 -- * Transformations
80 , map
55 , map
@@ -82,19 +57,12 @@ module Data.Text.Lazy
82 , intersperse
57 , intersperse
83 , transpose
58 , transpose
84 , reverse
59 , reverse
85− , replace
86
60
87 -- ** Case conversion
61 -- ** Case conversion
88 -- $case
62 -- $case
89 , toCaseFold
63 , toCaseFold
90 , toLower
64 , toLower
91 , toUpper
65 , toUpper
92− , toTitle
93−
94− -- ** Justification
95− , justifyLeft
96− , justifyRight
97− , center
98
66
99 -- * Folds
67 -- * Folds
100 , foldl
68 , foldl
@@ -125,10 +93,7 @@ module Data.Text.Lazy
125 , mapAccumR
93 , mapAccumR
126
94
127 -- ** Generation and unfolding
95 -- ** Generation and unfolding
128− , repeat
129 , replicate
96 , replicate
130− , cycle
131− , iterate
132 , unfoldr
97 , unfoldr
133 , unfoldrN
98 , unfoldrN
134
99
@@ -136,21 +101,11 @@ module Data.Text.Lazy
136
101
137 -- ** Breaking strings
102 -- ** Breaking strings
138 , take
103 , take
139− , takeEnd
140 , drop
104 , drop
141− , dropEnd
142 , takeWhile
105 , takeWhile
143− , takeWhileEnd
144 , dropWhile
106 , dropWhile
145− , dropWhileEnd
146− , dropAround
147− , strip
148− , stripStart
149− , stripEnd
150 , splitAt
107 , splitAt
151 , span
108 , span
152− , breakOn
153− , breakOnEnd
154 , break
109 , break
155 , group
110 , group
156 , groupBy
111 , groupBy
@@ -158,10 +113,8 @@ module Data.Text.Lazy
158 , tails
113 , tails
159
114
160 -- ** Breaking into many substrings
115 -- ** Breaking into many substrings
161− -- $split
162− , splitOn
163 , split
116 , split
164− , chunksOf
117+ , splitWith
165 -- , breakSubstring
118 -- , breakSubstring
166
119
167 -- ** Breaking into lines and words
120 -- ** Breaking into lines and words
@@ -175,21 +128,20 @@ module Data.Text.Lazy
175 , isSuffixOf
128 , isSuffixOf
176 , isInfixOf
129 , isInfixOf
177
130
178− -- ** View patterns
179− , stripPrefix
180− , stripSuffix
181− , commonPrefixes
182−
183 -- * Searching
131 -- * Searching
132+ , elem
184 , filter
133 , filter
185 , find
134 , find
186− , breakOnAll
187 , partition
135 , partition
188
136
189 -- , findSubstring
137 -- , findSubstring
190−
138+
191 -- * Indexing
139 -- * Indexing
192 , index
140 , index
141+ , findIndex
142+ , findIndices
143+ , elemIndex
144+ , elemIndices
193 , count
145 , count
194
146
195 -- * Zipping and unzipping
147 -- * Zipping and unzipping
@@ -200,140 +152,29 @@ module Data.Text.Lazy
200 -- , sort
152 -- , sort
201 ) where
153 ) where
202
154
203−import Prelude (Char, Bool(..), Maybe(..), String,
155+import Prelude (Char, Bool(..), Int, Maybe(..), String,
204− Eq(..), Ord(..), Ordering(..), Read(..), Show(..),
156+ Eq(..), Ord(..), Read(..), Show(..),
205− (&&), (||), (+), (-), (.), ($), (++),
157+ (&&), (+), (-), (.), ($), (++),
206− error, flip, fmap, fromIntegral, not, otherwise, quot)
158+ flip, fromIntegral, not, otherwise)
207import qualified Prelude as P
159import qualified Prelude as P
208−#if defined(HAVE_DEEPSEQ)
209−import Control.DeepSeq (NFData(..))
210−#endif
211import Data.Int (Int64)
160import Data.Int (Int64)
212import qualified Data.List as L
161import qualified Data.List as L
213import Data.Char (isSpace)
162import 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))
217−import Data.Monoid (Monoid(..))
218−#if MIN_VERSION_base(4,9,0)
219−import Data.Semigroup (Semigroup(..))
220−#endif
221import Data.String (IsString(..))
163import Data.String (IsString(..))
222import qualified Data.Text as T
164import qualified Data.Text as T
223−import qualified Data.Text.Internal as T
165+import qualified Data.Text.Fusion.Common as S
224−import qualified Data.Text.Internal.Fusion.Common as S
225import qualified Data.Text.Unsafe as T
166import qualified Data.Text.Unsafe as T
226−import qualified Data.Text.Internal.Lazy.Fusion as S
167+import qualified Data.Text.Lazy.Fusion as S
227−import Data.Text.Internal.Fusion.Types (PairS(..))
168+import Data.Text.Lazy.Fusion (stream, unstream)
228−import Data.Text.Internal.Lazy.Fusion (stream, unstream)
169+import Data.Text.Lazy.Internal
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)
235−#if __GLASGOW_HASKELL__ >= 702
236−import qualified GHC.CString as GHC
237−#else
238−import qualified GHC.Base as GHC
239−#endif
240−#if __GLASGOW_HASKELL__ >= 708
241−import qualified GHC.Exts as Exts
242−#endif
243−import GHC.Prim (Addr#)
244−#if MIN_VERSION_base(4,7,0)
245−import Text.Printf (PrintfArg, formatArg, formatString)
246−#endif
247−
248−-- $fusion
249−--
250−-- Most of the functions in this module are subject to /fusion/,
251−-- meaning that a pipeline of such functions will usually allocate at
252−-- most one 'Text' value.
253−--
254−-- As an example, consider the following pipeline:
255−--
256−-- > import Data.Text.Lazy as T
257−-- > import Data.Text.Lazy.Encoding as E
258−-- > import Data.ByteString.Lazy (ByteString)
259−-- >
260−-- > countChars :: ByteString -> Int
261−-- > countChars = T.length . T.toUpper . E.decodeUtf8
262−--
263−-- From the type signatures involved, this looks like it should
264−-- allocate one 'ByteString' value, and two 'Text' values. However,
265−-- when a module is compiled with optimisation enabled under GHC, the
266−-- two intermediate 'Text' values will be optimised away, and the
267−-- function will be compiled down to a single loop over the source
268−-- 'ByteString'.
269−--
270−-- Functions that can be fused by the compiler are documented with the
271−-- phrase \"Subject to fusion\".
272−
273−-- $replacement
274−--
275−-- A 'Text' value is a sequence of Unicode scalar values, as defined
276−-- in &#xa7;3.9, definition D76 of the Unicode 5.2 standard:
277−-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35>. As
278−-- such, a 'Text' cannot contain values in the range U+D800 to U+DFFF
279−-- inclusive. Haskell implementations admit all Unicode code points
280−-- (&#xa7;3.4, definition D10) as 'Char' values, including code points
281−-- from this invalid range. This means that there are some 'Char'
282−-- values that are not valid Unicode scalar values, and the functions
283−-- in this module must handle those cases.
284−--
285−-- Within this module, many functions construct a 'Text' from one or
286−-- more 'Char' values. Those functions will substitute 'Char' values
287−-- that are not valid Unicode scalar values with the replacement
288−-- character \"&#xfffd;\" (U+FFFD). Functions that perform this
289−-- inspection and replacement are documented with the phrase
290−-- \"Performs replacement on invalid scalar values\".
291−--
292−-- (One reason for this policy of replacement is that internally, a
293−-- 'Text' value is represented as packed UTF-16 data. Values in the
294−-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate
295−-- code points, and so cannot be represented. The functions replace
296−-- invalid scalar values, instead of dropping them, as a security
297−-- measure. For details, see Unicode Technical Report 36, &#xa7;3.5:
298−-- <http://unicode.org/reports/tr36#Deletion_of_Noncharacters>)
299−
300−equal :: Text -> Text -> Bool
301−equal Empty Empty = True
302−equal Empty _ = False
303−equal _ Empty = False
304−equal (Chunk a as) (Chunk b bs) =
305− case compare lenA lenB of
306− LT -> a == (T.takeWord16 lenA b) &&
307− as `equal` Chunk (T.dropWord16 lenA b) bs
308− EQ -> a == b && as `equal` bs
309− GT -> T.takeWord16 lenB a == b &&
310− Chunk (T.dropWord16 lenB a) as `equal` bs
311− where lenA = T.lengthWord16 a
312− lenB = T.lengthWord16 b
313
170
314instance Eq Text where
171instance Eq Text where
315− (==) = equal
172+ t1 == t2 = stream t1 == stream t2
316 {-# INLINE (==) #-}
173 {-# INLINE (==) #-}
317
174
318instance Ord Text where
175instance Ord Text where
319− compare = compareText
176+ compare t1 t2 = compare (stream t1) (stream t2)
320−
177+ {-# INLINE compare #-}
321−compareText :: Text -> Text -> Ordering
322−compareText Empty Empty = EQ
323−compareText Empty _ = LT
324−compareText _ Empty = GT
325−compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0
326− where
327− outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0
328− where
329− go !i !j
330− | i >= lenA = compareText as (chunk (T.Text arrB (offB+j) (lenB-j)) bs)
331− | j >= lenB = compareText (chunk (T.Text arrA (offA+i) (lenA-i)) as) bs
332− | a < b = LT
333− | a > b = GT
334− | otherwise = go (i+di) (j+dj)
335− where T.Iter a di = T.iter ta i
336− T.Iter b dj = T.iter tb j
337
178
338instance Show Text where
179instance Show Text where
339 showsPrec p ps r = showsPrec p (unpack ps) r
180 showsPrec p ps r = showsPrec p (unpack ps) r
@@ -341,108 +182,22 @@ instance Show Text where
341instance Read Text where
182instance Read Text where
342 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
183 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
343
184
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−
352−instance Monoid Text where
353− mempty = empty
354−#if MIN_VERSION_base(4,9,0)
355− mappend = (<>) -- future-proof definition
356−#else
357− mappend = append
358−#endif
359− mconcat = concat
360−
361instance IsString Text where
185instance IsString Text where
362 fromString = pack
186 fromString = pack
363
187
364−#if __GLASGOW_HASKELL__ >= 708
365−instance Exts.IsList Text where
366− type Item Text = Char
367− fromList = pack
368− toList = unpack
369−#endif
370−
371−#if defined(HAVE_DEEPSEQ)
372−instance NFData Text where
373− rnf Empty = ()
374− rnf (Chunk _ ts) = rnf ts
375−#endif
376−
377−instance Binary Text where
378− put t = put (encodeUtf8 t)
379− get = do
380− bs <- get
381− case decodeUtf8' bs of
382− P.Left exn -> P.fail (P.show exn)
383− P.Right a -> P.return a
384−
385−-- | This instance preserves data abstraction at the cost of inefficiency.
386−-- We omit reflection services for the sake of data abstraction.
387−--
388−-- This instance was created by copying the updated behavior of
389−-- @"Data.Text".@'Data.Text.Text'
390−instance Data Text where
391− 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]
409−
410-- | /O(n)/ Convert a 'String' into a 'Text'.
188-- | /O(n)/ Convert a 'String' into a 'Text'.
411--
189--
412−-- Subject to fusion. Performs replacement on invalid scalar values.
190+-- This function is subject to array fusion.
413pack :: String -> Text
191pack :: String -> Text
414−pack = unstream . S.streamList . L.map safe
192+pack s = unstream (S.streamList s)
415{-# INLINE [1] pack #-}
193{-# INLINE [1] pack #-}
416
194
417-- | /O(n)/ Convert a 'Text' into a 'String'.
195-- | /O(n)/ Convert a 'Text' into a 'String'.
418−-- Subject to fusion.
196+-- Subject to array fusion.
419unpack :: Text -> String
197unpack :: Text -> String
420unpack t = S.unstreamList (stream t)
198unpack t = S.unstreamList (stream t)
421{-# INLINE [1] unpack #-}
199{-# INLINE [1] unpack #-}
422
200
423−-- | /O(n)/ Convert a literal string into a Text.
424−unpackCString# :: Addr# -> Text
425−unpackCString# addr# = unstream (S.streamCString# addr#)
426−{-# NOINLINE unpackCString# #-}
427−
428−{-# RULES "TEXT literal" forall a.
429− unstream (S.streamList (L.map safe (GHC.unpackCString# a)))
430− = unpackCString# a #-}
431−
432−{-# RULES "TEXT literal UTF8" forall a.
433− unstream (S.streamList (L.map safe (GHC.unpackCStringUtf8# a)))
434− = unpackCString# a #-}
435−
436−{-# RULES "LAZY TEXT empty literal"
437− unstream (S.streamList (L.map safe []))
438− = Empty #-}
439−
440−{-# RULES "LAZY TEXT empty literal" forall a.
441− unstream (S.streamList (L.map safe [a]))
442− = Chunk (T.singleton a) Empty #-}
443−
444−-- | /O(1)/ Convert a character into a Text. Subject to fusion.
445−-- Performs replacement on invalid scalar values.
446singleton :: Char -> Text
201singleton :: Char -> Text
447singleton c = Chunk (T.singleton c) Empty
202singleton c = Chunk (T.singleton c) Empty
448{-# INLINE [1] singleton #-}
203{-# INLINE [1] singleton #-}
@@ -462,28 +217,10 @@ fromChunks cs = L.foldr chunk Empty cs
462toChunks :: Text -> [T.Text]
217toChunks :: Text -> [T.Text]
463toChunks cs = foldrChunks (:) [] cs
218toChunks cs = foldrChunks (:) [] cs
464
219
465−-- | /O(n)/ Convert a lazy 'Text' into a strict 'T.Text'.
466−toStrict :: Text -> T.Text
467−toStrict t = T.concat (toChunks t)
468−{-# INLINE [1] toStrict #-}
469−
470−-- | /O(c)/ Convert a strict 'T.Text' into a lazy 'Text'.
471−fromStrict :: T.Text -> Text
472−fromStrict t = chunk t Empty
473−{-# INLINE [1] fromStrict #-}
474−
475−-- -----------------------------------------------------------------------------
476−-- * Basic functions
477−
478−-- | /O(n)/ Adds a character to the front of a 'Text'. This function
479−-- is more costly than its 'List' counterpart because it requires
480−-- copying a new array. Subject to fusion.
481cons :: Char -> Text -> Text
220cons :: Char -> Text -> Text
482cons c t = Chunk (T.singleton c) t
221cons c t = Chunk (T.singleton c) t
483{-# INLINE [1] cons #-}
222{-# INLINE [1] cons #-}
484
223
485−infixr 5 `cons`
486−
487{-# RULES
224{-# RULES
488"LAZY TEXT cons -> fused" [~1] forall c t.
225"LAZY TEXT cons -> fused" [~1] forall c t.
489 cons c t = unstream (S.cons c (stream t))
226 cons c t = unstream (S.cons c (stream t))
@@ -491,8 +228,6 @@ infixr 5 `cons`
491 unstream (S.cons c (stream t)) = cons c t
228 unstream (S.cons c (stream t)) = cons c t
492 #-}
229 #-}
493
230
494−-- | /O(n)/ Adds a character to the end of a 'Text'. This copies the
495−-- entire array in the process, unless fused. Subject to fusion.
496snoc :: Text -> Char -> Text
231snoc :: Text -> Char -> Text
497snoc t c = foldrChunks Chunk (singleton c) t
232snoc t c = foldrChunks Chunk (singleton c) t
498{-# INLINE [1] snoc #-}
233{-# INLINE [1] snoc #-}
@@ -504,7 +239,8 @@ snoc t c = foldrChunks Chunk (singleton c) t
504 unstream (S.snoc (stream t) c) = snoc t c
239 unstream (S.snoc (stream t) c) = snoc t c
505 #-}
240 #-}
506
241
507−-- | /O(n\/c)/ Appends one 'Text' to another. Subject to fusion.
242+-- | /O(n\/c)/ Appends one 'Text' to another. Subject to array
243+-- fusion.
508append :: Text -> Text -> Text
244append :: Text -> Text -> Text
509append xs ys = foldrChunks Chunk ys xs
245append xs ys = foldrChunks Chunk ys xs
510{-# INLINE [1] append #-}
246{-# INLINE [1] append #-}
@@ -517,22 +253,22 @@ append xs ys = foldrChunks Chunk ys xs
517 #-}
253 #-}
518
254
519-- | /O(1)/ Returns the first character and rest of a 'Text', or
255-- | /O(1)/ Returns the first character and rest of a 'Text', or
520−-- 'Nothing' if empty. Subject to fusion.
256+-- 'Nothing' if empty. Subject to array fusion.
521uncons :: Text -> Maybe (Char, Text)
257uncons :: Text -> Maybe (Char, Text)
522−uncons Empty = Nothing
258+uncons Empty = Nothing
523−uncons (Chunk t ts) = Just (T.unsafeHead t, ts')
259+uncons (Chunk t ts) =
524− where ts' | T.compareLength t 1 == EQ = ts
260+ Just (T.unsafeHead t,
525− | otherwise = Chunk (T.unsafeTail t) ts
261+ if T.length t == 1 then ts else Chunk (T.unsafeTail t) ts)
526{-# INLINE uncons #-}
262{-# INLINE uncons #-}
527
263
528-- | /O(1)/ Returns the first character of a 'Text', which must be
264-- | /O(1)/ Returns the first character of a 'Text', which must be
529−-- non-empty. Subject to fusion.
265+-- non-empty. Subject to array fusion.
530head :: Text -> Char
266head :: Text -> Char
531head t = S.head (stream t)
267head t = S.head (stream t)
532{-# INLINE head #-}
268{-# INLINE head #-}
533
269
534-- | /O(1)/ Returns all characters after the head of a 'Text', which
270-- | /O(1)/ Returns all characters after the head of a 'Text', which
535−-- must be non-empty. Subject to fusion.
271+-- must be non-empty. Subject to array fusion.
536tail :: Text -> Text
272tail :: Text -> Text
537tail (Chunk t ts) = chunk (T.tail t) ts
273tail (Chunk t ts) = chunk (T.tail t) ts
538tail Empty = emptyError "tail"
274tail Empty = emptyError "tail"
@@ -545,8 +281,8 @@ tail Empty = emptyError "tail"
545 unstream (S.tail (stream t)) = tail t
281 unstream (S.tail (stream t)) = tail t
546 #-}
282 #-}
547
283
548−-- | /O(n\/c)/ Returns all but the last character of a 'Text', which must
284+-- | /O(1)/ Returns all but the last character of a 'Text', which must
549−-- be non-empty. Subject to fusion.
285+-- be non-empty. Subject to array fusion.
550init :: Text -> Text
286init :: Text -> Text
551init (Chunk t0 ts0) = go t0 ts0
287init (Chunk t0 ts0) = go t0 ts0
552 where go t (Chunk t' ts) = Chunk t (go t' ts)
288 where go t (Chunk t' ts) = Chunk t (go t' ts)
@@ -561,7 +297,7 @@ init Empty = emptyError "init"
561 unstream (S.init (stream t)) = init t
297 unstream (S.init (stream t)) = init t
562 #-}
298 #-}
563
299
564−-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
300+-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to array
565-- fusion.
301-- fusion.
566null :: Text -> Bool
302null :: Text -> Bool
567null Empty = True
303null Empty = True
@@ -575,14 +311,8 @@ null _ = False
575 S.null (stream t) = null t
311 S.null (stream t) = null t
576 #-}
312 #-}
577
313
578−-- | /O(1)/ Tests whether a 'Text' contains exactly one character.
314+-- | /O(1)/ Returns the last character of a 'Text', which must be
579−-- Subject to fusion.
315+-- non-empty. Subject to array fusion.
580−isSingleton :: Text -> Bool
581−isSingleton = S.isSingleton . stream
582−{-# INLINE isSingleton #-}
583−
584−-- | /O(n\/c)/ Returns the last character of a 'Text', which must be
585−-- non-empty. Subject to fusion.
586last :: Text -> Char
316last :: Text -> Char
587last Empty = emptyError "last"
317last Empty = emptyError "last"
588last (Chunk t ts) = go t ts
318last (Chunk t ts) = go t ts
@@ -597,8 +327,6 @@ last (Chunk t ts) = go t ts
597 S.last (stream t) = last t
327 S.last (stream t) = last t
598 #-}
328 #-}
599
329
600−-- | /O(n)/ Returns the number of characters in a 'Text'.
601−-- Subject to fusion.
602length :: Text -> Int64
330length :: Text -> Int64
603length = foldlChunks go 0
331length = foldlChunks go 0
604 where go l t = l + fromIntegral (T.length t)
332 where go l t = l + fromIntegral (T.length t)
@@ -611,95 +339,25 @@ length = foldlChunks go 0
611 S.length (stream t) = length t
339 S.length (stream t) = length t
612 #-}
340 #-}
613
341
614−-- | /O(n)/ Compare the count of characters in a 'Text' to a number.
342+-- | /O(n)/ 'map' @f @xs is the 'Text' obtained by applying @f@ to
615−-- Subject to fusion.
343+-- each element of @xs@. Subject to array fusion.
616−--
617−-- This function gives the same answer as comparing against the result
618−-- of 'length', but can short circuit if the count of characters is
619−-- greater than the number, and hence be more efficient.
620−compareLength :: Text -> Int64 -> Ordering
621−compareLength t n = S.compareLengthI (stream t) n
622−{-# INLINE [1] compareLength #-}
623−
624−-- We don't apply those otherwise appealing length-to-compareLength
625−-- rewrite rules here, because they can change the strictness
626−-- properties of code.
627−
628−-- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to
629−-- each element of @t@. Subject to fusion. Performs replacement on
630−-- invalid scalar values.
631map :: (Char -> Char) -> Text -> Text
344map :: (Char -> Char) -> Text -> Text
632−map f t = unstream (S.map (safe . f) (stream t))
345+map f t = unstream (S.map f (stream t))
633{-# INLINE [1] map #-}
346{-# INLINE [1] map #-}
634
347
635-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of
348-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of
636-- 'Text's and concatenates the list after interspersing the first
349-- 'Text's and concatenates the list after interspersing the first
637-- argument between each element of the list.
350-- argument between each element of the list.
638intercalate :: Text -> [Text] -> Text
351intercalate :: Text -> [Text] -> Text
639−intercalate t = concat . (F.intersperse t)
352+intercalate t ts = unstream (S.intercalate (stream t) (L.map stream ts))
640{-# INLINE intercalate #-}
353{-# INLINE intercalate #-}
641
354
642-- | /O(n)/ The 'intersperse' function takes a character and places it
355-- | /O(n)/ The 'intersperse' function takes a character and places it
643−-- between the characters of a 'Text'. Subject to fusion. Performs
356+-- between the characters of a 'Text'. Subject to array fusion.
644−-- replacement on invalid scalar values.
357+intersperse :: Char -> Text -> Text
645−intersperse :: Char -> Text -> Text
358+intersperse c t = unstream (S.intersperse c (stream t))
646−intersperse c t = unstream (S.intersperse (safe c) (stream t))
647{-# INLINE intersperse #-}
359{-# INLINE intersperse #-}
648
360
649−-- | /O(n)/ Left-justify a string to the given length, using the
650−-- specified fill character on the right. Subject to fusion. Performs
651−-- replacement on invalid scalar values.
652−--
653−-- Examples:
654−--
655−-- > justifyLeft 7 'x' "foo" == "fooxxxx"
656−-- > justifyLeft 3 'x' "foobar" == "foobar"
657−justifyLeft :: Int64 -> Char -> Text -> Text
658−justifyLeft k c t
659− | len >= k = t
660− | otherwise = t `append` replicateChar (k-len) c
661− where len = length t
662−{-# INLINE [1] justifyLeft #-}
663−
664−{-# RULES
665−"LAZY TEXT justifyLeft -> fused" [~1] forall k c t.
666− justifyLeft k c t = unstream (S.justifyLeftI k c (stream t))
667−"LAZY TEXT justifyLeft -> unfused" [1] forall k c t.
668− unstream (S.justifyLeftI k c (stream t)) = justifyLeft k c t
669− #-}
670−
671−-- | /O(n)/ Right-justify a string to the given length, using the
672−-- specified fill character on the left. Performs replacement on
673−-- invalid scalar values.
674−--
675−-- Examples:
676−--
677−-- > justifyRight 7 'x' "bar" == "xxxxbar"
678−-- > justifyRight 3 'x' "foobar" == "foobar"
679−justifyRight :: Int64 -> Char -> Text -> Text
680−justifyRight k c t
681− | len >= k = t
682− | otherwise = replicateChar (k-len) c `append` t
683− where len = length t
684−{-# INLINE justifyRight #-}
685−
686−-- | /O(n)/ Center a string to the given length, using the specified
687−-- fill character on either side. Performs replacement on invalid
688−-- scalar values.
689−--
690−-- Examples:
691−--
692−-- > center 8 'x' "HS" = "xxxHSxxx"
693−center :: Int64 -> Char -> Text -> Text
694−center k c t
695− | len >= k = t
696− | otherwise = replicateChar l c `append` t `append` replicateChar r c
697− where len = length t
698− d = k - len
699− r = d `quot` 2
700− l = d - r
701−{-# INLINE center #-}
702−
703-- | /O(n)/ The 'transpose' function transposes the rows and columns
361-- | /O(n)/ The 'transpose' function transposes the rows and columns
704-- of its 'Text' argument. Note that this function uses 'pack',
362-- of its 'Text' argument. Note that this function uses 'pack',
705-- 'unpack', and the list version of transpose, and is thus not very
363-- 'unpack', and the list version of transpose, and is thus not very
@@ -715,40 +373,6 @@ reverse = rev Empty
715 where rev a Empty = a
373 where rev a Empty = a
716 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts
374 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts
717
375
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"
738−--
739−-- In (unlikely) bad cases, this function's time complexity degrades
740−-- 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.
748− -> Text
749−replace s d = intercalate d . splitOn s
750−{-# INLINE replace #-}
751−
752-- ----------------------------------------------------------------------------
376-- ----------------------------------------------------------------------------
753-- ** Case conversions (folds)
377-- ** Case conversions (folds)
754
378
@@ -761,10 +385,9 @@ replace s d = intercalate d . splitOn s
761-- functions may map one input character to two or three output
385-- functions may map one input character to two or three output
762-- characters.
386-- characters.
763
387
764−-- | /O(n)/ Convert a string to folded case. Subject to fusion.
388+-- | /O(n)/ Convert a string to folded case. This function is mainly
765−--
389+-- useful for performing caseless (or case insensitive) string
766−-- This function is mainly useful for performing caseless (or case
390+-- comparisons.
767−-- insensitive) string comparisons.
768--
391--
769-- A string @x@ is a caseless match for a string @y@ if and only if:
392-- A string @x@ is a caseless match for a string @y@ if and only if:
770--
393--
@@ -781,70 +404,45 @@ toCaseFold t = unstream (S.toCaseFold (stream t))
781{-# INLINE [0] toCaseFold #-}
404{-# INLINE [0] toCaseFold #-}
782
405
783-- | /O(n)/ Convert a string to lower case, using simple case
406-- | /O(n)/ Convert a string to lower case, using simple case
784−-- conversion. Subject to fusion.
407+-- conversion. The result string may be longer than the input string.
785−--
408+-- For instance, the Latin capital letter I with dot above (U+0130)
786−-- The result string may be longer than the input string. For
409+-- maps to the sequence Latin small letter i (U+0069) followed by
787−-- instance, the Latin capital letter I with dot above (U+0130) maps
410+-- combining dot above (U+0307).
788−-- to the sequence Latin small letter i (U+0069) followed by combining
789−-- dot above (U+0307).
790toLower :: Text -> Text
411toLower :: Text -> Text
791toLower t = unstream (S.toLower (stream t))
412toLower t = unstream (S.toLower (stream t))
792{-# INLINE toLower #-}
413{-# INLINE toLower #-}
793
414
794-- | /O(n)/ Convert a string to upper case, using simple case
415-- | /O(n)/ Convert a string to upper case, using simple case
795−-- conversion. Subject to fusion.
416+-- conversion. The result string may be longer than the input string.
796−--
417+-- For instance, the German eszett (U+00DF) maps to the two-letter
797−-- The result string may be longer than the input string. For
798−-- instance, the German eszett (U+00DF) maps to the two-letter
799-- sequence SS.
418-- sequence SS.
800toUpper :: Text -> Text
419toUpper :: Text -> Text
801toUpper t = unstream (S.toUpper (stream t))
420toUpper t = unstream (S.toUpper (stream t))
802{-# INLINE toUpper #-}
421{-# INLINE toUpper #-}
803
422
804−
805−-- | /O(n)/ Convert a string to title case, using simple case
806−-- conversion. Subject to fusion.
807−--
808−-- The first letter of the input is converted to title case, as is
809−-- every subsequent letter that immediately follows a non-letter.
810−-- Every letter that immediately follows another letter is converted
811−-- to lower case.
812−--
813−-- The result string may be longer than the input string. For example,
814−-- the Latin small ligature &#xfb02; (U+FB02) is converted to the
815−-- sequence Latin capital letter F (U+0046) followed by Latin small
816−-- letter l (U+006C).
817−--
818−-- /Note/: this function does not take language or culture specific
819−-- rules into account. For instance, in English, different style
820−-- guides disagree on whether the book name \"The Hill of the Red
821−-- Fox\" is correctly title cased&#x2014;but this function will
822−-- capitalize /every/ word.
823−toTitle :: Text -> Text
824−toTitle t = unstream (S.toTitle (stream t))
825−{-# INLINE toTitle #-}
826−
827-- | /O(n)/ 'foldl', applied to a binary operator, a starting value
423-- | /O(n)/ 'foldl', applied to a binary operator, a starting value
828-- (typically the left-identity of the operator), and a 'Text',
424-- (typically the left-identity of the operator), and a 'Text',
829-- reduces the 'Text' using the binary operator, from left to right.
425-- reduces the 'Text' using the binary operator, from left to right.
830−-- Subject to fusion.
426+-- Subject to array fusion.
831−foldl :: (a -> Char -> a) -> a -> Text -> a
427+foldl :: (b -> Char -> b) -> b -> Text -> b
832foldl f z t = S.foldl f z (stream t)
428foldl f z t = S.foldl f z (stream t)
833{-# INLINE foldl #-}
429{-# INLINE foldl #-}
834
430
835-- | /O(n)/ A strict version of 'foldl'.
431-- | /O(n)/ A strict version of 'foldl'.
836−-- Subject to fusion.
432+-- Subject to array fusion.
837−foldl' :: (a -> Char -> a) -> a -> Text -> a
433+foldl' :: (b -> Char -> b) -> b -> Text -> b
838foldl' f z t = S.foldl' f z (stream t)
434foldl' f z t = S.foldl' f z (stream t)
839{-# INLINE foldl' #-}
435{-# INLINE foldl' #-}
840
436
841-- | /O(n)/ A variant of 'foldl' that has no starting value argument,
437-- | /O(n)/ A variant of 'foldl' that has no starting value argument,
842−-- and thus must be applied to a non-empty 'Text'. Subject to fusion.
438+-- and thus must be applied to a non-empty 'Text'. Subject to array
439+-- fusion.
843foldl1 :: (Char -> Char -> Char) -> Text -> Char
440foldl1 :: (Char -> Char -> Char) -> Text -> Char
844foldl1 f t = S.foldl1 f (stream t)
441foldl1 f t = S.foldl1 f (stream t)
845{-# INLINE foldl1 #-}
442{-# INLINE foldl1 #-}
846
443
847−-- | /O(n)/ A strict version of 'foldl1'. Subject to fusion.
444+-- | /O(n)/ A strict version of 'foldl1'.
445+-- Subject to array fusion.
848foldl1' :: (Char -> Char -> Char) -> Text -> Char
446foldl1' :: (Char -> Char -> Char) -> Text -> Char
849foldl1' f t = S.foldl1' f (stream t)
447foldl1' f t = S.foldl1' f (stream t)
850{-# INLINE foldl1' #-}
448{-# INLINE foldl1' #-}
@@ -852,61 +450,59 @@ foldl1' f t = S.foldl1' f (stream t)
852-- | /O(n)/ 'foldr', applied to a binary operator, a starting value
450-- | /O(n)/ 'foldr', applied to a binary operator, a starting value
853-- (typically the right-identity of the operator), and a 'Text',
451-- (typically the right-identity of the operator), and a 'Text',
854-- reduces the 'Text' using the binary operator, from right to left.
452-- reduces the 'Text' using the binary operator, from right to left.
855−-- Subject to fusion.
453+-- Subject to array fusion.
856−foldr :: (Char -> a -> a) -> a -> Text -> a
454+foldr :: (Char -> b -> b) -> b -> Text -> b
857foldr f z t = S.foldr f z (stream t)
455foldr f z t = S.foldr f z (stream t)
858{-# INLINE foldr #-}
456{-# INLINE foldr #-}
859
457
860−-- | /O(n)/ A variant of 'foldr' that has no starting value argument,
458+-- | /O(n)/ A variant of 'foldr' that has no starting value argument, and
861−-- and thus must be applied to a non-empty 'Text'. Subject to
459+-- thust must be applied to a non-empty 'Text'. Subject to array
862-- fusion.
460-- fusion.
863foldr1 :: (Char -> Char -> Char) -> Text -> Char
461foldr1 :: (Char -> Char -> Char) -> Text -> Char
864foldr1 f t = S.foldr1 f (stream t)
462foldr1 f t = S.foldr1 f (stream t)
865{-# INLINE foldr1 #-}
463{-# INLINE foldr1 #-}
866
464
867−-- | /O(n)/ Concatenate a list of 'Text's.
465+-- | /O(n)/ Concatenate a list of 'Text's. Subject to array fusion.
868concat :: [Text] -> Text
466concat :: [Text] -> Text
869−concat = to
467+concat ts = unstream (S.concat (L.map stream ts))
870− where
871− go Empty css = to css
872− go (Chunk c cs) css = Chunk c (go cs css)
873− to [] = Empty
874− to (cs:css) = go cs css
875{-# INLINE concat #-}
468{-# INLINE concat #-}
876
469
877-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and
470-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and
878−-- concatenate the results.
471+-- concatenate the results. This function is subject to array fusion.
472+--
473+-- Note: if in 'concatMap' @f@ @t@, @f@ is defined in terms of fusible
474+-- functions, it will also be fusible.
879concatMap :: (Char -> Text) -> Text -> Text
475concatMap :: (Char -> Text) -> Text -> Text
880−concatMap f = concat . foldr ((:) . f) []
476+concatMap f t = unstream (S.concatMap (stream . f) (stream t))
881{-# INLINE concatMap #-}
477{-# INLINE concatMap #-}
882
478
883-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
479-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
884−-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
480+-- 'Text' @t@ satisifes the predicate @p@. Subject to array fusion.
885any :: (Char -> Bool) -> Text -> Bool
481any :: (Char -> Bool) -> Text -> Bool
886any p t = S.any p (stream t)
482any p t = S.any p (stream t)
887{-# INLINE any #-}
483{-# INLINE any #-}
888
484
889-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
485-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
890−-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
486+-- 'Text' @t@ satisify the predicate @p@. Subject to array fusion.
891all :: (Char -> Bool) -> Text -> Bool
487all :: (Char -> Bool) -> Text -> Bool
892all p t = S.all p (stream t)
488all p t = S.all p (stream t)
893{-# INLINE all #-}
489{-# INLINE all #-}
894
490
895-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which
491-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which
896−-- must be non-empty. Subject to fusion.
492+-- must be non-empty. Subject to array fusion.
897maximum :: Text -> Char
493maximum :: Text -> Char
898maximum t = S.maximum (stream t)
494maximum t = S.maximum (stream t)
899{-# INLINE maximum #-}
495{-# INLINE maximum #-}
900
496
901-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which
497-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which
902−-- must be non-empty. Subject to fusion.
498+-- must be non-empty. Subject to array fusion.
903minimum :: Text -> Char
499minimum :: Text -> Char
904minimum t = S.minimum (stream t)
500minimum t = S.minimum (stream t)
905{-# INLINE minimum #-}
501{-# INLINE minimum #-}
906
502
907-- | /O(n)/ 'scanl' is similar to 'foldl', but returns a list of
503-- | /O(n)/ 'scanl' is similar to 'foldl', but returns a list of
908−-- successive reduced values from the left. Subject to fusion.
504+-- successive reduced values from the left. This function is subject
909−-- Performs replacement on invalid scalar values.
505+-- to array fusion.
910--
506--
911-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
507-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
912--
508--
@@ -914,13 +510,11 @@ minimum t = S.minimum (stream t)
914--
510--
915-- > last (scanl f z xs) == foldl f z xs.
511-- > last (scanl f z xs) == foldl f z xs.
916scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
512scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
917−scanl f z t = unstream (S.scanl g z (stream t))
513+scanl f z t = unstream (S.scanl f z (stream t))
918− where g a b = safe (f a b)
919{-# INLINE scanl #-}
514{-# INLINE scanl #-}
920
515
921-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting
516-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting
922−-- value argument. Subject to fusion. Performs replacement on
517+-- value argument. This function is subject to array fusion.
923−-- invalid scalar values.
924--
518--
925-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
519-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
926scanl1 :: (Char -> Char -> Char) -> Text -> Text
520scanl1 :: (Char -> Char -> Char) -> Text -> Text
@@ -929,99 +523,53 @@ scanl1 f t0 = case uncons t0 of
929 Just (t,ts) -> scanl f t ts
523 Just (t,ts) -> scanl f t ts
930{-# INLINE scanl1 #-}
524{-# INLINE scanl1 #-}
931
525
932−-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'. Performs
526+-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'.
933−-- replacement on invalid scalar values.
934--
527--
935-- > scanr f v == reverse . scanl (flip f) v . reverse
528-- > scanr f v == reverse . scanl (flip f) v . reverse
936scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
529scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
937−scanr f v = reverse . scanl g v . reverse
530+scanr f v = reverse . scanl (flip f) v . reverse
938− where g a b = safe (f b a)
939
531
940-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting
532-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting
941−-- value argument. Performs replacement on invalid scalar values.
533+-- value argument.
942scanr1 :: (Char -> Char -> Char) -> Text -> Text
534scanr1 :: (Char -> Char -> Char) -> Text -> Text
943scanr1 f t | null t = empty
535scanr1 f t | null t = empty
944 | otherwise = scanr f (last t) (init t)
536 | otherwise = scanr f (last t) (init t)
945
537
946−-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
538+-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a
947-- function to each element of a 'Text', passing an accumulating
539-- function to each element of a 'Text', passing an accumulating
948−-- parameter from left to right, and returns a final 'Text'. Performs
540+-- parameter from left to right, and returns a final 'Text'.
949−-- replacement on invalid scalar values.
950mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
541mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
951−mapAccumL f = go
542+mapAccumL f s t = case uncons t of
952− where
543+ Nothing -> (s, empty)
953− go z (Chunk c cs) = (z'', Chunk c' cs')
544+ Just (x, xs) -> (s'', cons y ys)
954− where (z', c') = T.mapAccumL f z c
545+ where (s', y ) = f s x
955− (z'', cs') = go z' cs
546+ (s'',ys) = mapAccumL f s' xs
956− go z Empty = (z, Empty)
957−{-# INLINE mapAccumL #-}
958
547
959-- | The 'mapAccumR' function behaves like a combination of 'map' and
548-- | The 'mapAccumR' function behaves like a combination of 'map' and
960−-- a strict 'foldr'; it applies a function to each element of a
549+-- 'foldr'; it applies a function to each element of a 'Text', passing
961−-- 'Text', passing an accumulating parameter from right to left, and
550+-- an accumulating parameter from right to left, and returning a final
962−-- returning a final value of this accumulator together with the new
551+-- value of this accumulator together with the new 'Text'.
963−-- 'Text'. Performs replacement on invalid scalar values.
964mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
552mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
965−mapAccumR f = go
553+mapAccumR f s t = case uncons t of
966− where
554+ Nothing -> (s, empty)
967− go z (Chunk c cs) = (z'', Chunk c' cs')
555+ Just (x, xs) -> (s'', cons y ys)
968− where (z'', c') = T.mapAccumR f z' c
556+ where (s'',y ) = f s' x
969− (z', cs') = go z cs
557+ (s', ys) = mapAccumR f s xs
970− go z Empty = (z, Empty)
558+
971−{-# INLINE mapAccumR #-}
559+-- | /O(n)/ 'replicate' @n@ @c@ is a 'Text' of length @n@ with @c@ the
972−
560+-- value of every element.
973−-- | @'repeat' x@ is an infinite 'Text', with @x@ the value of every
561+replicate :: Int -> Char -> Text
974−-- element.
562+replicate n c = unstream (S.replicate n c)
975−repeat :: Char -> Text
563+{-# INLINE replicate #-}
976−repeat c = let t = Chunk (T.replicate smallChunkSize (T.singleton c)) t
977− in t
978−
979−-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
980−-- @t@ repeated @n@ times.
981−replicate :: Int64 -> Text -> Text
982−replicate n t
983− | null t || n <= 0 = empty
984− | isSingleton t = replicateChar n (head t)
985− | otherwise = concat (rep 0)
986− where rep !i | i >= n = []
987− | 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
1004−
1005−-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
1006−-- value of every element. Subject to fusion.
1007−replicateChar :: Int64 -> Char -> Text
1008−replicateChar n c = unstream (S.replicateCharI n (safe c))
1009−{-# INLINE replicateChar #-}
1010−
1011−{-# RULES
1012−"LAZY TEXT replicate/singleton -> replicateChar" [~1] forall n c.
1013− replicate n (singleton c) = replicateChar n c
1014− #-}
1015
564
1016-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'
565-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'
1017-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a
566-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a
1018-- 'Text' from a seed value. The function takes the element and
567-- 'Text' from a seed value. The function takes the element and
1019-- returns 'Nothing' if it is done producing the 'Text', otherwise
568-- returns 'Nothing' if it is done producing the 'Text', otherwise
1020-- 'Just' @(a,b)@. In this case, @a@ is the next 'Char' in the
569-- 'Just' @(a,b)@. In this case, @a@ is the next 'Char' in the
1021−-- string, and @b@ is the seed value for further production. Performs
570+-- string, and @b@ is the seed value for further production.
1022−-- replacement on invalid scalar values.
571+unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
1023−unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
572+unfoldr f s = unstream (S.unfoldr f s)
1024−unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
1025{-# INLINE unfoldr #-}
573{-# INLINE unfoldr #-}
1026
574
1027-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed
575-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed
@@ -1029,9 +577,8 @@ unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
1029-- first argument to 'unfoldrN'. This function is more efficient than
577-- first argument to 'unfoldrN'. This function is more efficient than
1030-- 'unfoldr' when the maximum length of the result is known and
578-- 'unfoldr' when the maximum length of the result is known and
1031-- correct, otherwise its performance is similar to 'unfoldr'.
579-- correct, otherwise its performance is similar to 'unfoldr'.
1032−-- Performs replacement on invalid scalar values.
580+unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Text
1033−unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Text
581+unfoldrN n f s = unstream (S.unfoldrN n f s)
1034−unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)
1035{-# INLINE unfoldrN #-}
582{-# INLINE unfoldrN #-}
1036
583
1037-- | /O(n)/ 'take' @n@, applied to a 'Text', returns the prefix of the
584-- | /O(n)/ 'take' @n@, applied to a 'Text', returns the prefix of the
@@ -1055,35 +602,19 @@ take i t0 = take' i t0
1055 unstream (S.take n (stream t)) = take n t
602 unstream (S.take n (stream t)) = take n t
1056 #-}
603 #-}
1057
604
1058−-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after
1059−-- taking @n@ characters from the end of @t@.
1060−--
1061−-- Examples:
1062−--
1063−-- > takeEnd 3 "foobar" == "bar"
1064−takeEnd :: Int64 -> Text -> Text
1065−takeEnd n t0
1066− | n <= 0 = empty
1067− | otherwise = takeChunk n empty . L.reverse . toChunks $ t0
1068− where takeChunk _ acc [] = acc
1069− takeChunk i acc (t:ts)
1070− | i <= l = chunk (T.takeEnd (fromIntegral i) t) acc
1071− | otherwise = takeChunk (i-l) (Chunk t acc) ts
1072− where l = fromIntegral (T.length t)
1073−
1074-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
605-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1075−-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
606+-- 'Text' of length @n@, or the empty 'Text' if @n@ is greater than the
1076−-- is greater than the length of the 'Text'. Subject to fusion.
607+-- length of the 'Text'. Subject to fusion.
1077−drop :: Int64 -> Text -> Text
608+drop :: Int -> Text -> Text
1078drop i t0
609drop i t0
1079− | i <= 0 = t0
610+ | i <= 0 = t0
1080 | otherwise = drop' i t0
611 | otherwise = drop' i t0
1081 where drop' 0 ts = ts
612 where drop' 0 ts = ts
1082 drop' _ Empty = Empty
613 drop' _ Empty = Empty
1083− drop' n (Chunk t ts)
614+ drop' n (Chunk t ts)
1084− | n < len = Chunk (T.drop (fromIntegral n) t) ts
615+ | n < len = Chunk (T.drop (fromIntegral n) t) ts
1085 | otherwise = drop' (n - len) ts
616 | otherwise = drop' (n - len) ts
1086− where len = fromIntegral (T.length t)
617+ where len = fromIntegral (T.length t)
1087{-# INLINE [1] drop #-}
618{-# INLINE [1] drop #-}
1088
619
1089{-# RULES
620{-# RULES
@@ -1093,41 +624,9 @@ drop i t0
1093 unstream (S.drop n (stream t)) = drop n t
624 unstream (S.drop n (stream t)) = drop n t
1094 #-}
625 #-}
1095
626
1096−-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after
627+-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text', returns
1097−-- dropping @n@ characters from the end of @t@.
628+-- the longest prefix (possibly empty) of elements that satisfy @p@.
1098−--
629+-- This function is subject to array fusion.
1099−-- Examples:
1100−--
1101−-- > dropEnd 3 "foobar" == "foo"
1102−dropEnd :: Int64 -> Text -> Text
1103−dropEnd n t0
1104− | n <= 0 = t0
1105− | otherwise = dropChunk n . L.reverse . toChunks $ t0
1106− where dropChunk _ [] = empty
1107− dropChunk m (t:ts)
1108− | m >= l = dropChunk (m-l) ts
1109− | otherwise = fromChunks . L.reverse $
1110− T.dropEnd (fromIntegral m) t : ts
1111− where l = fromIntegral (T.length t)
1112−
1113−-- | /O(n)/ 'dropWords' @n@ returns the suffix with @n@ 'Word16'
1114−-- values dropped, or the empty 'Text' if @n@ is greater than the
1115−-- number of 'Word16' values present.
1116−dropWords :: Int64 -> Text -> Text
1117−dropWords i t0
1118− | i <= 0 = t0
1119− | otherwise = drop' i t0
1120− where drop' 0 ts = ts
1121− drop' _ Empty = Empty
1122− drop' n (Chunk (T.Text arr off len) ts)
1123− | n < len' = chunk (text arr (off+n') (len-n')) ts
1124− | otherwise = drop' (n - len') ts
1125− where len' = fromIntegral len
1126− n' = fromIntegral n
1127−
1128−-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1129−-- returns the longest prefix (possibly empty) of elements that
1130−-- satisfy @p@. Subject to fusion.
1131takeWhile :: (Char -> Bool) -> Text -> Text
630takeWhile :: (Char -> Bool) -> Text -> Text
1132takeWhile p t0 = takeWhile' t0
631takeWhile p t0 = takeWhile' t0
1133 where takeWhile' Empty = Empty
632 where takeWhile' Empty = Empty
@@ -1144,23 +643,9 @@ takeWhile p t0 = takeWhile' t0
1144"LAZY TEXT takeWhile -> unfused" [1] forall p t.
643"LAZY TEXT takeWhile -> unfused" [1] forall p t.
1145 unstream (S.takeWhile p (stream t)) = takeWhile p t
644 unstream (S.takeWhile p (stream t)) = takeWhile p t
1146 #-}
645 #-}
1147−-- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',
646+
1148−-- returns the longest suffix (possibly empty) of elements that
647+-- | /O(n)/ 'dropWhile' @p@ @xs@ returns the suffix remaining after
1149−-- satisfy @p@.
648+-- 'takeWhile' @p@ @xs@. This function is subject to array fusion.
1150−-- Examples:
1151−--
1152−-- > takeWhileEnd (=='o') "foo" == "oo"
1153−takeWhileEnd :: (Char -> Bool) -> Text -> Text
1154−takeWhileEnd p = takeChunk empty . L.reverse . toChunks
1155− where takeChunk acc [] = acc
1156− takeChunk acc (t:ts) = if T.length t' < T.length t
1157− then (Chunk t' acc)
1158− else takeChunk (Chunk t' acc) ts
1159− where t' = T.takeWhileEnd p t
1160−{-# INLINE takeWhileEnd #-}
1161−
1162−-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1163−-- 'takeWhile' @p@ @t@. Subject to fusion.
1164dropWhile :: (Char -> Bool) -> Text -> Text
649dropWhile :: (Char -> Bool) -> Text -> Text
1165dropWhile p t0 = dropWhile' t0
650dropWhile p t0 = dropWhile' t0
1166 where dropWhile' Empty = Empty
651 where dropWhile' Empty = Empty
@@ -1177,54 +662,6 @@ dropWhile p t0 = dropWhile' t0
1177 unstream (S.dropWhile p (stream t)) = dropWhile p t
662 unstream (S.dropWhile p (stream t)) = dropWhile p t
1178 #-}
663 #-}
1179
664
1180−-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1181−-- dropping characters that satisfy the predicate @p@ from the end of
1182−-- @t@.
1183−--
1184−-- Examples:
1185−--
1186−-- > dropWhileEnd (=='.') "foo..." == "foo"
1187−dropWhileEnd :: (Char -> Bool) -> Text -> Text
1188−dropWhileEnd p = go
1189− where go Empty = Empty
1190− go (Chunk t Empty) = if T.null t'
1191− then Empty
1192− else Chunk t' Empty
1193− where t' = T.dropWhileEnd p t
1194− go (Chunk t ts) = case go ts of
1195− Empty -> go (Chunk t Empty)
1196− ts' -> Chunk t ts'
1197−{-# INLINE dropWhileEnd #-}
1198−
1199−-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1200−-- dropping characters that satisfy the predicate @p@ from both the
1201−-- beginning and end of @t@. Subject to fusion.
1202−dropAround :: (Char -> Bool) -> Text -> Text
1203−dropAround p = dropWhile p . dropWhileEnd p
1204−{-# INLINE [1] dropAround #-}
1205−
1206−-- | /O(n)/ Remove leading white space from a string. Equivalent to:
1207−--
1208−-- > dropWhile isSpace
1209−stripStart :: Text -> Text
1210−stripStart = dropWhile isSpace
1211−{-# INLINE [1] stripStart #-}
1212−
1213−-- | /O(n)/ Remove trailing white space from a string. Equivalent to:
1214−--
1215−-- > dropWhileEnd isSpace
1216−stripEnd :: Text -> Text
1217−stripEnd = dropWhileEnd isSpace
1218−{-# INLINE [1] stripEnd #-}
1219−
1220−-- | /O(n)/ Remove leading and trailing white space from a string.
1221−-- Equivalent to:
1222−--
1223−-- > dropAround isSpace
1224−strip :: Text -> Text
1225−strip = dropAround isSpace
1226−{-# INLINE [1] strip #-}
1227−
1228-- | /O(n)/ 'splitAt' @n t@ returns a pair whose first element is a
665-- | /O(n)/ 'splitAt' @n t@ returns a pair whose first element is a
1229-- prefix of @t@ of length @n@, and whose second is the remainder of
666-- prefix of @t@ of length @n@, and whose second is the remainder of
1230-- the string. It is equivalent to @('take' n t, 'drop' n t)@.
667-- the string. It is equivalent to @('take' n t, 'drop' n t)@.
@@ -1239,95 +676,6 @@ splitAt = loop
1239 in (Chunk t ts', ts'')
676 in (Chunk t ts', ts'')
1240 where len = fromIntegral (T.length t)
677 where len = fromIntegral (T.length t)
1241
678
1242−-- | /O(n)/ 'splitAtWord' @n t@ returns a strict pair whose first
1243−-- element is a prefix of @t@ whose chunks contain @n@ 'Word16'
1244−-- values, and whose second is the remainder of the string.
1245−splitAtWord :: Int64 -> Text -> PairS Text Text
1246−splitAtWord _ Empty = empty :*: empty
1247−splitAtWord x (Chunk c@(T.Text arr off len) cs)
1248− | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1249− in Chunk c h :*: t
1250− | otherwise = chunk (text arr off y) empty :*:
1251− chunk (text arr (off+y) (len-y)) cs
1252− where y = fromIntegral x
1253−
1254−-- | /O(n+m)/ Find the first instance of @needle@ (which must be
1255−-- non-'null') in @haystack@. The first element of the returned tuple
1256−-- is the prefix of @haystack@ before @needle@ is matched. The second
1257−-- is the remainder of @haystack@, starting with the match.
1258−--
1259−-- Examples:
1260−--
1261−-- > breakOn "::" "a::b::c" ==> ("a", "::b::c")
1262−-- > breakOn "/" "foobar" ==> ("foobar", "")
1263−--
1264−-- Laws:
1265−--
1266−-- > append prefix match == haystack
1267−-- > where (prefix, match) = breakOn needle haystack
1268−--
1269−-- If you need to break a string by a substring repeatedly (e.g. you
1270−-- want to break on every instance of a substring), use 'breakOnAll'
1271−-- instead, as it has lower startup overhead.
1272−--
1273−-- This function is strict in its first argument, and lazy in its
1274−-- second.
1275−--
1276−-- In (unlikely) bad cases, this function's time complexity degrades
1277−-- towards /O(n*m)/.
1278−breakOn :: Text -> Text -> (Text, Text)
1279−breakOn pat src
1280− | null pat = emptyError "breakOn"
1281− | otherwise = case indices pat src of
1282− [] -> (src, empty)
1283− (x:_) -> let h :*: t = splitAtWord x src
1284− in (h, t)
1285−
1286−-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the string.
1287−--
1288−-- The first element of the returned tuple is the prefix of @haystack@
1289−-- up to and including the last match of @needle@. The second is the
1290−-- remainder of @haystack@, following the match.
1291−--
1292−-- > breakOnEnd "::" "a::b::c" ==> ("a::b::", "c")
1293−breakOnEnd :: Text -> Text -> (Text, Text)
1294−breakOnEnd pat src = let (a,b) = breakOn (reverse pat) (reverse src)
1295− in (reverse b, reverse a)
1296−{-# INLINE breakOnEnd #-}
1297−
1298−-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in
1299−-- @haystack@. Each element of the returned list consists of a pair:
1300−--
1301−-- * The entire string prior to the /k/th match (i.e. the prefix)
1302−--
1303−-- * The /k/th match, followed by the remainder of the string
1304−--
1305−-- Examples:
1306−--
1307−-- > breakOnAll "::" ""
1308−-- > ==> []
1309−-- > breakOnAll "/" "a/b/c/"
1310−-- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]
1311−--
1312−-- This function is strict in its first argument, and lazy in its
1313−-- second.
1314−--
1315−-- In (unlikely) bad cases, this function's time complexity degrades
1316−-- towards /O(n*m)/.
1317−--
1318−-- The @needle@ parameter may not be empty.
1319−breakOnAll :: Text -- ^ @needle@ to search for
1320− -> Text -- ^ @haystack@ in which to search
1321− -> [(Text, Text)]
1322−breakOnAll pat src
1323− | null pat = emptyError "breakOnAll"
1324− | otherwise = go 0 empty src (indices pat src)
1325− where
1326− go !n p s (x:xs) = let h :*: t = splitAtWord (x-n) s
1327− h' = append p h
1328− in (h',t) : go x h' t xs
1329− go _ _ _ _ = []
1330−
1331-- | /O(n)/ 'break' is like 'span', but the prefix returned is over
679-- | /O(n)/ 'break' is like 'span', but the prefix returned is over
1332-- elements that fail the predicate @p@.
680-- elements that fail the predicate @p@.
1333break :: (Char -> Bool) -> Text -> (Text, Text)
681break :: (Char -> Bool) -> Text -> (Text, Text)
@@ -1341,10 +689,10 @@ break p t0 = break' t0
1341 | otherwise -> let (a,b) = T.splitAt n t
689 | otherwise -> let (a,b) = T.splitAt n t
1342 in (Chunk a Empty, Chunk b ts)
690 in (Chunk a Empty, Chunk b ts)
1343
691
1344−-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
692+-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns a
1345−-- a pair whose first element is the longest prefix (possibly empty)
693+-- pair whose first element is the longest prefix (possibly empty) of
1346−-- of @t@ of elements that satisfy @p@, and whose second is the
694+-- @t@ of elements that satisfy @p@, and whose second is the remainder
1347−-- remainder of the list.
695+-- of the list.
1348span :: (Char -> Bool) -> Text -> (Text, Text)
696span :: (Char -> Bool) -> Text -> (Text, Text)
1349span p = break (not . p)
697span p = break (not . p)
1350{-# INLINE span #-}
698{-# INLINE span #-}
@@ -1386,86 +734,40 @@ tails ts@(Chunk t ts')
1386 | T.length t == 1 = ts : tails ts'
734 | T.length t == 1 = ts : tails ts'
1387 | otherwise = ts : tails (Chunk (T.unsafeTail t) ts')
735 | otherwise = ts : tails (Chunk (T.unsafeTail t) ts')
1388
736
1389−-- $split
737+-- | /O(n)/ Break a 'Text' into pieces separated by the byte
1390−--
738+-- argument, consuming the delimiter. I.e.
1391−-- Splitting functions in this library do not perform character-wise
1392−-- copies to create substrings; they just construct new 'Text's that
1393−-- are slices of the original.
1394−
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.
1399−--
1400−-- Examples:
1401−--
1402−-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]
1403−-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]
1404−-- > splitOn "x" "x" == ["",""]
1405--
739--
740+-- > split '\n' "a\nb\nd\ne" == ["a","b","d","e"]
741+-- > split 'a' "aXaXaXa" == ["","X","X","X",""]
742+-- > split 'x' "x" == ["",""]
743+--
1406-- and
744-- and
1407--
745--
1408−-- > intercalate s . splitOn s == id
746+-- > intercalate [c] . split c == id
1409−-- > splitOn (singleton c) == split (==c)
747+-- > split == splitWith . (==)
1410−--
748+--
1411−-- (Note: the string @s@ to split on above cannot be empty.)
749+-- As for all splitting functions in this library, this function does
1412−--
750+-- not copy the substrings, it just constructs new 'Text's that are
1413−-- This function is strict in its first argument, and lazy in its
751+-- slices of the original.
1414−-- second.
752+split :: Char -> Text -> [Text]
1415−--
753+split c = splitWith (==c)
1416−-- In (unlikely) bad cases, this function's time complexity degrades
754+{-# INLINE split #-}
1417−-- 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.
1423− -> [Text]
1424−splitOn pat src
1425− | null pat = emptyError "splitOn"
1426− | isSingleton pat = split (== head pat) src
1427− | otherwise = go 0 (indices pat src) src
1428− where
1429− go _ [] cs = [cs]
1430− go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs
1431− in h : go (x+l) xs (dropWords l t)
1432− l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat
1433−{-# INLINE [1] splitOn #-}
1434−
1435−{-# RULES
1436−"LAZY TEXT splitOn/singleton -> split/==" [~1] forall c t.
1437− splitOn (singleton c) t = split (==c) t
1438− #-}
1439
755
1440-- | /O(n)/ Splits a 'Text' into components delimited by separators,
756-- | /O(n)/ Splits a 'Text' into components delimited by separators,
1441-- where the predicate returns True for a separator element. The
757-- where the predicate returns True for a separator element. The
1442-- resulting components do not contain the separators. Two adjacent
758-- resulting components do not contain the separators. Two adjacent
1443-- separators result in an empty component in the output. eg.
759-- separators result in an empty component in the output. eg.
1444--
760--
1445−-- > split (=='a') "aabbaca" == ["","","bb","c",""]
761+-- > splitWith (=='a') "aabbaca" == ["","","bb","c",""]
1446−-- > split (=='a') [] == [""]
762+-- > splitWith (=='a') [] == []
1447−split :: (Char -> Bool) -> Text -> [Text]
763+splitWith :: (Char -> Bool) -> Text -> [Text]
1448−split _ Empty = [Empty]
764+splitWith _ Empty = []
1449−split p (Chunk t0 ts0) = comb [] (T.split p t0) ts0
765+splitWith p (Chunk t0 ts0) = comb [] (T.splitWith p t0) ts0
1450 where comb acc (s:[]) Empty = revChunks (s:acc) : []
766 where comb acc (s:[]) Empty = revChunks (s:acc) : []
1451− comb acc (s:[]) (Chunk t ts) = comb (s:acc) (T.split p t) ts
767+ comb acc (s:[]) (Chunk t ts) = comb (s:acc) (T.splitWith p t) ts
1452 comb acc (s:ss) ts = revChunks (s:acc) : comb [] ss ts
768 comb acc (s:ss) ts = revChunks (s:acc) : comb [] ss ts
1453− comb _ [] _ = impossibleError "split"
769+ comb _ [] _ = impossibleError "splitWith"
1454−{-# INLINE split #-}
770+{-# INLINE splitWith #-}
1455−
1456−-- | /O(n)/ Splits a 'Text' into components of length @k@. The last
1457−-- element may be shorter than the other chunks, depending on the
1458−-- length of the input. Examples:
1459−--
1460−-- > chunksOf 3 "foobarbaz" == ["foo","bar","baz"]
1461−-- > chunksOf 4 "haskell.org" == ["hask","ell.","org"]
1462−chunksOf :: Int64 -> Text -> [Text]
1463−chunksOf k = go
1464− where
1465− go t = case splitAt k t of
1466− (a,b) | null a -> []
1467− | otherwise -> a : go b
1468−{-# INLINE chunksOf #-}
1469
771
1470-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at
772-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at
1471-- newline 'Char's. The resulting strings do not contain newlines.
773-- newline 'Char's. The resulting strings do not contain newlines.
@@ -1478,7 +780,7 @@ lines t = let (l,t') = break ((==) '\n') t
1478-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
780-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1479-- representing white space.
781-- representing white space.
1480words :: Text -> [Text]
782words :: Text -> [Text]
1481−words = L.filter (not . null) . split isSpace
783+words = L.filter (not . null) . splitWith isSpace
1482{-# INLINE words #-}
784{-# INLINE words #-}
1483
785
1484-- | /O(n)/ Joins lines, after appending a terminating newline to
786-- | /O(n)/ Joins lines, after appending a terminating newline to
@@ -1493,7 +795,8 @@ unwords = intercalate (singleton ' ')
1493{-# INLINE unwords #-}
795{-# INLINE unwords #-}
1494
796
1495-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns
797-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns
1496−-- 'True' iff the first is a prefix of the second. Subject to fusion.
798+-- 'True' iff the first is a prefix of the second. This function is
799+-- subject to fusion.
1497isPrefixOf :: Text -> Text -> Bool
800isPrefixOf :: Text -> Text -> Bool
1498isPrefixOf Empty _ = True
801isPrefixOf Empty _ = True
1499isPrefixOf _ Empty = False
802isPrefixOf _ Empty = False
@@ -1521,101 +824,18 @@ isSuffixOf x y = reverse x `isPrefixOf` reverse y
1521{-# INLINE isSuffixOf #-}
824{-# INLINE isSuffixOf #-}
1522-- TODO: a better implementation
825-- TODO: a better implementation
1523
826
1524−-- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns
827+-- | /O(n)/ The 'isInfixOf' function takes two 'Text's and returns
1525-- 'True' iff the first is contained, wholly and intact, anywhere
828-- 'True' iff the first is contained, wholly and intact, anywhere
1526-- within the second.
829-- within the second.
1527−--
1528−-- This function is strict in its first argument, and lazy in its
1529−-- second.
1530−--
1531−-- In (unlikely) bad cases, this function's time complexity degrades
1532−-- towards /O(n*m)/.
1533isInfixOf :: Text -> Text -> Bool
830isInfixOf :: Text -> Text -> Bool
1534−isInfixOf needle haystack
831+isInfixOf needle haystack = L.any (isPrefixOf needle) (tails haystack)
1535− | null needle = True
832+{-# INLINE isInfixOf #-}
1536− | isSingleton needle = S.elem (head needle) . S.stream $ haystack
833+-- TODO: a better implementation
1537− | otherwise = not . L.null . indices needle $ haystack
1538−{-# INLINE [1] isInfixOf #-}
1539−
1540−{-# RULES
1541−"LAZY TEXT isInfixOf/singleton -> S.elem/S.stream" [~1] forall n h.
1542− isInfixOf (singleton n) h = S.elem n (S.stream h)
1543− #-}
1544
834
1545−-------------------------------------------------------------------------------
835+-- | /O(n)/ 'elem' is the 'Text' membership predicate.
1546−-- * View patterns
836+elem :: Char -> Text -> Bool
1547−
837+elem c t = S.elem c (stream t)
1548−-- | /O(n)/ Return the suffix of the second string if its prefix
838+{-# INLINE elem #-}
1549−-- matches the entire first string.
1550−--
1551−-- Examples:
1552−--
1553−-- > stripPrefix "foo" "foobar" == Just "bar"
1554−-- > stripPrefix "" "baz" == Just "baz"
1555−-- > stripPrefix "foo" "quux" == Nothing
1556−--
1557−-- This is particularly useful with the @ViewPatterns@ extension to
1558−-- GHC, as follows:
1559−--
1560−-- > {-# LANGUAGE ViewPatterns #-}
1561−-- > import Data.Text.Lazy as T
1562−-- >
1563−-- > fnordLength :: Text -> Int
1564−-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf
1565−-- > fnordLength _ = -1
1566−stripPrefix :: Text -> Text -> Maybe Text
1567−stripPrefix p t
1568− | null p = Just t
1569− | otherwise = case commonPrefixes p t of
1570− Just (_,c,r) | null c -> Just r
1571− _ -> Nothing
1572−
1573−-- | /O(n)/ Find the longest non-empty common prefix of two strings
1574−-- and return it, along with the suffixes of each string at which they
1575−-- no longer match.
1576−--
1577−-- If the strings do not have a common prefix or either one is empty,
1578−-- this function returns 'Nothing'.
1579−--
1580−-- Examples:
1581−--
1582−-- > commonPrefixes "foobar" "fooquux" == Just ("foo","bar","quux")
1583−-- > commonPrefixes "veeble" "fetzer" == Nothing
1584−-- > commonPrefixes "" "baz" == Nothing
1585−commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)
1586−commonPrefixes Empty _ = Nothing
1587−commonPrefixes _ Empty = Nothing
1588−commonPrefixes a0 b0 = Just (go a0 b0 [])
1589− where
1590− go t0@(Chunk x xs) t1@(Chunk y ys) ps
1591− = case T.commonPrefixes x y of
1592− Just (p,a,b)
1593− | T.null a -> go xs (chunk b ys) (p:ps)
1594− | T.null b -> go (chunk a xs) ys (p:ps)
1595− | otherwise -> (fromChunks (L.reverse (p:ps)),chunk a xs, chunk b ys)
1596− Nothing -> (fromChunks (L.reverse ps),t0,t1)
1597− go t0 t1 ps = (fromChunks (L.reverse ps),t0,t1)
1598−
1599−-- | /O(n)/ Return the prefix of the second string if its suffix
1600−-- matches the entire first string.
1601−--
1602−-- Examples:
1603−--
1604−-- > stripSuffix "bar" "foobar" == Just "foo"
1605−-- > stripSuffix "" "baz" == Just "baz"
1606−-- > stripSuffix "foo" "quux" == Nothing
1607−--
1608−-- This is particularly useful with the @ViewPatterns@ extension to
1609−-- GHC, as follows:
1610−--
1611−-- > {-# LANGUAGE ViewPatterns #-}
1612−-- > import Data.Text.Lazy as T
1613−-- >
1614−-- > quuxLength :: Text -> Int
1615−-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre
1616−-- > quuxLength _ = -1
1617−stripSuffix :: Text -> Text -> Maybe Text
1618−stripSuffix p t = reverse `fmap` stripPrefix (reverse p) (reverse t)
1619
839
1620-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
840-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
1621-- returns a 'Text' containing those characters that satisfy the
841-- returns a 'Text' containing those characters that satisfy the
@@ -1624,11 +844,11 @@ filter :: (Char -> Bool) -> Text -> Text
1624filter p t = unstream (S.filter p (stream t))
844filter p t = unstream (S.filter p (stream t))
1625{-# INLINE filter #-}
845{-# INLINE filter #-}
1626
846
1627−-- | /O(n)/ The 'find' function takes a predicate and a 'Text', and
847+-- | /O(n)/ The 'find' function takes a predicate and a 'Text',
1628−-- returns the first element in matching the predicate, or 'Nothing'
848+-- and returns the first element in matching the predicate, or 'Nothing'
1629-- if there is no such element.
849-- if there is no such element.
1630find :: (Char -> Bool) -> Text -> Maybe Char
850find :: (Char -> Bool) -> Text -> Maybe Char
1631−find p t = S.findBy p (stream t)
851+find p t = S.find p (stream t)
1632{-# INLINE find #-}
852{-# INLINE find #-}
1633
853
1634-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',
854-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',
@@ -1645,29 +865,41 @@ index :: Text -> Int64 -> Char
1645index t n = S.index (stream t) n
865index t n = S.index (stream t) n
1646{-# INLINE index #-}
866{-# INLINE index #-}
1647
867
1648−-- | /O(n+m)/ The 'count' function returns the number of times the
868+-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'
1649−-- query string appears in the given 'Text'. An empty query string is
869+-- and returns the index of the first element in the 'Text' satisfying
1650−-- invalid, and will cause an error to be raised.
870+-- the predicate. This function is subject to fusion.
1651−--
871+findIndex :: (Char -> Bool) -> Text -> Maybe Int64
1652−-- In (unlikely) bad cases, this function's time complexity degrades
872+findIndex p t = S.findIndex p (stream t)
1653−-- towards /O(n*m)/.
873+{-# INLINE findIndex #-}
1654−count :: Text -> Text -> Int64
874+
1655−count pat src
875+-- | The 'findIndices' function extends 'findIndex', by returning the
1656− | null pat = emptyError "count"
876+-- indices of all elements satisfying the predicate, in ascending
1657− | otherwise = go 0 (indices pat src)
877+-- order. This function is subject to fusion.
1658− where go !n [] = n
878+findIndices :: (Char -> Bool) -> Text -> [Int64]
1659− go !n (_:xs) = go (n+1) xs
879+findIndices p t = S.findIndices p (stream t)
1660−{-# INLINE [1] count #-}
880+{-# INLINE findIndices #-}
1661−
881+
1662−{-# RULES
882+-- | /O(n)/ The 'elemIndex' function returns the index of the first
1663−"LAZY TEXT count/singleton -> countChar" [~1] forall c t.
883+-- element in the given 'Text' which is equal to the query element, or
1664− count (singleton c) t = countChar c t
884+-- 'Nothing' if there is no such element. This function is subject to
1665− #-}
885+-- fusion.
1666−
886+elemIndex :: Char -> Text -> Maybe Int64
1667−-- | /O(n)/ The 'countChar' function returns the number of times the
887+elemIndex c t = S.elemIndex c (stream t)
1668−-- query element appears in the given 'Text'. Subject to fusion.
888+{-# INLINE elemIndex #-}
1669−countChar :: Char -> Text -> Int64
889+
1670−countChar c t = S.countChar c (stream t)
890+-- | /O(n)/ The 'elemIndices' function returns the index of every
891+-- element in the given 'Text' which is equal to the query
892+-- element. This function is subject to fusion.
893+elemIndices :: Char -> Text -> [Int64]
894+elemIndices c t = S.elemIndices c (stream t)
895+{-# INLINE elemIndices #-}
896+
897+-- | /O(n)/ The 'count' function returns the number of times the query
898+-- element appears in the given 'Text'. This function is subject to
899+-- fusion.
900+count :: Char -> Text -> Int64
901+count c t = S.count c (stream t)
902+{-# INLINE count #-}
1671
903
1672-- | /O(n)/ 'zip' takes two 'Text's and returns a list of
904-- | /O(n)/ 'zip' takes two 'Text's and returns a list of
1673-- corresponding pairs of bytes. If one input 'Text' is short,
905-- corresponding pairs of bytes. If one input 'Text' is short,
@@ -1679,10 +911,8 @@ zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1679
911
1680-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
912-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1681-- given as the first argument, instead of a tupling function.
913-- given as the first argument, instead of a tupling function.
1682−-- Performs replacement on invalid scalar values.
1683zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
914zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1684−zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
915+zipWith f t1 t2 = unstream (S.zipWith f (stream t1) (stream t2))
1685− where g a b = safe (f a b)
1686{-# INLINE [0] zipWith #-}
916{-# INLINE [0] zipWith #-}
1687
917
1688revChunks :: [T.Text] -> Text
918revChunks :: [T.Text] -> Text
Data/Text/Lazy/Builder.hsdeleted−58
@@ -1,58 +0,0 @@
1−{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
2−#if __GLASGOW_HASKELL__ >= 702
3−{-# LANGUAGE Trustworthy #-}
4−#endif
5−
6−-----------------------------------------------------------------------------
7−-- |
8−-- Module : Data.Text.Lazy.Builder
9−-- Copyright : (c) 2013 Bryan O'Sullivan
10−-- (c) 2010 Johan Tibell
11−-- License : BSD-style (see LICENSE)
12−--
13−-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
14−-- Stability : experimental
15−-- Portability : portable to Hugs and GHC
16−--
17−-- Efficient construction of lazy @Text@ values. The principal
18−-- operations on a @Builder@ are @singleton@, @fromText@, and
19−-- @fromLazyText@, which construct new builders, and 'mappend', which
20−-- concatenates two builders.
21−--
22−-- To get maximum performance when building lazy @Text@ values using a
23−-- builder, associate @mappend@ calls to the right. For example,
24−-- prefer
25−--
26−-- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')
27−--
28−-- to
29−--
30−-- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'
31−--
32−-- as the latter associates @mappend@ to the left. Or, equivalently,
33−-- prefer
34−--
35−-- > singleton 'a' <> singleton 'b' <> singleton 'c'
36−--
37−-- since the '<>' from recent versions of 'Data.Monoid' associates
38−-- to the right.
39−
40−-----------------------------------------------------------------------------
41−
42−module Data.Text.Lazy.Builder
43− ( -- * The Builder type
44− Builder
45− , toLazyText
46− , toLazyTextWith
47−
48− -- * Constructing Builders
49− , singleton
50− , fromText
51− , fromLazyText
52− , fromString
53−
54− -- * Flushing the buffer state
55− , flush
56− ) where
57−
58−import Data.Text.Internal.Builder
Data/Text/Lazy/Builder/Int.hsdeleted−262
@@ -1,262 +0,0 @@
1−{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,
2− UnboxedTuples #-}
3−#if __GLASGOW_HASKELL__ >= 702
4−{-# LANGUAGE Trustworthy #-}
5−#endif
6−
7−-- Module: Data.Text.Lazy.Builder.Int
8−-- Copyright: (c) 2013 Bryan O'Sullivan
9−-- (c) 2011 MailRank, Inc.
10−-- License: BSD-style
11−-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
12−-- Stability: experimental
13−-- Portability: portable
14−--
15−-- Efficiently write an integral value to a 'Builder'.
16−
17−module Data.Text.Lazy.Builder.Int
18− (
19− decimal
20− , hexadecimal
21− ) where
22−
23−import Data.Int (Int8, Int16, Int32, Int64)
24−import Data.Monoid (mempty)
25−import 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)
29−import Data.Text.Array
30−import Data.Word (Word, Word8, Word16, Word32, Word64)
31−import GHC.Base (quotInt, remInt)
32−import GHC.Num (quotRemInteger)
33−import GHC.Types (Int(..))
34−import Control.Monad.ST
35−
36−#ifdef __GLASGOW_HASKELL__
37−# if defined(INTEGER_GMP)
38−import GHC.Integer.GMP.Internals (Integer(S#))
39−# elif defined(INTEGER_SIMPLE)
40−import GHC.Integer
41−# else
42−# error "You need to use either GMP or integer-simple."
43−# endif
44−#endif
45−
46−#if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE)
47−# define PAIR(a,b) (# a,b #)
48−#else
49−# define PAIR(a,b) (a,b)
50−#endif
51−
52−decimal :: Integral a => a -> Builder
53−{-# RULES "decimal/Int8" decimal = boundedDecimal :: Int8 -> Builder #-}
54−{-# RULES "decimal/Int" decimal = boundedDecimal :: Int -> Builder #-}
55−{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}
56−{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}
57−{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}
58−{-# RULES "decimal/Word" decimal = positive :: Data.Word.Word -> Builder #-}
59−{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}
60−{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}
61−{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}
62−{-# RULES "decimal/Word64" decimal = positive :: Word64 -> Builder #-}
63−{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}
64−decimal i = decimal' (<= -128) i
65−{-# NOINLINE decimal #-}
66−
67−boundedDecimal :: (Integral a, Bounded a) => a -> Builder
68−{-# SPECIALIZE boundedDecimal :: Int -> Builder #-}
69−{-# SPECIALIZE boundedDecimal :: Int8 -> Builder #-}
70−{-# SPECIALIZE boundedDecimal :: Int16 -> Builder #-}
71−{-# SPECIALIZE boundedDecimal :: Int32 -> Builder #-}
72−{-# SPECIALIZE boundedDecimal :: Int64 -> Builder #-}
73−boundedDecimal i = decimal' (== minBound) i
74−
75−decimal' :: (Integral a) => (a -> Bool) -> a -> Builder
76−{-# INLINE decimal' #-}
77−decimal' p i
78− | i < 0 = if p i
79− then let (q, r) = i `quotRem` 10
80− qq = -q
81− !n = countDigits qq
82− in writeN (n + 2) $ \marr off -> do
83− unsafeWrite marr off minus
84− posDecimal marr (off+1) n qq
85− unsafeWrite marr (off+n+1) (i2w (-r))
86− else let j = -i
87− !n = countDigits j
88− in writeN (n + 1) $ \marr off ->
89− unsafeWrite marr off minus >> posDecimal marr (off+1) n j
90− | otherwise = positive i
91−
92−positive :: (Integral a) => a -> Builder
93−{-# SPECIALIZE positive :: Int -> Builder #-}
94−{-# SPECIALIZE positive :: Int8 -> Builder #-}
95−{-# SPECIALIZE positive :: Int16 -> Builder #-}
96−{-# SPECIALIZE positive :: Int32 -> Builder #-}
97−{-# SPECIALIZE positive :: Int64 -> Builder #-}
98−{-# SPECIALIZE positive :: Word -> Builder #-}
99−{-# SPECIALIZE positive :: Word8 -> Builder #-}
100−{-# SPECIALIZE positive :: Word16 -> Builder #-}
101−{-# SPECIALIZE positive :: Word32 -> Builder #-}
102−{-# SPECIALIZE positive :: Word64 -> Builder #-}
103−positive i
104− | i < 10 = writeN 1 $ \marr off -> unsafeWrite marr off (i2w i)
105− | otherwise = let !n = countDigits i
106− in writeN n $ \marr off -> posDecimal marr off n i
107−
108−posDecimal :: (Integral a) =>
109− forall s. MArray s -> Int -> Int -> a -> ST s ()
110−{-# INLINE posDecimal #-}
111−posDecimal marr off0 ds v0 = go (off0 + ds - 1) v0
112− where go off v
113− | v >= 100 = do
114− let (q, r) = v `quotRem` 100
115− write2 off r
116− go (off - 2) q
117− | v < 10 = unsafeWrite marr off (i2w v)
118− | otherwise = write2 off v
119− write2 off i0 = do
120− let i = fromIntegral i0; j = i + i
121− unsafeWrite marr off $ get (j + 1)
122− unsafeWrite marr (off - 1) $ get j
123− get = fromIntegral . B.unsafeIndex digits
124−
125−minus, zero :: Word16
126−{-# INLINE minus #-}
127−{-# INLINE zero #-}
128−minus = 45
129−zero = 48
130−
131−i2w :: (Integral a) => a -> Word16
132−{-# INLINE i2w #-}
133−i2w v = zero + fromIntegral v
134−
135−countDigits :: (Integral a) => a -> Int
136−{-# INLINE countDigits #-}
137−countDigits v0
138− | fromIntegral v64 == v0 = go 1 v64
139− | otherwise = goBig 1 (fromIntegral v0)
140− where v64 = fromIntegral v0
141− goBig !k (v :: Integer)
142− | v > big = goBig (k + 19) (v `quot` big)
143− | otherwise = go k (fromIntegral v)
144− big = 10000000000000000000
145− go !k (v :: Word64)
146− | v < 10 = k
147− | v < 100 = k + 1
148− | v < 1000 = k + 2
149− | v < 1000000000000 =
150− k + if v < 100000000
151− then if v < 1000000
152− then if v < 10000
153− then 3
154− else 4 + fin v 100000
155− else 6 + fin v 10000000
156− else if v < 10000000000
157− then 8 + fin v 1000000000
158− else 10 + fin v 100000000000
159− | otherwise = go (k + 12) (v `quot` 1000000000000)
160− fin v n = if v >= n then 1 else 0
161−
162−hexadecimal :: Integral a => a -> Builder
163−{-# SPECIALIZE hexadecimal :: Int -> Builder #-}
164−{-# SPECIALIZE hexadecimal :: Int8 -> Builder #-}
165−{-# SPECIALIZE hexadecimal :: Int16 -> Builder #-}
166−{-# SPECIALIZE hexadecimal :: Int32 -> Builder #-}
167−{-# SPECIALIZE hexadecimal :: Int64 -> Builder #-}
168−{-# SPECIALIZE hexadecimal :: Word -> Builder #-}
169−{-# SPECIALIZE hexadecimal :: Word8 -> Builder #-}
170−{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-}
171−{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-}
172−{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-}
173−{-# RULES "hexadecimal/Integer"
174− hexadecimal = hexInteger :: Integer -> Builder #-}
175−hexadecimal i
176− | i < 0 = error hexErrMsg
177− | otherwise = go i
178− where
179− go n | n < 16 = hexDigit n
180− | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)
181−{-# NOINLINE[0] hexadecimal #-}
182−
183−hexInteger :: Integer -> Builder
184−hexInteger i
185− | i < 0 = error hexErrMsg
186− | otherwise = integer 16 i
187−
188−hexErrMsg :: String
189−hexErrMsg = "Data.Text.Lazy.Builder.Int.hexadecimal: applied to negative number"
190−
191−hexDigit :: Integral a => a -> Builder
192−hexDigit n
193− | n <= 9 = singleton $! i2d (fromIntegral n)
194− | otherwise = singleton $! toEnum (fromIntegral n + 87)
195−{-# INLINE hexDigit #-}
196−
197−data T = T !Integer !Int
198−
199−integer :: Int -> Integer -> Builder
200−#ifdef INTEGER_GMP
201−integer 10 (S# i#) = decimal (I# i#)
202−integer 16 (S# i#) = hexadecimal (I# i#)
203−#endif
204−integer base i
205− | i < 0 = singleton '-' <> go (-i)
206− | otherwise = go i
207− where
208− go n | n < maxInt = int (fromInteger n)
209− | otherwise = putH (splitf (maxInt * maxInt) n)
210−
211− splitf p n
212− | p > n = [n]
213− | otherwise = splith p (splitf (p*p) n)
214−
215− splith p (n:ns) = case n `quotRemInteger` p of
216− PAIR(q,r) | q > 0 -> q : r : splitb p ns
217− | otherwise -> r : splitb p ns
218− splith _ _ = error "splith: the impossible happened."
219−
220− splitb p (n:ns) = case n `quotRemInteger` p of
221− PAIR(q,r) -> q : r : splitb p ns
222− splitb _ _ = []
223−
224− T maxInt10 maxDigits10 =
225− until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1)
226− where mi = fromIntegral (maxBound :: Int)
227− T maxInt16 maxDigits16 =
228− until ((>mi) . (*16) . fstT) (\(T n d) -> T (n*16) (d+1)) (T 16 1)
229− where mi = fromIntegral (maxBound :: Int)
230−
231− fstT (T a _) = a
232−
233− maxInt | base == 10 = maxInt10
234− | otherwise = maxInt16
235− maxDigits | base == 10 = maxDigits10
236− | otherwise = maxDigits16
237−
238− putH (n:ns) = case n `quotRemInteger` maxInt of
239− PAIR(x,y)
240− | q > 0 -> int q <> pblock r <> putB ns
241− | otherwise -> int r <> putB ns
242− where q = fromInteger x
243− r = fromInteger y
244− putH _ = error "putH: the impossible happened"
245−
246− putB (n:ns) = case n `quotRemInteger` maxInt of
247− PAIR(x,y) -> pblock q <> pblock r <> putB ns
248− where q = fromInteger x
249− r = fromInteger y
250− putB _ = Data.Monoid.mempty
251−
252− int :: Int -> Builder
253− int x | base == 10 = decimal x
254− | otherwise = hexadecimal x
255−
256− pblock = loop maxDigits
257− where
258− loop !d !n
259− | d == 1 = hexDigit n
260− | otherwise = loop (d-1) q <> hexDigit r
261− where q = n `quotInt` base
262− r = n `remInt` base
Data/Text/Lazy/Builder/RealFloat.hsdeleted−242
@@ -1,242 +0,0 @@
1−{-# LANGUAGE CPP, OverloadedStrings #-}
2−#if __GLASGOW_HASKELL__ >= 702
3−{-# LANGUAGE Trustworthy #-}
4−#endif
5−
6−-- |
7−-- Module: Data.Text.Lazy.Builder.RealFloat
8−-- Copyright: (c) The University of Glasgow 1994-2002
9−-- License: see libraries/base/LICENSE
10−--
11−-- Write a floating point value to a 'Builder'.
12−
13−module Data.Text.Lazy.Builder.RealFloat
14− (
15− FPFormat(..)
16− , realFloat
17− , formatRealFloat
18− ) where
19−
20−import Data.Array.Base (unsafeAt)
21−import Data.Array.IArray
22−import Data.Text.Internal.Builder.Functions ((<>), i2d)
23−import Data.Text.Lazy.Builder.Int (decimal)
24−import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)
25−import Data.Text.Lazy.Builder
26−import qualified Data.Text as T
27−
28−-- | Control the rendering of floating point numbers.
29−data FPFormat = Exponent
30− -- ^ Scientific notation (e.g. @2.3e123@).
31− | Fixed
32− -- ^ Standard decimal notation.
33− | Generic
34− -- ^ Use decimal notation for values between @0.1@ and
35− -- @9,999,999@, and scientific notation otherwise.
36− deriving (Enum, Read, Show)
37−
38−-- | Show a signed 'RealFloat' value to full precision,
39−-- using standard decimal notation for arguments whose absolute value lies
40−-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
41−realFloat :: (RealFloat a) => a -> Builder
42−{-# SPECIALIZE realFloat :: Float -> Builder #-}
43−{-# SPECIALIZE realFloat :: Double -> Builder #-}
44−realFloat x = formatRealFloat Generic Nothing x
45−
46−formatRealFloat :: (RealFloat a) =>
47− FPFormat
48− -> Maybe Int -- ^ Number of decimal places to render.
49− -> a
50− -> Builder
51−{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Float -> Builder #-}
52−{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Double -> Builder #-}
53−formatRealFloat fmt decs x
54− | isNaN x = "NaN"
55− | isInfinite x = if x < 0 then "-Infinity" else "Infinity"
56− | x < 0 || isNegativeZero x = singleton '-' <> doFmt fmt (floatToDigits (-x))
57− | otherwise = doFmt fmt (floatToDigits x)
58− where
59− doFmt format (is, e) =
60− let ds = map i2d is in
61− case format of
62− Generic ->
63− doFmt (if e < 0 || e > 7 then Exponent else Fixed)
64− (is,e)
65− Exponent ->
66− case decs of
67− Nothing ->
68− let show_e' = decimal (e-1) in
69− case ds of
70− "0" -> "0.0e0"
71− [d] -> singleton d <> ".0e" <> show_e'
72− (d:ds') -> singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> show_e'
73− [] -> error "formatRealFloat/doFmt/Exponent: []"
74− Just dec ->
75− let dec' = max dec 1 in
76− case is of
77− [0] -> "0." <> fromText (T.replicate dec' "0") <> "e0"
78− _ ->
79− let
80− (ei,is') = roundTo (dec'+1) is
81− (d:ds') = map i2d (if ei > 0 then init is' else is')
82− in
83− singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> decimal (e-1+ei)
84− Fixed ->
85− let
86− mk0 ls = case ls of { "" -> "0" ; _ -> fromString ls}
87− in
88− case decs of
89− Nothing
90− | e <= 0 -> "0." <> fromText (T.replicate (-e) "0") <> fromString ds
91− | otherwise ->
92− let
93− f 0 s rs = mk0 (reverse s) <> singleton '.' <> mk0 rs
94− f n s "" = f (n-1) ('0':s) ""
95− f n s (r:rs) = f (n-1) (r:s) rs
96− in
97− f e "" ds
98− Just dec ->
99− let dec' = max dec 0 in
100− if e >= 0 then
101− let
102− (ei,is') = roundTo (dec' + e) is
103− (ls,rs) = splitAt (e+ei) (map i2d is')
104− in
105− mk0 ls <> (if null rs then "" else singleton '.' <> fromString rs)
106− else
107− let
108− (ei,is') = roundTo dec' (replicate (-e) 0 ++ is)
109− d:ds' = map i2d (if ei > 0 then is' else 0:is')
110− in
111− singleton d <> (if null ds' then "" else singleton '.' <> fromString ds')
112−
113−
114−-- Based on "Printing Floating-Point Numbers Quickly and Accurately"
115−-- by R.G. Burger and R.K. Dybvig in PLDI 96.
116−-- This version uses a much slower logarithm estimator. It should be improved.
117−
118−-- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number,
119−-- and returns a list of digits and an exponent.
120−-- In particular, if @x>=0@, and
121−--
122−-- > floatToDigits base x = ([d1,d2,...,dn], e)
123−--
124−-- then
125−--
126−-- (1) @n >= 1@
127−--
128−-- (2) @x = 0.d1d2...dn * (base**e)@
129−--
130−-- (3) @0 <= di <= base-1@
131−
132−floatToDigits :: (RealFloat a) => a -> ([Int], Int)
133−{-# SPECIALIZE floatToDigits :: Float -> ([Int], Int) #-}
134−{-# SPECIALIZE floatToDigits :: Double -> ([Int], Int) #-}
135−floatToDigits 0 = ([0], 0)
136−floatToDigits x =
137− let
138− (f0, e0) = decodeFloat x
139− (minExp0, _) = floatRange x
140− p = floatDigits x
141− b = floatRadix x
142− minExp = minExp0 - p -- the real minimum exponent
143− -- Haskell requires that f be adjusted so denormalized numbers
144− -- will have an impossibly low exponent. Adjust for this.
145− (f, e) =
146− let n = minExp - e0 in
147− if n > 0 then (f0 `quot` (expt b n), e0+n) else (f0, e0)
148− (r, s, mUp, mDn) =
149− if e >= 0 then
150− let be = expt b e in
151− if f == expt b (p-1) then
152− (f*be*b*2, 2*b, be*b, be) -- according to Burger and Dybvig
153− else
154− (f*be*2, 2, be, be)
155− else
156− if e > minExp && f == expt b (p-1) then
157− (f*b*2, expt b (-e+1)*2, b, 1)
158− else
159− (f*2, expt b (-e)*2, 1, 1)
160− k :: Int
161− k =
162− let
163− k0 :: Int
164− k0 =
165− if b == 2 then
166− -- logBase 10 2 is very slightly larger than 8651/28738
167− -- (about 5.3558e-10), so if log x >= 0, the approximation
168− -- k1 is too small, hence we add one and need one fixup step less.
169− -- If log x < 0, the approximation errs rather on the high side.
170− -- That is usually more than compensated for by ignoring the
171− -- fractional part of logBase 2 x, but when x is a power of 1/2
172− -- or slightly larger and the exponent is a multiple of the
173− -- denominator of the rational approximation to logBase 10 2,
174− -- k1 is larger than logBase 10 x. If k1 > 1 + logBase 10 x,
175− -- we get a leading zero-digit we don't want.
176− -- With the approximation 3/10, this happened for
177− -- 0.5^1030, 0.5^1040, ..., 0.5^1070 and values close above.
178− -- The approximation 8651/28738 guarantees k1 < 1 + logBase 10 x
179− -- for IEEE-ish floating point types with exponent fields
180− -- <= 17 bits and mantissae of several thousand bits, earlier
181− -- convergents to logBase 10 2 would fail for long double.
182− -- Using quot instead of div is a little faster and requires
183− -- fewer fixup steps for negative lx.
184− let lx = p - 1 + e0
185− k1 = (lx * 8651) `quot` 28738
186− in if lx >= 0 then k1 + 1 else k1
187− else
188− -- f :: Integer, log :: Float -> Float,
189− -- ceiling :: Float -> Int
190− ceiling ((log (fromInteger (f+1) :: Float) +
191− fromIntegral e * log (fromInteger b)) /
192− log 10)
193−--WAS: fromInt e * log (fromInteger b))
194−
195− fixup n =
196− if n >= 0 then
197− if r + mUp <= expt 10 n * s then n else fixup (n+1)
198− else
199− if expt 10 (-n) * (r + mUp) <= s then n else fixup (n+1)
200− in
201− fixup k0
202−
203− gen ds rn sN mUpN mDnN =
204− let
205− (dn, rn') = (rn * 10) `quotRem` sN
206− mUpN' = mUpN * 10
207− mDnN' = mDnN * 10
208− in
209− case (rn' < mDnN', rn' + mUpN' > sN) of
210− (True, False) -> dn : ds
211− (False, True) -> dn+1 : ds
212− (True, True) -> if rn' * 2 < sN then dn : ds else dn+1 : ds
213− (False, False) -> gen (dn:ds) rn' sN mUpN' mDnN'
214−
215− rds =
216− if k >= 0 then
217− gen [] r (s * expt 10 k) mUp mDn
218− else
219− let bk = expt 10 (-k) in
220− gen [] (r * bk) s (mUp * bk) (mDn * bk)
221− in
222− (map fromIntegral (reverse rds), k)
223−
224−-- Exponentiation with a cache for the most common numbers.
225−minExpt, maxExpt :: Int
226−minExpt = 0
227−maxExpt = 1100
228−
229−expt :: Integer -> Int -> Integer
230−expt base n
231− | base == 2 && n >= minExpt && n <= maxExpt = expts `unsafeAt` n
232− | base == 10 && n <= maxExpt10 = expts10 `unsafeAt` n
233− | otherwise = base^n
234−
235−expts :: Array Int Integer
236−expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]
237−
238−maxExpt10 :: Int
239−maxExpt10 = 324
240−
241−expts10 :: Array Int Integer
242−expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]
Data/Text/Lazy/Encoding.hs+30−215
@@ -1,240 +1,55 @@
1−{-# LANGUAGE BangPatterns,CPP #-}
2−#if __GLASGOW_HASKELL__ >= 702
3−{-# LANGUAGE Trustworthy #-}
4−#endif
5-- |
1-- |
6-- Module : Data.Text.Lazy.Encoding
2-- Module : Data.Text.Lazy.Encoding
7−-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
3+-- Copyright : (c) Bryan O'Sullivan 2009
8--
4--
9-- License : BSD-style
5-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
6+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,
7+-- duncan@haskell.org
11-- Stability : experimental
8-- Stability : experimental
12-- Portability : portable
9-- Portability : portable
13--
10--
14-- Functions for converting lazy 'Text' values to and from lazy
11-- Functions for converting lazy 'Text' values to and from lazy
15-- 'ByteString', using several standard encodings.
12-- 'ByteString', using several standard encodings.
16--
13--
17−-- To gain access to a much larger variety of encodings, use the
14+-- To make use of a much larger variety of encodings, use the @text-icu@
18−-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>
15+-- package.
19
16
20module Data.Text.Lazy.Encoding
17module Data.Text.Lazy.Encoding
21 (
18 (
22 -- * Decoding ByteStrings to Text
19 -- * Decoding ByteStrings to Text
23− -- $strict
20+ -- decodeASCII
24− decodeASCII
21+ decodeUtf8
25− , decodeLatin1
26− , decodeUtf8
27− , decodeUtf16LE
28− , decodeUtf16BE
29− , decodeUtf32LE
30− , decodeUtf32BE
31−
32− -- ** Catchable failure
33− , decodeUtf8'
34−
35− -- ** Controllable error handling
36 , decodeUtf8With
22 , decodeUtf8With
37− , decodeUtf16LEWith
23+ --, decodeUtf16LE
38− , decodeUtf16BEWith
24+ --, decodeUtf16BE
39− , decodeUtf32LEWith
25+ --, decodeUtf32LE
40− , decodeUtf32BEWith
26+ --, decodeUtf32BE
41
27
42 -- * Encoding Text to ByteStrings
28 -- * Encoding Text to ByteStrings
43 , encodeUtf8
29 , encodeUtf8
44− , encodeUtf16LE
30+ --, encodeUtf16LE
45− , encodeUtf16BE
31+ --, encodeUtf16BE
46− , encodeUtf32LE
32+ --, encodeUtf32LE
47− , encodeUtf32BE
33+ --, encodeUtf32BE
48−
49− -- * Encoding Text using ByteString Builders
50− , encodeUtf8Builder
51− , encodeUtf8BuilderEscaped
52 ) where
34 ) where
53
35
54−import Control.Exception (evaluate, try)
36+import Data.ByteString.Lazy (ByteString)
55−import Data.Monoid (Monoid(..))
37+import Data.Text.Encoding.Error (OnDecodeError, strictDecode)
56−import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
38+import Data.Text.Lazy (Text)
57−import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldrChunks)
39+import qualified Data.Text.Lazy.Fusion as F
58−import Data.Word (Word8)
40+import qualified Data.Text.Lazy.Encoding.Fusion as E
59−import 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
63−import qualified Data.ByteString.Lazy as B
64−import qualified Data.ByteString.Lazy.Internal as B
65−import qualified Data.ByteString.Unsafe as B
66−import qualified Data.Text as T
67−import 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
70−import Data.Text.Unsafe (unsafeDupablePerformIO)
71−
72−-- $strict
73−--
74−-- All of the single-parameter functions for decoding bytestrings
75−-- encoded in one of the Unicode Transformation Formats (UTF) operate
76−-- in a /strict/ mode: each will throw an exception if given invalid
77−-- input.
78−--
79−-- Each function has a variant, whose name is suffixed with -'With',
80−-- that gives greater control over the handling of decoding errors.
81−-- For instance, 'decodeUtf8' will throw an exception, but
82−-- 'decodeUtf8With' allows the programmer to determine what to do on a
83−-- decoding error.
84−
85−-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
86−-- encoded text.
87−decodeASCII :: B.ByteString -> Text
88−decodeASCII = decodeUtf8
89−{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
90−
91−-- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.
92−decodeLatin1 :: B.ByteString -> Text
93−decodeLatin1 = foldr (chunk . TE.decodeLatin1) empty . B.toChunks
94
41
95-- | Decode a 'ByteString' containing UTF-8 encoded text.
42-- | Decode a 'ByteString' containing UTF-8 encoded text.
96−decodeUtf8With :: OnDecodeError -> B.ByteString -> Text
43+decodeUtf8With :: OnDecodeError -> ByteString -> Text
97−decodeUtf8With onErr (B.Chunk b0 bs0) =
44+decodeUtf8With onErr bs = F.unstream (E.streamUtf8 onErr bs)
98− case TE.streamDecodeUtf8With onErr b0 of
45+{-# INLINE decodeUtf8With #-}
99− TE.Some t l f -> chunk t (go f l bs0)
100− where
101− go f0 _ (B.Chunk b bs) =
102− case f0 b of
103− TE.Some t l f -> chunk t (go f l bs)
104− go _ l _
105− | S.null l = empty
106− | otherwise = case onErr desc (Just (B.unsafeHead l)) of
107− Nothing -> empty
108− Just c -> Chunk (T.singleton c) Empty
109− desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"
110−decodeUtf8With _ _ = empty
111
46
112−-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
47+-- | Decode a 'ByteString' containing UTF-8 encoded text.
113−-- to be valid.
48+decodeUtf8 :: ByteString -> Text
114−--
115−-- If the input contains any invalid UTF-8 data, an exception will be
116−-- thrown that cannot be caught in pure code. For more control over
117−-- the handling of invalid data, use 'decodeUtf8'' or
118−-- 'decodeUtf8With'.
119−decodeUtf8 :: B.ByteString -> Text
120decodeUtf8 = decodeUtf8With strictDecode
49decodeUtf8 = decodeUtf8With strictDecode
121−{-# INLINE[0] decodeUtf8 #-}
50+{-# INLINE decodeUtf8 #-}
122−
123−-- This rule seems to cause performance loss.
124−{- RULES "LAZY STREAM stream/decodeUtf8' fusion" [1]
125− forall bs. F.stream (decodeUtf8' bs) = E.streamUtf8 strictDecode bs #-}
126−
127−-- | Decode a 'ByteString' containing UTF-8 encoded text..
128−--
129−-- If the input contains any invalid UTF-8 data, the relevant
130−-- exception will be returned, otherwise the decoded text.
131−--
132−-- /Note/: this function is /not/ lazy, as it must decode its entire
133−-- input before it can return a result. If you need lazy (streaming)
134−-- decoding, use 'decodeUtf8With' in lenient mode.
135−decodeUtf8' :: B.ByteString -> Either UnicodeException Text
136−decodeUtf8' bs = unsafeDupablePerformIO $ do
137− let t = decodeUtf8 bs
138− try (evaluate (rnf t `seq` t))
139− where
140− rnf Empty = ()
141− rnf (Chunk _ ts) = rnf ts
142−{-# INLINE decodeUtf8' #-}
143−
144−encodeUtf8 :: 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
165−
166−-- | Decode text from little endian UTF-16 encoding.
167−decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text
168−decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)
169−{-# INLINE decodeUtf16LEWith #-}
170−
171−-- | Decode text from little endian UTF-16 encoding.
172−--
173−-- If the input contains any invalid little endian UTF-16 data, an
174−-- exception will be thrown. For more control over the handling of
175−-- invalid data, use 'decodeUtf16LEWith'.
176−decodeUtf16LE :: B.ByteString -> Text
177−decodeUtf16LE = decodeUtf16LEWith strictDecode
178−{-# INLINE decodeUtf16LE #-}
179−
180−-- | Decode text from big endian UTF-16 encoding.
181−decodeUtf16BEWith :: OnDecodeError -> B.ByteString -> Text
182−decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)
183−{-# INLINE decodeUtf16BEWith #-}
184−
185−-- | Decode text from big endian UTF-16 encoding.
186−--
187−-- If the input contains any invalid big endian UTF-16 data, an
188−-- exception will be thrown. For more control over the handling of
189−-- invalid data, use 'decodeUtf16BEWith'.
190−decodeUtf16BE :: B.ByteString -> Text
191−decodeUtf16BE = decodeUtf16BEWith strictDecode
192−{-# INLINE decodeUtf16BE #-}
193−
194−-- | Encode text using little endian UTF-16 encoding.
195−encodeUtf16LE :: Text -> B.ByteString
196−encodeUtf16LE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf16LE) [] txt)
197−{-# INLINE encodeUtf16LE #-}
198−
199−-- | Encode text using big endian UTF-16 encoding.
200−encodeUtf16BE :: Text -> B.ByteString
201−encodeUtf16BE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf16BE) [] txt)
202−{-# INLINE encodeUtf16BE #-}
203−
204−-- | Decode text from little endian UTF-32 encoding.
205−decodeUtf32LEWith :: OnDecodeError -> B.ByteString -> Text
206−decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)
207−{-# INLINE decodeUtf32LEWith #-}
208−
209−-- | Decode text from little endian UTF-32 encoding.
210−--
211−-- If the input contains any invalid little endian UTF-32 data, an
212−-- exception will be thrown. For more control over the handling of
213−-- invalid data, use 'decodeUtf32LEWith'.
214−decodeUtf32LE :: B.ByteString -> Text
215−decodeUtf32LE = decodeUtf32LEWith strictDecode
216−{-# INLINE decodeUtf32LE #-}
217−
218−-- | Decode text from big endian UTF-32 encoding.
219−decodeUtf32BEWith :: OnDecodeError -> B.ByteString -> Text
220−decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)
221−{-# INLINE decodeUtf32BEWith #-}
222−
223−-- | Decode text from big endian UTF-32 encoding.
224−--
225−-- If the input contains any invalid big endian UTF-32 data, an
226−-- exception will be thrown. For more control over the handling of
227−-- invalid data, use 'decodeUtf32BEWith'.
228−decodeUtf32BE :: B.ByteString -> Text
229−decodeUtf32BE = decodeUtf32BEWith strictDecode
230−{-# INLINE decodeUtf32BE #-}
231−
232−-- | Encode text using little endian UTF-32 encoding.
233−encodeUtf32LE :: Text -> B.ByteString
234−encodeUtf32LE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf32LE) [] txt)
235−{-# INLINE encodeUtf32LE #-}
236
51
237−-- | Encode text using big endian UTF-32 encoding.
52+-- | Encode text using UTF-8 encoding.
238−encodeUtf32BE :: Text -> B.ByteString
53+encodeUtf8 :: Text -> ByteString
239−encodeUtf32BE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf32BE) [] txt)
54+encodeUtf8 txt = E.unstream (E.restreamUtf8 (F.stream txt))
240−{-# INLINE encodeUtf32BE #-}
55+{-# INLINE encodeUtf8 #-}
Data/Text/Lazy/Encoding/Fusion.hsnew file+149
@@ -0,0 +1,149 @@
1+{-# LANGUAGE BangPatterns, Rank2Types #-}
2+
3+-- |
4+-- Module : Data.Text.Lazy.Encoding.Fusion
5+-- Copyright : (c) Bryan O'Sullivan 2009
6+--
7+-- License : BSD-style
8+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,
9+-- duncan@haskell.org
10+-- Stability : experimental
11+-- Portability : portable
12+--
13+-- Fusible 'Stream'-oriented functions for converting between lazy
14+-- 'Text' and several common encodings.
15+
16+module Data.Text.Lazy.Encoding.Fusion
17+ (
18+ -- * Streaming
19+ -- streamASCII
20+ streamUtf8
21+ --, streamUtf16LE
22+ --, streamUtf16BE
23+ --, streamUtf32LE
24+ --, streamUtf32BE
25+
26+ -- * Unstreaming
27+ , unstream
28+
29+ , module Data.Text.Encoding.Fusion.Common
30+ ) where
31+
32+import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)
33+import qualified Data.ByteString as B
34+import qualified Data.ByteString.Unsafe as B
35+import Data.Text.Encoding.Fusion.Common
36+import Data.Text.Encoding.Error
37+import Data.Text.Fusion (Step(..), Stream(..))
38+import Data.Text.Fusion.Internal (M(..), PairS(..), S(..))
39+import Data.Text.UnsafeChar (unsafeChr8)
40+import Data.Word (Word8)
41+import qualified Data.Text.Encoding.Utf8 as U8
42+import System.IO.Unsafe (unsafePerformIO)
43+import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
44+import Foreign.Storable (pokeByteOff)
45+import Data.ByteString.Internal (mallocByteString, memcpy)
46+import Control.Exception (assert)
47+import qualified Data.ByteString.Internal as B
48+
49+unknownLength :: Int
50+unknownLength = 4
51+
52+-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using
53+-- UTF-8 encoding.
54+streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
55+streamUtf8 onErr bs0 = Stream next (bs0 :!: empty :!: 0) unknownLength
56+ where
57+ empty = S N N N N
58+ {-# INLINE next #-}
59+ next (bs@(Chunk ps _) :!: S N _ _ _ :!: i)
60+ | i < len && U8.validate1 a =
61+ Yield (unsafeChr8 a) (bs :!: empty :!: i+1)
62+ | i + 1 < len && U8.validate2 a b =
63+ Yield (U8.chr2 a b) (bs :!: empty :!: i+2)
64+ | i + 2 < len && U8.validate3 a b c =
65+ Yield (U8.chr3 a b c) (bs :!: empty :!: i+3)
66+ | i + 4 < len && U8.validate4 a b c d =
67+ Yield (U8.chr4 a b c d) (bs :!: empty :!: i+4)
68+ where len = B.length ps
69+ a = B.unsafeIndex ps i
70+ b = B.unsafeIndex ps (i+1)
71+ c = B.unsafeIndex ps (i+2)
72+ d = B.unsafeIndex ps (i+3)
73+ next st@(bs :!: s :!: i) =
74+ case s of
75+ S (J a) N _ _ | U8.validate1 a ->
76+ Yield (unsafeChr8 a) es
77+ S (J a) (J b) N _ | U8.validate2 a b ->
78+ Yield (U8.chr2 a b) es
79+ S (J a) (J b) (J c) N | U8.validate3 a b c ->
80+ Yield (U8.chr3 a b c) es
81+ S (J a) (J b) (J c) (J d) | U8.validate4 a b c d ->
82+ Yield (U8.chr4 a b c d) es
83+ _ -> consume st
84+ where es = bs :!: empty :!: i
85+ {-# INLINE consume #-}
86+ consume (bs@(Chunk ps rest) :!: s :!: i)
87+ | i >= B.length ps = consume (rest :!: s :!: 0)
88+ | otherwise =
89+ case s of
90+ S N _ _ _ -> next (bs :!: S x N N N :!: i+1)
91+ S a N _ _ -> next (bs :!: S a x N N :!: i+1)
92+ S a b N _ -> next (bs :!: S a b x N :!: i+1)
93+ S a b c N -> next (bs :!: S a b c x :!: i+1)
94+ S (J a) b c d -> decodeError "streamUtf8" "UTF-8" onErr (Just a)
95+ (bs :!: S b c d N :!: i+1)
96+ where x = J (B.unsafeIndex ps i)
97+ consume (Empty :!: S N _ _ _ :!: _) = Done
98+ consume st = decodeError "streamUtf8" "UTF-8" onErr Nothing st
99+{-# INLINE [0] streamUtf8 #-}
100+
101+-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
102+unstreamChunks :: Int -> Stream Word8 -> ByteString
103+unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 len0
104+ where chunk s1 len1 = unsafePerformIO $ do
105+ let len = min (max len1 unknownLength) chunkSize
106+ mallocByteString len >>= loop len 0 s1
107+ where
108+ loop !n !off !s fp = case next s of
109+ Done | off == 0 -> return Empty
110+ | otherwise -> do
111+ bs <- trimUp fp off
112+ return $! Chunk bs Empty
113+ Skip s' -> loop n off s' fp
114+ Yield x s'
115+ | off == chunkSize -> do
116+ bs <- trimUp fp off
117+ return (Chunk bs (chunk s (n - B.length bs)))
118+ | off == n -> realloc fp n off s' x
119+ | otherwise -> do
120+ withForeignPtr fp $ \p -> pokeByteOff p off x
121+ loop n (off+1) s' fp
122+ {-# NOINLINE realloc #-}
123+ realloc fp n off s x = do
124+ let n' = min (n+n) chunkSize
125+ fp' <- copy0 fp n n'
126+ withForeignPtr fp' $ \p -> pokeByteOff p off x
127+ loop n' (off+1) s fp'
128+ {-# NOINLINE trimUp #-}
129+ trimUp fp off = return $! B.PS fp 0 off
130+ copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)
131+ copy0 !src !srcLen !destLen = assert (srcLen <= destLen) $ do
132+ dest <- mallocByteString destLen
133+ withForeignPtr src $ \src' ->
134+ withForeignPtr dest $ \dest' ->
135+ memcpy dest' src' (fromIntegral srcLen)
136+ return dest
137+
138+-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
139+unstream :: Stream Word8 -> ByteString
140+unstream = unstreamChunks defaultChunkSize
141+
142+decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8
143+ -> s -> Step s Char
144+decodeError func kind onErr mb i =
145+ case onErr desc mb of
146+ Nothing -> Skip i
147+ Just c -> Yield c i
148+ where desc = "Data.Text.Lazy.Encoding.Fusion." ++ func ++ ": Invalid " ++
149+ kind ++ " stream"
Data/Text/Lazy/Fusion.hsnew file+139
@@ -0,0 +1,139 @@
1+-- |
2+-- Module : Data.Text.Lazy.Fusion
3+-- Copyright : (c) Bryan O'Sullivan 2009
4+--
5+-- License : BSD-style
6+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,
7+-- duncan@haskell.org
8+-- Stability : experimental
9+-- Portability : GHC
10+--
11+-- Core stream fusion functionality for text.
12+
13+module Data.Text.Lazy.Fusion
14+ (
15+ stream
16+ , unstream
17+ , unstreamChunks
18+ , length
19+ , unfoldrN
20+ , index
21+ , findIndex
22+ , findIndices
23+ , elemIndex
24+ , elemIndices
25+ , count
26+ ) where
27+
28+import Prelude hiding (length)
29+import qualified Data.Text.Fusion.Common as S
30+import Data.Text.Fusion.Internal
31+import Data.Text.Lazy.Internal
32+import qualified Data.Text.Internal as I
33+import qualified Data.Text.Array as A
34+import Data.Text.UnsafeChar (unsafeWrite)
35+import Data.Text.Unsafe (iter)
36+import Data.Int (Int64)
37+
38+default(Int64)
39+
40+-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
41+stream :: Text -> Stream Char
42+stream text = Stream next (text :!: 0) 4 -- random HINT
43+ where
44+ next (Empty :!: _) = Done
45+ next (txt@(Chunk t@(I.Text _ _ len) ts) :!: i)
46+ | i >= len = next (ts :!: 0)
47+ | otherwise = Yield c (txt :!: i+d)
48+ where (c,d) = iter t i
49+{-# INLINE [0] stream #-}
50+
51+-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given
52+-- chunk size.
53+unstreamChunks :: Int -> Stream Char -> Text
54+unstreamChunks chunkSize (Stream next s0 len0)
55+ | len0 == 0 = Empty
56+ | otherwise = outer s0
57+ where
58+ outer s = case next s of
59+ Done -> Empty
60+ Skip s' -> outer s'
61+ Yield x s' -> I.Text arr 0 len `chunk` outer s''
62+ where (arr,(s'',len)) = A.run2 fill
63+ fill = do a <- A.unsafeNew unknownLength
64+ i <- unsafeWrite a 0 x
65+ inner a unknownLength s' i
66+ unknownLength = 4
67+ inner marr len s i
68+ | i + 1 >= chunkSize = return (marr, (s,i))
69+ | i + 1 >= len = do
70+ let newLen = min (len * 2) chunkSize
71+ marr' <- A.unsafeNew newLen
72+ A.copy marr marr'
73+ inner marr' newLen s i
74+ | otherwise =
75+ case next s of
76+ Done -> return (marr,(s,i))
77+ Skip s' -> inner marr len s' i
78+ Yield x s' -> unsafeWrite marr i x >>= inner marr len s'
79+{-# INLINE [0] unstreamChunks #-}
80+
81+-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using
82+-- 'defaultChunkSize'.
83+unstream :: Stream Char -> Text
84+unstream = unstreamChunks defaultChunkSize
85+{-# INLINE [0] unstream #-}
86+
87+-- | /O(n)/ Returns the number of characters in a text.
88+length :: Stream Char -> Int64
89+length = S.lengthI
90+{-# INLINE[0] length #-}
91+
92+{-# RULES "LAZY STREAM stream/unstream fusion" forall s.
93+ stream (unstream s) = s #-}
94+
95+-- | /O(n)/ Like 'unfoldr', 'unfoldrN64' builds a stream from a seed
96+-- value. However, the length of the result is limited by the
97+-- first argument to 'unfoldrN64'. This function is more efficient than
98+-- 'unfoldr' when the length of the result is known.
99+unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Stream Char
100+unfoldrN n = S.unfoldrNI n
101+{-# INLINE [0] unfoldrN #-}
102+
103+-- | /O(n)/ stream index (subscript) operator, starting from 0.
104+index :: Stream Char -> Int64 -> Char
105+index = S.indexI
106+{-# INLINE [0] index #-}
107+
108+-- | The 'findIndex' function takes a predicate and a stream and
109+-- returns the index of the first element in the stream
110+-- satisfying the predicate.
111+findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int64
112+findIndex = S.findIndexI
113+{-# INLINE [0] findIndex #-}
114+
115+-- | The 'findIndices' function takes a predicate and a stream and
116+-- returns all indices of the elements in the stream
117+-- satisfying the predicate.
118+findIndices :: (Char -> Bool) -> Stream Char -> [Int64]
119+findIndices = S.findIndicesI
120+{-# INLINE [0] findIndices #-}
121+
122+-- | /O(n)/ The 'elemIndex' function returns the index of the first
123+-- element in the given stream which is equal to the query
124+-- element, or 'Nothing' if there is no such element.
125+elemIndex :: Char -> Stream Char -> Maybe Int64
126+elemIndex = S.elemIndexI
127+{-# INLINE [0] elemIndex #-}
128+
129+-- | /O(n)/ The 'elemIndices' function returns the index of every
130+-- element in the given stream which is equal to the query element.
131+elemIndices :: Char -> Stream Char -> [Int64]
132+elemIndices = S.elemIndicesI
133+{-# INLINE [0] elemIndices #-}
134+
135+-- | /O(n)/ The 'count' function returns the number of times the query
136+-- element appears in the given stream.
137+count :: Char -> Stream Char -> Int64
138+count = S.countI
139+{-# INLINE [0] count #-}
Data/Text/Lazy/IO.hsdeleted−196
@@ -1,196 +0,0 @@
1−{-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}
2−#if __GLASGOW_HASKELL__ >= 702
3−{-# LANGUAGE Trustworthy #-}
4−#endif
5−-- |
6−-- Module : Data.Text.Lazy.IO
7−-- Copyright : (c) 2009, 2010 Bryan O'Sullivan,
8−-- (c) 2009 Simon Marlow
9−-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
11−-- Stability : experimental
12−-- Portability : GHC
13−--
14−-- Efficient locale-sensitive support for lazy text I\/O.
15−--
16−-- Skip past the synopsis for some important notes on performance and
17−-- portability across different versions of GHC.
18−
19−module Data.Text.Lazy.IO
20− (
21− -- * Performance
22− -- $performance
23−
24− -- * Locale support
25− -- $locale
26− -- * File-at-a-time operations
27− readFile
28− , writeFile
29− , appendFile
30− -- * Operations on handles
31− , hGetContents
32− , hGetLine
33− , hPutStr
34− , hPutStrLn
35− -- * Special cases for standard input and output
36− , interact
37− , getContents
38− , getLine
39− , putStr
40− , putStrLn
41− ) where
42−
43−import Data.Text.Lazy (Text)
44−import Prelude hiding (appendFile, getContents, getLine, interact,
45− putStr, putStrLn, readFile, writeFile)
46−import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,
47− withFile)
48−import qualified Data.Text.IO as T
49−import qualified Data.Text.Lazy as L
50−import qualified Control.Exception as E
51−import Control.Monad (when)
52−import Data.IORef (readIORef)
53−import Data.Text.Internal.IO (hGetLineWith, readChunk)
54−import Data.Text.Internal.Lazy (chunk, empty)
55−import GHC.IO.Buffer (isEmptyBuffer)
56−import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException)
57−import GHC.IO.Handle.Internals (augmentIOError, hClose_help,
58− wantReadableHandle, withHandle)
59−import GHC.IO.Handle.Types (Handle__(..), HandleType(..))
60−import System.IO (BufferMode(..), hGetBuffering, hSetBuffering)
61−import System.IO.Error (isEOFError)
62−import System.IO.Unsafe (unsafeInterleaveIO)
63−
64−-- $performance
65−--
66−-- The functions in this module obey the runtime system's locale,
67−-- character set encoding, and line ending conversion settings.
68−--
69−-- If you know in advance that you will be working with data that has
70−-- a specific encoding (e.g. UTF-8), and your application is highly
71−-- performance sensitive, you may find that it is faster to perform
72−-- I\/O with bytestrings and to encode and decode yourself than to use
73−-- the functions in this module.
74−--
75−-- Whether this will hold depends on the version of GHC you are using,
76−-- the platform you are working on, the data you are working with, and
77−-- the encodings you are using, so be sure to test for yourself.
78−
79−-- | Read a file and return its contents as a string. The file is
80−-- read lazily, as with 'getContents'.
81−readFile :: FilePath -> IO Text
82−readFile name = openFile name ReadMode >>= hGetContents
83−
84−-- | Write a string to a file. The file is truncated to zero length
85−-- before writing begins.
86−writeFile :: FilePath -> Text -> IO ()
87−writeFile p = withFile p WriteMode . flip hPutStr
88−
89−-- | Write a string the end of a file.
90−appendFile :: FilePath -> Text -> IO ()
91−appendFile p = withFile p AppendMode . flip hPutStr
92−
93−-- | Lazily read the remaining contents of a 'Handle'. The 'Handle'
94−-- will be closed after the read completes, or on error.
95−hGetContents :: Handle -> IO Text
96−hGetContents h = do
97− chooseGoodBuffering h
98− wantReadableHandle "hGetContents" h $ \hh -> do
99− ts <- lazyRead h
100− return (hh{haType=SemiClosedHandle}, ts)
101−
102−-- | Use a more efficient buffer size if we're reading in
103−-- block-buffered mode with the default buffer size.
104−chooseGoodBuffering :: Handle -> IO ()
105−chooseGoodBuffering h = do
106− bufMode <- hGetBuffering h
107− when (bufMode == BlockBuffering Nothing) $
108− hSetBuffering h (BlockBuffering (Just 16384))
109−
110−lazyRead :: Handle -> IO Text
111−lazyRead h = unsafeInterleaveIO $
112− withHandle "hGetContents" h $ \hh -> do
113− case haType hh of
114− ClosedHandle -> return (hh, L.empty)
115− SemiClosedHandle -> lazyReadBuffered h hh
116− _ -> ioException
117− (IOError (Just h) IllegalOperation "hGetContents"
118− "illegal handle type" Nothing Nothing)
119−
120−lazyReadBuffered :: Handle -> Handle__ -> IO (Handle__, Text)
121−lazyReadBuffered h hh@Handle__{..} = do
122− buf <- readIORef haCharBuffer
123− (do t <- readChunk hh buf
124− ts <- lazyRead h
125− return (hh, chunk t ts)) `E.catch` \e -> do
126− (hh', _) <- hClose_help hh
127− if isEOFError e
128− then return $ if isEmptyBuffer buf
129− then (hh', empty)
130− else (hh', L.singleton '\r')
131− else E.throwIO (augmentIOError e "hGetContents" h)
132−
133−-- | Read a single line from a handle.
134−hGetLine :: Handle -> IO Text
135−hGetLine = hGetLineWith L.fromChunks
136−
137−-- | Write a string to a handle.
138−hPutStr :: Handle -> Text -> IO ()
139−hPutStr h = mapM_ (T.hPutStr h) . L.toChunks
140−
141−-- | Write a string to a handle, followed by a newline.
142−hPutStrLn :: Handle -> Text -> IO ()
143−hPutStrLn h t = hPutStr h t >> hPutChar h '\n'
144−
145−-- | The 'interact' function takes a function of type @Text -> Text@
146−-- as its argument. The entire input from the standard input device is
147−-- passed (lazily) to this function as its argument, and the resulting
148−-- string is output on the standard output device.
149−interact :: (Text -> Text) -> IO ()
150−interact f = putStr . f =<< getContents
151−
152−-- | Lazily read all user input on 'stdin' as a single string.
153−getContents :: IO Text
154−getContents = hGetContents stdin
155−
156−-- | Read a single line of user input from 'stdin'.
157−getLine :: IO Text
158−getLine = hGetLine stdin
159−
160−-- | Write a string to 'stdout'.
161−putStr :: Text -> IO ()
162−putStr = hPutStr stdout
163−
164−-- | Write a string to 'stdout', followed by a newline.
165−putStrLn :: Text -> IO ()
166−putStrLn = hPutStrLn stdout
167−
168−-- $locale
169−--
170−-- /Note/: The behaviour of functions in this module depends on the
171−-- version of GHC you are using.
172−--
173−-- Beginning with GHC 6.12, text I\/O is performed using the system or
174−-- handle's current locale and line ending conventions.
175−--
176−-- Under GHC 6.10 and earlier, the system I\/O libraries /do not
177−-- support/ locale-sensitive I\/O or line ending conversion. On these
178−-- versions of GHC, functions in this library all use UTF-8. What
179−-- does this mean in practice?
180−--
181−-- * All data that is read will be decoded as UTF-8.
182−--
183−-- * Before data is written, it is first encoded as UTF-8.
184−--
185−-- * On both reading and writing, the platform's native newline
186−-- conversion is performed.
187−--
188−-- If you must use a non-UTF-8 locale on an older version of GHC, you
189−-- will have to perform the transcoding yourself, e.g. as follows:
190−--
191−-- > import qualified Data.ByteString.Lazy as B
192−-- > import Data.Text.Lazy (Text)
193−-- > import Data.Text.Lazy.Encoding (encodeUtf16)
194−-- >
195−-- > putStr_Utf16LE :: Text -> IO ()
196−-- > putStr_Utf16LE t = B.putStr (encodeUtf16LE t)
Data/Text/Lazy/Internal.hs+91−9
@@ -1,20 +1,102 @@
1{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
1{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
2-- |
2-- |
3-- Module : Data.Text.Lazy.Internal
3-- Module : Data.Text.Lazy.Internal
4−-- Copyright : (c) 2013 Bryan O'Sullivan
4+-- Copyright : (c) Bryan O'Sullivan 2009
5--
5--
6-- License : BSD-style
6-- License : BSD-style
7−-- Maintainer : bos@serpentine.com
7+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,
8+-- duncan@haskell.org
8-- Stability : experimental
9-- Stability : experimental
9-- Portability : GHC
10-- Portability : GHC
10−--
11+--
11−-- This module has been renamed to 'Data.Text.Internal.Lazy'. This
12+-- A module containing semi-public 'Text' internals. This exposes the
12−-- name for the module will be removed in the next major release.
13+-- 'Text' representation and low level construction functions.
13−
14+-- Modules which extend the 'Text' system may need to use this module.
15+-- Regular users should not.
14module Data.Text.Lazy.Internal
16module Data.Text.Lazy.Internal
15− {-# DEPRECATED "Use Data.Text.Internal.Lazy instead" #-}
16 (
17 (
17− module Data.Text.Internal.Lazy
18+ Text(..)
19+ , chunk
20+ , empty
21+ , foldrChunks
22+ , foldlChunks
23+ -- * Data type invariant and abstraction functions
24+ , invariant
25+ , checkInvariant
26+ , showStructure
27+ -- * Chunk allocation sizes
28+ , defaultChunkSize
29+ , smallChunkSize
30+ , chunkOverhead
18 ) where
31 ) where
19
32
20−import Data.Text.Internal.Lazy
33+import qualified Data.Text.Internal as T
34+import qualified Data.Text as T
35+import Data.Typeable (Typeable)
36+import Data.Word (Word16)
37+import Foreign.Storable (sizeOf)
38+
39+data Text = Empty
40+ | Chunk {-# UNPACK #-} !T.Text Text
41+ deriving (Typeable)
42+
43+-- | The data type invariant: Every 'Text' is either 'Empty' or
44+-- consists of non-null 'T.Text's. All functions must preserve this,
45+-- and the QC properties must check this.
46+invariant :: Text -> Bool
47+invariant Empty = True
48+invariant (Chunk (T.Text _ _ len) cs) = len > 0 && invariant cs
49+
50+showStructure :: Text -> String
51+showStructure Empty = "Empty"
52+showStructure (Chunk t Empty) = "Chunk " ++ show t ++ " Empty"
53+showStructure (Chunk t ts) =
54+ "Chunk " ++ show t ++ " (" ++ showStructure ts ++ ")"
55+
56+-- | In a form that checks the invariant lazily.
57+checkInvariant :: Text -> Text
58+checkInvariant Empty = Empty
59+checkInvariant (Chunk c@(T.Text _ _ len) cs)
60+ | len > 0 = Chunk c (checkInvariant cs)
61+ | otherwise = error $ "Data.Text.Lazy: invariant violation: "
62+ ++ showStructure (Chunk c cs)
63+
64+-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.
65+chunk :: T.Text -> Text -> Text
66+{-# INLINE chunk #-}
67+chunk t@(T.Text _ _ len) ts | len == 0 = ts
68+ | otherwise = Chunk t ts
69+
70+-- | Smart constructor for 'Empty'.
71+empty :: Text
72+{-# INLINE [0] empty #-}
73+empty = Empty
74+
75+-- | Consume the chunks of a lazy 'Text' with a natural right fold.
76+foldrChunks :: (T.Text -> a -> a) -> a -> Text -> a
77+foldrChunks f z = go
78+ where go Empty = z
79+ go (Chunk c cs) = f c (go cs)
80+{-# INLINE foldrChunks #-}
81+
82+-- | Consume the chunks of a lazy 'Text' with a strict, tail-recursive,
83+-- accumulating left fold.
84+foldlChunks :: (a -> T.Text -> a) -> a -> Text -> a
85+foldlChunks f z = go z
86+ where go !a Empty = a
87+ go !a (Chunk c cs) = go (f a c) cs
88+{-# INLINE foldlChunks #-}
89+
90+-- | Currently set to 32k, less the memory management overhead.
91+defaultChunkSize :: Int
92+defaultChunkSize = 32 * k - chunkOverhead
93+ where k = 1024 `div` sizeOf (undefined :: Word16)
94+
95+-- | Currently set to 4k, less the memory management overhead.
96+smallChunkSize :: Int
97+smallChunkSize = 4 * k - chunkOverhead
98+ where k = 1024 `div` sizeOf (undefined :: Word16)
99+
100+-- | The memory management overhead. Currently this is tuned for GHC only.
101+chunkOverhead :: Int
102+chunkOverhead = 2 * sizeOf (undefined :: Int)
Data/Text/Lazy/Read.hsdeleted−193
@@ -1,193 +0,0 @@
1−{-# LANGUAGE OverloadedStrings, CPP #-}
2−#if __GLASGOW_HASKELL__ >= 704
3−{-# LANGUAGE Safe #-}
4−#elif __GLASGOW_HASKELL__ >= 702
5−{-# LANGUAGE Trustworthy #-}
6−#endif
7−
8−-- |
9−-- Module : Data.Text.Lazy.Read
10−-- Copyright : (c) 2010, 2011 Bryan O'Sullivan
11−--
12−-- License : BSD-style
13−-- Maintainer : bos@serpentine.com
14−-- Stability : experimental
15−-- Portability : GHC
16−--
17−-- Functions used frequently when reading textual data.
18−module Data.Text.Lazy.Read
19− (
20− Reader
21− , decimal
22− , hexadecimal
23− , signed
24− , rational
25− , double
26− ) where
27−
28−import Control.Monad (liftM)
29−import Data.Char (isDigit, isHexDigit)
30−import Data.Int (Int8, Int16, Int32, Int64)
31−import Data.Ratio ((%))
32−import Data.Text.Internal.Read
33−import Data.Text.Lazy as T
34−import Data.Word (Word, Word8, Word16, Word32, Word64)
35−
36−-- | Read some text. If the read succeeds, return its value and the
37−-- remaining text, otherwise an error message.
38−type Reader a = IReader Text a
39−type Parser = IParser Text
40−
41−-- | Read a decimal integer. The input must begin with at least one
42−-- decimal digit, and is consumed until a non-digit or end of string
43−-- is reached.
44−--
45−-- This function does not handle leading sign characters. If you need
46−-- to handle signed input, use @'signed' 'decimal'@.
47−--
48−-- /Note/: For fixed-width integer types, this function does not
49−-- attempt to detect overflow, so a sufficiently long input may give
50−-- incorrect results. If you are worried about overflow, use
51−-- 'Integer' for your result type.
52−decimal :: Integral a => Reader a
53−{-# SPECIALIZE decimal :: Reader Int #-}
54−{-# SPECIALIZE decimal :: Reader Int8 #-}
55−{-# SPECIALIZE decimal :: Reader Int16 #-}
56−{-# SPECIALIZE decimal :: Reader Int32 #-}
57−{-# SPECIALIZE decimal :: Reader Int64 #-}
58−{-# SPECIALIZE decimal :: Reader Integer #-}
59−{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}
60−{-# SPECIALIZE decimal :: Reader Word8 #-}
61−{-# SPECIALIZE decimal :: Reader Word16 #-}
62−{-# SPECIALIZE decimal :: Reader Word32 #-}
63−{-# SPECIALIZE decimal :: Reader Word64 #-}
64−decimal txt
65− | T.null h = Left "input does not start with a digit"
66− | otherwise = Right (T.foldl' go 0 h, t)
67− where (h,t) = T.span isDigit txt
68− go n d = (n * 10 + fromIntegral (digitToInt d))
69−
70−-- | Read a hexadecimal integer, consisting of an optional leading
71−-- @\"0x\"@ followed by at least one decimal digit. Input is consumed
72−-- until a non-hex-digit or end of string is reached. This function
73−-- is case insensitive.
74−--
75−-- This function does not handle leading sign characters. If you need
76−-- to handle signed input, use @'signed' 'hexadecimal'@.
77−--
78−-- /Note/: For fixed-width integer types, this function does not
79−-- attempt to detect overflow, so a sufficiently long input may give
80−-- incorrect results. If you are worried about overflow, use
81−-- 'Integer' for your result type.
82−hexadecimal :: Integral a => Reader a
83−{-# SPECIALIZE hexadecimal :: Reader Int #-}
84−{-# SPECIALIZE hexadecimal :: Reader Integer #-}
85−hexadecimal txt
86− | h == "0x" || h == "0X" = hex t
87− | otherwise = hex txt
88− where (h,t) = T.splitAt 2 txt
89−
90−hex :: Integral a => Reader a
91−{-# SPECIALIZE hexadecimal :: Reader Int #-}
92−{-# SPECIALIZE hexadecimal :: Reader Int8 #-}
93−{-# SPECIALIZE hexadecimal :: Reader Int16 #-}
94−{-# SPECIALIZE hexadecimal :: Reader Int32 #-}
95−{-# SPECIALIZE hexadecimal :: Reader Int64 #-}
96−{-# SPECIALIZE hexadecimal :: Reader Integer #-}
97−{-# SPECIALIZE hexadecimal :: Reader Word #-}
98−{-# SPECIALIZE hexadecimal :: Reader Word8 #-}
99−{-# SPECIALIZE hexadecimal :: Reader Word16 #-}
100−{-# SPECIALIZE hexadecimal :: Reader Word32 #-}
101−{-# SPECIALIZE hexadecimal :: Reader Word64 #-}
102−hex txt
103− | T.null h = Left "input does not start with a hexadecimal digit"
104− | otherwise = Right (T.foldl' go 0 h, t)
105− where (h,t) = T.span isHexDigit txt
106− go n d = (n * 16 + fromIntegral (hexDigitToInt d))
107−
108−-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and
109−-- apply it to the result of applying the given reader.
110−signed :: Num a => Reader a -> Reader a
111−{-# INLINE signed #-}
112−signed f = runP (signa (P f))
113−
114−-- | Read a rational number.
115−--
116−-- This function accepts an optional leading sign character, followed
117−-- by at least one decimal digit. The syntax similar to that accepted
118−-- by the 'read' function, with the exception that a trailing @\'.\'@
119−-- or @\'e\'@ /not/ followed by a number is not consumed.
120−--
121−-- Examples:
122−--
123−-- >rational "3" == Right (3.0, "")
124−-- >rational "3.1" == Right (3.1, "")
125−-- >rational "3e4" == Right (30000.0, "")
126−-- >rational "3.1e4" == Right (31000.0, "")
127−-- >rational ".3" == Left "input does not start with a digit"
128−-- >rational "e3" == Left "input does not start with a digit"
129−--
130−-- Examples of differences from 'read':
131−--
132−-- >rational "3.foo" == Right (3.0, ".foo")
133−-- >rational "3e" == Right (3.0, "e")
134−rational :: Fractional a => Reader a
135−{-# SPECIALIZE rational :: Reader Double #-}
136−rational = floaty $ \real frac fracDenom -> fromRational $
137− real % 1 + frac % fracDenom
138−
139−-- | Read a rational number.
140−--
141−-- The syntax accepted by this function is the same as for 'rational'.
142−--
143−-- /Note/: This function is almost ten times faster than 'rational',
144−-- but is slightly less accurate.
145−--
146−-- The 'Double' type supports about 16 decimal places of accuracy.
147−-- For 94.2% of numbers, this function and 'rational' give identical
148−-- results, but for the remaining 5.8%, this function loses precision
149−-- around the 15th decimal place. For 0.001% of numbers, this
150−-- function will lose precision at the 13th or 14th decimal place.
151−double :: Reader Double
152−double = floaty $ \real frac fracDenom ->
153− fromIntegral real +
154− fromIntegral frac / fromIntegral fracDenom
155−
156−signa :: Num a => Parser a -> Parser a
157−{-# SPECIALIZE signa :: Parser Int -> Parser Int #-}
158−{-# SPECIALIZE signa :: Parser Int8 -> Parser Int8 #-}
159−{-# SPECIALIZE signa :: Parser Int16 -> Parser Int16 #-}
160−{-# SPECIALIZE signa :: Parser Int32 -> Parser Int32 #-}
161−{-# SPECIALIZE signa :: Parser Int64 -> Parser Int64 #-}
162−{-# SPECIALIZE signa :: Parser Integer -> Parser Integer #-}
163−signa p = do
164− sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
165− if sign == '+' then p else negate `liftM` p
166−
167−char :: (Char -> Bool) -> Parser Char
168−char p = P $ \t -> case T.uncons t of
169− Just (c,t') | p c -> Right (c,t')
170− _ -> Left "character does not match"
171−
172−floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a
173−{-# INLINE floaty #-}
174−floaty f = runP $ do
175− sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
176− real <- P decimal
177− T fraction fracDigits <- perhaps (T 0 0) $ do
178− _ <- char (=='.')
179− digits <- P $ \t -> Right (fromIntegral . T.length $ T.takeWhile isDigit t, t)
180− n <- P decimal
181− return $ T n digits
182− let e c = c == 'e' || c == 'E'
183− power <- perhaps 0 (char e >> signa (P decimal) :: Parser Int)
184− let n = if fracDigits == 0
185− then if power == 0
186− then fromIntegral real
187− else fromIntegral real * (10 ^^ power)
188− else if power == 0
189− then f real fraction (10 ^ fracDigits)
190− else f real fraction (10 ^ fracDigits) * (10 ^^ power)
191− return $! if sign == '+'
192− then n
193− else -n
Data/Text/Read.hsdeleted−201
@@ -1,201 +0,0 @@
1−{-# LANGUAGE OverloadedStrings, UnboxedTuples, CPP #-}
2−#if __GLASGOW_HASKELL__ >= 702
3−{-# LANGUAGE Trustworthy #-}
4−#endif
5−
6−-- |
7−-- Module : Data.Text.Read
8−-- Copyright : (c) 2010, 2011 Bryan O'Sullivan
9−--
10−-- License : BSD-style
11−-- Maintainer : bos@serpentine.com
12−-- Stability : experimental
13−-- Portability : GHC
14−--
15−-- Functions used frequently when reading textual data.
16−module Data.Text.Read
17− (
18− Reader
19− , decimal
20− , hexadecimal
21− , signed
22− , rational
23− , double
24− ) where
25−
26−import Control.Monad (liftM)
27−import Data.Char (isDigit, isHexDigit)
28−import Data.Int (Int8, Int16, Int32, Int64)
29−import Data.Ratio ((%))
30−import Data.Text as T
31−import Data.Text.Internal.Private (span_)
32−import Data.Text.Internal.Read
33−import Data.Word (Word, Word8, Word16, Word32, Word64)
34−
35−-- | Read some text. If the read succeeds, return its value and the
36−-- remaining text, otherwise an error message.
37−type Reader a = IReader Text a
38−type Parser a = IParser Text a
39−
40−-- | Read a decimal integer. The input must begin with at least one
41−-- decimal digit, and is consumed until a non-digit or end of string
42−-- is reached.
43−--
44−-- This function does not handle leading sign characters. If you need
45−-- to handle signed input, use @'signed' 'decimal'@.
46−--
47−-- /Note/: For fixed-width integer types, this function does not
48−-- attempt to detect overflow, so a sufficiently long input may give
49−-- incorrect results. If you are worried about overflow, use
50−-- 'Integer' for your result type.
51−decimal :: Integral a => Reader a
52−{-# SPECIALIZE decimal :: Reader Int #-}
53−{-# SPECIALIZE decimal :: Reader Int8 #-}
54−{-# SPECIALIZE decimal :: Reader Int16 #-}
55−{-# SPECIALIZE decimal :: Reader Int32 #-}
56−{-# SPECIALIZE decimal :: Reader Int64 #-}
57−{-# SPECIALIZE decimal :: Reader Integer #-}
58−{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}
59−{-# SPECIALIZE decimal :: Reader Word8 #-}
60−{-# SPECIALIZE decimal :: Reader Word16 #-}
61−{-# SPECIALIZE decimal :: Reader Word32 #-}
62−{-# SPECIALIZE decimal :: Reader Word64 #-}
63−decimal txt
64− | T.null h = Left "input does not start with a digit"
65− | otherwise = Right (T.foldl' go 0 h, t)
66− where (# h,t #) = span_ isDigit txt
67− go n d = (n * 10 + fromIntegral (digitToInt d))
68−
69−-- | Read a hexadecimal integer, consisting of an optional leading
70−-- @\"0x\"@ followed by at least one decimal digit. Input is consumed
71−-- until a non-hex-digit or end of string is reached. This function
72−-- is case insensitive.
73−--
74−-- This function does not handle leading sign characters. If you need
75−-- to handle signed input, use @'signed' 'hexadecimal'@.
76−--
77−-- /Note/: For fixed-width integer types, this function does not
78−-- attempt to detect overflow, so a sufficiently long input may give
79−-- incorrect results. If you are worried about overflow, use
80−-- 'Integer' for your result type.
81−hexadecimal :: Integral a => Reader a
82−{-# SPECIALIZE hexadecimal :: Reader Int #-}
83−{-# SPECIALIZE hexadecimal :: Reader Int8 #-}
84−{-# SPECIALIZE hexadecimal :: Reader Int16 #-}
85−{-# SPECIALIZE hexadecimal :: Reader Int32 #-}
86−{-# SPECIALIZE hexadecimal :: Reader Int64 #-}
87−{-# SPECIALIZE hexadecimal :: Reader Integer #-}
88−{-# SPECIALIZE hexadecimal :: Reader Word #-}
89−{-# SPECIALIZE hexadecimal :: Reader Word8 #-}
90−{-# SPECIALIZE hexadecimal :: Reader Word16 #-}
91−{-# SPECIALIZE hexadecimal :: Reader Word32 #-}
92−{-# SPECIALIZE hexadecimal :: Reader Word64 #-}
93−hexadecimal txt
94− | h == "0x" || h == "0X" = hex t
95− | otherwise = hex txt
96− where (h,t) = T.splitAt 2 txt
97−
98−hex :: Integral a => Reader a
99−{-# SPECIALIZE hex :: Reader Int #-}
100−{-# SPECIALIZE hex :: Reader Int8 #-}
101−{-# SPECIALIZE hex :: Reader Int16 #-}
102−{-# SPECIALIZE hex :: Reader Int32 #-}
103−{-# SPECIALIZE hex :: Reader Int64 #-}
104−{-# SPECIALIZE hex :: Reader Integer #-}
105−{-# SPECIALIZE hex :: Reader Word #-}
106−{-# SPECIALIZE hex :: Reader Word8 #-}
107−{-# SPECIALIZE hex :: Reader Word16 #-}
108−{-# SPECIALIZE hex :: Reader Word32 #-}
109−{-# SPECIALIZE hex :: Reader Word64 #-}
110−hex txt
111− | T.null h = Left "input does not start with a hexadecimal digit"
112− | otherwise = Right (T.foldl' go 0 h, t)
113− where (# h,t #) = span_ isHexDigit txt
114− go n d = (n * 16 + fromIntegral (hexDigitToInt d))
115−
116−-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and
117−-- apply it to the result of applying the given reader.
118−signed :: Num a => Reader a -> Reader a
119−{-# INLINE signed #-}
120−signed f = runP (signa (P f))
121−
122−-- | Read a rational number.
123−--
124−-- This function accepts an optional leading sign character, followed
125−-- by at least one decimal digit. The syntax similar to that accepted
126−-- by the 'read' function, with the exception that a trailing @\'.\'@
127−-- or @\'e\'@ /not/ followed by a number is not consumed.
128−--
129−-- Examples (with behaviour identical to 'read'):
130−--
131−-- >rational "3" == Right (3.0, "")
132−-- >rational "3.1" == Right (3.1, "")
133−-- >rational "3e4" == Right (30000.0, "")
134−-- >rational "3.1e4" == Right (31000.0, "")
135−-- >rational ".3" == Left "input does not start with a digit"
136−-- >rational "e3" == Left "input does not start with a digit"
137−--
138−-- Examples of differences from 'read':
139−--
140−-- >rational "3.foo" == Right (3.0, ".foo")
141−-- >rational "3e" == Right (3.0, "e")
142−rational :: Fractional a => Reader a
143−{-# SPECIALIZE rational :: Reader Double #-}
144−rational = floaty $ \real frac fracDenom -> fromRational $
145− real % 1 + frac % fracDenom
146−
147−-- | Read a rational number.
148−--
149−-- The syntax accepted by this function is the same as for 'rational'.
150−--
151−-- /Note/: This function is almost ten times faster than 'rational',
152−-- but is slightly less accurate.
153−--
154−-- The 'Double' type supports about 16 decimal places of accuracy.
155−-- For 94.2% of numbers, this function and 'rational' give identical
156−-- results, but for the remaining 5.8%, this function loses precision
157−-- around the 15th decimal place. For 0.001% of numbers, this
158−-- function will lose precision at the 13th or 14th decimal place.
159−double :: Reader Double
160−double = floaty $ \real frac fracDenom ->
161− fromIntegral real +
162− fromIntegral frac / fromIntegral fracDenom
163−
164−signa :: Num a => Parser a -> Parser a
165−{-# SPECIALIZE signa :: Parser Int -> Parser Int #-}
166−{-# SPECIALIZE signa :: Parser Int8 -> Parser Int8 #-}
167−{-# SPECIALIZE signa :: Parser Int16 -> Parser Int16 #-}
168−{-# SPECIALIZE signa :: Parser Int32 -> Parser Int32 #-}
169−{-# SPECIALIZE signa :: Parser Int64 -> Parser Int64 #-}
170−{-# SPECIALIZE signa :: Parser Integer -> Parser Integer #-}
171−signa p = do
172− sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
173− if sign == '+' then p else negate `liftM` p
174−
175−char :: (Char -> Bool) -> Parser Char
176−char p = P $ \t -> case T.uncons t of
177− Just (c,t') | p c -> Right (c,t')
178− _ -> Left "character does not match"
179−
180−floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a
181−{-# INLINE floaty #-}
182−floaty f = runP $ do
183− sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
184− real <- P decimal
185− T fraction fracDigits <- perhaps (T 0 0) $ do
186− _ <- char (=='.')
187− digits <- P $ \t -> Right (T.length $ T.takeWhile isDigit t, t)
188− n <- P decimal
189− return $ T n digits
190− let e c = c == 'e' || c == 'E'
191− power <- perhaps 0 (char e >> signa (P decimal) :: Parser Int)
192− let n = if fracDigits == 0
193− then if power == 0
194− then fromIntegral real
195− else fromIntegral real * (10 ^^ power)
196− else if power == 0
197− then f real fraction (10 ^ fracDigits)
198− else f real fraction (10 ^ fracDigits) * (10 ^^ power)
199− return $! if sign == '+'
200− then n
201− else -n
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+31−75
@@ -1,9 +1,9 @@
1−{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
2-- |
1-- |
3-- Module : Data.Text.Unsafe
2-- Module : Data.Text.Unsafe
4−-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
3+-- Copyright : (c) Bryan O'Sullivan 2009
5-- License : BSD-style
4-- License : BSD-style
6−-- Maintainer : bos@serpentine.com
5+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,
6+-- duncan@haskell.org
7-- Stability : experimental
7-- Stability : experimental
8-- Portability : portable
8-- Portability : portable
9--
9--
@@ -11,113 +11,69 @@
11-- use in heavily tested code.
11-- use in heavily tested code.
12module Data.Text.Unsafe
12module Data.Text.Unsafe
13 (
13 (
14− inlineInterleaveST
14+ iter
15− , inlinePerformIO
16− , unsafeDupablePerformIO
17− , Iter(..)
18− , iter
19 , iter_
15 , iter_
20 , reverseIter
16 , reverseIter
21− , reverseIter_
22 , unsafeHead
17 , unsafeHead
23 , unsafeTail
18 , unsafeTail
24− , lengthWord16
25− , takeWord16
26− , dropWord16
27 ) where
19 ) where
28−
20+
29−#if defined(ASSERTS)
30import Control.Exception (assert)
21import Control.Exception (assert)
31−#endif
32−import Data.Text.Internal.Encoding.Utf16 (chr2)
33import Data.Text.Internal (Text(..))
22import Data.Text.Internal (Text(..))
34−import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)
23+import Data.Text.UnsafeChar (unsafeChr)
35−import Data.Text.Internal.Unsafe.Char (unsafeChr)
24+import Data.Text.Encoding.Utf16 (chr2)
36import qualified Data.Text.Array as A
25import qualified Data.Text.Array as A
37−import GHC.IO (unsafeDupablePerformIO)
38
26
39-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'
27-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'
40-- omits the check for the empty case, so there is an obligation on
28-- omits the check for the empty case, so there is an obligation on
41-- the programmer to provide a proof that the 'Text' is non-empty.
29-- the programmer to provide a proof that the 'Text' is non-empty.
42unsafeHead :: Text -> Char
30unsafeHead :: Text -> Char
43−unsafeHead (Text arr off _len)
31+unsafeHead (Text arr off len)
44 | m < 0xD800 || m > 0xDBFF = unsafeChr m
32 | m < 0xD800 || m > 0xDBFF = unsafeChr m
45 | otherwise = chr2 m n
33 | otherwise = chr2 m n
46− where m = A.unsafeIndex arr off
34+ where m = assert (len > 0) $ A.unsafeIndex arr off
47− n = A.unsafeIndex arr (off+1)
35+ n = assert (len > 1) $ A.unsafeIndex arr (off+1)
48{-# INLINE unsafeHead #-}
36{-# INLINE unsafeHead #-}
49
37
50−-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'
38+-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeHead'
51-- omits the check for the empty case, so there is an obligation on
39-- omits the check for the empty case, so there is an obligation on
52-- the programmer to provide a proof that the 'Text' is non-empty.
40-- the programmer to provide a proof that the 'Text' is non-empty.
53unsafeTail :: Text -> Text
41unsafeTail :: Text -> Text
54unsafeTail t@(Text arr off len) =
42unsafeTail t@(Text arr off len) =
55−#if defined(ASSERTS)
43+ assert (d <= len) $ Text arr (off+d) (len-d)
56− assert (d <= len) $
57−#endif
58− Text arr (off+d) (len-d)
59 where d = iter_ t 0
44 where d = iter_ t 0
60{-# INLINE unsafeTail #-}
45{-# INLINE unsafeTail #-}
61
46
62−data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int
47+-- | /O(1)/ Iterate one step forwards through a UTF-16 array,
63−
48+-- returning the current character and the delta to add to give the
64−-- | /O(1)/ Iterate (unsafely) one step forwards through a UTF-16
49+-- next offset to iterate at.
65−-- array, returning the current character and the delta to add to give
50+iter :: Text -> Int -> (Char,Int)
66−-- the next offset to iterate at.
51+iter (Text arr off len) i
67−iter :: Text -> Int -> Iter
52+ | m < 0xD800 || m > 0xDBFF = (unsafeChr m, 1)
68−iter (Text arr off _len) i
53+ | otherwise = (chr2 m n, 2)
69− | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1
54+ where m = assert (i < len) $ A.unsafeIndex arr j
70− | otherwise = Iter (chr2 m n) 2
55+ n = assert (i + 1 < len) $ A.unsafeIndex arr k
71− where m = A.unsafeIndex arr j
56+ j = assert (i >= 0) $ off + i
72− n = A.unsafeIndex arr k
57+ k = j + 1
73− j = off + i
74− k = j + 1
75{-# INLINE iter #-}
58{-# INLINE iter #-}
76
59
77-- | /O(1)/ Iterate one step through a UTF-16 array, returning the
60-- | /O(1)/ Iterate one step through a UTF-16 array, returning the
78-- delta to add to give the next offset to iterate at.
61-- delta to add to give the next offset to iterate at.
79iter_ :: Text -> Int -> Int
62iter_ :: Text -> Int -> Int
80−iter_ (Text arr off _len) i | m < 0xD800 || m > 0xDBFF = 1
63+iter_ (Text arr off len) i | m < 0xD800 || m > 0xDBFF = 1
81− | otherwise = 2
64+ | otherwise = 2
82− where m = A.unsafeIndex arr (off+i)
65+ where m = assert (i >= 0 && i < len) $ A.unsafeIndex arr (off+i)
83{-# INLINE iter_ #-}
66{-# INLINE iter_ #-}
84
67
85-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
68-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
86-- returning the current character and the delta to add (i.e. a
69-- returning the current character and the delta to add (i.e. a
87-- negative number) to give the next offset to iterate at.
70-- negative number) to give the next offset to iterate at.
88reverseIter :: Text -> Int -> (Char,Int)
71reverseIter :: Text -> Int -> (Char,Int)
89−reverseIter (Text arr off _len) i
72+reverseIter (Text arr off len) i
90 | m < 0xDC00 || m > 0xDFFF = (unsafeChr m, -1)
73 | m < 0xDC00 || m > 0xDFFF = (unsafeChr m, -1)
91 | otherwise = (chr2 n m, -2)
74 | otherwise = (chr2 n m, -2)
92− where m = A.unsafeIndex arr j
75+ where m = assert (i < len) $ A.unsafeIndex arr j
93− n = A.unsafeIndex arr k
76+ n = assert (i - 1 >= 0) $ A.unsafeIndex arr k
94− j = off + i
77+ j = assert (i >= 0) $ off + i
95− k = j - 1
78+ k = j - 1
96{-# INLINE reverseIter #-}
79{-# INLINE reverseIter #-}
97−
98−-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
99−-- returning the delta to add (i.e. a negative number) to give the
100−-- next offset to iterate at.
101−reverseIter_ :: Text -> Int -> Int
102−reverseIter_ (Text arr off _len) i
103− | m < 0xDC00 || m > 0xDFFF = -1
104− | otherwise = -2
105− where m = A.unsafeIndex arr (off+i)
106−{-# INLINE reverseIter_ #-}
107−
108−-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
109−-- is useful for sizing a target array appropriately before using
110−-- 'unsafeCopyToPtr'.
111−lengthWord16 :: Text -> Int
112−lengthWord16 (Text _arr _off len) = len
113−{-# INLINE lengthWord16 #-}
114−
115−-- | /O(1)/ Unchecked take of 'k' 'Word16's from the front of a 'Text'.
116−takeWord16 :: Int -> Text -> Text
117−takeWord16 k (Text arr off _len) = Text arr off k
118−{-# INLINE takeWord16 #-}
119−
120−-- | /O(1)/ Unchecked drop of 'k' 'Word16's from the front of a 'Text'.
121−dropWord16 :: Int -> Text -> Text
122−dropWord16 k (Text arr off len) = Text arr (off+k) (len-k)
123−{-# INLINE dropWord16 #-}
Data/Text/Internal/Unsafe/Char.hs → Data/Text/UnsafeChar.hsrenamed+20−37
@@ -1,45 +1,36 @@
1−{-# LANGUAGE CPP, MagicHash #-}
1+{-# LANGUAGE MagicHash #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Internal.Unsafe.Char
4+-- Module : Data.Text.UnsafeChar
5−-- Copyright : (c) 2008, 2009 Tom Harper,
5+-- Copyright : (c) Tom Harper 2008-2009,
6−-- (c) 2009, 2010 Bryan O'Sullivan,
6+-- (c) Bryan O'Sullivan 2009,
7−-- (c) 2009 Duncan Coutts
7+-- (c) Duncan Coutts 2009
8--
8--
9-- License : BSD-style
9-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,
11+-- duncan@haskell.org
11-- Stability : experimental
12-- Stability : experimental
12-- Portability : GHC
13-- Portability : GHC
13--
14--
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−--
18-- Fast character manipulation functions.
15-- Fast character manipulation functions.
19−module Data.Text.Internal.Unsafe.Char
16+module Data.Text.UnsafeChar
20 (
17 (
21− ord
18+ unsafeChr
22− , unsafeChr
23 , unsafeChr8
19 , unsafeChr8
24 , unsafeChr32
20 , unsafeChr32
25 , unsafeWrite
21 , unsafeWrite
26− -- , unsafeWriteRev
22+ , unsafeWriteRev
27 ) where
23 ) where
28
24
29−#ifdef ASSERTS
30import Control.Exception (assert)
25import Control.Exception (assert)
31−#endif
32import Control.Monad.ST (ST)
26import Control.Monad.ST (ST)
33import Data.Bits ((.&.))
27import Data.Bits ((.&.))
34−import Data.Text.Internal.Unsafe.Shift (shiftR)
28+import Data.Char (ord)
35−import GHC.Exts (Char(..), Int(..), chr#, ord#, word2Int#)
29+import Data.Text.UnsafeShift (shiftR)
30+import GHC.Exts (Char(..), chr#, word2Int#)
36import GHC.Word (Word8(..), Word16(..), Word32(..))
31import GHC.Word (Word8(..), Word16(..), Word32(..))
37import qualified Data.Text.Array as A
32import qualified Data.Text.Array as A
38
33
39−ord :: Char -> Int
40−ord (C# c#) = I# (ord# c#)
41−{-# INLINE ord #-}
42−
43unsafeChr :: Word16 -> Char
34unsafeChr :: Word16 -> Char
44unsafeChr (W16# w#) = C# (chr# (word2Int# w#))
35unsafeChr (W16# w#) = C# (chr# (word2Int# w#))
45{-# INLINE unsafeChr #-}
36{-# INLINE unsafeChr #-}
@@ -52,30 +43,23 @@ unsafeChr32 :: Word32 -> Char
52unsafeChr32 (W32# w#) = C# (chr# (word2Int# w#))
43unsafeChr32 (W32# w#) = C# (chr# (word2Int# w#))
53{-# INLINE unsafeChr32 #-}
44{-# INLINE unsafeChr32 #-}
54
45
55−-- | Write a character into the array at the given offset. Returns
46+unsafeWrite :: A.MArray s Word16 -> Int -> Char -> ST s Int
56−-- the number of 'Word16's written.
57−unsafeWrite :: A.MArray s -> Int -> Char -> ST s Int
58unsafeWrite marr i c
47unsafeWrite marr i c
59 | n < 0x10000 = do
48 | n < 0x10000 = do
60−#if defined(ASSERTS)
49+ assert (i >= 0) . assert (i < A.length marr) $
61− assert (i >= 0) . assert (i < A.length marr) $ return ()
50+ A.unsafeWrite marr i (fromIntegral n)
62−#endif
51+ return (i+1)
63− A.unsafeWrite marr i (fromIntegral n)
64− return 1
65 | otherwise = do
52 | otherwise = do
66−#if defined(ASSERTS)
53+ assert (i >= 0) . assert (i < A.length marr - 1) $
67− assert (i >= 0) . assert (i < A.length marr - 1) $ return ()
54+ A.unsafeWrite marr i lo
68−#endif
69− A.unsafeWrite marr i lo
70 A.unsafeWrite marr (i+1) hi
55 A.unsafeWrite marr (i+1) hi
71− return 2
56+ return (i+2)
72 where n = ord c
57 where n = ord c
73 m = n - 0x10000
58 m = n - 0x10000
74 lo = fromIntegral $ (m `shiftR` 10) + 0xD800
59 lo = fromIntegral $ (m `shiftR` 10) + 0xD800
75 hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
60 hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
76{-# INLINE unsafeWrite #-}
61{-# INLINE unsafeWrite #-}
77
62
78−{-
79unsafeWriteRev :: A.MArray s Word16 -> Int -> Char -> ST s Int
63unsafeWriteRev :: A.MArray s Word16 -> Int -> Char -> ST s Int
80unsafeWriteRev marr i c
64unsafeWriteRev marr i c
81 | n < 0x10000 = do
65 | n < 0x10000 = do
@@ -92,4 +76,3 @@ unsafeWriteRev marr i c
92 lo = fromIntegral $ (m `shiftR` 10) + 0xD800
76 lo = fromIntegral $ (m `shiftR` 10) + 0xD800
93 hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
77 hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
94{-# INLINE unsafeWriteRev #-}
78{-# INLINE unsafeWriteRev #-}
95−-}
Data/Text/Internal/Unsafe/Shift.hs → Data/Text/UnsafeShift.hsrenamed+7−12
@@ -1,26 +1,23 @@
1{-# LANGUAGE MagicHash #-}
1{-# LANGUAGE MagicHash #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Internal.Unsafe.Shift
4+-- Module : Data.Text.UnsafeShift
5-- Copyright : (c) Bryan O'Sullivan 2009
5-- Copyright : (c) Bryan O'Sullivan 2009
6--
6--
7-- License : BSD-style
7-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
8+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,
9+-- duncan@haskell.org
9-- Stability : experimental
10-- Stability : experimental
10-- Portability : GHC
11-- Portability : GHC
11--
12--
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-- Fast, unchecked bit shifting functions.
13-- Fast, unchecked bit shifting functions.
17
14
18−module Data.Text.Internal.Unsafe.Shift
15+module Data.Text.UnsafeShift
19 (
16 (
20 UnsafeShift(..)
17 UnsafeShift(..)
21 ) where
18 ) where
22
19
23−-- import qualified Data.Bits as Bits
20+import qualified Data.Bits as Bits
24import GHC.Base
21import GHC.Base
25import GHC.Word
22import GHC.Word
26
23
@@ -36,14 +33,14 @@ class UnsafeShift a where
36
33
37instance UnsafeShift Word16 where
34instance UnsafeShift Word16 where
38 {-# INLINE shiftL #-}
35 {-# INLINE shiftL #-}
39− shiftL (W16# x#) (I# i#) = W16# (narrow16Word# (x# `uncheckedShiftL#` i#))
36+ shiftL (W16# x#) (I# i#) = W16# (x# `uncheckedShiftL#` i#)
40
37
41 {-# INLINE shiftR #-}
38 {-# INLINE shiftR #-}
42 shiftR (W16# x#) (I# i#) = W16# (x# `uncheckedShiftRL#` i#)
39 shiftR (W16# x#) (I# i#) = W16# (x# `uncheckedShiftRL#` i#)
43
40
44instance UnsafeShift Word32 where
41instance UnsafeShift Word32 where
45 {-# INLINE shiftL #-}
42 {-# INLINE shiftL #-}
46− shiftL (W32# x#) (I# i#) = W32# (narrow32Word# (x# `uncheckedShiftL#` i#))
43+ shiftL (W32# x#) (I# i#) = W32# (x# `uncheckedShiftL#` i#)
47
44
48 {-# INLINE shiftR #-}
45 {-# INLINE shiftR #-}
49 shiftR (W32# x#) (I# i#) = W32# (x# `uncheckedShiftRL#` i#)
46 shiftR (W32# x#) (I# i#) = W32# (x# `uncheckedShiftRL#` i#)
@@ -62,11 +59,9 @@ instance UnsafeShift Int where
62 {-# INLINE shiftR #-}
59 {-# INLINE shiftR #-}
63 shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#)
60 shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#)
64
61
65−{-
66instance UnsafeShift Integer where
62instance UnsafeShift Integer where
67 {-# INLINE shiftL #-}
63 {-# INLINE shiftL #-}
68 shiftL = Bits.shiftL
64 shiftL = Bits.shiftL
69
65
70 {-# INLINE shiftR #-}
66 {-# INLINE shiftR #-}
71 shiftR = Bits.shiftR
67 shiftR = Bits.shiftR
72−-}
READMEnew file+35
@@ -0,0 +1,35 @@
1+Text: Fast, packed Unicode strings, using stream fusion
2+-------------------------------------------------------
3+
4+This package provides the Data.Text library, a library for the space-
5+and time-efficient manipulation of Unicode text in Haskell.
6+
7+
8+Normalization, conversion, and collation, oh my!
9+------------------------------------------------
10+
11+This library intentionally provides a simple API based on the Haskell
12+prelude's list manipulation functions. For more complicated
13+real-world tasks, such as Unicode normalization, conversion to and
14+from a larger variety of encodings, and collation, use the text-icu
15+package:
16+
17+ http://hackage.haskell.org/cgi-bin/hackage-scripts/package/text-icu
18+
19+That library uses the well-respected and liberally licensed ICU
20+library to provide these facilities.
21+
22+
23+Source code
24+-----------
25+
26+darcs get http://code.haskell.org/text
27+
28+
29+Authors
30+-------
31+
32+The base code for this library was originally written by Tom Harper,
33+based on the stream fusion framework developed by Roman Leshchinskiy,
34+Duncan Coutts, and Don Stewart. The core library was fleshed out,
35+debugged, and tested by Bryan O'Sullivan.
README.markdowndeleted−42
@@ -1,42 +0,0 @@
1−# Text: Fast, packed Unicode strings, using stream fusion
2−
3−This package provides the Data.Text library, a library for the space-
4−and time-efficient manipulation of Unicode text in Haskell.
5−
6−
7−# Normalization, conversion, and collation, oh my!
8−
9−This library intentionally provides a simple API based on the
10−Haskell prelude's list manipulation functions. For more complicated
11−real-world tasks, such as Unicode normalization, conversion to and
12−from a larger variety of encodings, and collation, use the [text-icu
13−package](http://hackage.haskell.org/cgi-bin/hackage-scripts/package/text-icu).
14−
15−That library uses the well-respected and liberally licensed ICU
16−library to provide these facilities.
17−
18−
19−# Get involved!
20−
21−Please report bugs via the
22−[github issue tracker](https://github.com/bos/text/issues).
23−
24−Master [git repository](https://github.com/bos/text):
25−
26−* `git clone git://github.com/bos/text.git`
27−
28−There's also a [Mercurial mirror](https://bitbucket.org/bos/text):
29−
30−* `hg clone https://bitbucket.org/bos/text`
31−
32−(You can create and contribute changes using either Mercurial or git.)
33−
34−
35−# Authors
36−
37−The base code for this library was originally written by Tom Harper,
38−based on the stream fusion framework developed by Roman Leshchinskiy,
39−Duncan Coutts, and Don Stewart.
40−
41−The core library was fleshed out, debugged, and tested by Bryan
42−O'Sullivan <bos@serpentine.com>, and he is the current maintainer.
TODOnew file+6
@@ -0,0 +1,6 @@
1+Normalization.
2+
3+Collation.
4+
5+Case conversion lacks locale sensitivity, so cannot handle a few
6+Turkic and Azeri code points completely correctly.
benchmarks/.gitignoredeleted−1
@@ -1 +0,0 @@
1−dist
benchmarks/Setup.hsdeleted−2
@@ -1,2 +0,0 @@
1−import Distribution.Simple
2−main = defaultMain
benchmarks/cbits/time_iconv.cdeleted−35
@@ -1,35 +0,0 @@
1−#include <iconv.h>
2−#include <stdlib.h>
3−#include <stdio.h>
4−#include <stdint.h>
5−
6−int time_iconv(char *srcbuf, size_t srcbufsize)
7−{
8− uint16_t *destbuf = NULL;
9− size_t destbufsize;
10− static uint16_t *origdestbuf;
11− static size_t origdestbufsize;
12− iconv_t ic = (iconv_t) -1;
13− int ret = 0;
14−
15− if (ic == (iconv_t) -1) {
16− ic = iconv_open("UTF-16LE", "UTF-8");
17− if (ic == (iconv_t) -1) {
18− ret = -1;
19− goto done;
20− }
21− }
22−
23− destbufsize = srcbufsize * sizeof(uint16_t);
24− if (destbufsize > origdestbufsize) {
25− free(origdestbuf);
26− origdestbuf = destbuf = malloc(origdestbufsize = destbufsize);
27− } else {
28− destbuf = origdestbuf;
29− }
30−
31− iconv(ic, &srcbuf, &srcbufsize, (char**) &destbuf, &destbufsize);
32−
33− done:
34− return ret;
35−}
benchmarks/haskell/Benchmarks.hsdeleted−79
@@ -1,79 +0,0 @@
1−-- | Main module to run the micro benchmarks
2−--
3−{-# LANGUAGE OverloadedStrings #-}
4−module Main
5− ( main
6− ) where
7−
8−import Criterion.Main (Benchmark, defaultMain, bgroup)
9−import System.FilePath ((</>))
10−import System.IO (IOMode (WriteMode), openFile, hSetEncoding, utf8)
11−
12−import qualified Benchmarks.Builder as Builder
13−import qualified Benchmarks.DecodeUtf8 as DecodeUtf8
14−import qualified Benchmarks.EncodeUtf8 as EncodeUtf8
15−import qualified Benchmarks.Equality as Equality
16−import qualified Benchmarks.FileRead as FileRead
17−import qualified Benchmarks.FoldLines as FoldLines
18−import qualified Benchmarks.Mul as Mul
19−import qualified Benchmarks.Pure as Pure
20−import qualified Benchmarks.ReadNumbers as ReadNumbers
21−import qualified Benchmarks.Replace as Replace
22−import qualified Benchmarks.Search as Search
23−import qualified Benchmarks.Stream as Stream
24−import qualified Benchmarks.WordFrequencies as WordFrequencies
25−
26−import qualified Benchmarks.Programs.BigTable as Programs.BigTable
27−import qualified Benchmarks.Programs.Cut as Programs.Cut
28−import qualified Benchmarks.Programs.Fold as Programs.Fold
29−import qualified Benchmarks.Programs.Sort as Programs.Sort
30−import qualified Benchmarks.Programs.StripTags as Programs.StripTags
31−import qualified Benchmarks.Programs.Throughput as Programs.Throughput
32−
33−main :: IO ()
34−main = benchmarks >>= defaultMain
35−
36−benchmarks :: IO [Benchmark]
37−benchmarks = do
38− sink <- openFile "/dev/null" WriteMode
39− hSetEncoding sink utf8
40−
41− -- Traditional benchmarks
42− bs <- sequence
43− [ Builder.benchmark
44− , DecodeUtf8.benchmark "html" (tf "libya-chinese.html")
45− , DecodeUtf8.benchmark "xml" (tf "yiwiki.xml")
46− , DecodeUtf8.benchmark "ascii" (tf "ascii.txt")
47− , DecodeUtf8.benchmark "russian" (tf "russian.txt")
48− , DecodeUtf8.benchmark "japanese" (tf "japanese.txt")
49− , EncodeUtf8.benchmark "επανάληψη 竺法蘭共譯"
50− , Equality.benchmark (tf "japanese.txt")
51− , FileRead.benchmark (tf "russian.txt")
52− , 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")
58− , Pure.benchmark "japanese" (tf "japanese.txt")
59− , ReadNumbers.benchmark (tf "numbers.txt")
60− , Replace.benchmark (tf "russian.txt") "принимая" "своем"
61− , Search.benchmark (tf "russian.txt") "принимая"
62− , Stream.benchmark (tf "russian.txt")
63− , WordFrequencies.benchmark (tf "russian.txt")
64− ]
65−
66− -- Program-like benchmarks
67− ps <- bgroup "Programs" `fmap` sequence
68− [ Programs.BigTable.benchmark sink
69− , Programs.Cut.benchmark (tf "russian.txt") sink 20 40
70− , Programs.Fold.benchmark (tf "russian.txt") sink
71− , Programs.Sort.benchmark (tf "russian.txt") sink
72− , Programs.StripTags.benchmark (tf "yiwiki.xml") sink
73− , Programs.Throughput.benchmark (tf "russian.txt") sink
74− ]
75−
76− return $ bs ++ [ps]
77− where
78− -- Location of a test file
79− tf = ("../tests/text-test-data" </>)
benchmarks/haskell/Benchmarks/Builder.hsdeleted−75
@@ -1,75 +0,0 @@
1−-- | Testing the internal builder monoid
2−--
3−-- Tested in this benchmark:
4−--
5−-- * Concatenating many small strings using a builder
6−--
7−{-# LANGUAGE OverloadedStrings #-}
8−module Benchmarks.Builder
9− ( benchmark
10− ) where
11−
12−import Criterion (Benchmark, bgroup, bench, nf)
13−import Data.Binary.Builder as B
14−import Data.ByteString.Char8 ()
15−import Data.Monoid (mconcat, mempty)
16−import qualified Blaze.ByteString.Builder as Blaze
17−import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze
18−import qualified Data.ByteString as SB
19−import qualified Data.ByteString.Lazy as LB
20−import qualified Data.Text as T
21−import qualified Data.Text.Lazy as LT
22−import qualified Data.Text.Lazy.Builder as LTB
23−import qualified Data.Text.Lazy.Builder.Int as Int
24−import Data.Int (Int64)
25−
26−benchmark :: IO Benchmark
27−benchmark = return $ bgroup "Builder"
28− [ bgroup "Comparison"
29− [ bench "LazyText" $ nf
30− (LT.length . LTB.toLazyText . mconcat . map LTB.fromText) texts
31− , bench "Binary" $ nf
32− (LB.length . B.toLazyByteString . mconcat . map B.fromByteString)
33− byteStrings
34− , bench "Blaze" $ nf
35− (LB.length . Blaze.toLazyByteString . mconcat . map Blaze.fromString)
36− strings
37− ]
38− , bgroup "Int"
39− [ bgroup "Decimal"
40− [ bgroup "Positive" .
41− flip map numbers $ \n ->
42− (bench (show (length (show n))) $ nf (LTB.toLazyText . Int.decimal) n)
43− , bgroup "Negative" .
44− flip map numbers $ \m ->
45− let n = negate m in
46− (bench (show (length (show n))) $ nf (LTB.toLazyText . Int.decimal) n)
47− , bench "Empty" $ nf LTB.toLazyText mempty
48− , bgroup "Show" .
49− flip map numbers $ \n ->
50− (bench (show (length (show n))) $ nf show n)
51− ]
52− ]
53− ]
54− where
55− numbers :: [Int64]
56− numbers = [
57− 6, 14, 500, 9688, 10654, 620735, 5608880, 37010612,
58− 731223504, 5061580596, 24596952933, 711732309084, 2845910093839,
59− 54601756118340, 735159434806159, 3619097625502435, 95777227510267124,
60− 414944309510675693, 8986407456998704019
61− ]
62−
63−texts :: [T.Text]
64−texts = take 200000 $ cycle ["foo", "λx", "由の"]
65−{-# NOINLINE texts #-}
66−
67−-- Note that the non-ascii characters will be chopped
68−byteStrings :: [SB.ByteString]
69−byteStrings = take 200000 $ cycle ["foo", "λx", "由の"]
70−{-# NOINLINE byteStrings #-}
71−
72−-- Note that the non-ascii characters will be chopped
73−strings :: [String]
74−strings = take 200000 $ cycle ["foo", "λx", "由の"]
75−{-# NOINLINE strings #-}
benchmarks/haskell/Benchmarks/DecodeUtf8.hsdeleted−67
@@ -1,67 +0,0 @@
1−{-# LANGUAGE ForeignFunctionInterface #-}
2−
3−-- | Test decoding of UTF-8
4−--
5−-- Tested in this benchmark:
6−--
7−-- * Decoding bytes using UTF-8
8−--
9−-- In some tests:
10−--
11−-- * Taking the length of the result
12−--
13−-- * Taking the init of the result
14−--
15−-- The latter are used for testing stream fusion.
16−--
17−module Benchmarks.DecodeUtf8
18− ( benchmark
19− ) where
20−
21−import Foreign.C.Types
22−import Data.ByteString.Internal (ByteString(..))
23−import Data.ByteString.Lazy.Internal (ByteString(..))
24−import Foreign.Ptr (Ptr, plusPtr)
25−import Foreign.ForeignPtr (withForeignPtr)
26−import Data.Word (Word8)
27−import qualified Criterion as C
28−import Criterion (Benchmark, bgroup, nf, whnfIO)
29−import qualified Codec.Binary.UTF8.Generic as U8
30−import qualified Data.ByteString as B
31−import qualified Data.ByteString.Lazy as BL
32−import qualified Data.Text as T
33−import qualified Data.Text.Encoding as T
34−import qualified Data.Text.Lazy as TL
35−import qualified Data.Text.Lazy.Encoding as TL
36−
37−benchmark :: String -> FilePath -> IO Benchmark
38−benchmark kind fp = do
39− bs <- B.readFile fp
40− lbs <- BL.readFile fp
41− let bench name = C.bench (name ++ "+" ++ kind)
42− decodeStream (Chunk b0 bs0) = case T.streamDecodeUtf8 b0 of
43− T.Some t0 _ f0 -> t0 : go f0 bs0
44− where go f (Chunk b bs1) = case f b of
45− T.Some t1 _ f1 -> t1 : go f1 bs1
46− go _ _ = []
47− decodeStream _ = []
48− return $ bgroup "DecodeUtf8"
49− [ bench "Strict" $ nf T.decodeUtf8 bs
50− , bench "Stream" $ nf decodeStream lbs
51− , bench "IConv" $ whnfIO $ iconv bs
52− , bench "StrictLength" $ nf (T.length . T.decodeUtf8) bs
53− , bench "StrictInitLength" $ nf (T.length . T.init . T.decodeUtf8) bs
54− , bench "Lazy" $ nf TL.decodeUtf8 lbs
55− , bench "LazyLength" $ nf (TL.length . TL.decodeUtf8) lbs
56− , bench "LazyInitLength" $ nf (TL.length . TL.init . TL.decodeUtf8) lbs
57− , bench "StrictStringUtf8" $ nf U8.toString bs
58− , bench "StrictStringUtf8Length" $ nf (length . U8.toString) bs
59− , bench "LazyStringUtf8" $ nf U8.toString lbs
60− , bench "LazyStringUtf8Length" $ nf (length . U8.toString) lbs
61− ]
62−
63−iconv :: B.ByteString -> IO CInt
64−iconv (PS fp off len) = withForeignPtr fp $ \ptr ->
65− time_iconv (ptr `plusPtr` off) (fromIntegral len)
66−
67−foreign import ccall unsafe time_iconv :: Ptr Word8 -> CSize -> IO CInt
benchmarks/haskell/Benchmarks/EncodeUtf8.hsdeleted−33
@@ -1,33 +0,0 @@
1−-- | UTF-8 encode a text
2−--
3−-- Tested in this benchmark:
4−--
5−-- * Replicating a string a number of times
6−--
7−-- * UTF-8 encoding it
8−--
9−module Benchmarks.EncodeUtf8
10− ( benchmark
11− ) where
12−
13−import Criterion (Benchmark, bgroup, bench, whnf)
14−import qualified Data.ByteString as B
15−import qualified Data.ByteString.Lazy as BL
16−import qualified Data.Text as T
17−import qualified Data.Text.Encoding as T
18−import qualified Data.Text.Lazy as TL
19−import qualified Data.Text.Lazy.Encoding as TL
20−
21−benchmark :: String -> IO Benchmark
22−benchmark string = do
23− return $ bgroup "EncodeUtf8"
24− [ bench "Text" $ whnf (B.length . T.encodeUtf8) text
25− , bench "LazyText" $ whnf (BL.length . TL.encodeUtf8) lazyText
26− ]
27− where
28− -- The string in different formats
29− text = T.replicate k $ T.pack string
30− lazyText = TL.replicate (fromIntegral k) $ TL.pack string
31−
32− -- Amount
33− k = 100000
benchmarks/haskell/Benchmarks/Equality.hsdeleted−38
@@ -1,38 +0,0 @@
1−-- | Compare a string with a copy of itself that is identical except
2−-- for the last character.
3−--
4−-- Tested in this benchmark:
5−--
6−-- * Comparison of strings (Eq instance)
7−--
8−module Benchmarks.Equality
9− ( benchmark
10− ) where
11−
12−import Criterion (Benchmark, bgroup, bench, whnf)
13−import qualified Data.ByteString.Char8 as B
14−import qualified Data.ByteString.Lazy.Char8 as BL
15−import qualified Data.Text as T
16−import qualified Data.Text.Encoding as T
17−import qualified Data.Text.Lazy as TL
18−import qualified Data.Text.Lazy.Encoding as TL
19−
20−benchmark :: FilePath -> IO Benchmark
21−benchmark fp = do
22− b <- B.readFile fp
23− bl1 <- BL.readFile fp
24− -- A lazy bytestring is a list of chunks. When we do not explicitly create two
25− -- different lazy bytestrings at a different address, the bytestring library
26− -- will compare the chunk addresses instead of the chunk contents. This is why
27− -- we read the lazy bytestring twice here.
28− bl2 <- BL.readFile fp
29− l <- readFile fp
30− let t = T.decodeUtf8 b
31− tl = TL.decodeUtf8 bl1
32− return $ bgroup "Equality"
33− [ bench "Text" $ whnf (== T.init t `T.snoc` '\xfffd') t
34− , bench "LazyText" $ whnf (== TL.init tl `TL.snoc` '\xfffd') tl
35− , bench "ByteString" $ whnf (== B.init b `B.snoc` '\xfffd') b
36− , bench "LazyByteString" $ whnf (== BL.init bl2 `BL.snoc` '\xfffd') bl1
37− , bench "String" $ whnf (== init l ++ "\xfffd") l
38− ]
benchmarks/haskell/Benchmarks/FileRead.hsdeleted−33
@@ -1,33 +0,0 @@
1−-- | Benchmarks simple file reading
2−--
3−-- Tested in this benchmark:
4−--
5−-- * Reading a file from the disk
6−--
7−module Benchmarks.FileRead
8− ( benchmark
9− ) where
10−
11−import Control.Applicative ((<$>))
12−import Criterion (Benchmark, bgroup, bench, whnfIO)
13−import qualified Data.ByteString as SB
14−import qualified Data.ByteString.Lazy as LB
15−import qualified Data.Text as T
16−import qualified Data.Text.Encoding as T
17−import qualified Data.Text.IO as T
18−import qualified Data.Text.Lazy as LT
19−import qualified Data.Text.Lazy.Encoding as LT
20−import qualified Data.Text.Lazy.IO as LT
21−
22−benchmark :: FilePath -> IO Benchmark
23−benchmark 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
33− ]
benchmarks/haskell/Benchmarks/FoldLines.hsdeleted−58
@@ -1,58 +0,0 @@
1−-- | Read a file line-by-line using handles, and perform a fold over the lines.
2−-- The fold is used here to calculate the number of lines in the file.
3−--
4−-- Tested in this benchmark:
5−--
6−-- * Buffered, line-based IO
7−--
8−{-# LANGUAGE BangPatterns #-}
9−module Benchmarks.FoldLines
10− ( benchmark
11− ) where
12−
13−import Criterion (Benchmark, bgroup, bench, whnfIO)
14−import System.IO
15−import qualified Data.ByteString as B
16−import qualified Data.Text as T
17−import qualified Data.Text.IO as T
18−
19−benchmark :: FilePath -> IO Benchmark
20−benchmark fp = return $ bgroup "ReadLines"
21− [ bench "Text" $ withHandle $ foldLinesT (\n _ -> n + 1) (0 :: Int)
22− , bench "ByteString" $ withHandle $ foldLinesB (\n _ -> n + 1) (0 :: Int)
23− ]
24− where
25− withHandle f = whnfIO $ do
26− h <- openFile fp ReadMode
27− hSetBuffering h (BlockBuffering (Just 16384))
28− x <- f h
29− hClose h
30− return x
31−
32−-- | Text line fold
33−--
34−foldLinesT :: (a -> T.Text -> a) -> a -> Handle -> IO a
35−foldLinesT f z0 h = go z0
36− where
37− go !z = do
38− eof <- hIsEOF h
39− if eof
40− then return z
41− else do
42− l <- T.hGetLine h
43− let z' = f z l in go z'
44−{-# INLINE foldLinesT #-}
45−
46−-- | ByteString line fold
47−--
48−foldLinesB :: (a -> B.ByteString -> a) -> a -> Handle -> IO a
49−foldLinesB f z0 h = go z0
50− where
51− go !z = do
52− eof <- hIsEOF h
53− if eof
54− then return z
55− else do
56− l <- B.hGetLine h
57− let z' = f z l in go z'
58−{-# INLINE foldLinesB #-}
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.hsdeleted−42
@@ -1,42 +0,0 @@
1−-- | Create a large HTML table and dump it to a handle
2−--
3−-- Tested in this benchmark:
4−--
5−-- * Creating a large HTML document using a builder
6−--
7−-- * Writing to a handle
8−--
9−{-# LANGUAGE OverloadedStrings #-}
10−module Benchmarks.Programs.BigTable
11− ( benchmark
12− ) where
13−
14−import Criterion (Benchmark, bench, whnfIO)
15−import Data.Monoid (mappend, mconcat)
16−import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)
17−import Data.Text.Lazy.IO (hPutStr)
18−import System.IO (Handle)
19−import qualified Data.Text as T
20−
21−benchmark :: Handle -> IO Benchmark
22−benchmark sink = return $ bench "BigTable" $ whnfIO $ do
23− hPutStr sink "Content-Type: text/html\n\n<table>"
24− hPutStr sink . toLazyText . makeTable =<< rows
25− hPutStr sink "</table>"
26− where
27− -- We provide the number of rows in IO so the builder value isn't shared
28− -- between the benchmark samples.
29− rows :: IO Int
30− rows = return 20000
31− {-# NOINLINE rows #-}
32−
33−makeTable :: Int -> Builder
34−makeTable n = mconcat $ replicate n $ mconcat $ map makeCol [1 .. 50]
35−
36−makeCol :: Int -> Builder
37−makeCol 1 = fromText "<tr><td>1</td>"
38−makeCol 50 = fromText "<td>50</td></tr>"
39−makeCol i = fromText "<td>" `mappend` (fromInt i `mappend` fromText "</td>")
40−
41−fromInt :: Int -> Builder
42−fromInt = fromText . T.pack . show
benchmarks/haskell/Benchmarks/Programs/Cut.hsdeleted−98
@@ -1,98 +0,0 @@
1−-- | Cut into a file, selecting certain columns (e.g. columns 10 to 40)
2−--
3−-- Tested in this benchmark:
4−--
5−-- * Reading the file
6−--
7−-- * Splitting into lines
8−--
9−-- * Taking a number of characters from the lines
10−--
11−-- * Joining the lines
12−--
13−-- * Writing back to a handle
14−--
15−module Benchmarks.Programs.Cut
16− ( benchmark
17− ) where
18−
19−import Criterion (Benchmark, bgroup, bench, whnfIO)
20−import System.IO (Handle, hPutStr)
21−import qualified Data.ByteString as B
22−import qualified Data.ByteString.Char8 as BC
23−import qualified Data.ByteString.Lazy as BL
24−import qualified Data.ByteString.Lazy.Char8 as BLC
25−import qualified Data.Text as T
26−import qualified Data.Text.Encoding as T
27−import qualified Data.Text.IO as T
28−import qualified Data.Text.Lazy as TL
29−import qualified Data.Text.Lazy.Encoding as TL
30−import qualified Data.Text.Lazy.IO as TL
31−
32−benchmark :: FilePath -> Handle -> Int -> Int -> IO Benchmark
33−benchmark p sink from to = return $ bgroup "Cut"
34− [ bench' "String" string
35− , bench' "ByteString" byteString
36− , bench' "LazyByteString" lazyByteString
37− , bench' "Text" text
38− , bench' "LazyText" lazyText
39− , bench' "TextByteString" textByteString
40− , bench' "LazyTextByteString" lazyTextByteString
41− ]
42− where
43− bench' n s = bench n $ whnfIO (s p sink from to)
44−
45−string :: FilePath -> Handle -> Int -> Int -> IO ()
46−string fp sink from to = do
47− s <- readFile fp
48− hPutStr sink $ cut s
49− where
50− cut = unlines . map (take (to - from) . drop from) . lines
51−
52−byteString :: FilePath -> Handle -> Int -> Int -> IO ()
53−byteString fp sink from to = do
54− bs <- B.readFile fp
55− B.hPutStr sink $ cut bs
56− where
57− cut = BC.unlines . map (B.take (to - from) . B.drop from) . BC.lines
58−
59−lazyByteString :: FilePath -> Handle -> Int -> Int -> IO ()
60−lazyByteString fp sink from to = do
61− bs <- BL.readFile fp
62− BL.hPutStr sink $ cut bs
63− where
64− cut = BLC.unlines . map (BL.take (to' - from') . BL.drop from') . BLC.lines
65− from' = fromIntegral from
66− to' = fromIntegral to
67−
68−text :: FilePath -> Handle -> Int -> Int -> IO ()
69−text fp sink from to = do
70− t <- T.readFile fp
71− T.hPutStr sink $ cut t
72− where
73− cut = T.unlines . map (T.take (to - from) . T.drop from) . T.lines
74−
75−lazyText :: FilePath -> Handle -> Int -> Int -> IO ()
76−lazyText fp sink from to = do
77− t <- TL.readFile fp
78− TL.hPutStr sink $ cut t
79− where
80− cut = TL.unlines . map (TL.take (to' - from') . TL.drop from') . TL.lines
81− from' = fromIntegral from
82− to' = fromIntegral to
83−
84−textByteString :: FilePath -> Handle -> Int -> Int -> IO ()
85−textByteString fp sink from to = do
86− t <- T.decodeUtf8 `fmap` B.readFile fp
87− B.hPutStr sink $ T.encodeUtf8 $ cut t
88− where
89− cut = T.unlines . map (T.take (to - from) . T.drop from) . T.lines
90−
91−lazyTextByteString :: FilePath -> Handle -> Int -> Int -> IO ()
92−lazyTextByteString fp sink from to = do
93− t <- TL.decodeUtf8 `fmap` BL.readFile fp
94− BL.hPutStr sink $ TL.encodeUtf8 $ cut t
95− where
96− cut = TL.unlines . map (TL.take (to' - from') . TL.drop from') . TL.lines
97− from' = fromIntegral from
98− to' = fromIntegral to
benchmarks/haskell/Benchmarks/Programs/Fold.hsdeleted−68
@@ -1,68 +0,0 @@
1−-- | Benchmark which formats paragraph, like the @sort@ unix utility.
2−--
3−-- Tested in this benchmark:
4−--
5−-- * Reading the file
6−--
7−-- * Splitting into paragraphs
8−--
9−-- * Reformatting the paragraphs to a certain line width
10−--
11−-- * Concatenating the results using the text builder
12−--
13−-- * Writing back to a handle
14−--
15−{-# LANGUAGE OverloadedStrings #-}
16−module Benchmarks.Programs.Fold
17− ( benchmark
18− ) where
19−
20−import Data.List (foldl')
21−import Data.List (intersperse)
22−import Data.Monoid (mempty, mappend, mconcat)
23−import System.IO (Handle)
24−import Criterion (Benchmark, bench, whnfIO)
25−import qualified Data.Text as T
26−import qualified Data.Text.IO as T
27−import qualified Data.Text.Lazy.Builder as TLB
28−import qualified Data.Text.Lazy as TL
29−import qualified Data.Text.Lazy.IO as TL
30−
31−benchmark :: FilePath -> Handle -> IO Benchmark
32−benchmark i o = return $
33− bench "Fold" $ whnfIO $ T.readFile i >>= TL.hPutStr o . fold 80
34−
35−-- | We represent a paragraph by a word list
36−--
37−type Paragraph = [T.Text]
38−
39−-- | Fold a text
40−--
41−fold :: Int -> T.Text -> TL.Text
42−fold maxWidth = TLB.toLazyText . mconcat .
43− intersperse "\n\n" . map (foldParagraph maxWidth) . paragraphs
44−
45−-- | Fold a paragraph
46−--
47−foldParagraph :: Int -> Paragraph -> TLB.Builder
48−foldParagraph _ [] = mempty
49−foldParagraph max' (w : ws) = fst $ foldl' go (TLB.fromText w, T.length w) ws
50− where
51− go (builder, width) word
52− | width + len + 1 <= max' =
53− (builder `mappend` " " `mappend` word', width + len + 1)
54− | otherwise =
55− (builder `mappend` "\n" `mappend` word', len)
56− where
57− word' = TLB.fromText word
58− len = T.length word
59−
60−-- | Divide a text into paragraphs
61−--
62−paragraphs :: T.Text -> [Paragraph]
63−paragraphs = splitParagraphs . map T.words . T.lines
64− where
65− splitParagraphs ls = case break null ls of
66− ([], []) -> []
67− (p, []) -> [concat p]
68− (p, lr) -> concat p : splitParagraphs (dropWhile null lr)
benchmarks/haskell/Benchmarks/Programs/Sort.hsdeleted−71
@@ -1,71 +0,0 @@
1−-- | This benchmark sorts the lines of a file, like the @sort@ unix utility.
2−--
3−-- Tested in this benchmark:
4−--
5−-- * Reading the file
6−--
7−-- * Splitting into lines
8−--
9−-- * Sorting the lines
10−--
11−-- * Joining the lines
12−--
13−-- * Writing back to a handle
14−--
15−{-# LANGUAGE OverloadedStrings #-}
16−module Benchmarks.Programs.Sort
17− ( benchmark
18− ) where
19−
20−import Criterion (Benchmark, bgroup, bench, whnfIO)
21−import Data.Monoid (mconcat)
22−import System.IO (Handle, hPutStr)
23−import qualified Data.ByteString as B
24−import qualified Data.ByteString.Char8 as BC
25−import qualified Data.ByteString.Lazy as BL
26−import qualified Data.ByteString.Lazy.Char8 as BLC
27−import qualified Data.List as L
28−import qualified Data.Text as T
29−import qualified Data.Text.Encoding as T
30−import qualified Data.Text.IO as T
31−import qualified Data.Text.Lazy as TL
32−import qualified Data.Text.Lazy.Builder as TLB
33−import qualified Data.Text.Lazy.Encoding as TL
34−import qualified Data.Text.Lazy.IO as TL
35−
36−benchmark :: FilePath -> Handle -> IO Benchmark
37−benchmark 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 >>=
45− B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8
46− , bench "LazyTextByteString" $ whnfIO $ BL.readFile i >>=
47− BL.hPutStr o . TL.encodeUtf8 . lazyText . TL.decodeUtf8
48− , bench "TextBuilder" $ whnfIO $ B.readFile i >>=
49− BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8
50− ]
51−
52−string :: String -> String
53−string = unlines . L.sort . lines
54−
55−byteString :: B.ByteString -> B.ByteString
56−byteString = BC.unlines . L.sort . BC.lines
57−
58−lazyByteString :: BL.ByteString -> BL.ByteString
59−lazyByteString = BLC.unlines . L.sort . BLC.lines
60−
61−text :: T.Text -> T.Text
62−text = T.unlines . L.sort . T.lines
63−
64−lazyText :: TL.Text -> TL.Text
65−lazyText = TL.unlines . L.sort . TL.lines
66−
67−-- | Text variant using a builder monoid for the final concatenation
68−--
69−textBuilder :: T.Text -> TL.Text
70−textBuilder = TLB.toLazyText . mconcat . L.intersperse (TLB.singleton '\n') .
71− map TLB.fromText . L.sort . T.lines
benchmarks/haskell/Benchmarks/Programs/StripTags.hsdeleted−53
@@ -1,53 +0,0 @@
1−-- | Program to replace HTML tags by whitespace
2−--
3−-- This program was originally contributed by Petr Prokhorenkov.
4−--
5−-- Tested in this benchmark:
6−--
7−-- * Reading the file
8−--
9−-- * Replacing text between HTML tags (<>) with whitespace
10−--
11−-- * Writing back to a handle
12−--
13−{-# OPTIONS_GHC -fspec-constr-count=5 #-}
14−module Benchmarks.Programs.StripTags
15− ( benchmark
16− ) where
17−
18−import Criterion (Benchmark, bgroup, bench, whnfIO)
19−import Data.List (mapAccumL)
20−import System.IO (Handle, hPutStr)
21−import qualified Data.ByteString as B
22−import qualified Data.ByteString.Char8 as BC
23−import qualified Data.Text as T
24−import qualified Data.Text.Encoding as T
25−import qualified Data.Text.IO as T
26−
27−benchmark :: FilePath -> Handle -> IO Benchmark
28−benchmark 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 $
33− B.readFile i >>= B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8
34− ]
35−
36−string :: String -> String
37−string = snd . mapAccumL step 0
38−
39−text :: T.Text -> T.Text
40−text = snd . T.mapAccumL step 0
41−
42−byteString :: B.ByteString -> B.ByteString
43−byteString = snd . BC.mapAccumL step 0
44−
45−step :: Int -> Char -> (Int, Char)
46−step d c
47− | d > 0 || d' > 0 = (d', ' ')
48− | otherwise = (d', c)
49− where
50− d' = d + depth c
51− depth '>' = 1
52− depth '<' = -1
53− depth _ = 0
benchmarks/haskell/Benchmarks/Programs/Throughput.hsdeleted−41
@@ -1,41 +0,0 @@
1−-- | This benchmark simply reads and writes a file using the various string
2−-- libraries. The point of it is that we can make better estimations on how
3−-- much time the other benchmarks spend doing IO.
4−--
5−-- Note that we expect ByteStrings to be a whole lot faster, since they do not
6−-- do any actual encoding/decoding here, while String and Text do have UTF-8
7−-- encoding/decoding.
8−--
9−-- Tested in this benchmark:
10−--
11−-- * Reading the file
12−--
13−-- * Replacing text between HTML tags (<>) with whitespace
14−--
15−-- * Writing back to a handle
16−--
17−module Benchmarks.Programs.Throughput
18− ( benchmark
19− ) where
20−
21−import Criterion (Benchmark, bgroup, bench, whnfIO)
22−import System.IO (Handle, hPutStr)
23−import qualified Data.ByteString as B
24−import qualified Data.ByteString.Lazy as BL
25−import qualified Data.Text.Encoding as T
26−import qualified Data.Text.IO as T
27−import qualified Data.Text.Lazy.Encoding as TL
28−import qualified Data.Text.Lazy.IO as TL
29−
30−benchmark :: FilePath -> Handle -> IO Benchmark
31−benchmark 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 $
38− B.readFile fp >>= B.hPutStr sink . T.encodeUtf8 . T.decodeUtf8
39− , bench "LazyTextByteString" $ whnfIO $
40− BL.readFile fp >>= BL.hPutStr sink . TL.encodeUtf8 . TL.decodeUtf8
41− ]
benchmarks/haskell/Benchmarks/Pure.hsdeleted−486
@@ -1,486 +0,0 @@
1−-- | Benchmarks various pure functions from the Text library
2−--
3−-- Tested in this benchmark:
4−--
5−-- * Most pure functions defined the string types
6−--
7−{-# LANGUAGE BangPatterns, CPP, GADTs, MagicHash #-}
8−{-# OPTIONS_GHC -fno-warn-orphans #-}
9−module Benchmarks.Pure
10− ( benchmark
11− ) where
12−
13−import Control.DeepSeq (NFData (..))
14−import Control.Exception (evaluate)
15−import Criterion (Benchmark, bgroup, bench, nf)
16−import Data.Char (toLower, toUpper)
17−import Data.Monoid (mappend, mempty)
18−import GHC.Base (Char (..), Int (..), chr#, ord#, (+#))
19−import qualified Data.ByteString.Char8 as BS
20−import qualified Data.ByteString.Lazy.Char8 as BL
21−import qualified Data.ByteString.UTF8 as UTF8
22−import qualified Data.List as L
23−import qualified Data.Text as T
24−import qualified Data.Text.Encoding as T
25−import qualified Data.Text.Lazy as TL
26−import qualified Data.Text.Lazy.Builder as TB
27−import qualified Data.Text.Lazy.Encoding as TL
28−
29−benchmark :: String -> FilePath -> IO Benchmark
30−benchmark kind fp = do
31− -- Evaluate stuff before actually running the benchmark, we don't want to
32− -- count it here.
33−
34− -- ByteString A
35− bsa <- BS.readFile fp
36−
37− -- Text A/B, LazyText A/B
38− ta <- evaluate $ T.decodeUtf8 bsa
39− tb <- evaluate $ T.toUpper ta
40− tla <- evaluate $ TL.fromChunks (T.chunksOf 16376 ta)
41− tlb <- evaluate $ TL.fromChunks (T.chunksOf 16376 tb)
42−
43− -- ByteString B, LazyByteString A/B
44− bsb <- evaluate $ T.encodeUtf8 tb
45− bla <- evaluate $ BL.fromChunks (chunksOf 16376 bsa)
46− blb <- evaluate $ BL.fromChunks (chunksOf 16376 bsb)
47−
48− -- String A/B
49− sa <- evaluate $ UTF8.toString bsa
50− sb <- evaluate $ T.unpack tb
51−
52− -- Lengths
53− bsa_len <- evaluate $ BS.length bsa
54− ta_len <- evaluate $ T.length ta
55− bla_len <- evaluate $ BL.length bla
56− tla_len <- evaluate $ TL.length tla
57− sa_len <- evaluate $ L.length sa
58−
59− -- Lines
60− bsl <- evaluate $ BS.lines bsa
61− bll <- evaluate $ BL.lines bla
62− tl <- evaluate $ T.lines ta
63− tll <- evaluate $ TL.lines tla
64− sl <- evaluate $ L.lines sa
65−
66− return $ bgroup "Pure"
67− [ bgroup "append"
68− [ benchT $ nf (T.append tb) ta
69− , benchTL $ nf (TL.append tlb) tla
70− , benchBS $ nf (BS.append bsb) bsa
71− , benchBSL $ nf (BL.append blb) bla
72− , benchS $ nf ((++) sb) sa
73− ]
74− , bgroup "concat"
75− [ benchT $ nf T.concat tl
76− , benchTL $ nf TL.concat tll
77− , benchBS $ nf BS.concat bsl
78− , benchBSL $ nf BL.concat bll
79− , benchS $ nf L.concat sl
80− ]
81− , bgroup "cons"
82− [ benchT $ nf (T.cons c) ta
83− , benchTL $ nf (TL.cons c) tla
84− , benchBS $ nf (BS.cons c) bsa
85− , benchBSL $ nf (BL.cons c) bla
86− , benchS $ nf (c:) sa
87− ]
88− , bgroup "concatMap"
89− [ benchT $ nf (T.concatMap (T.replicate 3 . T.singleton)) ta
90− , benchTL $ nf (TL.concatMap (TL.replicate 3 . TL.singleton)) tla
91− , benchBS $ nf (BS.concatMap (BS.replicate 3)) bsa
92− , benchBSL $ nf (BL.concatMap (BL.replicate 3)) bla
93− , benchS $ nf (L.concatMap (L.replicate 3 . (:[]))) sa
94− ]
95− , bgroup "decode"
96− [ benchT $ nf T.decodeUtf8 bsa
97− , benchTL $ nf TL.decodeUtf8 bla
98− , benchBS $ nf BS.unpack bsa
99− , benchBSL $ nf BL.unpack bla
100− , benchS $ nf UTF8.toString bsa
101− ]
102− , bgroup "decode'"
103− [ benchT $ nf T.decodeUtf8' bsa
104− , benchTL $ nf TL.decodeUtf8' bla
105− ]
106− , bgroup "drop"
107− [ benchT $ nf (T.drop (ta_len `div` 3)) ta
108− , benchTL $ nf (TL.drop (tla_len `div` 3)) tla
109− , benchBS $ nf (BS.drop (bsa_len `div` 3)) bsa
110− , benchBSL $ nf (BL.drop (bla_len `div` 3)) bla
111− , benchS $ nf (L.drop (sa_len `div` 3)) sa
112− ]
113− , bgroup "encode"
114− [ benchT $ nf T.encodeUtf8 ta
115− , benchTL $ nf TL.encodeUtf8 tla
116− , benchBS $ nf BS.pack sa
117− , benchBSL $ nf BL.pack sa
118− , benchS $ nf UTF8.fromString sa
119− ]
120− , bgroup "filter"
121− [ benchT $ nf (T.filter p0) ta
122− , benchTL $ nf (TL.filter p0) tla
123− , benchBS $ nf (BS.filter p0) bsa
124− , benchBSL $ nf (BL.filter p0) bla
125− , benchS $ nf (L.filter p0) sa
126− ]
127− , bgroup "filter.filter"
128− [ benchT $ nf (T.filter p1 . T.filter p0) ta
129− , benchTL $ nf (TL.filter p1 . TL.filter p0) tla
130− , benchBS $ nf (BS.filter p1 . BS.filter p0) bsa
131− , benchBSL $ nf (BL.filter p1 . BL.filter p0) bla
132− , benchS $ nf (L.filter p1 . L.filter p0) sa
133− ]
134− , bgroup "foldl'"
135− [ benchT $ nf (T.foldl' len 0) ta
136− , benchTL $ nf (TL.foldl' len 0) tla
137− , benchBS $ nf (BS.foldl' len 0) bsa
138− , benchBSL $ nf (BL.foldl' len 0) bla
139− , benchS $ nf (L.foldl' len 0) sa
140− ]
141− , bgroup "foldr"
142− [ benchT $ nf (L.length . T.foldr (:) []) ta
143− , benchTL $ nf (L.length . TL.foldr (:) []) tla
144− , benchBS $ nf (L.length . BS.foldr (:) []) bsa
145− , benchBSL $ nf (L.length . BL.foldr (:) []) bla
146− , benchS $ nf (L.length . L.foldr (:) []) sa
147− ]
148− , bgroup "head"
149− [ benchT $ nf T.head ta
150− , benchTL $ nf TL.head tla
151− , benchBS $ nf BS.head bsa
152− , benchBSL $ nf BL.head bla
153− , benchS $ nf L.head sa
154− ]
155− , bgroup "init"
156− [ benchT $ nf T.init ta
157− , benchTL $ nf TL.init tla
158− , benchBS $ nf BS.init bsa
159− , benchBSL $ nf BL.init bla
160− , benchS $ nf L.init sa
161− ]
162− , bgroup "intercalate"
163− [ benchT $ nf (T.intercalate tsw) tl
164− , benchTL $ nf (TL.intercalate tlw) tll
165− , benchBS $ nf (BS.intercalate bsw) bsl
166− , benchBSL $ nf (BL.intercalate blw) bll
167− , benchS $ nf (L.intercalate lw) sl
168− ]
169− , bgroup "intersperse"
170− [ benchT $ nf (T.intersperse c) ta
171− , benchTL $ nf (TL.intersperse c) tla
172− , benchBS $ nf (BS.intersperse c) bsa
173− , benchBSL $ nf (BL.intersperse c) bla
174− , benchS $ nf (L.intersperse c) sa
175− ]
176− , bgroup "isInfixOf"
177− [ benchT $ nf (T.isInfixOf tsw) ta
178− , benchTL $ nf (TL.isInfixOf tlw) tla
179− , benchBS $ nf (BS.isInfixOf bsw) bsa
180− -- no isInfixOf for lazy bytestrings
181− , benchS $ nf (L.isInfixOf lw) sa
182− ]
183− , bgroup "last"
184− [ benchT $ nf T.last ta
185− , benchTL $ nf TL.last tla
186− , benchBS $ nf BS.last bsa
187− , benchBSL $ nf BL.last bla
188− , benchS $ nf L.last sa
189− ]
190− , bgroup "map"
191− [ benchT $ nf (T.map f) ta
192− , benchTL $ nf (TL.map f) tla
193− , benchBS $ nf (BS.map f) bsa
194− , benchBSL $ nf (BL.map f) bla
195− , benchS $ nf (L.map f) sa
196− ]
197− , bgroup "mapAccumL"
198− [ benchT $ nf (T.mapAccumL g 0) ta
199− , benchTL $ nf (TL.mapAccumL g 0) tla
200− , benchBS $ nf (BS.mapAccumL g 0) bsa
201− , benchBSL $ nf (BL.mapAccumL g 0) bla
202− , benchS $ nf (L.mapAccumL g 0) sa
203− ]
204− , bgroup "mapAccumR"
205− [ benchT $ nf (T.mapAccumR g 0) ta
206− , benchTL $ nf (TL.mapAccumR g 0) tla
207− , benchBS $ nf (BS.mapAccumR g 0) bsa
208− , benchBSL $ nf (BL.mapAccumR g 0) bla
209− , benchS $ nf (L.mapAccumR g 0) sa
210− ]
211− , bgroup "map.map"
212− [ benchT $ nf (T.map f . T.map f) ta
213− , benchTL $ nf (TL.map f . TL.map f) tla
214− , benchBS $ nf (BS.map f . BS.map f) bsa
215− , benchBSL $ nf (BL.map f . BL.map f) bla
216− , benchS $ nf (L.map f . L.map f) sa
217− ]
218− , bgroup "replicate char"
219− [ benchT $ nf (T.replicate bsa_len) (T.singleton c)
220− , benchTL $ nf (TL.replicate (fromIntegral bsa_len)) (TL.singleton c)
221− , benchBS $ nf (BS.replicate bsa_len) c
222− , benchBSL $ nf (BL.replicate (fromIntegral bsa_len)) c
223− , benchS $ nf (L.replicate bsa_len) c
224− ]
225− , bgroup "replicate string"
226− [ benchT $ nf (T.replicate (bsa_len `div` T.length tsw)) tsw
227− , benchTL $ nf (TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw
228− , benchS $ nf (replicat (bsa_len `div` T.length tsw)) lw
229− ]
230− , bgroup "reverse"
231− [ benchT $ nf T.reverse ta
232− , benchTL $ nf TL.reverse tla
233− , benchBS $ nf BS.reverse bsa
234− , benchBSL $ nf BL.reverse bla
235− , benchS $ nf L.reverse sa
236− ]
237− , bgroup "take"
238− [ benchT $ nf (T.take (ta_len `div` 3)) ta
239− , benchTL $ nf (TL.take (tla_len `div` 3)) tla
240− , benchBS $ nf (BS.take (bsa_len `div` 3)) bsa
241− , benchBSL $ nf (BL.take (bla_len `div` 3)) bla
242− , benchS $ nf (L.take (sa_len `div` 3)) sa
243− ]
244− , bgroup "tail"
245− [ benchT $ nf T.tail ta
246− , benchTL $ nf TL.tail tla
247− , benchBS $ nf BS.tail bsa
248− , benchBSL $ nf BL.tail bla
249− , benchS $ nf L.tail sa
250− ]
251− , bgroup "toLower"
252− [ benchT $ nf T.toLower ta
253− , benchTL $ nf TL.toLower tla
254− , benchBS $ nf (BS.map toLower) bsa
255− , benchBSL $ nf (BL.map toLower) bla
256− , benchS $ nf (L.map toLower) sa
257− ]
258− , bgroup "toUpper"
259− [ benchT $ nf T.toUpper ta
260− , benchTL $ nf TL.toUpper tla
261− , benchBS $ nf (BS.map toUpper) bsa
262− , benchBSL $ nf (BL.map toUpper) bla
263− , benchS $ nf (L.map toUpper) sa
264− ]
265− , bgroup "uncons"
266− [ benchT $ nf T.uncons ta
267− , benchTL $ nf TL.uncons tla
268− , benchBS $ nf BS.uncons bsa
269− , benchBSL $ nf BL.uncons bla
270− , benchS $ nf L.uncons sa
271− ]
272− , bgroup "words"
273− [ benchT $ nf T.words ta
274− , benchTL $ nf TL.words tla
275− , benchBS $ nf BS.words bsa
276− , benchBSL $ nf BL.words bla
277− , benchS $ nf L.words sa
278− ]
279− , bgroup "zipWith"
280− [ benchT $ nf (T.zipWith min tb) ta
281− , benchTL $ nf (TL.zipWith min tlb) tla
282− , benchBS $ nf (BS.zipWith min bsb) bsa
283− , benchBSL $ nf (BL.zipWith min blb) bla
284− , benchS $ nf (L.zipWith min sb) sa
285− ]
286− , bgroup "length"
287− [ bgroup "cons"
288− [ benchT $ nf (T.length . T.cons c) ta
289− , benchTL $ nf (TL.length . TL.cons c) tla
290− , benchBS $ nf (BS.length . BS.cons c) bsa
291− , benchBSL $ nf (BL.length . BL.cons c) bla
292− , benchS $ nf (L.length . (:) c) sa
293− ]
294− , bgroup "decode"
295− [ benchT $ nf (T.length . T.decodeUtf8) bsa
296− , benchTL $ nf (TL.length . TL.decodeUtf8) bla
297− , benchBS $ nf (L.length . BS.unpack) bsa
298− , benchBSL $ nf (L.length . BL.unpack) bla
299− , bench "StringUTF8" $ nf (L.length . UTF8.toString) bsa
300− ]
301− , bgroup "drop"
302− [ benchT $ nf (T.length . T.drop (ta_len `div` 3)) ta
303− , benchTL $ nf (TL.length . TL.drop (tla_len `div` 3)) tla
304− , benchBS $ nf (BS.length . BS.drop (bsa_len `div` 3)) bsa
305− , benchBSL $ nf (BL.length . BL.drop (bla_len `div` 3)) bla
306− , benchS $ nf (L.length . L.drop (sa_len `div` 3)) sa
307− ]
308− , bgroup "filter"
309− [ benchT $ nf (T.length . T.filter p0) ta
310− , benchTL $ nf (TL.length . TL.filter p0) tla
311− , benchBS $ nf (BS.length . BS.filter p0) bsa
312− , benchBSL $ nf (BL.length . BL.filter p0) bla
313− , benchS $ nf (L.length . L.filter p0) sa
314− ]
315− , bgroup "filter.filter"
316− [ benchT $ nf (T.length . T.filter p1 . T.filter p0) ta
317− , benchTL $ nf (TL.length . TL.filter p1 . TL.filter p0) tla
318− , benchBS $ nf (BS.length . BS.filter p1 . BS.filter p0) bsa
319− , benchBSL $ nf (BL.length . BL.filter p1 . BL.filter p0) bla
320− , benchS $ nf (L.length . L.filter p1 . L.filter p0) sa
321− ]
322− , bgroup "init"
323− [ benchT $ nf (T.length . T.init) ta
324− , benchTL $ nf (TL.length . TL.init) tla
325− , benchBS $ nf (BS.length . BS.init) bsa
326− , benchBSL $ nf (BL.length . BL.init) bla
327− , benchS $ nf (L.length . L.init) sa
328− ]
329− , bgroup "intercalate"
330− [ benchT $ nf (T.length . T.intercalate tsw) tl
331− , benchTL $ nf (TL.length . TL.intercalate tlw) tll
332− , benchBS $ nf (BS.length . BS.intercalate bsw) bsl
333− , benchBSL $ nf (BL.length . BL.intercalate blw) bll
334− , benchS $ nf (L.length . L.intercalate lw) sl
335− ]
336− , bgroup "intersperse"
337− [ benchT $ nf (T.length . T.intersperse c) ta
338− , benchTL $ nf (TL.length . TL.intersperse c) tla
339− , benchBS $ nf (BS.length . BS.intersperse c) bsa
340− , benchBSL $ nf (BL.length . BL.intersperse c) bla
341− , benchS $ nf (L.length . L.intersperse c) sa
342− ]
343− , bgroup "map"
344− [ benchT $ nf (T.length . T.map f) ta
345− , benchTL $ nf (TL.length . TL.map f) tla
346− , benchBS $ nf (BS.length . BS.map f) bsa
347− , benchBSL $ nf (BL.length . BL.map f) bla
348− , benchS $ nf (L.length . L.map f) sa
349− ]
350− , bgroup "map.map"
351− [ benchT $ nf (T.length . T.map f . T.map f) ta
352− , benchTL $ nf (TL.length . TL.map f . TL.map f) tla
353− , benchBS $ nf (BS.length . BS.map f . BS.map f) bsa
354− , benchS $ nf (L.length . L.map f . L.map f) sa
355− ]
356− , bgroup "replicate char"
357− [ benchT $ nf (T.length . T.replicate bsa_len) (T.singleton c)
358− , benchTL $ nf (TL.length . TL.replicate (fromIntegral bsa_len)) (TL.singleton c)
359− , benchBS $ nf (BS.length . BS.replicate bsa_len) c
360− , benchBSL $ nf (BL.length . BL.replicate (fromIntegral bsa_len)) c
361− , benchS $ nf (L.length . L.replicate bsa_len) c
362− ]
363− , bgroup "replicate string"
364− [ benchT $ nf (T.length . T.replicate (bsa_len `div` T.length tsw)) tsw
365− , benchTL $ nf (TL.length . TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw
366− , benchS $ nf (L.length . replicat (bsa_len `div` T.length tsw)) lw
367− ]
368− , bgroup "take"
369− [ benchT $ nf (T.length . T.take (ta_len `div` 3)) ta
370− , benchTL $ nf (TL.length . TL.take (tla_len `div` 3)) tla
371− , benchBS $ nf (BS.length . BS.take (bsa_len `div` 3)) bsa
372− , benchBSL $ nf (BL.length . BL.take (bla_len `div` 3)) bla
373− , benchS $ nf (L.length . L.take (sa_len `div` 3)) sa
374− ]
375− , bgroup "tail"
376− [ benchT $ nf (T.length . T.tail) ta
377− , benchTL $ nf (TL.length . TL.tail) tla
378− , benchBS $ nf (BS.length . BS.tail) bsa
379− , benchBSL $ nf (BL.length . BL.tail) bla
380− , benchS $ nf (L.length . L.tail) sa
381− ]
382− , bgroup "toLower"
383− [ benchT $ nf (T.length . T.toLower) ta
384− , benchTL $ nf (TL.length . TL.toLower) tla
385− , benchBS $ nf (BS.length . BS.map toLower) bsa
386− , benchBSL $ nf (BL.length . BL.map toLower) bla
387− , benchS $ nf (L.length . L.map toLower) sa
388− ]
389− , bgroup "toUpper"
390− [ benchT $ nf (T.length . T.toUpper) ta
391− , benchTL $ nf (TL.length . TL.toUpper) tla
392− , benchBS $ nf (BS.length . BS.map toUpper) bsa
393− , benchBSL $ nf (BL.length . BL.map toUpper) bla
394− , benchS $ nf (L.length . L.map toUpper) sa
395− ]
396− , bgroup "words"
397− [ benchT $ nf (L.length . T.words) ta
398− , benchTL $ nf (L.length . TL.words) tla
399− , benchBS $ nf (L.length . BS.words) bsa
400− , benchBSL $ nf (L.length . BL.words) bla
401− , benchS $ nf (L.length . L.words) sa
402− ]
403− , bgroup "zipWith"
404− [ benchT $ nf (T.length . T.zipWith min tb) ta
405− , benchTL $ nf (TL.length . TL.zipWith min tlb) tla
406− , benchBS $ nf (L.length . BS.zipWith min bsb) bsa
407− , benchBSL $ nf (L.length . BL.zipWith min blb) bla
408− , benchS $ nf (L.length . L.zipWith min sb) sa
409− ]
410− ]
411− , bgroup "Builder"
412− [ bench "mappend char" $ nf (TL.length . TB.toLazyText . mappendNChar 'a') 10000
413− , bench "mappend 8 char" $ nf (TL.length . TB.toLazyText . mappend8Char) 'a'
414− , bench "mappend text" $ nf (TL.length . TB.toLazyText . mappendNText short) 10000
415− ]
416− ]
417− where
418− benchS = bench ("String+" ++ kind)
419− benchT = bench ("Text+" ++ kind)
420− benchTL = bench ("LazyText+" ++ kind)
421− benchBS = bench ("ByteString+" ++ kind)
422− benchBSL = bench ("LazyByteString+" ++ kind)
423−
424− c = 'й'
425− p0 = (== c)
426− p1 = (/= 'д')
427− lw = "право"
428− bsw = UTF8.fromString lw
429− blw = BL.fromChunks [bsw]
430− tsw = T.pack lw
431− tlw = TL.fromChunks [tsw]
432− f (C# c#) = C# (chr# (ord# c# +# 1#))
433− g (I# i#) (C# c#) = (I# (i# +# 1#), C# (chr# (ord# c# +# i#)))
434− len l _ = l + (1::Int)
435− replicat n = concat . L.replicate n
436− short = T.pack "short"
437−
438−#if !MIN_VERSION_bytestring(0,10,0)
439−instance NFData BS.ByteString
440−
441−instance NFData BL.ByteString where
442− rnf BL.Empty = ()
443− rnf (BL.Chunk _ ts) = rnf ts
444−#endif
445−
446−data B where
447− B :: NFData a => a -> B
448−
449−instance NFData B where
450− rnf (B b) = rnf b
451−
452−-- | Split a bytestring in chunks
453−--
454−chunksOf :: Int -> BS.ByteString -> [BS.ByteString]
455−chunksOf k = go
456− where
457− go t = case BS.splitAt k t of
458− (a,b) | BS.null a -> []
459− | otherwise -> a : go b
460−
461−-- | Append a character n times
462−--
463−mappendNChar :: Char -> Int -> TB.Builder
464−mappendNChar c n = go 0
465− where
466− go i
467− | i < n = TB.singleton c `mappend` go (i+1)
468− | otherwise = mempty
469−
470−-- | Gives more opportunity for inlining and elimination of unnecesary
471−-- bounds checks.
472−--
473−mappend8Char :: Char -> TB.Builder
474−mappend8Char c = TB.singleton c `mappend` TB.singleton c `mappend`
475− TB.singleton c `mappend` TB.singleton c `mappend`
476− TB.singleton c `mappend` TB.singleton c `mappend`
477− TB.singleton c `mappend` TB.singleton c
478−
479−-- | Append a text N times
480−--
481−mappendNText :: T.Text -> Int -> TB.Builder
482−mappendNText t n = go 0
483− where
484− go i
485− | i < n = TB.fromText t `mappend` go (i+1)
486− | otherwise = mempty
benchmarks/haskell/Benchmarks/ReadNumbers.hsdeleted−93
@@ -1,93 +0,0 @@
1−-- | Read numbers from a file with a just a number on each line, find the
2−-- minimum of those numbers. The file contains different kinds of numbers:
3−--
4−-- * Decimals
5−--
6−-- * Hexadecimals
7−--
8−-- * Floating point numbers
9−--
10−-- * Floating point numbers in scientific notation
11−--
12−-- The different benchmarks will only take into account the values they can
13−-- parse.
14−--
15−-- Tested in this benchmark:
16−--
17−-- * Lexing/parsing of different numerical types
18−--
19−module Benchmarks.ReadNumbers
20− ( benchmark
21− ) where
22−
23−import Criterion (Benchmark, bgroup, bench, whnf)
24−import Data.List (foldl')
25−import Numeric (readDec, readFloat, readHex)
26−import qualified Data.ByteString.Char8 as B
27−import qualified Data.ByteString.Lazy.Char8 as BL
28−import qualified Data.ByteString.Lex.Fractional as B
29−import qualified Data.Text as T
30−import qualified Data.Text.IO as T
31−import qualified Data.Text.Lazy as TL
32−import qualified Data.Text.Lazy.IO as TL
33−import qualified Data.Text.Lazy.Read as TL
34−import qualified Data.Text.Read as T
35−
36−benchmark :: FilePath -> IO Benchmark
37−benchmark fp = do
38− -- Read all files into lines: string, text, lazy text, bytestring, lazy
39− -- bytestring
40− s <- lines `fmap` readFile fp
41− t <- T.lines `fmap` T.readFile fp
42− tl <- TL.lines `fmap` TL.readFile fp
43− b <- B.lines `fmap` B.readFile fp
44− bl <- BL.lines `fmap` BL.readFile fp
45− return $ bgroup "ReadNumbers"
46− [ bench "DecimalString" $ whnf (int . string readDec) s
47− , bench "HexadecimalString" $ whnf (int . string readHex) s
48− , bench "DoubleString" $ whnf (double . string readFloat) s
49−
50− , bench "DecimalText" $ whnf (int . text (T.signed T.decimal)) t
51− , bench "HexadecimalText" $ whnf (int . text (T.signed T.hexadecimal)) t
52− , bench "DoubleText" $ whnf (double . text T.double) t
53− , bench "RationalText" $ whnf (double . text T.rational) t
54−
55− , bench "DecimalLazyText" $
56− whnf (int . text (TL.signed TL.decimal)) tl
57− , bench "HexadecimalLazyText" $
58− whnf (int . text (TL.signed TL.hexadecimal)) tl
59− , bench "DoubleLazyText" $
60− whnf (double . text TL.double) tl
61− , bench "RationalLazyText" $
62− whnf (double . text TL.rational) tl
63−
64− , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b
65− , bench "DoubleByteString" $ whnf (double . byteString B.readDecimal) b
66−
67− , bench "DecimalLazyByteString" $
68− whnf (int . byteString BL.readInt) bl
69− ]
70− where
71− -- Used for fixing types
72− int :: Int -> Int
73− int = id
74− double :: Double -> Double
75− double = id
76−
77−string :: (Ord a, Num a) => (t -> [(a, t)]) -> [t] -> a
78−string reader = foldl' go 1000000
79− where
80− go z t = case reader t of [(n, _)] -> min n z
81− _ -> z
82−
83−text :: (Ord a, Num a) => (t -> Either String (a,t)) -> [t] -> a
84−text reader = foldl' go 1000000
85− where
86− go z t = case reader t of Left _ -> z
87− Right (n, _) -> min n z
88−
89−byteString :: (Ord a, Num a) => (t -> Maybe (a,t)) -> [t] -> a
90−byteString reader = foldl' go 1000000
91− where
92− go z t = case reader t of Nothing -> z
93− Just (n, _) -> min n z
benchmarks/haskell/Benchmarks/Replace.hsdeleted−43
@@ -1,43 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−-- | Replace a string by another string
3−--
4−-- Tested in this benchmark:
5−--
6−-- * Search and replace of a pattern in a text
7−--
8−module Benchmarks.Replace
9− ( benchmark
10− ) where
11−
12−import Criterion (Benchmark, bgroup, bench, nf)
13−import qualified Data.ByteString.Char8 as B
14−import qualified Data.ByteString.Lazy as BL
15−import qualified Data.ByteString.Lazy.Search as BL
16−import qualified Data.ByteString.Search as B
17−import qualified Data.Text as T
18−import qualified Data.Text.Encoding as T
19−import qualified Data.Text.Lazy as TL
20−import qualified Data.Text.Lazy.Encoding as TL
21−import qualified Data.Text.Lazy.IO as TL
22−
23−benchmark :: FilePath -> String -> String -> IO Benchmark
24−benchmark fp pat sub = do
25− tl <- TL.readFile fp
26− bl <- BL.readFile fp
27− let !t = TL.toStrict tl
28− !b = T.encodeUtf8 t
29− return $ bgroup "Replace" [
30− bench "Text" $ nf (T.length . T.replace tpat tsub) t
31− , bench "ByteString" $ nf (BL.length . B.replace bpat bsub) b
32− , bench "LazyText" $ nf (TL.length . TL.replace tlpat tlsub) tl
33− , bench "LazyByteString" $ nf (BL.length . BL.replace blpat blsub) bl
34− ]
35− where
36− tpat = T.pack pat
37− tsub = T.pack sub
38− tlpat = TL.pack pat
39− tlsub = TL.pack sub
40− bpat = T.encodeUtf8 tpat
41− bsub = T.encodeUtf8 tsub
42− blpat = B.concat $ BL.toChunks $ TL.encodeUtf8 tlpat
43− blsub = B.concat $ BL.toChunks $ TL.encodeUtf8 tlsub
benchmarks/haskell/Benchmarks/Search.hsdeleted−48
@@ -1,48 +0,0 @@
1−-- | Search for a pattern in a file, find the number of occurences
2−--
3−-- Tested in this benchmark:
4−--
5−-- * Searching all occurences of a pattern using library routines
6−--
7−module Benchmarks.Search
8− ( benchmark
9− ) where
10−
11−import Criterion (Benchmark, bench, bgroup, whnf)
12−import qualified Data.ByteString as B
13−import qualified Data.ByteString.Lazy as BL
14−import qualified Data.ByteString.Lazy.Search as BL
15−import qualified Data.ByteString.Search as B
16−import qualified Data.Text as T
17−import qualified Data.Text.Encoding as T
18−import qualified Data.Text.IO as T
19−import qualified Data.Text.Lazy as TL
20−import qualified Data.Text.Lazy.IO as TL
21−
22−benchmark :: FilePath -> T.Text -> IO Benchmark
23−benchmark fp needleT = do
24− b <- B.readFile fp
25− bl <- BL.readFile fp
26− t <- T.readFile fp
27− tl <- TL.readFile fp
28− return $ bgroup "FileIndices"
29− [ bench "ByteString" $ whnf (byteString needleB) b
30− , bench "LazyByteString" $ whnf (lazyByteString needleB) bl
31− , bench "Text" $ whnf (text needleT) t
32− , bench "LazyText" $ whnf (lazyText needleTL) tl
33− ]
34− where
35− needleB = T.encodeUtf8 needleT
36− needleTL = TL.fromChunks [needleT]
37−
38−byteString :: B.ByteString -> B.ByteString -> Int
39−byteString needle = length . B.indices needle
40−
41−lazyByteString :: B.ByteString -> BL.ByteString -> Int
42−lazyByteString needle = length . BL.indices needle
43−
44−text :: T.Text -> T.Text -> Int
45−text = T.count
46−
47−lazyText :: TL.Text -> TL.Text -> Int
48−lazyText needle = fromIntegral . TL.count needle
benchmarks/haskell/Benchmarks/Stream.hsdeleted−104
@@ -1,104 +0,0 @@
1−-- | This module contains a number of benchmarks for the different streaming
2−-- functions
3−--
4−-- Tested in this benchmark:
5−--
6−-- * Most streaming functions
7−--
8−{-# LANGUAGE BangPatterns #-}
9−{-# OPTIONS_GHC -fno-warn-orphans #-}
10−module Benchmarks.Stream
11− ( benchmark
12− ) where
13−
14−import Control.DeepSeq (NFData (..))
15−import Criterion (Benchmark, bgroup, bench, nf)
16−import Data.Text.Internal.Fusion.Types (Step (..), Stream (..))
17−import qualified Data.Text.Encoding as T
18−import 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
22−import qualified Data.Text.IO as T
23−import 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
26−import qualified Data.Text.Lazy.IO as TL
27−
28−instance NFData a => NFData (Stream a) where
29− -- Currently, this implementation does not force evaluation of the size hint
30− rnf (Stream next s0 _) = go s0
31− where
32− go !s = case next s of
33− Done -> ()
34− Skip s' -> go s'
35− Yield x s' -> rnf x `seq` go s'
36−
37−benchmark :: FilePath -> IO Benchmark
38−benchmark fp = do
39− -- Different formats
40− t <- T.readFile fp
41− let !utf8 = T.encodeUtf8 t
42− !utf16le = T.encodeUtf16LE t
43− !utf16be = T.encodeUtf16BE t
44− !utf32le = T.encodeUtf32LE t
45− !utf32be = T.encodeUtf32BE t
46−
47− -- Once again for the lazy variants
48− tl <- TL.readFile fp
49− let !utf8L = TL.encodeUtf8 tl
50− !utf16leL = TL.encodeUtf16LE tl
51− !utf16beL = TL.encodeUtf16BE tl
52− !utf32leL = TL.encodeUtf32LE tl
53− !utf32beL = TL.encodeUtf32BE tl
54−
55− -- For the functions which operate on streams
56− let !s = F.stream t
57−
58− return $ bgroup "Stream"
59−
60− -- Fusion
61− [ 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
75− ]
76−
77− -- Encoding.Fusion
78− , bgroup "streamUtf8"
79− [ bench "Text" $ nf (T.streamUtf8 E.lenientDecode) utf8
80− , bench "LazyText" $ nf (TL.streamUtf8 E.lenientDecode) utf8L
81− ]
82− , bgroup "streamUtf16LE"
83− [ bench "Text" $ nf (T.streamUtf16LE E.lenientDecode) utf16le
84− , bench "LazyText" $ nf (TL.streamUtf16LE E.lenientDecode) utf16leL
85− ]
86− , bgroup "streamUtf16BE"
87− [ bench "Text" $ nf (T.streamUtf16BE E.lenientDecode) utf16be
88− , bench "LazyText" $ nf (TL.streamUtf16BE E.lenientDecode) utf16beL
89− ]
90− , bgroup "streamUtf32LE"
91− [ bench "Text" $ nf (T.streamUtf32LE E.lenientDecode) utf32le
92− , bench "LazyText" $ nf (TL.streamUtf32LE E.lenientDecode) utf32leL
93− ]
94− , bgroup "streamUtf32BE"
95− [ bench "Text" $ nf (T.streamUtf32BE E.lenientDecode) utf32be
96− , bench "LazyText" $ nf (TL.streamUtf32BE E.lenientDecode) utf32beL
97− ]
98−
99− -- Encoding.Fusion.Common
100− , bench "restreamUtf16LE" $ nf F.restreamUtf16LE s
101− , bench "restreamUtf16BE" $ nf F.restreamUtf16BE s
102− , bench "restreamUtf32LE" $ nf F.restreamUtf32LE s
103− , bench "restreamUtf32BE" $ nf F.restreamUtf32BE s
104− ]
benchmarks/haskell/Benchmarks/WordFrequencies.hsdeleted−36
@@ -1,36 +0,0 @@
1−-- | A word frequency count using the different string types
2−--
3−-- Tested in this benchmark:
4−--
5−-- * Splitting into words
6−--
7−-- * Converting to lowercase
8−--
9−-- * Comparing: Eq/Ord instances
10−--
11−module Benchmarks.WordFrequencies
12− ( benchmark
13− ) where
14−
15−import Criterion (Benchmark, bench, bgroup, whnf)
16−import Data.Char (toLower)
17−import Data.List (foldl')
18−import Data.Map (Map)
19−import qualified Data.ByteString.Char8 as B
20−import qualified Data.Map as M
21−import qualified Data.Text as T
22−import qualified Data.Text.IO as T
23−
24−benchmark :: FilePath -> IO Benchmark
25−benchmark fp = do
26− s <- readFile fp
27− b <- B.readFile fp
28− t <- T.readFile fp
29− return $ bgroup "WordFrequencies"
30− [ bench "String" $ whnf (frequencies . words . map toLower) s
31− , bench "ByteString" $ whnf (frequencies . B.words . B.map toLower) b
32− , bench "Text" $ whnf (frequencies . T.words . T.toLower) t
33− ]
34−
35−frequencies :: Ord a => [a] -> Map a Int
36−frequencies = foldl' (\m k -> M.insertWith (+) k 1 m) M.empty
benchmarks/haskell/Multilang.hsdeleted−32
@@ -1,32 +0,0 @@
1−{-# LANGUAGE BangPatterns, OverloadedStrings, RankNTypes #-}
2−
3−module Main (
4− main
5− ) where
6−
7−import Control.Monad (forM_)
8−import qualified Data.ByteString as B
9−import qualified Data.Text as Text
10−import Data.Text.Encoding (decodeUtf8)
11−import Data.Text (Text)
12−import System.IO (hFlush, stdout)
13−import Timer (timer)
14−
15−type BM = Text -> ()
16−
17−bm :: forall a. (Text -> a) -> BM
18−bm f t = f t `seq` ()
19−
20−benchmarks :: [(String, Text.Text -> ())]
21−benchmarks = [
22− ("find_first", bm $ Text.isInfixOf "en:Benin")
23− , ("find_index", bm $ Text.findIndex (=='c'))
24− ]
25−
26−main :: IO ()
27−main = do
28− !contents <- decodeUtf8 `fmap` B.readFile "../tests/text-test-data/yiwiki.xml"
29− forM_ benchmarks $ \(name, bmark) -> do
30− putStr $ name ++ " "
31− hFlush stdout
32− putStrLn =<< (timer 100 contents bmark)
benchmarks/haskell/Timer.hsdeleted−30
@@ -1,30 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−
3−module Timer (timer) where
4−
5−import Control.Exception (evaluate)
6−import Data.Time.Clock.POSIX (getPOSIXTime)
7−import GHC.Float (FFFormat(..), formatRealFloat)
8−
9−ickyRound :: Int -> Double -> String
10−ickyRound k = formatRealFloat FFFixed (Just k)
11−
12−timer :: Int -> a -> (a -> b) -> IO String
13−timer count a0 f = do
14− let loop !k !fastest
15− | k <= 0 = return fastest
16− | otherwise = do
17− start <- getPOSIXTime
18− let inner a i
19− | i <= 0 = return ()
20− | otherwise = evaluate (f a) >> inner a (i-1)
21− inner a0 count
22− end <- getPOSIXTime
23− let elapsed = end - start
24− loop (k-1) (min fastest (elapsed / fromIntegral count))
25− t <- loop (3::Int) 1e300
26− let log10 x = log x / log 10
27− ft = realToFrac t
28− prec = round (log10 (fromIntegral count) - log10 ft)
29− return $! ickyRound prec ft
30−{-# NOINLINE timer #-}
benchmarks/python/.gitignoredeleted−2
@@ -1,2 +0,0 @@
1−__pycache__
2−*.pyc
benchmarks/python/cut.pydeleted−12
@@ -1,12 +0,0 @@
1−#!/usr/bin/env python
2−
3−import utils, sys, codecs
4−
5−def cut(filename, l, r):
6− content = open(filename, encoding='utf-8')
7− for line in content:
8− print(line[l:r])
9−
10−for f in sys.argv[1:]:
11− t = utils.benchmark(lambda: cut(f, 20, 40))
12− sys.stderr.write('{0}: {1}\n'.format(f, t))
benchmarks/python/multilang.pydeleted−50
@@ -1,50 +0,0 @@
1−#!/usr/bin/env python
2−
3−import math
4−import sys
5−import time
6−
7−def find_first():
8− cf = contents.find
9− return timer(lambda: cf("en:Benin"))
10−
11−def timer(f, count=100):
12− a = 1e300
13− def g():
14− return
15− for i in xrange(3):
16− start = time.time()
17− for j in xrange(count):
18− g()
19− a = min(a, (time.time() - start) / count)
20−
21− b = 1e300
22− for i in xrange(3):
23− start = time.time()
24− for j in xrange(count):
25− f()
26− b = min(b, (time.time() - start) / count)
27−
28− return round(b - a, int(round(math.log(count, 10) - math.log(b - a, 10))))
29−
30−contents = open('../../tests/text-test-data/yiwiki.xml', 'r').read()
31−contents = contents.decode('utf-8')
32−
33−benchmarks = (
34− find_first,
35− )
36−
37−to_run = sys.argv[1:]
38−bms = []
39−if to_run:
40− for r in to_run:
41− for b in benchmarks:
42− if b.__name__.startswith(r):
43− bms.append(b)
44−else:
45− bms = benchmarks
46−
47−for b in bms:
48− sys.stdout.write(b.__name__ + ' ')
49− sys.stdout.flush()
50− print b()
benchmarks/python/sort.pydeleted−13
@@ -1,13 +0,0 @@
1−#!/usr/bin/env python
2−
3−import utils, sys, codecs
4−
5−def sort(filename):
6− content = open(filename, encoding='utf-8').read()
7− lines = content.splitlines()
8− lines.sort()
9− print('\n'.join(lines))
10−
11−for f in sys.argv[1:]:
12− t = utils.benchmark(lambda: sort(f))
13− sys.stderr.write('{0}: {1}\n'.format(f, t))
benchmarks/python/strip_tags.pydeleted−25
@@ -1,25 +0,0 @@
1−#!/usr/bin/env python
2−
3−import utils, sys
4−
5−def strip_tags(filename):
6− string = open(filename, encoding='utf-8').read()
7−
8− d = 0
9− out = []
10−
11− for c in string:
12− if c == '<': d += 1
13−
14− if d > 0:
15− out += ' '
16− else:
17− out += c
18−
19− if c == '>': d -= 1
20−
21− print(''.join(out))
22−
23−for f in sys.argv[1:]:
24− t = utils.benchmark(lambda: strip_tags(f))
25− sys.stderr.write('{0}: {1}\n'.format(f, t))
benchmarks/python/utils.pydeleted−18
@@ -1,18 +0,0 @@
1−#!/usr/bin/env python
2−
3−import sys, time
4−
5−def benchmark_once(f):
6− start = time.time()
7− f()
8− end = time.time()
9− return end - start
10−
11−def benchmark(f):
12− runs = 100
13− total = 0.0
14− for i in range(runs):
15− result = benchmark_once(f)
16− sys.stderr.write('Run {0}: {1}\n'.format(i, result))
17− total += result
18− return total / runs
benchmarks/ruby/cut.rbdeleted−16
@@ -1,16 +0,0 @@
1−#!/usr/bin/env ruby
2−
3−require './utils.rb'
4−
5−def cut(filename, l, r)
6− File.open(filename, 'r:utf-8') do |file|
7− file.each_line do |line|
8− puts line[l, r - l]
9− end
10− end
11−end
12−
13−ARGV.each do |f|
14− t = benchmark { cut(f, 20, 40) }
15− STDERR.puts "#{f}: #{t}"
16−end
benchmarks/ruby/fold.rbdeleted−50
@@ -1,50 +0,0 @@
1−#!/usr/bin/env ruby
2−
3−require './utils.rb'
4−
5−def fold(filename, max_width)
6− File.open(filename, 'r:utf-8') do |file|
7− # Words in this paragraph
8− paragraph = []
9−
10− file.each_line do |line|
11− # If we encounter an empty line, we reformat and dump the current
12− # paragraph
13− if line.strip.empty?
14− puts fold_paragraph(paragraph, max_width)
15− puts
16− paragraph = []
17− # Otherwise, we append the words found in the line to the paragraph
18− else
19− paragraph.concat line.split
20− end
21− end
22−
23− # Last paragraph
24− puts fold_paragraph(paragraph, max_width) unless paragraph.empty?
25− end
26−end
27−
28−# Fold a single paragraph to the desired width
29−def fold_paragraph(paragraph, max_width)
30− # Gradually build our output
31− str, *rest = paragraph
32− width = str.length
33−
34− rest.each do |word|
35− if width + word.length + 1 <= max_width
36− str << ' ' << word
37− width += word.length + 1
38− else
39− str << "\n" << word
40− width = word.length
41− end
42− end
43−
44− str
45−end
46−
47−ARGV.each do |f|
48− t = benchmark { fold(f, 80) }
49− STDERR.puts "#{f}: #{t}"
50−end
benchmarks/ruby/sort.rbdeleted−15
@@ -1,15 +0,0 @@
1−#!/usr/bin/env ruby
2−
3−require './utils.rb'
4−
5−def sort(filename)
6− File.open(filename, 'r:utf-8') do |file|
7− content = file.read
8− puts content.lines.sort.join
9− end
10−end
11−
12−ARGV.each do |f|
13− t = benchmark { sort(f) }
14− STDERR.puts "#{f}: #{t}"
15−end
benchmarks/ruby/strip_tags.rbdeleted−22
@@ -1,22 +0,0 @@
1−#!/usr/bin/env ruby
2−
3−require './utils.rb'
4−
5−def strip_tags(filename)
6− File.open(filename, 'r:utf-8') do |file|
7− str = file.read
8−
9− d = 0
10−
11− str.each_char do |c|
12− d += 1 if c == '<'
13− putc(if d > 0 then ' ' else c end)
14− d -= 1 if c == '>'
15− end
16− end
17−end
18−
19−ARGV.each do |f|
20− t = benchmark { strip_tags(f) }
21− STDERR.puts "#{f}: #{t}"
22−end
benchmarks/ruby/utils.rbdeleted−14
@@ -1,14 +0,0 @@
1−require 'benchmark'
2−
3−def benchmark(&block)
4− runs = 100
5− total = 0
6−
7− runs.times do |i|
8− result = Benchmark.measure(&block).total
9− $stderr.puts "Run #{i}: #{result}"
10− total += result
11− end
12−
13− total / runs
14−end
benchmarks/text-benchmarks.cabaldeleted−66
@@ -1,66 +0,0 @@
1−name: text-benchmarks
2−version: 0.0.0.0
3−synopsis: Benchmarks for the text package
4−description: Benchmarks for the text package
5−homepage: https://bitbucket.org/bos/text
6−license: BSD2
7−license-file: ../LICENSE
8−author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
9− Bryan O'Sullivan <bos@serpentine.com>,
10− Tom Harper <rtomharper@googlemail.com>,
11− Duncan Coutts <duncan@haskell.org>
12−maintainer: jaspervdj@gmail.com
13−category: Text
14−build-type: Simple
15−
16−cabal-version: >=1.2
17−
18−flag bytestring-builder
19− description: Depend on the bytestring-builder package for backwards compatibility.
20− default: False
21− manual: False
22−
23−flag llvm
24− description: use LLVM
25− default: False
26− manual: True
27−
28−executable text-benchmarks
29− hs-source-dirs: haskell ..
30− c-sources: ../cbits/cbits.c
31− cbits/time_iconv.c
32− include-dirs: ../include
33− main-is: Benchmarks.hs
34− ghc-options: -Wall -O2 -rtsopts
35− if flag(llvm)
36− ghc-options: -fllvm
37− cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP
38− build-depends: base == 4.*,
39− binary,
40− blaze-builder,
41− bytestring-lexing >= 0.5.0,
42− containers,
43− criterion >= 0.10.0.0,
44− deepseq,
45− directory,
46− filepath,
47− ghc-prim,
48− integer-gmp,
49− 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
58−
59−executable text-multilang
60− hs-source-dirs: haskell
61− main-is: Multilang.hs
62− ghc-options: -Wall -O2
63− build-depends: base == 4.*,
64− bytestring,
65− text,
66− time
cbits/cbits.cdeleted−311
@@ -1,311 +0,0 @@
1−/*
2− * Copyright (c) 2011 Bryan O'Sullivan <bos@serpentine.com>.
3− *
4− * Portions copyright (c) 2008-2010 Björn Höhrmann <bjoern@hoehrmann.de>.
5− *
6− * See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details.
7− */
8−
9−#include <string.h>
10−#include <stdint.h>
11−#include <stdio.h>
12−#include "text_cbits.h"
13−
14−void _hs_text_memcpy(void *dest, size_t doff, const void *src, size_t soff,
15− size_t n)
16−{
17− memcpy(dest + (doff<<1), src + (soff<<1), n<<1);
18−}
19−
20−int _hs_text_memcmp(const void *a, size_t aoff, const void *b, size_t boff,
21− size_t n)
22−{
23− return memcmp(a + (aoff<<1), b + (boff<<1), n<<1);
24−}
25−
26−#define UTF8_ACCEPT 0
27−#define UTF8_REJECT 12
28−
29−static const uint8_t utf8d[] = {
30− /*
31− * The first part of the table maps bytes to character classes that
32− * to reduce the size of the transition table and create bitmasks.
33− */
34− 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
35− 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
36− 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
37− 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
38− 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,
39− 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
40− 8,8,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,
41− 10,3,3,3,3,3,3,3,3,3,3,3,3,4,3,3, 11,6,6,6,5,8,8,8,8,8,8,8,8,8,8,8,
42−
43− /*
44− * The second part is a transition table that maps a combination of
45− * a state of the automaton and a character class to a state.
46− */
47− 0,12,24,36,60,96,84,12,12,12,48,72, 12,12,12,12,12,12,12,12,12,12,12,12,
48− 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12,
49− 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12,
50− 12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12,
51− 12,36,12,12,12,12,12,12,12,12,12,12,
52−};
53−
54−static inline uint32_t
55−decode(uint32_t *state, uint32_t* codep, uint32_t byte) {
56− uint32_t type = utf8d[byte];
57−
58− *codep = (*state != UTF8_ACCEPT) ?
59− (byte & 0x3fu) | (*codep << 6) :
60− (0xff >> type) & (byte);
61−
62− return *state = utf8d[256 + *state + type];
63−}
64−
65−/*
66− * The ISO 8859-1 (aka latin-1) code points correspond exactly to the first 256 unicode
67− * code-points, therefore we can trivially convert from a latin-1 encoded bytestring to
68− * an UTF16 array
69− */
70−void
71−_hs_text_decode_latin1(uint16_t *dest, const uint8_t *src,
72− const uint8_t *srcend)
73−{
74− const uint8_t *p = src;
75−
76−#if defined(__i386__) || defined(__x86_64__)
77− /* This optimization works on a little-endian systems by using
78− (aligned) 32-bit loads instead of 8-bit loads
79− */
80−
81− /* consume unaligned prefix */
82− while (p != srcend && (uintptr_t)p & 0x3)
83− *dest++ = *p++;
84−
85− /* iterate over 32-bit aligned loads */
86− while (p < srcend - 3) {
87− const uint32_t w = *((const uint32_t *)p);
88−
89− *dest++ = w & 0xff;
90− *dest++ = (w >> 8) & 0xff;
91− *dest++ = (w >> 16) & 0xff;
92− *dest++ = (w >> 24) & 0xff;
93−
94− p += 4;
95− }
96−#endif
97−
98− /* handle unaligned suffix */
99− while (p != srcend)
100− *dest++ = *p++;
101−}
102−
103−/*
104− * A best-effort decoder. Runs until it hits either end of input or
105− * the start of an invalid byte sequence.
106− *
107− * At exit, we update *destoff with the next offset to write to, *src
108− * with the next source location past the last one successfully
109− * decoded, and return the next source location to read from.
110− *
111− * Moreover, we expose the internal decoder state (state0 and
112− * codepoint0), allowing one to restart the decoder after it
113− * terminates (say, due to a partial codepoint).
114− *
115− * In particular, there are a few possible outcomes,
116− *
117− * 1) We decoded the buffer entirely:
118− * In this case we return srcend
119− * state0 == UTF8_ACCEPT
120− *
121− * 2) We met an invalid encoding
122− * In this case we return the address of the first invalid byte
123− * state0 == UTF8_REJECT
124− *
125− * 3) We reached the end of the buffer while decoding a codepoint
126− * In this case we return a pointer to the first byte of the partial codepoint
127− * state0 != UTF8_ACCEPT, UTF8_REJECT
128− *
129− */
130−#if defined(__GNUC__) || defined(__clang__)
131−static inline uint8_t const *
132−_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,
133− const uint8_t **src, const uint8_t *srcend,
134− uint32_t *codepoint0, uint32_t *state0)
135− __attribute((always_inline));
136−#endif
137−
138−static inline uint8_t const *
139−_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,
140− const uint8_t **src, const uint8_t *srcend,
141− uint32_t *codepoint0, uint32_t *state0)
142−{
143− uint16_t *d = dest + *destoff;
144− const uint8_t *s = *src, *last = *src;
145− uint32_t state = *state0;
146− uint32_t codepoint = *codepoint0;
147−
148− while (s < srcend) {
149−#if defined(__i386__) || defined(__x86_64__)
150− /*
151− * This code will only work on a little-endian system that
152− * supports unaligned loads.
153− *
154− * It gives a substantial speed win on data that is purely or
155− * partly ASCII (e.g. HTML), at only a slight cost on purely
156− * non-ASCII text.
157− */
158−
159− if (state == UTF8_ACCEPT) {
160− while (s < srcend - 4) {
161− codepoint = *((uint32_t *) s);
162− if ((codepoint & 0x80808080) != 0)
163− break;
164− s += 4;
165−
166− /*
167− * Tried 32-bit stores here, but the extra bit-twiddling
168− * slowed the code down.
169− */
170−
171− *d++ = (uint16_t) (codepoint & 0xff);
172− *d++ = (uint16_t) ((codepoint >> 8) & 0xff);
173− *d++ = (uint16_t) ((codepoint >> 16) & 0xff);
174− *d++ = (uint16_t) ((codepoint >> 24) & 0xff);
175− }
176− last = s;
177− }
178−#endif
179−
180− if (decode(&state, &codepoint, *s++) != UTF8_ACCEPT) {
181− if (state != UTF8_REJECT)
182− continue;
183− break;
184− }
185−
186− if (codepoint <= 0xffff)
187− *d++ = (uint16_t) codepoint;
188− else {
189− *d++ = (uint16_t) (0xD7C0 + (codepoint >> 10));
190− *d++ = (uint16_t) (0xDC00 + (codepoint & 0x3FF));
191− }
192− last = s;
193− }
194−
195− *destoff = d - dest;
196− *codepoint0 = codepoint;
197− *state0 = state;
198− *src = last;
199−
200− return s;
201−}
202−
203−uint8_t const *
204−_hs_text_decode_utf8_state(uint16_t *const dest, size_t *destoff,
205− const uint8_t **src,
206− const uint8_t *srcend,
207− uint32_t *codepoint0, uint32_t *state0)
208−{
209− uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, src, srcend,
210− codepoint0, state0);
211− if (*state0 == UTF8_REJECT)
212− ret -=1;
213− return ret;
214−}
215−
216−/*
217− * Helper to decode buffer and discard final decoder state
218− */
219−const uint8_t *
220−_hs_text_decode_utf8(uint16_t *const dest, size_t *destoff,
221− const uint8_t *src, const uint8_t *const srcend)
222−{
223− uint32_t codepoint;
224− uint32_t state = UTF8_ACCEPT;
225− uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, &src, srcend,
226− &codepoint, &state);
227− /* Back up if we have an incomplete or invalid encoding */
228− if (state != UTF8_ACCEPT)
229− ret -= 1;
230− return ret;
231−}
232−
233−void
234−_hs_text_encode_utf8(uint8_t **destp, const uint16_t *src, size_t srcoff,
235− size_t srclen)
236−{
237− const uint16_t *srcend;
238− uint8_t *dest = *destp;
239−
240− src += srcoff;
241− srcend = src + srclen;
242−
243− ascii:
244−#if defined(__x86_64__)
245− while (srcend - src >= 4) {
246− uint64_t w = *((uint64_t *) src);
247−
248− if (w & 0xFF80FF80FF80FF80ULL) {
249− if (!(w & 0x000000000000FF80ULL)) {
250− *dest++ = w & 0xFFFF;
251− src++;
252− if (!(w & 0x00000000FF800000ULL)) {
253− *dest++ = (w >> 16) & 0xFFFF;
254− src++;
255− if (!(w & 0x0000FF8000000000ULL)) {
256− *dest++ = (w >> 32) & 0xFFFF;
257− src++;
258− }
259− }
260− }
261− break;
262− }
263− *dest++ = w & 0xFFFF;
264− *dest++ = (w >> 16) & 0xFFFF;
265− *dest++ = (w >> 32) & 0xFFFF;
266− *dest++ = w >> 48;
267− src += 4;
268− }
269−#endif
270−
271−#if defined(__i386__)
272− while (srcend - src >= 2) {
273− uint32_t w = *((uint32_t *) src);
274−
275− if (w & 0xFF80FF80)
276− break;
277− *dest++ = w & 0xFFFF;
278− *dest++ = w >> 16;
279− src += 2;
280− }
281−#endif
282−
283− while (src < srcend) {
284− uint16_t w = *src++;
285−
286− if (w <= 0x7F) {
287− *dest++ = w;
288− /* An ASCII byte is likely to begin a run of ASCII bytes.
289− Falling back into the fast path really helps performance. */
290− goto ascii;
291− }
292− else if (w <= 0x7FF) {
293− *dest++ = (w >> 6) | 0xC0;
294− *dest++ = (w & 0x3f) | 0x80;
295− }
296− else if (w < 0xD800 || w > 0xDBFF) {
297− *dest++ = (w >> 12) | 0xE0;
298− *dest++ = ((w >> 6) & 0x3F) | 0x80;
299− *dest++ = (w & 0x3F) | 0x80;
300− } else {
301− uint32_t c = ((((uint32_t) w) - 0xD800) << 10) +
302− (((uint32_t) *src++) - 0xDC00) + 0x10000;
303− *dest++ = (c >> 18) | 0xF0;
304− *dest++ = ((c >> 12) & 0x3F) | 0x80;
305− *dest++ = ((c >> 6) & 0x3F) | 0x80;
306− *dest++ = (c & 0x3F) | 0x80;
307− }
308− }
309−
310− *destp = dest;
311−}
changelog.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
include/text_cbits.hdeleted−11
@@ -1,11 +0,0 @@
1−/*
2− * Copyright (c) 2013 Bryan O'Sullivan <bos@serpentine.com>.
3− */
4−
5−#ifndef _text_cbits_h
6−#define _text_cbits_h
7−
8−#define UTF8_ACCEPT 0
9−#define UTF8_REJECT 12
10−
11−#endif
scripts/ApiCompare.hsdeleted−28
@@ -1,28 +0,0 @@
1−-- This script compares the strict and lazy Text APIs to ensure that
2−-- they're reasonably in sync.
3−
4−{-# LANGUAGE OverloadedStrings #-}
5−
6−import qualified Data.Set as S
7−import qualified Data.Text as T
8−import System.Process
9−
10−main = do
11− let tidy pkg = (S.fromList . filter (T.isInfixOf "::") . T.lines .
12− T.replace "GHC.Int.Int64" "Int" .
13− T.replace "\n " "" .
14− T.replace (T.append (T.pack pkg) ".") "" . T.pack) `fmap`
15− readProcess "ghci" [] (":browse " ++ pkg)
16− let diff a b = mapM_ (putStrLn . (" "++) . T.unpack) . S.toList $
17− S.difference a b
18− text <- tidy "Data.Text"
19− lazy <- tidy "Data.Text.Lazy"
20− list <- tidy "Data.List"
21− putStrLn "Text \\ List:"
22− diff text list
23− putStrLn ""
24− putStrLn "Text \\ Lazy:"
25− diff text lazy
26− putStrLn ""
27− putStrLn "Lazy \\ Text:"
28− diff lazy text
scripts/Arsec.hs+9−4
@@ -1,7 +1,6 @@
1module Arsec
1module Arsec
2 (
2 (
3− Comment
3+ comment
4− , comment
5 , semi
4 , semi
6 , showC
5 , showC
7 , unichar
6 , unichar
@@ -24,7 +23,13 @@ import Text.ParserCombinators.Parsec.Combinator hiding (optional)
24import Text.ParserCombinators.Parsec.Error
23import Text.ParserCombinators.Parsec.Error
25import Text.ParserCombinators.Parsec.Prim hiding ((<|>), many)
24import Text.ParserCombinators.Parsec.Prim hiding ((<|>), many)
26
25
27−type Comment = String
26+instance Applicative (GenParser s a) where
27+ pure = return
28+ (<*>) = ap
29+
30+instance Alternative (GenParser s a) where
31+ empty = mzero
32+ (<|>) = mplus
28
33
29unichar :: Parser Char
34unichar :: Parser Char
30unichar = chr . fst . head . readHex <$> many1 hexDigit
35unichar = chr . fst . head . readHex <$> many1 hexDigit
@@ -35,7 +40,7 @@ unichars = manyTill (unichar <* spaces) semi
35semi :: Parser ()
40semi :: Parser ()
36semi = char ';' *> spaces *> pure ()
41semi = char ';' *> spaces *> pure ()
37
42
38−comment :: Parser Comment
43+comment :: Parser String
39comment = (char '#' *> manyTill anyToken (char '\n')) <|> string "\n"
44comment = (char '#' *> manyTill anyToken (char '\n')) <|> string "\n"
40
45
41showC :: Char -> String
46showC :: Char -> String
scripts/CaseFolding.hs+10−14
@@ -4,8 +4,7 @@
4
4
5module CaseFolding
5module CaseFolding
6 (
6 (
7− CaseFolding(..)
7+ Fold(..)
8− , Fold(..)
9 , parseCF
8 , parseCF
10 , mapCF
9 , mapCF
11 ) where
10 ) where
@@ -19,28 +18,25 @@ data Fold = Fold {
19 , name :: String
18 , name :: String
20 } deriving (Eq, Ord, Show)
19 } deriving (Eq, Ord, Show)
21
20
22−data CaseFolding = CF { cfComments :: [Comment], cfFolding :: [Fold] }
21+entries :: Parser [Fold]
23− deriving (Show)
22+entries = many comment *> many (entry <* many comment)
24−
25−entries :: Parser CaseFolding
26−entries = CF <$> many comment <*> many (entry <* many comment)
27 where
23 where
28 entry = Fold <$> unichar <* semi
24 entry = Fold <$> unichar <* semi
29 <*> oneOf "CFST" <* semi
25 <*> oneOf "CFST" <* semi
30 <*> unichars
26 <*> unichars
31 <*> (string "# " *> manyTill anyToken (char '\n'))
27 <*> (string "# " *> manyTill anyToken (char '\n'))
32
28
33−parseCF :: FilePath -> IO (Either ParseError CaseFolding)
29+parseCF :: FilePath -> IO (Either ParseError [Fold])
34parseCF name = parse entries name <$> readFile name
30parseCF name = parse entries name <$> readFile name
35
31
36−mapCF :: CaseFolding -> [String]
32+mapCF :: [Fold] -> [String]
37−mapCF (CF _ ms) = typ ++ (map nice . filter p $ ms) ++ [last]
33+mapCF ms = typ ++ (map nice . filter p $ ms) ++ [last]
38 where
34 where
39− typ = ["foldMapping :: forall s. Char -> s -> Step (CC s) Char"
35+ typ = ["foldMapping :: forall s. Char -> s -> Step (PairS (PairS s Char) Char) Char"
40− ,"{-# NOINLINE foldMapping #-}"]
36+ ,"{-# INLINE foldMapping #-}"]
41− last = "foldMapping c s = Yield (toLower c) (CC s '\\0' '\\0')"
37+ last = "foldMapping c s = Yield (toLower c) (s :!: '\\0' :!: '\\0')"
42 nice c = "-- " ++ name c ++ "\n" ++
38 nice c = "-- " ++ name c ++ "\n" ++
43− "foldMapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"
39+ "foldMapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (s :!: " ++ y ++ " :!: " ++ z ++ ")"
44 where [x,y,z] = (map showC . take 3) (mapping c ++ repeat '\0')
40 where [x,y,z] = (map showC . take 3) (mapping c ++ repeat '\0')
45 p f = status f `elem` "CF" &&
41 p f = status f `elem` "CF" &&
46 mapping f /= [toLower (code f)]
42 mapping f /= [toLower (code f)]
scripts/CaseMapping.hs+5−11
@@ -8,7 +8,7 @@ import SpecialCasing
8main = do
8main = do
9 args <- getArgs
9 args <- getArgs
10 let oname = case args of
10 let oname = case args of
11− [] -> "../Data/Text/Internal/Fusion/CaseMapping.hs"
11+ [] -> "../Data/Text/Fusion/CaseMapping.hs"
12 [o] -> o
12 [o] -> o
13 psc <- parseSC "SpecialCasing.txt"
13 psc <- parseSC "SpecialCasing.txt"
14 pcf <- parseCF "CaseFolding.txt"
14 pcf <- parseCF "CaseFolding.txt"
@@ -19,20 +19,14 @@ main = do
19 Left err -> print err >> return undefined
19 Left err -> print err >> return undefined
20 Right ms -> return ms
20 Right ms -> return ms
21 h <- openFile oname WriteMode
21 h <- openFile oname WriteMode
22− let comments = map ("--" ++) $
22+ mapM_ (hPutStrLn h) ["{-# LANGUAGE Rank2Types #-}"
23− take 2 (cfComments cfs) ++ take 2 (scComments scs)
24− mapM_ (hPutStrLn h) $
25− ["{-# LANGUAGE Rank2Types #-}"
26 ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"
23 ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"
27− ,"-- Generated by scripts/CaseMapping.hs"] ++
24+ ,"-- Generated by scripts/SpecialCasing.hs"
28− comments ++
25+ ,"module Data.Text.Fusion.CaseMapping where"
29− [""
30− ,"module Data.Text.Internal.Fusion.CaseMapping where"
31 ,"import Data.Char"
26 ,"import Data.Char"
32− ,"import Data.Text.Internal.Fusion.Types"
27+ ,"import Data.Text.Fusion.Internal"
33 ,""]
28 ,""]
34 mapM_ (hPutStrLn h) (mapSC "upper" upper toUpper scs)
29 mapM_ (hPutStrLn h) (mapSC "upper" upper toUpper scs)
35 mapM_ (hPutStrLn h) (mapSC "lower" lower toLower scs)
30 mapM_ (hPutStrLn h) (mapSC "lower" lower toLower scs)
36− mapM_ (hPutStrLn h) (mapSC "title" title toTitle scs)
37 mapM_ (hPutStrLn h) (mapCF cfs)
31 mapM_ (hPutStrLn h) (mapCF cfs)
38 hClose h
32 hClose h
scripts/SpecialCasing.hs+10−16
@@ -4,17 +4,13 @@
4
4
5module SpecialCasing
5module SpecialCasing
6 (
6 (
7− SpecialCasing(..)
7+ Case(..)
8− , Case(..)
9 , parseSC
8 , parseSC
10 , mapSC
9 , mapSC
11 ) where
10 ) where
12
11
13import Arsec
12import Arsec
14
13
15−data SpecialCasing = SC { scComments :: [Comment], scCasing :: [Case] }
16− deriving (Show)
17−
18data Case = Case {
14data Case = Case {
19 code :: Char
15 code :: Char
20 , lower :: [Char]
16 , lower :: [Char]
@@ -24,8 +20,8 @@ data Case = Case {
24 , name :: String
20 , name :: String
25 } deriving (Eq, Ord, Show)
21 } deriving (Eq, Ord, Show)
26
22
27−entries :: Parser SpecialCasing
23+entries :: Parser [Case]
28−entries = SC <$> many comment <*> many (entry <* many comment)
24+entries = many comment *> many (entry <* many comment)
29 where
25 where
30 entry = Case <$> unichar <* semi
26 entry = Case <$> unichar <* semi
31 <*> unichars
27 <*> unichars
@@ -34,19 +30,17 @@ entries = SC <$> many comment <*> many (entry <* many comment)
34 <*> manyTill anyToken (string "# ")
30 <*> manyTill anyToken (string "# ")
35 <*> manyTill anyToken (char '\n')
31 <*> manyTill anyToken (char '\n')
36
32
37−parseSC :: FilePath -> IO (Either ParseError SpecialCasing)
33+parseSC :: FilePath -> IO (Either ParseError [Case])
38parseSC name = parse entries name <$> readFile name
34parseSC name = parse entries name <$> readFile name
39
35
40−mapSC :: String -> (Case -> String) -> (Char -> Char) -> SpecialCasing
36+mapSC :: String -> (Case -> String) -> (Char -> Char) -> [Case] -> [String]
41− -> [String]
37+mapSC which access twiddle ms = typ ++ (map nice . filter p $ ms) ++ [last]
42−mapSC which access twiddle (SC _ ms) =
43− typ ++ (map nice . filter p $ ms) ++ [last]
44 where
38 where
45− typ = [which ++ "Mapping :: forall s. Char -> s -> Step (CC s) Char"
39+ typ = [which ++ "Mapping :: forall s. Char -> s -> Step (PairS (PairS s Char) Char) Char"
46− ,"{-# NOINLINE " ++ which ++ "Mapping #-}"]
40+ ,"{-# INLINE " ++ which ++ "Mapping #-}"]
47− last = which ++ "Mapping c s = Yield (to" ++ ucFirst which ++ " c) (CC s '\\0' '\\0')"
41+ last = which ++ "Mapping c s = Yield (to" ++ ucFirst which ++ " c) (s :!: '\\0' :!: '\\0')"
48 nice c = "-- " ++ name c ++ "\n" ++
42 nice c = "-- " ++ name c ++ "\n" ++
49− which ++ "Mapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"
43+ which ++ "Mapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (s :!: " ++ y ++ " :!: " ++ z ++ ")"
50 where [x,y,z] = (map showC . take 3) (access c ++ repeat '\0')
44 where [x,y,z] = (map showC . take 3) (access c ++ repeat '\0')
51 p c = [k] /= a && a /= [twiddle k] && null (conditions c)
45 p c = [k] /= a && a /= [twiddle k] && null (conditions c)
52 where a = access c
46 where a = access c
tests-and-benchmarks.markdowndeleted−63
@@ -1,63 +0,0 @@
1−Tests and benchmarks
2−====================
3−
4−Prerequisites
5−-------------
6−
7−To run the tests and benchmarks, you will need the test data, which
8−you can clone from one of the following locations:
9−
10−* Mercurial master repository:
11− [bitbucket.org/bos/text-test-data](https://bitbucket.org/bos/text-test-data)
12−
13−* Git mirror repository:
14− [github.com/bos/text-test-data](https://github.com/bos/text-test-data)
15−
16−You should clone that repository into the `tests` subdirectory (your
17−clone must be named `text-test-data` locally), then run `make -C
18−tests/text-test-data` to uncompress the test files. Many tests and
19−benchmarks will fail if the test files are missing.
20−
21−Functional tests
22−----------------
23−
24−The functional tests are located in the `tests` subdirectory. An overview of
25−what's in that directory:
26−
27− Makefile Has targets for common tasks
28− Tests Source files of the testing code
29− scripts Various utility scripts
30− text-tests.cabal Cabal file that compiles all benchmarks
31−
32−The `text-tests.cabal` builds:
33−
34−- A copy of the text library, sharing the source code, but exposing all internal
35− modules, for testing purposes
36−- The different test suites
37−
38−To compile, run all tests, and generate a coverage report, simply use `make`.
39−
40−Benchmarks
41−----------
42−
43−The benchmarks are located in the `benchmarks` subdirectory. An overview of
44−what's in that directory:
45−
46− Makefile Has targets for common tasks
47− haskell Source files of the haskell benchmarks
48− python Python implementations of some benchmarks
49− ruby Ruby implementations of some benchmarks
50− text-benchmarks.cabal Cabal file which compiles all benchmarks
51−
52−To compile the benchmarks, navigate to the `benchmarks` subdirectory and run
53−`cabal configure && cabal build`. Then, you can run the benchmarks using:
54−
55− ./dist/build/text-benchmarks/text-benchmarks
56−
57−However, since there's quite a lot of benchmarks, you usually don't want to
58−run them all. Instead, use the `-l` flag to get a list of benchmarks:
59−
60− ./dist/build/text-benchmarks/text-benchmarks
61−
62−And run the ones you want to inspect. If you want to configure the benchmarks
63−further, the exact parameters can be changed in `Benchmarks.hs`.
tests/.ghcideleted−1
@@ -1 +0,0 @@
1−:set -DHAVE_DEEPSEQ -isrc -i../..
tests/Bench.hsnew file+171
@@ -0,0 +1,171 @@
1+import BenchUtils
2+import System.Mem
3+import Control.Concurrent
4+import Data.Char
5+import System.CPUTime
6+import System.IO
7+import System.IO.Unsafe
8+import Text.Printf
9+import Control.Exception
10+
11+import qualified Data.Text as T
12+import qualified Data.Text.Encoding as E
13+import Data.Text.Internal
14+import qualified Data.Text.Fusion as S
15+
16+import qualified Data.List as L
17+import qualified Data.ByteString.Char8 as B
18+import qualified Data.ByteString as B8
19+import Data.ByteString (ByteString)
20+import Data.Word
21+import qualified System.IO.UTF8 as UTF8
22+
23+main = do ascii_bs <- B.readFile "text/test/ascii.txt"
24+ let ascii_txt = E.decodeASCII ascii_bs
25+ let ascii_str = T.unpack ascii_txt
26+ force (ascii_txt,ascii_str,ascii_bs)
27+ printf " # Text\t\tString\tByteString\n"
28+ run 1 (ascii_txt,ascii_str,ascii_bs) ascii_tests
29+
30+
31+ascii_tests = [
32+ ("cons",
33+ [F (app1 (T.cons '\88')),
34+ F (app2 ((:) '\88') ),
35+ F (app3 (B8.cons 88) )]),
36+ ("head",
37+ [F (app1 T.head),
38+ F (app2 L.head),
39+ F (app3 B.head)]),
40+ ("last",
41+ [F (app1 T.last),
42+ F (app2 L.last),
43+ F (app3 B.last)]),
44+ ("tail",
45+ [F (app1 T.tail),
46+ F (app2 L.tail),
47+ F (app3 B.tail)]),
48+ ("init",
49+ [F (app1 T.init),
50+ Flist (app2 L.init),
51+ F (app3 B.init) ]),
52+ ("null",
53+ [F (app1 T.null),
54+ F (app2 L.null),
55+ F (app3 B.null) ]),
56+ ("length",
57+ [F (app1 T.length),
58+ F (app2 L.length),
59+ F (app3 B.length)]),
60+ ("map",
61+ [F (app1 $ T.map succ),
62+ Flist (app2 (L.map succ)),
63+ F (app3 $ B.map succ)]),
64+ ("filter",
65+ [F $ app1 $ T.filter (/= '\101'),
66+ Flist $ app2 $ L.filter (/= '\101'),
67+ F $ app3 $ B8.filter (/= 101)]),
68+ ("foldl'",
69+ [F (app1 $ T.foldl' (\a w -> a+1::Int) 0),
70+ F (app2 $ L.foldl' (\a w -> a+1::Int) 0),
71+ F (app3 $ B.foldl' (\a w -> a+1::Int) 0)
72+ ]),
73+ ("drop",
74+ [F (app1 $ T.drop 30000000),
75+ Flist (app2 $ L.drop 30000000),
76+ F (app3 $ B.drop 30000000)
77+ ]),
78+ ("take",
79+ [F (app1 $ T.take 30000000),
80+ Flist (app2 $ L.take 30000000),
81+ F (app3 $ B.take 30000000)]),
82+ ("words",
83+ [F (app1 $ T.words),
84+ Flist (app2 $ L.words),
85+ F (app3 $ B.words)])
86+ ]
87+
88+bmp_tests = [
89+ ("cons",
90+ [F (app1 (T.cons '\88')),
91+ F (app2 ((:) '\88') )]),
92+ ("head",
93+ [F (app1 T.head),
94+ F (app2 L.head)]),
95+ ("last",
96+ [F (app1 T.last),
97+ F (app2 L.last)]),
98+ ("tail",
99+ [F (app1 T.tail),
100+ F (app2 L.tail)]),
101+ ("init",
102+ [F (app1 T.init),
103+ Flist (app2 L.init)]),
104+ ("null",
105+ [F (app1 T.null),
106+ F (app2 L.null),
107+ F (app3 B.null)]),
108+ ("length",
109+ [F (app1 T.length),
110+ F (app2 L.length),
111+ F (app3 B.length)]),
112+ ("map",
113+ [F (app1 $ T.map succ),
114+ Flist (app2 (L.map succ))]),
115+ ("filter",
116+ [F $ app1 $ T.filter (/= '\101'),
117+ Flist $ app2 $ L.filter (/= '\101')]),
118+ ("foldl'",
119+ [F (app1 $ T.foldl' (\a w -> a+1::Int) 0),
120+ F (app2 $ L.foldl' (\a w -> a+1::Int) 0)]),
121+ ("drop",
122+ [F (app1 $ T.drop 30000000),
123+ Flist (app2 $ L.drop 30000000)]),
124+ ("take",
125+ [F (app1 $ T.take 30000000),
126+ Flist (app2 $ L.take 30000000)]),
127+ ("words",
128+ [F (app1 $ T.words),
129+ Flist (app2 $ L.words)])
130+ ]
131+
132+smp_sip_tests = [
133+ ("cons",
134+ [F (app1 (T.cons '\65624')),
135+ F (app2 ((:) '\65624'))]),
136+ ("head",
137+ [F (app1 T.head),
138+ F (app2 L.head)]),
139+ ("last",
140+ [F (app1 T.last),
141+ F (app2 L.last)]),
142+ ("tail",
143+ [F (app1 T.tail),
144+ F (app2 L.tail)]),
145+ ("init",
146+ [F (app1 T.init),
147+ Flist (app2 L.init)]),
148+ ("null",
149+ [F (app1 T.null),
150+ F (app2 L.null),
151+ F (app3 B.null) ]),
152+ ("length",
153+ [F (app1 T.length ),
154+ F (app2 L.length),
155+ F (app3 B.length)]),
156+ ("map",
157+ [F (app1 $ T.map succ),
158+ Flist (app2 (L.map succ))]),
159+ ("filter",
160+ [F $ app1 $ T.filter (/= '\65624'),
161+ Flist $ app2 $ L.filter (/= '\65624')]),
162+ ("foldl'",
163+ [F (app1 $ T.foldl' (\a w -> a+1::Int) 0),
164+ F (app2 $ L.foldl' (\a w -> a+1::Int) 0)]),
165+ ("drop",
166+ [F (app1 $ T.drop 30000000),
167+ Flist (app2 $ L.drop 30000000)]),
168+ ("take",
169+ [F (app1 $ T.take 30000000),
170+ Flist (app2 $ L.take 30000000)])
171+ ]
tests/BenchUtils.hsnew file+79
@@ -0,0 +1,79 @@
1+{-# LANGUAGE ExistentialQuantification #-}
2+module BenchUtils where
3+
4+import qualified Data.List as L
5+import Data.ByteString (ByteString(..))
6+import Data.Word
7+import Text.Printf
8+import System.IO
9+import Data.Text.Internal (Text(..))
10+import System.Mem
11+import System.CPUTime
12+import Control.Exception
13+import Control.Concurrent
14+
15+data Result = T | B
16+
17+data F a = forall b. F (a -> b) | forall b. Flist (a -> [b])
18+
19+class Forceable a where
20+ force :: a -> IO Result
21+ force v = v `seq` return T
22+
23+instance Forceable Text
24+
25+seqList = L.foldl' (flip seq) (return ())
26+instance Forceable [a] where
27+ force = L.foldl' (flip seq) (return T)
28+
29+instance Forceable ByteString
30+instance Forceable Char
31+instance Forceable Bool
32+instance Forceable Int
33+instance Forceable Word8
34+
35+instance (Forceable a, Forceable b) => Forceable (a,b) where
36+ force (a,b) = force a >> force b
37+
38+instance (Forceable a, Forceable b, Forceable c) => Forceable (a,b,c) where
39+ force (a,b,c) = force a >> force b >> force c
40+
41+run c x tests = sequence_ $ zipWith (runTest c x) [1..] tests
42+
43+runTest :: Int -> a -> Int -> (String,[F a]) -> IO ()
44+runTest count x n (name,tests) = do
45+ printf "%2d " n
46+ fn tests
47+ printf "\t# %-16s\n" (show name)
48+ hFlush stdout
49+ where fn xs = case xs of
50+ [f,g,h] -> runN count f x >> putStr "\t"
51+ >> runN count g x >> putStr "\t"
52+ >> runN count h x >> putStr "\t"
53+ [f,g] -> runN count f x >> putStr "\t"
54+ >> runN count g x >> putStr "\t\t"
55+ [f] -> runN count f x >> putStr "\t\t\t"
56+ _ -> return ()
57+ run f x = performGC >> threadDelay 100 >> time f x
58+ runN 0 f x = return ()
59+ runN c f x = run f x >> runN (c-1) f x
60+
61+time (Flist f) a = do
62+ start <- getCPUTime
63+ v <- seqList (f a)
64+ end <- getCPUTime
65+ let diff = (fromIntegral (end - start)) / 10^12
66+ printf "%0.3f" (diff :: Double)
67+ hFlush stdout
68+
69+time (F f) a = do
70+ start <- getCPUTime
71+ v <- evaluate (f a)
72+ end <- getCPUTime
73+ let diff = (fromIntegral (end - start)) / 10^12
74+ printf "%0.3f" (diff :: Double)
75+ hFlush stdout
76+
77+app1 f (x,y,z) = f x
78+app2 f (x,y,z) = f y
79+app3 f (x,y,z) = f z
tests/EncodingBench.hsnew file+106
@@ -0,0 +1,106 @@
1+{-# LANGUAGE ExistentialQuantification #-}
2+
3+import BenchUtils
4+import qualified Data.Text.Utf8.Fusion as U8
5+import qualified Data.Text.Utf8.Internal as U8I
6+import qualified Data.Text.Utf32.Fusion as U32
7+import qualified Data.Text.Utf32.Internal as U32I
8+import qualified Data.Text.Fusion as S
9+import Data.Text.Fusion (bsStream,Encoding(..))
10+import qualified Data.Text as T
11+import qualified Data.ByteString as B
12+import Text.Printf
13+import System.Mem
14+
15+instance Forceable U32I.Text
16+instance Forceable U8I.Text
17+
18+data E a = forall b. E (a -> b) | EText (a -> S.Stream Char)
19+
20+main = do force (ascii_tests, smp_sip_tests)
21+ ascii <- B.readFile "ascii.txt"
22+ let ascii8 = U8.unstream (bsStream ascii ASCII)
23+ let ascii16 = S.unstream (bsStream ascii ASCII)
24+ let ascii32 = U32.unstream (bsStream ascii ASCII)
25+ force (ascii8, ascii16, ascii32)
26+ printf " # Utf8\t\tUtf16\tUtf32\n"
27+ run 1 (ascii8, ascii16, ascii32) ascii_tests
28+ performGC
29+ bmp <- B.readFile "bmp.txt"
30+ let bmp8 = U8.unstream (bsStream bmp Utf8)
31+ let bmp16 = S.unstream (bsStream bmp Utf8)
32+ let bmp32 = U32.unstream (bsStream bmp Utf8)
33+ force (bmp8, bmp16, bmp32)
34+ printf " # Utf8\t\tUtf16\tUtf32\n"
35+ run 1 (bmp8, bmp16, bmp32) ascii_tests
36+ performGC
37+ smp_sip <- B.readFile "smp_sip.txt"
38+ let smp_sip8 = U8.unstream (bsStream smp_sip Utf8)
39+ let smp_sip16 = S.unstream (bsStream smp_sip Utf8)
40+ let smp_sip32 = U32.unstream (bsStream smp_sip Utf8)
41+ force (smp_sip8, smp_sip16, smp_sip32)
42+ printf " # Utf8\t\tUtf16\tUtf32\n"
43+ run 1 (smp_sip8, smp_sip16, smp_sip32) smp_sip_tests
44+
45+ascii_tests = [
46+ ("cons" ,
47+ [F $ app1 $ U8.unstream . S.cons '\88' . U8.stream,
48+ F $ app2 $ S.unstream . S.cons '\88' . S.stream,
49+ F $ app3 $ U32.unstream . S.cons '\88' . U32.stream]),
50+ ("length",
51+ [F $ app1 $ S.length . U8.stream,
52+ F $ app2 $ S.length . S.stream,
53+ F $ app3 $ S.length . U32.stream]),
54+ ("map" ,
55+ [F $ app1 $ U8.unstream . S.map succ . U8.stream,
56+ F $ app2 $ S.unstream . S.map succ . S.stream,
57+ F $ app3 $ U32.unstream . S.map succ . U32.stream]),
58+ ("filter",
59+ [F $ app1 $ U8.unstream . S.filter (/= '\101') . U8.stream,
60+ F $ app2 $ S.unstream . S.filter (/= '\101') . S.stream,
61+ F $ app3 $ U32.unstream . S.filter (/= '\101') . U32.stream]),
62+ ("take",
63+ [F $ app1 $ U8.unstream . S.take 1000000 . U8.stream,
64+ F $ app2 $ S.unstream . S.take 1000000 . S.stream,
65+ F $ app3 $ U32.unstream . S.take 1000000 . U32.stream]),
66+ ("drop" ,
67+ [F $ app1 $ U8.unstream . S.drop 1000000 . U8.stream,
68+ F $ app2 $ S.unstream . S.drop 1000000 . S.stream,
69+ F $ app3 $ U32.unstream . S.drop 1000000 . U32.stream]),
70+ ("foldl'",
71+ [F $ app1 $ S.foldl' (\a w -> a+1::Int) 0 . U8.stream,
72+ F $ app2 $ S.foldl' (\a w -> a+1::Int) 0 . S.stream,
73+ F $ app3 $ S.foldl' (\a w -> a+1::Int) 0 . U32.stream
74+ ])
75+ ]
76+
77+smp_sip_tests = [
78+ ("cons" ,
79+ [F $ app1 $ U8.unstream . S.cons '\88' . U8.stream,
80+ F $ app2 $ S.unstream . S.cons '\88' . S.stream,
81+ F $ app3 $ U32.unstream . S.cons '\88' . U32.stream]),
82+ ("length",
83+ [F $ app1 $ S.length . U8.stream,
84+ F $ app2 $ S.length . S.stream,
85+ F $ app3 $ S.length . U32.stream]),
86+ ("map" ,
87+ [F $ app1 $ U8.unstream . S.map succ . U8.stream,
88+ F $ app2 $ S.unstream . S.map succ . S.stream,
89+ F $ app3 $ U32.unstream . S.map succ . U32.stream]),
90+ ("filter",
91+ [F $ app1 $ U8.unstream . S.filter (/= '\101') . U8.stream,
92+ F $ app2 $ S.unstream . S.filter (/= '\101') . S.stream,
93+ F $ app3 $ U32.unstream . S.filter (/= '\101') . U32.stream]),
94+ ("take",
95+ [F $ app1 $ U8.unstream . S.take 1000000 . U8.stream,
96+ F $ app2 $ S.unstream . S.take 1000000 . S.stream,
97+ F $ app3 $ U32.unstream . S.take 1000000 . U32.stream]),
98+ ("drop" ,
99+ [F $ app1 $ U8.unstream . S.drop 1000000 . U8.stream,
100+ F $ app2 $ S.unstream . S.drop 1000000 . S.stream,
101+ F $ app3 $ U32.unstream . S.drop 1000000 . U32.stream]),
102+ ("foldl'",
103+ [F $ app1 $ S.foldl' (\a w -> a+1::Int) 0 . U8.stream,
104+ F $ app2 $ S.foldl' (\a w -> a+1::Int) 0 . S.stream,
105+ F $ app3 $ S.foldl' (\a w -> a+1::Int) 0 . U32.stream])
106+ ]
tests/FusionBench.hsnew file+53
@@ -0,0 +1,53 @@
1+import Prelude hiding (zip,zip3)
2+
3+import BenchUtils
4+import Data.Char
5+import qualified Data.List as L
6+import qualified Data.ByteString as B
7+import qualified Data.Text as T
8+import Data.Text.Fusion (Encoding(..))
9+import qualified Data.Text.Fusion as S
10+import Text.Printf
11+import System.IO
12+import System.Mem
13+import qualified System.IO.UTF8 as UTF8
14+
15+main = do ascii_str <- readFile "ascii.txt"
16+ ascii_bs <- B.readFile "ascii.txt"
17+ let ascii_txt = T.decode ASCII ascii_bs
18+ force (ascii_txt,ascii_str,ascii_bs)
19+ printf " # Text\t\tString\tByteString\n"
20+ run 1 (ascii_txt,ascii_str,ascii_bs) ascii_tests
21+
22+trd (a,b,c) = c
23+
24+ascii_tests = [
25+ ("map/map",
26+ [F $ T.map pred . T.map succ . fst,
27+ Flist $ L.map pred . L.map succ . snd,
28+ F $ B.map pred . B.map succ . trd]),
29+ ("filter/filter",
30+ [F $ T.filter (/= '\101') . T.filter (/= '\102') . fst,
31+ Flist $ L.filter (/= '\101') . L.filter (/= '\102') . snd,
32+ F $ B.filter (/= 101) . B.filter (/= 102) . trd]),
33+ ("filter/map",
34+ [F $ T.filter (/= '\103') . T.map succ . fst,
35+ Flist $ L.filter (/= '\103') . L.map succ . snd,
36+ F $ B.filter (/= 103) . B.map succ . trd]),
37+ ("map/filter",
38+ [F $ T.map succ . T.filter (/= '\104') . fst,
39+ Flist $ L.map succ . L.filter (/= '\104') . snd,
40+ F $ B.map succ . B.filter (/= 104) . trd]),
41+ ("foldl'/map",
42+ [F $ T.foldl' (const . (+1)) (0 :: Int) . T.map succ . fst,
43+ F $ L.foldl' (const . (+1)) (0 :: Int) . L.map succ . snd,
44+ F $ B.foldl' (const . (+1)) (0 :: Int) . B.map succ . trd]),
45+ ("foldl'/filter",
46+ [F $ T.foldl' (const . (+2)) (0::Int) . T.filter (/= '\105') . fst,
47+ F $ L.foldl' (const . (+2)) (0::Int) . L.filter (/= '\105') . snd,
48+ F $ B.foldl' (const . (+2)) (0::Int) . B.filter (/= 105) . trd]),
49+ ("foldl'/map/filter",
50+ [F $ T.foldl' (const.(+3)) (0::Int) . T.map succ . T.filter (/='\110') . fst,
51+ F $ L.foldl' (const.(+3)) (0::Int) . L.map succ . L.filter (/='\110') . snd,
52+ F $ B.foldl' (const . (+3)) (0::Int) . B.map succ . B.filter (/= 110) . trd])
53+ ]
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+15−33
@@ -1,40 +1,22 @@
1−count = 1000
1+all: bin/Bench
2
2
3−all: coverage literal-rule-test
3+bin/Bench: dist/setup-config *.hs
4+ ./Setup build
5+ ./Setup install
4
6
5−literal-rule-test:
7+Setup: Setup.lhs
6− ./literal-rule-test.sh
8+ ghc -O --make $@
9+ -rm -f $@.o $@.hi
7
10
8−coverage: build coverage/hpc_index.html
11+.PHONY: testdata
12+testdata: text-testdata.tar.bz2
9
13
10−build: text-test-data
14+text-testdata.tar.bz2:
11− cabal configure -fhpc
15+ curl -O http://projects.haskell.org/text/text-testdata.tar.bz2
12− cabal build
13
16
14−text-test-data:
17+dist/setup-config: text-tests.cabal Setup
15− hg clone https://bitbucket.org/bos/text-test-data
18+ ./Setup configure --user --prefix=`pwd`
16− $(MAKE) -C text-test-data
17−
18−coverage/text-tests.tix:
19− -mkdir -p coverage
20− ./dist/build/text-tests/text-tests -a $(count)
21− mv text-tests.tix $@
22−
23−coverage/text-tests-stdio.tix:
24− -mkdir -p coverage
25− ./scripts/cover-stdio.sh ./dist/build/text-tests-stdio/text-tests-stdio
26− mv text-tests-stdio.tix $@
27−
28−coverage/coverage.tix: coverage/text-tests.tix coverage/text-tests-stdio.tix
29− hpc combine --output=$@ \
30− --exclude=Main \
31− coverage/text-tests.tix \
32− coverage/text-tests-stdio.tix
33−
34−coverage/hpc_index.html: coverage/coverage.tix
35− hpc markup --destdir=coverage coverage/coverage.tix
36
19
37clean:
20clean:
38− rm -rf dist coverage .hpc
21+ -rm -f *.o *.hi Setup
39−
22+ -rm -rf dist bin
40−.PHONY: build coverage all literal-rule-test
tests/Properties.hsnew file+553
@@ -0,0 +1,553 @@
1+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
2+{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}
3+
4+import Test.QuickCheck
5+import Text.Show.Functions
6+
7+import Data.Char
8+import Debug.Trace
9+import Text.Printf
10+import System.Environment
11+import Control.Applicative
12+import Control.Arrow
13+import Control.Monad
14+import Data.Word
15+import qualified Data.ByteString as B
16+import qualified Data.Text as T
17+import qualified Data.Text.Lazy as TL
18+import qualified Data.Text.Encoding as E
19+import Control.Exception
20+import qualified Data.Text.Fusion as S
21+import qualified Data.Text.Fusion.Common as S
22+import qualified Data.Text.Lazy.Encoding as EL
23+import qualified Data.Text.Lazy.Fusion as SL
24+import qualified Data.List as L
25+import System.IO.Unsafe
26+import Prelude hiding (catch)
27+
28+import QuickCheckUtils
29+
30+-- If a pure property threatens to crash, wrap it with this to keep
31+-- QuickCheck from bombing out.
32+crashy :: a -> a -> a
33+{-# NOINLINE crashy #-}
34+crashy onException p = unsafePerformIO $
35+ (return $! p) `catch` \e ->
36+ let types = e :: SomeException
37+ in trace ("*** Exception: " ++ show e) return onException
38+
39+prop_T_pack_unpack = (T.unpack . T.pack) `eq` id
40+prop_TL_pack_unpack = (TL.unpack . TL.pack) `eq` id
41+prop_T_stream_unstream = (S.unstream . S.stream) `eq` id
42+prop_TL_stream_unstream = (SL.unstream . SL.stream) `eq` id
43+prop_T_reverse_stream t = (S.reverse . S.reverseStream) t == t
44+prop_T_singleton c = [c] == (T.unpack . T.singleton) c
45+prop_TL_singleton c = [c] == (TL.unpack . TL.singleton) c
46+prop_TL_unstreamChunks x = f 11 x == f 1000 x
47+ where f n = SL.unstreamChunks n . S.streamList
48+prop_TL_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
49+
50+prop_T_ascii t = E.decodeASCII (E.encodeUtf8 a) == a
51+ where a = T.map (\c -> chr (ord c `mod` 128)) t
52+prop_T_utf8 = (E.decodeUtf8 . E.encodeUtf8) `eq` id
53+prop_TL_utf8 = (EL.decodeUtf8 . EL.encodeUtf8) `eq` id
54+prop_T_utf16LE = (E.decodeUtf16LE . E.encodeUtf16LE) `eq` id
55+prop_T_utf16BE = (E.decodeUtf16BE . E.encodeUtf16BE) `eq` id
56+prop_T_utf32LE = (E.decodeUtf32LE . E.encodeUtf32LE) `eq` id
57+prop_T_utf32BE = (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
58+
59+class Stringy s where
60+ packS :: String -> s
61+ unpackS :: s -> String
62+ splitAtS :: Int -> s -> (s,s)
63+ packSChunkSize :: Int -> String -> s
64+ packSChunkSize _ = packS
65+
66+instance Stringy String where
67+ packS = id
68+ unpackS = id
69+ splitAtS = splitAt
70+
71+instance Stringy (S.Stream Char) where
72+ packS = S.streamList
73+ unpackS = S.unstreamList
74+ splitAtS n s = (S.take n s, S.drop n s)
75+
76+instance Stringy T.Text where
77+ packS = T.pack
78+ unpackS = T.unpack
79+ splitAtS = T.splitAt
80+
81+instance Stringy TL.Text where
82+ packSChunkSize k = SL.unstreamChunks k . S.streamList
83+ packS = TL.pack
84+ unpackS = TL.unpack
85+ splitAtS = TL.splitAt . fromIntegral
86+
87+-- Do two functions give the same answer?
88+eq :: (Eq a) => (t -> a) -> (t -> a) -> t -> Bool
89+eq a b s = crashy False $ a s == b s
90+
91+-- What about with the RHS packed?
92+eqP :: (Eq a, Show a, Stringy s) =>
93+ (String -> a) -> (s -> a) -> String -> Word8 -> Bool
94+eqP a b s w = eq "orig" (a s) (b t) &&
95+ eq "mini" (a s) (b mini) &&
96+ eq "head" (a sa) (b ta) &&
97+ eq "tail" (a sb) (b tb)
98+ where t = packS s
99+ mini = packSChunkSize 10 s
100+ (sa,sb) = splitAt m s
101+ (ta,tb) = splitAtS m t
102+ l = length s
103+ m | l == 0 = n
104+ | otherwise = n `mod` l
105+ n = fromIntegral w
106+ eq s a b | crashy False $ a == b = True
107+ | otherwise = trace (s ++ ": " ++ show a ++ " /= " ++ show b) False
108+
109+-- Or with the string non-empty, and the RHS packed?
110+eqEP :: (Eq a, Stringy s) =>
111+ (String -> a) -> (s -> a) -> NotEmpty String -> Word8 -> Bool
112+eqEP a b e w = a s == b t &&
113+ a s == b mini &&
114+ (null sa || a sa == b ta) &&
115+ (null sb || a sb == b tb)
116+ where (sa,sb) = splitAt m s
117+ (ta,tb) = splitAtS m t
118+ t = packS s
119+ mini = packSChunkSize 10 s
120+ l = length s
121+ m | l == 0 = n
122+ | otherwise = n `mod` l
123+ n = fromIntegral w
124+ s = notEmpty e
125+
126+prop_S_cons x = (x:) `eqP` (unpackS . S.cons x)
127+prop_T_cons x = (x:) `eqP` (unpackS . T.cons x)
128+prop_TL_cons x = ((x:) `eqP` (TL.unpack . TL.cons x))
129+prop_S_snoc x = (++ [x]) `eqP` (unpackS . (flip S.snoc) x)
130+prop_T_snoc x = (++ [x]) `eqP` (unpackS . (flip T.snoc) x)
131+prop_TL_snoc x = (++ [x]) `eqP` (unpackS . (flip TL.snoc) x)
132+prop_T_append s = (s++) `eqP` (unpackS . T.append (packS s))
133+prop_T_appendS s = (s++) `eqP` (unpackS . S.unstream . S.append (S.stream (packS s)) . S.stream)
134+
135+uncons (x:xs) = Just (x,xs)
136+uncons _ = Nothing
137+
138+prop_T_uncons s = uncons `eqP` (fmap (second unpackS) . T.uncons)
139+ where types = s :: String
140+prop_TL_uncons s = uncons `eqP` (fmap (second unpackS) . TL.uncons)
141+ where types = s :: String
142+prop_S_head = head `eqEP` S.head
143+prop_T_head = head `eqEP` T.head
144+prop_TL_head = head `eqEP` TL.head
145+prop_S_last = last `eqEP` S.last
146+prop_T_last = last `eqEP` T.last
147+prop_TL_last = last `eqEP` TL.last
148+prop_S_tail = tail `eqEP` (unpackS . S.tail)
149+prop_T_tail = tail `eqEP` (unpackS . T.tail)
150+prop_TL_tail = tail `eqEP` (unpackS . TL.tail)
151+prop_S_init = init `eqEP` (unpackS . S.init)
152+prop_T_init = init `eqEP` (unpackS . T.init)
153+prop_TL_init = init `eqEP` (unpackS . TL.init)
154+prop_S_null = null `eqP` S.null
155+prop_T_null = null `eqP` T.null
156+prop_TL_null = null `eqP` TL.null
157+prop_S_length = length `eqP` S.length
158+prop_T_length = length `eqP` T.length
159+prop_TL_length = length `eqP` (fromIntegral . TL.length)
160+prop_T_map f = map f `eqP` (unpackS . T.map f)
161+prop_TL_map f = map f `eqP` (unpackS . TL.map f)
162+prop_T_intercalate c = L.intercalate c `eq` (unpackS . T.intercalate (packS c) . map packS)
163+prop_TL_intercalate c = L.intercalate c `eq` (unpackS . TL.intercalate (TL.pack c) . map TL.pack)
164+prop_T_intersperse c = L.intersperse c `eqP` (unpackS . T.intersperse c)
165+prop_TL_intersperse c = L.intersperse c `eqP` (unpackS . TL.intersperse c)
166+prop_T_transpose = L.transpose `eq` (map unpackS . T.transpose . map packS)
167+prop_TL_transpose = L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)
168+prop_T_reverse = L.reverse `eqP` (unpackS . T.reverse)
169+prop_TL_reverse = L.reverse `eqP` (unpackS . TL.reverse)
170+prop_T_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)
171+
172+prop_T_foldl f z = L.foldl f z `eqP` (T.foldl f z)
173+ where types = f :: Char -> Char -> Char
174+prop_TL_foldl f z = L.foldl f z `eqP` (TL.foldl f z)
175+ where types = f :: Char -> Char -> Char
176+prop_T_foldl' f z = L.foldl' f z `eqP` T.foldl' f z
177+ where types = f :: Char -> Char -> Char
178+prop_TL_foldl' f z = L.foldl' f z `eqP` TL.foldl' f z
179+ where types = f :: Char -> Char -> Char
180+prop_T_foldl1 f = L.foldl1 f `eqEP` T.foldl1 f
181+prop_TL_foldl1 f = L.foldl1 f `eqEP` TL.foldl1 f
182+prop_T_foldl1' f = L.foldl1' f `eqEP` T.foldl1' f
183+prop_TL_foldl1' f = L.foldl1' f `eqEP` TL.foldl1' f
184+prop_T_foldr f z = L.foldr f z `eqP` T.foldr f z
185+ where types = f :: Char -> Char -> Char
186+prop_TL_foldr f z = L.foldr f z `eqP` TL.foldr f z
187+ where types = f :: Char -> Char -> Char
188+prop_T_foldr1 f = L.foldr1 f `eqEP` T.foldr1 f
189+prop_TL_foldr1 f = L.foldr1 f `eqEP` TL.foldr1 f
190+
191+prop_T_concat = L.concat `eq` (unpackS . T.concat . map packS)
192+prop_TL_concat = L.concat `eq` (unpackS . TL.concat . map TL.pack)
193+prop_T_concatMap f = L.concatMap f `eqP` (unpackS . T.concatMap (packS . f))
194+prop_TL_concatMap f = L.concatMap f `eqP` (unpackS . TL.concatMap (TL.pack . f))
195+prop_T_any p = L.any p `eqP` T.any p
196+prop_TL_any p = L.any p `eqP` TL.any p
197+prop_T_all p = L.all p `eqP` T.all p
198+prop_TL_all p = L.all p `eqP` TL.all p
199+prop_T_maximum = L.maximum `eqEP` T.maximum
200+prop_TL_maximum = L.maximum `eqEP` TL.maximum
201+prop_T_minimum = L.minimum `eqEP` T.minimum
202+prop_TL_minimum = L.minimum `eqEP` TL.minimum
203+
204+prop_T_scanl f z = L.scanl f z `eqP` (unpackS . T.scanl f z)
205+prop_TL_scanl f z = L.scanl f z `eqP` (unpackS . TL.scanl f z)
206+prop_T_scanl1 f = L.scanl1 f `eqP` (unpackS . T.scanl1 f)
207+prop_TL_scanl1 f = L.scanl1 f `eqP` (unpackS . TL.scanl1 f)
208+prop_T_scanr f z = L.scanr f z `eqP` (unpackS . T.scanr f z)
209+prop_TL_scanr f z = L.scanr f z `eqP` (unpackS . TL.scanr f z)
210+prop_T_scanr1 f = L.scanr1 f `eqP` (unpackS . T.scanr1 f)
211+prop_TL_scanr1 f = L.scanr1 f `eqP` (unpackS . TL.scanr1 f)
212+
213+prop_T_mapAccumL f z = L.mapAccumL f z `eqP` (second unpackS . T.mapAccumL f z)
214+ where types = f :: Int -> Char -> (Int,Char)
215+prop_TL_mapAccumL f z = L.mapAccumL f z `eqP` (second unpackS . TL.mapAccumL f z)
216+ where types = f :: Int -> Char -> (Int,Char)
217+prop_T_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z)
218+ where types = f :: Int -> Char -> (Int,Char)
219+prop_TL_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)
220+ where types = f :: Int -> Char -> (Int,Char)
221+
222+prop_T_replicate n = L.replicate n `eq` (unpackS . T.replicate n)
223+prop_TL_replicate n = L.replicate n `eq` (unpackS . TL.replicate n)
224+
225+unf :: Int -> Char -> Maybe (Char, Char)
226+unf n c | fromEnum c * 100 > n = Nothing
227+ | otherwise = Just (c, succ c)
228+
229+prop_T_unfoldr n = L.unfoldr (unf n) `eq` (unpackS . T.unfoldr (unf n))
230+prop_TL_unfoldr n = L.unfoldr (unf n) `eq` (unpackS . TL.unfoldr (unf n))
231+prop_T_unfoldrN n m = (L.take n . L.unfoldr (unf m)) `eq`
232+ (unpackS . T.unfoldrN n (unf m))
233+prop_TL_unfoldrN n m = (L.take n . L.unfoldr (unf m)) `eq`
234+ (unpackS . TL.unfoldrN (fromIntegral n) (unf m))
235+
236+unpack2 :: (Stringy s) => (s,s) -> (String,String)
237+unpack2 = unpackS *** unpackS
238+
239+prop_S_take n = L.take n `eqP` (unpackS . S.take n)
240+prop_T_take n = L.take n `eqP` (unpackS . T.take n)
241+prop_TL_take n = L.take n `eqP` (unpackS . TL.take (fromIntegral n))
242+prop_S_drop n = L.drop n `eqP` (unpackS . S.drop n)
243+prop_T_drop n = L.drop n `eqP` (unpackS . T.drop n)
244+prop_TL_drop n = L.drop n `eqP` (unpackS . TL.drop n)
245+prop_S_takeWhile p = L.takeWhile p `eqP` (unpackS . S.takeWhile p)
246+prop_T_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
247+prop_TL_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
248+prop_S_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
249+prop_T_dropWhile p = L.dropWhile p `eqP` (unpackS . T.dropWhile p)
250+prop_TL_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
251+prop_T_splitAt n = L.splitAt n `eqP` (unpack2 . T.splitAt n)
252+prop_TL_splitAt n = L.splitAt n `eqP` (unpack2 . TL.splitAt (fromIntegral n))
253+prop_T_span p = L.span p `eqP` (unpack2 . T.span p)
254+prop_TL_span p = L.span p `eqP` (unpack2 . TL.span p)
255+prop_T_break p = L.break p `eqP` (unpack2 . T.break p)
256+prop_TL_break p = L.break p `eqP` (unpack2 . TL.break p)
257+prop_T_group = L.group `eqP` (map unpackS . T.group)
258+prop_TL_group = L.group `eqP` (map unpackS . TL.group)
259+prop_T_groupBy p = L.groupBy p `eqP` (map unpackS . T.groupBy p)
260+prop_TL_groupBy p = L.groupBy p `eqP` (map unpackS . TL.groupBy p)
261+prop_T_inits = L.inits `eqP` (map unpackS . T.inits)
262+prop_TL_inits = L.inits `eqP` (map unpackS . TL.inits)
263+prop_T_tails = L.tails `eqP` (map unpackS . T.tails)
264+prop_TL_tails = L.tails `eqP` (map unpackS . TL.tails)
265+
266+prop_T_split_i c = id `eq` (T.intercalate (T.singleton c) . T.split c)
267+prop_TL_split_i c = id `eq` (TL.intercalate (TL.singleton c) . TL.split c)
268+
269+prop_T_splitWith p = splitWith p `eqP` (map unpackS . T.splitWith p)
270+prop_TL_splitWith p = splitWith p `eqP` (map unpackS . TL.splitWith p)
271+
272+splitWith :: (a -> Bool) -> [a] -> [[a]]
273+splitWith _ [] = []
274+splitWith p xs = loop xs
275+ where loop s | null s' = [l]
276+ | otherwise = l : loop (tail s')
277+ where (l, s') = break p s
278+
279+prop_T_breakSubstring_isInfixOf s l
280+ = T.isInfixOf s l ==
281+ T.null s || (not . T.null . snd $ T.breakSubstring s l)
282+prop_T_breakSubstringC c
283+ = L.break (==c) `eqP`
284+ (unpack2 . T.breakSubstring (T.singleton c))
285+
286+prop_T_lines = L.lines `eqP` (map unpackS . T.lines)
287+prop_TL_lines = L.lines `eqP` (map unpackS . TL.lines)
288+{-
289+prop_T_lines' = lines' `eqP` (map unpackS . T.lines')
290+ where lines' "" = []
291+ lines' s = let (l, s') = break eol s
292+ in l : case s' of
293+ [] -> []
294+ ('\r':'\n':s'') -> lines' s''
295+ (_:s'') -> lines' s''
296+ eol c = c == '\r' || c == '\n'
297+-}
298+prop_T_words = L.words `eqP` (map unpackS . T.words)
299+prop_TL_words = L.words `eqP` (map unpackS . TL.words)
300+prop_T_unlines = L.unlines `eq` (unpackS . T.unlines . map packS)
301+prop_TL_unlines = L.unlines `eq` (unpackS . TL.unlines . map packS)
302+prop_T_unwords = L.unwords `eq` (unpackS . T.unwords . map packS)
303+prop_TL_unwords = L.unwords `eq` (unpackS . TL.unwords . map packS)
304+
305+prop_S_isPrefixOf s = L.isPrefixOf s`eqP` (S.isPrefixOf (S.stream $ packS s) . S.stream)
306+prop_T_isPrefixOf s = L.isPrefixOf s`eqP` T.isPrefixOf (packS s)
307+prop_TL_isPrefixOf s = L.isPrefixOf s`eqP` TL.isPrefixOf (packS s)
308+prop_T_isSuffixOf s = L.isSuffixOf s`eqP` T.isSuffixOf (packS s)
309+prop_TL_isSuffixOf s = L.isSuffixOf s`eqP` TL.isSuffixOf (packS s)
310+prop_T_isInfixOf s = L.isInfixOf s `eqP` T.isInfixOf (packS s)
311+prop_TL_isInfixOf s = L.isInfixOf s `eqP` TL.isInfixOf (packS s)
312+
313+prop_T_elem c = L.elem c `eqP` T.elem c
314+prop_TL_elem c = L.elem c `eqP` TL.elem c
315+prop_T_filter p = L.filter p `eqP` (unpackS . T.filter p)
316+prop_TL_filter p = L.filter p `eqP` (unpackS . TL.filter p)
317+prop_T_find p = L.find p `eqP` T.find p
318+prop_TL_find p = L.find p `eqP` TL.find p
319+prop_T_partition p = L.partition p `eqP` (unpack2 . T.partition p)
320+prop_TL_partition p = L.partition p `eqP` (unpack2 . TL.partition p)
321+
322+prop_T_index x s = x < L.length s && x >= 0 ==>
323+ (L.!!) s x == T.index (packS s) x
324+prop_TL_index x s = x < L.length s && x >= 0 ==>
325+ (L.!!) s x == TL.index (packS s) (fromIntegral x)
326+prop_T_findIndex p = L.findIndex p `eqP` T.findIndex p
327+prop_TL_findIndex p = (fmap fromIntegral . L.findIndex p) `eqP` TL.findIndex p
328+prop_T_findIndices p = L.findIndices p `eqP` T.findIndices p
329+prop_TL_findIndices p = (fmap fromIntegral . L.findIndices p) `eqP` TL.findIndices p
330+prop_T_elemIndex c = L.elemIndex c `eqP` T.elemIndex c
331+prop_TL_elemIndex c = (fmap fromIntegral . L.elemIndex c) `eqP` TL.elemIndex c
332+prop_T_elemIndices c = L.elemIndices c`eqP` T.elemIndices c
333+prop_TL_elemIndices c = (fmap fromIntegral . L.elemIndices c) `eqP` TL.elemIndices c
334+prop_T_count c = (L.length . L.elemIndices c) `eqP` T.count c
335+prop_TL_count c = (fromIntegral . L.length . L.elemIndices c) `eqP` TL.count c
336+prop_T_zip s = L.zip s `eqP` T.zip (packS s)
337+prop_TL_zip s = L.zip s `eqP` TL.zip (packS s)
338+prop_T_zipWith c s = L.zipWith c s `eqP` (unpackS . T.zipWith c (packS s))
339+prop_TL_zipWith c s = L.zipWith c s `eqP` (unpackS . TL.zipWith c (packS s))
340+
341+-- Regression tests.
342+prop_S_filter_eq s = S.filter p t == S.streamList (filter p s)
343+ where p = (/= S.last t)
344+ t = S.streamList s
345+
346+-- Make a stream appear shorter than it really is, to ensure that
347+-- functions that consume inaccurately sized streams behave
348+-- themselves.
349+shorten :: Int -> S.Stream a -> S.Stream a
350+shorten n t@(S.Stream arr off len)
351+ | n < len && n > 0 = S.Stream arr off n
352+ | otherwise = t
353+
354+main = run tests =<< getArgs
355+
356+run :: [(String, Int -> IO (Bool,Int))] -> [String] -> IO ()
357+run tests args = do
358+ let (n,names) = case args of
359+ (k:ts) -> (read k,ts)
360+ [] -> (100,[])
361+ (results,passed) <- fmap unzip . forM tests $ \(s,a) ->
362+ if null names || s `elem` names
363+ then printf "%-40s: " s >> a n
364+ else return (True,0)
365+ printf "Passed %d tests!\n" (sum passed)
366+ when (not . and $ results) $
367+ fail "Not all tests passed!"
368+
369+tests :: [(String, Int -> IO (Bool, Int))]
370+tests = [
371+ ("prop_T_pack_unpack", mytest prop_T_pack_unpack),
372+ ("prop_TL_pack_unpack", mytest prop_TL_pack_unpack),
373+ ("prop_T_stream_unstream", mytest prop_T_stream_unstream),
374+ ("prop_TL_stream_unstream", mytest prop_TL_stream_unstream),
375+ ("prop_T_reverse_stream", mytest prop_T_reverse_stream),
376+ ("prop_T_singleton", mytest prop_T_singleton),
377+ ("prop_TL_singleton", mytest prop_TL_singleton),
378+ ("prop_TL_unstreamChunks", mytest prop_TL_unstreamChunks),
379+ ("prop_TL_chunk_unchunk", mytest prop_TL_chunk_unchunk),
380+
381+ ("prop_T_ascii", mytest prop_T_ascii),
382+ ("prop_T_utf8", mytest prop_T_utf8),
383+ ("prop_TL_utf8", mytest prop_TL_utf8),
384+ ("prop_T_utf16LE", mytest prop_T_utf16LE),
385+ ("prop_T_utf16BE", mytest prop_T_utf16BE),
386+ ("prop_T_utf32LE", mytest prop_T_utf32LE),
387+ ("prop_T_utf32BE", mytest prop_T_utf32BE),
388+
389+ ("prop_S_cons", mytest prop_S_cons),
390+ ("prop_T_cons", mytest prop_T_cons),
391+ ("prop_TL_cons", mytest prop_TL_cons),
392+ ("prop_S_snoc", mytest prop_S_snoc),
393+ ("prop_T_snoc", mytest prop_T_snoc),
394+ ("prop_TL_snoc", mytest prop_TL_snoc),
395+ ("prop_T_append", mytest prop_T_append),
396+ ("prop_T_appendS", mytest prop_T_appendS),
397+ ("prop_T_uncons", mytest prop_T_uncons),
398+ ("prop_TL_uncons", mytest prop_TL_uncons),
399+ ("prop_S_head", mytest prop_S_head),
400+ ("prop_T_head", mytest prop_T_head),
401+ ("prop_TL_head", mytest prop_TL_head),
402+ ("prop_S_last", mytest prop_S_last),
403+ ("prop_T_last", mytest prop_T_last),
404+ ("prop_TL_last", mytest prop_TL_last),
405+ ("prop_S_tail", mytest prop_S_tail),
406+ ("prop_T_tail", mytest prop_T_tail),
407+ ("prop_TL_tail", mytest prop_TL_tail),
408+ ("prop_S_init", mytest prop_S_init),
409+ ("prop_T_init", mytest prop_T_init),
410+ ("prop_TL_init", mytest prop_TL_init),
411+ ("prop_S_null", mytest prop_S_null),
412+ ("prop_T_null", mytest prop_T_null),
413+ ("prop_TL_null", mytest prop_TL_null),
414+ ("prop_S_length", mytest prop_S_length),
415+ ("prop_T_length", mytest prop_T_length),
416+ ("prop_TL_length", mytest prop_TL_length),
417+
418+ ("prop_T_map", mytest prop_T_map),
419+ ("prop_TL_map", mytest prop_TL_map),
420+ ("prop_T_intercalate", mytest prop_T_intercalate),
421+ ("prop_TL_intercalate", mytest prop_TL_intercalate),
422+ ("prop_T_intersperse", mytest prop_T_intersperse),
423+ ("prop_TL_intersperse", mytest prop_TL_intersperse),
424+ ("prop_T_transpose", mytest prop_T_transpose),
425+ ("prop_TL_transpose", mytest prop_TL_transpose),
426+ ("prop_T_reverse", mytest prop_T_reverse),
427+ ("prop_TL_reverse", mytest prop_TL_reverse),
428+ ("prop_T_reverse_short", mytest prop_T_reverse_short),
429+
430+ ("prop_T_foldl", mytest prop_T_foldl),
431+ ("prop_TL_foldl", mytest prop_TL_foldl),
432+ ("prop_T_foldl'", mytest prop_T_foldl'),
433+ ("prop_TL_foldl'", mytest prop_TL_foldl'),
434+ ("prop_T_foldl1", mytest prop_T_foldl1),
435+ ("prop_TL_foldl1", mytest prop_TL_foldl1),
436+ ("prop_T_foldl1'", mytest prop_T_foldl1'),
437+ ("prop_TL_foldl1'", mytest prop_TL_foldl1'),
438+ ("prop_T_foldr", mytest prop_T_foldr),
439+ ("prop_TL_foldr", mytest prop_TL_foldr),
440+ ("prop_T_foldr1", mytest prop_T_foldr1),
441+ ("prop_TL_foldr1", mytest prop_TL_foldr1),
442+
443+ ("prop_T_concat", mytest prop_T_concat),
444+ ("prop_TL_concat", mytest prop_TL_concat),
445+ ("prop_T_concatMap", mytest prop_T_concatMap),
446+ ("prop_TL_concatMap", mytest prop_TL_concatMap),
447+ ("prop_T_any", mytest prop_T_any),
448+ ("prop_TL_any", mytest prop_TL_any),
449+ ("prop_T_all", mytest prop_T_all),
450+ ("prop_TL_all", mytest prop_TL_all),
451+ ("prop_T_maximum", mytest prop_T_maximum),
452+ ("prop_TL_maximum", mytest prop_TL_maximum),
453+ ("prop_T_minimum", mytest prop_T_minimum),
454+ ("prop_TL_minimum", mytest prop_TL_minimum),
455+
456+ ("prop_T_scanl", mytest prop_T_scanl),
457+ ("prop_TL_scanl", mytest prop_TL_scanl),
458+ ("prop_T_scanl1", mytest prop_T_scanl1),
459+ ("prop_TL_scanl1", mytest prop_TL_scanl1),
460+ ("prop_T_scanr", mytest prop_T_scanr),
461+ ("prop_TL_scanr", mytest prop_TL_scanr),
462+ ("prop_T_scanr1", mytest prop_T_scanr1),
463+ ("prop_TL_scanr1", mytest prop_TL_scanr1),
464+
465+ ("prop_T_mapAccumL", mytest prop_T_mapAccumL),
466+ ("prop_TL_mapAccumL", mytest prop_TL_mapAccumL),
467+ ("prop_T_mapAccumR", mytest prop_T_mapAccumR),
468+ ("prop_TL_mapAccumR", mytest prop_TL_mapAccumR),
469+
470+ ("prop_T_replicate", mytest prop_T_replicate),
471+ ("prop_TL_replicate", mytest prop_TL_replicate),
472+ ("prop_T_unfoldr", mytest prop_T_unfoldr),
473+ ("prop_TL_unfoldr", mytest prop_TL_unfoldr),
474+ ("prop_T_unfoldrN", mytest prop_T_unfoldrN),
475+ ("prop_TL_unfoldrN", mytest prop_TL_unfoldrN),
476+
477+ ("prop_S_take", mytest prop_S_take),
478+ ("prop_T_take", mytest prop_T_take),
479+ ("prop_TL_take", mytest prop_TL_take),
480+ ("prop_S_drop", mytest prop_S_drop),
481+ ("prop_T_drop", mytest prop_T_drop),
482+ ("prop_TL_drop", mytest prop_TL_drop),
483+ ("prop_S_takeWhile", mytest prop_S_takeWhile),
484+ ("prop_T_takeWhile", mytest prop_T_takeWhile),
485+ ("prop_TL_takeWhile", mytest prop_TL_takeWhile),
486+ ("prop_S_dropWhile", mytest prop_S_dropWhile),
487+ ("prop_T_dropWhile", mytest prop_T_dropWhile),
488+ ("prop_TL_dropWhile", mytest prop_TL_dropWhile),
489+ ("prop_T_splitAt", mytest prop_T_splitAt),
490+ ("prop_T_span", mytest prop_T_span),
491+ ("prop_TL_span", mytest prop_TL_span),
492+ ("prop_T_break", mytest prop_T_break),
493+ ("prop_TL_break", mytest prop_TL_break),
494+ ("prop_T_group", mytest prop_T_group),
495+ ("prop_TL_group", mytest prop_TL_group),
496+ ("prop_T_groupBy", mytest prop_T_groupBy),
497+ ("prop_TL_groupBy", mytest prop_TL_groupBy),
498+ ("prop_T_inits", mytest prop_T_inits),
499+ ("prop_TL_inits", mytest prop_TL_inits),
500+ ("prop_T_tails", mytest prop_T_tails),
501+ ("prop_TL_tails", mytest prop_TL_tails),
502+
503+ ("prop_T_split_i", mytest prop_T_split_i),
504+ ("prop_TL_split_i", mytest prop_TL_split_i),
505+ ("prop_T_splitWith", mytest prop_T_splitWith),
506+ ("prop_TL_splitWith", mytest prop_TL_splitWith),
507+ ("prop_T_breakSubstringC", mytest prop_T_breakSubstringC),
508+ ("prop_T_breakSubstring_isInfixOf", mytest prop_T_breakSubstring_isInfixOf),
509+
510+ ("prop_T_lines", mytest prop_T_lines),
511+ ("prop_TL_lines", mytest prop_TL_lines),
512+--("prop_T_lines'", mytest prop_T_lines'),
513+ ("prop_T_words", mytest prop_T_words),
514+ ("prop_TL_words", mytest prop_TL_words),
515+ ("prop_T_unlines", mytest prop_T_unlines),
516+ ("prop_TL_unlines", mytest prop_TL_unlines),
517+ ("prop_TL_unwords", mytest prop_TL_unwords),
518+
519+ ("prop_S_isPrefixOf", mytest prop_S_isPrefixOf),
520+ ("prop_T_isPrefixOf", mytest prop_T_isPrefixOf),
521+ ("prop_TL_isPrefixOf", mytest prop_TL_isPrefixOf),
522+ ("prop_T_isSuffixOf", mytest prop_T_isSuffixOf),
523+ ("prop_TL_isSuffixOf", mytest prop_TL_isSuffixOf),
524+ ("prop_T_isInfixOf", mytest prop_T_isInfixOf),
525+ ("prop_TL_isInfixOf", mytest prop_TL_isInfixOf),
526+
527+ ("prop_T_elem", mytest prop_T_elem),
528+ ("prop_TL_elem", mytest prop_TL_elem),
529+ ("prop_T_filter", mytest prop_T_filter),
530+ ("prop_TL_filter", mytest prop_TL_filter),
531+ ("prop_T_find", mytest prop_T_find),
532+ ("prop_TL_find", mytest prop_TL_find),
533+ ("prop_T_partition", mytest prop_T_partition),
534+ ("prop_TL_partition", mytest prop_TL_partition),
535+
536+ ("prop_T_index", mytest prop_T_index),
537+ ("prop_T_findIndex", mytest prop_T_findIndex),
538+ ("prop_TL_findIndex", mytest prop_TL_findIndex),
539+ ("prop_T_findIndices", mytest prop_T_findIndices),
540+ ("prop_TL_findIndices", mytest prop_TL_findIndices),
541+ ("prop_T_elemIndex", mytest prop_T_elemIndex),
542+ ("prop_TL_elemIndex", mytest prop_TL_elemIndex),
543+ ("prop_T_elemIndices", mytest prop_T_elemIndices),
544+ ("prop_TL_elemIndices", mytest prop_TL_elemIndices),
545+ ("prop_T_count", mytest prop_T_count),
546+ ("prop_TL_count", mytest prop_TL_count),
547+ ("prop_T_zip", mytest prop_T_zip),
548+ ("prop_TL_zip", mytest prop_TL_zip),
549+ ("prop_T_zipWith", mytest prop_T_zipWith),
550+ ("prop_TL_zipWith", mytest prop_TL_zipWith),
551+
552+ ("prop_S_filter_eq", mytest prop_S_filter_eq)
553+ ]
tests/QuickCheckUtils.hsnew file+129
@@ -0,0 +1,129 @@
1+{-# LANGUAGE FlexibleInstances #-}
2+
3+module QuickCheckUtils where
4+
5+import Data.List
6+import Data.Word
7+import qualified Data.Text as T
8+import qualified Data.Text.Lazy as TL
9+import System.IO
10+import System.Random
11+import Test.QuickCheck
12+import qualified Data.ByteString as B
13+
14+integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
15+integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
16+ fromIntegral b :: Integer) g of
17+ (x,g) -> (fromIntegral x, g)
18+
19+instance Random Word8 where
20+ randomR = integralRandomR
21+ random = randomR (minBound,maxBound)
22+
23+instance Arbitrary Word8 where
24+ arbitrary = choose (minBound,maxBound)
25+ coarbitrary c = variant (fromEnum c `rem` 4)
26+
27+instance Arbitrary B.ByteString where
28+ arbitrary = B.pack `fmap` arbitrary
29+ coarbitrary s = coarbitrary (B.unpack s)
30+
31+instance Random Word16 where
32+ randomR = integralRandomR
33+ random = randomR (minBound,maxBound)
34+
35+instance Arbitrary Word16 where
36+ arbitrary = choose (minBound,maxBound)
37+ coarbitrary c = variant (fromEnum c `rem` 4)
38+
39+instance Arbitrary Char where
40+ arbitrary = oneof [choose ('\0','\55295'), choose ('\57344','\1114111')]
41+ coarbitrary c = variant (fromEnum c `rem` 4)
42+
43+instance Arbitrary T.Text where
44+ arbitrary = T.pack `fmap` arbitrary
45+ coarbitrary s = coarbitrary (T.unpack s)
46+
47+instance Arbitrary TL.Text where
48+ arbitrary = TL.pack `fmap` arbitrary
49+ coarbitrary s = coarbitrary (TL.unpack s)
50+
51+newtype NotEmpty a = NotEmpty { notEmpty :: a }
52+ deriving (Eq, Ord, Show)
53+
54+instance Functor NotEmpty where
55+ fmap f (NotEmpty a) = NotEmpty (f a)
56+
57+instance Arbitrary a => Arbitrary (NotEmpty [a]) where
58+ arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))
59+ coarbitrary = coarbitrary . notEmpty
60+
61+instance Arbitrary (NotEmpty T.Text) where
62+ arbitrary = (fmap T.pack) `fmap` arbitrary
63+ coarbitrary = coarbitrary . notEmpty
64+
65+instance Arbitrary (NotEmpty TL.Text) where
66+ arbitrary = (fmap TL.pack) `fmap` arbitrary
67+ coarbitrary = coarbitrary . notEmpty
68+
69+instance Arbitrary (NotEmpty B.ByteString) where
70+ arbitrary = (fmap B.pack) `fmap` arbitrary
71+ coarbitrary = coarbitrary . notEmpty
72+
73+debug = False
74+
75+mytest :: Testable a => a -> Int -> IO (Bool, Int)
76+mytest a n = mycheck defaultConfig
77+ { configMaxTest=n
78+ , configEvery= \n args -> if debug then show n ++ ":\n" ++ unlines args else [] } a
79+
80+mycheck :: Testable a => Config -> a -> IO (Bool, Int)
81+mycheck config a =
82+ do rnd <- newStdGen
83+ mytests config (evaluate a) rnd 0 0 []
84+
85+mytests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO (Bool, Int)
86+mytests config gen rnd0 ntest nfail stamps
87+ | ntest == configMaxTest config = done "OK," ntest stamps >> return (True, ntest)
88+ | nfail == configMaxFail config = done "Arguments exhausted after" ntest stamps >> return (True, ntest)
89+ | otherwise =
90+ do putStr (configEvery config ntest (arguments result)) >> hFlush stdout
91+ case ok result of
92+ Nothing ->
93+ mytests config gen rnd1 ntest (nfail+1) stamps
94+ Just True ->
95+ mytests config gen rnd1 (ntest+1) nfail (stamp result:stamps)
96+ Just False ->
97+ putStr ( "Falsifiable after "
98+ ++ show ntest
99+ ++ " tests:\n"
100+ ++ unlines (arguments result)
101+ ) >> hFlush stdout >> return (False, ntest)
102+ where
103+ result = generate (configSize config ntest) rnd2 gen
104+ (rnd1,rnd2) = split rnd0
105+
106+done :: String -> Int -> [[String]] -> IO ()
107+done mesg ntest stamps =
108+ do putStr ( mesg ++ " " ++ show ntest ++ " tests" ++ table )
109+ where
110+ table = display
111+ . map entry
112+ . reverse
113+ . sort
114+ . map pairLength
115+ . group
116+ . sort
117+ . filter (not . null)
118+ $ stamps
119+
120+ display [] = ".\n"
121+ display [x] = " (" ++ x ++ ").\n"
122+ display xs = ".\n" ++ unlines (map (++ ".") xs)
123+
124+ pairLength xss@(xs:_) = (length xss, xs)
125+ entry (n, xs) = percentage n ntest
126+ ++ " "
127+ ++ concat (intersperse ", " xs)
128+
129+ percentage n m = show ((100 * n) `div` m) ++ "%"
tests/READMEnew file+2
@@ -0,0 +1,2 @@
1+You also need the test data from:
2+http://projects.haskell.org/text/text-testdata.tar.bz2
tests/Tests.hsdeleted−13
@@ -1,13 +0,0 @@
1−-- | Provides a simple main function which runs all the tests
2−--
3−module Main
4− ( main
5− ) where
6−
7−import Test.Framework (defaultMain)
8−
9−import qualified Tests.Properties as Properties
10−import qualified Tests.Regressions as Regressions
11−
12−main :: IO ()
13−main = defaultMain [Properties.tests, Regressions.tests]
tests/Tests/IO.hsdeleted−34
@@ -1,34 +0,0 @@
1−-- | Program which exposes some haskell functions as an exutable. The results
2−-- and coverage of this module is meant to be checked using a shell script.
3−--
4−module Main
5− (
6− main
7− ) where
8−
9−import System.Environment (getArgs)
10−import System.Exit (exitFailure)
11−import System.IO (hPutStrLn, stderr)
12−import qualified Data.Text as T
13−import qualified Data.Text.IO as T
14−import qualified Data.Text.Lazy as TL
15−import qualified Data.Text.Lazy.IO as TL
16−
17−main :: IO ()
18−main = do
19− args <- getArgs
20− case args of
21− ["T.readFile", name] -> T.putStr =<< T.readFile name
22− ["T.writeFile", name, t] -> T.writeFile name (T.pack t)
23− ["T.appendFile", name, t] -> T.appendFile name (T.pack t)
24− ["T.interact"] -> T.interact id
25− ["T.getContents"] -> T.putStr =<< T.getContents
26− ["T.getLine"] -> T.putStrLn =<< T.getLine
27−
28− ["TL.readFile", name] -> TL.putStr =<< TL.readFile name
29− ["TL.writeFile", name, t] -> TL.writeFile name (TL.pack t)
30− ["TL.appendFile", name, t] -> TL.appendFile name (TL.pack t)
31− ["TL.interact"] -> TL.interact id
32− ["TL.getContents"] -> TL.putStr =<< TL.getContents
33− ["TL.getLine"] -> TL.putStrLn =<< TL.getLine
34− _ -> hPutStrLn stderr "invalid directive!" >> exitFailure
tests/Tests/Properties.hsdeleted−1363
@@ -1,1363 +0,0 @@
1−-- | QuickCheck properties for the text library.
2−
3−{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
4− ScopedTypeVariables, TypeSynonymInstances #-}
5−{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}
6−module Tests.Properties
7− (
8− tests
9− ) where
10−
11−import Control.Applicative ((<$>), (<*>))
12−import Control.Arrow ((***), second)
13−import Data.Bits ((.&.))
14−import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
15−import Data.Int (Int8, Int16, Int32, Int64)
16−import Data.Monoid (Monoid(..))
17−import Data.String (IsString(fromString))
18−import Data.Text.Encoding.Error
19−import Data.Text.Foreign
20−import Data.Text.Internal.Encoding.Utf8
21−import Data.Text.Internal.Fusion.Size
22−import Data.Text.Internal.Search (indices)
23−import Data.Text.Lazy.Read as TL
24−import Data.Text.Read as T
25−import Data.Word (Word, Word8, Word16, Word32, Word64)
26−import Numeric (showEFloat, showFFloat, showGFloat, showHex)
27−import Prelude hiding (replicate)
28−import Test.Framework (Test, testGroup)
29−import 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
37−import qualified Data.Bits as Bits (shiftL, shiftR)
38−import qualified Data.ByteString as B
39−import qualified Data.ByteString.Lazy as BL
40−import qualified Data.List as L
41−import qualified Data.Text as T
42−import qualified Data.Text.Encoding as E
43−import 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
49−import qualified Data.Text.Lazy as TL
50−import qualified Data.Text.Lazy.Builder as TB
51−import qualified Data.Text.Lazy.Builder.Int as TB
52−import qualified Data.Text.Lazy.Builder.RealFloat as TB
53−import qualified Data.Text.Lazy.Encoding as EL
54−import qualified Data.Text.Lazy.IO as TL
55−import qualified System.IO as IO
56−import qualified Tests.Properties.Mul as Mul
57−import qualified Tests.SlowFunctions as Slow
58−
59−t_pack_unpack = (T.unpack . T.pack) `eq` id
60−tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
61−t_stream_unstream = (S.unstream . S.stream) `eq` id
62−tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
63−t_reverse_stream t = (S.reverse . S.reverseStream) t == t
64−t_singleton c = [c] == (T.unpack . T.singleton) c
65−tl_singleton c = [c] == (TL.unpack . TL.singleton) c
66−tl_unstreamChunks x = f 11 x == f 1000 x
67− where f n = SL.unstreamChunks n . S.streamList
68−tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
69−tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
70−
71−-- Note: this silently truncates code-points > 255 to 8-bit due to 'B.pack'
72−encodeL1 :: T.Text -> B.ByteString
73−encodeL1 = B.pack . map (fromIntegral . fromEnum) . T.unpack
74−encodeLazyL1 :: TL.Text -> BL.ByteString
75−encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
76−
77−t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a
78− where a = T.map (\c -> chr (ord c `mod` 128)) t
79−tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a
80− where a = TL.map (\c -> chr (ord c `mod` 128)) t
81−t_latin1 t = E.decodeLatin1 (encodeL1 a) == a
82− where a = T.map (\c -> chr (ord c `mod` 256)) t
83−tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) == a
84− where a = TL.map (\c -> chr (ord c `mod` 256)) t
85−t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
86−t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
87−tl_utf8 = forAll genUnicode $ (EL.decodeUtf8 . EL.encodeUtf8) `eq` id
88−tl_utf8' = forAll genUnicode $ (EL.decodeUtf8' . EL.encodeUtf8) `eq` (id . Right)
89−t_utf16LE = forAll genUnicode $ (E.decodeUtf16LE . E.encodeUtf16LE) `eq` id
90−tl_utf16LE = forAll genUnicode $ (EL.decodeUtf16LE . EL.encodeUtf16LE) `eq` id
91−t_utf16BE = forAll genUnicode $ (E.decodeUtf16BE . E.encodeUtf16BE) `eq` id
92−tl_utf16BE = forAll genUnicode $ (EL.decodeUtf16BE . EL.encodeUtf16BE) `eq` id
93−t_utf32LE = forAll genUnicode $ (E.decodeUtf32LE . E.encodeUtf32LE) `eq` id
94−tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id
95−t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
96−tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
97−
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
115−
116−data Badness = Solo | Leading | Trailing
117− deriving (Eq, Show)
118−
119−instance Arbitrary Badness where
120− arbitrary = elements [Solo, Leading, Trailing]
121−
122−t_utf8_err :: Badness -> DecodeErr -> Property
123−t_utf8_err bad de = do
124− let gen = case bad of
125− Solo -> genInvalidUTF8
126− Leading -> B.append <$> genInvalidUTF8 <*> genUTF8
127− Trailing -> B.append <$> genUTF8 <*> genInvalidUTF8
128− genUTF8 = E.encodeUtf8 <$> genUnicode
129− forAll gen $ \bs -> MkProperty $ do
130− onErr <- genDecodeErr de
131− unProperty . monadicIO $ do
132− l <- run $ let len = T.length (E.decodeUtf8With onErr bs)
133− in (len `seq` return (Right len)) `Exception.catch`
134− (\(e::UnicodeException) -> return (Left e))
135− assert $ case l of
136− Left err -> length (show err) >= 0
137− Right _ -> de /= Strict
138−
139−t_utf8_err' :: B.ByteString -> Property
140−t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of
141− Left err -> length (show err) >= 0
142− Right t -> T.length t >= 0
143−
144−genInvalidUTF8 :: Gen B.ByteString
145−genInvalidUTF8 = B.pack <$> oneof [
146− -- invalid leading byte of a 2-byte sequence
147− (:) <$> choose (0xC0, 0xC1) <*> upTo 1 contByte
148− -- invalid leading byte of a 4-byte sequence
149− , (:) <$> choose (0xF5, 0xFF) <*> upTo 3 contByte
150− -- 4-byte sequence greater than U+10FFFF
151− , do k <- choose (0x11, 0x13)
152− let w0 = 0xF0 + (k `Bits.shiftR` 2)
153− w1 = 0x80 + ((k .&. 3) `Bits.shiftL` 4)
154− ([w0,w1]++) <$> vectorOf 2 contByte
155− -- continuation bytes without a start byte
156− , listOf1 contByte
157− -- short 2-byte sequence
158− , (:[]) <$> choose (0xC2, 0xDF)
159− -- short 3-byte sequence
160− , (:) <$> choose (0xE0, 0xEF) <*> upTo 1 contByte
161− -- short 4-byte sequence
162− , (:) <$> choose (0xF0, 0xF4) <*> upTo 2 contByte
163− -- overlong encoding
164− , do k <- choose (0,0xFFFF)
165− let c = chr k
166− case k of
167− _ | k < 0x80 -> oneof [ let (w,x) = ord2 c in return [w,x]
168− , let (w,x,y) = ord3 c in return [w,x,y]
169− , let (w,x,y,z) = ord4 c in return [w,x,y,z] ]
170− | k < 0x7FF -> oneof [ let (w,x,y) = ord3 c in return [w,x,y]
171− , let (w,x,y,z) = ord4 c in return [w,x,y,z] ]
172− | otherwise -> let (w,x,y,z) = ord4 c in return [w,x,y,z]
173− ]
174− where
175− contByte = (0x80 +) <$> choose (0, 0x3f)
176− upTo n gen = do
177− k <- choose (0,n)
178− vectorOf k gen
179−
180−s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
181− where _types = s :: String
182−sf_Eq p s =
183− ((L.filter p s==) . L.filter p) `eq`
184− (((S.filter p $ S.streamList s)==) . S.filter p . S.streamList)
185−t_Eq s = (s==) `eq` ((T.pack s==) . T.pack)
186−tl_Eq s = (s==) `eq` ((TL.pack s==) . TL.pack)
187−s_Ord s = (compare s) `eq` (compare (S.streamList s) . S.streamList)
188− where _types = s :: String
189−sf_Ord p s =
190− ((compare $ L.filter p s) . L.filter p) `eq`
191− (compare (S.filter p $ S.streamList s) . S.filter p . S.streamList)
192−t_Ord s = (compare s) `eq` (compare (T.pack s) . T.pack)
193−tl_Ord s = (compare s) `eq` (compare (TL.pack s) . TL.pack)
194−t_Read = id `eq` (T.unpack . read . show)
195−tl_Read = id `eq` (TL.unpack . read . show)
196−t_Show = show `eq` (show . T.pack)
197−tl_Show = show `eq` (show . TL.pack)
198−t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))
199−tl_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)
204−t_mempty = mempty == (unpackS (mempty :: T.Text))
205−tl_mempty = mempty == (unpackS (mempty :: TL.Text))
206−t_IsString = fromString `eqP` (T.unpack . fromString)
207−tl_IsString = fromString `eqP` (TL.unpack . fromString)
208−
209−s_cons x = (x:) `eqP` (unpackS . S.cons x)
210−s_cons_s x = (x:) `eqP` (unpackS . S.unstream . S.cons x)
211−sf_cons p x = ((x:) . L.filter p) `eqP` (unpackS . S.cons x . S.filter p)
212−t_cons x = (x:) `eqP` (unpackS . T.cons x)
213−tl_cons x = (x:) `eqP` (unpackS . TL.cons x)
214−s_snoc x = (++ [x]) `eqP` (unpackS . (flip S.snoc) x)
215−t_snoc x = (++ [x]) `eqP` (unpackS . (flip T.snoc) x)
216−tl_snoc x = (++ [x]) `eqP` (unpackS . (flip TL.snoc) x)
217−s_append s = (s++) `eqP` (unpackS . S.append (S.streamList s))
218−s_append_s s = (s++) `eqP`
219− (unpackS . S.unstream . S.append (S.streamList s))
220−sf_append p s = (L.filter p s++) `eqP`
221− (unpackS . S.append (S.filter p $ S.streamList s))
222−t_append s = (s++) `eqP` (unpackS . T.append (packS s))
223−
224−uncons (x:xs) = Just (x,xs)
225−uncons _ = Nothing
226−
227−s_uncons = uncons `eqP` (fmap (second unpackS) . S.uncons)
228−sf_uncons p = (uncons . L.filter p) `eqP`
229− (fmap (second unpackS) . S.uncons . S.filter p)
230−t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
231−tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)
232−s_head = head `eqP` S.head
233−sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)
234−t_head = head `eqP` T.head
235−tl_head = head `eqP` TL.head
236−s_last = last `eqP` S.last
237−sf_last p = (last . L.filter p) `eqP` (S.last . S.filter p)
238−t_last = last `eqP` T.last
239−tl_last = last `eqP` TL.last
240−s_tail = tail `eqP` (unpackS . S.tail)
241−s_tail_s = tail `eqP` (unpackS . S.unstream . S.tail)
242−sf_tail p = (tail . L.filter p) `eqP` (unpackS . S.tail . S.filter p)
243−t_tail = tail `eqP` (unpackS . T.tail)
244−tl_tail = tail `eqP` (unpackS . TL.tail)
245−s_init = init `eqP` (unpackS . S.init)
246−s_init_s = init `eqP` (unpackS . S.unstream . S.init)
247−sf_init p = (init . L.filter p) `eqP` (unpackS . S.init . S.filter p)
248−t_init = init `eqP` (unpackS . T.init)
249−tl_init = init `eqP` (unpackS . TL.init)
250−s_null = null `eqP` S.null
251−sf_null p = (null . L.filter p) `eqP` (S.null . S.filter p)
252−t_null = null `eqP` T.null
253−tl_null = null `eqP` TL.null
254−s_length = length `eqP` S.length
255−sf_length p = (length . L.filter p) `eqP` (S.length . S.filter p)
256−sl_length = (fromIntegral . length) `eqP` SL.length
257−t_length = length `eqP` T.length
258−tl_length = L.genericLength `eqP` TL.length
259−t_compareLength t = (compare (T.length t)) `eq` T.compareLength t
260−tl_compareLength t= (compare (TL.length t)) `eq` TL.compareLength t
261−
262−s_map f = map f `eqP` (unpackS . S.map f)
263−s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)
264−sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)
265−t_map f = map f `eqP` (unpackS . T.map f)
266−tl_map f = map f `eqP` (unpackS . TL.map f)
267−s_intercalate c = unsquare $
268− L.intercalate c `eq`
269− (unpackS . S.intercalate (packS c) . map packS)
270−t_intercalate c = unsquare $
271− L.intercalate c `eq`
272− (unpackS . T.intercalate (packS c) . map packS)
273−tl_intercalate c = unsquare $
274− L.intercalate c `eq`
275− (unpackS . TL.intercalate (TL.pack c) . map TL.pack)
276−s_intersperse c = L.intersperse c `eqP`
277− (unpackS . S.intersperse c)
278−s_intersperse_s c = L.intersperse c `eqP`
279− (unpackS . S.unstream . S.intersperse c)
280−sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`
281− (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)
290−t_reverse = L.reverse `eqP` (unpackS . T.reverse)
291−tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)
292−t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)
293−
294−t_replace s d = (L.intercalate d . splitOn s) `eqP`
295− (unpackS . T.replace (T.pack s) (T.pack d))
296−tl_replace s d = (L.intercalate d . splitOn s) `eqP`
297− (unpackS . TL.replace (TL.pack s) (TL.pack d))
298−
299−splitOn :: (Eq a) => [a] -> [a] -> [[a]]
300−splitOn pat src0
301− | l == 0 = error "splitOn: empty"
302− | otherwise = go src0
303− where
304− l = length pat
305− go src = search 0 src
306− where
307− search _ [] = [src]
308− search !n s@(_:s')
309− | pat `L.isPrefixOf` s = take n src : go (drop l s)
310− | otherwise = search (n+1) s'
311−
312−s_toCaseFold_length xs = S.length (S.toCaseFold s) >= length xs
313− where s = S.streamList xs
314−sf_toCaseFold_length p xs =
315− (S.length . S.toCaseFold . S.filter p $ s) >= (length . L.filter p $ xs)
316− where s = S.streamList xs
317−t_toCaseFold_length t = T.length (T.toCaseFold t) >= T.length t
318−tl_toCaseFold_length t = TL.length (TL.toCaseFold t) >= TL.length t
319−t_toLower_length t = T.length (T.toLower t) >= T.length t
320−t_toLower_lower t = p (T.toLower t) >= p t
321− where p = T.length . T.filter isLower
322−tl_toLower_lower t = p (TL.toLower t) >= p t
323− where p = TL.length . TL.filter isLower
324−t_toUpper_length t = T.length (T.toUpper t) >= T.length t
325−t_toUpper_upper t = p (T.toUpper t) >= p t
326− where p = T.length . T.filter isUpper
327−tl_toUpper_upper t = p (TL.toUpper t) >= p t
328− where p = TL.length . TL.filter isUpper
329−
330−justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
331−justifyRight m n xs = L.replicate (m - length xs) n ++ xs
332−center k c xs
333− | len >= k = xs
334− | otherwise = L.replicate l c ++ xs ++ L.replicate r c
335− where len = length xs
336− d = k - len
337− r = d `div` 2
338− l = d - r
339−
340−s_justifyLeft k c = justifyLeft j c `eqP` (unpackS . S.justifyLeftI j c)
341− where j = fromIntegral (k :: Word8)
342−s_justifyLeft_s k c = justifyLeft j c `eqP`
343− (unpackS . S.unstream . S.justifyLeftI j c)
344− where j = fromIntegral (k :: Word8)
345−sf_justifyLeft p k c = (justifyLeft j c . L.filter p) `eqP`
346− (unpackS . S.justifyLeftI j c . S.filter p)
347− where j = fromIntegral (k :: Word8)
348−t_justifyLeft k c = justifyLeft j c `eqP` (unpackS . T.justifyLeft j c)
349− where j = fromIntegral (k :: Word8)
350−tl_justifyLeft k c = justifyLeft j c `eqP`
351− (unpackS . TL.justifyLeft (fromIntegral j) c)
352− where j = fromIntegral (k :: Word8)
353−t_justifyRight k c = justifyRight j c `eqP` (unpackS . T.justifyRight j c)
354− where j = fromIntegral (k :: Word8)
355−tl_justifyRight k c = justifyRight j c `eqP`
356− (unpackS . TL.justifyRight (fromIntegral j) c)
357− where j = fromIntegral (k :: Word8)
358−t_center k c = center j c `eqP` (unpackS . T.center j c)
359− where j = fromIntegral (k :: Word8)
360−tl_center k c = center j c `eqP` (unpackS . TL.center (fromIntegral j) c)
361− where j = fromIntegral (k :: Word8)
362−
363−sf_foldl p f z = (L.foldl f z . L.filter p) `eqP` (S.foldl f z . S.filter p)
364− where _types = f :: Char -> Char -> Char
365−t_foldl f z = L.foldl f z `eqP` (T.foldl f z)
366− where _types = f :: Char -> Char -> Char
367−tl_foldl f z = L.foldl f z `eqP` (TL.foldl f z)
368− where _types = f :: Char -> Char -> Char
369−sf_foldl' p f z = (L.foldl' f z . L.filter p) `eqP`
370− (S.foldl' f z . S.filter p)
371− where _types = f :: Char -> Char -> Char
372−t_foldl' f z = L.foldl' f z `eqP` T.foldl' f z
373− where _types = f :: Char -> Char -> Char
374−tl_foldl' f z = L.foldl' f z `eqP` TL.foldl' f z
375− where _types = f :: Char -> Char -> Char
376−sf_foldl1 p f = (L.foldl1 f . L.filter p) `eqP` (S.foldl1 f . S.filter p)
377−t_foldl1 f = L.foldl1 f `eqP` T.foldl1 f
378−tl_foldl1 f = L.foldl1 f `eqP` TL.foldl1 f
379−sf_foldl1' p f = (L.foldl1' f . L.filter p) `eqP` (S.foldl1' f . S.filter p)
380−t_foldl1' f = L.foldl1' f `eqP` T.foldl1' f
381−tl_foldl1' f = L.foldl1' f `eqP` TL.foldl1' f
382−sf_foldr p f z = (L.foldr f z . L.filter p) `eqP` (S.foldr f z . S.filter p)
383− where _types = f :: Char -> Char -> Char
384−t_foldr f z = L.foldr f z `eqP` T.foldr f z
385− where _types = f :: Char -> Char -> Char
386−tl_foldr f z = unsquare $
387− L.foldr f z `eqP` TL.foldr f z
388− 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)
391−t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f
392−tl_foldr1 f = unsquare $
393− L.foldr1 f `eqP` TL.foldr1 f
394−
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`
399− (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)
404−sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`
405− (unpackS . S.concatMap (packS . f) . S.filter p)
406−t_concatMap f = unsquare $
407− L.concatMap f `eqP` (unpackS . T.concatMap (packS . f))
408−tl_concatMap f = unsquare $
409− L.concatMap f `eqP` (unpackS . TL.concatMap (TL.pack . f))
410−sf_any q p = (L.any p . L.filter q) `eqP` (S.any p . S.filter q)
411−t_any p = L.any p `eqP` T.any p
412−tl_any p = L.any p `eqP` TL.any p
413−sf_all q p = (L.all p . L.filter q) `eqP` (S.all p . S.filter q)
414−t_all p = L.all p `eqP` T.all p
415−tl_all p = L.all p `eqP` TL.all p
416−sf_maximum p = (L.maximum . L.filter p) `eqP` (S.maximum . S.filter p)
417−t_maximum = L.maximum `eqP` T.maximum
418−tl_maximum = L.maximum `eqP` TL.maximum
419−sf_minimum p = (L.minimum . L.filter p) `eqP` (S.minimum . S.filter p)
420−t_minimum = L.minimum `eqP` T.minimum
421−tl_minimum = L.minimum `eqP` TL.minimum
422−
423−sf_scanl p f z = (L.scanl f z . L.filter p) `eqP`
424− (unpackS . S.scanl f z . S.filter p)
425−t_scanl f z = L.scanl f z `eqP` (unpackS . T.scanl f z)
426−tl_scanl f z = L.scanl f z `eqP` (unpackS . TL.scanl f z)
427−t_scanl1 f = L.scanl1 f `eqP` (unpackS . T.scanl1 f)
428−tl_scanl1 f = L.scanl1 f `eqP` (unpackS . TL.scanl1 f)
429−t_scanr f z = L.scanr f z `eqP` (unpackS . T.scanr f z)
430−tl_scanr f z = L.scanr f z `eqP` (unpackS . TL.scanr f z)
431−t_scanr1 f = L.scanr1 f `eqP` (unpackS . T.scanr1 f)
432−tl_scanr1 f = L.scanr1 f `eqP` (unpackS . TL.scanr1 f)
433−
434−t_mapAccumL f z = L.mapAccumL f z `eqP` (second unpackS . T.mapAccumL f z)
435− where _types = f :: Int -> Char -> (Int,Char)
436−tl_mapAccumL f z = L.mapAccumL f z `eqP` (second unpackS . TL.mapAccumL f z)
437− where _types = f :: Int -> Char -> (Int,Char)
438−t_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z)
439− where _types = f :: Int -> Char -> (Int,Char)
440−tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)
441− where _types = f :: Int -> Char -> (Int,Char)
442−
443−tl_repeat n = (L.take m . L.repeat) `eq`
444− (unpackS . TL.take (fromIntegral m) . TL.repeat)
445− where m = fromIntegral (n :: Word8)
446−
447−replicate n l = concat (L.replicate n l)
448−
449−s_replicate n = replicate m `eq`
450− (unpackS . S.replicateI (fromIntegral m) . packS)
451− where m = fromIntegral (n :: Word8)
452−t_replicate n = replicate m `eq` (unpackS . T.replicate m . packS)
453− where m = fromIntegral (n :: Word8)
454−tl_replicate n = replicate m `eq`
455− (unpackS . TL.replicate (fromIntegral m) . packS)
456− where m = fromIntegral (n :: Word8)
457−
458−tl_cycle n = (L.take m . L.cycle) `eq`
459− (unpackS . TL.take (fromIntegral m) . TL.cycle . packS)
460− where m = fromIntegral (n :: Word8)
461−
462−tl_iterate f n = (L.take m . L.iterate f) `eq`
463− (unpackS . TL.take (fromIntegral m) . TL.iterate f)
464− where m = fromIntegral (n :: Word8)
465−
466−unf :: Int -> Char -> Maybe (Char, Char)
467−unf n c | fromEnum c * 100 > n = Nothing
468− | otherwise = Just (c, succ c)
469−
470−t_unfoldr n = L.unfoldr (unf m) `eq` (unpackS . T.unfoldr (unf m))
471− where m = fromIntegral (n :: Word16)
472−tl_unfoldr n = L.unfoldr (unf m) `eq` (unpackS . TL.unfoldr (unf m))
473− where m = fromIntegral (n :: Word16)
474−t_unfoldrN n m = (L.take i . L.unfoldr (unf j)) `eq`
475− (unpackS . T.unfoldrN i (unf j))
476− where i = fromIntegral (n :: Word16)
477− j = fromIntegral (m :: Word16)
478−tl_unfoldrN n m = (L.take i . L.unfoldr (unf j)) `eq`
479− (unpackS . TL.unfoldrN (fromIntegral i) (unf j))
480− where i = fromIntegral (n :: Word16)
481− j = fromIntegral (m :: Word16)
482−
483−unpack2 :: (Stringy s) => (s,s) -> (String,String)
484−unpack2 = unpackS *** unpackS
485−
486−s_take n = L.take n `eqP` (unpackS . S.take n)
487−s_take_s m = L.take n `eqP` (unpackS . S.unstream . S.take n)
488− where n = small m
489−sf_take p n = (L.take n . L.filter p) `eqP`
490− (unpackS . S.take n . S.filter p)
491−t_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)
494−tl_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)
497−s_drop n = L.drop n `eqP` (unpackS . S.drop n)
498−s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)
499− where n = small m
500−sf_drop p n = (L.drop n . L.filter p) `eqP`
501− (unpackS . S.drop n . S.filter p)
502−t_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)
505−tl_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))
508−s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)
509− where n = small m
510−s_take_drop_s m = (L.take n . L.drop n) `eqP`
511− (unpackS . S.unstream . S.take n . S.drop n)
512− where n = small m
513−s_takeWhile p = L.takeWhile p `eqP` (unpackS . S.takeWhile p)
514−s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)
515−sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
516− (unpackS . S.takeWhile p . S.filter q)
517−t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
518−tl_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)
523−s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
524−s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
525−sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
526− (unpackS . S.dropWhile p . S.filter q)
527−t_dropWhile p = L.dropWhile p `eqP` (unpackS . T.dropWhile p)
528−tl_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
529−t_dropWhileEnd p = (L.reverse . L.dropWhile p . L.reverse) `eqP`
530− (unpackS . T.dropWhileEnd p)
531−tl_dropWhileEnd p = (L.reverse . L.dropWhile p . L.reverse) `eqP`
532− (unpackS . TL.dropWhileEnd p)
533−t_dropAround p = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse)
534− `eqP` (unpackS . T.dropAround p)
535−tl_dropAround p = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse)
536− `eqP` (unpackS . TL.dropAround p)
537−t_stripStart = T.dropWhile isSpace `eq` T.stripStart
538−tl_stripStart = TL.dropWhile isSpace `eq` TL.stripStart
539−t_stripEnd = T.dropWhileEnd isSpace `eq` T.stripEnd
540−tl_stripEnd = TL.dropWhileEnd isSpace `eq` TL.stripEnd
541−t_strip = T.dropAround isSpace `eq` T.strip
542−tl_strip = TL.dropAround isSpace `eq` TL.strip
543−t_splitAt n = L.splitAt n `eqP` (unpack2 . T.splitAt n)
544−tl_splitAt n = L.splitAt n `eqP` (unpack2 . TL.splitAt (fromIntegral n))
545−t_span p = L.span p `eqP` (unpack2 . T.span p)
546−tl_span p = L.span p `eqP` (unpack2 . TL.span p)
547−
548−t_breakOn_id s = squid `eq` (uncurry T.append . T.breakOn s)
549− where squid t | T.null s = error "empty"
550− | otherwise = t
551−tl_breakOn_id s = squid `eq` (uncurry TL.append . TL.breakOn s)
552− where squid t | TL.null s = error "empty"
553− | otherwise = t
554−t_breakOn_start (NotEmpty s) t =
555− let (k,m) = T.breakOn s t
556− in k `T.isPrefixOf` t && (T.null m || s `T.isPrefixOf` m)
557−tl_breakOn_start (NotEmpty s) t =
558− let (k,m) = TL.breakOn s t
559− in k `TL.isPrefixOf` t && TL.null m || s `TL.isPrefixOf` m
560−t_breakOnEnd_end (NotEmpty s) t =
561− let (m,k) = T.breakOnEnd s t
562− in k `T.isSuffixOf` t && (T.null m || s `T.isSuffixOf` m)
563−tl_breakOnEnd_end (NotEmpty s) t =
564− let (m,k) = TL.breakOnEnd s t
565− in k `TL.isSuffixOf` t && (TL.null m || s `TL.isSuffixOf` m)
566−t_break p = L.break p `eqP` (unpack2 . T.break p)
567−tl_break p = L.break p `eqP` (unpack2 . TL.break p)
568−t_group = L.group `eqP` (map unpackS . T.group)
569−tl_group = L.group `eqP` (map unpackS . TL.group)
570−t_groupBy p = L.groupBy p `eqP` (map unpackS . T.groupBy p)
571−tl_groupBy p = L.groupBy p `eqP` (map unpackS . TL.groupBy p)
572−t_inits = L.inits `eqP` (map unpackS . T.inits)
573−tl_inits = L.inits `eqP` (map unpackS . TL.inits)
574−t_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 ->
578− let t = T.intercalate s ts
579− in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)
580−tl_findAppendId = unsquare $ \(NotEmpty s) ts ->
581− let t = TL.intercalate s ts
582− 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) .
586− TL.breakOnAll s . TL.intercalate s
587−sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c
588−t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s
589−tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s
590−
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
596−t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)
597−tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)
598−
599−t_split p = split p `eqP` (map unpackS . T.split p)
600−t_split_count c = (L.length . T.split (==c)) `eq`
601− ((1+) . T.count (T.singleton c))
602−t_split_splitOn c = T.split (==c) `eq` T.splitOn (T.singleton c)
603−tl_split p = split p `eqP` (map unpackS . TL.split p)
604−
605−split :: (a -> Bool) -> [a] -> [[a]]
606−split _ [] = [[]]
607−split p xs = loop xs
608− where loop s | null s' = [l]
609− | otherwise = l : loop (tail s')
610− where (l, s') = break p s
611−
612−t_chunksOf_same_lengths k = all ((==k) . T.length) . ini . T.chunksOf k
613− where ini [] = []
614− ini xs = init xs
615−
616−t_chunksOf_length k t = len == T.length t || (k <= 0 && len == 0)
617− where len = L.sum . L.map T.length $ T.chunksOf k t
618−
619−tl_chunksOf k = T.chunksOf k `eq` (map (T.concat . TL.toChunks) .
620− TL.chunksOf (fromIntegral k) . TL.fromStrict)
621−
622−t_lines = L.lines `eqP` (map unpackS . T.lines)
623−tl_lines = L.lines `eqP` (map unpackS . TL.lines)
624−{-
625−t_lines' = lines' `eqP` (map unpackS . T.lines')
626− where lines' "" = []
627− lines' s = let (l, s') = break eol s
628− in l : case s' of
629− [] -> []
630− ('\r':'\n':s'') -> lines' s''
631− (_:s'') -> lines' s''
632− eol c = c == '\r' || c == '\n'
633−-}
634−t_words = L.words `eqP` (map unpackS . T.words)
635−
636−tl_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)
645−
646−s_isPrefixOf s = L.isPrefixOf s `eqP`
647− (S.isPrefixOf (S.stream $ packS s) . S.stream)
648−sf_isPrefixOf p s = (L.isPrefixOf s . L.filter p) `eqP`
649− (S.isPrefixOf (S.stream $ packS s) . S.filter p . S.stream)
650−t_isPrefixOf s = L.isPrefixOf s`eqP` T.isPrefixOf (packS s)
651−tl_isPrefixOf s = L.isPrefixOf s`eqP` TL.isPrefixOf (packS s)
652−t_isSuffixOf s = L.isSuffixOf s`eqP` T.isSuffixOf (packS s)
653−tl_isSuffixOf s = L.isSuffixOf s`eqP` TL.isSuffixOf (packS s)
654−t_isInfixOf s = L.isInfixOf s `eqP` T.isInfixOf (packS s)
655−tl_isInfixOf s = L.isInfixOf s `eqP` TL.isInfixOf (packS s)
656−
657−t_stripPrefix s = (fmap packS . L.stripPrefix s) `eqP` T.stripPrefix (packS s)
658−tl_stripPrefix s = (fmap packS . L.stripPrefix s) `eqP` TL.stripPrefix (packS s)
659−
660−stripSuffix p t = reverse `fmap` L.stripPrefix (reverse p) (reverse t)
661−
662−t_stripSuffix s = (fmap packS . stripSuffix s) `eqP` T.stripSuffix (packS s)
663−tl_stripSuffix s = (fmap packS . stripSuffix s) `eqP` TL.stripSuffix (packS s)
664−
665−commonPrefixes a0@(_:_) b0@(_:_) = Just (go a0 b0 [])
666− where go (a:as) (b:bs) ps
667− | a == b = go as bs (a:ps)
668− go as bs ps = (reverse ps,as,bs)
669−commonPrefixes _ _ = Nothing
670−
671−t_commonPrefixes a b (NonEmpty p)
672− = commonPrefixes pa pb ==
673− repack `fmap` T.commonPrefixes (packS pa) (packS pb)
674− where repack (x,y,z) = (unpackS x,unpackS y,unpackS z)
675− pa = p ++ a
676− pb = p ++ b
677−
678−tl_commonPrefixes a b (NonEmpty p)
679− = commonPrefixes pa pb ==
680− repack `fmap` TL.commonPrefixes (packS pa) (packS pb)
681− where repack (x,y,z) = (unpackS x,unpackS y,unpackS z)
682− pa = p ++ a
683− pb = p ++ b
684−
685−sf_elem p c = (L.elem c . L.filter p) `eqP` (S.elem c . S.filter p)
686−sf_filter q p = (L.filter p . L.filter q) `eqP`
687− (unpackS . S.filter p . S.filter q)
688−t_filter p = L.filter p `eqP` (unpackS . T.filter p)
689−tl_filter p = L.filter p `eqP` (unpackS . TL.filter p)
690−sf_findBy q p = (L.find p . L.filter q) `eqP` (S.findBy p . S.filter q)
691−t_find p = L.find p `eqP` T.find p
692−tl_find p = L.find p `eqP` TL.find p
693−t_partition p = L.partition p `eqP` (unpack2 . T.partition p)
694−tl_partition p = L.partition p `eqP` (unpack2 . TL.partition p)
695−
696−sf_index p s = forAll (choose (-l,l*2))
697− ((L.filter p s L.!!) `eq` S.index (S.filter p $ packS s))
698− where l = L.length s
699−t_index s = forAll (choose (-l,l*2)) ((s L.!!) `eq` T.index (packS s))
700− where l = L.length s
701−
702−tl_index s = forAll (choose (-l,l*2))
703− ((s L.!!) `eq` (TL.index (packS s) . fromIntegral))
704− where l = L.length s
705−
706−t_findIndex p = L.findIndex p `eqP` T.findIndex p
707−t_count (NotEmpty t) = (subtract 1 . L.length . T.splitOn t) `eq` T.count t
708−tl_count (NotEmpty t) = (subtract 1 . L.genericLength . TL.splitOn t) `eq`
709− TL.count t
710−t_zip s = L.zip s `eqP` T.zip (packS s)
711−tl_zip s = L.zip s `eqP` TL.zip (packS s)
712−sf_zipWith p c s = (L.zipWith c (L.filter p s) . L.filter p) `eqP`
713− (unpackS . S.zipWith c (S.filter p $ packS s) . S.filter p)
714−t_zipWith c s = L.zipWith c s `eqP` (unpackS . T.zipWith c (packS s))
715−tl_zipWith c s = L.zipWith c s `eqP` (unpackS . TL.zipWith c (packS s))
716−
717−t_indices (NotEmpty s) = Slow.indices s `eq` indices s
718−tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
719− where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)
720− 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
724−
725−-- Bit shifts.
726−shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
727− where width = round (log (fromIntegral m) / log 2 :: Double)
728− (m,_) = (maxBound, m == w)
729−shiftR w = forAll (choose (0,width-1)) $ \k -> Bits.shiftR w k == U.shiftR w k
730− where width = round (log (fromIntegral m) / log 2 :: Double)
731− (m,_) = (maxBound, m == w)
732−
733−shiftL_Int = shiftL :: Int -> Property
734−shiftL_Word16 = shiftL :: Word16 -> Property
735−shiftL_Word32 = shiftL :: Word32 -> Property
736−shiftR_Int = shiftR :: Int -> Property
737−shiftR_Word16 = shiftR :: Word16 -> Property
738−shiftR_Word32 = shiftR :: Word32 -> Property
739−
740−-- Builder.
741−
742−tb_singleton = id `eqP`
743− (unpackS . TB.toLazyText . mconcat . map TB.singleton)
744−tb_fromText = L.concat `eq` (unpackS . TB.toLazyText . mconcat .
745− map (TB.fromText . packS))
746−tb_associative s1 s2 s3 =
747− TB.toLazyText (b1 `mappend` (b2 `mappend` b3)) ==
748− TB.toLazyText ((b1 `mappend` b2) `mappend` b3)
749− where b1 = TB.fromText (packS s1)
750− b2 = TB.fromText (packS s2)
751− b3 = TB.fromText (packS s3)
752−
753−-- Numeric builder stuff.
754−
755−tb_decimal :: (Integral a, Show a) => a -> Bool
756−tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)
757−
758−tb_decimal_integer (a::Integer) = tb_decimal a
759−tb_decimal_integer_big (Big a) = tb_decimal a
760−tb_decimal_int (a::Int) = tb_decimal a
761−tb_decimal_int8 (a::Int8) = tb_decimal a
762−tb_decimal_int16 (a::Int16) = tb_decimal a
763−tb_decimal_int32 (a::Int32) = tb_decimal a
764−tb_decimal_int64 (a::Int64) = tb_decimal a
765−tb_decimal_word (a::Word) = tb_decimal a
766−tb_decimal_word8 (a::Word8) = tb_decimal a
767−tb_decimal_word16 (a::Word16) = tb_decimal a
768−tb_decimal_word32 (a::Word32) = tb_decimal a
769−tb_decimal_word64 (a::Word64) = tb_decimal a
770−
771−tb_decimal_big_int (BigBounded (a::Int)) = tb_decimal a
772−tb_decimal_big_int64 (BigBounded (a::Int64)) = tb_decimal a
773−tb_decimal_big_word (BigBounded (a::Word)) = tb_decimal a
774−tb_decimal_big_word64 (BigBounded (a::Word64)) = tb_decimal a
775−
776−tb_hex :: (Integral a, Show a) => a -> Bool
777−tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")
778−
779−tb_hexadecimal_integer (a::Integer) = tb_hex a
780−tb_hexadecimal_int (a::Int) = tb_hex a
781−tb_hexadecimal_int8 (a::Int8) = tb_hex a
782−tb_hexadecimal_int16 (a::Int16) = tb_hex a
783−tb_hexadecimal_int32 (a::Int32) = tb_hex a
784−tb_hexadecimal_int64 (a::Int64) = tb_hex a
785−tb_hexadecimal_word (a::Word) = tb_hex a
786−tb_hexadecimal_word8 (a::Word8) = tb_hex a
787−tb_hexadecimal_word16 (a::Word16) = tb_hex a
788−tb_hexadecimal_word32 (a::Word32) = tb_hex a
789−tb_hexadecimal_word64 (a::Word64) = tb_hex a
790−
791−tb_realfloat :: (RealFloat a, Show a) => a -> Bool
792−tb_realfloat = (TB.toLazyText . TB.realFloat) `eq` (TL.pack . show)
793−
794−tb_realfloat_float (a::Float) = tb_realfloat a
795−tb_realfloat_double (a::Double) = tb_realfloat a
796−
797−showFloat :: (RealFloat a) => TB.FPFormat -> Maybe Int -> a -> ShowS
798−showFloat TB.Exponent = showEFloat
799−showFloat TB.Fixed = showFFloat
800−showFloat TB.Generic = showGFloat
801−
802−tb_formatRealFloat :: (RealFloat a, Show a) =>
803− a -> TB.FPFormat -> Precision a -> Property
804−tb_formatRealFloat a fmt prec =
805− TB.formatRealFloat fmt p a ===
806− TB.fromString (showFloat fmt p a "")
807− where p = precision a prec
808−
809−tb_formatRealFloat_float (a::Float) = tb_formatRealFloat a
810−tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a
811−
812−-- Reading.
813−
814−t_decimal (n::Int) s =
815− T.signed T.decimal (T.pack (show n) `T.append` t) == Right (n,t)
816− where t = T.dropWhile isDigit s
817−tl_decimal (n::Int) s =
818− TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
819− where t = TL.dropWhile isDigit s
820−t_hexadecimal m s ox =
821− T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
822− where t = T.dropWhile isHexDigit s
823− p = if ox then "0x" else ""
824− n = getPositive m :: Int
825−tl_hexadecimal m s ox =
826− TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
827− where t = TL.dropWhile isHexDigit s
828− p = if ox then "0x" else ""
829− n = getPositive m :: Int
830−
831−isFloaty c = c `elem` ("+-.0123456789eE" :: String)
832−
833−t_read_rational p tol (n::Double) s =
834− case p (T.pack (show n) `T.append` t) of
835− Left _err -> False
836− Right (n',t') -> t == t' && abs (n-n') <= tol
837− where t = T.dropWhile isFloaty s
838−
839−tl_read_rational p tol (n::Double) s =
840− case p (TL.pack (show n) `TL.append` t) of
841− Left _err -> False
842− Right (n',t') -> t == t' && abs (n-n') <= tol
843− where t = TL.dropWhile isFloaty s
844−
845−t_double = t_read_rational T.double 1e-13
846−tl_double = tl_read_rational TL.double 1e-13
847−t_rational = t_read_rational T.rational 1e-16
848−tl_rational = tl_read_rational TL.rational 1e-16
849−
850−-- Input and output.
851−
852−t_put_get = write_read T.unlines T.filter put get
853− where put h = withRedirect h IO.stdout . T.putStr
854− get h = withRedirect h IO.stdin T.getContents
855−tl_put_get = write_read TL.unlines TL.filter put get
856− where put h = withRedirect h IO.stdout . TL.putStr
857− get h = withRedirect h IO.stdin TL.getContents
858−t_write_read = write_read T.unlines T.filter T.hPutStr T.hGetContents
859−tl_write_read = write_read TL.unlines TL.filter TL.hPutStr TL.hGetContents
860−
861−t_write_read_line e m b t = write_read head T.filter T.hPutStrLn
862− T.hGetLine e m b [t]
863−tl_write_read_line e m b t = write_read head TL.filter TL.hPutStrLn
864− TL.hGetLine e m b [t]
865−
866−-- Low-level.
867−
868−t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
869−t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
870−t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) == t
871− where n = small m
872−t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
873−
874−t_copy t = T.copy t == t
875−
876−-- Regression tests.
877−s_filter_eq s = S.filter p t == S.streamList (filter p s)
878− where p = (/= S.last t)
879− t = S.streamList s
880−
881−-- Make a stream appear shorter than it really is, to ensure that
882−-- functions that consume inaccurately sized streams behave
883−-- themselves.
884−shorten :: Int -> S.Stream a -> S.Stream a
885−shorten n t@(S.Stream arr off len)
886− | n > 0 = S.Stream arr off (smaller (exactSize n) len)
887− | otherwise = t
888−
889−tests :: Test
890−tests =
891− testGroup "Properties" [
892− testGroup "creation/elimination" [
893− testProperty "t_pack_unpack" t_pack_unpack,
894− testProperty "tl_pack_unpack" tl_pack_unpack,
895− testProperty "t_stream_unstream" t_stream_unstream,
896− testProperty "tl_stream_unstream" tl_stream_unstream,
897− testProperty "t_reverse_stream" t_reverse_stream,
898− testProperty "t_singleton" t_singleton,
899− testProperty "tl_singleton" tl_singleton,
900− testProperty "tl_unstreamChunks" tl_unstreamChunks,
901− testProperty "tl_chunk_unchunk" tl_chunk_unchunk,
902− testProperty "tl_from_to_strict" tl_from_to_strict
903− ],
904−
905− testGroup "transcoding" [
906− testProperty "t_ascii" t_ascii,
907− testProperty "tl_ascii" tl_ascii,
908− testProperty "t_latin1" t_latin1,
909− testProperty "tl_latin1" tl_latin1,
910− testProperty "t_utf8" t_utf8,
911− testProperty "t_utf8'" t_utf8',
912− testProperty "t_utf8_incr" t_utf8_incr,
913− testProperty "t_utf8_undecoded" t_utf8_undecoded,
914− testProperty "tl_utf8" tl_utf8,
915− testProperty "tl_utf8'" tl_utf8',
916− testProperty "t_utf16LE" t_utf16LE,
917− testProperty "tl_utf16LE" tl_utf16LE,
918− testProperty "t_utf16BE" t_utf16BE,
919− testProperty "tl_utf16BE" tl_utf16BE,
920− testProperty "t_utf32LE" t_utf32LE,
921− testProperty "tl_utf32LE" tl_utf32LE,
922− testProperty "t_utf32BE" t_utf32BE,
923− testProperty "tl_utf32BE" tl_utf32BE,
924− testGroup "errors" [
925− testProperty "t_utf8_err" t_utf8_err,
926− testProperty "t_utf8_err'" t_utf8_err'
927− ]
928− ],
929−
930− testGroup "instances" [
931− testProperty "s_Eq" s_Eq,
932− testProperty "sf_Eq" sf_Eq,
933− testProperty "t_Eq" t_Eq,
934− testProperty "tl_Eq" tl_Eq,
935− testProperty "s_Ord" s_Ord,
936− testProperty "sf_Ord" sf_Ord,
937− testProperty "t_Ord" t_Ord,
938− testProperty "tl_Ord" tl_Ord,
939− testProperty "t_Read" t_Read,
940− testProperty "tl_Read" tl_Read,
941− testProperty "t_Show" t_Show,
942− testProperty "tl_Show" tl_Show,
943− testProperty "t_mappend" t_mappend,
944− testProperty "tl_mappend" tl_mappend,
945− testProperty "t_mconcat" t_mconcat,
946− testProperty "tl_mconcat" tl_mconcat,
947− testProperty "t_mempty" t_mempty,
948− testProperty "tl_mempty" tl_mempty,
949− testProperty "t_IsString" t_IsString,
950− testProperty "tl_IsString" tl_IsString
951− ],
952−
953− testGroup "basics" [
954− testProperty "s_cons" s_cons,
955− testProperty "s_cons_s" s_cons_s,
956− testProperty "sf_cons" sf_cons,
957− testProperty "t_cons" t_cons,
958− testProperty "tl_cons" tl_cons,
959− testProperty "s_snoc" s_snoc,
960− testProperty "t_snoc" t_snoc,
961− testProperty "tl_snoc" tl_snoc,
962− testProperty "s_append" s_append,
963− testProperty "s_append_s" s_append_s,
964− testProperty "sf_append" sf_append,
965− testProperty "t_append" t_append,
966− testProperty "s_uncons" s_uncons,
967− testProperty "sf_uncons" sf_uncons,
968− testProperty "t_uncons" t_uncons,
969− testProperty "tl_uncons" tl_uncons,
970− testProperty "s_head" s_head,
971− testProperty "sf_head" sf_head,
972− testProperty "t_head" t_head,
973− testProperty "tl_head" tl_head,
974− testProperty "s_last" s_last,
975− testProperty "sf_last" sf_last,
976− testProperty "t_last" t_last,
977− testProperty "tl_last" tl_last,
978− testProperty "s_tail" s_tail,
979− testProperty "s_tail_s" s_tail_s,
980− testProperty "sf_tail" sf_tail,
981− testProperty "t_tail" t_tail,
982− testProperty "tl_tail" tl_tail,
983− testProperty "s_init" s_init,
984− testProperty "s_init_s" s_init_s,
985− testProperty "sf_init" sf_init,
986− testProperty "t_init" t_init,
987− testProperty "tl_init" tl_init,
988− testProperty "s_null" s_null,
989− testProperty "sf_null" sf_null,
990− testProperty "t_null" t_null,
991− testProperty "tl_null" tl_null,
992− testProperty "s_length" s_length,
993− testProperty "sf_length" sf_length,
994− testProperty "sl_length" sl_length,
995− testProperty "t_length" t_length,
996− testProperty "tl_length" tl_length,
997− testProperty "t_compareLength" t_compareLength,
998− testProperty "tl_compareLength" tl_compareLength
999− ],
1000−
1001− testGroup "transformations" [
1002− testProperty "s_map" s_map,
1003− testProperty "s_map_s" s_map_s,
1004− testProperty "sf_map" sf_map,
1005− testProperty "t_map" t_map,
1006− testProperty "tl_map" tl_map,
1007− testProperty "s_intercalate" s_intercalate,
1008− testProperty "t_intercalate" t_intercalate,
1009− testProperty "tl_intercalate" tl_intercalate,
1010− testProperty "s_intersperse" s_intersperse,
1011− testProperty "s_intersperse_s" s_intersperse_s,
1012− testProperty "sf_intersperse" sf_intersperse,
1013− testProperty "t_intersperse" t_intersperse,
1014− testProperty "tl_intersperse" tl_intersperse,
1015− testProperty "t_transpose" t_transpose,
1016− testProperty "tl_transpose" tl_transpose,
1017− testProperty "t_reverse" t_reverse,
1018− testProperty "tl_reverse" tl_reverse,
1019− testProperty "t_reverse_short" t_reverse_short,
1020− testProperty "t_replace" t_replace,
1021− testProperty "tl_replace" tl_replace,
1022−
1023− testGroup "case conversion" [
1024− testProperty "s_toCaseFold_length" s_toCaseFold_length,
1025− testProperty "sf_toCaseFold_length" sf_toCaseFold_length,
1026− testProperty "t_toCaseFold_length" t_toCaseFold_length,
1027− testProperty "tl_toCaseFold_length" tl_toCaseFold_length,
1028− testProperty "t_toLower_length" t_toLower_length,
1029− testProperty "t_toLower_lower" t_toLower_lower,
1030− testProperty "tl_toLower_lower" tl_toLower_lower,
1031− testProperty "t_toUpper_length" t_toUpper_length,
1032− testProperty "t_toUpper_upper" t_toUpper_upper,
1033− testProperty "tl_toUpper_upper" tl_toUpper_upper
1034− ],
1035−
1036− testGroup "justification" [
1037− testProperty "s_justifyLeft" s_justifyLeft,
1038− testProperty "s_justifyLeft_s" s_justifyLeft_s,
1039− testProperty "sf_justifyLeft" sf_justifyLeft,
1040− testProperty "t_justifyLeft" t_justifyLeft,
1041− testProperty "tl_justifyLeft" tl_justifyLeft,
1042− testProperty "t_justifyRight" t_justifyRight,
1043− testProperty "tl_justifyRight" tl_justifyRight,
1044− testProperty "t_center" t_center,
1045− testProperty "tl_center" tl_center
1046− ]
1047− ],
1048−
1049− testGroup "folds" [
1050− testProperty "sf_foldl" sf_foldl,
1051− testProperty "t_foldl" t_foldl,
1052− testProperty "tl_foldl" tl_foldl,
1053− testProperty "sf_foldl'" sf_foldl',
1054− testProperty "t_foldl'" t_foldl',
1055− testProperty "tl_foldl'" tl_foldl',
1056− testProperty "sf_foldl1" sf_foldl1,
1057− testProperty "t_foldl1" t_foldl1,
1058− testProperty "tl_foldl1" tl_foldl1,
1059− testProperty "t_foldl1'" t_foldl1',
1060− testProperty "sf_foldl1'" sf_foldl1',
1061− testProperty "tl_foldl1'" tl_foldl1',
1062− testProperty "sf_foldr" sf_foldr,
1063− testProperty "t_foldr" t_foldr,
1064− testProperty "tl_foldr" tl_foldr,
1065− testProperty "sf_foldr1" sf_foldr1,
1066− testProperty "t_foldr1" t_foldr1,
1067− testProperty "tl_foldr1" tl_foldr1,
1068−
1069− testGroup "special" [
1070− testProperty "s_concat_s" s_concat_s,
1071− testProperty "sf_concat" sf_concat,
1072− testProperty "t_concat" t_concat,
1073− testProperty "tl_concat" tl_concat,
1074− testProperty "sf_concatMap" sf_concatMap,
1075− testProperty "t_concatMap" t_concatMap,
1076− testProperty "tl_concatMap" tl_concatMap,
1077− testProperty "sf_any" sf_any,
1078− testProperty "t_any" t_any,
1079− testProperty "tl_any" tl_any,
1080− testProperty "sf_all" sf_all,
1081− testProperty "t_all" t_all,
1082− testProperty "tl_all" tl_all,
1083− testProperty "sf_maximum" sf_maximum,
1084− testProperty "t_maximum" t_maximum,
1085− testProperty "tl_maximum" tl_maximum,
1086− testProperty "sf_minimum" sf_minimum,
1087− testProperty "t_minimum" t_minimum,
1088− testProperty "tl_minimum" tl_minimum
1089− ]
1090− ],
1091−
1092− testGroup "construction" [
1093− testGroup "scans" [
1094− testProperty "sf_scanl" sf_scanl,
1095− testProperty "t_scanl" t_scanl,
1096− testProperty "tl_scanl" tl_scanl,
1097− testProperty "t_scanl1" t_scanl1,
1098− testProperty "tl_scanl1" tl_scanl1,
1099− testProperty "t_scanr" t_scanr,
1100− testProperty "tl_scanr" tl_scanr,
1101− testProperty "t_scanr1" t_scanr1,
1102− testProperty "tl_scanr1" tl_scanr1
1103− ],
1104−
1105− testGroup "mapAccum" [
1106− testProperty "t_mapAccumL" t_mapAccumL,
1107− testProperty "tl_mapAccumL" tl_mapAccumL,
1108− testProperty "t_mapAccumR" t_mapAccumR,
1109− testProperty "tl_mapAccumR" tl_mapAccumR
1110− ],
1111−
1112− testGroup "unfolds" [
1113− testProperty "tl_repeat" tl_repeat,
1114− testProperty "s_replicate" s_replicate,
1115− testProperty "t_replicate" t_replicate,
1116− testProperty "tl_replicate" tl_replicate,
1117− testProperty "tl_cycle" tl_cycle,
1118− testProperty "tl_iterate" tl_iterate,
1119− testProperty "t_unfoldr" t_unfoldr,
1120− testProperty "tl_unfoldr" tl_unfoldr,
1121− testProperty "t_unfoldrN" t_unfoldrN,
1122− testProperty "tl_unfoldrN" tl_unfoldrN
1123− ]
1124− ],
1125−
1126− testGroup "substrings" [
1127− testGroup "breaking" [
1128− testProperty "s_take" s_take,
1129− testProperty "s_take_s" s_take_s,
1130− testProperty "sf_take" sf_take,
1131− testProperty "t_take" t_take,
1132− testProperty "t_takeEnd" t_takeEnd,
1133− testProperty "tl_take" tl_take,
1134− testProperty "tl_takeEnd" tl_takeEnd,
1135− testProperty "s_drop" s_drop,
1136− testProperty "s_drop_s" s_drop_s,
1137− testProperty "sf_drop" sf_drop,
1138− testProperty "t_drop" t_drop,
1139− testProperty "t_dropEnd" t_dropEnd,
1140− testProperty "tl_drop" tl_drop,
1141− testProperty "tl_dropEnd" tl_dropEnd,
1142− testProperty "s_take_drop" s_take_drop,
1143− testProperty "s_take_drop_s" s_take_drop_s,
1144− testProperty "s_takeWhile" s_takeWhile,
1145− testProperty "s_takeWhile_s" s_takeWhile_s,
1146− testProperty "sf_takeWhile" sf_takeWhile,
1147− testProperty "t_takeWhile" t_takeWhile,
1148− testProperty "tl_takeWhile" tl_takeWhile,
1149− testProperty "t_takeWhileEnd" t_takeWhileEnd,
1150− testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1151− testProperty "sf_dropWhile" sf_dropWhile,
1152− testProperty "s_dropWhile" s_dropWhile,
1153− testProperty "s_dropWhile_s" s_dropWhile_s,
1154− testProperty "t_dropWhile" t_dropWhile,
1155− testProperty "tl_dropWhile" tl_dropWhile,
1156− testProperty "t_dropWhileEnd" t_dropWhileEnd,
1157− testProperty "tl_dropWhileEnd" tl_dropWhileEnd,
1158− testProperty "t_dropAround" t_dropAround,
1159− testProperty "tl_dropAround" tl_dropAround,
1160− testProperty "t_stripStart" t_stripStart,
1161− testProperty "tl_stripStart" tl_stripStart,
1162− testProperty "t_stripEnd" t_stripEnd,
1163− testProperty "tl_stripEnd" tl_stripEnd,
1164− testProperty "t_strip" t_strip,
1165− testProperty "tl_strip" tl_strip,
1166− testProperty "t_splitAt" t_splitAt,
1167− testProperty "tl_splitAt" tl_splitAt,
1168− testProperty "t_span" t_span,
1169− testProperty "tl_span" tl_span,
1170− testProperty "t_breakOn_id" t_breakOn_id,
1171− testProperty "tl_breakOn_id" tl_breakOn_id,
1172− testProperty "t_breakOn_start" t_breakOn_start,
1173− testProperty "tl_breakOn_start" tl_breakOn_start,
1174− testProperty "t_breakOnEnd_end" t_breakOnEnd_end,
1175− testProperty "tl_breakOnEnd_end" tl_breakOnEnd_end,
1176− testProperty "t_break" t_break,
1177− testProperty "tl_break" tl_break,
1178− testProperty "t_group" t_group,
1179− testProperty "tl_group" tl_group,
1180− testProperty "t_groupBy" t_groupBy,
1181− testProperty "tl_groupBy" tl_groupBy,
1182− testProperty "t_inits" t_inits,
1183− testProperty "tl_inits" tl_inits,
1184− testProperty "t_tails" t_tails,
1185− testProperty "tl_tails" tl_tails
1186− ],
1187−
1188− testGroup "breaking many" [
1189− testProperty "t_findAppendId" t_findAppendId,
1190− testProperty "tl_findAppendId" tl_findAppendId,
1191− testProperty "t_findContains" t_findContains,
1192− testProperty "tl_findContains" tl_findContains,
1193− testProperty "sl_filterCount" sl_filterCount,
1194− testProperty "t_findCount" t_findCount,
1195− testProperty "tl_findCount" tl_findCount,
1196− testProperty "t_splitOn_split" t_splitOn_split,
1197− testProperty "tl_splitOn_split" tl_splitOn_split,
1198− testProperty "t_splitOn_i" t_splitOn_i,
1199− testProperty "tl_splitOn_i" tl_splitOn_i,
1200− testProperty "t_split" t_split,
1201− testProperty "t_split_count" t_split_count,
1202− testProperty "t_split_splitOn" t_split_splitOn,
1203− testProperty "tl_split" tl_split,
1204− testProperty "t_chunksOf_same_lengths" t_chunksOf_same_lengths,
1205− testProperty "t_chunksOf_length" t_chunksOf_length,
1206− testProperty "tl_chunksOf" tl_chunksOf
1207− ],
1208−
1209− testGroup "lines and words" [
1210− testProperty "t_lines" t_lines,
1211− testProperty "tl_lines" tl_lines,
1212− --testProperty "t_lines'" t_lines',
1213− testProperty "t_words" t_words,
1214− testProperty "tl_words" tl_words,
1215− testProperty "t_unlines" t_unlines,
1216− testProperty "tl_unlines" tl_unlines,
1217− testProperty "t_unwords" t_unwords,
1218− testProperty "tl_unwords" tl_unwords
1219− ]
1220− ],
1221−
1222− testGroup "predicates" [
1223− testProperty "s_isPrefixOf" s_isPrefixOf,
1224− testProperty "sf_isPrefixOf" sf_isPrefixOf,
1225− testProperty "t_isPrefixOf" t_isPrefixOf,
1226− testProperty "tl_isPrefixOf" tl_isPrefixOf,
1227− testProperty "t_isSuffixOf" t_isSuffixOf,
1228− testProperty "tl_isSuffixOf" tl_isSuffixOf,
1229− testProperty "t_isInfixOf" t_isInfixOf,
1230− testProperty "tl_isInfixOf" tl_isInfixOf,
1231−
1232− testGroup "view" [
1233− testProperty "t_stripPrefix" t_stripPrefix,
1234− testProperty "tl_stripPrefix" tl_stripPrefix,
1235− testProperty "t_stripSuffix" t_stripSuffix,
1236− testProperty "tl_stripSuffix" tl_stripSuffix,
1237− testProperty "t_commonPrefixes" t_commonPrefixes,
1238− testProperty "tl_commonPrefixes" tl_commonPrefixes
1239− ]
1240− ],
1241−
1242− testGroup "searching" [
1243− testProperty "sf_elem" sf_elem,
1244− testProperty "sf_filter" sf_filter,
1245− testProperty "t_filter" t_filter,
1246− testProperty "tl_filter" tl_filter,
1247− testProperty "sf_findBy" sf_findBy,
1248− testProperty "t_find" t_find,
1249− testProperty "tl_find" tl_find,
1250− testProperty "t_partition" t_partition,
1251− testProperty "tl_partition" tl_partition
1252− ],
1253−
1254− testGroup "indexing" [
1255− testProperty "sf_index" sf_index,
1256− testProperty "t_index" t_index,
1257− testProperty "tl_index" tl_index,
1258− testProperty "t_findIndex" t_findIndex,
1259− testProperty "t_count" t_count,
1260− testProperty "tl_count" tl_count,
1261− testProperty "t_indices" t_indices,
1262− testProperty "tl_indices" tl_indices,
1263− testProperty "t_indices_occurs" t_indices_occurs
1264− ],
1265−
1266− testGroup "zips" [
1267− testProperty "t_zip" t_zip,
1268− testProperty "tl_zip" tl_zip,
1269− testProperty "sf_zipWith" sf_zipWith,
1270− testProperty "t_zipWith" t_zipWith,
1271− testProperty "tl_zipWith" tl_zipWith
1272− ],
1273−
1274− testGroup "regressions" [
1275− testProperty "s_filter_eq" s_filter_eq
1276− ],
1277−
1278− testGroup "shifts" [
1279− testProperty "shiftL_Int" shiftL_Int,
1280− testProperty "shiftL_Word16" shiftL_Word16,
1281− testProperty "shiftL_Word32" shiftL_Word32,
1282− testProperty "shiftR_Int" shiftR_Int,
1283− testProperty "shiftR_Word16" shiftR_Word16,
1284− testProperty "shiftR_Word32" shiftR_Word32
1285− ],
1286−
1287− testGroup "builder" [
1288− testProperty "tb_associative" tb_associative,
1289− testGroup "decimal" [
1290− testProperty "tb_decimal_int" tb_decimal_int,
1291− testProperty "tb_decimal_int8" tb_decimal_int8,
1292− testProperty "tb_decimal_int16" tb_decimal_int16,
1293− testProperty "tb_decimal_int32" tb_decimal_int32,
1294− testProperty "tb_decimal_int64" tb_decimal_int64,
1295− testProperty "tb_decimal_integer" tb_decimal_integer,
1296− testProperty "tb_decimal_integer_big" tb_decimal_integer_big,
1297− testProperty "tb_decimal_word" tb_decimal_word,
1298− testProperty "tb_decimal_word8" tb_decimal_word8,
1299− testProperty "tb_decimal_word16" tb_decimal_word16,
1300− 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
1306− ],
1307− testGroup "hexadecimal" [
1308− testProperty "tb_hexadecimal_int" tb_hexadecimal_int,
1309− testProperty "tb_hexadecimal_int8" tb_hexadecimal_int8,
1310− testProperty "tb_hexadecimal_int16" tb_hexadecimal_int16,
1311− testProperty "tb_hexadecimal_int32" tb_hexadecimal_int32,
1312− testProperty "tb_hexadecimal_int64" tb_hexadecimal_int64,
1313− testProperty "tb_hexadecimal_integer" tb_hexadecimal_integer,
1314− testProperty "tb_hexadecimal_word" tb_hexadecimal_word,
1315− testProperty "tb_hexadecimal_word8" tb_hexadecimal_word8,
1316− testProperty "tb_hexadecimal_word16" tb_hexadecimal_word16,
1317− testProperty "tb_hexadecimal_word32" tb_hexadecimal_word32,
1318− testProperty "tb_hexadecimal_word64" tb_hexadecimal_word64
1319− ],
1320− testGroup "realfloat" [
1321− 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
1325− ],
1326− testProperty "tb_fromText" tb_fromText,
1327− testProperty "tb_singleton" tb_singleton
1328− ],
1329−
1330− testGroup "read" [
1331− testProperty "t_decimal" t_decimal,
1332− testProperty "tl_decimal" tl_decimal,
1333− testProperty "t_hexadecimal" t_hexadecimal,
1334− testProperty "tl_hexadecimal" tl_hexadecimal,
1335− testProperty "t_double" t_double,
1336− testProperty "tl_double" tl_double,
1337− testProperty "t_rational" t_rational,
1338− testProperty "tl_rational" tl_rational
1339− ],
1340−
1341− {-
1342− testGroup "input-output" [
1343− testProperty "t_write_read" t_write_read,
1344− testProperty "tl_write_read" tl_write_read,
1345− testProperty "t_write_read_line" t_write_read_line,
1346− testProperty "tl_write_read_line" tl_write_read_line
1347− -- These tests are subject to I/O race conditions when run under
1348− -- test-framework-quickcheck2.
1349− -- testProperty "t_put_get" t_put_get
1350− -- testProperty "tl_put_get" tl_put_get
1351− ],
1352− -}
1353−
1354− testGroup "lowlevel" [
1355− testProperty "t_dropWord16" t_dropWord16,
1356− testProperty "t_takeWord16" t_takeWord16,
1357− testProperty "t_take_drop_16" t_take_drop_16,
1358− testProperty "t_use_from" t_use_from,
1359− testProperty "t_copy" t_copy
1360− ],
1361−
1362− testGroup "mul" Mul.tests
1363− ]
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.hsdeleted−360
@@ -1,360 +0,0 @@
1−-- | This module provides quickcheck utilities, e.g. arbitrary and show
2−-- instances, and comparison functions, so we can focus on the actual properties
3−-- in the 'Tests.Properties' module.
4−--
5−{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-}
6−{-# OPTIONS_GHC -fno-warn-orphans #-}
7−module Tests.QuickCheckUtils
8− (
9− genUnicode
10− , unsquare
11− , smallArbitrary
12−
13− , BigBounded(..)
14− , BigInt(..)
15− , NotEmpty(..)
16−
17− , Small(..)
18− , small
19−
20− , Precision(..)
21− , precision
22−
23− , integralRandomR
24−
25− , DecodeErr(..)
26− , genDecodeErr
27−
28− , Stringy(..)
29− , eq
30− , eqP
31−
32− , Encoding(..)
33−
34− , write_read
35− ) where
36−
37−import Control.Applicative ((<$>))
38−import Control.Arrow (first, (***))
39−import Control.DeepSeq (NFData (..), deepseq)
40−import Control.Exception (bracket)
41−import Data.String (IsString, fromString)
42−import Data.Text.Foreign (I16)
43−import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))
44−import Data.Word (Word8, Word16)
45−import Debug.Trace (trace)
46−import System.Random (Random(..), RandomGen)
47−import Test.QuickCheck hiding (Fixed(..), Small (..), (.&.))
48−import Test.QuickCheck.Monadic (assert, monadicIO, run)
49−import Test.QuickCheck.Unicode (string)
50−import Tests.Utils
51−import qualified Data.ByteString as B
52−import qualified Data.Text as T
53−import 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
58−import qualified Data.Text.Lazy as TL
59−import qualified System.IO as IO
60−
61−#if !MIN_VERSION_base(4,4,0)
62−import Data.Int (Int64)
63−import Data.Word (Word, Word64)
64−#endif
65−
66−genUnicode :: IsString a => Gen a
67−genUnicode = fromString <$> string
68−
69−instance Random I16 where
70− randomR = integralRandomR
71− random = randomR (minBound,maxBound)
72−
73−instance Arbitrary I16 where
74− arbitrary = arbitrarySizedIntegral
75− shrink = shrinkIntegral
76−
77−instance Arbitrary B.ByteString where
78− arbitrary = B.pack `fmap` arbitrary
79− shrink = map B.pack . shrink . B.unpack
80−
81−#if !MIN_VERSION_base(4,4,0)
82−instance Random Int64 where
83− randomR = integralRandomR
84− random = randomR (minBound,maxBound)
85−
86−instance Random Word where
87− randomR = integralRandomR
88− random = randomR (minBound,maxBound)
89−
90−instance Random Word8 where
91− randomR = integralRandomR
92− random = randomR (minBound,maxBound)
93−
94−instance Random Word64 where
95− randomR = integralRandomR
96− random = randomR (minBound,maxBound)
97−#endif
98−
99−-- For tests that have O(n^2) running times or input sizes, resize
100−-- their inputs to the square root of the originals.
101−unsquare :: (Arbitrary a, Show a, Testable b) => (a -> b) -> Property
102−unsquare = forAll smallArbitrary
103−
104−smallArbitrary :: (Arbitrary a, Show a) => Gen a
105−smallArbitrary = sized $ \n -> resize (smallish n) arbitrary
106− where smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs
107−
108−instance Arbitrary T.Text where
109− arbitrary = T.pack `fmap` arbitrary
110− shrink = map T.pack . shrink . T.unpack
111−
112−instance Arbitrary TL.Text where
113− arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary
114− shrink = map TL.pack . shrink . TL.unpack
115−
116−newtype BigInt = Big Integer
117− deriving (Eq, Show)
118−
119−instance Arbitrary BigInt where
120− arbitrary = choose (1::Int,200) >>= \e -> Big <$> choose (10^(e-1),10^e)
121− shrink (Big a) = [Big (a `div` 2^(l-e)) | e <- shrink l]
122− where l = truncate (log (fromIntegral a) / log 2 :: Double) :: Integer
123−
124−newtype BigBounded a = BigBounded a
125− deriving (Eq, Show)
126−
127−instance (Bounded a, Random a, Arbitrary a) => Arbitrary (BigBounded a) where
128− arbitrary = BigBounded <$> choose (minBound, maxBound)
129−
130−newtype NotEmpty a = NotEmpty { notEmpty :: a }
131− deriving (Eq, Ord)
132−
133−instance Show a => Show (NotEmpty a) where
134− show (NotEmpty a) = show a
135−
136−instance Functor NotEmpty where
137− fmap f (NotEmpty a) = NotEmpty (f a)
138−
139−instance Arbitrary a => Arbitrary (NotEmpty [a]) where
140− arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))
141− shrink = shrinkNotEmpty null
142−
143−instance Arbitrary (NotEmpty T.Text) where
144− arbitrary = (fmap T.pack) `fmap` arbitrary
145− shrink = shrinkNotEmpty T.null
146−
147−instance Arbitrary (NotEmpty TL.Text) where
148− arbitrary = (fmap TL.pack) `fmap` arbitrary
149− shrink = shrinkNotEmpty TL.null
150−
151−instance Arbitrary (NotEmpty B.ByteString) where
152− arbitrary = (fmap B.pack) `fmap` arbitrary
153− shrink = shrinkNotEmpty B.null
154−
155−shrinkNotEmpty :: Arbitrary a => (a -> Bool) -> NotEmpty a -> [NotEmpty a]
156−shrinkNotEmpty isNull (NotEmpty xs) =
157− [ NotEmpty xs' | xs' <- shrink xs, not (isNull xs') ]
158−
159−data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7
160− | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15
161− | S16 | S17 | S18 | S19 | S20 | S21 | S22 | S23
162− | S24 | S25 | S26 | S27 | S28 | S29 | S30 | S31
163− deriving (Eq, Ord, Enum, Bounded)
164−
165−small :: Integral a => Small -> a
166−small = fromIntegral . fromEnum
167−
168−intf :: (Int -> Int -> Int) -> Small -> Small -> Small
169−intf f a b = toEnum ((fromEnum a `f` fromEnum b) `mod` 32)
170−
171−instance Show Small where
172− show = show . fromEnum
173−
174−instance Read Small where
175− readsPrec n = map (first toEnum) . readsPrec n
176−
177−instance Num Small where
178− fromInteger = toEnum . fromIntegral
179− signum _ = 1
180− abs = id
181− (+) = intf (+)
182− (-) = intf (-)
183− (*) = intf (*)
184−
185−instance Real Small where
186− toRational = toRational . fromEnum
187−
188−instance Integral Small where
189− toInteger = toInteger . fromEnum
190− quotRem a b = (toEnum x, toEnum y)
191− where (x, y) = fromEnum a `quotRem` fromEnum b
192−
193−instance Random Small where
194− randomR = integralRandomR
195− random = randomR (minBound,maxBound)
196−
197−instance Arbitrary Small where
198− arbitrary = choose (minBound, maxBound)
199− shrink = shrinkIntegral
200−
201−integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
202−integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
203− fromIntegral b :: Integer) g of
204− (x,h) -> (fromIntegral x, h)
205−
206−data DecodeErr = Lenient | Ignore | Strict | Replace
207− deriving (Show, Eq)
208−
209−genDecodeErr :: DecodeErr -> Gen T.OnDecodeError
210−genDecodeErr Lenient = return T.lenientDecode
211−genDecodeErr Ignore = return T.ignore
212−genDecodeErr Strict = return T.strictDecode
213−genDecodeErr Replace = arbitrary
214−
215−instance Arbitrary DecodeErr where
216− arbitrary = elements [Lenient, Ignore, Strict, Replace]
217−
218−class Stringy s where
219− packS :: String -> s
220− unpackS :: s -> String
221− splitAtS :: Int -> s -> (s,s)
222− packSChunkSize :: Int -> String -> s
223− packSChunkSize _ = packS
224−
225−instance Stringy String where
226− packS = id
227− unpackS = id
228− splitAtS = splitAt
229−
230−instance Stringy (TF.Stream Char) where
231− packS = TF.streamList
232− unpackS = TF.unstreamList
233− splitAtS n s = (TF.take n s, TF.drop n s)
234−
235−instance Stringy T.Text where
236− packS = T.pack
237− unpackS = T.unpack
238− splitAtS = T.splitAt
239−
240−instance Stringy TL.Text where
241− packSChunkSize k = TLF.unstreamChunks k . TF.streamList
242− packS = TL.pack
243− unpackS = TL.unpack
244− splitAtS = ((TL.lazyInvariant *** TL.lazyInvariant) .) .
245− TL.splitAt . fromIntegral
246−
247−-- Do two functions give the same answer?
248−eq :: (Eq a, Show a) => (t -> a) -> (t -> a) -> t -> Bool
249−eq a b s = a s =^= b s
250−
251−-- What about with the RHS packed?
252−eqP :: (Eq a, Show a, Stringy s) =>
253− (String -> a) -> (s -> a) -> String -> Word8 -> Bool
254−eqP f g s w = eql "orig" (f s) (g t) &&
255− eql "mini" (f s) (g mini) &&
256− eql "head" (f sa) (g ta) &&
257− eql "tail" (f sb) (g tb)
258− where t = packS s
259− mini = packSChunkSize 10 s
260− (sa,sb) = splitAt m s
261− (ta,tb) = splitAtS m t
262− l = length s
263− m | l == 0 = n
264− | otherwise = n `mod` l
265− n = fromIntegral w
266− eql d a b
267− | a =^= b = True
268− | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
269−
270−instance Arbitrary FPFormat where
271− arbitrary = elements [Exponent, Fixed, Generic]
272−
273−newtype Precision a = Precision (Maybe Int)
274− deriving (Eq, Show)
275−
276−precision :: a -> Precision a -> Maybe Int
277−precision _ (Precision prec) = prec
278−
279−arbitraryPrecision :: Int -> Gen (Precision a)
280−arbitraryPrecision maxDigits = Precision <$> do
281− n <- choose (-1,maxDigits)
282− return $ if n == -1
283− then Nothing
284− else Just n
285−
286−instance Arbitrary (Precision Float) where
287− arbitrary = arbitraryPrecision 11
288− shrink = map Precision . shrink . precision undefined
289−
290−instance Arbitrary (Precision Double) where
291− arbitrary = arbitraryPrecision 22
292− shrink = map Precision . shrink . precision undefined
293−
294−-- Work around lack of Show instance for TextEncoding.
295−data Encoding = E String IO.TextEncoding
296−
297−instance Show Encoding where show (E n _) = "utf" ++ n
298−
299−instance Arbitrary Encoding where
300− arbitrary = oneof . map return $
301− [ E "8" IO.utf8, E "8_bom" IO.utf8_bom, E "16" IO.utf16
302− , E "16le" IO.utf16le, E "16be" IO.utf16be, E "32" IO.utf32
303− , E "32le" IO.utf32le, E "32be" IO.utf32be
304− ]
305−
306−windowsNewlineMode :: IO.NewlineMode
307−windowsNewlineMode = IO.NewlineMode
308− { IO.inputNL = IO.CRLF, IO.outputNL = IO.CRLF
309− }
310−
311−instance Arbitrary IO.NewlineMode where
312− arbitrary = oneof . map return $
313− [ IO.noNewlineTranslation, IO.universalNewlineMode, IO.nativeNewlineMode
314− , windowsNewlineMode
315− ]
316−
317−instance Arbitrary IO.BufferMode where
318− arbitrary = oneof [ return IO.NoBuffering,
319− return IO.LineBuffering,
320− return (IO.BlockBuffering Nothing),
321− (IO.BlockBuffering . Just . (+1) . fromIntegral) `fmap`
322− (arbitrary :: Gen Word16) ]
323−
324−-- This test harness is complex! What property are we checking?
325−--
326−-- Reading after writing a multi-line file should give the same
327−-- results as were written.
328−--
329−-- What do we vary while checking this property?
330−-- * The lines themselves, scrubbed to contain neither CR nor LF. (By
331−-- working with a list of lines, we ensure that the data will
332−-- sometimes contain line endings.)
333−-- * Encoding.
334−-- * Newline translation mode.
335−-- * Buffering.
336−write_read :: (NFData a, Eq a)
337− => ([b] -> a)
338− -> ((Char -> Bool) -> a -> b)
339− -> (IO.Handle -> a -> IO ())
340− -> (IO.Handle -> IO a)
341− -> Encoding
342− -> IO.NewlineMode
343− -> IO.BufferMode
344− -> [a]
345− -> Property
346−write_read unline filt writer reader (E _ _) nl buf ts =
347− monadicIO $ assert . (==t) =<< run act
348− where t = unline . map (filt (not . (`elem` "\r\n"))) $ ts
349− act = withTempFile $ \path h -> do
350− -- hSetEncoding h enc
351− IO.hSetNewlineMode h nl
352− IO.hSetBuffering h buf
353− () <- writer h t
354− IO.hClose h
355− bracket (IO.openFile path IO.ReadMode) IO.hClose $ \h' -> do
356− -- hSetEncoding h' enc
357− IO.hSetNewlineMode h' nl
358− IO.hSetBuffering h' buf
359− r <- reader h'
360− r `deepseq` return r
tests/Tests/Regressions.hsdeleted−82
@@ -1,82 +0,0 @@
1−-- | Regression tests for specific bugs.
2−--
3−{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
4−module Tests.Regressions
5− (
6− tests
7− ) where
8−
9−import Control.Exception (SomeException, handle)
10−import System.IO
11−import Test.HUnit (assertBool, assertEqual, assertFailure)
12−import qualified Data.ByteString as B
13−import Data.ByteString.Char8 ()
14−import qualified Data.ByteString.Lazy as LB
15−import qualified Data.Text as T
16−import qualified Data.Text.Encoding as TE
17−import qualified Data.Text.IO as T
18−import qualified Data.Text.Lazy as LT
19−import qualified Data.Text.Lazy.Encoding as LE
20−import qualified Data.Text.Unsafe as T
21−import qualified Test.Framework as F
22−import qualified Test.Framework.Providers.HUnit as F
23−
24−import Tests.Utils (withTempFile)
25−
26−-- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring
27−-- caused either a segfault or attempt to allocate a negative number
28−-- of bytes.
29−lazy_encode_crash :: IO ()
30−lazy_encode_crash = withTempFile $ \ _ h ->
31− LB.hPut h . LE.encodeUtf8 . LT.pack . replicate 100000 $ 'a'
32−
33−-- Reported by Pieter Laeremans: attempting to read an incorrectly
34−-- encoded file can result in a crash in the RTS (i.e. not merely an
35−-- exception).
36−hGetContents_crash :: IO ()
37−hGetContents_crash = withTempFile $ \ path h -> do
38− B.hPut h (B.pack [0x78, 0xc4 ,0x0a]) >> hClose h
39− h' <- openFile path ReadMode
40− hSetEncoding h' utf8
41− handle (\(_::SomeException) -> return ()) $
42− T.hGetContents h' >> assertFailure "T.hGetContents should crash"
43−
44−-- Reported by Ian Lynagh: attempting to allocate a sufficiently large
45−-- string (via either Array.new or Text.replicate) could result in an
46−-- integer overflow.
47−replicate_crash :: IO ()
48−replicate_crash = handle (\(_::SomeException) -> return ()) $
49− T.replicate (2^power) "0123456789abcdef" `seq`
50− assertFailure "T.replicate should crash"
51− where
52− power | maxBound == (2147483647::Int) = 28
53− | otherwise = 60 :: Int
54−
55−-- Reported by John Millikin: a UTF-8 decode error handler could
56−-- return a bogus substitution character, which we would write without
57−-- checking.
58−utf8_decode_unsafe :: IO ()
59−utf8_decode_unsafe = do
60− let t = TE.decodeUtf8With (\_ _ -> Just '\xdc00') "\x80"
61− assertBool "broken error recovery shouldn't break us" (t == "\xfffd")
62−
63−-- Reported by Eric Seidel: we mishandled mapping Chars that fit in a
64−-- single Word16 to Chars that require two.
65−mapAccumL_resize :: IO ()
66−mapAccumL_resize = do
67− let f a _ = (a, '\65536')
68− count = 5
69− val = T.mapAccumL f (0::Int) (T.replicate count "a")
70− assertEqual "mapAccumL should correctly fill buffers for two-word results"
71− (0, T.replicate count "\65536") val
72− assertEqual "mapAccumL should correctly size buffers for two-word results"
73− (count * 2) (T.lengthWord16 (snd val))
74−
75−tests :: F.Test
76−tests = F.testGroup "Regressions"
77− [ F.testCase "hGetContents_crash" hGetContents_crash
78− , F.testCase "lazy_encode_crash" lazy_encode_crash
79− , F.testCase "mapAccumL_resize" mapAccumL_resize
80− , F.testCase "replicate_crash" replicate_crash
81− , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe
82− ]
tests/Tests/SlowFunctions.hsdeleted−39
@@ -1,39 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−module Tests.SlowFunctions
3− (
4− indices
5− , splitOn
6− ) where
7−
8−import qualified Data.Text as T
9−import Data.Text.Internal (Text(..))
10−import Data.Text.Unsafe (iter_, unsafeHead, unsafeTail)
11−
12−indices :: T.Text -- ^ Substring to search for (@needle@)
13− -> T.Text -- ^ Text to search in (@haystack@)
14− -> [Int]
15−indices needle@(Text _narr _noff nlen) haystack@(Text harr hoff hlen)
16− | T.null needle = []
17− | otherwise = scan 0
18− where
19− scan i | i >= hlen = []
20− | needle `T.isPrefixOf` t = i : scan (i+nlen)
21− | otherwise = scan (i+d)
22− where t = Text harr (hoff+i) (hlen-i)
23− d = iter_ haystack i
24−
25−splitOn :: T.Text -- ^ Text to split on
26− -> T.Text -- ^ Input text
27− -> [T.Text]
28−splitOn pat src0
29− | T.null pat = error "splitOn: empty"
30− | l == 1 = T.split (== (unsafeHead pat)) src0
31− | otherwise = go src0
32− where
33− l = T.length pat
34− go src = search 0 src
35− where
36− search !n !s
37− | T.null s = [src] -- not found
38− | pat `T.isPrefixOf` s = T.take n src : go (T.drop l s)
39− | otherwise = search (n+1) (unsafeTail s)
tests/Tests/Utils.hsdeleted−52
@@ -1,52 +0,0 @@
1−-- | Miscellaneous testing utilities
2−--
3−{-# LANGUAGE ScopedTypeVariables #-}
4−module Tests.Utils
5− (
6− (=^=)
7− , withRedirect
8− , withTempFile
9− ) where
10−
11−import Control.Exception (SomeException, bracket, bracket_, evaluate, try)
12−import Control.Monad (when)
13−import Debug.Trace (trace)
14−import GHC.IO.Handle.Internals (withHandle)
15−import System.Directory (removeFile)
16−import System.IO (Handle, hClose, hFlush, hIsOpen, hIsWritable, openTempFile)
17−import System.IO.Unsafe (unsafePerformIO)
18−
19−-- Ensure that two potentially bottom values (in the sense of crashing
20−-- for some inputs, not looping infinitely) either both crash, or both
21−-- give comparable results for some input.
22−(=^=) :: (Eq a, Show a) => a -> a -> Bool
23−i =^= j = unsafePerformIO $ do
24− x <- try (evaluate i)
25− y <- try (evaluate j)
26− case (x,y) of
27− (Left (_ :: SomeException), Left (_ :: SomeException))
28− -> return True
29− (Right a, Right b) -> return (a == b)
30− e -> trace ("*** Divergence: " ++ show e) return False
31−infix 4 =^=
32−{-# NOINLINE (=^=) #-}
33−
34−withTempFile :: (FilePath -> Handle -> IO a) -> IO a
35−withTempFile = bracket (openTempFile "." "crashy.txt") cleanupTemp . uncurry
36− where
37− cleanupTemp (path,h) = do
38− open <- hIsOpen h
39− when open (hClose h)
40− removeFile path
41−
42−withRedirect :: Handle -> Handle -> IO a -> IO a
43−withRedirect tmp h = bracket_ swap swap
44− where
45− whenM p a = p >>= (`when` a)
46− swap = do
47− whenM (hIsOpen tmp) $ whenM (hIsWritable tmp) $ hFlush tmp
48− whenM (hIsOpen h) $ whenM (hIsWritable h) $ hFlush h
49− withHandle "spam" tmp $ \tmph -> do
50− hh <- withHandle "spam" h $ \hh ->
51− return (tmph,hh)
52− return (hh,())
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/scripts/cover-stdio.shdeleted−62
@@ -1,62 +0,0 @@
1−#!/bin/bash
2−
3−if [[ $# < 1 ]]; then
4− echo "Usage: $0 <exe>"
5− exit 1
6−fi
7−
8−exe=$1
9−
10−rm -f $exe.tix
11−
12−f=$(mktemp stdio-f.XXXXXX)
13−g=$(mktemp stdio-g.XXXXXX)
14−
15−for t in T TL; do
16− echo $t.readFile > $f
17− $exe $t.readFile $f > $g
18− if ! diff -u $f $g; then
19− errs=$((errs+1))
20− echo FAIL: $t.readFile 1>&2
21− fi
22−
23− $exe $t.writeFile $f $t.writeFile
24− echo -n $t.writeFile > $g
25− if ! diff -u $f $g; then
26− errs=$((errs+1))
27− echo FAIL: $t.writeFile 1>&2
28− fi
29−
30− echo -n quux > $f
31− $exe $t.appendFile $f $t.appendFile
32− echo -n quux$t.appendFile > $g
33− if ! diff -u $f $g; then
34− errs=$((errs+1))
35− echo FAIL: $t.appendFile 1>&2
36− fi
37−
38− echo $t.interact | $exe $t.interact > $f
39− echo $t.interact > $g
40− if ! diff -u $f $g; then
41− errs=$((errs+1))
42− echo FAIL: $t.interact 1>&2
43− fi
44−
45− echo $t.getContents | $exe $t.getContents > $f
46− echo $t.getContents > $g
47− if ! diff -u $f $g; then
48− errs=$((errs+1))
49− echo FAIL: $t.getContents 1>&2
50− fi
51−
52− echo $t.getLine | $exe $t.getLine > $f
53− echo $t.getLine > $g
54− if ! diff -u $f $g; then
55− errs=$((errs+1))
56− echo FAIL: $t.getLine 1>&2
57− fi
58−done
59−
60−rm -f $f $g
61−
62−exit $errs
tests/text-tests.cabaldeleted−143
@@ -1,143 +0,0 @@
1−name: text-tests
2−version: 0.0.0.0
3−synopsis: Functional tests for the text package
4−description: Functional tests for the text package
5−homepage: https://github.com/bos/text
6−license: BSD2
7−license-file: ../LICENSE
8−author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
9− Bryan O'Sullivan <bos@serpentine.com>,
10− Tom Harper <rtomharper@googlemail.com>,
11− Duncan Coutts <duncan@haskell.org>
12−maintainer: Bryan O'Sullivan <bos@serpentine.com>
13−category: Text
14−build-type: Simple
15−
16−cabal-version: >=1.8
17−
18−flag hpc
19− description: Enable HPC to generate coverage reports
20− default: False
21− manual: True
22−
23−executable text-tests
24− main-is: Tests.hs
25−
26− other-modules:
27− Tests.IO
28− Tests.Properties
29− Tests.Properties.Mul
30− Tests.QuickCheckUtils
31− Tests.Regressions
32− Tests.SlowFunctions
33− Tests.Utils
34−
35− ghc-options:
36− -Wall -threaded -O0 -rtsopts
37−
38− if flag(hpc)
39− ghc-options:
40− -fhpc
41−
42− cpp-options:
43− -DTEST_SUITE
44− -DASSERTS
45− -DHAVE_DEEPSEQ
46−
47− build-depends:
48− HUnit >= 1.2,
49− QuickCheck >= 2.7,
50− base == 4.*,
51− bytestring,
52− deepseq,
53− directory,
54− quickcheck-unicode,
55− random,
56− test-framework >= 0.4,
57− test-framework-hunit >= 0.2,
58− test-framework-quickcheck2 >= 0.2,
59− text-tests
60−
61−executable text-tests-stdio
62− main-is: Tests/IO.hs
63−
64− ghc-options:
65− -Wall -threaded -rtsopts
66−
67− -- Optional HPC support
68− if flag(hpc)
69− ghc-options:
70− -fhpc
71−
72− build-depends:
73− text-tests,
74− base >= 4 && < 5
75−
76−library
77− hs-source-dirs: ..
78− c-sources: ../cbits/cbits.c
79− include-dirs: ../include
80− ghc-options: -Wall
81− exposed-modules:
82− Data.Text
83− Data.Text.Array
84− Data.Text.Encoding
85− 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
91− 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
97− Data.Text.IO
98− Data.Text.Internal.IO
99− Data.Text.Internal
100− Data.Text.Lazy
101− Data.Text.Lazy.Builder
102− Data.Text.Internal.Builder.Functions
103− Data.Text.Lazy.Builder.Int
104− Data.Text.Internal.Builder.Int.Digits
105− Data.Text.Internal.Builder
106− Data.Text.Lazy.Builder.RealFloat
107− Data.Text.Internal.Builder.RealFloat.Functions
108− Data.Text.Lazy.Encoding
109− Data.Text.Internal.Lazy.Encoding.Fusion
110− Data.Text.Internal.Lazy.Fusion
111− Data.Text.Lazy.IO
112− Data.Text.Internal.Lazy
113− Data.Text.Lazy.Read
114− Data.Text.Internal.Lazy.Search
115− Data.Text.Internal.Private
116− Data.Text.Read
117− Data.Text.Show
118− Data.Text.Internal.Read
119− Data.Text.Internal.Search
120− 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
125−
126− if flag(hpc)
127− ghc-options:
128− -fhpc
129−
130− cpp-options:
131− -DTEST_SUITE
132− -DHAVE_DEEPSEQ
133− -DASSERTS
134− -DINTEGER_GMP
135−
136− build-depends:
137− array,
138− base == 4.*,
139− binary,
140− bytestring,
141− deepseq,
142− ghc-prim,
143− integer-gmp
text.cabal+38−190
@@ -1,208 +1,56 @@
1name: text
1name: text
2−version: 1.2.2.1
2+version: 0.3
3−homepage: https://github.com/bos/text
3+synopsis: An efficient packed Unicode text type
4−bug-reports: https://github.com/bos/text/issues
4+description: An efficient packed Unicode text type.
5−synopsis: An efficient packed Unicode text type.
5+license: BSD3
6−description:
7− .
8− An efficient packed, immutable Unicode text type (both strict and
9− lazy), with a powerful loop fusion optimization framework.
10− .
11− The 'Text' type represents Unicode character strings, in a time and
12− space-efficient manner. This package provides text processing
13− capabilities that are optimized for performance critical use, both
14− in terms of large data quantities and high speed.
15− .
16− The 'Text' type provides character-encoding, type-safe case
17− conversion via whole-string case conversion functions. It also
18− provides a range of functions for converting 'Text' values to and from
19− 'ByteStrings', using several standard encodings.
20− .
21− Efficient locale-sensitive support for text IO is also supported.
22− .
23− These modules are intended to be imported qualified, to avoid name
24− clashes with Prelude functions, e.g.
25− .
26− > import qualified Data.Text as T
27− .
28− To use an extended and very rich family of functions for working
29− with Unicode text (including normalization, regular expressions,
30− non-standard encodings, text breaking, and locales), see
31− the @text-icu@ package:
32− <http://hackage.haskell.org/package/text-icu>
33−
34−license: BSD2
35license-file: LICENSE
6license-file: LICENSE
36−author: Bryan O'Sullivan <bos@serpentine.com>
7+author: Tom Harper <rtharper@aftereternity.co.uk>
37maintainer: Bryan O'Sullivan <bos@serpentine.com>
8maintainer: Bryan O'Sullivan <bos@serpentine.com>
38−copyright: 2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper
9+ Tom Harper <rtharper@aftereternity.co.uk>
10+ Duncan Coutts <duncan@haskell.org>
11+copyright: 2008-2009 Tom Harper, 2009 Bryan O'Sullivan
39category: Data, Text
12category: Data, Text
40build-type: Simple
13build-type: Simple
41−cabal-version: >= 1.8
14+cabal-version: >= 1.2
42−extra-source-files:
15+extra-source-files: README
43− -- scripts/CaseFolding.txt
44− -- scripts/SpecialCasing.txt
45− README.markdown
46− benchmarks/Setup.hs
47− benchmarks/cbits/*.c
48− benchmarks/haskell/*.hs
49− benchmarks/haskell/Benchmarks/*.hs
50− benchmarks/haskell/Benchmarks/Programs/*.hs
51− benchmarks/python/*.py
52− benchmarks/ruby/*.rb
53− benchmarks/text-benchmarks.cabal
54− changelog.md
55− include/*.h
56− scripts/*.hs
57− tests-and-benchmarks.markdown
58− tests/*.hs
59− tests/.ghci
60− tests/Makefile
61− tests/Tests/*.hs
62− tests/Tests/Properties/*.hs
63− tests/cabal.config
64− tests/scripts/*.sh
65− tests/text-tests.cabal
66−
67−flag bytestring-builder
68− description: Depend on the bytestring-builder package for backwards compatibility.
69− default: False
70− manual: False
71−
72−flag developer
73− description: operate in developer mode
74− default: False
75− manual: True
76−
77−flag integer-simple
78− description: Use the simple integer library instead of GMP
79− default: False
80− manual: False
81
16
82library
17library
83− c-sources: cbits/cbits.c
84− include-dirs: include
85−
86 exposed-modules:
18 exposed-modules:
87 Data.Text
19 Data.Text
88− Data.Text.Array
89 Data.Text.Encoding
20 Data.Text.Encoding
90 Data.Text.Encoding.Error
21 Data.Text.Encoding.Error
22+ Data.Text.Encoding.Fusion
91 Data.Text.Foreign
23 Data.Text.Foreign
92− Data.Text.IO
24+ Data.Text.Fusion
93− Data.Text.Internal
25+ Data.Text.Fusion.Common
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
120 Data.Text.Lazy
26 Data.Text.Lazy
121− Data.Text.Lazy.Builder
122− Data.Text.Lazy.Builder.Int
123− Data.Text.Lazy.Builder.RealFloat
124 Data.Text.Lazy.Encoding
27 Data.Text.Lazy.Encoding
125− Data.Text.Lazy.IO
28+ Data.Text.Lazy.Encoding.Fusion
29+ Data.Text.Lazy.Fusion
30+ other-modules:
31+ Data.Text.Array
32+ Data.Text.Internal
33+ Data.Text.Encoding.Fusion.Common
34+ Data.Text.Fusion.Internal
35+ Data.Text.Fusion.CaseMapping
126 Data.Text.Lazy.Internal
36 Data.Text.Lazy.Internal
127− Data.Text.Lazy.Read
128− Data.Text.Read
129 Data.Text.Unsafe
37 Data.Text.Unsafe
130−
38+ Data.Text.UnsafeChar
131− other-modules:
39+ Data.Text.UnsafeShift
132− Data.Text.Show
40+ Data.Text.Encoding.Utf8
41+ Data.Text.Encoding.Utf16
42+ Data.Text.Encoding.Utf32
133
43
134 build-depends:
44 build-depends:
135− array >= 0.3,
45+ base < 5,
136− base >= 4.2 && < 5,
46+ bytestring >= 0.9 && < 1.0
137− binary,
47+ if impl(ghc >= 6.10)
138− deepseq >= 1.1.0.0,
48+ build-depends:
139− ghc-prim >= 0.2
49+ ghc-prim, base >= 4
140−
50+
141− if flag(bytestring-builder)
51+ -- gather extensive profiling data for now
142− build-depends: bytestring >= 0.9 && < 0.10.4,
52+ ghc-prof-options: -auto-all
143− bytestring-builder >= 0.10.4
53+
144− else
54+ ghc-options: -Wall -funbox-strict-fields -O2
145− build-depends: bytestring >= 0.10.4
55+ if impl(ghc >= 6.8)
146−
56+ ghc-options: -fwarn-tabs
147− cpp-options: -DHAVE_DEEPSEQ
148− ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
149− if flag(developer)
150− ghc-prof-options: -auto-all
151− ghc-options: -Werror
152− cpp-options: -DASSERTS
153−
154− if flag(integer-simple)
155− cpp-options: -DINTEGER_SIMPLE
156− build-depends: integer-simple >= 0.1 && < 0.5
157− else
158− cpp-options: -DINTEGER_GMP
159− build-depends: integer-gmp >= 0.2
160−
161−test-suite tests
162− type: exitcode-stdio-1.0
163− hs-source-dirs: tests .
164− main-is: Tests.hs
165− c-sources: cbits/cbits.c
166− include-dirs: include
167−
168− ghc-options:
169− -Wall -threaded -O0 -rtsopts
170−
171− cpp-options:
172− -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE
173−
174− build-depends:
175− HUnit >= 1.2,
176− QuickCheck >= 2.7,
177− array,
178− base,
179− binary,
180− deepseq,
181− directory,
182− ghc-prim,
183− quickcheck-unicode,
184− random,
185− test-framework >= 0.4,
186− test-framework-hunit >= 0.2,
187− test-framework-quickcheck2 >= 0.2
188−
189− if flag(bytestring-builder)
190− build-depends: bytestring >= 0.9 && < 0.10.4,
191− bytestring-builder >= 0.10.4
192− else
193− build-depends: bytestring >= 0.10.4
194−
195− if flag(integer-simple)
196− cpp-options: -DINTEGER_SIMPLE
197− build-depends: integer-simple >= 0.1 && < 0.5
198− else
199− cpp-options: -DINTEGER_GMP
200− build-depends: integer-gmp >= 0.2
201−
202−source-repository head
203− type: git
204− location: https://github.com/bos/text
205−
206−source-repository head
207− type: mercurial
208− location: https://bitbucket.org/bos/text