on master help sign in
.gitignore+3−10
since splitsnapshots
unifiedsplit
@@ -1,10 +1,3 @@
1−/dist/
1+dist
2−/dist-boot/
3−/dist-install/
4−/dist-newstyle/
5−/cabal-dev/
2+cabal-dev
6−/cabal.sandbox.config
3+cabal.sandbox.config
7−/ghc.mk
8−/GNUmakefile
9−/.ghc.environment.*
10−/cabal.project.local
.hgtags−1
@@ -64,4 +64,3 @@ f8a60279237c1c28e094868740d9188dd94fcc9e 1.2.0.0
64631fd055e27fa10983e17e9ad36d1b285b85c661 1.2.1.3
64631fd055e27fa10983e17e9ad36d1b285b85c661 1.2.1.3
658221a68ed5ec37028357df9c6c25f52320e54ad9 1.2.2.0
658221a68ed5ec37028357df9c6c25f52320e54ad9 1.2.2.0
66ce1c5ac65eb9f5580114b4e380092b05a485e95d 1.2.2.1
66ce1c5ac65eb9f5580114b4e380092b05a485e95d 1.2.2.1
67−d72c634a91ffe27ec5cd03921dd53efc8129d8f6 1.2.2.2
.travis.ymldeleted−111
@@ -1,111 +0,0 @@
1−# This Travis job script has been generated by a script via
2−#
3−# make_travis_yml_2.hs '-o' '.travis.yml' 'text.cabal'
4−#
5−# For more information, see https://github.com/hvr/multi-ghc-travis
6−#
7−language: c
8−sudo: false
9−
10−# Bryan threatens to turn off Travis-CI if he gets any email :-)
11−notifications:
12− email: false
13−
14−cache:
15− directories:
16− - $HOME/.cabal/packages
17− - $HOME/.cabal/store
18−
19−before_cache:
20− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
21− # remove files that are regenerated by 'cabal update'
22− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*
23− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json
24− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache
25− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar
26− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx
27−
28−matrix:
29− include:
30− - compiler: "ghc-7.0.4"
31− # env: TEST=--disable-tests BENCH=--disable-benchmarks
32− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.0.4], sources: [hvr-ghc]}}
33− - compiler: "ghc-7.2.2"
34− # env: TEST=--disable-tests BENCH=--disable-benchmarks
35− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.2.2], sources: [hvr-ghc]}}
36− - compiler: "ghc-7.4.2"
37− # env: TEST=--disable-tests BENCH=--disable-benchmarks
38− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.4.2], sources: [hvr-ghc]}}
39− - compiler: "ghc-7.6.3"
40− # env: TEST=--disable-tests BENCH=--disable-benchmarks
41− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.6.3], sources: [hvr-ghc]}}
42− - compiler: "ghc-7.8.4"
43− # env: TEST=--disable-tests BENCH=--disable-benchmarks
44− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.8.4], sources: [hvr-ghc]}}
45− - compiler: "ghc-7.10.3"
46− # env: TEST=--disable-tests BENCH=--disable-benchmarks
47− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}}
48− - compiler: "ghc-8.0.2"
49− # env: TEST=--disable-tests BENCH=--disable-benchmarks
50− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}
51− - compiler: "ghc-8.2.2"
52− # env: TEST=--disable-tests BENCH=--disable-benchmarks
53− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}}
54−
55−before_install:
56− - HC=${CC}
57− - HCPKG=${HC/ghc/ghc-pkg}
58− - unset CC
59− - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH
60− - PKGNAME='text'
61−
62−install:
63− - cabal --version
64− - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
65− - BENCH=${BENCH---enable-benchmarks}
66− - TEST=${TEST---enable-tests}
67− - HADDOCK=${HADDOCK-true}
68− - INSTALLED=${INSTALLED-true}
69− - travis_retry cabal update -v
70− - sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
71− - rm -fv cabal.project.local
72− - "echo 'packages: .' > cabal.project"
73− - rm -f cabal.project.freeze
74− - cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all
75− - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all
76−
77−# Here starts the actual work to be performed for the package under test;
78−# any command which exits with a non-zero exit code causes the build to fail.
79−script:
80− - if [ -f configure.ac ]; then autoreconf -i; fi
81− - rm -rf .ghc.environment.* dist/
82− - cabal sdist # test that a source-distribution can be generated
83− - cd dist/
84− - SRCTAR=(${PKGNAME}-*.tar.gz)
85− - SRC_BASENAME="${SRCTAR/%.tar.gz}"
86− - tar -xvf "./$SRC_BASENAME.tar.gz"
87− - cd "$SRC_BASENAME/"
88−## from here on, CWD is inside the extracted source-tarball
89− - rm -fv cabal.project.local
90− - "echo 'packages: .' > cabal.project"
91− # this builds all libraries and executables (without tests/benchmarks)
92− - rm -f cabal.project.freeze
93− - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all
94− # this builds all libraries and executables (including tests/benchmarks)
95− # - rm -rf ./dist-newstyle
96−
97− # Build with installed constraints for packages in global-db
98− - if $INSTALLED; then
99− echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/\([a-zA-Z0-9-]\{1,\}\) */--constraint="\1 installed" /g') all | sh;
100− else echo "Not building with installed constraints"; fi
101−
102− # build & run tests, build benchmarks
103− - cabal new-build -w ${HC} ${TEST} ${BENCH} all
104− - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi
105−
106− # haddock
107− - rm -rf ./dist-newstyle
108− - if $HADDOCK; then cabal new-haddock -w ${HC} --disable-tests --disable-benchmarks all; else echo "Skipping haddock generation";fi
109−
110−# REGENDATA ["-o",".travis.yml","text.cabal"]
111−# EOF
Data/JSString/Text.hsdeleted−64
@@ -1,64 +0,0 @@
1−{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes, JavaScriptFFI,
2− UnboxedTuples, DeriveDataTypeable, GHCForeignImportPrim,
3− MagicHash, FlexibleInstances, BangPatterns, Rank2Types, CPP #-}
4−
5−{- | Conversion between 'Data.Text.Text' and 'Data.JSString.JSString'
6−
7− -}
8−
9−-- Moved from ghcjs-base with text-jsstring support.
10−
11−module Data.JSString.Text
12− ( textToJSString
13− , textFromJSString
14− , lazyTextToJSString
15− , lazyTextFromJSString
16− , textFromJSVal
17− , lazyTextFromJSVal
18− ) where
19−
20−import GHCJS.Prim
21−
22−import GHC.Exts (Any)
23−
24−import Control.DeepSeq
25−
26−import qualified Data.Text as T
27−import qualified Data.Text.Internal as T
28−import qualified Data.Text.Lazy as TL
29−import Data.JSString (JSString)
30−
31−import GHCJS.Marshal.Pure
32−import Unsafe.Coerce
33−
34−textToJSString :: T.Text -> JSString
35−textToJSString (T.Text txt) = txt
36−{-# INLINE textToJSString #-}
37−
38−textFromJSString :: JSString -> T.Text
39−textFromJSString = T.Text
40−{-# INLINE textFromJSString #-}
41−
42−lazyTextToJSString :: TL.Text -> JSString
43−lazyTextToJSString t = rnf t `seq` js_lazyTextToString (unsafeCoerce t)
44−{-# INLINE lazyTextToJSString #-}
45−
46−lazyTextFromJSString :: JSString -> TL.Text
47−lazyTextFromJSString = TL.fromStrict . textFromJSString
48−{-# INLINE lazyTextFromJSString #-}
49−
50−-- | returns the empty Text if not a string
51−textFromJSVal :: JSVal -> T.Text
52−textFromJSVal v = T.Text $ pFromJSVal v -- TODO check if val is a string?
53−{-# INLINE textFromJSVal #-}
54−
55−-- | returns the empty Text if not a string
56−lazyTextFromJSVal :: JSVal -> TL.Text
57−lazyTextFromJSVal = TL.fromStrict . textFromJSVal
58−{-# INLINE lazyTextFromJSVal #-}
59−
60−-- ----------------------------------------------------------------------------
61−
62−foreign import javascript unsafe
63− "h$lazyTextToString"
64− js_lazyTextToString :: Any -> JSString
Data/Text.hs+391−689
@@ -6,7 +6,7 @@
6#if __GLASGOW_HASKELL__ >= 708
6#if __GLASGOW_HASKELL__ >= 708
7{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeFamilies #-}
8#endif
8#endif
9−{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI, UnliftedFFITypes #-}
9+
10-- |
10-- |
11-- Module : Data.Text
11-- Module : Data.Text
12-- Copyright : (c) 2009, 2010, 2011, 2012 Bryan O'Sullivan,
12-- Copyright : (c) 2009, 2010, 2011, 2012 Bryan O'Sullivan,
@@ -15,6 +15,7 @@
15--
15--
16-- License : BSD-style
16-- License : BSD-style
17-- Maintainer : bos@serpentine.com
17-- Maintainer : bos@serpentine.com
18+-- Stability : experimental
18-- Portability : GHC
19-- Portability : GHC
19--
20--
20-- A time and space-efficient implementation of Unicode text.
21-- A time and space-efficient implementation of Unicode text.
@@ -31,9 +32,8 @@
31--
32--
32-- To use an extended and very rich family of functions for working
33-- To use an extended and very rich family of functions for working
33-- with Unicode text (including normalization, regular expressions,
34-- with Unicode text (including normalization, regular expressions,
34−-- non-standard encodings, text breaking, and locales), see the
35+-- non-standard encodings, text breaking, and locales), see
35−-- <http://hackage.haskell.org/package/text-icu text-icu package >.
36+-- <http://hackage.haskell.org/package/text-icu the text-icu package >.
36−--
37
37
38module Data.Text
38module Data.Text
39 (
39 (
@@ -43,9 +43,6 @@ module Data.Text
43 -- * Acceptable data
43 -- * Acceptable data
44 -- $replacement
44 -- $replacement
45
45
46− -- * Definition of character
47− -- $character_definition
48−
49 -- * Fusion
46 -- * Fusion
50 -- $fusion
47 -- $fusion
51
48
@@ -63,7 +60,6 @@ module Data.Text
63 , snoc
60 , snoc
64 , append
61 , append
65 , uncons
62 , uncons
66− , unsnoc
67 , head
63 , head
68 , last
64 , last
69 , tail
65 , tail
@@ -227,17 +223,16 @@ import qualified Data.Text.Internal.Fusion as S
227import qualified Data.Text.Internal.Fusion.Common as S
223import qualified Data.Text.Internal.Fusion.Common as S
228import Data.Text.Encoding (decodeUtf8', encodeUtf8)
224import Data.Text.Encoding (decodeUtf8', encodeUtf8)
229import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
225import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
230−-- import Data.Text.Internal.Private (span_)
226+import Data.Text.Internal.Private (span_)
231−import Data.Text.Internal (Text(..), empty, empty_, firstf, mul, safe, text)
227+import Data.Text.Internal (Text(..), empty, firstf, mul, safe, text)
232−-- import Data.Text.Show (singleton, unpack, unpackCString#)
228+import Data.Text.Show (singleton, unpack, unpackCString#)
233import qualified Prelude as P
229import qualified Prelude as P
234import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
230import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
235− reverseIter_, unsafeHead, unsafeTail,
231+ reverseIter_, unsafeHead, unsafeTail)
236− unsafeDupablePerformIO)
237import Data.Text.Internal.Unsafe.Char (unsafeChr)
232import Data.Text.Internal.Unsafe.Char (unsafeChr)
238import qualified Data.Text.Internal.Functions as F
233import qualified Data.Text.Internal.Functions as F
239import qualified Data.Text.Internal.Encoding.Utf16 as U16
234import qualified Data.Text.Internal.Encoding.Utf16 as U16
240−-- import Data.Text.Internal.Search (indices)
235+import Data.Text.Internal.Search (indices)
241#if defined(__HADDOCK__)
236#if defined(__HADDOCK__)
242import Data.ByteString (ByteString)
237import Data.ByteString (ByteString)
243import qualified Data.Text.Lazy as L
238import qualified Data.Text.Lazy as L
@@ -251,68 +246,6 @@ import qualified GHC.Exts as Exts
251import Text.Printf (PrintfArg, formatArg, formatString)
246import Text.Printf (PrintfArg, formatArg, formatString)
252#endif
247#endif
253
248
254−-- GHCJS ------------------------------------------------------------
255−import Data.JSString.Internal.Type (JSString (..))
256−import qualified Data.JSString as JSS
257−import qualified Data.JSString.Internal.Fusion as SJS
258−import qualified Data.JSString.Internal.Fusion.Common as SJS
259−import Data.Coerce
260−import GHC.Base (build)
261−import qualified GHC.CString as GHC
262−import GHC.Exts (Addr#, ByteArray#)
263−import GHCJS.Prim (JSVal (..), unpackJSString#)
264−
265−unpack :: Text -> String
266−unpack = coerce JSS.unpack
267−{-# INLINE [1] unpack #-}
268−
269−singleton :: Char -> Text
270−singleton = coerce JSS.singleton
271−{-# INLINE [1] singleton #-}
272−
273−{-# RULES
274−"JSSTRING singleton -> fused" [~1] forall a.
275− singleton a = unstream (S.singleton (safe a))
276−"JSSTRING singleton -> unfused" [1] forall a.
277− unstream (S.singleton (safe a)) = singleton a
278− #-}
279−
280−{-# RULES "inlineJSString" forall s. pack (GHC.Base.build (GHC.unpackFoldrCString# s)) = Text (JSString (unsafeDupablePerformIO (unpackJSString# s))) #-}
281−
282−-- | /O(n)/ Convert a literal string into a JSString. Subject to fusion.
283−unpackCString# :: Addr# -> Text
284−unpackCString# addr# = Text $ SJS.unstream (SJS.streamCString# addr#)
285−{-# NOINLINE unpackCString# #-}
286−
287−{-# RULES "TEXT literal" forall a.
288− unstream (S.map safe (S.streamList (GHC.unpackCString# a)))
289− = unpackCString# a #-}
290−
291−{-# RULES "TEXT literal UTF8" [1] forall a.
292− unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))
293− = unpackCString# a #-}
294−
295−{-# RULES "TEXT empty literal" [1]
296− unstream (S.map safe (S.streamList []))
297− = empty_ #-}
298−
299−{-# RULES "TEXT singleton literal" [1] forall a.
300− unstream (S.map safe (S.streamList [a]))
301− = singleton a #-}
302−
303−---------------------------------------------------------------------
304−-- $character_definition
305−--
306−-- This package uses the term /character/ to denote Unicode /code points/.
307−--
308−-- Note that this is not the same thing as a grapheme (e.g. a
309−-- composition of code points that form one visual symbol). For
310−-- instance, consider the grapheme \"&#x00e4;\". This symbol has two
311−-- Unicode representations: a single code-point representation
312−-- @U+00E4@ (the @LATIN SMALL LETTER A WITH DIAERESIS@ code point),
313−-- and a two code point representation @U+0061@ (the \"@A@\" code
314−-- point) and @U+0308@ (the @COMBINING DIAERESIS@ code point).
315−
316-- $strict
249-- $strict
317--
250--
318-- This package provides both strict and lazy 'Text' types. The
251-- This package provides both strict and lazy 'Text' types. The
@@ -388,31 +321,22 @@ unpackCString# addr# = Text $ SJS.unstream (SJS.streamCString# addr#)
388-- Functions that can be fused by the compiler are documented with the
321-- Functions that can be fused by the compiler are documented with the
389-- phrase \"Subject to fusion\".
322-- phrase \"Subject to fusion\".
390
323
391−-- instance Eq Text where
392−-- Text arrA offA lenA == Text arrB offB lenB
393−-- | lenA == lenB = A.equal arrA offA arrB offB lenA
394−-- | otherwise = False
395−-- {-# INLINE (==) #-}
396instance Eq Text where
324instance Eq Text where
397− Text x == Text y = x == y
325+ Text arrA offA lenA == Text arrB offB lenB
398−
326+ | lenA == lenB = A.equal arrA offA arrB offB lenA
399−-- instance Ord Text where
327+ | otherwise = False
400−-- compare = compareText
328+ {-# INLINE (==) #-}
401
329
402instance Ord Text where
330instance Ord Text where
403− compare (Text x) (Text y) = compare x y
331+ compare = compareText
404
332
405instance Read Text where
333instance Read Text where
406 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
334 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
407
335
408#if MIN_VERSION_base(4,9,0)
336#if MIN_VERSION_base(4,9,0)
409−-- | Non-orphan 'Semigroup' instance only defined for
410−-- @base-4.9.0.0@ and later; orphan instances for older GHCs are
337+-- Semigroup orphan instances for older GHCs are provided by
411−-- provided by
412−-- the [semigroups](http://hackage.haskell.org/package/semigroups)
413−-- package
338+-- 'semigroups` package
414−--
339+
415−-- @since 1.2.2.0
416instance Semigroup Text where
340instance Semigroup Text where
417 (<>) = append
341 (<>) = append
418#endif
342#endif
@@ -430,7 +354,6 @@ instance IsString Text where
430 fromString = pack
354 fromString = pack
431
355
432#if __GLASGOW_HASKELL__ >= 708
356#if __GLASGOW_HASKELL__ >= 708
433−-- | @since 1.2.0.0
434instance Exts.IsList Text where
357instance Exts.IsList Text where
435 type Item Text = Char
358 type Item Text = Char
436 fromList = pack
359 fromList = pack
@@ -441,7 +364,6 @@ instance Exts.IsList Text where
441instance NFData Text where rnf !_ = ()
364instance NFData Text where rnf !_ = ()
442#endif
365#endif
443
366
444−-- | @since 1.2.1.0
445instance Binary Text where
367instance Binary Text where
446 put t = put (encodeUtf8 t)
368 put t = put (encodeUtf8 t)
447 get = do
369 get = do
@@ -475,10 +397,8 @@ instance Data Text where
475
397
476#if MIN_VERSION_base(4,7,0)
398#if MIN_VERSION_base(4,7,0)
477-- | Only defined for @base-4.7.0.0@ and later
399-- | Only defined for @base-4.7.0.0@ and later
478−--
479−-- @since 1.2.2.0
480instance PrintfArg Text where
400instance PrintfArg Text where
481− formatArg t = formatString $ unpack t
401+ formatArg txt = formatString $ unpack txt
482#endif
402#endif
483
403
484packConstr :: Constr
404packConstr :: Constr
@@ -487,19 +407,19 @@ packConstr = mkConstr textDataType "pack" [] Prefix
487textDataType :: DataType
407textDataType :: DataType
488textDataType = mkDataType "Data.Text.Text" [packConstr]
408textDataType = mkDataType "Data.Text.Text" [packConstr]
489
409
490−-- -- | /O(n)/ Compare two 'Text' values lexicographically.
410+-- | /O(n)/ Compare two 'Text' values lexicographically.
491−-- compareText :: Text -> Text -> Ordering
411+compareText :: Text -> Text -> Ordering
492−-- compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)
412+compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)
493−-- | lenA == 0 && lenB == 0 = EQ
413+ | lenA == 0 && lenB == 0 = EQ
494−-- | otherwise = go 0 0
414+ | otherwise = go 0 0
495−-- where
415+ where
496−-- go !i !j
416+ go !i !j
497−-- | i >= lenA || j >= lenB = compare lenA lenB
417+ | i >= lenA || j >= lenB = compare lenA lenB
498−-- | a < b = LT
418+ | a < b = LT
499−-- | a > b = GT
419+ | a > b = GT
500−-- | otherwise = go (i+di) (j+dj)
420+ | otherwise = go (i+di) (j+dj)
501−-- where Iter a di = iter ta i
421+ where Iter a di = iter ta i
502−-- Iter b dj = iter tb j
422+ Iter b dj = iter tb j
503
423
504-- -----------------------------------------------------------------------------
424-- -----------------------------------------------------------------------------
505-- * Conversion to/from 'Text'
425-- * Conversion to/from 'Text'
@@ -507,8 +427,7 @@ textDataType = mkDataType "Data.Text.Text" [packConstr]
507-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to
427-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to
508-- fusion. Performs replacement on invalid scalar values.
428-- fusion. Performs replacement on invalid scalar values.
509pack :: String -> Text
429pack :: String -> Text
510−pack = coerce JSS.pack
511−-- pack = unstream . S.map safe . S.streamList
430+pack = unstream . S.map safe . S.streamList
512{-# INLINE [1] pack #-}
431{-# INLINE [1] pack #-}
513
432
514-- -----------------------------------------------------------------------------
433-- -----------------------------------------------------------------------------
@@ -519,8 +438,7 @@ pack = coerce JSS.pack
519-- copying a new array. Subject to fusion. Performs replacement on
438-- copying a new array. Subject to fusion. Performs replacement on
520-- invalid scalar values.
439-- invalid scalar values.
521cons :: Char -> Text -> Text
440cons :: Char -> Text -> Text
522−cons = coerce JSS.cons
523−-- cons c t = unstream (S.cons (safe c) (stream t))
441+cons c t = unstream (S.cons (safe c) (stream t))
524{-# INLINE cons #-}
442{-# INLINE cons #-}
525
443
526infixr 5 `cons`
444infixr 5 `cons`
@@ -529,27 +447,25 @@ infixr 5 `cons`
529-- entire array in the process, unless fused. Subject to fusion.
447-- entire array in the process, unless fused. Subject to fusion.
530-- Performs replacement on invalid scalar values.
448-- Performs replacement on invalid scalar values.
531snoc :: Text -> Char -> Text
449snoc :: Text -> Char -> Text
532−snoc = coerce JSS.snoc
533−-- snoc t c = unstream (S.snoc (stream t) (safe c))
450+snoc t c = unstream (S.snoc (stream t) (safe c))
534{-# INLINE snoc #-}
451{-# INLINE snoc #-}
535
452
536-- | /O(n)/ Appends one 'Text' to the other by copying both of them
453-- | /O(n)/ Appends one 'Text' to the other by copying both of them
537-- into a new 'Text'. Subject to fusion.
454-- into a new 'Text'. Subject to fusion.
538append :: Text -> Text -> Text
455append :: Text -> Text -> Text
539−append = coerce JSS.append
540−-- append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
456+append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
541−-- | len1 == 0 = b
457+ | len1 == 0 = b
542−-- | len2 == 0 = a
458+ | len2 == 0 = a
543−-- | len > 0 = Text (A.run x) 0 len
459+ | len > 0 = Text (A.run x) 0 len
544−-- | otherwise = overflowError "append"
460+ | otherwise = overflowError "append"
545−-- where
461+ where
546−-- len = len1+len2
462+ len = len1+len2
547−-- x :: ST s (A.MArray s)
463+ x :: ST s (A.MArray s)
548−-- x = do
464+ x = do
549−-- arr <- A.new len
465+ arr <- A.new len
550−-- A.copyI arr 0 arr1 off1 len1
466+ A.copyI arr 0 arr1 off1 len1
551−-- A.copyI arr len1 arr2 off2 len
467+ A.copyI arr len1 arr2 off2 len
552−-- return arr
468+ return arr
553{-# NOINLINE append #-}
469{-# NOINLINE append #-}
554
470
555{-# RULES
471{-# RULES
@@ -562,18 +478,16 @@ append = coerce JSS.append
562-- | /O(1)/ Returns the first character of a 'Text', which must be
478-- | /O(1)/ Returns the first character of a 'Text', which must be
563-- non-empty. Subject to fusion.
479-- non-empty. Subject to fusion.
564head :: Text -> Char
480head :: Text -> Char
565−head = coerce JSS.head
566−-- head t = S.head (stream t)
481+head t = S.head (stream t)
567{-# INLINE head #-}
482{-# INLINE head #-}
568
483
569-- | /O(1)/ Returns the first character and rest of a 'Text', or
484-- | /O(1)/ Returns the first character and rest of a 'Text', or
570-- 'Nothing' if empty. Subject to fusion.
485-- 'Nothing' if empty. Subject to fusion.
571uncons :: Text -> Maybe (Char, Text)
486uncons :: Text -> Maybe (Char, Text)
572−uncons = coerce JSS.uncons
573−-- uncons t@(Text arr off len)
487+uncons t@(Text arr off len)
574−-- | len <= 0 = Nothing
488+ | len <= 0 = Nothing
575−-- | otherwise = Just $ let !(Iter c d) = iter t 0
489+ | otherwise = Just $ let !(Iter c d) = iter t 0
576−-- in (c, text arr (off+d) (len-d))
490+ in (c, text arr (off+d) (len-d))
577{-# INLINE [1] uncons #-}
491{-# INLINE [1] uncons #-}
578
492
579-- | Lifted from Control.Arrow and specialized.
493-- | Lifted from Control.Arrow and specialized.
@@ -583,13 +497,12 @@ second f (a, b) = (a, f b)
583-- | /O(1)/ Returns the last character of a 'Text', which must be
497-- | /O(1)/ Returns the last character of a 'Text', which must be
584-- non-empty. Subject to fusion.
498-- non-empty. Subject to fusion.
585last :: Text -> Char
499last :: Text -> Char
586−last = coerce JSS.last
587−-- last (Text arr off len)
500+last (Text arr off len)
588−-- | len <= 0 = emptyError "last"
501+ | len <= 0 = emptyError "last"
589−-- | n < 0xDC00 || n > 0xDFFF = unsafeChr n
502+ | n < 0xDC00 || n > 0xDFFF = unsafeChr n
590−-- | otherwise = U16.chr2 n0 n
503+ | otherwise = U16.chr2 n0 n
591−-- where n = A.unsafeIndex arr (off+len-1)
504+ where n = A.unsafeIndex arr (off+len-1)
592−-- n0 = A.unsafeIndex arr (off+len-2)
505+ n0 = A.unsafeIndex arr (off+len-2)
593{-# INLINE [1] last #-}
506{-# INLINE [1] last #-}
594
507
595{-# RULES
508{-# RULES
@@ -602,11 +515,10 @@ last = coerce JSS.last
602-- | /O(1)/ Returns all characters after the head of a 'Text', which
515-- | /O(1)/ Returns all characters after the head of a 'Text', which
603-- must be non-empty. Subject to fusion.
516-- must be non-empty. Subject to fusion.
604tail :: Text -> Text
517tail :: Text -> Text
605−tail = coerce JSS.tail
606−-- tail t@(Text arr off len)
518+tail t@(Text arr off len)
607−-- | len <= 0 = emptyError "tail"
519+ | len <= 0 = emptyError "tail"
608−-- | otherwise = text arr (off+d) (len-d)
520+ | otherwise = text arr (off+d) (len-d)
609−-- where d = iter_ t 0
521+ where d = iter_ t 0
610{-# INLINE [1] tail #-}
522{-# INLINE [1] tail #-}
611
523
612{-# RULES
524{-# RULES
@@ -619,12 +531,11 @@ tail = coerce JSS.tail
619-- | /O(1)/ Returns all but the last character of a 'Text', which must
531-- | /O(1)/ Returns all but the last character of a 'Text', which must
620-- be non-empty. Subject to fusion.
532-- be non-empty. Subject to fusion.
621init :: Text -> Text
533init :: Text -> Text
622−init = coerce JSS.init
623−-- init (Text arr off len) | len <= 0 = emptyError "init"
534+init (Text arr off len) | len <= 0 = emptyError "init"
624−-- | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)
535+ | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)
625−-- | otherwise = text arr off (len-1)
536+ | otherwise = text arr off (len-1)
626−-- where
537+ where
627−-- n = A.unsafeIndex arr (off+len-1)
538+ n = A.unsafeIndex arr (off+len-1)
628{-# INLINE [1] init #-}
539{-# INLINE [1] init #-}
629
540
630{-# RULES
541{-# RULES
@@ -634,28 +545,14 @@ init = coerce JSS.init
634 unstream (S.init (stream t)) = init t
545 unstream (S.init (stream t)) = init t
635 #-}
546 #-}
636
547
637−-- | /O(1)/ Returns all but the last character and the last character of a
638−-- 'Text', or 'Nothing' if empty.
639−--
640−-- @since 1.2.3.0
641−unsnoc :: Text -> Maybe (Text, Char)
642−unsnoc (Text arr off len)
643− | len <= 0 = Nothing
644− | n < 0xDC00 || n > 0xDFFF = Just (text arr off (len-1), unsafeChr n)
645− | otherwise = Just (text arr off (len-2), U16.chr2 n0 n)
646− where n = A.unsafeIndex arr (off+len-1)
647− n0 = A.unsafeIndex arr (off+len-2)
648−{-# INLINE [1] unsnoc #-}
649−
650-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
548-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
651-- fusion.
549-- fusion.
652null :: Text -> Bool
550null :: Text -> Bool
653−null = coerce JSS.null
654−-- null (Text _arr _off len) =
551+null (Text _arr _off len) =
655−-- #if defined(ASSERTS)
552+#if defined(ASSERTS)
656−-- assert (len >= 0) $
553+ assert (len >= 0) $
657−-- #endif
554+#endif
658−-- len <= 0
555+ len <= 0
659{-# INLINE [1] null #-}
556{-# INLINE [1] null #-}
660
557
661{-# RULES
558{-# RULES
@@ -667,15 +564,14 @@ null = coerce JSS.null
667
564
668-- | /O(1)/ Tests whether a 'Text' contains exactly one character.
565-- | /O(1)/ Tests whether a 'Text' contains exactly one character.
669-- Subject to fusion.
566-- Subject to fusion.
670−-- isSingleton :: Text -> Bool
567+isSingleton :: Text -> Bool
671−-- isSingleton = S.isSingleton . stream
568+isSingleton = S.isSingleton . stream
672−-- {-# INLINE isSingleton #-}
569+{-# INLINE isSingleton #-}
673
570
674-- | /O(n)/ Returns the number of characters in a 'Text'.
571-- | /O(n)/ Returns the number of characters in a 'Text'.
675-- Subject to fusion.
572-- Subject to fusion.
676length :: Text -> Int
573length :: Text -> Int
677−length = coerce JSS.length
678−-- length t = S.length (stream t)
574+length t = S.length (stream t)
679{-# INLINE [0] length #-}
575{-# INLINE [0] length #-}
680-- length needs to be phased after the compareN/length rules otherwise
576-- length needs to be phased after the compareN/length rules otherwise
681-- it may inline before the rules have an opportunity to fire.
577-- it may inline before the rules have an opportunity to fire.
@@ -728,58 +624,29 @@ compareLength t n = S.compareLengthI (stream t) n
728-- -----------------------------------------------------------------------------
624-- -----------------------------------------------------------------------------
729-- * Transformations
625-- * Transformations
730-- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to
626-- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to
731−-- each element of @t@.
732−--
733−-- Example:
734−--
735−-- >>> let message = pack "I am not angry. Not at all."
736−-- >>> T.map (\c -> if c == '.' then '!' else c) message
737−-- "I am not angry! Not at all!"
738−--
739−-- Subject to fusion. Performs replacement on invalid scalar values.
627+-- each element of @t@. Subject to fusion. Performs replacement on
628+-- invalid scalar values.
740map :: (Char -> Char) -> Text -> Text
629map :: (Char -> Char) -> Text -> Text
741−map = coerce JSS.map
742−-- map f t = unstream (S.map (safe . f) (stream t))
630+map f t = unstream (S.map (safe . f) (stream t))
743{-# INLINE [1] map #-}
631{-# INLINE [1] map #-}
744
632
745-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of
633-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of
746-- 'Text's and concatenates the list after interspersing the first
634-- 'Text's and concatenates the list after interspersing the first
747-- argument between each element of the list.
635-- argument between each element of the list.
748−--
749−-- Example:
750−--
751−-- >>> T.intercalate "NI!" ["We", "seek", "the", "Holy", "Grail"]
752−-- "WeNI!seekNI!theNI!HolyNI!Grail"
753intercalate :: Text -> [Text] -> Text
636intercalate :: Text -> [Text] -> Text
754−intercalate = coerce JSS.intercalate
755−-- intercalate t = concat . (F.intersperse t)
637+intercalate t = concat . (F.intersperse t)
756{-# INLINE intercalate #-}
638{-# INLINE intercalate #-}
757
639
758-- | /O(n)/ The 'intersperse' function takes a character and places it
640-- | /O(n)/ The 'intersperse' function takes a character and places it
759−-- between the characters of a 'Text'.
641+-- between the characters of a 'Text'. Subject to fusion. Performs
760−--
761−-- Example:
762−--
763−-- >>> T.intersperse '.' "SHIELD"
764−-- "S.H.I.E.L.D"
765−--
766−-- Subject to fusion. Performs replacement on invalid scalar values.
642+-- replacement on invalid scalar values.
767intersperse :: Char -> Text -> Text
643intersperse :: Char -> Text -> Text
768−intersperse = coerce JSS.intersperse
769−-- intersperse c t = unstream (S.intersperse (safe c) (stream t))
644+intersperse c t = unstream (S.intersperse (safe c) (stream t))
770{-# INLINE intersperse #-}
645{-# INLINE intersperse #-}
771
646
772−-- | /O(n)/ Reverse the characters of a string.
647+-- | /O(n)/ Reverse the characters of a string. Subject to fusion.
773−--
774−-- Example:
775−--
776−-- >>> T.reverse "desrever"
777−-- "reversed"
778−--
779−-- Subject to fusion.
780reverse :: Text -> Text
648reverse :: Text -> Text
781−reverse = coerce JSS.reverse
782−-- reverse t = S.reverse (stream t)
649+reverse t = S.reverse (stream t)
783{-# INLINE reverse #-}
650{-# INLINE reverse #-}
784
651
785-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
652-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
@@ -796,14 +663,12 @@ reverse = coerce JSS.reverse
796-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
663-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
797-- be replaced recursively:
664-- be replaced recursively:
798--
665--
799−-- >>> replace "oo" "foo" "oo"
666+-- > replace "oo" "foo" "oo" == "foo"
800−-- "foo"
801--
667--
802-- In cases where several instances of @needle@ overlap, only the
668-- In cases where several instances of @needle@ overlap, only the
803-- first one will be replaced:
669-- first one will be replaced:
804--
670--
805−-- >>> replace "ofo" "bar" "ofofo"
671+-- > replace "ofo" "bar" "ofofo" == "barfo"
806−-- "barfo"
807--
672--
808-- In (unlikely) bad cases, this function's time complexity degrades
673-- In (unlikely) bad cases, this function's time complexity degrades
809-- towards /O(n*m)/.
674-- towards /O(n*m)/.
@@ -815,29 +680,28 @@ replace :: Text
815 -> Text
680 -> Text
816 -- ^ @haystack@ in which to search.
681 -- ^ @haystack@ in which to search.
817 -> Text
682 -> Text
818−replace = coerce JSS.replace
819−-- replace needle@(Text _ _ neeLen)
683+replace needle@(Text _ _ neeLen)
820−-- (Text repArr repOff repLen)
684+ (Text repArr repOff repLen)
821−-- haystack@(Text hayArr hayOff hayLen)
685+ haystack@(Text hayArr hayOff hayLen)
822−-- | neeLen == 0 = emptyError "replace"
686+ | neeLen == 0 = emptyError "replace"
823−-- | L.null ixs = haystack
687+ | L.null ixs = haystack
824−-- | len > 0 = Text (A.run x) 0 len
688+ | len > 0 = Text (A.run x) 0 len
825−-- | otherwise = empty
689+ | otherwise = empty
826−-- where
690+ where
827−-- ixs = indices needle haystack
691+ ixs = indices needle haystack
828−-- len = hayLen - (neeLen - repLen) `mul` L.length ixs
692+ len = hayLen - (neeLen - repLen) `mul` L.length ixs
829−-- x :: ST s (A.MArray s)
693+ x :: ST s (A.MArray s)
830−-- x = do
694+ x = do
831−-- marr <- A.new len
695+ marr <- A.new len
832−-- let loop (i:is) o d = do
696+ let loop (i:is) o d = do
833−-- let d0 = d + i - o
697+ let d0 = d + i - o
834−-- d1 = d0 + repLen
698+ d1 = d0 + repLen
835−-- A.copyI marr d hayArr (hayOff+o) d0
699+ A.copyI marr d hayArr (hayOff+o) d0
836−-- A.copyI marr d0 repArr repOff d1
700+ A.copyI marr d0 repArr repOff d1
837−-- loop is (i + neeLen) d1
701+ loop is (i + neeLen) d1
838−-- loop [] o d = A.copyI marr d hayArr (hayOff+o) len
702+ loop [] o d = A.copyI marr d hayArr (hayOff+o) len
839−-- loop ixs 0 0
703+ loop ixs 0 0
840−-- return marr
704+ return marr
841
705
842-- ----------------------------------------------------------------------------
706-- ----------------------------------------------------------------------------
843-- ** Case conversions (folds)
707-- ** Case conversions (folds)
@@ -876,8 +740,7 @@ replace = coerce JSS.replace
876-- U+00B5) is case folded to \"&#x3bc;\" (small letter mu, U+03BC)
740-- U+00B5) is case folded to \"&#x3bc;\" (small letter mu, U+03BC)
877-- instead of itself.
741-- instead of itself.
878toCaseFold :: Text -> Text
742toCaseFold :: Text -> Text
879−-- toCaseFold t = unstream (S.toCaseFold (stream t))
743+toCaseFold t = unstream (S.toCaseFold (stream t))
880−toCaseFold = coerce JSS.toCaseFold
881{-# INLINE toCaseFold #-}
744{-# INLINE toCaseFold #-}
882
745
883-- | /O(n)/ Convert a string to lower case, using simple case
746-- | /O(n)/ Convert a string to lower case, using simple case
@@ -888,8 +751,7 @@ toCaseFold = coerce JSS.toCaseFold
888-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)
751-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)
889-- followed by \" &#x307;\" (combining dot above, U+0307).
752-- followed by \" &#x307;\" (combining dot above, U+0307).
890toLower :: Text -> Text
753toLower :: Text -> Text
891−-- toLower t = unstream (S.toLower (stream t))
754+toLower t = unstream (S.toLower (stream t))
892−toLower = coerce JSS.toLower
893{-# INLINE toLower #-}
755{-# INLINE toLower #-}
894
756
895-- | /O(n)/ Convert a string to upper case, using simple case
757-- | /O(n)/ Convert a string to upper case, using simple case
@@ -899,8 +761,7 @@ toLower = coerce JSS.toLower
899-- instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the
761-- instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the
900-- two-letter sequence \"SS\".
762-- two-letter sequence \"SS\".
901toUpper :: Text -> Text
763toUpper :: Text -> Text
902−-- toUpper t = unstream (S.toUpper (stream t))
764+toUpper t = unstream (S.toUpper (stream t))
903−toUpper = coerce JSS.toUpper
904{-# INLINE toUpper #-}
765{-# INLINE toUpper #-}
905
766
906-- | /O(n)/ Convert a string to title case, using simple case
767-- | /O(n)/ Convert a string to title case, using simple case
@@ -921,11 +782,8 @@ toUpper = coerce JSS.toUpper
921-- guides disagree on whether the book name \"The Hill of the Red
782-- guides disagree on whether the book name \"The Hill of the Red
922-- Fox\" is correctly title cased&#x2014;but this function will
783-- Fox\" is correctly title cased&#x2014;but this function will
923-- capitalize /every/ word.
784-- capitalize /every/ word.
924−--
925−-- @since 1.0.0.0
926toTitle :: Text -> Text
785toTitle :: Text -> Text
927−toTitle = coerce JSS.toTitle
928−-- toTitle t = unstream (S.toTitle (stream t))
786+toTitle t = unstream (S.toTitle (stream t))
929{-# INLINE toTitle #-}
787{-# INLINE toTitle #-}
930
788
931-- | /O(n)/ Left-justify a string to the given length, using the
789-- | /O(n)/ Left-justify a string to the given length, using the
@@ -934,17 +792,13 @@ toTitle = coerce JSS.toTitle
934--
792--
935-- Examples:
793-- Examples:
936--
794--
937−-- >>> justifyLeft 7 'x' "foo"
795+-- > justifyLeft 7 'x' "foo" == "fooxxxx"
938−-- "fooxxxx"
939−--
940−-- >>> justifyLeft 3 'x' "foobar"
796+-- > justifyLeft 3 'x' "foobar" == "foobar"
941−-- "foobar"
942justifyLeft :: Int -> Char -> Text -> Text
797justifyLeft :: Int -> Char -> Text -> Text
943−justifyLeft = coerce JSS.justifyLeft
798+justifyLeft k c t
944−-- justifyLeft k c t
945−-- | len >= k = t
799+ | len >= k = t
946−-- | otherwise = t `append` replicateChar (k-len) c
800+ | otherwise = t `append` replicateChar (k-len) c
947−-- where len = length t
801+ where len = length t
948{-# INLINE [1] justifyLeft #-}
802{-# INLINE [1] justifyLeft #-}
949
803
950{-# RULES
804{-# RULES
@@ -960,17 +814,13 @@ justifyLeft = coerce JSS.justifyLeft
960--
814--
961-- Examples:
815-- Examples:
962--
816--
963−-- >>> justifyRight 7 'x' "bar"
817+-- > justifyRight 7 'x' "bar" == "xxxxbar"
964−-- "xxxxbar"
965−--
966−-- >>> justifyRight 3 'x' "foobar"
818+-- > justifyRight 3 'x' "foobar" == "foobar"
967−-- "foobar"
968justifyRight :: Int -> Char -> Text -> Text
819justifyRight :: Int -> Char -> Text -> Text
969−justifyRight = coerce JSS.justifyRight
820+justifyRight k c t
970−-- justifyRight k c t
971−-- | len >= k = t
821+ | len >= k = t
972−-- | otherwise = replicateChar (k-len) c `append` t
822+ | otherwise = replicateChar (k-len) c `append` t
973−-- where len = length t
823+ where len = length t
974{-# INLINE justifyRight #-}
824{-# INLINE justifyRight #-}
975
825
976-- | /O(n)/ Center a string to the given length, using the specified
826-- | /O(n)/ Center a string to the given length, using the specified
@@ -979,34 +829,23 @@ justifyRight = coerce JSS.justifyRight
979--
829--
980-- Examples:
830-- Examples:
981--
831--
982−-- >>> center 8 'x' "HS"
832+-- > center 8 'x' "HS" = "xxxHSxxx"
983−-- "xxxHSxxx"
984center :: Int -> Char -> Text -> Text
833center :: Int -> Char -> Text -> Text
985−center = coerce JSS.center
834+center k c t
986−-- center k c t
987−-- | len >= k = t
835+ | len >= k = t
988−-- | otherwise = replicateChar l c `append` t `append` replicateChar r c
836+ | otherwise = replicateChar l c `append` t `append` replicateChar r c
989−-- where len = length t
837+ where len = length t
990−-- d = k - len
838+ d = k - len
991−-- r = d `quot` 2
839+ r = d `quot` 2
992−-- l = d - r
840+ l = d - r
993{-# INLINE center #-}
841{-# INLINE center #-}
994
842
995-- | /O(n)/ The 'transpose' function transposes the rows and columns
843-- | /O(n)/ The 'transpose' function transposes the rows and columns
996-- of its 'Text' argument. Note that this function uses 'pack',
844-- of its 'Text' argument. Note that this function uses 'pack',
997-- 'unpack', and the list version of transpose, and is thus not very
845-- 'unpack', and the list version of transpose, and is thus not very
998-- efficient.
846-- efficient.
999−--
1000−-- Examples:
1001−--
1002−-- >>> transpose ["green","orange"]
1003−-- ["go","rr","ea","en","ng","e"]
1004−--
1005−-- >>> transpose ["blue","red"]
1006−-- ["br","le","ud","e"]
1007transpose :: [Text] -> [Text]
847transpose :: [Text] -> [Text]
1008−transpose = coerce JSS.transpose
1009−-- transpose ts = P.map pack (L.transpose (P.map unpack ts))
848+transpose ts = P.map pack (L.transpose (P.map unpack ts))
1010
849
1011-- -----------------------------------------------------------------------------
850-- -----------------------------------------------------------------------------
1012-- * Reducing 'Text's (folds)
851-- * Reducing 'Text's (folds)
@@ -1016,27 +855,23 @@ transpose = coerce JSS.transpose
1016-- reduces the 'Text' using the binary operator, from left to right.
855-- reduces the 'Text' using the binary operator, from left to right.
1017-- Subject to fusion.
856-- Subject to fusion.
1018foldl :: (a -> Char -> a) -> a -> Text -> a
857foldl :: (a -> Char -> a) -> a -> Text -> a
1019−foldl f a0 (Text t) = JSS.foldl f a0 t
1020−-- foldl f z t = S.foldl f z (stream t)
858+foldl f z t = S.foldl f z (stream t)
1021{-# INLINE foldl #-}
859{-# INLINE foldl #-}
1022
860
1023-- | /O(n)/ A strict version of 'foldl'. Subject to fusion.
861-- | /O(n)/ A strict version of 'foldl'. Subject to fusion.
1024foldl' :: (a -> Char -> a) -> a -> Text -> a
862foldl' :: (a -> Char -> a) -> a -> Text -> a
1025−foldl' f a0 (Text t) = JSS.foldl' f a0 t
1026−-- foldl' f z t = S.foldl' f z (stream t)
863+foldl' f z t = S.foldl' f z (stream t)
1027{-# INLINE foldl' #-}
864{-# INLINE foldl' #-}
1028
865
1029-- | /O(n)/ A variant of 'foldl' that has no starting value argument,
866-- | /O(n)/ A variant of 'foldl' that has no starting value argument,
1030-- and thus must be applied to a non-empty 'Text'. Subject to fusion.
867-- and thus must be applied to a non-empty 'Text'. Subject to fusion.
1031foldl1 :: (Char -> Char -> Char) -> Text -> Char
868foldl1 :: (Char -> Char -> Char) -> Text -> Char
1032−foldl1 = coerce JSS.foldl1
1033−-- foldl1 f t = S.foldl1 f (stream t)
869+foldl1 f t = S.foldl1 f (stream t)
1034{-# INLINE foldl1 #-}
870{-# INLINE foldl1 #-}
1035
871
1036-- | /O(n)/ A strict version of 'foldl1'. Subject to fusion.
872-- | /O(n)/ A strict version of 'foldl1'. Subject to fusion.
1037foldl1' :: (Char -> Char -> Char) -> Text -> Char
873foldl1' :: (Char -> Char -> Char) -> Text -> Char
1038−foldl1' = coerce JSS.foldl1'
1039−-- foldl1' f t = S.foldl1' f (stream t)
874+foldl1' f t = S.foldl1' f (stream t)
1040{-# INLINE foldl1' #-}
875{-# INLINE foldl1' #-}
1041
876
1042-- | /O(n)/ 'foldr', applied to a binary operator, a starting value
877-- | /O(n)/ 'foldr', applied to a binary operator, a starting value
@@ -1044,16 +879,14 @@ foldl1' = coerce JSS.foldl1'
1044-- reduces the 'Text' using the binary operator, from right to left.
879-- reduces the 'Text' using the binary operator, from right to left.
1045-- Subject to fusion.
880-- Subject to fusion.
1046foldr :: (Char -> a -> a) -> a -> Text -> a
881foldr :: (Char -> a -> a) -> a -> Text -> a
1047−foldr f a0 (Text t) = JSS.foldr f a0 t
1048−-- foldr f z t = S.foldr f z (stream t)
882+foldr f z t = S.foldr f z (stream t)
1049{-# INLINE foldr #-}
883{-# INLINE foldr #-}
1050
884
1051-- | /O(n)/ A variant of 'foldr' that has no starting value argument,
885-- | /O(n)/ A variant of 'foldr' that has no starting value argument,
1052-- and thus must be applied to a non-empty 'Text'. Subject to
886-- and thus must be applied to a non-empty 'Text'. Subject to
1053-- fusion.
887-- fusion.
1054foldr1 :: (Char -> Char -> Char) -> Text -> Char
888foldr1 :: (Char -> Char -> Char) -> Text -> Char
1055−foldr1 = coerce JSS.foldr1
1056−-- foldr1 f t = S.foldr1 f (stream t)
889+foldr1 f t = S.foldr1 f (stream t)
1057{-# INLINE foldr1 #-}
890{-# INLINE foldr1 #-}
1058
891
1059-- -----------------------------------------------------------------------------
892-- -----------------------------------------------------------------------------
@@ -1061,54 +894,48 @@ foldr1 = coerce JSS.foldr1
1061
894
1062-- | /O(n)/ Concatenate a list of 'Text's.
895-- | /O(n)/ Concatenate a list of 'Text's.
1063concat :: [Text] -> Text
896concat :: [Text] -> Text
1064−concat = coerce JSS.concat
1065−-- concat ts = case ts' of
897+concat ts = case ts' of
1066−-- [] -> empty
898+ [] -> empty
1067−-- [t] -> t
899+ [t] -> t
1068−-- _ -> Text (A.run go) 0 len
900+ _ -> Text (A.run go) 0 len
1069−-- where
901+ where
1070−-- ts' = L.filter (not . null) ts
902+ ts' = L.filter (not . null) ts
1071−-- len = sumP "concat" $ L.map lengthWord16 ts'
903+ len = sumP "concat" $ L.map lengthWord16 ts'
1072−-- go :: ST s (A.MArray s)
904+ go :: ST s (A.MArray s)
1073−-- go = do
905+ go = do
1074−-- arr <- A.new len
906+ arr <- A.new len
1075−-- let step i (Text a o l) =
907+ let step i (Text a o l) =
1076−-- let !j = i + l in A.copyI arr i a o j >> return j
908+ let !j = i + l in A.copyI arr i a o j >> return j
1077−-- foldM step 0 ts' >> return arr
909+ foldM step 0 ts' >> return arr
1078
910
1079-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and
911-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and
1080-- concatenate the results.
912-- concatenate the results.
1081concatMap :: (Char -> Text) -> Text -> Text
913concatMap :: (Char -> Text) -> Text -> Text
1082−concatMap = coerce JSS.concatMap
1083−-- concatMap f = concat . foldr ((:) . f) []
914+concatMap f = concat . foldr ((:) . f) []
1084{-# INLINE concatMap #-}
915{-# INLINE concatMap #-}
1085
916
1086-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
917-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
1087-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
918-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
1088any :: (Char -> Bool) -> Text -> Bool
919any :: (Char -> Bool) -> Text -> Bool
1089−any = coerce JSS.any
1090−-- any p t = S.any p (stream t)
920+any p t = S.any p (stream t)
1091{-# INLINE any #-}
921{-# INLINE any #-}
1092
922
1093-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
923-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
1094-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
924-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
1095all :: (Char -> Bool) -> Text -> Bool
925all :: (Char -> Bool) -> Text -> Bool
1096−all = coerce JSS.all
1097−-- all p t = S.all p (stream t)
926+all p t = S.all p (stream t)
1098{-# INLINE all #-}
927{-# INLINE all #-}
1099
928
1100-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which
929-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which
1101-- must be non-empty. Subject to fusion.
930-- must be non-empty. Subject to fusion.
1102maximum :: Text -> Char
931maximum :: Text -> Char
1103−maximum = coerce JSS.maximum
1104−-- maximum t = S.maximum (stream t)
932+maximum t = S.maximum (stream t)
1105{-# INLINE maximum #-}
933{-# INLINE maximum #-}
1106
934
1107-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which
935-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which
1108-- must be non-empty. Subject to fusion.
936-- must be non-empty. Subject to fusion.
1109minimum :: Text -> Char
937minimum :: Text -> Char
1110−minimum = coerce JSS.minimum
1111−-- minimum t = S.minimum (stream t)
938+minimum t = S.minimum (stream t)
1112{-# INLINE minimum #-}
939{-# INLINE minimum #-}
1113
940
1114-- -----------------------------------------------------------------------------
941-- -----------------------------------------------------------------------------
@@ -1124,9 +951,8 @@ minimum = coerce JSS.minimum
1124--
951--
1125-- > last (scanl f z xs) == foldl f z xs.
952-- > last (scanl f z xs) == foldl f z xs.
1126scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
953scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
1127−scanl = coerce JSS.scanl
1128−-- scanl f z t = unstream (S.scanl g z (stream t))
954+scanl f z t = unstream (S.scanl g z (stream t))
1129−-- where g a b = safe (f a b)
955+ where g a b = safe (f a b)
1130{-# INLINE scanl #-}
956{-# INLINE scanl #-}
1131
957
1132-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting
958-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting
@@ -1135,9 +961,8 @@ scanl = coerce JSS.scanl
1135--
961--
1136-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
962-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
1137scanl1 :: (Char -> Char -> Char) -> Text -> Text
963scanl1 :: (Char -> Char -> Char) -> Text -> Text
1138−scanl1 = coerce JSS.scanl1
1139−-- scanl1 f t | null t = empty
964+scanl1 f t | null t = empty
1140−-- | otherwise = scanl f (unsafeHead t) (unsafeTail t)
965+ | otherwise = scanl f (unsafeHead t) (unsafeTail t)
1141{-# INLINE scanl1 #-}
966{-# INLINE scanl1 #-}
1142
967
1143-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'. Performs
968-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'. Performs
@@ -1145,18 +970,16 @@ scanl1 = coerce JSS.scanl1
1145--
970--
1146-- > scanr f v == reverse . scanl (flip f) v . reverse
971-- > scanr f v == reverse . scanl (flip f) v . reverse
1147scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
972scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
1148−scanr = coerce JSS.scanr
1149−-- scanr f z = S.reverse . S.reverseScanr g z . reverseStream
973+scanr f z = S.reverse . S.reverseScanr g z . reverseStream
1150−-- where g a b = safe (f a b)
974+ where g a b = safe (f a b)
1151{-# INLINE scanr #-}
975{-# INLINE scanr #-}
1152
976
1153-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting
977-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting
1154-- value argument. Subject to fusion. Performs replacement on
978-- value argument. Subject to fusion. Performs replacement on
1155-- invalid scalar values.
979-- invalid scalar values.
1156scanr1 :: (Char -> Char -> Char) -> Text -> Text
980scanr1 :: (Char -> Char -> Char) -> Text -> Text
1157−scanr1 = coerce JSS.scanr1
1158−-- scanr1 f t | null t = empty
981+scanr1 f t | null t = empty
1159−-- | otherwise = scanr f (last t) (init t)
982+ | otherwise = scanr f (last t) (init t)
1160{-# INLINE scanr1 #-}
983{-# INLINE scanr1 #-}
1161
984
1162-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
985-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
@@ -1164,11 +987,8 @@ scanr1 = coerce JSS.scanr1
1164-- parameter from left to right, and returns a final 'Text'. Performs
987-- parameter from left to right, and returns a final 'Text'. Performs
1165-- replacement on invalid scalar values.
988-- replacement on invalid scalar values.
1166mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
989mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
1167−mapAccumL f z0 (Text a) =
1168− let (a', t) = JSS.mapAccumL f z0 a
1169− in (a', Text t)
1170−-- mapAccumL f z0 = S.mapAccumL g z0 . stream
990+mapAccumL f z0 = S.mapAccumL g z0 . stream
1171−-- where g a b = second safe (f a b)
991+ where g a b = second safe (f a b)
1172{-# INLINE mapAccumL #-}
992{-# INLINE mapAccumL #-}
1173
993
1174-- | The 'mapAccumR' function behaves like a combination of 'map' and
994-- | The 'mapAccumR' function behaves like a combination of 'map' and
@@ -1178,11 +998,8 @@ mapAccumL f z0 (Text a) =
1178-- 'Text'.
998-- 'Text'.
1179-- Performs replacement on invalid scalar values.
999-- Performs replacement on invalid scalar values.
1180mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
1000mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
1181−mapAccumR f z0 (Text a) =
1182− let (a', t) = JSS.mapAccumR f z0 a
1183− in (a', Text t)
1184−-- mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream
1001+mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream
1185−-- where g a b = second safe (f a b)
1002+ where g a b = second safe (f a b)
1186{-# INLINE mapAccumR #-}
1003{-# INLINE mapAccumR #-}
1187
1004
1188-- -----------------------------------------------------------------------------
1005-- -----------------------------------------------------------------------------
@@ -1191,21 +1008,20 @@ mapAccumR f z0 (Text a) =
1191-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
1008-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
1192-- @t@ repeated @n@ times.
1009-- @t@ repeated @n@ times.
1193replicate :: Int -> Text -> Text
1010replicate :: Int -> Text -> Text
1194−replicate = coerce JSS.replicate
1195−-- replicate n t@(Text a o l)
1011+replicate n t@(Text a o l)
1196−-- | n <= 0 || l <= 0 = empty
1012+ | n <= 0 || l <= 0 = empty
1197−-- | n == 1 = t
1013+ | n == 1 = t
1198−-- | isSingleton t = replicateChar n (unsafeHead t)
1014+ | isSingleton t = replicateChar n (unsafeHead t)
1199−-- | otherwise = Text (A.run x) 0 len
1015+ | otherwise = Text (A.run x) 0 len
1200−-- where
1016+ where
1201−-- len = l `mul` n
1017+ len = l `mul` n
1202−-- x :: ST s (A.MArray s)
1018+ x :: ST s (A.MArray s)
1203−-- x = do
1019+ x = do
1204−-- arr <- A.new len
1020+ arr <- A.new len
1205−-- let loop !d !i | i >= n = return arr
1021+ let loop !d !i | i >= n = return arr
1206−-- | otherwise = let m = d + l
1022+ | otherwise = let m = d + l
1207−-- in A.copyI arr d a o m >> loop m (i+1)
1023+ in A.copyI arr d a o m >> loop m (i+1)
1208−-- loop 0 0
1024+ loop 0 0
1209{-# INLINE [1] replicate #-}
1025{-# INLINE [1] replicate #-}
1210
1026
1211{-# RULES
1027{-# RULES
@@ -1216,19 +1032,8 @@ replicate = coerce JSS.replicate
1216-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
1032-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
1217-- value of every element. Subject to fusion.
1033-- value of every element. Subject to fusion.
1218replicateChar :: Int -> Char -> Text
1034replicateChar :: Int -> Char -> Text
1219−#ifndef __GHCJS__
1220replicateChar n c = unstream (S.replicateCharI n (safe c))
1035replicateChar n c = unstream (S.replicateCharI n (safe c))
1221{-# INLINE replicateChar #-}
1036{-# INLINE replicateChar #-}
1222−#else
1223−replicateChar n c = Text $ js_replicateChar n c
1224−{-# INLINE [1] replicateChar #-}
1225−{-# RULES
1226−"JSSTRING replicateChar -> fused" [~1] forall n c.
1227− replicateChar n c = unstream (S.replicateCharI n (safe c))
1228−"JSSTRING replicateChar -> unfused" [1] forall n c.
1229− unstream (S.replicateCharI n (safe c)) = replicateChar n c
1230− #-}
1231−#endif
1232
1037
1233-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'
1038-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'
1234-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a
1039-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a
@@ -1238,8 +1043,7 @@ replicateChar n c = Text $ js_replicateChar n c
1238-- string, and @b@ is the seed value for further production. Subject
1043-- string, and @b@ is the seed value for further production. Subject
1239-- to fusion. Performs replacement on invalid scalar values.
1044-- to fusion. Performs replacement on invalid scalar values.
1240unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
1045unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
1241−unfoldr f a = Text $ JSS.unfoldr f a
1242−-- unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
1046+unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
1243{-# INLINE unfoldr #-}
1047{-# INLINE unfoldr #-}
1244
1048
1245-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed
1049-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed
@@ -1249,8 +1053,7 @@ unfoldr f a = Text $ JSS.unfoldr f a
1249-- correct, otherwise its performance is similar to 'unfoldr'. Subject
1053-- correct, otherwise its performance is similar to 'unfoldr'. Subject
1250-- to fusion. Performs replacement on invalid scalar values.
1054-- to fusion. Performs replacement on invalid scalar values.
1251unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text
1055unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text
1252−unfoldrN n f a0 = Text $ JSS.unfoldrN n f a0
1253−-- unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)
1056+unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)
1254{-# INLINE unfoldrN #-}
1057{-# INLINE unfoldrN #-}
1255
1058
1256-- -----------------------------------------------------------------------------
1059-- -----------------------------------------------------------------------------
@@ -1260,19 +1063,18 @@ unfoldrN n f a0 = Text $ JSS.unfoldrN n f a0
1260-- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than
1063-- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than
1261-- the length of the Text. Subject to fusion.
1064-- the length of the Text. Subject to fusion.
1262take :: Int -> Text -> Text
1065take :: Int -> Text -> Text
1263−take = coerce JSS.take
1264−-- take n t@(Text arr off len)
1066+take n t@(Text arr off len)
1265−-- | n <= 0 = empty
1067+ | n <= 0 = empty
1266−-- | n >= len = t
1068+ | n >= len = t
1267−-- | otherwise = text arr off (iterN n t)
1069+ | otherwise = text arr off (iterN n t)
1268{-# INLINE [1] take #-}
1070{-# INLINE [1] take #-}
1269
1071
1270−-- iterN :: Int -> Text -> Int
1072+iterN :: Int -> Text -> Int
1271−-- iterN n t@(Text _arr _off len) = loop 0 0
1073+iterN n t@(Text _arr _off len) = loop 0 0
1272−-- where loop !i !cnt
1074+ where loop !i !cnt
1273−-- | i >= len || cnt >= n = i
1075+ | i >= len || cnt >= n = i
1274−-- | otherwise = loop (i+d) (cnt+1)
1076+ | otherwise = loop (i+d) (cnt+1)
1275−-- where d = iter_ t i
1077+ where d = iter_ t i
1276
1078
1277{-# RULES
1079{-# RULES
1278"TEXT take -> fused" [~1] forall n t.
1080"TEXT take -> fused" [~1] forall n t.
@@ -1286,36 +1088,31 @@ take = coerce JSS.take
1286--
1088--
1287-- Examples:
1089-- Examples:
1288--
1090--
1289−-- >>> takeEnd 3 "foobar"
1091+-- > takeEnd 3 "foobar" == "bar"
1290−-- "bar"
1291−--
1292−-- @since 1.1.1.0
1293takeEnd :: Int -> Text -> Text
1092takeEnd :: Int -> Text -> Text
1294−takeEnd = coerce JSS.takeEnd
1295−-- takeEnd n t@(Text arr off len)
1093+takeEnd n t@(Text arr off len)
1296−-- | n <= 0 = empty
1094+ | n <= 0 = empty
1297−-- | n >= len = t
1095+ | n >= len = t
1298−-- | otherwise = text arr (off+i) (len-i)
1096+ | otherwise = text arr (off+i) (len-i)
1299−-- where i = iterNEnd n t
1097+ where i = iterNEnd n t
1300−
1098+
1301−-- iterNEnd :: Int -> Text -> Int
1099+iterNEnd :: Int -> Text -> Int
1302−-- iterNEnd n t@(Text _arr _off len) = loop (len-1) n
1100+iterNEnd n t@(Text _arr _off len) = loop (len-1) n
1303−-- where loop i !m
1101+ where loop i !m
1304−-- | i <= 0 = 0
1102+ | i <= 0 = 0
1305−-- | m <= 1 = i
1103+ | m <= 1 = i
1306−-- | otherwise = loop (i+d) (m-1)
1104+ | otherwise = loop (i+d) (m-1)
1307−-- where d = reverseIter_ t i
1105+ where d = reverseIter_ t i
1308
1106
1309-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1107-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1310-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1108-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1311-- is greater than the length of the 'Text'. Subject to fusion.
1109-- is greater than the length of the 'Text'. Subject to fusion.
1312drop :: Int -> Text -> Text
1110drop :: Int -> Text -> Text
1313−drop = coerce JSS.drop
1314−-- drop n t@(Text arr off len)
1111+drop n t@(Text arr off len)
1315−-- | n <= 0 = t
1112+ | n <= 0 = t
1316−-- | n >= len = empty
1113+ | n >= len = empty
1317−-- | otherwise = text arr (off+i) (len-i)
1114+ | otherwise = text arr (off+i) (len-i)
1318−-- where i = iterN n t
1115+ where i = iterN n t
1319{-# INLINE [1] drop #-}
1116{-# INLINE [1] drop #-}
1320
1117
1321{-# RULES
1118{-# RULES
@@ -1330,27 +1127,22 @@ drop = coerce JSS.drop
1330--
1127--
1331-- Examples:
1128-- Examples:
1332--
1129--
1333−-- >>> dropEnd 3 "foobar"
1130+-- > dropEnd 3 "foobar" == "foo"
1334−-- "foo"
1335−--
1336−-- @since 1.1.1.0
1337dropEnd :: Int -> Text -> Text
1131dropEnd :: Int -> Text -> Text
1338−dropEnd = coerce JSS.dropEnd
1339−-- dropEnd n t@(Text arr off len)
1132+dropEnd n t@(Text arr off len)
1340−-- | n <= 0 = t
1133+ | n <= 0 = t
1341−-- | n >= len = empty
1134+ | n >= len = empty
1342−-- | otherwise = text arr off (iterNEnd n t)
1135+ | otherwise = text arr off (iterNEnd n t)
1343
1136
1344-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1137-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1345-- returns the longest prefix (possibly empty) of elements that
1138-- returns the longest prefix (possibly empty) of elements that
1346-- satisfy @p@. Subject to fusion.
1139-- satisfy @p@. Subject to fusion.
1347takeWhile :: (Char -> Bool) -> Text -> Text
1140takeWhile :: (Char -> Bool) -> Text -> Text
1348−takeWhile = coerce JSS.takeWhile
1349−-- takeWhile p t@(Text arr off len) = loop 0
1141+takeWhile p t@(Text arr off len) = loop 0
1350−-- where loop !i | i >= len = t
1142+ where loop !i | i >= len = t
1351−-- | p c = loop (i+d)
1143+ | p c = loop (i+d)
1352−-- | otherwise = text arr off i
1144+ | otherwise = text arr off i
1353−-- where Iter c d = iter t i
1145+ where Iter c d = iter t i
1354{-# INLINE [1] takeWhile #-}
1146{-# INLINE [1] takeWhile #-}
1355
1147
1356{-# RULES
1148{-# RULES
@@ -1365,25 +1157,13 @@ takeWhile = coerce JSS.takeWhile
1365-- satisfy @p@. Subject to fusion.
1157-- satisfy @p@. Subject to fusion.
1366-- Examples:
1158-- Examples:
1367--
1159--
1368−-- >>> takeWhileEnd (=='o') "foo"
1160+-- > takeWhileEnd (=='o') "foo" == "oo"
1369−-- "oo"
1370−--
1371−-- @since 1.2.2.0
1372takeWhileEnd :: (Char -> Bool) -> Text -> Text
1161takeWhileEnd :: (Char -> Bool) -> Text -> Text
1373−#ifndef __GHCJS__
1374takeWhileEnd p t@(Text arr off len) = loop (len-1) len
1162takeWhileEnd p t@(Text arr off len) = loop (len-1) len
1375 where loop !i !l | l <= 0 = t
1163 where loop !i !l | l <= 0 = t
1376 | p c = loop (i+d) (l+d)
1164 | p c = loop (i+d) (l+d)
1377 | otherwise = text arr (off+l) (len-l)
1165 | otherwise = text arr (off+l) (len-l)
1378 where (c,d) = reverseIter t i
1166 where (c,d) = reverseIter t i
1379−#else
1380−takeWhileEnd p t@(Text jst) = loop (len-1) len
1381− where loop !i !l | l <= 0 = t
1382− | p c = loop (i+d) (l+d)
1383− | otherwise = Text $ js_substr1 l jst
1384− where (c,d) = reverseIter t i
1385− len = length t
1386−#endif
1387{-# INLINE [1] takeWhileEnd #-}
1167{-# INLINE [1] takeWhileEnd #-}
1388
1168
1389{-# RULES
1169{-# RULES
@@ -1396,12 +1176,11 @@ takeWhileEnd p t@(Text jst) = loop (len-1) len
1396-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1176-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1397-- 'takeWhile' @p@ @t@. Subject to fusion.
1177-- 'takeWhile' @p@ @t@. Subject to fusion.
1398dropWhile :: (Char -> Bool) -> Text -> Text
1178dropWhile :: (Char -> Bool) -> Text -> Text
1399−dropWhile = coerce JSS.dropWhile
1400−-- dropWhile p t@(Text arr off len) = loop 0 0
1179+dropWhile p t@(Text arr off len) = loop 0 0
1401−-- where loop !i !l | l >= len = empty
1180+ where loop !i !l | l >= len = empty
1402−-- | p c = loop (i+d) (l+d)
1181+ | p c = loop (i+d) (l+d)
1403−-- | otherwise = Text arr (off+i) (len-l)
1182+ | otherwise = Text arr (off+i) (len-l)
1404−
1183+ where Iter c d = iter t i
1405{-# INLINE [1] dropWhile #-}
1184{-# INLINE [1] dropWhile #-}
1406
1185
1407{-# RULES
1186{-# RULES
@@ -1417,15 +1196,13 @@ dropWhile = coerce JSS.dropWhile
1417--
1196--
1418-- Examples:
1197-- Examples:
1419--
1198--
1420−-- >>> dropWhileEnd (=='.') "foo..."
1199+-- > dropWhileEnd (=='.') "foo..." == "foo"
1421−-- "foo"
1422dropWhileEnd :: (Char -> Bool) -> Text -> Text
1200dropWhileEnd :: (Char -> Bool) -> Text -> Text
1423−dropWhileEnd = coerce JSS.dropWhileEnd
1424−-- dropWhileEnd p t@(Text arr off len) = loop (len-1) len
1201+dropWhileEnd p t@(Text arr off len) = loop (len-1) len
1425−-- where loop !i !l | l <= 0 = empty
1202+ where loop !i !l | l <= 0 = empty
1426−-- | p c = loop (i+d) (l+d)
1203+ | p c = loop (i+d) (l+d)
1427−-- | otherwise = Text arr off l
1204+ | otherwise = Text arr off l
1428−-- where (c,d) = reverseIter t i
1205+ where (c,d) = reverseIter t i
1429{-# INLINE [1] dropWhileEnd #-}
1206{-# INLINE [1] dropWhileEnd #-}
1430
1207
1431{-# RULES
1208{-# RULES
@@ -1468,49 +1245,45 @@ strip = dropAround isSpace
1468-- prefix of @t@ of length @n@, and whose second is the remainder of
1245-- prefix of @t@ of length @n@, and whose second is the remainder of
1469-- the string. It is equivalent to @('take' n t, 'drop' n t)@.
1246-- the string. It is equivalent to @('take' n t, 'drop' n t)@.
1470splitAt :: Int -> Text -> (Text, Text)
1247splitAt :: Int -> Text -> (Text, Text)
1471−splitAt = coerce JSS.splitAt
1472−-- splitAt n t@(Text arr off len)
1248+splitAt n t@(Text arr off len)
1473−-- | n <= 0 = (empty, t)
1249+ | n <= 0 = (empty, t)
1474−-- | n >= len = (t, empty)
1250+ | n >= len = (t, empty)
1475−-- | otherwise = let k = iterN n t
1251+ | otherwise = let k = iterN n t
1476−-- in (text arr off k, text arr (off+k) (len-k))
1252+ in (text arr off k, text arr (off+k) (len-k))
1477
1253
1478-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
1254-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
1479-- a pair whose first element is the longest prefix (possibly empty)
1255-- a pair whose first element is the longest prefix (possibly empty)
1480-- of @t@ of elements that satisfy @p@, and whose second is the
1256-- of @t@ of elements that satisfy @p@, and whose second is the
1481-- remainder of the list.
1257-- remainder of the list.
1482span :: (Char -> Bool) -> Text -> (Text, Text)
1258span :: (Char -> Bool) -> Text -> (Text, Text)
1483−span = coerce JSS.span
1484−-- span p t = case span_ p t of
1259+span p t = case span_ p t of
1485−-- (# hd,tl #) -> (hd,tl)
1260+ (# hd,tl #) -> (hd,tl)
1486{-# INLINE span #-}
1261{-# INLINE span #-}
1487
1262
1488-- | /O(n)/ 'break' is like 'span', but the prefix returned is
1263-- | /O(n)/ 'break' is like 'span', but the prefix returned is
1489-- over elements that fail the predicate @p@.
1264-- over elements that fail the predicate @p@.
1490break :: (Char -> Bool) -> Text -> (Text, Text)
1265break :: (Char -> Bool) -> Text -> (Text, Text)
1491−break = coerce JSS.break
1492−-- break p = span (not . p)
1266+break p = span (not . p)
1493{-# INLINE break #-}
1267{-# INLINE break #-}
1494
1268
1495-- | /O(n)/ Group characters in a string according to a predicate.
1269-- | /O(n)/ Group characters in a string according to a predicate.
1496groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
1270groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
1497−groupBy = coerce JSS.groupBy
1498−-- groupBy p = loop
1271+groupBy p = loop
1499−-- where
1272+ where
1500−-- loop t@(Text arr off len)
1273+ loop t@(Text arr off len)
1501−-- | null t = []
1274+ | null t = []
1502−-- | otherwise = text arr off n : loop (text arr (off+n) (len-n))
1275+ | otherwise = text arr off n : loop (text arr (off+n) (len-n))
1503−-- where Iter c d = iter t 0
1276+ where Iter c d = iter t 0
1504−-- n = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))
1277+ n = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))
1505
1278
1506-- | Returns the /array/ index (in units of 'Word16') at which a
1279-- | Returns the /array/ index (in units of 'Word16') at which a
1507-- character may be found. This is /not/ the same as the logical
1280-- character may be found. This is /not/ the same as the logical
1508-- index returned by e.g. 'findIndex'.
1281-- index returned by e.g. 'findIndex'.
1509−-- findAIndexOrEnd :: (Char -> Bool) -> Text -> Int
1282+findAIndexOrEnd :: (Char -> Bool) -> Text -> Int
1510−-- findAIndexOrEnd q t@(Text _arr _off len) = go 0
1283+findAIndexOrEnd q t@(Text _arr _off len) = go 0
1511−-- where go !i | i >= len || q c = i
1284+ where go !i | i >= len || q c = i
1512−-- | otherwise = go (i+d)
1285+ | otherwise = go (i+d)
1513−-- where Iter c d = iter t i
1286+ where Iter c d = iter t i
1514
1287
1515-- | /O(n)/ Group characters in a string by equality.
1288-- | /O(n)/ Group characters in a string by equality.
1516group :: Text -> [Text]
1289group :: Text -> [Text]
@@ -1519,17 +1292,15 @@ group = groupBy (==)
1519-- | /O(n)/ Return all initial segments of the given 'Text', shortest
1292-- | /O(n)/ Return all initial segments of the given 'Text', shortest
1520-- first.
1293-- first.
1521inits :: Text -> [Text]
1294inits :: Text -> [Text]
1522−inits = coerce JSS.inits
1523−-- inits t@(Text arr off len) = loop 0
1295+inits t@(Text arr off len) = loop 0
1524−-- where loop i | i >= len = [t]
1296+ where loop i | i >= len = [t]
1525−-- | otherwise = Text arr off i : loop (i + iter_ t i)
1297+ | otherwise = Text arr off i : loop (i + iter_ t i)
1526
1298
1527-- | /O(n)/ Return all final segments of the given 'Text', longest
1299-- | /O(n)/ Return all final segments of the given 'Text', longest
1528-- first.
1300-- first.
1529tails :: Text -> [Text]
1301tails :: Text -> [Text]
1530−tails = coerce JSS.tails
1531−-- tails t | null t = [empty]
1302+tails t | null t = [empty]
1532−-- | otherwise = t : tails (unsafeTail t)
1303+ | otherwise = t : tails (unsafeTail t)
1533
1304
1534-- $split
1305-- $split
1535--
1306--
@@ -1543,14 +1314,9 @@ tails = coerce JSS.tails
1543--
1314--
1544-- Examples:
1315-- Examples:
1545--
1316--
1546−-- >>> splitOn "\r\n" "a\r\nb\r\nd\r\ne"
1317+-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]
1547−-- ["a","b","d","e"]
1548−--
1549−-- >>> splitOn "aaa" "aaaXaaaXaaaXaaa"
1318+-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]
1550−-- ["","X","X","X",""]
1551−--
1552−-- >>> splitOn "x" "x"
1319+-- > splitOn "x" "x" == ["",""]
1553−-- ["",""]
1554--
1320--
1555-- and
1321-- and
1556--
1322--
@@ -1567,14 +1333,13 @@ splitOn :: Text
1567 -> Text
1333 -> Text
1568 -- ^ Input text.
1334 -- ^ Input text.
1569 -> [Text]
1335 -> [Text]
1570−splitOn = coerce JSS.splitOn
1571−-- splitOn pat@(Text _ _ l) src@(Text arr off len)
1336+splitOn pat@(Text _ _ l) src@(Text arr off len)
1572−-- | l <= 0 = emptyError "splitOn"
1337+ | l <= 0 = emptyError "splitOn"
1573−-- | isSingleton pat = split (== unsafeHead pat) src
1338+ | isSingleton pat = split (== unsafeHead pat) src
1574−-- | otherwise = go 0 (indices pat src)
1339+ | otherwise = go 0 (indices pat src)
1575−-- where
1340+ where
1576−-- go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs
1341+ go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs
1577−-- go s _ = [text arr (s+off) (len-s)]
1342+ go s _ = [text arr (s+off) (len-s)]
1578{-# INLINE [1] splitOn #-}
1343{-# INLINE [1] splitOn #-}
1579
1344
1580{-# RULES
1345{-# RULES
@@ -1587,36 +1352,28 @@ splitOn = coerce JSS.splitOn
1587-- resulting components do not contain the separators. Two adjacent
1352-- resulting components do not contain the separators. Two adjacent
1588-- separators result in an empty component in the output. eg.
1353-- separators result in an empty component in the output. eg.
1589--
1354--
1590−-- >>> split (=='a') "aabbaca"
1355+-- > split (=='a') "aabbaca" == ["","","bb","c",""]
1591−-- ["","","bb","c",""]
1592−--
1593−-- >>> split (=='a') ""
1356+-- > split (=='a') "" == [""]
1594−-- [""]
1595split :: (Char -> Bool) -> Text -> [Text]
1357split :: (Char -> Bool) -> Text -> [Text]
1596−split = coerce JSS.split
1597−-- split _ t@(Text _off _arr 0) = [t]
1358+split _ t@(Text _off _arr 0) = [t]
1598−-- split p t = loop t
1359+split p t = loop t
1599−-- where loop s | null s' = [l]
1360+ where loop s | null s' = [l]
1600−-- | otherwise = l : loop (unsafeTail s')
1361+ | otherwise = l : loop (unsafeTail s')
1601−-- where (# l, s' #) = span_ (not . p) s
1362+ where (# l, s' #) = span_ (not . p) s
1602{-# INLINE split #-}
1363{-# INLINE split #-}
1603
1364
1604-- | /O(n)/ Splits a 'Text' into components of length @k@. The last
1365-- | /O(n)/ Splits a 'Text' into components of length @k@. The last
1605-- element may be shorter than the other chunks, depending on the
1366-- element may be shorter than the other chunks, depending on the
1606-- length of the input. Examples:
1367-- length of the input. Examples:
1607--
1368--
1608−-- >>> chunksOf 3 "foobarbaz"
1369+-- > chunksOf 3 "foobarbaz" == ["foo","bar","baz"]
1609−-- ["foo","bar","baz"]
1610−--
1611−-- >>> chunksOf 4 "haskell.org"
1370+-- > chunksOf 4 "haskell.org" == ["hask","ell.","org"]
1612−-- ["hask","ell.","org"]
1613chunksOf :: Int -> Text -> [Text]
1371chunksOf :: Int -> Text -> [Text]
1614−chunksOf = coerce JSS.chunksOf
1372+chunksOf k = go
1615−-- chunksOf k = go
1616−-- where
1373+ where
1617−-- go t = case splitAt k t of
1374+ go t = case splitAt k t of
1618−-- (a,b) | null a -> []
1375+ (a,b) | null a -> []
1619−-- | otherwise -> a : go b
1376+ | otherwise -> a : go b
1620{-# INLINE chunksOf #-}
1377{-# INLINE chunksOf #-}
1621
1378
1622-- ----------------------------------------------------------------------------
1379-- ----------------------------------------------------------------------------
@@ -1629,8 +1386,7 @@ chunksOf = coerce JSS.chunksOf
1629-- returns the first element matching the predicate, or 'Nothing' if
1386-- returns the first element matching the predicate, or 'Nothing' if
1630-- there is no such element.
1387-- there is no such element.
1631find :: (Char -> Bool) -> Text -> Maybe Char
1388find :: (Char -> Bool) -> Text -> Maybe Char
1632−find = coerce JSS.find
1633−-- find p t = S.findBy p (stream t)
1389+find p t = S.findBy p (stream t)
1634{-# INLINE find #-}
1390{-# INLINE find #-}
1635
1391
1636-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',
1392-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',
@@ -1639,16 +1395,14 @@ find = coerce JSS.find
1639--
1395--
1640-- > partition p t == (filter p t, filter (not . p) t)
1396-- > partition p t == (filter p t, filter (not . p) t)
1641partition :: (Char -> Bool) -> Text -> (Text, Text)
1397partition :: (Char -> Bool) -> Text -> (Text, Text)
1642−partition = coerce JSS.partition
1643−-- partition p t = (filter p t, filter (not . p) t)
1398+partition p t = (filter p t, filter (not . p) t)
1644{-# INLINE partition #-}
1399{-# INLINE partition #-}
1645
1400
1646-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
1401-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
1647-- returns a 'Text' containing those characters that satisfy the
1402-- returns a 'Text' containing those characters that satisfy the
1648-- predicate.
1403-- predicate.
1649filter :: (Char -> Bool) -> Text -> Text
1404filter :: (Char -> Bool) -> Text -> Text
1650−filter = coerce JSS.filter
1651−-- filter p t = unstream (S.filter p (stream t))
1405+filter p t = unstream (S.filter p (stream t))
1652{-# INLINE filter #-}
1406{-# INLINE filter #-}
1653
1407
1654-- | /O(n+m)/ Find the first instance of @needle@ (which must be
1408-- | /O(n+m)/ Find the first instance of @needle@ (which must be
@@ -1658,11 +1412,8 @@ filter = coerce JSS.filter
1658--
1412--
1659-- Examples:
1413-- Examples:
1660--
1414--
1661−-- >>> breakOn "::" "a::b::c"
1415+-- > breakOn "::" "a::b::c" ==> ("a", "::b::c")
1662−-- ("a","::b::c")
1663−--
1664−-- >>> breakOn "/" "foobar"
1416+-- > breakOn "/" "foobar" ==> ("foobar", "")
1665−-- ("foobar","")
1666--
1417--
1667-- Laws:
1418-- Laws:
1668--
1419--
@@ -1676,12 +1427,11 @@ filter = coerce JSS.filter
1676-- In (unlikely) bad cases, this function's time complexity degrades
1427-- In (unlikely) bad cases, this function's time complexity degrades
1677-- towards /O(n*m)/.
1428-- towards /O(n*m)/.
1678breakOn :: Text -> Text -> (Text, Text)
1429breakOn :: Text -> Text -> (Text, Text)
1679−breakOn = coerce JSS.breakOn
1680−-- breakOn pat src@(Text arr off len)
1430+breakOn pat src@(Text arr off len)
1681−-- | null pat = emptyError "breakOn"
1431+ | null pat = emptyError "breakOn"
1682−-- | otherwise = case indices pat src of
1432+ | otherwise = case indices pat src of
1683−-- [] -> (src, empty)
1433+ [] -> (src, empty)
1684−-- (x:_) -> (text arr off x, text arr (off+x) (len-x))
1434+ (x:_) -> (text arr off x, text arr (off+x) (len-x))
1685{-# INLINE breakOn #-}
1435{-# INLINE breakOn #-}
1686
1436
1687-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
1437-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
@@ -1691,12 +1441,10 @@ breakOn = coerce JSS.breakOn
1691-- up to and including the last match of @needle@. The second is the
1441-- up to and including the last match of @needle@. The second is the
1692-- remainder of @haystack@, following the match.
1442-- remainder of @haystack@, following the match.
1693--
1443--
1694−-- >>> breakOnEnd "::" "a::b::c"
1444+-- > breakOnEnd "::" "a::b::c" ==> ("a::b::", "c")
1695−-- ("a::b::","c")
1696breakOnEnd :: Text -> Text -> (Text, Text)
1445breakOnEnd :: Text -> Text -> (Text, Text)
1697−breakOnEnd = coerce JSS.breakOnEnd
1698−-- breakOnEnd pat src = (reverse b, reverse a)
1446+breakOnEnd pat src = (reverse b, reverse a)
1699−-- where (a,b) = breakOn (reverse pat) (reverse src)
1447+ where (a,b) = breakOn (reverse pat) (reverse src)
1700{-# INLINE breakOnEnd #-}
1448{-# INLINE breakOnEnd #-}
1701
1449
1702-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in
1450-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in
@@ -1708,11 +1456,10 @@ breakOnEnd = coerce JSS.breakOnEnd
1708--
1456--
1709-- Examples:
1457-- Examples:
1710--
1458--
1711−-- >>> breakOnAll "::" ""
1459+-- > breakOnAll "::" ""
1712−-- []
1460+-- > ==> []
1713−--
1714−-- >>> breakOnAll "/" "a/b/c/"
1461+-- > breakOnAll "/" "a/b/c/"
1715−-- [("a","/b/c/"),("a/b","/c/"),("a/b/c","/")]
1462+-- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]
1716--
1463--
1717-- In (unlikely) bad cases, this function's time complexity degrades
1464-- In (unlikely) bad cases, this function's time complexity degrades
1718-- towards /O(n*m)/.
1465-- towards /O(n*m)/.
@@ -1721,13 +1468,12 @@ breakOnEnd = coerce JSS.breakOnEnd
1721breakOnAll :: Text -- ^ @needle@ to search for
1468breakOnAll :: Text -- ^ @needle@ to search for
1722 -> Text -- ^ @haystack@ in which to search
1469 -> Text -- ^ @haystack@ in which to search
1723 -> [(Text, Text)]
1470 -> [(Text, Text)]
1724−breakOnAll = coerce JSS.breakOnAll
1725−-- breakOnAll pat src@(Text arr off slen)
1471+breakOnAll pat src@(Text arr off slen)
1726−-- | null pat = emptyError "breakOnAll"
1472+ | null pat = emptyError "breakOnAll"
1727−-- | otherwise = L.map step (indices pat src)
1473+ | otherwise = L.map step (indices pat src)
1728−-- where
1474+ where
1729−-- step x = (chunk 0 x, chunk x (slen-x))
1475+ step x = (chunk 0 x, chunk x (slen-x))
1730−-- chunk !n !l = text arr (n+off) l
1476+ chunk !n !l = text arr (n+off) l
1731{-# INLINE breakOnAll #-}
1477{-# INLINE breakOnAll #-}
1732
1478
1733-------------------------------------------------------------------------------
1479-------------------------------------------------------------------------------
@@ -1751,16 +1497,14 @@ breakOnAll = coerce JSS.breakOnAll
1751
1497
1752-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.
1498-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.
1753index :: Text -> Int -> Char
1499index :: Text -> Int -> Char
1754−index = coerce JSS.index
1755−-- index t n = S.index (stream t) n
1500+index t n = S.index (stream t) n
1756{-# INLINE index #-}
1501{-# INLINE index #-}
1757
1502
1758-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'
1503-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'
1759-- and returns the index of the first element in the 'Text' satisfying
1504-- and returns the index of the first element in the 'Text' satisfying
1760-- the predicate. Subject to fusion.
1505-- the predicate. Subject to fusion.
1761findIndex :: (Char -> Bool) -> Text -> Maybe Int
1506findIndex :: (Char -> Bool) -> Text -> Maybe Int
1762−findIndex = coerce JSS.findIndex
1763−-- findIndex p t = S.findIndex p (stream t)
1507+findIndex p t = S.findIndex p (stream t)
1764{-# INLINE findIndex #-}
1508{-# INLINE findIndex #-}
1765
1509
1766-- | /O(n+m)/ The 'count' function returns the number of times the
1510-- | /O(n+m)/ The 'count' function returns the number of times the
@@ -1770,11 +1514,10 @@ findIndex = coerce JSS.findIndex
1770-- In (unlikely) bad cases, this function's time complexity degrades
1514-- In (unlikely) bad cases, this function's time complexity degrades
1771-- towards /O(n*m)/.
1515-- towards /O(n*m)/.
1772count :: Text -> Text -> Int
1516count :: Text -> Text -> Int
1773−count = coerce JSS.count
1774−-- count pat src
1517+count pat src
1775−-- | null pat = emptyError "count"
1518+ | null pat = emptyError "count"
1776−-- | isSingleton pat = countChar (unsafeHead pat) src
1519+ | isSingleton pat = countChar (unsafeHead pat) src
1777−-- | otherwise = L.length (indices pat src)
1520+ | otherwise = L.length (indices pat src)
1778{-# INLINE [1] count #-}
1521{-# INLINE [1] count #-}
1779
1522
1780{-# RULES
1523{-# RULES
@@ -1796,46 +1539,42 @@ countChar c t = S.countChar c (stream t)
1796-- excess elements of the longer 'Text' are discarded. This is
1539-- excess elements of the longer 'Text' are discarded. This is
1797-- equivalent to a pair of 'unpack' operations.
1540-- equivalent to a pair of 'unpack' operations.
1798zip :: Text -> Text -> [(Char,Char)]
1541zip :: Text -> Text -> [(Char,Char)]
1799−zip = coerce JSS.zip
1800−-- zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1542+zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1801{-# INLINE zip #-}
1543{-# INLINE zip #-}
1802
1544
1803-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1545-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1804-- given as the first argument, instead of a tupling function.
1546-- given as the first argument, instead of a tupling function.
1805-- Performs replacement on invalid scalar values.
1547-- Performs replacement on invalid scalar values.
1806zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1548zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1807−zipWith = coerce JSS.zipWith
1808−-- zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1549+zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1809−-- where g a b = safe (f a b)
1550+ where g a b = safe (f a b)
1810{-# INLINE zipWith #-}
1551{-# INLINE zipWith #-}
1811
1552
1812-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1553-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1813-- representing white space.
1554-- representing white space.
1814words :: Text -> [Text]
1555words :: Text -> [Text]
1815−words = coerce JSS.words
1816−-- words t@(Text arr off len) = loop 0 0
1556+words t@(Text arr off len) = loop 0 0
1817−-- where
1557+ where
1818−-- loop !start !n
1558+ loop !start !n
1819−-- | n >= len = if start == n
1559+ | n >= len = if start == n
1820−-- then []
1560+ then []
1821−-- else [Text arr (start+off) (n-start)]
1561+ else [Text arr (start+off) (n-start)]
1822−-- | isSpace c =
1562+ | isSpace c =
1823−-- if start == n
1563+ if start == n
1824−-- then loop (start+1) (start+1)
1564+ then loop (start+1) (start+1)
1825−-- else Text arr (start+off) (n-start) : loop (n+d) (n+d)
1565+ else Text arr (start+off) (n-start) : loop (n+d) (n+d)
1826−-- | otherwise = loop start (n+d)
1566+ | otherwise = loop start (n+d)
1827−-- where Iter c d = iter t n
1567+ where Iter c d = iter t n
1828{-# INLINE words #-}
1568{-# INLINE words #-}
1829
1569
1830-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at
1570-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at
1831-- newline 'Char's. The resulting strings do not contain newlines.
1571-- newline 'Char's. The resulting strings do not contain newlines.
1832lines :: Text -> [Text]
1572lines :: Text -> [Text]
1833−lines = coerce JSS.lines
1834−-- lines ps | null ps = []
1573+lines ps | null ps = []
1835−-- | otherwise = h : if null t
1574+ | otherwise = h : if null t
1836−-- then []
1575+ then []
1837−-- else lines (unsafeTail t)
1576+ else lines (unsafeTail t)
1838−-- where (# h,t #) = span_ (/= '\n') ps
1577+ where (# h,t #) = span_ (/= '\n') ps
1839{-# INLINE lines #-}
1578{-# INLINE lines #-}
1840
1579
1841{-
1580{-
@@ -1863,40 +1602,34 @@ lines' ps | null ps = []
1863-- | /O(n)/ Joins lines, after appending a terminating newline to
1602-- | /O(n)/ Joins lines, after appending a terminating newline to
1864-- each.
1603-- each.
1865unlines :: [Text] -> Text
1604unlines :: [Text] -> Text
1866−unlines = coerce JSS.unlines
1867−-- unlines = concat . L.map (`snoc` '\n')
1605+unlines = concat . L.map (`snoc` '\n')
1868{-# INLINE unlines #-}
1606{-# INLINE unlines #-}
1869
1607
1870-- | /O(n)/ Joins words using single space characters.
1608-- | /O(n)/ Joins words using single space characters.
1871unwords :: [Text] -> Text
1609unwords :: [Text] -> Text
1872−unwords = coerce JSS.unwords
1873−-- unwords = intercalate (singleton ' ')
1610+unwords = intercalate (singleton ' ')
1874{-# INLINE unwords #-}
1611{-# INLINE unwords #-}
1875
1612
1876-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns
1613-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns
1877-- 'True' iff the first is a prefix of the second. Subject to fusion.
1614-- 'True' iff the first is a prefix of the second. Subject to fusion.
1878isPrefixOf :: Text -> Text -> Bool
1615isPrefixOf :: Text -> Text -> Bool
1879−isPrefixOf = coerce JSS.isPrefixOf
1880−-- isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =
1616+isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =
1881−-- alen <= blen && S.isPrefixOf (stream a) (stream b)
1617+ alen <= blen && S.isPrefixOf (stream a) (stream b)
1882{-# INLINE [1] isPrefixOf #-}
1618{-# INLINE [1] isPrefixOf #-}
1883
1619
1884{-# RULES
1620{-# RULES
1885"TEXT isPrefixOf -> fused" [~1] forall s t.
1621"TEXT isPrefixOf -> fused" [~1] forall s t.
1886 isPrefixOf s t = S.isPrefixOf (stream s) (stream t)
1622 isPrefixOf s t = S.isPrefixOf (stream s) (stream t)
1887−"JSSTRING isPrefixOf -> unfused" [1] forall x y.
1888− S.isPrefixOf (stream x) (stream y) = isPrefixOf x y
1889 #-}
1623 #-}
1890
1624
1891-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns
1625-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns
1892-- 'True' iff the first is a suffix of the second.
1626-- 'True' iff the first is a suffix of the second.
1893isSuffixOf :: Text -> Text -> Bool
1627isSuffixOf :: Text -> Text -> Bool
1894−isSuffixOf = coerce JSS.isSuffixOf
1895−-- isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =
1628+isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =
1896−-- d >= 0 && a == b'
1629+ d >= 0 && a == b'
1897−-- where d = blen - alen
1630+ where d = blen - alen
1898−-- b' | d == 0 = b
1631+ b' | d == 0 = b
1899−-- | otherwise = Text barr (boff+d) alen
1632+ | otherwise = Text barr (boff+d) alen
1900{-# INLINE isSuffixOf #-}
1633{-# INLINE isSuffixOf #-}
1901
1634
1902-- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns
1635-- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns
@@ -1906,11 +1639,10 @@ isSuffixOf = coerce JSS.isSuffixOf
1906-- In (unlikely) bad cases, this function's time complexity degrades
1639-- In (unlikely) bad cases, this function's time complexity degrades
1907-- towards /O(n*m)/.
1640-- towards /O(n*m)/.
1908isInfixOf :: Text -> Text -> Bool
1641isInfixOf :: Text -> Text -> Bool
1909−isInfixOf = coerce JSS.isInfixOf
1910−-- isInfixOf needle haystack
1642+isInfixOf needle haystack
1911−-- | null needle = True
1643+ | null needle = True
1912−-- | isSingleton needle = S.elem (unsafeHead needle) . S.stream $ haystack
1644+ | isSingleton needle = S.elem (unsafeHead needle) . S.stream $ haystack
1913−-- | otherwise = not . L.null . indices needle $ haystack
1645+ | otherwise = not . L.null . indices needle $ haystack
1914{-# INLINE [1] isInfixOf #-}
1646{-# INLINE [1] isInfixOf #-}
1915
1647
1916{-# RULES
1648{-# RULES
@@ -1926,14 +1658,9 @@ isInfixOf = coerce JSS.isInfixOf
1926--
1658--
1927-- Examples:
1659-- Examples:
1928--
1660--
1929−-- >>> stripPrefix "foo" "foobar"
1661+-- > stripPrefix "foo" "foobar" == Just "bar"
1930−-- Just "bar"
1931−--
1932−-- >>> stripPrefix "" "baz"
1662+-- > stripPrefix "" "baz" == Just "baz"
1933−-- Just "baz"
1934−--
1935−-- >>> stripPrefix "foo" "quux"
1663+-- > stripPrefix "foo" "quux" == Nothing
1936−-- Nothing
1937--
1664--
1938-- This is particularly useful with the @ViewPatterns@ extension to
1665-- This is particularly useful with the @ViewPatterns@ extension to
1939-- GHC, as follows:
1666-- GHC, as follows:
@@ -1945,10 +1672,9 @@ isInfixOf = coerce JSS.isInfixOf
1945-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf
1672-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf
1946-- > fnordLength _ = -1
1673-- > fnordLength _ = -1
1947stripPrefix :: Text -> Text -> Maybe Text
1674stripPrefix :: Text -> Text -> Maybe Text
1948−stripPrefix = coerce JSS.stripPrefix
1949−-- stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1675+stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1950−-- | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)
1676+ | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)
1951−-- | otherwise = Nothing
1677+ | otherwise = Nothing
1952
1678
1953-- | /O(n)/ Find the longest non-empty common prefix of two strings
1679-- | /O(n)/ Find the longest non-empty common prefix of two strings
1954-- and return it, along with the suffixes of each string at which they
1680-- and return it, along with the suffixes of each string at which they
@@ -1959,39 +1685,28 @@ stripPrefix = coerce JSS.stripPrefix
1959--
1685--
1960-- Examples:
1686-- Examples:
1961--
1687--
1962−-- >>> commonPrefixes "foobar" "fooquux"
1688+-- > commonPrefixes "foobar" "fooquux" == Just ("foo","bar","quux")
1963−-- Just ("foo","bar","quux")
1964−--
1965−-- >>> commonPrefixes "veeble" "fetzer"
1689+-- > commonPrefixes "veeble" "fetzer" == Nothing
1966−-- Nothing
1967−--
1968−-- >>> commonPrefixes "" "baz"
1690+-- > commonPrefixes "" "baz" == Nothing
1969−-- Nothing
1970commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)
1691commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)
1971−commonPrefixes = coerce JSS.commonPrefixes
1972−-- commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1692+commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1973−-- where
1693+ where
1974−-- go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1694+ go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1975−-- | i > 0 = Just (Text arr0 off0 i,
1695+ | i > 0 = Just (Text arr0 off0 i,
1976−-- text arr0 (off0+i) (len0-i),
1696+ text arr0 (off0+i) (len0-i),
1977−-- text arr1 (off1+j) (len1-j))
1697+ text arr1 (off1+j) (len1-j))
1978−-- | otherwise = Nothing
1698+ | otherwise = Nothing
1979−-- where Iter a d0 = iter t0 i
1699+ where Iter a d0 = iter t0 i
1980−-- Iter b d1 = iter t1 j
1700+ Iter b d1 = iter t1 j
1981
1701
1982-- | /O(n)/ Return the prefix of the second string if its suffix
1702-- | /O(n)/ Return the prefix of the second string if its suffix
1983-- matches the entire first string.
1703-- matches the entire first string.
1984--
1704--
1985-- Examples:
1705-- Examples:
1986--
1706--
1987−-- >>> stripSuffix "bar" "foobar"
1707+-- > stripSuffix "bar" "foobar" == Just "foo"
1988−-- Just "foo"
1989−--
1990−-- >>> stripSuffix "" "baz"
1708+-- > stripSuffix "" "baz" == Just "baz"
1991−-- Just "baz"
1992−--
1993−-- >>> stripSuffix "foo" "quux"
1709+-- > stripSuffix "foo" "quux" == Nothing
1994−-- Nothing
1995--
1710--
1996-- This is particularly useful with the @ViewPatterns@ extension to
1711-- This is particularly useful with the @ViewPatterns@ extension to
1997-- GHC, as follows:
1712-- GHC, as follows:
@@ -2003,22 +1718,21 @@ commonPrefixes = coerce JSS.commonPrefixes
2003-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre
1718-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre
2004-- > quuxLength _ = -1
1719-- > quuxLength _ = -1
2005stripSuffix :: Text -> Text -> Maybe Text
1720stripSuffix :: Text -> Text -> Maybe Text
2006−stripSuffix = coerce JSS.stripSuffix
2007−-- stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
1721+stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
2008−-- | p `isSuffixOf` t = Just $! text arr off (len-plen)
1722+ | p `isSuffixOf` t = Just $! text arr off (len-plen)
2009−-- | otherwise = Nothing
1723+ | otherwise = Nothing
2010−
1724+
2011−-- -- | Add a list of non-negative numbers. Errors out on overflow.
1725+-- | Add a list of non-negative numbers. Errors out on overflow.
2012−-- sumP :: String -> [Int] -> Int
1726+sumP :: String -> [Int] -> Int
2013−-- sumP fun = go 0
1727+sumP fun = go 0
2014−-- where go !a (x:xs)
1728+ where go !a (x:xs)
2015−-- | ax >= 0 = go ax xs
1729+ | ax >= 0 = go ax xs
2016−-- | otherwise = overflowError fun
1730+ | otherwise = overflowError fun
2017−-- where ax = a + x
1731+ where ax = a + x
2018−-- go a _ = a
1732+ go a _ = a
2019−
1733+
2020−-- emptyError :: String -> a
1734+emptyError :: String -> a
2021−-- emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"
1735+emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"
2022
1736
2023overflowError :: String -> a
1737overflowError :: String -> a
2024overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
1738overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
@@ -2032,22 +1746,10 @@ overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
2032-- copy \"breaks the link\" to the original array, allowing it to be
1746-- copy \"breaks the link\" to the original array, allowing it to be
2033-- garbage collected if there are no other live references to it.
1747-- garbage collected if there are no other live references to it.
2034copy :: Text -> Text
1748copy :: Text -> Text
2035−copy = P.id -- TODO
2036−-- copy (Text arr off len) = Text (A.run go) 0 len
1749+copy (Text arr off len) = Text (A.run go) 0 len
2037−-- where
1750+ where
2038−-- go :: ST s (A.MArray s)
1751+ go :: ST s (A.MArray s)
2039−-- go = do
1752+ go = do
2040−-- marr <- A.new len
1753+ marr <- A.new len
2041−
1754+ A.copyI marr 0 arr off len
2042−foreign import javascript unsafe
1755+ return marr
2043− "h$jsstringReplicateChar" js_replicateChar :: Int -> Char -> JSString
2044−foreign import javascript unsafe
2045− "$2.substr($1)" js_substr1 :: Int -> JSString -> JSString
2046−
2047−-------------------------------------------------
2048−-- NOTE: the named chunk below used by doctest;
2049−-- verify the doctests via `doctest -fobject-code Data/Text.hs`
2050−
2051−-- $setup
2052−-- >>> :set -XOverloadedStrings
2053−-- >>> import qualified Data.Text as T
Data/Text/Array.hs+1−4
@@ -7,6 +7,7 @@
7--
7--
8-- License : BSD-style
8-- License : BSD-style
9-- Maintainer : bos@serpentine.com
9-- Maintainer : bos@serpentine.com
10+-- Stability : experimental
10-- Portability : portable
11-- Portability : portable
11--
12--
12-- Packed, unboxed, heap-resident arrays. Suitable for performance
13-- Packed, unboxed, heap-resident arrays. Suitable for performance
@@ -79,8 +80,6 @@ import GHC.Word (Word16(..))
79import Prelude hiding (length, read)
80import Prelude hiding (length, read)
80
81
81-- | Immutable array type.
82-- | Immutable array type.
82−--
83−-- The 'Array' constructor is exposed since @text-1.1.1.3@
84data Array = Array {
83data Array = Array {
85 aBA :: ByteArray#
84 aBA :: ByteArray#
86#if defined(ASSERTS)
85#if defined(ASSERTS)
@@ -89,8 +88,6 @@ data Array = Array {
89 }
88 }
90
89
91-- | Mutable array type, for use in the ST monad.
90-- | Mutable array type, for use in the ST monad.
92−--
93−-- The 'MArray' constructor is exposed since @text-1.1.1.3@
94data MArray s = MArray {
91data MArray s = MArray {
95 maBA :: MutableByteArray# s
92 maBA :: MutableByteArray# s
96#if defined(ASSERTS)
93#if defined(ASSERTS)
Data/Text/Encoding.hs+11−95
@@ -3,7 +3,6 @@
3#if __GLASGOW_HASKELL__ >= 702
3#if __GLASGOW_HASKELL__ >= 702
4{-# LANGUAGE Trustworthy #-}
4{-# LANGUAGE Trustworthy #-}
5#endif
5#endif
6−{-# LANGUAGE UnboxedTuples #-}
7-- |
6-- |
8-- Module : Data.Text.Encoding
7-- Module : Data.Text.Encoding
9-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan,
8-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan,
@@ -12,13 +11,14 @@
12--
11--
13-- License : BSD-style
12-- License : BSD-style
14-- Maintainer : bos@serpentine.com
13-- Maintainer : bos@serpentine.com
14+-- Stability : experimental
15-- Portability : portable
15-- Portability : portable
16--
16--
17-- Functions for converting 'Text' values to and from 'ByteString',
17-- Functions for converting 'Text' values to and from 'ByteString',
18-- using several standard encodings.
18-- using several standard encodings.
19--
19--
20-- To gain access to a much larger family of encodings, use the
20-- To gain access to a much larger family of encodings, use the
21−-- <http://hackage.haskell.org/package/text-icu text-icu package>.
21+-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>
22
22
23module Data.Text.Encoding
23module Data.Text.Encoding
24 (
24 (
@@ -66,7 +66,7 @@ import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
66import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)
66import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)
67#endif
67#endif
68
68
69−import Control.Exception (evaluate, try, throwIO, ErrorCall(ErrorCall))
69+import Control.Exception (evaluate, try)
70import Control.Monad.ST (runST)
70import Control.Monad.ST (runST)
71import Data.Bits ((.&.))
71import Data.Bits ((.&.))
72import Data.ByteString as B
72import Data.ByteString as B
@@ -76,16 +76,10 @@ import Data.Text.Internal (Text(..), safe, text)
76import Data.Text.Internal.Private (runText)
76import Data.Text.Internal.Private (runText)
77import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
77import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
78import Data.Text.Internal.Unsafe.Shift (shiftR)
78import Data.Text.Internal.Unsafe.Shift (shiftR)
79−#ifndef __GHCJS__
80import Data.Text.Show ()
79import Data.Text.Show ()
81−#endif
82import Data.Text.Unsafe (unsafeDupablePerformIO)
80import Data.Text.Unsafe (unsafeDupablePerformIO)
83import Data.Word (Word8, Word32)
81import Data.Word (Word8, Word32)
84−#if __GLASGOW_HASKELL__ >= 703
85−import Foreign.C.Types (CSize(CSize))
82+import Foreign.C.Types (CSize(..))
86−#else
87−import Foreign.C.Types (CSize)
88−#endif
89import Foreign.ForeignPtr (withForeignPtr)
83import Foreign.ForeignPtr (withForeignPtr)
90import Foreign.Marshal.Utils (with)
84import Foreign.Marshal.Utils (with)
91import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
85import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
@@ -101,12 +95,6 @@ import qualified Data.Text.Internal.Encoding.Utf16 as U16
101import qualified Data.Text.Internal.Fusion as F
95import qualified Data.Text.Internal.Fusion as F
102
96
103#include "text_cbits.h"
97#include "text_cbits.h"
104−#ifdef __GHCJS__
105−import GHC.Exts (Int(..), Int#)
106−import Data.ByteString (ByteString)
107−import GHCJS.Buffer
108−import Data.JSString (JSString)
109−#endif
110
98
111-- $strict
99-- $strict
112--
100--
@@ -140,13 +128,6 @@ decodeLatin1 (PS fp off len) = text a 0 len
140 return dest
128 return dest
141
129
142-- | Decode a 'ByteString' containing UTF-8 encoded text.
130-- | Decode a 'ByteString' containing UTF-8 encoded text.
143−--
144−-- __NOTE__: The replacement character returned by 'OnDecodeError'
145−-- MUST be within the BMP plane; surrogate code points will
146−-- automatically be remapped to the replacement char @U+FFFD@
147−-- (/since 0.11.3.0/), whereas code points beyond the BMP will throw an
148−-- 'error' (/since 1.2.3.1/); For earlier versions of @text@ using
149−-- those unsupported code points would result in undefined behavior.
150decodeUtf8With :: OnDecodeError -> ByteString -> Text
131decodeUtf8With :: OnDecodeError -> ByteString -> Text
151decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
132decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
152 let go dest = withForeignPtr fp $ \ptr ->
133 let go dest = withForeignPtr fp $ \ptr ->
@@ -162,52 +143,16 @@ decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
162 x <- peek curPtr'
143 x <- peek curPtr'
163 case onErr desc (Just x) of
144 case onErr desc (Just x) of
164 Nothing -> loop $ curPtr' `plusPtr` 1
145 Nothing -> loop $ curPtr' `plusPtr` 1
165− Just c
146+ Just c -> do
166− | c > '\xFFFF' -> throwUnsupportedReplChar
167− | otherwise -> do
168− destOff <- peek destOffPtr
147+ destOff <- peek destOffPtr
169− w <- unsafeSTToIO $
148+ w <- unsafeSTToIO $
170− unsafeWrite dest (fromIntegral destOff)
149+ unsafeWrite dest (fromIntegral destOff) (safe c)
171− (safe c)
172− poke destOffPtr (destOff + fromIntegral w)
150+ poke destOffPtr (destOff + fromIntegral w)
173− loop $ curPtr' `plusPtr` 1
151+ loop $ curPtr' `plusPtr` 1
174 loop (ptr `plusPtr` off)
152 loop (ptr `plusPtr` off)
175 (unsafeIOToST . go) =<< A.new len
153 (unsafeIOToST . go) =<< A.new len
176 where
154 where
177 desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
155 desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
178−
179− throwUnsupportedReplChar = throwIO $
180− ErrorCall "decodeUtf8With: non-BMP replacement characters not supported"
181− -- TODO: The code currently assumes that the transcoded UTF-16
182− -- stream is at most twice as long (in bytes) as the input UTF-8
183− -- stream. To justify this assumption one has to assume that the
184− -- error handler replacement character also satisfies this
185− -- invariant, by emitting at most one UTF16 code unit.
186− --
187− -- One easy way to support the full range of code-points for
188− -- replacement characters in the error handler is to simply change
189− -- the (over-)allocation to `A.new (2*len)` and then shrink back the
190− -- `ByteArray#` to the real size (recent GHCs have a cheap
191− -- `ByteArray#` resize-primop for that which allow the GC to reclaim
192− -- the overallocation). However, this would require 4 times as much
193− -- (temporary) storage as the original UTF-8 required.
194− --
195− -- Another strategy would be to optimistically assume that
196− -- replacement characters are within the BMP, and if the case of a
197− -- non-BMP replacement occurs reallocate the target buffer (or throw
198− -- an exception, and fallback to a pessimistic codepath, like e.g.
199− -- `decodeUtf8With onErr bs = F.unstream (E.streamUtf8 onErr bs)`)
200− --
201− -- Alternatively, `OnDecodeError` could become a datastructure which
202− -- statically encodes the replacement-character range,
203− -- e.g. something isomorphic to
204− --
205− -- Either (... -> Maybe Word16) (... -> Maybe Char)
206− --
207− -- And allow to statically switch between the BMP/non-BMP
208− -- replacement-character codepaths. There's multiple ways to address
209− -- this with different tradeoffs; but ideally we should optimise for
210− -- the optimistic/error-free case.
211{- INLINE[0] decodeUtf8With #-}
156{- INLINE[0] decodeUtf8With #-}
212
157
213-- $stream
158-- $stream
@@ -264,8 +209,6 @@ decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
264-- or continuation where it is encountered.
209-- or continuation where it is encountered.
265
210
266-- | A stream oriented decoding result.
211-- | A stream oriented decoding result.
267−--
268−-- @since 1.0.0.0
269data Decoding = Some Text ByteString (ByteString -> Decoding)
212data Decoding = Some Text ByteString (ByteString -> Decoding)
270
213
271instance Show Decoding where
214instance Show Decoding where
@@ -285,15 +228,11 @@ newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable)
285-- thrown (either by this function or a continuation) that cannot be
228-- thrown (either by this function or a continuation) that cannot be
286-- caught in pure code. For more control over the handling of invalid
229-- caught in pure code. For more control over the handling of invalid
287-- data, use 'streamDecodeUtf8With'.
230-- data, use 'streamDecodeUtf8With'.
288−--
289−-- @since 1.0.0.0
290streamDecodeUtf8 :: ByteString -> Decoding
231streamDecodeUtf8 :: ByteString -> Decoding
291streamDecodeUtf8 = streamDecodeUtf8With strictDecode
232streamDecodeUtf8 = streamDecodeUtf8With strictDecode
292
233
293-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
234-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
294-- encoded text.
235-- encoded text.
295−--
296−-- @since 1.0.0.0
297streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
236streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
298streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
237streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
299 where
238 where
@@ -369,8 +308,6 @@ decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDec
369{-# INLINE decodeUtf8' #-}
308{-# INLINE decodeUtf8' #-}
370
309
371-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
310-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
372−--
373−-- @since 1.1.0.0
374encodeUtf8Builder :: Text -> B.Builder
311encodeUtf8Builder :: Text -> B.Builder
375encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
312encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
376
313
@@ -379,8 +316,6 @@ encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
379--
316--
380-- Use this function is to implement efficient encoders for text-based formats
317-- Use this function is to implement efficient encoders for text-based formats
381-- like JSON or HTML.
318-- like JSON or HTML.
382−--
383−-- @since 1.1.0.0
384{-# INLINE encodeUtf8BuilderEscaped #-}
319{-# INLINE encodeUtf8BuilderEscaped #-}
385-- TODO: Extend documentation with references to source code in @blaze-html@
320-- TODO: Extend documentation with references to source code in @blaze-html@
386-- or @aeson@ that uses this function.
321-- or @aeson@ that uses this function.
@@ -391,18 +326,9 @@ encodeUtf8BuilderEscaped be =
391 where
326 where
392 bound = max 4 $ BP.sizeBound be
327 bound = max 4 $ BP.sizeBound be
393
328
394−#ifndef __GHCJS__
395 mkBuildstep (Text arr off len) !k =
329 mkBuildstep (Text arr off len) !k =
396−#else
397− mkBuildstep (Text t) !k =
398−#endif
399 outerLoop off
330 outerLoop off
400 where
331 where
401−#ifdef __GHCJS__
402− off = 0
403− (arr, len) = let (# ba, len' #) = js_fromString t
404− in (A.Array ba, I# len')
405−#endif
406 iend = off + len
332 iend = off + len
407
333
408 outerLoop !i0 !br@(B.BufferRange op0 ope)
334 outerLoop !i0 !br@(B.BufferRange op0 ope)
@@ -444,11 +370,10 @@ encodeUtf8BuilderEscaped be =
444
370
445-- | Encode text using UTF-8 encoding.
371-- | Encode text using UTF-8 encoding.
446encodeUtf8 :: Text -> ByteString
372encodeUtf8 :: Text -> ByteString
447−#ifndef __GHCJS__
448encodeUtf8 (Text arr off len)
373encodeUtf8 (Text arr off len)
449 | len == 0 = B.empty
374 | len == 0 = B.empty
450 | otherwise = unsafeDupablePerformIO $ do
375 | otherwise = unsafeDupablePerformIO $ do
451− fp <- mallocByteString (len*3) -- see https://github.com/haskell/text/issues/194 for why len*3 is enough
376+ fp <- mallocByteString (len*4)
452 withForeignPtr fp $ \ptr ->
377 withForeignPtr fp $ \ptr ->
453 with ptr $ \destPtr -> do
378 with ptr $ \destPtr -> do
454 c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
379 c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
@@ -461,10 +386,6 @@ encodeUtf8 (Text arr off len)
461 withForeignPtr fp' $ \ptr' -> do
386 withForeignPtr fp' $ \ptr' -> do
462 memcpy ptr' ptr (fromIntegral utf8len)
387 memcpy ptr' ptr (fromIntegral utf8len)
463 return (PS fp' 0 utf8len)
388 return (PS fp' 0 utf8len)
464−#else
465−encodeUtf8 (Text txt) = toByteString 0 (Just (byteLength buf - 1)) buf
466− where buf = js_encodeUtf8 txt
467−#endif
468
389
469-- | Decode text from little endian UTF-16 encoding.
390-- | Decode text from little endian UTF-16 encoding.
470decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
391decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
@@ -554,10 +475,5 @@ foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_stat
554foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
475foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
555 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
476 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
556
477
557−#ifndef __GHCJS__
558foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
478foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
559 :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()
479 :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()
560−#else
561−foreign import javascript unsafe "h$textFromString" js_fromString :: JSString -> (# ByteArray#, Int# #)
562−foreign import javascript unsafe "h$encodeUtf8($1)" js_encodeUtf8 :: JSString -> Buffer
563−#endif
Data/Text/Encoding/Error.hs+1
@@ -10,6 +10,7 @@
10--
10--
11-- License : BSD-style
11-- License : BSD-style
12-- Maintainer : bos@serpentine.com
12-- Maintainer : bos@serpentine.com
13+-- Stability : experimental
13-- Portability : GHC
14-- Portability : GHC
14--
15--
15-- Types and functions for dealing with encoding and decoding errors
16-- Types and functions for dealing with encoding and decoding errors
Data/Text/Foreign.hs+2−5
@@ -5,6 +5,7 @@
5--
5--
6-- License : BSD-style
6-- License : BSD-style
7-- Maintainer : bos@serpentine.com
7-- Maintainer : bos@serpentine.com
8+-- Stability : experimental
8-- Portability : GHC
9-- Portability : GHC
9--
10--
10-- Support for using 'Text' data with native code via the Haskell
11-- Support for using 'Text' data with native code via the Haskell
@@ -107,7 +108,7 @@ takeWord16 (I16 n) t@(Text arr off len)
107 | n >= len || m >= len = t
108 | n >= len || m >= len = t
108 | otherwise = Text arr off m
109 | otherwise = Text arr off m
109 where
110 where
110− m | w < 0xD800 || w > 0xDBFF = n
111+ m | w < 0xDB00 || w > 0xD8FF = n
111 | otherwise = n+1
112 | otherwise = n+1
112 w = A.unsafeIndex arr (off+n-1)
113 w = A.unsafeIndex arr (off+n-1)
113
114
@@ -156,8 +157,6 @@ asForeignPtr t@(Text _arr _off len) = do
156-- | /O(n)/ Decode a C string with explicit length, which is assumed
157-- | /O(n)/ Decode a C string with explicit length, which is assumed
157-- to have been encoded as UTF-8. If decoding fails, a
158-- to have been encoded as UTF-8. If decoding fails, a
158-- 'UnicodeException' is thrown.
159-- 'UnicodeException' is thrown.
159−--
160−-- @since 1.0.0.0
161peekCStringLen :: CStringLen -> IO Text
160peekCStringLen :: CStringLen -> IO Text
162peekCStringLen cs = do
161peekCStringLen cs = do
163 bs <- unsafePackCStringLen cs
162 bs <- unsafePackCStringLen cs
@@ -170,7 +169,5 @@ peekCStringLen cs = do
170-- The temporary storage is freed when the subcomputation terminates
169-- The temporary storage is freed when the subcomputation terminates
171-- (either normally or via an exception), so the pointer to the
170-- (either normally or via an exception), so the pointer to the
172-- temporary storage must /not/ be used after this function returns.
171-- temporary storage must /not/ be used after this function returns.
173−--
174−-- @since 1.0.0.0
175withCStringLen :: Text -> (CStringLen -> IO a) -> IO a
172withCStringLen :: Text -> (CStringLen -> IO a) -> IO a
176withCStringLen t act = unsafeUseAsCStringLen (encodeUtf8 t) act
173withCStringLen t act = unsafeUseAsCStringLen (encodeUtf8 t) act
Data/Text/IO.hs+1−20
@@ -8,6 +8,7 @@
8-- (c) 2009 Simon Marlow
8-- (c) 2009 Simon Marlow
9-- License : BSD-style
9-- License : BSD-style
10-- Maintainer : bos@serpentine.com
10-- Maintainer : bos@serpentine.com
11+-- Stability : experimental
11-- Portability : GHC
12-- Portability : GHC
12--
13--
13-- Efficient locale-sensitive support for text I\/O.
14-- Efficient locale-sensitive support for text I\/O.
@@ -184,11 +185,7 @@ hPutStr h t = do
184 | otherwise -> writeBlocksRaw h buf str
185 | otherwise -> writeBlocksRaw h buf str
185
186
186hPutChars :: Handle -> Stream Char -> IO ()
187hPutChars :: Handle -> Stream Char -> IO ()
187−#ifndef __GHCJS__
188hPutChars h (Stream next0 s0 _len) = loop s0
188hPutChars h (Stream next0 s0 _len) = loop s0
189−#else
190−hPutChars h (Stream next0 s0) = loop s0
191−#endif
192 where
189 where
193 loop !s = case next0 s of
190 loop !s = case next0 s of
194 Done -> return ()
191 Done -> return ()
@@ -206,11 +203,7 @@ hPutChars h (Stream next0 s0) = loop s0
206-- handling gave a few more percent on top.
203-- handling gave a few more percent on top.
207
204
208writeLines :: Handle -> Newline -> Buffer CharBufElem -> Stream Char -> IO ()
205writeLines :: Handle -> Newline -> Buffer CharBufElem -> Stream Char -> IO ()
209−#ifndef __GHCJS__
210writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0
206writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0
211−#else
212−writeLines h nl buf0 (Stream next0 s0) = outer s0 buf0
213−#endif
214 where
207 where
215 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
208 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
216 where
209 where
@@ -230,11 +223,7 @@ writeLines h nl buf0 (Stream next0 s0) = outer s0 buf0
230 commit = commitBuffer h raw len
223 commit = commitBuffer h raw len
231
224
232writeBlocksCRLF :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
225writeBlocksCRLF :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
233−#ifndef __GHCJS__
234writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0
226writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0
235−#else
236−writeBlocksCRLF h buf0 (Stream next0 s0) = outer s0 buf0
237−#endif
238 where
227 where
239 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
228 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
240 where
229 where
@@ -250,11 +239,7 @@ writeBlocksCRLF h buf0 (Stream next0 s0) = outer s0 buf0
250 commit = commitBuffer h raw len
239 commit = commitBuffer h raw len
251
240
252writeBlocksRaw :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
241writeBlocksRaw :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
253−#ifndef __GHCJS__
254writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0
242writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0
255−#else
256−writeBlocksRaw h buf0 (Stream next0 s0) = outer s0 buf0
257−#endif
258 where
243 where
259 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
244 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
260 where
245 where
@@ -351,7 +336,3 @@ putStrLn = hPutStrLn stdout
351-- >
336-- >
352-- > putStr_Utf16LE :: Text -> IO ()
337-- > putStr_Utf16LE :: Text -> IO ()
353-- > putStr_Utf16LE t = B.putStr (encodeUtf16LE t)
338-- > putStr_Utf16LE t = B.putStr (encodeUtf16LE t)
354−--
355−-- On transcoding errors, an 'IOError' exception is thrown. You can
356−-- use the API in "Data.Text.Encoding" if you need more control over
357−-- error handling or transcoding.
Data/Text/Internal.hs+125−48
@@ -1,67 +1,127 @@
1−{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples, MagicHash,
1+{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples #-}
2− BangPatterns, ForeignFunctionInterface, JavaScriptFFI, GeneralizedNewtypeDeriving #-}
2+{-# OPTIONS_HADDOCK not-home #-}
3−{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes,
3+
4− GHCForeignImportPrim, MagicHash, FlexibleInstances #-}
4+-- |
5+-- Module : Data.Text.Internal
6+-- Copyright : (c) 2008, 2009 Tom Harper,
7+-- (c) 2009, 2010 Bryan O'Sullivan,
8+-- (c) 2009 Duncan Coutts
9+--
10+-- License : BSD-style
11+-- Maintainer : bos@serpentine.com
12+-- Stability : experimental
13+-- Portability : GHC
14+--
15+-- A module containing private 'Text' internals. This exposes the
16+-- 'Text' representation and low level construction functions.
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+
5module Data.Text.Internal
27module Data.Text.Internal
6− ( module Data.Text.Internal
28+ (
29+ -- * Types
30+ -- $internals
31+ Text(..)
32+ -- * Construction
33+ , text
34+ , textP
35+ -- * Safety
7− , JSS.safe
36+ , safe
37+ -- * Code that must be here for accessibility
38+ , empty
39+ , empty_
40+ -- * Utilities
8− , JSS.firstf
41+ , firstf
42+ -- * Checked multiplication
43+ , mul
44+ , mul32
45+ , mul64
46+ -- * Debugging
47+ , showText
9− ) where
48+ ) where
10−
11−import Data.String (IsString(..))
12−import Data.Coerce
13−import Data.Data
14−import Data.Maybe
15−import Data.Binary
16−import Control.DeepSeq
17−import Data.Semigroup
18−import Data.Char
19−import qualified Data.JSString as JSS
20−import qualified Data.JSString.Internal as JSSS
21−import qualified Data.JSString.Internal.Type as JSS
22−import Data.JSString hiding (empty)
23−import qualified Data.Text.Array as A
24
49
50+#if defined(ASSERTS)
51+import Control.Exception (assert)
52+#endif
25import Data.Bits
53import Data.Bits
26import Data.Int (Int32, Int64)
54import Data.Int (Int32, Int64)
27−-- import Data.Text.Internal.Unsafe.Char (ord)
55+import Data.Text.Internal.Unsafe.Char (ord)
28import Data.Typeable (Typeable)
56import Data.Typeable (Typeable)
29−import GHC.Exts (ByteArray#, Char(..), ord#, andI#, (/=#), isTrue#, (==#), Int(..), Int#, isTrue#)
30−-- import qualified Data.Text.Array as A
57+import qualified Data.Text.Array as A
31−import GHCJS.Marshal.Pure
32−import GHCJS.Marshal
33−import qualified GHC.CString as GHC
34−
35
58
59+-- | A space efficient, packed, unboxed Unicode text type.
36−newtype Text = Text JSString
60+data Text = Text
37− deriving (PToJSVal, PFromJSVal, FromJSVal, ToJSVal)
61+ {-# UNPACK #-} !A.Array -- payload (Word16 elements)
62+ {-# UNPACK #-} !Int -- offset (units of Word16, not Char)
63+ {-# UNPACK #-} !Int -- length (units of Word16, not Char)
64+ deriving (Typeable)
38
65
39−instance Show Text where
66+-- | Smart constructor.
40− showsPrec p (Text jsstring) r = showsPrec p jsstring r
67+text_ :: A.Array -> Int -> Int -> Text
68+text_ arr off len =
69+#if defined(ASSERTS)
70+ let c = A.unsafeIndex arr off
71+ alen = A.length arr
72+ in assert (len >= 0) .
73+ assert (off >= 0) .
74+ assert (alen == 0 || len == 0 || off < alen) .
75+ assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $
76+#endif
77+ Text arr off len
78+{-# INLINE text_ #-}
41
79
80+-- | /O(1)/ The empty 'Text'.
42empty :: Text
81empty :: Text
43−empty = Text JSS.empty
82+empty = Text A.empty 0 0
44{-# INLINE [1] empty #-}
83{-# INLINE [1] empty #-}
45
84
85+-- | A non-inlined version of 'empty'.
46empty_ :: Text
86empty_ :: Text
47−empty_ = Text JSS.empty
87+empty_ = Text A.empty 0 0
48{-# NOINLINE empty_ #-}
88{-# NOINLINE empty_ #-}
49
89
50−foreign import javascript unsafe
51− "String.fromCharCode.apply(null, $1['u8'])"
52− js_decodeBytes :: ByteArray# -> JSString
53−
54−foreign import javascript unsafe
55− "h$textToString"
56− js_textToString :: ByteArray# -> Int# -> Int# -> JSString
57−
58-- | Construct a 'Text' without invisibly pinning its byte array in
90-- | Construct a 'Text' without invisibly pinning its byte array in
59-- memory if its length has dwindled to zero.
91-- memory if its length has dwindled to zero.
60text :: A.Array -> Int -> Int -> Text
92text :: A.Array -> Int -> Int -> Text
61−-- text arr off len | len == 0 = empty
93+text arr off len | len == 0 = empty
62−-- | otherwise = text_ arr off len
94+ | otherwise = text_ arr off len
63−text (A.Array ba) (I# off#) (I# len#) | isTrue# (len# ==# 0#) = empty
95+{-# INLINE text #-}
64− | otherwise = Text $ js_textToString ba off# len#
96+
97+textP :: A.Array -> Int -> Int -> Text
98+{-# DEPRECATED textP "Use text instead" #-}
99+textP = text
100+
101+-- | A useful 'show'-like function for debugging purposes.
102+showText :: Text -> String
103+showText (Text arr off len) =
104+ "Text " ++ show (A.toList arr off len) ++ ' ' :
105+ 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
65
125
66-- | Checked multiplication. Calls 'error' if the result would
126-- | Checked multiplication. Calls 'error' if the result would
67-- overflow.
127-- overflow.
@@ -108,4 +168,21 @@ mul32 a b = case fromIntegral a * fromIntegral b of
108{-# INLINE mul32 #-}
168{-# INLINE mul32 #-}
109infixl 7 `mul32`
169infixl 7 `mul32`
110
170
111−--------------------------------------
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.hs+5−47
@@ -1,6 +1,4 @@
1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
2−{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes, UnboxedTuples,
3− MagicHash #-}
4{-# OPTIONS_HADDOCK not-home #-}
2{-# OPTIONS_HADDOCK not-home #-}
5
3
6-----------------------------------------------------------------------------
4-----------------------------------------------------------------------------
@@ -75,8 +73,6 @@ import qualified Data.Text as S
75import qualified Data.Text.Array as A
73import qualified Data.Text.Array as A
76import qualified Data.Text.Lazy as L
74import qualified Data.Text.Lazy as L
77
75
78−import Data.JSString (JSString)
79−import GHC.Exts (ByteArray#, Int#, Int(I#))
80------------------------------------------------------------------------
76------------------------------------------------------------------------
81
77
82-- | A @Builder@ is an efficient way to build lazy @Text@ values.
78-- | A @Builder@ is an efficient way to build lazy @Text@ values.
@@ -168,17 +164,10 @@ copyLimit = 128
168-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@
164-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@
169--
165--
170fromText :: S.Text -> Builder
166fromText :: S.Text -> Builder
171−fromText t@(Text t')
167+fromText t@(Text arr off l)
172 | S.null t = empty
168 | S.null t = empty
173 | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)
169 | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)
174 | otherwise = flush `append` mapBuilder (t :)
170 | otherwise = flush `append` mapBuilder (t :)
175− where
176− (# ba, len #) = js_fromString t'
177− (arr, off, l) = (A.Array ba, 0, I# len)
178−-- fromText t@(Text arr off l)
179−-- | S.null t = empty
180−-- | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)
181−-- | otherwise = flush `append` mapBuilder (t :)
182{-# INLINE [1] fromText #-}
171{-# INLINE [1] fromText #-}
183
172
184{-# RULES
173{-# RULES
@@ -193,10 +182,10 @@ fromText t@(Text t')
193fromString :: String -> Builder
182fromString :: String -> Builder
194fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
183fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
195 let loop !marr !o !u !l [] = k (Buffer marr o u l)
184 let loop !marr !o !u !l [] = k (Buffer marr o u l)
196− loop marr o@(I# o#) u@(I# u#) l s@(c:cs)
185+ loop marr o u l s@(c:cs)
197 | l <= 1 = do
186 | l <= 1 = do
198 arr <- A.unsafeFreeze marr
187 arr <- A.unsafeFreeze marr
199− let !t = Text $ js_toString (A.aBA arr) o# u#
188+ let !t = Text arr o u
200 marr' <- A.new chunkSize
189 marr' <- A.new chunkSize
201 ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
190 ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
202 return $ t : ts
191 return $ t : ts
@@ -206,21 +195,6 @@ fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
206 in loop p0 o0 u0 l0 str
195 in loop p0 o0 u0 l0 str
207 where
196 where
208 chunkSize = smallChunkSize
197 chunkSize = smallChunkSize
209−-- fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
210−-- let loop !marr !o !u !l [] = k (Buffer marr o u l)
211−-- loop marr o u l s@(c:cs)
212−-- | l <= 1 = do
213−-- arr <- A.unsafeFreeze marr
214−-- let !t = Text arr o u
215−-- marr' <- A.new chunkSize
216−-- ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
217−-- return $ t : ts
218−-- | otherwise = do
219−-- n <- unsafeWrite marr (o+u) c
220−-- loop marr o (u+n) (l-n) cs
221−-- in loop p0 o0 u0 l0 str
222−-- where
223−-- chunkSize = smallChunkSize
224{-# INLINE fromString #-}
198{-# INLINE fromString #-}
225
199
226-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying
200-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying
@@ -260,24 +234,16 @@ toLazyTextWith chunkSize m = L.fromChunks (runST $
260-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,
234-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,
261-- yielding a new chunk in the result lazy @Text@.
235-- yielding a new chunk in the result lazy @Text@.
262flush :: Builder
236flush :: Builder
263−flush = Builder $ \ k buf@(Buffer p o@(I# o#) u@(I# u#) l) ->
237+flush = Builder $ \ k buf@(Buffer p o u l) ->
264 if u == 0
238 if u == 0
265 then k buf
239 then k buf
266 else do arr <- A.unsafeFreeze p
240 else do arr <- A.unsafeFreeze p
267 let !b = Buffer p (o+u) 0 l
241 let !b = Buffer p (o+u) 0 l
268− !t = Text $ js_toString (A.aBA arr) o# u#
242+ !t = Text arr o u
269 ts <- inlineInterleaveST (k b)
243 ts <- inlineInterleaveST (k b)
270 return $! t : ts
244 return $! t : ts
271{-# INLINE [1] flush #-}
245{-# INLINE [1] flush #-}
272-- defer inlining so that flush/flush rule may fire.
246-- defer inlining so that flush/flush rule may fire.
273−-- flush = Builder $ \ k buf@(Buffer p o u l) ->
274−-- if u == 0
275−-- then k buf
276−-- else do arr <- A.unsafeFreeze p
277−-- let !b = Buffer p (o+u) 0 l
278−-- !t = Text arr o u
279−-- ts <- inlineInterleaveST (k b)
280−-- return $! t : ts
281
247
282------------------------------------------------------------------------
248------------------------------------------------------------------------
283
249
@@ -361,11 +327,3 @@ append' (Builder f) (Builder g) = Builder (f . g)
361 append flush flush = flush
327 append flush flush = flush
362
328
363 #-}
329 #-}
364−
365−foreign import javascript unsafe
366− "h$textFromString"
367− js_fromString :: JSString -> (# ByteArray#, Int# #)
368−
369−foreign import javascript unsafe
370− "h$textToString"
371− js_toString :: ByteArray# -> Int# -> Int# -> JSString
Data/Text/Internal/Encoding/Fusion.hs+8−10
@@ -55,7 +55,7 @@ import qualified Data.Text.Internal.Encoding.Utf32 as U32
55import Data.Text.Unsafe (unsafeDupablePerformIO)
55import Data.Text.Unsafe (unsafeDupablePerformIO)
56
56
57streamASCII :: ByteString -> Stream Char
57streamASCII :: ByteString -> Stream Char
58−streamASCII bs = Stream next 0 -- (maxSize l)
58+streamASCII bs = Stream next 0 (maxSize l)
59 where
59 where
60 l = B.length bs
60 l = B.length bs
61 {-# INLINE next #-}
61 {-# INLINE next #-}
@@ -70,7 +70,7 @@ streamASCII bs = Stream next 0 -- (maxSize l)
70-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8
70-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8
71-- encoding.
71-- encoding.
72streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
72streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
73−streamUtf8 onErr bs = Stream next 0 -- (maxSize l)
73+streamUtf8 onErr bs = Stream next 0 (maxSize l)
74 where
74 where
75 l = B.length bs
75 l = B.length bs
76 next i
76 next i
@@ -91,7 +91,7 @@ streamUtf8 onErr bs = Stream next 0 -- (maxSize l)
91-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
91-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
92-- endian UTF-16 encoding.
92-- endian UTF-16 encoding.
93streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
93streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
94−streamUtf16LE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 1))
94+streamUtf16LE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))
95 where
95 where
96 l = B.length bs
96 l = B.length bs
97 {-# INLINE next #-}
97 {-# INLINE next #-}
@@ -109,7 +109,7 @@ streamUtf16LE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 1))
109-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
109-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
110-- endian UTF-16 encoding.
110-- endian UTF-16 encoding.
111streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
111streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
112−streamUtf16BE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 1))
112+streamUtf16BE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))
113 where
113 where
114 l = B.length bs
114 l = B.length bs
115 {-# INLINE next #-}
115 {-# INLINE next #-}
@@ -127,7 +127,7 @@ streamUtf16BE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 1))
127-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
127-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
128-- endian UTF-32 encoding.
128-- endian UTF-32 encoding.
129streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
129streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
130−streamUtf32BE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 2))
130+streamUtf32BE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))
131 where
131 where
132 l = B.length bs
132 l = B.length bs
133 {-# INLINE next #-}
133 {-# INLINE next #-}
@@ -147,7 +147,7 @@ streamUtf32BE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 2))
147-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
147-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
148-- endian UTF-32 encoding.
148-- endian UTF-32 encoding.
149streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
149streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
150−streamUtf32LE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 2))
150+streamUtf32LE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))
151 where
151 where
152 l = B.length bs
152 l = B.length bs
153 {-# INLINE next #-}
153 {-# INLINE next #-}
@@ -166,10 +166,8 @@ streamUtf32LE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 2))
166
166
167-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.
167-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.
168unstream :: Stream Word8 -> ByteString
168unstream :: Stream Word8 -> ByteString
169−-- unstream (Stream next s0 len) = unsafeDupablePerformIO $ do
169+unstream (Stream next s0 len) = unsafeDupablePerformIO $ do
170−unstream (Stream next s0) = unsafeDupablePerformIO $ do
171− -- let mlen = upperBound 4 len
170+ let mlen = upperBound 4 len
172− let mlen = 4
173 mallocByteString mlen >>= loop mlen 0 s0
171 mallocByteString mlen >>= loop mlen 0 s0
174 where
172 where
175 loop !n !off !s fp = case next s of
173 loop !n !off !s fp = case next s of
Data/Text/Internal/Encoding/Fusion/Common.hs+4−8
@@ -37,8 +37,7 @@ import Data.Text.Internal.Unsafe.Shift (shiftR)
37import Data.Word (Word8)
37import Data.Word (Word8)
38
38
39restreamUtf16BE :: Stream Char -> Stream Word8
39restreamUtf16BE :: Stream Char -> Stream Word8
40−-- restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
40+restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
41−restreamUtf16BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
42 where
41 where
43 next (RS0 s) = case next0 s of
42 next (RS0 s) = case next0 s of
44 Done -> Done
43 Done -> Done
@@ -62,8 +61,7 @@ restreamUtf16BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
62{-# INLINE restreamUtf16BE #-}
61{-# INLINE restreamUtf16BE #-}
63
62
64restreamUtf16LE :: Stream Char -> Stream Word8
63restreamUtf16LE :: Stream Char -> Stream Word8
65−-- restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
64+restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
66−restreamUtf16LE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
67 where
65 where
68 next (RS0 s) = case next0 s of
66 next (RS0 s) = case next0 s of
69 Done -> Done
67 Done -> Done
@@ -87,8 +85,7 @@ restreamUtf16LE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
87{-# INLINE restreamUtf16LE #-}
85{-# INLINE restreamUtf16LE #-}
88
86
89restreamUtf32BE :: Stream Char -> Stream Word8
87restreamUtf32BE :: Stream Char -> Stream Word8
90−restreamUtf32BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
88+restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
91−-- restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
92 where
89 where
93 next (RS0 s) = case next0 s of
90 next (RS0 s) = case next0 s of
94 Done -> Done
91 Done -> Done
@@ -107,8 +104,7 @@ restreamUtf32BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
107{-# INLINE restreamUtf32BE #-}
104{-# INLINE restreamUtf32BE #-}
108
105
109restreamUtf32LE :: Stream Char -> Stream Word8
106restreamUtf32LE :: Stream Char -> Stream Word8
110−restreamUtf32LE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
107+restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
111−-- restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
112 where
108 where
113 next (RS0 s) = case next0 s of
109 next (RS0 s) = case next0 s of
114 Done -> Done
110 Done -> Done
Data/Text/Internal/Fusion.hs+166−40
@@ -28,91 +28,217 @@ module Data.Text.Internal.Fusion
28 , unstream
28 , unstream
29 , reverseStream
29 , reverseStream
30
30
31− , Data.Text.Internal.Fusion.length
31+ , length
32
32
33 -- * Transformations
33 -- * Transformations
34− , Data.Text.Internal.Fusion.reverse
34+ , reverse
35
35
36 -- * Construction
36 -- * Construction
37 -- ** Scans
37 -- ** Scans
38 , reverseScanr
38 , reverseScanr
39
39
40 -- ** Accumulating maps
40 -- ** Accumulating maps
41− , Data.Text.Internal.Fusion.mapAccumL
41+ , mapAccumL
42
42
43 -- ** Generation and unfolding
43 -- ** Generation and unfolding
44 , unfoldrN
44 , unfoldrN
45
45
46 -- * Indexing
46 -- * Indexing
47− , Data.Text.Internal.Fusion.index
47+ , index
48− , Data.Text.Internal.Fusion.findIndex
48+ , findIndex
49 , countChar
49 , countChar
50 ) where
50 ) where
51
51
52−import GHC.Exts (Char(..), Int(..), chr#, Int#, isTrue#, (-#), (+#), (>=#))
52+import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,
53−
53+ Num(..), Ord(..), ($), (&&),
54−import Prelude hiding (length, reverse)
54+ fromIntegral, otherwise)
55−import Data.Char
55+import Data.Bits ((.&.))
56−
57−import Data.JSString.Internal.Type (JSString(..))
56+import Data.Text.Internal (Text(..))
58−import qualified Data.JSString.Internal.Type as I
57+import Data.Text.Internal.Private (runText)
58+import Data.Text.Internal.Unsafe.Char (ord, unsafeChr, unsafeWrite)
59−import Data.JSString.Internal.Fusion.Types
59+import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
60+import qualified Data.Text.Array as A
60−import qualified Data.JSString.Internal.Fusion.Common as S
61+import qualified Data.Text.Internal.Fusion.Common as S
61−
62+import Data.Text.Internal.Fusion.Types
62−import System.IO.Unsafe
63−
64−import GHCJS.Prim
65−
66−import Data.Coerce
67−import Data.Text.Internal
63+import Data.Text.Internal.Fusion.Size
68−import qualified Data.JSString.Internal.Fusion as JSS
64+import qualified Data.Text.Internal as I
69−import Data.JSString.Internal.Fusion.Types (Stream(..))
65+import qualified Data.Text.Internal.Encoding.Utf16 as U16
70
66
71default(Int)
67default(Int)
72
68
69+-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
73stream :: Text -> Stream Char
70stream :: Text -> Stream Char
74−stream = coerce JSS.stream
71+stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)
72+ where
73+ !end = off+len
74+ next !i
75+ | i >= end = Done
76+ | n >= 0xD800 && n <= 0xDBFF = Yield (U16.chr2 n n2) (i + 2)
77+ | otherwise = Yield (unsafeChr n) (i + 1)
78+ where
79+ n = A.unsafeIndex arr i
80+ n2 = A.unsafeIndex arr (i + 1)
75{-# INLINE [0] stream #-}
81{-# INLINE [0] stream #-}
76
82
83+-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate
84+-- backwards.
77reverseStream :: Text -> Stream Char
85reverseStream :: Text -> Stream Char
78−reverseStream = coerce JSS.reverseStream
86+reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `shiftR` 1) len)
87+ where
88+ {-# INLINE next #-}
89+ next !i
90+ | i < off = Done
91+ | n >= 0xDC00 && n <= 0xDFFF = Yield (U16.chr2 n2 n) (i - 2)
92+ | otherwise = Yield (unsafeChr n) (i - 1)
93+ where
94+ n = A.unsafeIndex arr i
95+ n2 = A.unsafeIndex arr (i - 1)
79{-# INLINE [0] reverseStream #-}
96{-# INLINE [0] reverseStream #-}
80
97
98+-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
81unstream :: Stream Char -> Text
99unstream :: Stream Char -> Text
82−unstream = coerce JSS.unstream
100+unstream (Stream next0 s0 len) = runText $ \done -> do
101+ -- Before encoding each char we perform a buffer realloc check assuming
102+ -- worst case encoding size of two 16-bit units for the char. Just add an
103+ -- extra space to the buffer so that we do not end up reallocating even when
104+ -- all the chars are encoded as single unit.
105+ let mlen = upperBound 4 len + 1
106+ arr0 <- A.new mlen
107+ let outer !arr !maxi = encode
108+ where
109+ -- keep the common case loop as small as possible
110+ encode !si !di =
111+ case next0 si of
112+ Done -> done arr di
113+ Skip si' -> encode si' di
114+ Yield c si'
115+ -- simply check for the worst case
116+ | maxi < di + 1 -> realloc si di
117+ | otherwise -> do
118+ n <- unsafeWrite arr di c
119+ encode si' (di + n)
120+
121+ -- keep uncommon case separate from the common case code
122+ {-# NOINLINE realloc #-}
123+ realloc !si !di = do
124+ let newlen = (maxi + 1) * 2
125+ arr' <- A.new newlen
126+ A.copyM arr' 0 arr 0 di
127+ outer arr' (newlen - 1) si di
128+
129+ outer arr0 (mlen - 1) s0 0
83{-# INLINE [0] unstream #-}
130{-# INLINE [0] unstream #-}
84{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
131{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
85
132
133+
134+-- ----------------------------------------------------------------------------
135+-- * Basic stream functions
136+
86length :: Stream Char -> Int
137length :: Stream Char -> Int
87−length = JSS.length
138+length = S.lengthI
88−{-# INLINE [0] length #-}
139+{-# INLINE[0] length #-}
89
140
141+-- | /O(n)/ Reverse the characters of a string.
90reverse :: Stream Char -> Text
142reverse :: Stream Char -> Text
91−reverse = coerce JSS.reverse
143+reverse (Stream next s len0)
144+ | isEmpty len0 = I.empty
145+ | otherwise = I.text arr off' len'
146+ where
147+ len0' = upperBound 4 (larger len0 4)
148+ (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')
149+ loop !s0 !i !len marr =
150+ case next s0 of
151+ Done -> return (marr, (j, len-j))
152+ where j = i + 1
153+ Skip s1 -> loop s1 i len marr
154+ Yield x s1 | i < least -> {-# SCC "reverse/resize" #-} do
155+ let newLen = len `shiftL` 1
156+ marr' <- A.new newLen
157+ A.copyM marr' (newLen-len) marr 0 len
158+ write s1 (len+i) newLen marr'
159+ | otherwise -> write s1 i len marr
160+ where n = ord x
161+ least | n < 0x10000 = 0
162+ | otherwise = 1
163+ m = n - 0x10000
164+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800
165+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
166+ write t j l mar
167+ | n < 0x10000 = do
168+ A.unsafeWrite mar j (fromIntegral n)
169+ loop t (j-1) l mar
170+ | otherwise = do
171+ A.unsafeWrite mar (j-1) lo
172+ A.unsafeWrite mar j hi
173+ loop t (j-2) l mar
92{-# INLINE [0] reverse #-}
174{-# INLINE [0] reverse #-}
93
175
176+-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with
177+-- the input and result reversed.
94reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
178reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
95−reverseScanr = JSS.reverseScanr
179+reverseScanr f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
180+ where
181+ {-# INLINE next #-}
182+ next (Scan1 z s) = Yield z (Scan2 z s)
183+ next (Scan2 z s) = case next0 s of
184+ Yield x s' -> let !x' = f x z
185+ in Yield x' (Scan2 x' s')
186+ Skip s' -> Skip (Scan2 z s')
187+ Done -> Done
96{-# INLINE reverseScanr #-}
188{-# INLINE reverseScanr #-}
97
189
98−mapAccumL :: (a -> Char -> (a, Char)) -> a -> Stream Char -> (a, Text)
190+-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
99−mapAccumL f z0 st =
191+-- value. However, the length of the result is limited by the
100− let (a, t) = JSS.mapAccumL f z0 st
192+-- first argument to 'unfoldrN'. This function is more efficient than
101− in (a, Text t)
193+-- 'unfoldr' when the length of the result is known.
102−{-# INLINE [0] mapAccumL #-}
103−
104unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char
194unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char
105−unfoldrN = JSS.unfoldrN
195+unfoldrN n = S.unfoldrNI n
106{-# INLINE [0] unfoldrN #-}
196{-# INLINE [0] unfoldrN #-}
107
197
198+-------------------------------------------------------------------------------
199+-- ** Indexing streams
200+
201+-- | /O(n)/ stream index (subscript) operator, starting from 0.
108index :: Stream Char -> Int -> Char
202index :: Stream Char -> Int -> Char
109−index = JSS.index
203+index = S.indexI
110{-# INLINE [0] index #-}
204{-# INLINE [0] index #-}
111
205
206+-- | The 'findIndex' function takes a predicate and a stream and
207+-- returns the index of the first element in the stream
208+-- satisfying the predicate.
112findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int
209findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int
113−findIndex = JSS.findIndex
210+findIndex = S.findIndexI
114{-# INLINE [0] findIndex #-}
211{-# INLINE [0] findIndex #-}
115
212
213+-- | /O(n)/ The 'count' function returns the number of times the query
214+-- element appears in the given stream.
116countChar :: Char -> Stream Char -> Int
215countChar :: Char -> Stream Char -> Int
117−countChar = JSS.countChar
216+countChar = S.countCharI
118{-# INLINE [0] countChar #-}
217{-# INLINE [0] countChar #-}
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/Internal/Fusion/CaseMapping.hs+4−164
@@ -1,10 +1,10 @@
1{-# LANGUAGE Rank2Types #-}
1{-# LANGUAGE Rank2Types #-}
2-- AUTOMATICALLY GENERATED - DO NOT EDIT
2-- AUTOMATICALLY GENERATED - DO NOT EDIT
3-- Generated by scripts/CaseMapping.hs
3-- Generated by scripts/CaseMapping.hs
4−-- CaseFolding-9.0.0.txt
4+-- CaseFolding-8.0.0.txt
5−-- Date: 2016-03-02, 18:54:54 GMT
5+-- Date: 2015-01-13, 18:16:36 GMT [MD]
6−-- SpecialCasing-9.0.0.txt
6+-- SpecialCasing-8.0.0.txt
7−-- Date: 2016-03-02, 18:55:13 GMT
7+-- Date: 2014-12-16, 23:08:04 GMT [MD]
8
8
9module Data.Text.Internal.Fusion.CaseMapping where
9module Data.Text.Internal.Fusion.CaseMapping where
10import Data.Char
10import Data.Char
@@ -371,24 +371,6 @@ foldMapping '\x13fb' s = Yield '\x13f3' (CC s '\x0000' '\x0000')
371foldMapping '\x13fc' s = Yield '\x13f4' (CC s '\x0000' '\x0000')
371foldMapping '\x13fc' s = Yield '\x13f4' (CC s '\x0000' '\x0000')
372-- CHEROKEE SMALL LETTER MV
372-- CHEROKEE SMALL LETTER MV
373foldMapping '\x13fd' s = Yield '\x13f5' (CC s '\x0000' '\x0000')
373foldMapping '\x13fd' s = Yield '\x13f5' (CC s '\x0000' '\x0000')
374−-- CYRILLIC SMALL LETTER ROUNDED VE
375−foldMapping '\x1c80' s = Yield '\x0432' (CC s '\x0000' '\x0000')
376−-- CYRILLIC SMALL LETTER LONG-LEGGED DE
377−foldMapping '\x1c81' s = Yield '\x0434' (CC s '\x0000' '\x0000')
378−-- CYRILLIC SMALL LETTER NARROW O
379−foldMapping '\x1c82' s = Yield '\x043e' (CC s '\x0000' '\x0000')
380−-- CYRILLIC SMALL LETTER WIDE ES
381−foldMapping '\x1c83' s = Yield '\x0441' (CC s '\x0000' '\x0000')
382−-- CYRILLIC SMALL LETTER TALL TE
383−foldMapping '\x1c84' s = Yield '\x0442' (CC s '\x0000' '\x0000')
384−-- CYRILLIC SMALL LETTER THREE-LEGGED TE
385−foldMapping '\x1c85' s = Yield '\x0442' (CC s '\x0000' '\x0000')
386−-- CYRILLIC SMALL LETTER TALL HARD SIGN
387−foldMapping '\x1c86' s = Yield '\x044a' (CC s '\x0000' '\x0000')
388−-- CYRILLIC SMALL LETTER TALL YAT
389−foldMapping '\x1c87' s = Yield '\x0463' (CC s '\x0000' '\x0000')
390−-- CYRILLIC SMALL LETTER UNBLENDED UK
391−foldMapping '\x1c88' s = Yield '\xa64b' (CC s '\x0000' '\x0000')
392-- LATIN SMALL LETTER H WITH LINE BELOW
374-- LATIN SMALL LETTER H WITH LINE BELOW
393foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')
375foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')
394-- LATIN SMALL LETTER T WITH DIAERESIS
376-- LATIN SMALL LETTER T WITH DIAERESIS
@@ -563,8 +545,6 @@ foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')
563foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')
545foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')
564-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
546-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
565foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')
547foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')
566−-- LATIN CAPITAL LETTER SMALL CAPITAL I
567−foldMapping '\xa7ae' s = Yield '\x026a' (CC s '\x0000' '\x0000')
568-- LATIN CAPITAL LETTER J WITH CROSSED-TAIL
548-- LATIN CAPITAL LETTER J WITH CROSSED-TAIL
569foldMapping '\xa7b2' s = Yield '\x029d' (CC s '\x0000' '\x0000')
549foldMapping '\xa7b2' s = Yield '\x029d' (CC s '\x0000' '\x0000')
570-- LATIN CAPITAL LETTER CHI
550-- LATIN CAPITAL LETTER CHI
@@ -757,78 +737,6 @@ foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')
757foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')
737foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')
758-- ARMENIAN SMALL LIGATURE MEN XEH
738-- ARMENIAN SMALL LIGATURE MEN XEH
759foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')
739foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')
760−-- OSAGE CAPITAL LETTER A
761−foldMapping '\x104b0' s = Yield '\x104d8' (CC s '\x0000' '\x0000')
762−-- OSAGE CAPITAL LETTER AI
763−foldMapping '\x104b1' s = Yield '\x104d9' (CC s '\x0000' '\x0000')
764−-- OSAGE CAPITAL LETTER AIN
765−foldMapping '\x104b2' s = Yield '\x104da' (CC s '\x0000' '\x0000')
766−-- OSAGE CAPITAL LETTER AH
767−foldMapping '\x104b3' s = Yield '\x104db' (CC s '\x0000' '\x0000')
768−-- OSAGE CAPITAL LETTER BRA
769−foldMapping '\x104b4' s = Yield '\x104dc' (CC s '\x0000' '\x0000')
770−-- OSAGE CAPITAL LETTER CHA
771−foldMapping '\x104b5' s = Yield '\x104dd' (CC s '\x0000' '\x0000')
772−-- OSAGE CAPITAL LETTER EHCHA
773−foldMapping '\x104b6' s = Yield '\x104de' (CC s '\x0000' '\x0000')
774−-- OSAGE CAPITAL LETTER E
775−foldMapping '\x104b7' s = Yield '\x104df' (CC s '\x0000' '\x0000')
776−-- OSAGE CAPITAL LETTER EIN
777−foldMapping '\x104b8' s = Yield '\x104e0' (CC s '\x0000' '\x0000')
778−-- OSAGE CAPITAL LETTER HA
779−foldMapping '\x104b9' s = Yield '\x104e1' (CC s '\x0000' '\x0000')
780−-- OSAGE CAPITAL LETTER HYA
781−foldMapping '\x104ba' s = Yield '\x104e2' (CC s '\x0000' '\x0000')
782−-- OSAGE CAPITAL LETTER I
783−foldMapping '\x104bb' s = Yield '\x104e3' (CC s '\x0000' '\x0000')
784−-- OSAGE CAPITAL LETTER KA
785−foldMapping '\x104bc' s = Yield '\x104e4' (CC s '\x0000' '\x0000')
786−-- OSAGE CAPITAL LETTER EHKA
787−foldMapping '\x104bd' s = Yield '\x104e5' (CC s '\x0000' '\x0000')
788−-- OSAGE CAPITAL LETTER KYA
789−foldMapping '\x104be' s = Yield '\x104e6' (CC s '\x0000' '\x0000')
790−-- OSAGE CAPITAL LETTER LA
791−foldMapping '\x104bf' s = Yield '\x104e7' (CC s '\x0000' '\x0000')
792−-- OSAGE CAPITAL LETTER MA
793−foldMapping '\x104c0' s = Yield '\x104e8' (CC s '\x0000' '\x0000')
794−-- OSAGE CAPITAL LETTER NA
795−foldMapping '\x104c1' s = Yield '\x104e9' (CC s '\x0000' '\x0000')
796−-- OSAGE CAPITAL LETTER O
797−foldMapping '\x104c2' s = Yield '\x104ea' (CC s '\x0000' '\x0000')
798−-- OSAGE CAPITAL LETTER OIN
799−foldMapping '\x104c3' s = Yield '\x104eb' (CC s '\x0000' '\x0000')
800−-- OSAGE CAPITAL LETTER PA
801−foldMapping '\x104c4' s = Yield '\x104ec' (CC s '\x0000' '\x0000')
802−-- OSAGE CAPITAL LETTER EHPA
803−foldMapping '\x104c5' s = Yield '\x104ed' (CC s '\x0000' '\x0000')
804−-- OSAGE CAPITAL LETTER SA
805−foldMapping '\x104c6' s = Yield '\x104ee' (CC s '\x0000' '\x0000')
806−-- OSAGE CAPITAL LETTER SHA
807−foldMapping '\x104c7' s = Yield '\x104ef' (CC s '\x0000' '\x0000')
808−-- OSAGE CAPITAL LETTER TA
809−foldMapping '\x104c8' s = Yield '\x104f0' (CC s '\x0000' '\x0000')
810−-- OSAGE CAPITAL LETTER EHTA
811−foldMapping '\x104c9' s = Yield '\x104f1' (CC s '\x0000' '\x0000')
812−-- OSAGE CAPITAL LETTER TSA
813−foldMapping '\x104ca' s = Yield '\x104f2' (CC s '\x0000' '\x0000')
814−-- OSAGE CAPITAL LETTER EHTSA
815−foldMapping '\x104cb' s = Yield '\x104f3' (CC s '\x0000' '\x0000')
816−-- OSAGE CAPITAL LETTER TSHA
817−foldMapping '\x104cc' s = Yield '\x104f4' (CC s '\x0000' '\x0000')
818−-- OSAGE CAPITAL LETTER DHA
819−foldMapping '\x104cd' s = Yield '\x104f5' (CC s '\x0000' '\x0000')
820−-- OSAGE CAPITAL LETTER U
821−foldMapping '\x104ce' s = Yield '\x104f6' (CC s '\x0000' '\x0000')
822−-- OSAGE CAPITAL LETTER WA
823−foldMapping '\x104cf' s = Yield '\x104f7' (CC s '\x0000' '\x0000')
824−-- OSAGE CAPITAL LETTER KHA
825−foldMapping '\x104d0' s = Yield '\x104f8' (CC s '\x0000' '\x0000')
826−-- OSAGE CAPITAL LETTER GHA
827−foldMapping '\x104d1' s = Yield '\x104f9' (CC s '\x0000' '\x0000')
828−-- OSAGE CAPITAL LETTER ZA
829−foldMapping '\x104d2' s = Yield '\x104fa' (CC s '\x0000' '\x0000')
830−-- OSAGE CAPITAL LETTER ZHA
831−foldMapping '\x104d3' s = Yield '\x104fb' (CC s '\x0000' '\x0000')
832-- OLD HUNGARIAN CAPITAL LETTER A
740-- OLD HUNGARIAN CAPITAL LETTER A
833foldMapping '\x10c80' s = Yield '\x10cc0' (CC s '\x0000' '\x0000')
741foldMapping '\x10c80' s = Yield '\x10cc0' (CC s '\x0000' '\x0000')
834-- OLD HUNGARIAN CAPITAL LETTER AA
742-- OLD HUNGARIAN CAPITAL LETTER AA
@@ -931,72 +839,4 @@ foldMapping '\x10cb0' s = Yield '\x10cf0' (CC s '\x0000' '\x0000')
931foldMapping '\x10cb1' s = Yield '\x10cf1' (CC s '\x0000' '\x0000')
839foldMapping '\x10cb1' s = Yield '\x10cf1' (CC s '\x0000' '\x0000')
932-- OLD HUNGARIAN CAPITAL LETTER US
840-- OLD HUNGARIAN CAPITAL LETTER US
933foldMapping '\x10cb2' s = Yield '\x10cf2' (CC s '\x0000' '\x0000')
841foldMapping '\x10cb2' s = Yield '\x10cf2' (CC s '\x0000' '\x0000')
934−-- ADLAM CAPITAL LETTER ALIF
935−foldMapping '\x1e900' s = Yield '\x1e922' (CC s '\x0000' '\x0000')
936−-- ADLAM CAPITAL LETTER DAALI
937−foldMapping '\x1e901' s = Yield '\x1e923' (CC s '\x0000' '\x0000')
938−-- ADLAM CAPITAL LETTER LAAM
939−foldMapping '\x1e902' s = Yield '\x1e924' (CC s '\x0000' '\x0000')
940−-- ADLAM CAPITAL LETTER MIIM
941−foldMapping '\x1e903' s = Yield '\x1e925' (CC s '\x0000' '\x0000')
942−-- ADLAM CAPITAL LETTER BA
943−foldMapping '\x1e904' s = Yield '\x1e926' (CC s '\x0000' '\x0000')
944−-- ADLAM CAPITAL LETTER SINNYIIYHE
945−foldMapping '\x1e905' s = Yield '\x1e927' (CC s '\x0000' '\x0000')
946−-- ADLAM CAPITAL LETTER PE
947−foldMapping '\x1e906' s = Yield '\x1e928' (CC s '\x0000' '\x0000')
948−-- ADLAM CAPITAL LETTER BHE
949−foldMapping '\x1e907' s = Yield '\x1e929' (CC s '\x0000' '\x0000')
950−-- ADLAM CAPITAL LETTER RA
951−foldMapping '\x1e908' s = Yield '\x1e92a' (CC s '\x0000' '\x0000')
952−-- ADLAM CAPITAL LETTER E
953−foldMapping '\x1e909' s = Yield '\x1e92b' (CC s '\x0000' '\x0000')
954−-- ADLAM CAPITAL LETTER FA
955−foldMapping '\x1e90a' s = Yield '\x1e92c' (CC s '\x0000' '\x0000')
956−-- ADLAM CAPITAL LETTER I
957−foldMapping '\x1e90b' s = Yield '\x1e92d' (CC s '\x0000' '\x0000')
958−-- ADLAM CAPITAL LETTER O
959−foldMapping '\x1e90c' s = Yield '\x1e92e' (CC s '\x0000' '\x0000')
960−-- ADLAM CAPITAL LETTER DHA
961−foldMapping '\x1e90d' s = Yield '\x1e92f' (CC s '\x0000' '\x0000')
962−-- ADLAM CAPITAL LETTER YHE
963−foldMapping '\x1e90e' s = Yield '\x1e930' (CC s '\x0000' '\x0000')
964−-- ADLAM CAPITAL LETTER WAW
965−foldMapping '\x1e90f' s = Yield '\x1e931' (CC s '\x0000' '\x0000')
966−-- ADLAM CAPITAL LETTER NUN
967−foldMapping '\x1e910' s = Yield '\x1e932' (CC s '\x0000' '\x0000')
968−-- ADLAM CAPITAL LETTER KAF
969−foldMapping '\x1e911' s = Yield '\x1e933' (CC s '\x0000' '\x0000')
970−-- ADLAM CAPITAL LETTER YA
971−foldMapping '\x1e912' s = Yield '\x1e934' (CC s '\x0000' '\x0000')
972−-- ADLAM CAPITAL LETTER U
973−foldMapping '\x1e913' s = Yield '\x1e935' (CC s '\x0000' '\x0000')
974−-- ADLAM CAPITAL LETTER JIIM
975−foldMapping '\x1e914' s = Yield '\x1e936' (CC s '\x0000' '\x0000')
976−-- ADLAM CAPITAL LETTER CHI
977−foldMapping '\x1e915' s = Yield '\x1e937' (CC s '\x0000' '\x0000')
978−-- ADLAM CAPITAL LETTER HA
979−foldMapping '\x1e916' s = Yield '\x1e938' (CC s '\x0000' '\x0000')
980−-- ADLAM CAPITAL LETTER QAAF
981−foldMapping '\x1e917' s = Yield '\x1e939' (CC s '\x0000' '\x0000')
982−-- ADLAM CAPITAL LETTER GA
983−foldMapping '\x1e918' s = Yield '\x1e93a' (CC s '\x0000' '\x0000')
984−-- ADLAM CAPITAL LETTER NYA
985−foldMapping '\x1e919' s = Yield '\x1e93b' (CC s '\x0000' '\x0000')
986−-- ADLAM CAPITAL LETTER TU
987−foldMapping '\x1e91a' s = Yield '\x1e93c' (CC s '\x0000' '\x0000')
988−-- ADLAM CAPITAL LETTER NHA
989−foldMapping '\x1e91b' s = Yield '\x1e93d' (CC s '\x0000' '\x0000')
990−-- ADLAM CAPITAL LETTER VA
991−foldMapping '\x1e91c' s = Yield '\x1e93e' (CC s '\x0000' '\x0000')
992−-- ADLAM CAPITAL LETTER KHA
993−foldMapping '\x1e91d' s = Yield '\x1e93f' (CC s '\x0000' '\x0000')
994−-- ADLAM CAPITAL LETTER GBE
995−foldMapping '\x1e91e' s = Yield '\x1e940' (CC s '\x0000' '\x0000')
996−-- ADLAM CAPITAL LETTER ZAL
997−foldMapping '\x1e91f' s = Yield '\x1e941' (CC s '\x0000' '\x0000')
998−-- ADLAM CAPITAL LETTER KPO
999−foldMapping '\x1e920' s = Yield '\x1e942' (CC s '\x0000' '\x0000')
1000−-- ADLAM CAPITAL LETTER SHA
1001−foldMapping '\x1e921' s = Yield '\x1e943' (CC s '\x0000' '\x0000')
1002foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
842foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
Data/Text/Internal/Fusion/Common.hs+922−968
@@ -14,971 +14,925 @@
14--
14--
15-- Common stream fusion functionality for text.
15-- Common stream fusion functionality for text.
16
16
17−module Data.Text.Internal.Fusion.Common (module Data.JSString.Internal.Fusion.Common) where
17+module Data.Text.Internal.Fusion.Common
18−import Data.JSString.Internal.Fusion.Common
18+ (
19−-- module Data.Text.Internal.Fusion.Common
19+ -- * Creation and elimination
20−-- (
20+ singleton
21−-- -- * Creation and elimination
21+ , streamList
22−-- singleton
22+ , unstreamList
23−-- , streamList
23+ , streamCString#
24−-- , unstreamList
24+
25−-- , streamCString#
25+ -- * Basic interface
26−
26+ , cons
27−-- -- * Basic interface
27+ , snoc
28−-- , cons
28+ , append
29−-- , snoc
29+ , head
30−-- , append
30+ , uncons
31−-- , head
31+ , last
32−-- , uncons
32+ , tail
33−-- , last
33+ , init
34−-- , tail
34+ , null
35−-- , init
35+ , lengthI
36−-- , null
36+ , compareLengthI
37−-- , lengthI
37+ , isSingleton
38−-- , compareLengthI
38+
39−-- , isSingleton
39+ -- * Transformations
40−
40+ , map
41−-- -- * Transformations
41+ , intercalate
42−-- , map
42+ , intersperse
43−-- , intercalate
43+
44−-- , intersperse
44+ -- ** Case conversion
45−
45+ -- $case
46−-- -- ** Case conversion
46+ , toCaseFold
47−-- -- $case
47+ , toLower
48−-- , toCaseFold
48+ , toTitle
49−-- , toLower
49+ , toUpper
50−-- , toTitle
50+
51−-- , toUpper
51+ -- ** Justification
52−
52+ , justifyLeftI
53−-- -- ** Justification
53+
54−-- , justifyLeftI
54+ -- * Folds
55−
55+ , foldl
56−-- -- * Folds
56+ , foldl'
57−-- , foldl
57+ , foldl1
58−-- , foldl'
58+ , foldl1'
59−-- , foldl1
59+ , foldr
60−-- , foldl1'
60+ , foldr1
61−-- , foldr
61+
62−-- , foldr1
62+ -- ** Special folds
63−
63+ , concat
64−-- -- ** Special folds
64+ , concatMap
65−-- , concat
65+ , any
66−-- , concatMap
66+ , all
67−-- , any
67+ , maximum
68−-- , all
68+ , minimum
69−-- , maximum
69+
70−-- , minimum
70+ -- * Construction
71−
71+ -- ** Scans
72−-- -- * Construction
72+ , scanl
73−-- -- ** Scans
73+
74−-- , scanl
74+ -- ** Generation and unfolding
75−
75+ , replicateCharI
76−-- -- ** Generation and unfolding
76+ , replicateI
77−-- , replicateCharI
77+ , unfoldr
78−-- , replicateI
78+ , unfoldrNI
79−-- , unfoldr
79+
80−-- , unfoldrNI
80+ -- * Substrings
81−
81+ -- ** Breaking strings
82−-- -- * Substrings
82+ , take
83−-- -- ** Breaking strings
83+ , drop
84−-- , take
84+ , takeWhile
85−-- , drop
85+ , dropWhile
86−-- , takeWhile
86+
87−-- , dropWhile
87+ -- * Predicates
88−
88+ , isPrefixOf
89−-- -- * Predicates
89+
90−-- , isPrefixOf
90+ -- * Searching
91−
91+ , elem
92−-- -- * Searching
92+ , filter
93−-- , elem
93+
94−-- , filter
94+ -- * Indexing
95−
95+ , findBy
96−-- -- * Indexing
96+ , indexI
97−-- , findBy
97+ , findIndexI
98−-- , indexI
98+ , countCharI
99−-- , findIndexI
99+
100−-- , countCharI
100+ -- * Zipping and unzipping
101−
101+ , zipWith
102−-- -- * Zipping and unzipping
102+ ) where
103−-- , zipWith
103+
104−-- ) where
104+import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
105−
105+ Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),
106−-- import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
106+ (&&), fromIntegral, otherwise)
107−-- Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),
107+import qualified Data.List as L
108−-- (&&), fromIntegral, otherwise)
108+import qualified Prelude as P
109−-- import qualified Data.List as L
109+import Data.Bits (shiftL)
110−-- import qualified Prelude as P
110+import Data.Char (isLetter)
111−-- import Data.Bits (shiftL)
111+import Data.Int (Int64)
112−-- import Data.Char (isLetter)
112+import Data.Text.Internal.Fusion.Types
113−-- import Data.Int (Int64)
113+import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,
114−-- import Data.Text.Internal.Fusion.Types
114+ upperMapping)
115−-- import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,
115+import Data.Text.Internal.Fusion.Size
116−-- upperMapping)
116+import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)
117−-- import Data.Text.Internal.Fusion.Size
117+import GHC.Types (Char(..), Int(..))
118−-- import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)
118+
119−-- import GHC.Types (Char(..), Int(..))
119+singleton :: Char -> Stream Char
120−
120+singleton c = Stream next False 1
121−-- singleton :: Char -> Stream Char
121+ where next False = Yield c True
122−-- singleton c = Stream next False -- 1
122+ next True = Done
123−-- where next False = Yield c True
123+{-# INLINE [0] singleton #-}
124−-- next True = Done
124+
125−-- {-# INLINE [0] singleton #-}
125+streamList :: [a] -> Stream a
126−
126+{-# INLINE [0] streamList #-}
127−-- streamList :: [a] -> Stream a
127+streamList s = Stream next s unknownSize
128−-- {-# INLINE [0] streamList #-}
128+ where next [] = Done
129−-- streamList s = Stream next s -- unknownSize
129+ next (x:xs) = Yield x xs
130−-- where next [] = Done
130+
131−-- next (x:xs) = Yield x xs
131+unstreamList :: Stream a -> [a]
132−
132+unstreamList (Stream next s0 _len) = unfold s0
133−-- unstreamList :: Stream a -> [a]
133+ where unfold !s = case next s of
134−-- -- unstreamList (Stream next s0 _len) = unfold s0
134+ Done -> []
135−-- unstreamList (Stream next s0) = unfold s0
135+ Skip s' -> unfold s'
136−-- where unfold !s = case next s of
136+ Yield x s' -> x : unfold s'
137−-- Done -> []
137+{-# INLINE [0] unstreamList #-}
138−-- Skip s' -> unfold s'
138+
139−-- Yield x s' -> x : unfold s'
139+{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}
140−-- {-# INLINE [0] unstreamList #-}
140+
141−
141+-- | Stream the UTF-8-like packed encoding used by GHC to represent
142−-- {-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}
142+-- constant strings in generated code.
143−
143+--
144−-- -- | Stream the UTF-8-like packed encoding used by GHC to represent
144+-- This encoding uses the byte sequence "\xc0\x80" to represent NUL,
145−-- -- constant strings in generated code.
145+-- and the string is NUL-terminated.
146−-- --
146+streamCString# :: Addr# -> Stream Char
147−-- -- This encoding uses the byte sequence "\xc0\x80" to represent NUL,
147+streamCString# addr = Stream step 0 unknownSize
148−-- -- and the string is NUL-terminated.
148+ where
149−-- streamCString# :: Addr# -> Stream Char
149+ step !i
150−-- streamCString# addr = Stream step 0 -- unknownSize
150+ | b == 0 = Done
151−-- where
151+ | b <= 0x7f = Yield (C# b#) (i+1)
152−-- step !i
152+ | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1
153−-- | b == 0 = Done
153+ in Yield c (i+2)
154−-- | b <= 0x7f = Yield (C# b#) (i+1)
154+ | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +
155−-- | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1
155+ (next 1 `shiftL` 6) +
156−-- in Yield c (i+2)
156+ next 2
157−-- | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +
157+ in Yield c (i+3)
158−-- (next 1 `shiftL` 6) +
158+ | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +
159−-- next 2
159+ (next 1 `shiftL` 12) +
160−-- in Yield c (i+3)
160+ (next 2 `shiftL` 6) +
161−-- | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +
161+ next 3
162−-- (next 1 `shiftL` 12) +
162+ in Yield c (i+4)
163−-- (next 2 `shiftL` 6) +
163+ where b = I# (ord# b#)
164−-- next 3
164+ next n = I# (ord# (at# (i+n))) - 0x80
165−-- in Yield c (i+4)
165+ !b# = at# i
166−-- where b = I# (ord# b#)
166+ at# (I# i#) = indexCharOffAddr# addr i#
167−-- next n = I# (ord# (at# (i+n))) - 0x80
167+ chr (I# i#) = C# (chr# i#)
168−-- !b# = at# i
168+{-# INLINE [0] streamCString# #-}
169−-- at# (I# i#) = indexCharOffAddr# addr i#
169+
170−-- chr (I# i#) = C# (chr# i#)
170+-- ----------------------------------------------------------------------------
171−-- {-# INLINE [0] streamCString# #-}
171+-- * Basic stream functions
172−
172+
173−-- -- ----------------------------------------------------------------------------
173+data C s = C0 !s
174−-- -- * Basic stream functions
174+ | C1 !s
175−
175+
176−-- data C s = C0 !s
176+-- | /O(n)/ Adds a character to the front of a Stream Char.
177−-- | C1 !s
177+cons :: Char -> Stream Char -> Stream Char
178−
178+cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
179−-- -- | /O(n)/ Adds a character to the front of a Stream Char.
179+ where
180−-- cons :: Char -> Stream Char -> Stream Char
180+ next (C1 s) = Yield w (C0 s)
181−-- -- cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
181+ next (C0 s) = case next0 s of
182−-- cons !w (Stream next0 s0) = Stream next (C1 s0) -- (len+1)
182+ Done -> Done
183−-- where
183+ Skip s' -> Skip (C0 s')
184−-- next (C1 s) = Yield w (C0 s)
184+ Yield x s' -> Yield x (C0 s')
185−-- next (C0 s) = case next0 s of
185+{-# INLINE [0] cons #-}
186−-- Done -> Done
186+
187−-- Skip s' -> Skip (C0 s')
187+data Snoc a = N
188−-- Yield x s' -> Yield x (C0 s')
188+ | J !a
189−-- {-# INLINE [0] cons #-}
189+
190−
190+-- | /O(n)/ Adds a character to the end of a stream.
191−-- data Snoc a = N
191+snoc :: Stream Char -> Char -> Stream Char
192−-- | J !a
192+snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
193−
193+ where
194−-- -- | /O(n)/ Adds a character to the end of a stream.
194+ next (J xs) = case next0 xs of
195−-- snoc :: Stream Char -> Char -> Stream Char
195+ Done -> Yield w N
196−-- -- snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
196+ Skip xs' -> Skip (J xs')
197−-- snoc (Stream next0 xs0) w = Stream next (J xs0) -- (len+1)
197+ Yield x xs' -> Yield x (J xs')
198−-- where
198+ next N = Done
199−-- next (J xs) = case next0 xs of
199+{-# INLINE [0] snoc #-}
200−-- Done -> Yield w N
200+
201−-- Skip xs' -> Skip (J xs')
201+data E l r = L !l
202−-- Yield x xs' -> Yield x (J xs')
202+ | R !r
203−-- next N = Done
203+
204−-- {-# INLINE [0] snoc #-}
204+-- | /O(n)/ Appends one Stream to the other.
205−
205+append :: Stream Char -> Stream Char -> Stream Char
206−-- data E l r = L !l
206+append (Stream next0 s01 len1) (Stream next1 s02 len2) =
207−-- | R !r
207+ Stream next (L s01) (len1 + len2)
208−
208+ where
209−-- -- | /O(n)/ Appends one Stream to the other.
209+ next (L s1) = case next0 s1 of
210−-- append :: Stream Char -> Stream Char -> Stream Char
210+ Done -> Skip (R s02)
211−-- -- append (Stream next0 s01 len1) (Stream next1 s02 len2) =
211+ Skip s1' -> Skip (L s1')
212−-- -- Stream next (L s01) (len1 + len2)
212+ Yield x s1' -> Yield x (L s1')
213−-- append (Stream next0 s01) (Stream next1 s02) =
213+ next (R s2) = case next1 s2 of
214−-- Stream next (L s01)
214+ Done -> Done
215−-- where
215+ Skip s2' -> Skip (R s2')
216−-- next (L s1) = case next0 s1 of
216+ Yield x s2' -> Yield x (R s2')
217−-- Done -> Skip (R s02)
217+{-# INLINE [0] append #-}
218−-- Skip s1' -> Skip (L s1')
218+
219−-- Yield x s1' -> Yield x (L s1')
219+-- | /O(1)/ Returns the first character of a Text, which must be non-empty.
220−-- next (R s2) = case next1 s2 of
220+-- Subject to array fusion.
221−-- Done -> Done
221+head :: Stream Char -> Char
222−-- Skip s2' -> Skip (R s2')
222+head (Stream next s0 _len) = loop_head s0
223−-- Yield x s2' -> Yield x (R s2')
223+ where
224−-- {-# INLINE [0] append #-}
224+ loop_head !s = case next s of
225−
225+ Yield x _ -> x
226−-- -- | /O(1)/ Returns the first character of a Text, which must be non-empty.
226+ Skip s' -> loop_head s'
227−-- -- Subject to array fusion.
227+ Done -> head_empty
228−-- head :: Stream Char -> Char
228+{-# INLINE [0] head #-}
229−-- -- head (Stream next s0 _len) = loop_head s0
229+
230−-- head (Stream next s0) = loop_head s0
230+head_empty :: a
231−-- where
231+head_empty = streamError "head" "Empty stream"
232−-- loop_head !s = case next s of
232+{-# NOINLINE head_empty #-}
233−-- Yield x _ -> x
233+
234−-- Skip s' -> loop_head s'
234+-- | /O(1)/ Returns the first character and remainder of a 'Stream
235−-- Done -> head_empty
235+-- Char', or 'Nothing' if empty. Subject to array fusion.
236−-- {-# INLINE [0] head #-}
236+uncons :: Stream Char -> Maybe (Char, Stream Char)
237−
237+uncons (Stream next s0 len) = loop_uncons s0
238−-- head_empty :: a
238+ where
239−-- head_empty = streamError "head" "Empty stream"
239+ loop_uncons !s = case next s of
240−-- {-# NOINLINE head_empty #-}
240+ Yield x s1 -> Just (x, Stream next s1 (len-1))
241−
241+ Skip s' -> loop_uncons s'
242−-- -- | /O(1)/ Returns the first character and remainder of a 'Stream
242+ Done -> Nothing
243−-- -- Char', or 'Nothing' if empty. Subject to array fusion.
243+{-# INLINE [0] uncons #-}
244−-- uncons :: Stream Char -> Maybe (Char, Stream Char)
244+
245−-- -- uncons (Stream next s0 len) = loop_uncons s0
245+-- | /O(n)/ Returns the last character of a 'Stream Char', which must
246−-- uncons (Stream next s0) = loop_uncons s0
246+-- be non-empty.
247−-- where
247+last :: Stream Char -> Char
248−-- loop_uncons !s = case next s of
248+last (Stream next s0 _len) = loop0_last s0
249−-- Yield x s1 -> Just (x, Stream next s1)
249+ where
250−-- Skip s' -> loop_uncons s'
250+ loop0_last !s = case next s of
251−-- Done -> Nothing
251+ Done -> emptyError "last"
252−-- {-# INLINE [0] uncons #-}
252+ Skip s' -> loop0_last s'
253−
253+ Yield x s' -> loop_last x s'
254−-- -- | /O(n)/ Returns the last character of a 'Stream Char', which must
254+ loop_last !x !s = case next s of
255−-- -- be non-empty.
255+ Done -> x
256−-- last :: Stream Char -> Char
256+ Skip s' -> loop_last x s'
257−-- -- last (Stream next s0 _len) = loop0_last s0
257+ Yield x' s' -> loop_last x' s'
258−-- last (Stream next s0) = loop0_last s0
258+{-# INLINE[0] last #-}
259−-- where
259+
260−-- loop0_last !s = case next s of
260+-- | /O(1)/ Returns all characters after the head of a Stream Char, which must
261−-- Done -> emptyError "last"
261+-- be non-empty.
262−-- Skip s' -> loop0_last s'
262+tail :: Stream Char -> Stream Char
263−-- Yield x s' -> loop_last x s'
263+tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)
264−-- loop_last !x !s = case next s of
264+ where
265−-- Done -> x
265+ next (C0 s) = case next0 s of
266−-- Skip s' -> loop_last x s'
266+ Done -> emptyError "tail"
267−-- Yield x' s' -> loop_last x' s'
267+ Skip s' -> Skip (C0 s')
268−-- {-# INLINE[0] last #-}
268+ Yield _ s' -> Skip (C1 s')
269−
269+ next (C1 s) = case next0 s of
270−-- -- | /O(1)/ Returns all characters after the head of a Stream Char, which must
270+ Done -> Done
271−-- -- be non-empty.
271+ Skip s' -> Skip (C1 s')
272−-- tail :: Stream Char -> Stream Char
272+ Yield x s' -> Yield x (C1 s')
273−-- -- tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)
273+{-# INLINE [0] tail #-}
274−-- tail (Stream next0 s0) = Stream next (C0 s0) -- (len-1)
274+
275−-- where
275+data Init s = Init0 !s
276−-- next (C0 s) = case next0 s of
276+ | Init1 {-# UNPACK #-} !Char !s
277−-- Done -> emptyError "tail"
277+
278−-- Skip s' -> Skip (C0 s')
278+-- | /O(1)/ Returns all but the last character of a Stream Char, which
279−-- Yield _ s' -> Skip (C1 s')
279+-- must be non-empty.
280−-- next (C1 s) = case next0 s of
280+init :: Stream Char -> Stream Char
281−-- Done -> Done
281+init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)
282−-- Skip s' -> Skip (C1 s')
282+ where
283−-- Yield x s' -> Yield x (C1 s')
283+ next (Init0 s) = case next0 s of
284−-- {-# INLINE [0] tail #-}
284+ Done -> emptyError "init"
285−
285+ Skip s' -> Skip (Init0 s')
286−-- data Init s = Init0 !s
286+ Yield x s' -> Skip (Init1 x s')
287−-- | Init1 {-# UNPACK #-} !Char !s
287+ next (Init1 x s) = case next0 s of
288−
288+ Done -> Done
289−-- -- | /O(1)/ Returns all but the last character of a Stream Char, which
289+ Skip s' -> Skip (Init1 x s')
290−-- -- must be non-empty.
290+ Yield x' s' -> Yield x (Init1 x' s')
291−-- init :: Stream Char -> Stream Char
291+{-# INLINE [0] init #-}
292−-- -- init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)
292+
293−-- init (Stream next0 s0) = Stream next (Init0 s0) -- (len-1)
293+-- | /O(1)/ Tests whether a Stream Char is empty or not.
294−-- where
294+null :: Stream Char -> Bool
295−-- next (Init0 s) = case next0 s of
295+null (Stream next s0 _len) = loop_null s0
296−-- Done -> emptyError "init"
296+ where
297−-- Skip s' -> Skip (Init0 s')
297+ loop_null !s = case next s of
298−-- Yield x s' -> Skip (Init1 x s')
298+ Done -> True
299−-- next (Init1 x s) = case next0 s of
299+ Yield _ _ -> False
300−-- Done -> Done
300+ Skip s' -> loop_null s'
301−-- Skip s' -> Skip (Init1 x s')
301+{-# INLINE[0] null #-}
302−-- Yield x' s' -> Yield x (Init1 x' s')
302+
303−-- {-# INLINE [0] init #-}
303+-- | /O(n)/ Returns the number of characters in a string.
304−
304+lengthI :: Integral a => Stream Char -> a
305−-- -- | /O(1)/ Tests whether a Stream Char is empty or not.
305+lengthI (Stream next s0 _len) = loop_length 0 s0
306−-- null :: Stream Char -> Bool
306+ where
307−-- -- null (Stream next s0 _len) = loop_null s0
307+ loop_length !z s = case next s of
308−-- null (Stream next s0) = loop_null s0
308+ Done -> z
309−-- where
309+ Skip s' -> loop_length z s'
310−-- loop_null !s = case next s of
310+ Yield _ s' -> loop_length (z + 1) s'
311−-- Done -> True
311+{-# INLINE[0] lengthI #-}
312−-- Yield _ _ -> False
312+
313−-- Skip s' -> loop_null s'
313+-- | /O(n)/ Compares the count of characters in a string to a number.
314−-- {-# INLINE[0] null #-}
314+-- Subject to fusion.
315−
315+--
316−-- -- | /O(n)/ Returns the number of characters in a string.
316+-- This function gives the same answer as comparing against the result
317−-- lengthI :: Integral a => Stream Char -> a
317+-- of 'lengthI', but can short circuit if the count of characters is
318−-- -- lengthI (Stream next s0 _len) = loop_length 0 s0
318+-- greater than the number or if the stream can't possibly be as long
319−-- lengthI (Stream next s0) = loop_length 0 s0
319+-- as the number supplied, and hence be more efficient.
320−-- where
320+compareLengthI :: Integral a => Stream Char -> a -> Ordering
321−-- loop_length !z s = case next s of
321+compareLengthI (Stream next s0 len) n =
322−-- Done -> z
322+ case compareSize len (fromIntegral n) of
323−-- Skip s' -> loop_length z s'
323+ Just o -> o
324−-- Yield _ s' -> loop_length (z + 1) s'
324+ Nothing -> loop_cmp 0 s0
325−-- {-# INLINE[0] lengthI #-}
325+ where
326−
326+ loop_cmp !z s = case next s of
327−-- -- | /O(n)/ Compares the count of characters in a string to a number.
327+ Done -> compare z n
328−-- -- Subject to fusion.
328+ Skip s' -> loop_cmp z s'
329−-- --
329+ Yield _ s' | z > n -> GT
330−-- -- This function gives the same answer as comparing against the result
330+ | otherwise -> loop_cmp (z + 1) s'
331−-- -- of 'lengthI', but can short circuit if the count of characters is
331+{-# INLINE[0] compareLengthI #-}
332−-- -- greater than the number or if the stream can't possibly be as long
332+
333−-- -- as the number supplied, and hence be more efficient.
333+-- | /O(n)/ Indicate whether a string contains exactly one element.
334−-- compareLengthI :: Integral a => Stream Char -> a -> Ordering
334+isSingleton :: Stream Char -> Bool
335−-- -- compareLengthI (Stream next s0 len) n =
335+isSingleton (Stream next s0 _len) = loop 0 s0
336−-- compareLengthI (Stream next s0) n =
336+ where
337−-- -- case compareSize len (fromIntegral n) of
337+ loop !z s = case next s of
338−-- -- Just o -> o
338+ Done -> z == (1::Int)
339−-- -- Nothing -> loop_cmp 0 s0
339+ Skip s' -> loop z s'
340−-- loop_cmp 0 s0
340+ Yield _ s'
341−-- where
341+ | z >= 1 -> False
342−-- loop_cmp !z s = case next s of
342+ | otherwise -> loop (z+1) s'
343−-- Done -> compare z n
343+{-# INLINE[0] isSingleton #-}
344−-- Skip s' -> loop_cmp z s'
344+
345−-- Yield _ s' | z > n -> GT
345+-- ----------------------------------------------------------------------------
346−-- | otherwise -> loop_cmp (z + 1) s'
346+-- * Stream transformations
347−-- {-# INLINE[0] compareLengthI #-}
347+
348−
348+-- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@
349−-- -- | /O(n)/ Indicate whether a string contains exactly one element.
349+-- to each element of @xs@.
350−-- isSingleton :: Stream Char -> Bool
350+map :: (Char -> Char) -> Stream Char -> Stream Char
351−-- -- isSingleton (Stream next s0 _len) = loop 0 s0
351+map f (Stream next0 s0 len) = Stream next s0 len
352−-- isSingleton (Stream next s0) = loop 0 s0
352+ where
353−-- where
353+ next !s = case next0 s of
354−-- loop !z s = case next s of
354+ Done -> Done
355−-- Done -> z == (1::Int)
355+ Skip s' -> Skip s'
356−-- Skip s' -> loop z s'
356+ Yield x s' -> Yield (f x) s'
357−-- Yield _ s'
357+{-# INLINE [0] map #-}
358−-- | z >= 1 -> False
358+
359−-- | otherwise -> loop (z+1) s'
359+{-#
360−-- {-# INLINE[0] isSingleton #-}
360+ RULES "STREAM map/map fusion" forall f g s.
361−
361+ map f (map g s) = map (\x -> f (g x)) s
362−-- -- ----------------------------------------------------------------------------
362+ #-}
363−-- -- * Stream transformations
363+
364−
364+data I s = I1 !s
365−-- -- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@
365+ | I2 !s {-# UNPACK #-} !Char
366−-- -- to each element of @xs@.
366+ | I3 !s
367−-- map :: (Char -> Char) -> Stream Char -> Stream Char
367+
368−-- -- map f (Stream next0 s0 len) = Stream next s0 len
368+-- | /O(n)/ Take a character and place it between each of the
369−-- map f (Stream next0 s0) = Stream next s0 -- len
369+-- characters of a 'Stream Char'.
370−-- where
370+intersperse :: Char -> Stream Char -> Stream Char
371−-- next !s = case next0 s of
371+intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len
372−-- Done -> Done
372+ where
373−-- Skip s' -> Skip s'
373+ next (I1 s) = case next0 s of
374−-- Yield x s' -> Yield (f x) s'
374+ Done -> Done
375−-- {-# INLINE [0] map #-}
375+ Skip s' -> Skip (I1 s')
376−
376+ Yield x s' -> Skip (I2 s' x)
377−-- {-#
377+ next (I2 s x) = Yield x (I3 s)
378−-- RULES "STREAM map/map fusion" forall f g s.
378+ next (I3 s) = case next0 s of
379−-- map f (map g s) = map (\x -> f (g x)) s
379+ Done -> Done
380−-- #-}
380+ Skip s' -> Skip (I3 s')
381−
381+ Yield x s' -> Yield c (I2 s' x)
382−-- data I s = I1 !s
382+{-# INLINE [0] intersperse #-}
383−-- | I2 !s {-# UNPACK #-} !Char
383+
384−-- | I3 !s
384+-- ----------------------------------------------------------------------------
385−
385+-- ** Case conversions (folds)
386−-- -- | /O(n)/ Take a character and place it between each of the
386+
387−-- -- characters of a 'Stream Char'.
387+-- $case
388−-- intersperse :: Char -> Stream Char -> Stream Char
388+--
389−-- intersperse c (Stream next0 s0) = Stream next (I1 s0) -- len
389+-- With Unicode text, it is incorrect to use combinators like @map
390−-- -- intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len
390+-- toUpper@ to case convert each character of a string individually.
391−-- where
391+-- Instead, use the whole-string case conversion functions from this
392−-- next (I1 s) = case next0 s of
392+-- module. For correctness in different writing systems, these
393−-- Done -> Done
393+-- functions may map one input character to two or three output
394−-- Skip s' -> Skip (I1 s')
394+-- characters.
395−-- Yield x s' -> Skip (I2 s' x)
395+
396−-- next (I2 s x) = Yield x (I3 s)
396+caseConvert :: (forall s. Char -> s -> Step (CC s) Char)
397−-- next (I3 s) = case next0 s of
397+ -> Stream Char -> Stream Char
398−-- Done -> Done
398+caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len
399−-- Skip s' -> Skip (I3 s')
399+ where
400−-- Yield x s' -> Yield c (I2 s' x)
400+ next (CC s '\0' _) =
401−-- {-# INLINE [0] intersperse #-}
401+ case next0 s of
402−
402+ Done -> Done
403−-- -- ----------------------------------------------------------------------------
403+ Skip s' -> Skip (CC s' '\0' '\0')
404−-- -- ** Case conversions (folds)
404+ Yield c s' -> remap c s'
405−
405+ next (CC s a b) = Yield a (CC s b '\0')
406−-- -- $case
406+
407−-- --
407+-- | /O(n)/ Convert a string to folded case. This function is mainly
408−-- -- With Unicode text, it is incorrect to use combinators like @map
408+-- useful for performing caseless (or case insensitive) string
409−-- -- toUpper@ to case convert each character of a string individually.
409+-- comparisons.
410−-- -- Instead, use the whole-string case conversion functions from this
410+--
411−-- -- module. For correctness in different writing systems, these
411+-- A string @x@ is a caseless match for a string @y@ if and only if:
412−-- -- functions may map one input character to two or three output
412+--
413−-- -- characters.
413+-- @toCaseFold x == toCaseFold y@
414−
414+--
415−-- caseConvert :: (forall s. Char -> s -> Step (CC s) Char)
415+-- The result string may be longer than the input string, and may
416−-- -> Stream Char -> Stream Char
416+-- differ from applying 'toLower' to the input string. For instance,
417−-- -- caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len
417+-- the Armenian small ligature men now (U+FB13) is case folded to the
418−-- caseConvert remap (Stream next0 s0) = Stream next (CC s0 '\0' '\0') -- len
418+-- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is
419−-- where
419+-- case folded to the Greek small letter letter mu (U+03BC) instead of
420−-- next (CC s '\0' _) =
420+-- itself.
421−-- case next0 s of
421+toCaseFold :: Stream Char -> Stream Char
422−-- Done -> Done
422+toCaseFold = caseConvert foldMapping
423−-- Skip s' -> Skip (CC s' '\0' '\0')
423+{-# INLINE [0] toCaseFold #-}
424−-- Yield c s' -> remap c s'
424+
425−-- next (CC s a b) = Yield a (CC s b '\0')
425+-- | /O(n)/ Convert a string to upper case, using simple case
426−
426+-- conversion. The result string may be longer than the input string.
427−-- -- | /O(n)/ Convert a string to folded case. This function is mainly
427+-- For instance, the German eszett (U+00DF) maps to the two-letter
428−-- -- useful for performing caseless (or case insensitive) string
428+-- sequence SS.
429−-- -- comparisons.
429+toUpper :: Stream Char -> Stream Char
430−-- --
430+toUpper = caseConvert upperMapping
431−-- -- A string @x@ is a caseless match for a string @y@ if and only if:
431+{-# INLINE [0] toUpper #-}
432−-- --
432+
433−-- -- @toCaseFold x == toCaseFold y@
433+-- | /O(n)/ Convert a string to lower case, using simple case
434−-- --
434+-- conversion. The result string may be longer than the input string.
435−-- -- The result string may be longer than the input string, and may
435+-- For instance, the Latin capital letter I with dot above (U+0130)
436−-- -- differ from applying 'toLower' to the input string. For instance,
436+-- maps to the sequence Latin small letter i (U+0069) followed by
437−-- -- the Armenian small ligature men now (U+FB13) is case folded to the
437+-- combining dot above (U+0307).
438−-- -- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is
438+toLower :: Stream Char -> Stream Char
439−-- -- case folded to the Greek small letter letter mu (U+03BC) instead of
439+toLower = caseConvert lowerMapping
440−-- -- itself.
440+{-# INLINE [0] toLower #-}
441−-- toCaseFold :: Stream Char -> Stream Char
441+
442−-- toCaseFold = caseConvert foldMapping
442+-- | /O(n)/ Convert a string to title case, using simple case
443−-- {-# INLINE [0] toCaseFold #-}
443+-- conversion.
444−
444+--
445−-- -- | /O(n)/ Convert a string to upper case, using simple case
445+-- The first letter of the input is converted to title case, as is
446−-- -- conversion. The result string may be longer than the input string.
446+-- every subsequent letter that immediately follows a non-letter.
447−-- -- For instance, the German eszett (U+00DF) maps to the two-letter
447+-- Every letter that immediately follows another letter is converted
448−-- -- sequence SS.
448+-- to lower case.
449−-- toUpper :: Stream Char -> Stream Char
449+--
450−-- toUpper = caseConvert upperMapping
450+-- The result string may be longer than the input string. For example,
451−-- {-# INLINE [0] toUpper #-}
451+-- the Latin small ligature &#xfb02; (U+FB02) is converted to the
452−
452+-- sequence Latin capital letter F (U+0046) followed by Latin small
453−-- -- | /O(n)/ Convert a string to lower case, using simple case
453+-- letter l (U+006C).
454−-- -- conversion. The result string may be longer than the input string.
454+--
455−-- -- For instance, the Latin capital letter I with dot above (U+0130)
455+-- /Note/: this function does not take language or culture specific
456−-- -- maps to the sequence Latin small letter i (U+0069) followed by
456+-- rules into account. For instance, in English, different style
457−-- -- combining dot above (U+0307).
457+-- guides disagree on whether the book name \"The Hill of the Red
458−-- toLower :: Stream Char -> Stream Char
458+-- Fox\" is correctly title cased&#x2014;but this function will
459−-- toLower = caseConvert lowerMapping
459+-- capitalize /every/ word.
460−-- {-# INLINE [0] toLower #-}
460+toTitle :: Stream Char -> Stream Char
461−
461+toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len
462−-- -- | /O(n)/ Convert a string to title case, using simple case
462+ where
463−-- -- conversion.
463+ next (CC (letter :*: s) '\0' _) =
464−-- --
464+ case next0 s of
465−-- -- The first letter of the input is converted to title case, as is
465+ Done -> Done
466−-- -- every subsequent letter that immediately follows a non-letter.
466+ Skip s' -> Skip (CC (letter :*: s') '\0' '\0')
467−-- -- Every letter that immediately follows another letter is converted
467+ Yield c s'
468−-- -- to lower case.
468+ | letter' -> if letter
469−-- --
469+ then lowerMapping c (letter' :*: s')
470−-- -- The result string may be longer than the input string. For example,
470+ else titleMapping c (letter' :*: s')
471−-- -- the Latin small ligature &#xfb02; (U+FB02) is converted to the
471+ | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')
472−-- -- sequence Latin capital letter F (U+0046) followed by Latin small
472+ where letter' = isLetter c
473−-- -- letter l (U+006C).
473+ next (CC s a b) = Yield a (CC s b '\0')
474−-- --
474+{-# INLINE [0] toTitle #-}
475−-- -- /Note/: this function does not take language or culture specific
475+
476−-- -- rules into account. For instance, in English, different style
476+data Justify i s = Just1 !i !s
477−-- -- guides disagree on whether the book name \"The Hill of the Red
477+ | Just2 !i !s
478−-- -- Fox\" is correctly title cased&#x2014;but this function will
478+
479−-- -- capitalize /every/ word.
479+justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
480−-- toTitle :: Stream Char -> Stream Char
480+justifyLeftI k c (Stream next0 s0 len) =
481−-- -- toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len
481+ Stream next (Just1 0 s0) (larger (fromIntegral k) len)
482−-- toTitle (Stream next0 s0) = Stream next (CC (False :*: s0) '\0' '\0') -- len
482+ where
483−-- where
483+ next (Just1 n s) =
484−-- next (CC (letter :*: s) '\0' _) =
484+ case next0 s of
485−-- case next0 s of
485+ Done -> next (Just2 n s)
486−-- Done -> Done
486+ Skip s' -> Skip (Just1 n s')
487−-- Skip s' -> Skip (CC (letter :*: s') '\0' '\0')
487+ Yield x s' -> Yield x (Just1 (n+1) s')
488−-- Yield c s'
488+ next (Just2 n s)
489−-- | letter' -> if letter
489+ | n < k = Yield c (Just2 (n+1) s)
490−-- then lowerMapping c (letter' :*: s')
490+ | otherwise = Done
491−-- else titleMapping c (letter' :*: s')
491+ {-# INLINE next #-}
492−-- | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')
492+{-# INLINE [0] justifyLeftI #-}
493−-- where letter' = isLetter c
493+
494−-- next (CC s a b) = Yield a (CC s b '\0')
494+-- ----------------------------------------------------------------------------
495−-- {-# INLINE [0] toTitle #-}
495+-- * Reducing Streams (folds)
496−
496+
497−-- data Justify i s = Just1 !i !s
497+-- | foldl, applied to a binary operator, a starting value (typically the
498−-- | Just2 !i !s
498+-- left-identity of the operator), and a Stream, reduces the Stream using the
499−
499+-- binary operator, from left to right.
500−-- justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
500+foldl :: (b -> Char -> b) -> b -> Stream Char -> b
501−-- -- justifyLeftI k c (Stream next0 s0 len) =
501+foldl f z0 (Stream next s0 _len) = loop_foldl z0 s0
502−-- justifyLeftI k c (Stream next0 s0) =
502+ where
503−-- Stream next (Just1 0 s0) -- (larger (fromIntegral k) len)
503+ loop_foldl z !s = case next s of
504−-- where
504+ Done -> z
505−-- next (Just1 n s) =
505+ Skip s' -> loop_foldl z s'
506−-- case next0 s of
506+ Yield x s' -> loop_foldl (f z x) s'
507−-- Done -> next (Just2 n s)
507+{-# INLINE [0] foldl #-}
508−-- Skip s' -> Skip (Just1 n s')
508+
509−-- Yield x s' -> Yield x (Just1 (n+1) s')
509+-- | A strict version of foldl.
510−-- next (Just2 n s)
510+foldl' :: (b -> Char -> b) -> b -> Stream Char -> b
511−-- | n < k = Yield c (Just2 (n+1) s)
511+foldl' f z0 (Stream next s0 _len) = loop_foldl' z0 s0
512−-- | otherwise = Done
512+ where
513−-- {-# INLINE next #-}
513+ loop_foldl' !z !s = case next s of
514−-- {-# INLINE [0] justifyLeftI #-}
514+ Done -> z
515−
515+ Skip s' -> loop_foldl' z s'
516−-- -- ----------------------------------------------------------------------------
516+ Yield x s' -> loop_foldl' (f z x) s'
517−-- -- * Reducing Streams (folds)
517+{-# INLINE [0] foldl' #-}
518−
518+
519−-- -- | foldl, applied to a binary operator, a starting value (typically the
519+-- | foldl1 is a variant of foldl that has no starting value argument,
520−-- -- left-identity of the operator), and a Stream, reduces the Stream using the
520+-- and thus must be applied to non-empty Streams.
521−-- -- binary operator, from left to right.
521+foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char
522−-- foldl :: (b -> Char -> b) -> b -> Stream Char -> b
522+foldl1 f (Stream next s0 _len) = loop0_foldl1 s0
523−-- -- foldl f z0 (Stream next s0 _len) = loop_foldl z0 s0
523+ where
524−-- foldl f z0 (Stream next s0) = loop_foldl z0 s0
524+ loop0_foldl1 !s = case next s of
525−-- where
525+ Skip s' -> loop0_foldl1 s'
526−-- loop_foldl z !s = case next s of
526+ Yield x s' -> loop_foldl1 x s'
527−-- Done -> z
527+ Done -> emptyError "foldl1"
528−-- Skip s' -> loop_foldl z s'
528+ loop_foldl1 z !s = case next s of
529−-- Yield x s' -> loop_foldl (f z x) s'
529+ Done -> z
530−-- {-# INLINE [0] foldl #-}
530+ Skip s' -> loop_foldl1 z s'
531−
531+ Yield x s' -> loop_foldl1 (f z x) s'
532−-- -- | A strict version of foldl.
532+{-# INLINE [0] foldl1 #-}
533−-- foldl' :: (b -> Char -> b) -> b -> Stream Char -> b
533+
534−-- -- foldl' f z0 (Stream next s0 _len) = loop_foldl' z0 s0
534+-- | A strict version of foldl1.
535−-- foldl' f z0 (Stream next s0) = loop_foldl' z0 s0
535+foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char
536−-- where
536+foldl1' f (Stream next s0 _len) = loop0_foldl1' s0
537−-- loop_foldl' !z !s = case next s of
537+ where
538−-- Done -> z
538+ loop0_foldl1' !s = case next s of
539−-- Skip s' -> loop_foldl' z s'
539+ Skip s' -> loop0_foldl1' s'
540−-- Yield x s' -> loop_foldl' (f z x) s'
540+ Yield x s' -> loop_foldl1' x s'
541−-- {-# INLINE [0] foldl' #-}
541+ Done -> emptyError "foldl1"
542−
542+ loop_foldl1' !z !s = case next s of
543−-- -- | foldl1 is a variant of foldl that has no starting value argument,
543+ Done -> z
544−-- -- and thus must be applied to non-empty Streams.
544+ Skip s' -> loop_foldl1' z s'
545−-- foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char
545+ Yield x s' -> loop_foldl1' (f z x) s'
546−-- -- foldl1 f (Stream next s0 _len) = loop0_foldl1 s0
546+{-# INLINE [0] foldl1' #-}
547−-- foldl1 f (Stream next s0) = loop0_foldl1 s0
547+
548−-- where
548+-- | 'foldr', applied to a binary operator, a starting value (typically the
549−-- loop0_foldl1 !s = case next s of
549+-- right-identity of the operator), and a stream, reduces the stream using the
550−-- Skip s' -> loop0_foldl1 s'
550+-- binary operator, from right to left.
551−-- Yield x s' -> loop_foldl1 x s'
551+foldr :: (Char -> b -> b) -> b -> Stream Char -> b
552−-- Done -> emptyError "foldl1"
552+foldr f z (Stream next s0 _len) = loop_foldr s0
553−-- loop_foldl1 z !s = case next s of
553+ where
554−-- Done -> z
554+ loop_foldr !s = case next s of
555−-- Skip s' -> loop_foldl1 z s'
555+ Done -> z
556−-- Yield x s' -> loop_foldl1 (f z x) s'
556+ Skip s' -> loop_foldr s'
557−-- {-# INLINE [0] foldl1 #-}
557+ Yield x s' -> f x (loop_foldr s')
558−
558+{-# INLINE [0] foldr #-}
559−-- -- | A strict version of foldl1.
559+
560−-- foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char
560+-- | foldr1 is a variant of 'foldr' that has no starting value argument,
561−-- -- foldl1' f (Stream next s0 _len) = loop0_foldl1' s0
561+-- and thus must be applied to non-empty streams.
562−-- foldl1' f (Stream next s0) = loop0_foldl1' s0
562+-- Subject to array fusion.
563−-- where
563+foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char
564−-- loop0_foldl1' !s = case next s of
564+foldr1 f (Stream next s0 _len) = loop0_foldr1 s0
565−-- Skip s' -> loop0_foldl1' s'
565+ where
566−-- Yield x s' -> loop_foldl1' x s'
566+ loop0_foldr1 !s = case next s of
567−-- Done -> emptyError "foldl1"
567+ Done -> emptyError "foldr1"
568−-- loop_foldl1' !z !s = case next s of
568+ Skip s' -> loop0_foldr1 s'
569−-- Done -> z
569+ Yield x s' -> loop_foldr1 x s'
570−-- Skip s' -> loop_foldl1' z s'
570+
571−-- Yield x s' -> loop_foldl1' (f z x) s'
571+ loop_foldr1 x !s = case next s of
572−-- {-# INLINE [0] foldl1' #-}
572+ Done -> x
573−
573+ Skip s' -> loop_foldr1 x s'
574−-- -- | 'foldr', applied to a binary operator, a starting value (typically the
574+ Yield x' s' -> f x (loop_foldr1 x' s')
575−-- -- right-identity of the operator), and a stream, reduces the stream using the
575+{-# INLINE [0] foldr1 #-}
576−-- -- binary operator, from right to left.
576+
577−-- foldr :: (Char -> b -> b) -> b -> Stream Char -> b
577+intercalate :: Stream Char -> [Stream Char] -> Stream Char
578−-- -- foldr f z (Stream next s0 _len) = loop_foldr s0
578+intercalate s = concat . (L.intersperse s)
579−-- foldr f z (Stream next s0) = loop_foldr s0
579+{-# INLINE [0] intercalate #-}
580−-- where
580+
581−-- loop_foldr !s = case next s of
581+-- ----------------------------------------------------------------------------
582−-- Done -> z
582+-- ** Special folds
583−-- Skip s' -> loop_foldr s'
583+
584−-- Yield x s' -> f x (loop_foldr s')
584+-- | /O(n)/ Concatenate a list of streams. Subject to array fusion.
585−-- {-# INLINE [0] foldr #-}
585+concat :: [Stream Char] -> Stream Char
586−
586+concat = L.foldr append empty
587−-- -- | foldr1 is a variant of 'foldr' that has no starting value argument,
587+{-# INLINE [0] concat #-}
588−-- -- and thus must be applied to non-empty streams.
588+
589−-- -- Subject to array fusion.
589+-- | Map a function over a stream that results in a stream and concatenate the
590−-- foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char
590+-- results.
591−-- -- foldr1 f (Stream next s0 _len) = loop0_foldr1 s0
591+concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char
592−-- foldr1 f (Stream next s0) = loop0_foldr1 s0
592+concatMap f = foldr (append . f) empty
593−-- where
593+{-# INLINE [0] concatMap #-}
594−-- loop0_foldr1 !s = case next s of
594+
595−-- Done -> emptyError "foldr1"
595+-- | /O(n)/ any @p @xs determines if any character in the stream
596−-- Skip s' -> loop0_foldr1 s'
596+-- @xs@ satisfies the predicate @p@.
597−-- Yield x s' -> loop_foldr1 x s'
597+any :: (Char -> Bool) -> Stream Char -> Bool
598−
598+any p (Stream next0 s0 _len) = loop_any s0
599−-- loop_foldr1 x !s = case next s of
599+ where
600−-- Done -> x
600+ loop_any !s = case next0 s of
601−-- Skip s' -> loop_foldr1 x s'
601+ Done -> False
602−-- Yield x' s' -> f x (loop_foldr1 x' s')
602+ Skip s' -> loop_any s'
603−-- {-# INLINE [0] foldr1 #-}
603+ Yield x s' | p x -> True
604−
604+ | otherwise -> loop_any s'
605−-- intercalate :: Stream Char -> [Stream Char] -> Stream Char
605+{-# INLINE [0] any #-}
606−-- intercalate s = concat . (L.intersperse s)
606+
607−-- {-# INLINE [0] intercalate #-}
607+-- | /O(n)/ all @p @xs determines if all characters in the 'Text'
608−
608+-- @xs@ satisfy the predicate @p@.
609−-- -- ----------------------------------------------------------------------------
609+all :: (Char -> Bool) -> Stream Char -> Bool
610−-- -- ** Special folds
610+all p (Stream next0 s0 _len) = loop_all s0
611−
611+ where
612−-- -- | /O(n)/ Concatenate a list of streams. Subject to array fusion.
612+ loop_all !s = case next0 s of
613−-- concat :: [Stream Char] -> Stream Char
613+ Done -> True
614−-- concat = L.foldr append empty
614+ Skip s' -> loop_all s'
615−-- {-# INLINE [0] concat #-}
615+ Yield x s' | p x -> loop_all s'
616−
616+ | otherwise -> False
617−-- -- | Map a function over a stream that results in a stream and concatenate the
617+{-# INLINE [0] all #-}
618−-- -- results.
618+
619−-- concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char
619+-- | /O(n)/ maximum returns the maximum value from a stream, which must be
620−-- concatMap f = foldr (append . f) empty
620+-- non-empty.
621−-- {-# INLINE [0] concatMap #-}
621+maximum :: Stream Char -> Char
622−
622+maximum (Stream next0 s0 _len) = loop0_maximum s0
623−-- -- | /O(n)/ any @p @xs determines if any character in the stream
623+ where
624−-- -- @xs@ satisfies the predicate @p@.
624+ loop0_maximum !s = case next0 s of
625−-- any :: (Char -> Bool) -> Stream Char -> Bool
625+ Done -> emptyError "maximum"
626−-- -- any p (Stream next0 s0 _len) = loop_any s0
626+ Skip s' -> loop0_maximum s'
627−-- any p (Stream next0 s0) = loop_any s0
627+ Yield x s' -> loop_maximum x s'
628−-- where
628+ loop_maximum !z !s = case next0 s of
629−-- loop_any !s = case next0 s of
629+ Done -> z
630−-- Done -> False
630+ Skip s' -> loop_maximum z s'
631−-- Skip s' -> loop_any s'
631+ Yield x s'
632−-- Yield x s' | p x -> True
632+ | x > z -> loop_maximum x s'
633−-- | otherwise -> loop_any s'
633+ | otherwise -> loop_maximum z s'
634−-- {-# INLINE [0] any #-}
634+{-# INLINE [0] maximum #-}
635−
635+
636−-- -- | /O(n)/ all @p @xs determines if all characters in the 'Text'
636+-- | /O(n)/ minimum returns the minimum value from a 'Text', which must be
637−-- -- @xs@ satisfy the predicate @p@.
637+-- non-empty.
638−-- all :: (Char -> Bool) -> Stream Char -> Bool
638+minimum :: Stream Char -> Char
639−-- -- all p (Stream next0 s0 _len) = loop_all s0
639+minimum (Stream next0 s0 _len) = loop0_minimum s0
640−-- all p (Stream next0 s0) = loop_all s0
640+ where
641−-- where
641+ loop0_minimum !s = case next0 s of
642−-- loop_all !s = case next0 s of
642+ Done -> emptyError "minimum"
643−-- Done -> True
643+ Skip s' -> loop0_minimum s'
644−-- Skip s' -> loop_all s'
644+ Yield x s' -> loop_minimum x s'
645−-- Yield x s' | p x -> loop_all s'
645+ loop_minimum !z !s = case next0 s of
646−-- | otherwise -> False
646+ Done -> z
647−-- {-# INLINE [0] all #-}
647+ Skip s' -> loop_minimum z s'
648−
648+ Yield x s'
649−-- -- | /O(n)/ maximum returns the maximum value from a stream, which must be
649+ | x < z -> loop_minimum x s'
650−-- -- non-empty.
650+ | otherwise -> loop_minimum z s'
651−-- maximum :: Stream Char -> Char
651+{-# INLINE [0] minimum #-}
652−-- -- maximum (Stream next0 s0 _len) = loop0_maximum s0
652+
653−-- maximum (Stream next0 s0) = loop0_maximum s0
653+-- -----------------------------------------------------------------------------
654−-- where
654+-- * Building streams
655−-- loop0_maximum !s = case next0 s of
655+
656−-- Done -> emptyError "maximum"
656+scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
657−-- Skip s' -> loop0_maximum s'
657+scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
658−-- Yield x s' -> loop_maximum x s'
658+ where
659−-- loop_maximum !z !s = case next0 s of
659+ {-# INLINE next #-}
660−-- Done -> z
660+ next (Scan1 z s) = Yield z (Scan2 z s)
661−-- Skip s' -> loop_maximum z s'
661+ next (Scan2 z s) = case next0 s of
662−-- Yield x s'
662+ Yield x s' -> let !x' = f z x
663−-- | x > z -> loop_maximum x s'
663+ in Yield x' (Scan2 x' s')
664−-- | otherwise -> loop_maximum z s'
664+ Skip s' -> Skip (Scan2 z s')
665−-- {-# INLINE [0] maximum #-}
665+ Done -> Done
666−
666+{-# INLINE [0] scanl #-}
667−-- -- | /O(n)/ minimum returns the minimum value from a 'Text', which must be
667+
668−-- -- non-empty.
668+-- -----------------------------------------------------------------------------
669−-- minimum :: Stream Char -> Char
669+-- ** Generating and unfolding streams
670−-- -- minimum (Stream next0 s0 _len) = loop0_minimum s0
670+
671−-- minimum (Stream next0 s0) = loop0_minimum s0
671+replicateCharI :: Integral a => a -> Char -> Stream Char
672−-- where
672+replicateCharI !n !c
673−-- loop0_minimum !s = case next0 s of
673+ | n < 0 = empty
674−-- Done -> emptyError "minimum"
674+ | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
675−-- Skip s' -> loop0_minimum s'
675+ where
676−-- Yield x s' -> loop_minimum x s'
676+ next !i | i >= n = Done
677−-- loop_minimum !z !s = case next0 s of
677+ | otherwise = Yield c (i + 1)
678−-- Done -> z
678+{-# INLINE [0] replicateCharI #-}
679−-- Skip s' -> loop_minimum z s'
679+
680−-- Yield x s'
680+data RI s = RI !s {-# UNPACK #-} !Int64
681−-- | x < z -> loop_minimum x s'
681+
682−-- | otherwise -> loop_minimum z s'
682+replicateI :: Int64 -> Stream Char -> Stream Char
683−-- {-# INLINE [0] minimum #-}
683+replicateI n (Stream next0 s0 len) =
684−
684+ Stream next (RI s0 0) (fromIntegral (max 0 n) * len)
685−-- -- -----------------------------------------------------------------------------
685+ where
686−-- -- * Building streams
686+ next (RI s k)
687−
687+ | k >= n = Done
688−-- scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
688+ | otherwise = case next0 s of
689−-- -- scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
689+ Done -> Skip (RI s0 (k+1))
690−-- scanl f z0 (Stream next0 s0) = Stream next (Scan1 z0 s0) -- (len+1) -- HINT maybe too low
690+ Skip s' -> Skip (RI s' k)
691−-- where
691+ Yield x s' -> Yield x (RI s' k)
692−-- {-# INLINE next #-}
692+{-# INLINE [0] replicateI #-}
693−-- next (Scan1 z s) = Yield z (Scan2 z s)
693+
694−-- next (Scan2 z s) = case next0 s of
694+-- | /O(n)/, where @n@ is the length of the result. The unfoldr function
695−-- Yield x s' -> let !x' = f z x
695+-- is analogous to the List 'unfoldr'. unfoldr builds a stream
696−-- in Yield x' (Scan2 x' s')
696+-- from a seed value. The function takes the element and returns
697−-- Skip s' -> Skip (Scan2 z s')
697+-- Nothing if it is done producing the stream or returns Just
698−-- Done -> Done
698+-- (a,b), in which case, a is the next Char in the string, and b is
699−-- {-# INLINE [0] scanl #-}
699+-- the seed value for further production.
700−
700+unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char
701−-- -- -----------------------------------------------------------------------------
701+unfoldr f s0 = Stream next s0 1 -- HINT maybe too low
702−-- -- ** Generating and unfolding streams
702+ where
703−
703+ {-# INLINE next #-}
704−-- replicateCharI :: Integral a => a -> Char -> Stream Char
704+ next !s = case f s of
705−-- replicateCharI n c
705+ Nothing -> Done
706−-- | n < 0 = empty
706+ Just (w, s') -> Yield w s'
707−-- | otherwise = Stream next 0 -- (fromIntegral n) -- HINT maybe too low
707+{-# INLINE [0] unfoldr #-}
708−-- where
708+
709−-- next i | i >= n = Done
709+-- | /O(n)/ Like 'unfoldr', 'unfoldrNI' builds a stream from a seed
710−-- | otherwise = Yield c (i + 1)
710+-- value. However, the length of the result is limited by the
711−-- {-# INLINE [0] replicateCharI #-}
711+-- first argument to 'unfoldrNI'. This function is more efficient than
712−
712+-- 'unfoldr' when the length of the result is known.
713−-- data RI s = RI !s {-# UNPACK #-} !Int64
713+unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char
714−
714+unfoldrNI n f s0 | n < 0 = empty
715−-- replicateI :: Int64 -> Stream Char -> Stream Char
715+ | otherwise = Stream next (0 :*: s0) (fromIntegral (n*2)) -- HINT maybe too high
716−-- -- replicateI n (Stream next0 s0 len) =
716+ where
717−-- replicateI n (Stream next0 s0) =
717+ {-# INLINE next #-}
718−-- Stream next (RI s0 0) -- (fromIntegral (max 0 n) * len)
718+ next (z :*: s) = case f s of
719−-- where
719+ Nothing -> Done
720−-- next (RI s k)
720+ Just (w, s') | z >= n -> Done
721−-- | k >= n = Done
721+ | otherwise -> Yield w ((z + 1) :*: s')
722−-- | otherwise = case next0 s of
722+{-# INLINE unfoldrNI #-}
723−-- Done -> Skip (RI s0 (k+1))
723+
724−-- Skip s' -> Skip (RI s' k)
724+-------------------------------------------------------------------------------
725−-- Yield x s' -> Yield x (RI s' k)
725+-- * Substreams
726−-- {-# INLINE [0] replicateI #-}
726+
727−
727+-- | /O(n)/ take n, applied to a stream, returns the prefix of the
728−-- -- | /O(n)/, where @n@ is the length of the result. The unfoldr function
728+-- stream of length @n@, or the stream itself if @n@ is greater than the
729−-- -- is analogous to the List 'unfoldr'. unfoldr builds a stream
729+-- length of the stream.
730−-- -- from a seed value. The function takes the element and returns
730+take :: Integral a => a -> Stream Char -> Stream Char
731−-- -- Nothing if it is done producing the stream or returns Just
731+take n0 (Stream next0 s0 len) =
732−-- -- (a,b), in which case, a is the next Char in the string, and b is
732+ Stream next (n0 :*: s0) (smaller len (fromIntegral (max 0 n0)))
733−-- -- the seed value for further production.
733+ where
734−-- unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char
734+ {-# INLINE next #-}
735−-- unfoldr f s0 = Stream next s0 -- 1 -- HINT maybe too low
735+ next (n :*: s) | n <= 0 = Done
736−-- where
736+ | otherwise = case next0 s of
737−-- {-# INLINE next #-}
737+ Done -> Done
738−-- next !s = case f s of
738+ Skip s' -> Skip (n :*: s')
739−-- Nothing -> Done
739+ Yield x s' -> Yield x ((n-1) :*: s')
740−-- Just (w, s') -> Yield w s'
740+{-# INLINE [0] take #-}
741−-- {-# INLINE [0] unfoldr #-}
741+
742−
742+data Drop a s = NS !s
743−-- -- | /O(n)/ Like 'unfoldr', 'unfoldrNI' builds a stream from a seed
743+ | JS !a !s
744−-- -- value. However, the length of the result is limited by the
744+
745−-- -- first argument to 'unfoldrNI'. This function is more efficient than
745+-- | /O(n)/ drop n, applied to a stream, returns the suffix of the
746−-- -- 'unfoldr' when the length of the result is known.
746+-- stream after the first @n@ characters, or the empty stream if @n@
747−-- unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char
747+-- is greater than the length of the stream.
748−-- unfoldrNI n f s0 | n < 0 = empty
748+drop :: Integral a => a -> Stream Char -> Stream Char
749−-- | otherwise = Stream next (0 :*: s0) -- (fromIntegral (n*2)) -- HINT maybe too high
749+drop n0 (Stream next0 s0 len) =
750−-- where
750+ Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))
751−-- {-# INLINE next #-}
751+ where
752−-- next (z :*: s) = case f s of
752+ {-# INLINE next #-}
753−-- Nothing -> Done
753+ next (JS n s)
754−-- Just (w, s') | z >= n -> Done
754+ | n <= 0 = Skip (NS s)
755−-- | otherwise -> Yield w ((z + 1) :*: s')
755+ | otherwise = case next0 s of
756−-- {-# INLINE unfoldrNI #-}
756+ Done -> Done
757−
757+ Skip s' -> Skip (JS n s')
758−-- -------------------------------------------------------------------------------
758+ Yield _ s' -> Skip (JS (n-1) s')
759−-- -- * Substreams
759+ next (NS s) = case next0 s of
760−
760+ Done -> Done
761−-- -- | /O(n)/ take n, applied to a stream, returns the prefix of the
761+ Skip s' -> Skip (NS s')
762−-- -- stream of length @n@, or the stream itself if @n@ is greater than the
762+ Yield x s' -> Yield x (NS s')
763−-- -- length of the stream.
763+{-# INLINE [0] drop #-}
764−-- take :: Integral a => a -> Stream Char -> Stream Char
764+
765−-- take n0 (Stream next0 s0) =
765+-- | takeWhile, applied to a predicate @p@ and a stream, returns the
766−-- -- take n0 (Stream next0 s0 len) =
766+-- longest prefix (possibly empty) of elements that satisfy p.
767−-- Stream next (n0 :*: s0) -- (smaller len (fromIntegral (max 0 n0)))
767+takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char
768−-- where
768+takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
769−-- {-# INLINE next #-}
769+ where
770−-- next (n :*: s) | n <= 0 = Done
770+ {-# INLINE next #-}
771−-- | otherwise = case next0 s of
771+ next !s = case next0 s of
772−-- Done -> Done
772+ Done -> Done
773−-- Skip s' -> Skip (n :*: s')
773+ Skip s' -> Skip s'
774−-- Yield x s' -> Yield x ((n-1) :*: s')
774+ Yield x s' | p x -> Yield x s'
775−-- {-# INLINE [0] take #-}
775+ | otherwise -> Done
776−
776+{-# INLINE [0] takeWhile #-}
777−-- data Drop a s = NS !s
777+
778−-- | JS !a !s
778+-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
779−
779+dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
780−-- -- | /O(n)/ drop n, applied to a stream, returns the suffix of the
780+dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
781−-- -- stream after the first @n@ characters, or the empty stream if @n@
781+ where
782−-- -- is greater than the length of the stream.
782+ {-# INLINE next #-}
783−-- drop :: Integral a => a -> Stream Char -> Stream Char
783+ next (L s) = case next0 s of
784−-- -- drop n0 (Stream next0 s0 len) =
784+ Done -> Done
785−-- drop n0 (Stream next0 s0) =
785+ Skip s' -> Skip (L s')
786−-- Stream next (JS n0 s0) -- (len - fromIntegral (max 0 n0))
786+ Yield x s' | p x -> Skip (L s')
787−-- where
787+ | otherwise -> Yield x (R s')
788−-- {-# INLINE next #-}
788+ next (R s) = case next0 s of
789−-- next (JS n s)
789+ Done -> Done
790−-- | n <= 0 = Skip (NS s)
790+ Skip s' -> Skip (R s')
791−-- | otherwise = case next0 s of
791+ Yield x s' -> Yield x (R s')
792−-- Done -> Done
792+{-# INLINE [0] dropWhile #-}
793−-- Skip s' -> Skip (JS n s')
793+
794−-- Yield _ s' -> Skip (JS (n-1) s')
794+-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
795−-- next (NS s) = case next0 s of
795+-- 'True' iff the first is a prefix of the second.
796−-- Done -> Done
796+isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool
797−-- Skip s' -> Skip (NS s')
797+isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
798−-- Yield x s' -> Yield x (NS s')
798+ where
799−-- {-# INLINE [0] drop #-}
799+ loop Done _ = True
800−
800+ loop _ Done = False
801−-- -- | takeWhile, applied to a predicate @p@ and a stream, returns the
801+ loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
802−-- -- longest prefix (possibly empty) of elements that satisfy p.
802+ loop (Skip s1') x2 = loop (next1 s1') x2
803−-- takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char
803+ loop x1 (Skip s2') = loop x1 (next2 s2')
804−-- -- takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
804+ loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
805−-- takeWhile p (Stream next0 s0) = Stream next s0 -- len -- HINT maybe too high
805+ loop (next1 s1') (next2 s2')
806−-- where
806+{-# INLINE [0] isPrefixOf #-}
807−-- {-# INLINE next #-}
807+
808−-- next !s = case next0 s of
808+-- ----------------------------------------------------------------------------
809−-- Done -> Done
809+-- * Searching
810−-- Skip s' -> Skip s'
810+
811−-- Yield x s' | p x -> Yield x s'
811+-------------------------------------------------------------------------------
812−-- | otherwise -> Done
812+-- ** Searching by equality
813−-- {-# INLINE [0] takeWhile #-}
813+
814−
814+-- | /O(n)/ elem is the stream membership predicate.
815−-- -- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
815+elem :: Char -> Stream Char -> Bool
816−-- dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
816+elem w (Stream next s0 _len) = loop_elem s0
817−-- -- dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
817+ where
818−-- dropWhile p (Stream next0 s0) = Stream next (L s0) -- len -- HINT maybe too high
818+ loop_elem !s = case next s of
819−-- where
819+ Done -> False
820−-- {-# INLINE next #-}
820+ Skip s' -> loop_elem s'
821−-- next (L s) = case next0 s of
821+ Yield x s' | x == w -> True
822−-- Done -> Done
822+ | otherwise -> loop_elem s'
823−-- Skip s' -> Skip (L s')
823+{-# INLINE [0] elem #-}
824−-- Yield x s' | p x -> Skip (L s')
824+
825−-- | otherwise -> Yield x (R s')
825+-------------------------------------------------------------------------------
826−-- next (R s) = case next0 s of
826+-- ** Searching with a predicate
827−-- Done -> Done
827+
828−-- Skip s' -> Skip (R s')
828+-- | /O(n)/ The 'findBy' function takes a predicate and a stream,
829−-- Yield x s' -> Yield x (R s')
829+-- and returns the first element in matching the predicate, or 'Nothing'
830−-- {-# INLINE [0] dropWhile #-}
830+-- if there is no such element.
831−
831+
832−-- -- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
832+findBy :: (Char -> Bool) -> Stream Char -> Maybe Char
833−-- -- 'True' iff the first is a prefix of the second.
833+findBy p (Stream next s0 _len) = loop_find s0
834−-- isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool
834+ where
835−-- -- isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
835+ loop_find !s = case next s of
836−-- isPrefixOf (Stream next1 s1) (Stream next2 s2) = loop (next1 s1) (next2 s2)
836+ Done -> Nothing
837−-- where
837+ Skip s' -> loop_find s'
838−-- loop Done _ = True
838+ Yield x s' | p x -> Just x
839−-- loop _ Done = False
839+ | otherwise -> loop_find s'
840−-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
840+{-# INLINE [0] findBy #-}
841−-- loop (Skip s1') x2 = loop (next1 s1') x2
841+
842−-- loop x1 (Skip s2') = loop x1 (next2 s2')
842+-- | /O(n)/ Stream index (subscript) operator, starting from 0.
843−-- loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
843+indexI :: Integral a => Stream Char -> a -> Char
844−-- loop (next1 s1') (next2 s2')
844+indexI (Stream next s0 _len) n0
845−-- {-# INLINE [0] isPrefixOf #-}
845+ | n0 < 0 = streamError "index" "Negative index"
846−
846+ | otherwise = loop_index n0 s0
847−-- -- ----------------------------------------------------------------------------
847+ where
848−-- -- * Searching
848+ loop_index !n !s = case next s of
849−
849+ Done -> streamError "index" "Index too large"
850−-- -------------------------------------------------------------------------------
850+ Skip s' -> loop_index n s'
851−-- -- ** Searching by equality
851+ Yield x s' | n == 0 -> x
852−
852+ | otherwise -> loop_index (n-1) s'
853−-- -- | /O(n)/ elem is the stream membership predicate.
853+{-# INLINE [0] indexI #-}
854−-- elem :: Char -> Stream Char -> Bool
854+
855−-- -- elem w (Stream next s0 _len) = loop_elem s0
855+-- | /O(n)/ 'filter', applied to a predicate and a stream,
856−-- elem w (Stream next s0) = loop_elem s0
856+-- returns a stream containing those characters that satisfy the
857−-- where
857+-- predicate.
858−-- loop_elem !s = case next s of
858+filter :: (Char -> Bool) -> Stream Char -> Stream Char
859−-- Done -> False
859+filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
860−-- Skip s' -> loop_elem s'
860+ where
861−-- Yield x s' | x == w -> True
861+ next !s = case next0 s of
862−-- | otherwise -> loop_elem s'
862+ Done -> Done
863−-- {-# INLINE [0] elem #-}
863+ Skip s' -> Skip s'
864−
864+ Yield x s' | p x -> Yield x s'
865−-- -------------------------------------------------------------------------------
865+ | otherwise -> Skip s'
866−-- -- ** Searching with a predicate
866+{-# INLINE [0] filter #-}
867−
867+
868−-- -- | /O(n)/ The 'findBy' function takes a predicate and a stream,
868+{-# RULES
869−-- -- and returns the first element in matching the predicate, or 'Nothing'
869+ "STREAM filter/filter fusion" forall p q s.
870−-- -- if there is no such element.
870+ filter p (filter q s) = filter (\x -> q x && p x) s
871−
871+ #-}
872−-- findBy :: (Char -> Bool) -> Stream Char -> Maybe Char
872+
873−-- -- findBy p (Stream next s0 _len) = loop_find s0
873+-- | The 'findIndexI' function takes a predicate and a stream and
874−-- findBy p (Stream next s0) = loop_find s0
874+-- returns the index of the first element in the stream satisfying the
875−-- where
875+-- predicate.
876−-- loop_find !s = case next s of
876+findIndexI :: Integral a => (Char -> Bool) -> Stream Char -> Maybe a
877−-- Done -> Nothing
877+findIndexI p s = case findIndicesI p s of
878−-- Skip s' -> loop_find s'
878+ (i:_) -> Just i
879−-- Yield x s' | p x -> Just x
879+ _ -> Nothing
880−-- | otherwise -> loop_find s'
880+{-# INLINE [0] findIndexI #-}
881−-- {-# INLINE [0] findBy #-}
881+
882−
882+-- | The 'findIndicesI' function takes a predicate and a stream and
883−-- -- | /O(n)/ Stream index (subscript) operator, starting from 0.
883+-- returns all indices of the elements in the stream satisfying the
884−-- indexI :: Integral a => Stream Char -> a -> Char
884+-- predicate.
885−-- -- indexI (Stream next s0 _len) n0
885+findIndicesI :: Integral a => (Char -> Bool) -> Stream Char -> [a]
886−-- indexI (Stream next s0) n0
886+findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0
887−-- | n0 < 0 = streamError "index" "Negative index"
887+ where
888−-- | otherwise = loop_index n0 s0
888+ loop_findIndex !i !s = case next s of
889−-- where
889+ Done -> []
890−-- loop_index !n !s = case next s of
890+ Skip s' -> loop_findIndex i s' -- hmm. not caught by QC
891−-- Done -> streamError "index" "Index too large"
891+ Yield x s' | p x -> i : loop_findIndex (i+1) s'
892−-- Skip s' -> loop_index n s'
892+ | otherwise -> loop_findIndex (i+1) s'
893−-- Yield x s' | n == 0 -> x
893+{-# INLINE [0] findIndicesI #-}
894−-- | otherwise -> loop_index (n-1) s'
894+
895−-- {-# INLINE [0] indexI #-}
895+-------------------------------------------------------------------------------
896−
896+-- * Zipping
897−-- -- | /O(n)/ 'filter', applied to a predicate and a stream,
897+
898−-- -- returns a stream containing those characters that satisfy the
898+-- | Strict triple.
899−-- -- predicate.
899+data Zip a b m = Z1 !a !b
900−-- filter :: (Char -> Bool) -> Stream Char -> Stream Char
900+ | Z2 !a !b !m
901−-- -- filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
901+
902−-- filter p (Stream next0 s0) = Stream next s0 -- len -- HINT maybe too high
902+-- | zipWith generalises 'zip' by zipping with the function given as
903−-- where
903+-- the first argument, instead of a tupling function.
904−-- next !s = case next0 s of
904+zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
905−-- Done -> Done
905+zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
906−-- Skip s' -> Skip s'
906+ Stream next (Z1 sa0 sb0) (smaller len1 len2)
907−-- Yield x s' | p x -> Yield x s'
907+ where
908−-- | otherwise -> Skip s'
908+ next (Z1 sa sb) = case next0 sa of
909−-- {-# INLINE [0] filter #-}
909+ Done -> Done
910−
910+ Skip sa' -> Skip (Z1 sa' sb)
911−-- {-# RULES
911+ Yield a sa' -> Skip (Z2 sa' sb a)
912−-- "STREAM filter/filter fusion" forall p q s.
912+
913−-- filter p (filter q s) = filter (\x -> q x && p x) s
913+ next (Z2 sa' sb a) = case next1 sb of
914−-- #-}
914+ Done -> Done
915−
915+ Skip sb' -> Skip (Z2 sa' sb' a)
916−-- -- | The 'findIndexI' function takes a predicate and a stream and
916+ Yield b sb' -> Yield (f a b) (Z1 sa' sb')
917−-- -- returns the index of the first element in the stream satisfying the
917+{-# INLINE [0] zipWith #-}
918−-- -- predicate.
918+
919−-- findIndexI :: Integral a => (Char -> Bool) -> Stream Char -> Maybe a
919+-- | /O(n)/ The 'countCharI' function returns the number of times the
920−-- findIndexI p s = case findIndicesI p s of
920+-- query element appears in the given stream.
921−-- (i:_) -> Just i
921+countCharI :: Integral a => Char -> Stream Char -> a
922−-- _ -> Nothing
922+countCharI a (Stream next s0 _len) = loop 0 s0
923−-- {-# INLINE [0] findIndexI #-}
923+ where
924−
924+ loop !i !s = case next s of
925−-- -- | The 'findIndicesI' function takes a predicate and a stream and
925+ Done -> i
926−-- -- returns all indices of the elements in the stream satisfying the
926+ Skip s' -> loop i s'
927−-- -- predicate.
927+ Yield x s' | a == x -> loop (i+1) s'
928−-- findIndicesI :: Integral a => (Char -> Bool) -> Stream Char -> [a]
928+ | otherwise -> loop i s'
929−-- -- findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0
929+{-# INLINE [0] countCharI #-}
930−-- findIndicesI p (Stream next s0) = loop_findIndex 0 s0
930+
931−-- where
931+streamError :: String -> String -> a
932−-- loop_findIndex !i !s = case next s of
932+streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg
933−-- Done -> []
933+
934−-- Skip s' -> loop_findIndex i s' -- hmm. not caught by QC
934+emptyError :: String -> a
935−-- Yield x s' | p x -> i : loop_findIndex (i+1) s'
935+emptyError func = internalError func "Empty input"
936−-- | otherwise -> loop_findIndex (i+1) s'
936+
937−-- {-# INLINE [0] findIndicesI #-}
937+internalError :: String -> a
938−
938+internalError func = streamError func "Internal error"
939−-- -------------------------------------------------------------------------------
940−-- -- * Zipping
941−
942−-- -- | Strict triple.
943−-- data Zip a b m = Z1 !a !b
944−-- | Z2 !a !b !m
945−
946−-- -- | zipWith generalises 'zip' by zipping with the function given as
947−-- -- the first argument, instead of a tupling function.
948−-- zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
949−-- -- zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
950−-- zipWith f (Stream next0 sa0) (Stream next1 sb0) =
951−-- Stream next (Z1 sa0 sb0) -- (smaller len1 len2)
952−-- where
953−-- next (Z1 sa sb) = case next0 sa of
954−-- Done -> Done
955−-- Skip sa' -> Skip (Z1 sa' sb)
956−-- Yield a sa' -> Skip (Z2 sa' sb a)
957−
958−-- next (Z2 sa' sb a) = case next1 sb of
959−-- Done -> Done
960−-- Skip sb' -> Skip (Z2 sa' sb' a)
961−-- Yield b sb' -> Yield (f a b) (Z1 sa' sb')
962−-- {-# INLINE [0] zipWith #-}
963−
964−-- -- | /O(n)/ The 'countCharI' function returns the number of times the
965−-- -- query element appears in the given stream.
966−-- countCharI :: Integral a => Char -> Stream Char -> a
967−-- -- countCharI a (Stream next s0 _len) = loop 0 s0
968−-- countCharI a (Stream next s0) = loop 0 s0
969−-- where
970−-- loop !i !s = case next s of
971−-- Done -> i
972−-- Skip s' -> loop i s'
973−-- Yield x s' | a == x -> loop (i+1) s'
974−-- | otherwise -> loop i s'
975−-- {-# INLINE [0] countCharI #-}
976−
977−-- streamError :: String -> String -> a
978−-- streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg
979−
980−-- emptyError :: String -> a
981−-- emptyError func = internalError func "Empty input"
982−
983−-- internalError :: String -> a
984−-- internalError func = streamError func "Internal error"
Data/Text/Internal/Fusion/Size.hs+7−33
@@ -1,4 +1,4 @@
1−{-# LANGUAGE CPP, PatternGuards #-}
1+{-# LANGUAGE CPP #-}
2{-# OPTIONS_GHC -fno-warn-missing-methods #-}
2{-# OPTIONS_GHC -fno-warn-missing-methods #-}
3-- |
3-- |
4-- Module : Data.Text.Internal.Fusion.Internal
4-- Module : Data.Text.Internal.Fusion.Internal
@@ -19,16 +19,11 @@
19module Data.Text.Internal.Fusion.Size
19module Data.Text.Internal.Fusion.Size
20 (
20 (
21 Size
21 Size
22− -- * Sizes
22+ , exactly
23 , exactSize
23 , exactSize
24 , maxSize
24 , maxSize
25 , betweenSize
25 , betweenSize
26 , unknownSize
26 , unknownSize
27− , unionSize
28− , charSize
29− , codePointsSize
30− -- * Querying sizes
31− , exactly
32 , smaller
27 , smaller
33 , larger
28 , larger
34 , upperBound
29 , upperBound
@@ -37,13 +32,11 @@ module Data.Text.Internal.Fusion.Size
37 , isEmpty
32 , isEmpty
38 ) where
33 ) where
39
34
40−import Data.Char (ord)
41import Data.Text.Internal (mul)
35import Data.Text.Internal (mul)
42#if defined(ASSERTS)
36#if defined(ASSERTS)
43import Control.Exception (assert)
37import Control.Exception (assert)
44#endif
38#endif
45
39
46−-- | A size in UTF-16 code units.
47data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.
40data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.
48 | Unknown -- ^ Unknown size.
41 | Unknown -- ^ Unknown size.
49 deriving (Eq, Show)
42 deriving (Eq, Show)
@@ -53,17 +46,6 @@ exactly (Between na nb) | na == nb = Just na
53exactly _ = Nothing
46exactly _ = Nothing
54{-# INLINE exactly #-}
47{-# INLINE exactly #-}
55
48
56−-- | The 'Size' of the given code point.
57−charSize :: Char -> Size
58−charSize c
59− | ord c < 0x10000 = exactSize 1
60− | otherwise = exactSize 2
61−
62−-- | The 'Size' of @n@ code points.
63−codePointsSize :: Int -> Size
64−codePointsSize n = Between n (2*n)
65−{-# INLINE codePointsSize #-}
66−
67exactSize :: Int -> Size
49exactSize :: Int -> Size
68exactSize n =
50exactSize n =
69#if defined(ASSERTS)
51#if defined(ASSERTS)
@@ -89,10 +71,6 @@ betweenSize m n =
89 Between m n
71 Between m n
90{-# INLINE betweenSize #-}
72{-# INLINE betweenSize #-}
91
73
92−unionSize :: Size -> Size -> Size
93−unionSize (Between a b) (Between c d) = Between (min a c) (max b d)
94−unionSize _ _ = Unknown
95−
96unknownSize :: Size
74unknownSize :: Size
97unknownSize = Unknown
75unknownSize = Unknown
98{-# INLINE unknownSize #-}
76{-# INLINE unknownSize #-}
@@ -162,15 +140,11 @@ lowerBound _ (Between n _) = n
162lowerBound k _ = k
140lowerBound k _ = k
163{-# INLINE lowerBound #-}
141{-# INLINE lowerBound #-}
164
142
165−-- | Determine the ordering relationship between two 'Size's, or 'Nothing' in
166−-- the indeterminate case.
167−compareSize :: Size -> Size -> Maybe Ordering
143+compareSize :: Size -> Int -> Maybe Ordering
168−compareSize (Between ma mb) (Between na nb)
144+compareSize (Between ma mb) n
169− | mb < na = Just LT
145+ | mb < n = Just LT
170− | ma > nb = Just GT
146+ | ma > n = Just GT
171− | ma == mb
172− , ma == na
173− , ma == nb = Just EQ
147+ | ma == n && mb == n = Just EQ
174compareSize _ _ = Nothing
148compareSize _ _ = Nothing
175
149
176
150
Data/Text/Internal/Fusion/Types.hs+99−102
@@ -19,107 +19,104 @@
19
19
20module Data.Text.Internal.Fusion.Types
20module Data.Text.Internal.Fusion.Types
21 (
21 (
22− -- CC(..)
22+ CC(..)
23− -- , PairS(..)
23+ , PairS(..)
24− -- , Scan(..)
24+ , Scan(..)
25− -- , RS(..)
25+ , RS(..)
26− -- , Step(..)
26+ , Step(..)
27− -- , Stream(..)
27+ , Stream(..)
28− -- , empty
28+ , empty
29− module Data.JSString.Internal.Fusion.Types
30 ) where
29 ) where
31
30
32−-- import Data.Text.Internal.Fusion.Size
31+import Data.Text.Internal.Fusion.Size
33−-- import Data.Word (Word8)
32+import Data.Word (Word8)
34−
33+
35−import Data.JSString.Internal.Fusion.Types
36−
37−-- -- | Specialised tuple for case conversion.
34+-- | Specialised tuple for case conversion.
38−-- data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char
35+data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char
39−
36+
40−-- -- | Restreaming state.
37+-- | Restreaming state.
41−-- data RS s
38+data RS s
42−-- = RS0 !s
39+ = RS0 !s
43−-- | RS1 !s {-# UNPACK #-} !Word8
40+ | RS1 !s {-# UNPACK #-} !Word8
44−-- | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
41+ | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
45−-- | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
42+ | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
46−
43+
47−-- -- | Strict pair.
44+-- | Strict pair.
48−-- data PairS a b = !a :*: !b
45+data PairS a b = !a :*: !b
49−-- -- deriving (Eq, Ord, Show)
46+ -- deriving (Eq, Ord, Show)
50−-- infixl 2 :*:
47+infixl 2 :*:
51−
48+
52−-- -- | An intermediate result in a scan.
49+-- | An intermediate result in a scan.
53−-- data Scan s = Scan1 {-# UNPACK #-} !Char !s
50+data Scan s = Scan1 {-# UNPACK #-} !Char !s
54−-- | Scan2 {-# UNPACK #-} !Char !s
51+ | Scan2 {-# UNPACK #-} !Char !s
55−
52+
56−-- -- | Intermediate result in a processing pipeline.
53+-- | Intermediate result in a processing pipeline.
57−-- data Step s a = Done
54+data Step s a = Done
58−-- | Skip !s
55+ | Skip !s
59−-- | Yield !a !s
56+ | Yield !a !s
60−
57+
61−-- {-
58+{-
62−-- instance (Show a) => Show (Step s a)
59+instance (Show a) => Show (Step s a)
63−-- where show Done = "Done"
60+ where show Done = "Done"
64−-- show (Skip _) = "Skip"
61+ show (Skip _) = "Skip"
65−-- show (Yield x _) = "Yield " ++ show x
62+ show (Yield x _) = "Yield " ++ show x
66−-- -}
63+-}
67−
64+
68−-- instance (Eq a) => Eq (Stream a) where
65+instance (Eq a) => Eq (Stream a) where
69−-- (==) = eq
66+ (==) = eq
70−
67+
71−-- instance (Ord a) => Ord (Stream a) where
68+instance (Ord a) => Ord (Stream a) where
72−-- compare = cmp
69+ compare = cmp
73−
70+
74−-- -- The length hint in a Stream has two roles. If its value is zero,
71+-- The length hint in a Stream has two roles. If its value is zero,
75−-- -- we trust it, and treat the stream as empty. Otherwise, we treat it
72+-- we trust it, and treat the stream as empty. Otherwise, we treat it
76−-- -- as a hint: it should usually be accurate, so we use it when
73+-- as a hint: it should usually be accurate, so we use it when
77−-- -- unstreaming to decide what size array to allocate. However, the
74+-- unstreaming to decide what size array to allocate. However, the
78−-- -- unstreaming functions must be able to cope with the hint being too
75+-- unstreaming functions must be able to cope with the hint being too
79−-- -- small or too large.
76+-- small or too large.
80−-- --
77+--
81−-- -- The size hint tries to track the UTF-16 code units in a stream,
78+-- The size hint tries to track the UTF-16 code points in a stream,
82−-- -- but often counts the number of code points instead. It can easily
79+-- but often counts the number of characters instead. It can easily
83−-- -- undercount if, for instance, a transformed stream contains astral
80+-- undercount if, for instance, a transformed stream contains astral
84−-- -- plane code points (those above 0x10000).
81+-- plane characters (those above 0x10000).
85−
82+
86−-- data Stream a =
83+data Stream a =
87−-- forall s. Stream
84+ forall s. Stream
88−-- (s -> Step s a) -- stepper function
85+ (s -> Step s a) -- stepper function
89−-- !s -- current state
86+ !s -- current state
90−-- !Size -- size hint in code units
87+ !Size -- size hint
91−
88+
92−-- -- | /O(n)/ Determines if two streams are equal.
89+-- | /O(n)/ Determines if two streams are equal.
93−-- eq :: (Eq a) => Stream a -> Stream a -> Bool
90+eq :: (Eq a) => Stream a -> Stream a -> Bool
94−-- eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
91+eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
95−-- where
92+ where
96−-- loop Done Done = True
93+ loop Done Done = True
97−-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
94+ loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
98−-- loop (Skip s1') x2 = loop (next1 s1') x2
95+ loop (Skip s1') x2 = loop (next1 s1') x2
99−-- loop x1 (Skip s2') = loop x1 (next2 s2')
96+ loop x1 (Skip s2') = loop x1 (next2 s2')
100−-- loop Done _ = False
97+ loop Done _ = False
101−-- loop _ Done = False
98+ loop _ Done = False
102−-- loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
99+ loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
103−-- loop (next1 s1') (next2 s2')
100+ loop (next1 s1') (next2 s2')
104−-- {-# INLINE [0] eq #-}
101+{-# INLINE [0] eq #-}
105−
102+
106−-- cmp :: (Ord a) => Stream a -> Stream a -> Ordering
103+cmp :: (Ord a) => Stream a -> Stream a -> Ordering
107−-- cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
104+cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
108−-- where
105+ where
109−-- loop Done Done = EQ
106+ loop Done Done = EQ
110−-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
107+ loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
111−-- loop (Skip s1') x2 = loop (next1 s1') x2
108+ loop (Skip s1') x2 = loop (next1 s1') x2
112−-- loop x1 (Skip s2') = loop x1 (next2 s2')
109+ loop x1 (Skip s2') = loop x1 (next2 s2')
113−-- loop Done _ = LT
110+ loop Done _ = LT
114−-- loop _ Done = GT
111+ loop _ Done = GT
115−-- loop (Yield x1 s1') (Yield x2 s2') =
112+ loop (Yield x1 s1') (Yield x2 s2') =
116−-- case compare x1 x2 of
113+ case compare x1 x2 of
117−-- EQ -> loop (next1 s1') (next2 s2')
114+ EQ -> loop (next1 s1') (next2 s2')
118−-- other -> other
115+ other -> other
119−-- {-# INLINE [0] cmp #-}
116+{-# INLINE [0] cmp #-}
120−
117+
121−-- -- | The empty stream.
118+-- | The empty stream.
122−-- empty :: Stream a
119+empty :: Stream a
123−-- empty = Stream next () 0
120+empty = Stream next () 0
124−-- where next _ = Done
121+ where next _ = Done
125−-- {-# INLINE [0] empty #-}
122+{-# INLINE [0] empty #-}
Data/Text/Internal/IO.hs−8
@@ -95,11 +95,7 @@ unpack !buf !r !w
95 | r >= w = return T.empty
95 | r >= w = return T.empty
96 | otherwise = withRawBuffer buf go
96 | otherwise = withRawBuffer buf go
97 where
97 where
98−#ifndef __GHCJS__
99 go pbuf = return $! unstream (Stream next r (exactSize (w-r)))
98 go pbuf = return $! unstream (Stream next r (exactSize (w-r)))
100−#else
101− go pbuf = return $! unstream (Stream next r)
102−#endif
103 where
99 where
104 next !i | i >= w = Done
100 next !i | i >= w = Done
105 | otherwise = Yield (ix i) (i+1)
101 | otherwise = Yield (ix i) (i+1)
@@ -112,11 +108,7 @@ unpack_nl !buf !r !w
112 | otherwise = withRawBuffer buf $ go
108 | otherwise = withRawBuffer buf $ go
113 where
109 where
114 go pbuf = do
110 go pbuf = do
115−#ifndef __GHCJS__
116 let !t = unstream (Stream next r (maxSize (w-r)))
111 let !t = unstream (Stream next r (maxSize (w-r)))
117−#else
118− let !t = unstream (Stream next r)
119−#endif
120 w' = w - 1
112 w' = w - 1
121 return $ if ix w' == '\r'
113 return $ if ix w' == '\r'
122 then (t,w')
114 then (t,w')
Data/Text/Internal/Lazy.hs+1−20
@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, DeriveDataTypeable, CPP #-}
1+{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
2{-# OPTIONS_HADDOCK not-home #-}
2{-# OPTIONS_HADDOCK not-home #-}
3
3
4-- |
4-- |
@@ -44,10 +44,6 @@ import Data.Typeable (Typeable)
44import Foreign.Storable (sizeOf)
44import Foreign.Storable (sizeOf)
45import qualified Data.Text.Internal as T
45import qualified Data.Text.Internal as T
46
46
47−#ifdef __GHCJS__
48−import qualified Data.Text as TT
49−#endif
50−
51data Text = Empty
47data Text = Empty
52 | Chunk {-# UNPACK #-} !T.Text Text
48 | Chunk {-# UNPACK #-} !T.Text Text
53 deriving (Typeable)
49 deriving (Typeable)
@@ -61,26 +57,16 @@ data Text = Empty
61-- | Check the invariant strictly.
57-- | Check the invariant strictly.
62strictInvariant :: Text -> Bool
58strictInvariant :: Text -> Bool
63strictInvariant Empty = True
59strictInvariant Empty = True
64−#ifndef __GHCJS__
65strictInvariant x@(Chunk (T.Text _ _ len) cs)
60strictInvariant x@(Chunk (T.Text _ _ len) cs)
66 | len > 0 = strictInvariant cs
61 | len > 0 = strictInvariant cs
67−#else
68−strictInvariant x@(Chunk t cs)
69− | TT.length t > 0 = strictInvariant cs
70−#endif
71 | otherwise = error $ "Data.Text.Lazy: invariant violation: "
62 | otherwise = error $ "Data.Text.Lazy: invariant violation: "
72 ++ showStructure x
63 ++ showStructure x
73
64
74-- | Check the invariant lazily.
65-- | Check the invariant lazily.
75lazyInvariant :: Text -> Text
66lazyInvariant :: Text -> Text
76lazyInvariant Empty = Empty
67lazyInvariant Empty = Empty
77−#ifndef __GHCJS__
78lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)
68lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)
79 | len > 0 = Chunk c (lazyInvariant cs)
69 | len > 0 = Chunk c (lazyInvariant cs)
80−#else
81−lazyInvariant x@(Chunk c cs)
82− | TT.length c > 0 = Chunk c (lazyInvariant cs)
83−#endif
84 | otherwise = error $ "Data.Text.Lazy: invariant violation: "
70 | otherwise = error $ "Data.Text.Lazy: invariant violation: "
85 ++ showStructure x
71 ++ showStructure x
86
72
@@ -94,13 +80,8 @@ showStructure (Chunk t ts) =
94-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.
80-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.
95chunk :: T.Text -> Text -> Text
81chunk :: T.Text -> Text -> Text
96{-# INLINE chunk #-}
82{-# INLINE chunk #-}
97−#ifndef __GHCJS__
98chunk t@(T.Text _ _ len) ts | len == 0 = ts
83chunk t@(T.Text _ _ len) ts | len == 0 = ts
99 | otherwise = Chunk t ts
84 | otherwise = Chunk t ts
100−#else
101−chunk t ts | TT.null t = ts
102− | otherwise = Chunk t ts
103−#endif
104
85
105-- | Smart constructor for 'Empty'.
86-- | Smart constructor for 'Empty'.
106empty :: Text
87empty :: Text
Data/Text/Internal/Lazy/Encoding/Fusion.hs−26
@@ -38,9 +38,7 @@ import qualified Data.ByteString.Unsafe as B
38import Data.Text.Internal.Encoding.Fusion.Common
38import Data.Text.Internal.Encoding.Fusion.Common
39import Data.Text.Encoding.Error
39import Data.Text.Encoding.Error
40import Data.Text.Internal.Fusion (Step(..), Stream(..))
40import Data.Text.Internal.Fusion (Step(..), Stream(..))
41−#ifndef __GHCJS__
42import Data.Text.Internal.Fusion.Size
41import Data.Text.Internal.Fusion.Size
43−#endif
44import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)
42import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)
45import Data.Text.Internal.Unsafe.Shift (shiftL)
43import Data.Text.Internal.Unsafe.Shift (shiftL)
46import Data.Word (Word8, Word16, Word32)
44import Data.Word (Word8, Word16, Word32)
@@ -67,11 +65,7 @@ data T = T !ByteString !S {-# UNPACK #-} !Int
67-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using
65-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using
68-- UTF-8 encoding.
66-- UTF-8 encoding.
69streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
67streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
70−#ifndef __GHCJS__
71streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize
68streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize
72−#else
73−streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
74−#endif
75 where
69 where
76 next (T bs@(Chunk ps _) S0 i)
70 next (T bs@(Chunk ps _) S0 i)
77 | i < len && U8.validate1 a =
71 | i < len && U8.validate1 a =
@@ -113,11 +107,7 @@ streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
113-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
107-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
114-- endian UTF-16 encoding.
108-- endian UTF-16 encoding.
115streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
109streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
116−#ifndef __GHCJS__
117streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
110streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
118−#else
119−streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
120−#endif
121 where
111 where
122 next (T bs@(Chunk ps _) S0 i)
112 next (T bs@(Chunk ps _) S0 i)
123 | i + 1 < len && U16.validate1 x1 =
113 | i + 1 < len && U16.validate1 x1 =
@@ -157,11 +147,7 @@ streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
157-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
147-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
158-- endian UTF-16 encoding.
148-- endian UTF-16 encoding.
159streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
149streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
160−#ifndef __GHCJS__
161streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
150streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
162−#else
163−streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
164−#endif
165 where
151 where
166 next (T bs@(Chunk ps _) S0 i)
152 next (T bs@(Chunk ps _) S0 i)
167 | i + 1 < len && U16.validate1 x1 =
153 | i + 1 < len && U16.validate1 x1 =
@@ -201,11 +187,7 @@ streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
201-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
187-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
202-- endian UTF-32 encoding.
188-- endian UTF-32 encoding.
203streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
189streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
204−#ifndef __GHCJS__
205streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
190streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
206−#else
207−streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
208−#endif
209 where
191 where
210 next (T bs@(Chunk ps _) S0 i)
192 next (T bs@(Chunk ps _) S0 i)
211 | i + 3 < len && U32.validate x =
193 | i + 3 < len && U32.validate x =
@@ -249,11 +231,7 @@ streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
249-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
231-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
250-- endian UTF-32 encoding.
232-- endian UTF-32 encoding.
251streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
233streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
252−#ifndef __GHCJS__
253streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
234streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
254−#else
255−streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
256−#endif
257 where
235 where
258 next (T bs@(Chunk ps _) S0 i)
236 next (T bs@(Chunk ps _) S0 i)
259 | i + 3 < len && U32.validate x =
237 | i + 3 < len && U32.validate x =
@@ -296,11 +274,7 @@ streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
296
274
297-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
275-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
298unstreamChunks :: Int -> Stream Word8 -> ByteString
276unstreamChunks :: Int -> Stream Word8 -> ByteString
299−#ifndef __GHCJS__
300unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)
277unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)
301−#else
302−unstreamChunks chunkSize (Stream next s0) = chunk s0 4
303−#endif
304 where chunk s1 len1 = unsafeDupablePerformIO $ do
278 where chunk s1 len1 = unsafeDupablePerformIO $ do
305 let len = max 4 (min len1 chunkSize)
279 let len = max 4 (min len1 chunkSize)
306 mallocByteString len >>= loop len 0 s1
280 mallocByteString len >>= loop len 0 s1
Data/Text/Internal/Lazy/Fusion.hs−62
@@ -1,10 +1,4 @@
1{-# LANGUAGE BangPatterns #-}
1{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE CPP #-}
3−#ifdef __GHCJS__
4−{-# LANGUAGE ForeignFunctionInterface #-}
5−{-# LANGUAGE MagicHash #-}
6−{-# LANGUAGE UnliftedFFITypes #-}
7−#endif
8-- |
2-- |
9-- Module : Data.Text.Lazy.Fusion
3-- Module : Data.Text.Lazy.Fusion
10-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
@@ -35,14 +29,7 @@ import Prelude hiding (length)
35import qualified Data.Text.Internal.Fusion.Common as S
29import qualified Data.Text.Internal.Fusion.Common as S
36import Control.Monad.ST (runST)
30import Control.Monad.ST (runST)
37import Data.Text.Internal.Fusion.Types
31import Data.Text.Internal.Fusion.Types
38−#ifndef __GHCJS__
39import Data.Text.Internal.Fusion.Size (isEmpty, unknownSize)
32import Data.Text.Internal.Fusion.Size (isEmpty, unknownSize)
40−#else
41−import Data.JSString (JSString)
42−import qualified Data.JSString as JSS
43−import GHC.Base (Int(..))
44−import GHC.Exts (ByteArray#, Int#)
45−#endif
46import Data.Text.Internal.Lazy
33import Data.Text.Internal.Lazy
47import qualified Data.Text.Internal as I
34import qualified Data.Text.Internal as I
48import qualified Data.Text.Array as A
35import qualified Data.Text.Array as A
@@ -55,7 +42,6 @@ default(Int64)
55
42
56-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
43-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
57stream :: Text -> Stream Char
44stream :: Text -> Stream Char
58−#ifndef __GHCJS__
59stream text = Stream next (text :*: 0) unknownSize
45stream text = Stream next (text :*: 0) unknownSize
60 where
46 where
61 next (Empty :*: _) = Done
47 next (Empty :*: _) = Done
@@ -63,22 +49,11 @@ stream text = Stream next (text :*: 0) unknownSize
63 | i >= len = next (ts :*: 0)
49 | i >= len = next (ts :*: 0)
64 | otherwise = Yield c (txt :*: i+d)
50 | otherwise = Yield c (txt :*: i+d)
65 where Iter c d = iter t i
51 where Iter c d = iter t i
66−#else
67−stream text = Stream next (text :*: 0) -- unknownSize
68− where
69− next (Empty :*: _) = Done
70− next (txt@(Chunk t@(I.Text jst) ts) :*: i)
71− | i >= JSS.length jst = next (ts :*: 0)
72− | otherwise = Yield c (txt :*: i+d)
73− where Iter c d = iter t i
74−#endif
75{-# INLINE [0] stream #-}
52{-# INLINE [0] stream #-}
76
53
77−-- TODO
78-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given
54-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given
79-- chunk size.
55-- chunk size.
80unstreamChunks :: Int -> Stream Char -> Text
56unstreamChunks :: Int -> Stream Char -> Text
81−#ifndef __GHCJS__
82unstreamChunks !chunkSize (Stream next s0 len0)
57unstreamChunks !chunkSize (Stream next s0 len0)
83 | isEmpty len0 = Empty
58 | isEmpty len0 = Empty
84 | otherwise = outer s0
59 | otherwise = outer s0
@@ -109,36 +84,6 @@ unstreamChunks !chunkSize (Stream next s0 len0)
109 finish marr len s' = do
84 finish marr len s' = do
110 arr <- A.unsafeFreeze marr
85 arr <- A.unsafeFreeze marr
111 return (I.Text arr 0 len `Chunk` outer s')
86 return (I.Text arr 0 len `Chunk` outer s')
112−#else
113−unstreamChunks !chunkSize (Stream next s0) = outer s0
114− where
115− outer so = {-# SCC "unstreamChunks/outer" #-}
116− case next so of
117− Done -> Empty
118− Skip s' -> outer s'
119− Yield x s' -> runST $ do
120− a <- A.new unknownLength
121− unsafeWrite a 0 x >>= inner a unknownLength s'
122− where unknownLength = 4
123− where
124− inner marr !len s !i
125− | i + 1 >= chunkSize = finish marr i s
126− | i + 1 >= len = {-# SCC "unstreamChunks/resize" #-} do
127− let newLen = min (len `shiftL` 1) chunkSize
128− marr' <- A.new newLen
129− A.copyM marr' 0 marr 0 len
130− inner marr' newLen s i
131− | otherwise =
132− {-# SCC "unstreamChunks/inner" #-}
133− case next s of
134− Done -> finish marr i s
135− Skip s' -> inner marr len s' i
136− Yield x s' -> do d <- unsafeWrite marr i x
137− inner marr len s' (i+d)
138− finish marr (I# len#) s' = do
139− arr <- A.unsafeFreeze marr
140− return (I.Text (js_toString (A.aBA arr) 0# len#) `Chunk` outer s')
141−#endif
142{-# INLINE [0] unstreamChunks #-}
87{-# INLINE [0] unstreamChunks #-}
143
88
144-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using
89-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using
@@ -173,10 +118,3 @@ index = S.indexI
173countChar :: Char -> Stream Char -> Int64
118countChar :: Char -> Stream Char -> Int64
174countChar = S.countCharI
119countChar = S.countCharI
175{-# INLINE [0] countChar #-}
120{-# INLINE [0] countChar #-}
176−
177−#ifdef __GHCJS__
178−foreign import javascript unsafe
179− "h$textToString"
180− js_toString :: ByteArray# -> Int# -> Int# -> JSString
181−#endif
182−
Data/Text/Internal/Lazy/Search.hs+11−55
@@ -1,7 +1,4 @@
1{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
1{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
2−{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes, JavaScriptFFI,
3− UnboxedTuples, DeriveDataTypeable, GHCForeignImportPrim,
4− MagicHash, FlexibleInstances, BangPatterns, Rank2Types, CPP #-}
5
2
6-- |
3-- |
7-- Module : Data.Text.Lazy.Search
4-- Module : Data.Text.Lazy.Search
@@ -34,17 +31,6 @@ import Data.Text.Internal.Lazy (Text(..), foldlChunks)
34import Data.Bits ((.|.), (.&.))
31import Data.Bits ((.|.), (.&.))
35import Data.Text.Internal.Unsafe.Shift (shiftL)
32import Data.Text.Internal.Unsafe.Shift (shiftL)
36
33
37−import Data.JSString (JSString)
38−import qualified Data.Text as TT
39−import GHC.Exts (Int(..), Int#, ByteArray#)
40−
41−foreign import javascript unsafe
42− "h$textFromString"
43− js_fromString :: JSString -> (# ByteArray#, Int# #)
44−
45−fromString :: T.Text -> (# ByteArray#, Int# #)
46−fromString (T.Text txt) = js_fromString txt
47−
48-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
34-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
49-- @needle@ within @haystack@.
35-- @needle@ within @haystack@.
50--
36--
@@ -61,10 +47,8 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)
61 | nlen == 1 = indicesOne (nindex 0) 0 k ks
47 | nlen == 1 = indicesOne (nindex 0) 0 k ks
62 | otherwise = advance k ks 0 0
48 | otherwise = advance k ks 0 0
63 where
49 where
64− -- advance x@(T.Text _ _ l) xs = scan
50+ advance x@(T.Text _ _ l) xs = scan
65− advance x xs = scan
66 where
51 where
67− l = TT.length x
68 scan !g !i
52 scan !g !i
69 | i >= m = case xs of
53 | i >= m = case xs of
70 Empty -> []
54 Empty -> []
@@ -88,23 +72,11 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)
88 nlast = nlen - 1
72 nlast = nlen - 1
89 nindex = index n ns
73 nindex = index n ns
90 z = foldlChunks fin 0 needle
74 z = foldlChunks fin 0 needle
91− where
92− -- fin _ (T.Text farr foff flen) =
93− fin _ t =
94− let foff = 0
95− (farr, flen) =
96− let (# ba, len #) = fromString t
97− in (A.Array ba, I# len)
98− in A.unsafeIndex farr (foff+flen-1)
75+ where fin _ (T.Text farr foff flen) = A.unsafeIndex farr (foff+flen-1)
99 (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)
76 (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)
100 swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)
77 swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)
101− -- buildTable (T.Text xarr xoff xlen) xs = go
78+ buildTable (T.Text xarr xoff xlen) xs = go
102− buildTable t xs = go
103 where
79 where
104− xoff = 0
105− (xarr, xlen) =
106− let (# ba, len #) = fromString t
107− in (A.Array ba, I# len)
108 go !(g::Int64) !i !msk !skp
80 go !(g::Int64) !i !msk !skp
109 | i >= xlast = case xs of
81 | i >= xlast = case xs of
110 Empty -> (msk .|. swizzle z) :*: skp
82 Empty -> (msk .|. swizzle z) :*: skp
@@ -119,22 +91,17 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)
119 -- given offset would fail.
91 -- given offset would fail.
120 lackingHay q = go 0
92 lackingHay q = go 0
121 where
93 where
122− -- go p (T.Text _ _ l) ps = p' < q && case ps of
94+ go p (T.Text _ _ l) ps = p' < q && case ps of
123− go p t ps = p' < q && case ps of
124− Empty -> True
95+ Empty -> True
125− Chunk r rs -> go p' r rs
96+ Chunk r rs -> go p' r rs
126− where
127− l = TT.length t
128− p' = p + fromIntegral l
97+ where p' = p + fromIntegral l
129−
130indices _ _ = []
98indices _ _ = []
131
99
132-- | Fast index into a partly unpacked 'Text'. We take into account
100-- | Fast index into a partly unpacked 'Text'. We take into account
133-- the possibility that the caller might try to access one element
101-- the possibility that the caller might try to access one element
134-- past the end.
102-- past the end.
135index :: T.Text -> Text -> Int64 -> Word16
103index :: T.Text -> Text -> Int64 -> Word16
136−-- index (T.Text arr off len) xs !i
104+index (T.Text arr off len) xs !i
137−index t xs !i
138 | j < len = A.unsafeIndex arr (off+j)
105 | j < len = A.unsafeIndex arr (off+j)
139 | otherwise = case xs of
106 | otherwise = case xs of
140 Empty
107 Empty
@@ -143,24 +110,14 @@ index t xs !i
143 -- should never happen, due to lackingHay above
110 -- should never happen, due to lackingHay above
144 | otherwise -> emptyError "index"
111 | otherwise -> emptyError "index"
145 Chunk c cs -> index c cs (i-fromIntegral len)
112 Chunk c cs -> index c cs (i-fromIntegral len)
146− where
147− j = fromIntegral i
113+ where j = fromIntegral i
148− off = 0
149− (arr, len) =
150− let (# ba, len' #) = fromString t
151− in (A.Array ba, I# len')
152
114
153-- | A variant of 'indices' that scans linearly for a single 'Word16'.
115-- | A variant of 'indices' that scans linearly for a single 'Word16'.
154indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]
116indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]
155indicesOne c = chunk
117indicesOne c = chunk
156 where
118 where
157− -- chunk !i (T.Text oarr ooff olen) os = go 0
119+ chunk !i (T.Text oarr ooff olen) os = go 0
158− chunk !i t os = go 0
159 where
120 where
160− ooff = 0
161− (oarr, olen) =
162− let (# ba, len #) = fromString t
163− in (A.Array ba, I# len)
164 go h | h >= olen = case os of
121 go h | h >= olen = case os of
165 Empty -> []
122 Empty -> []
166 Chunk y ys -> chunk (i+fromIntegral olen) y ys
123 Chunk y ys -> chunk (i+fromIntegral olen) y ys
@@ -171,8 +128,7 @@ indicesOne c = chunk
171-- | The number of 'Word16' values in a 'Text'.
128-- | The number of 'Word16' values in a 'Text'.
172wordLength :: Text -> Int64
129wordLength :: Text -> Int64
173wordLength = foldlChunks sumLength 0
130wordLength = foldlChunks sumLength 0
174− where sumLength i t = i + fromIntegral (TT.length t)
175− -- where sumLength i (T.Text _ _ l) = i + fromIntegral l
131+ where sumLength i (T.Text _ _ l) = i + fromIntegral l
176
132
177emptyError :: String -> a
133emptyError :: String -> a
178emptyError fun = error ("Data.Text.Lazy.Search." ++ fun ++ ": empty input")
134emptyError fun = error ("Data.Text.Lazy.Search." ++ fun ++ ": empty input")
Data/Text/Internal/Private.hs+1−8
@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples, CPP #-}
1+{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples #-}
2
2
3-- |
3-- |
4-- Module : Data.Text.Internal.Private
4-- Module : Data.Text.Internal.Private
@@ -19,12 +19,8 @@ import Control.Monad.ST (ST, runST)
19import Data.Text.Internal (Text(..), text)
19import Data.Text.Internal (Text(..), text)
20import Data.Text.Unsafe (Iter(..), iter)
20import Data.Text.Unsafe (Iter(..), iter)
21import qualified Data.Text.Array as A
21import qualified Data.Text.Array as A
22−#ifdef __GHCJS__
23−import qualified Data.JSString as JSS
24−#endif
25
22
26span_ :: (Char -> Bool) -> Text -> (# Text, Text #)
23span_ :: (Char -> Bool) -> Text -> (# Text, Text #)
27−#ifndef __GHCJS__
28span_ p t@(Text arr off len) = (# hd,tl #)
24span_ p t@(Text arr off len) = (# hd,tl #)
29 where hd = text arr off k
25 where hd = text arr off k
30 tl = text arr (off+k) (len-k)
26 tl = text arr (off+k) (len-k)
@@ -32,9 +28,6 @@ span_ p t@(Text arr off len) = (# hd,tl #)
32 loop !i | i < len && p c = loop (i+d)
28 loop !i | i < len && p c = loop (i+d)
33 | otherwise = i
29 | otherwise = i
34 where Iter c d = iter t i
30 where Iter c d = iter t i
35−#else
36−span_ p (Text t) = let (# a, b #) = JSS.span_ p t in (# Text a, Text b #)
37−#endif
38{-# INLINE span_ #-}
31{-# INLINE span_ #-}
39
32
40runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text
33runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text
Data/Text/Internal/Search.hs+37−40
@@ -37,8 +37,6 @@ import Data.Text.Internal (Text(..))
37import Data.Bits ((.|.), (.&.))
37import Data.Bits ((.|.), (.&.))
38import Data.Text.Internal.Unsafe.Shift (shiftL)
38import Data.Text.Internal.Unsafe.Shift (shiftL)
39
39
40−import qualified Data.JSString.Internal.Search as JSS
41−
42data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
40data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
43
41
44-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
42-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
@@ -51,42 +49,41 @@ data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
51indices :: Text -- ^ Substring to search for (@needle@)
49indices :: Text -- ^ Substring to search for (@needle@)
52 -> Text -- ^ Text to search in (@haystack@)
50 -> Text -- ^ Text to search in (@haystack@)
53 -> [Int]
51 -> [Int]
54−indices = coerce JSS.indices
55−-- indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)
52+indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)
56−-- | nlen == 1 = scanOne (nindex 0)
53+ | nlen == 1 = scanOne (nindex 0)
57−-- | nlen <= 0 || ldiff < 0 = []
54+ | nlen <= 0 || ldiff < 0 = []
58−-- | otherwise = scan 0
55+ | otherwise = scan 0
59−-- where
56+ where
60−-- ldiff = hlen - nlen
57+ ldiff = hlen - nlen
61−-- nlast = nlen - 1
58+ nlast = nlen - 1
62−-- z = nindex nlast
59+ z = nindex nlast
63−-- nindex k = A.unsafeIndex narr (noff+k)
60+ nindex k = A.unsafeIndex narr (noff+k)
64−-- hindex k = A.unsafeIndex harr (hoff+k)
61+ hindex k = A.unsafeIndex harr (hoff+k)
65−-- hindex' k | k == hlen = 0
62+ hindex' k | k == hlen = 0
66−-- | otherwise = A.unsafeIndex harr (hoff+k)
63+ | otherwise = A.unsafeIndex harr (hoff+k)
67−-- buildTable !i !msk !skp
64+ buildTable !i !msk !skp
68−-- | i >= nlast = (msk .|. swizzle z) :* skp
65+ | i >= nlast = (msk .|. swizzle z) :* skp
69−-- | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'
66+ | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'
70−-- where c = nindex i
67+ where c = nindex i
71−-- skp' | c == z = nlen - i - 2
68+ skp' | c == z = nlen - i - 2
72−-- | otherwise = skp
69+ | otherwise = skp
73−-- swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)
70+ swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)
74−-- scan !i
71+ scan !i
75−-- | i > ldiff = []
72+ | i > ldiff = []
76−-- | c == z && candidateMatch 0 = i : scan (i + nlen)
73+ | c == z && candidateMatch 0 = i : scan (i + nlen)
77−-- | otherwise = scan (i + delta)
74+ | otherwise = scan (i + delta)
78−-- where c = hindex (i + nlast)
75+ where c = hindex (i + nlast)
79−-- candidateMatch !j
76+ candidateMatch !j
80−-- | j >= nlast = True
77+ | j >= nlast = True
81−-- | hindex (i+j) /= nindex j = False
78+ | hindex (i+j) /= nindex j = False
82−-- | otherwise = candidateMatch (j+1)
79+ | otherwise = candidateMatch (j+1)
83−-- delta | nextInPattern = nlen + 1
80+ delta | nextInPattern = nlen + 1
84−-- | c == z = skip + 1
81+ | c == z = skip + 1
85−-- | otherwise = 1
82+ | otherwise = 1
86−-- where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0
83+ where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0
87−-- !(mask :* skip) = buildTable 0 0 (nlen-2)
84+ !(mask :* skip) = buildTable 0 0 (nlen-2)
88−-- scanOne c = loop 0
85+ scanOne c = loop 0
89−-- where loop !i | i >= hlen = []
86+ where loop !i | i >= hlen = []
90−-- | hindex i == c = i : loop (i+1)
87+ | hindex i == c = i : loop (i+1)
91−-- | otherwise = loop (i+1)
88+ | otherwise = loop (i+1)
92{-# INLINE indices #-}
89{-# INLINE indices #-}
Data/Text/Lazy.hs+21−103
@@ -6,15 +6,14 @@
6#if __GLASGOW_HASKELL__ >= 708
6#if __GLASGOW_HASKELL__ >= 708
7{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeFamilies #-}
8#endif
8#endif
9−#ifdef __GHCJS__
9+
10−{-# LANGUAGE ForeignFunctionInterface #-}
11−#endif
12-- |
10-- |
13-- Module : Data.Text.Lazy
11-- Module : Data.Text.Lazy
14-- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan
12-- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan
15--
13--
16-- License : BSD-style
14-- License : BSD-style
17-- Maintainer : bos@serpentine.com
15-- Maintainer : bos@serpentine.com
16+-- Stability : experimental
18-- Portability : GHC
17-- Portability : GHC
19--
18--
20-- A time and space-efficient implementation of Unicode text using
19-- A time and space-efficient implementation of Unicode text using
@@ -69,7 +68,6 @@ module Data.Text.Lazy
69 , snoc
68 , snoc
70 , append
69 , append
71 , uncons
70 , uncons
72− , unsnoc
73 , head
71 , head
74 , last
72 , last
75 , tail
73 , tail
@@ -246,9 +244,6 @@ import GHC.Prim (Addr#)
246#if MIN_VERSION_base(4,7,0)
244#if MIN_VERSION_base(4,7,0)
247import Text.Printf (PrintfArg, formatArg, formatString)
245import Text.Printf (PrintfArg, formatArg, formatString)
248#endif
246#endif
249−#ifdef __GHCJS__
250−import Data.JSString (JSString)
251−#endif
252
247
253-- $fusion
248-- $fusion
254--
249--
@@ -278,16 +273,14 @@ import Data.JSString (JSString)
278-- $replacement
273-- $replacement
279--
274--
280-- A 'Text' value is a sequence of Unicode scalar values, as defined
275-- A 'Text' value is a sequence of Unicode scalar values, as defined
281−-- in
282−-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35 §3.9, definition D76 of the Unicode 5.2 standard >.
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
283−-- As such, a 'Text' cannot contain values in the range U+D800 to
278+-- such, a 'Text' cannot contain values in the range U+D800 to U+DFFF
284−-- U+DFFF inclusive. Haskell implementations admit all Unicode code
279+-- inclusive. Haskell implementations admit all Unicode code points
285−-- points
286−-- (<http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=13 §3.4, definition D10 >)
287−-- as 'Char' values, including code points from this invalid range.
280+-- (&#xa7;3.4, definition D10) as 'Char' values, including code points
288−-- This means that there are some 'Char' values that are not valid
281+-- from this invalid range. This means that there are some 'Char'
289−-- Unicode scalar values, and the functions in this module must handle
282+-- values that are not valid Unicode scalar values, and the functions
290−-- those cases.
283+-- in this module must handle those cases.
291--
284--
292-- Within this module, many functions construct a 'Text' from one or
285-- Within this module, many functions construct a 'Text' from one or
293-- more 'Char' values. Those functions will substitute 'Char' values
286-- more 'Char' values. Those functions will substitute 'Char' values
@@ -301,8 +294,8 @@ import Data.JSString (JSString)
301-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate
294-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate
302-- code points, and so cannot be represented. The functions replace
295-- code points, and so cannot be represented. The functions replace
303-- invalid scalar values, instead of dropping them, as a security
296-- invalid scalar values, instead of dropping them, as a security
304−-- measure. For details, see
297+-- measure. For details, see Unicode Technical Report 36, &#xa7;3.5:
305−-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters Unicode Technical Report 36, §3.5 >.)
298+-- <http://unicode.org/reports/tr36#Deletion_of_Noncharacters>)
306
299
307equal :: Text -> Text -> Bool
300equal :: Text -> Text -> Bool
308equal Empty Empty = True
301equal Empty Empty = True
@@ -331,7 +324,6 @@ compareText Empty _ = LT
331compareText _ Empty = GT
324compareText _ Empty = GT
332compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0
325compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0
333 where
326 where
334−#ifndef __GHCJS__
335 outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0
327 outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0
336 where
328 where
337 go !i !j
329 go !i !j
@@ -342,20 +334,6 @@ compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0
342 | otherwise = go (i+di) (j+dj)
334 | otherwise = go (i+di) (j+dj)
343 where T.Iter a di = T.iter ta i
335 where T.Iter a di = T.iter ta i
344 T.Iter b dj = T.iter tb j
336 T.Iter b dj = T.iter tb j
345−#else
346− outer ta@(T.Text jsa) tb@(T.Text jsb) = go 0 0
347− where
348− go !i !j
349− | i >= lenA = compareText as (chunk (T.Text (js_substr1 j jsb)) bs)
350− | j >= lenB = compareText (chunk (T.Text (js_substr1 i jsa)) as) bs
351− | a < b = LT
352− | a > b = GT
353− | otherwise = go (i+di) (j+dj)
354− where T.Iter a di = T.iter ta i
355− T.Iter b dj = T.iter tb j
356− lenA = T.length ta
357− lenB = T.length tb
358−#endif
359
337
360instance Show Text where
338instance Show Text where
361 showsPrec p ps r = showsPrec p (unpack ps) r
339 showsPrec p ps r = showsPrec p (unpack ps) r
@@ -364,13 +342,9 @@ instance Read Text where
364 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
342 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
365
343
366#if MIN_VERSION_base(4,9,0)
344#if MIN_VERSION_base(4,9,0)
367−-- | Non-orphan 'Semigroup' instance only defined for
368−-- @base-4.9.0.0@ and later; orphan instances for older GHCs are
345+-- Semigroup orphan instances for older GHCs are provided by
369−-- provided by
370−-- the [semigroups](http://hackage.haskell.org/package/semigroups)
371−-- package
346+-- 'semigroups` package
372−--
347+
373−-- @since 1.2.2.0
374instance Semigroup Text where
348instance Semigroup Text where
375 (<>) = append
349 (<>) = append
376#endif
350#endif
@@ -388,7 +362,6 @@ instance IsString Text where
388 fromString = pack
362 fromString = pack
389
363
390#if __GLASGOW_HASKELL__ >= 708
364#if __GLASGOW_HASKELL__ >= 708
391−-- | @since 1.2.0.0
392instance Exts.IsList Text where
365instance Exts.IsList Text where
393 type Item Text = Char
366 type Item Text = Char
394 fromList = pack
367 fromList = pack
@@ -401,7 +374,6 @@ instance NFData Text where
401 rnf (Chunk _ ts) = rnf ts
374 rnf (Chunk _ ts) = rnf ts
402#endif
375#endif
403
376
404−-- | @since 1.2.1.0
405instance Binary Text where
377instance Binary Text where
406 put t = put (encodeUtf8 t)
378 put t = put (encodeUtf8 t)
407 get = do
379 get = do
@@ -425,8 +397,6 @@ instance Data Text where
425
397
426#if MIN_VERSION_base(4,7,0)
398#if MIN_VERSION_base(4,7,0)
427-- | Only defined for @base-4.7.0.0@ and later
399-- | Only defined for @base-4.7.0.0@ and later
428−--
429−-- @since 1.2.2.0
430instance PrintfArg Text where
400instance PrintfArg Text where
431 formatArg txt = formatString $ unpack txt
401 formatArg txt = formatString $ unpack txt
432#endif
402#endif
@@ -505,7 +475,9 @@ fromStrict t = chunk t Empty
505-- -----------------------------------------------------------------------------
475-- -----------------------------------------------------------------------------
506-- * Basic functions
476-- * Basic functions
507
477
508−-- | /O(1)/ Adds a character to the front of a 'Text'. Subject to fusion.
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.
509cons :: Char -> Text -> Text
481cons :: Char -> Text -> Text
510cons c t = Chunk (T.singleton c) t
482cons c t = Chunk (T.singleton c) t
511{-# INLINE [1] cons #-}
483{-# INLINE [1] cons #-}
@@ -589,17 +561,6 @@ init Empty = emptyError "init"
589 unstream (S.init (stream t)) = init t
561 unstream (S.init (stream t)) = init t
590 #-}
562 #-}
591
563
592−-- | /O(n\/c)/ Returns the 'init' and 'last' of a 'Text', or 'Nothing' if
593−-- empty.
594−--
595−-- * It is no faster than using 'init' and 'last'.
596−--
597−-- @since 1.2.3.0
598−unsnoc :: Text -> Maybe (Text, Char)
599−unsnoc Empty = Nothing
600−unsnoc ts@(Chunk _ _) = Just (init ts, last ts)
601−{-# INLINE unsnoc #-}
602−
603-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
564-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
604-- fusion.
565-- fusion.
605null :: Text -> Bool
566null :: Text -> Bool
@@ -859,8 +820,6 @@ toUpper t = unstream (S.toUpper (stream t))
859-- guides disagree on whether the book name \"The Hill of the Red
820-- guides disagree on whether the book name \"The Hill of the Red
860-- Fox\" is correctly title cased&#x2014;but this function will
821-- Fox\" is correctly title cased&#x2014;but this function will
861-- capitalize /every/ word.
822-- capitalize /every/ word.
862−--
863−-- @since 1.0.0.0
864toTitle :: Text -> Text
823toTitle :: Text -> Text
865toTitle t = unstream (S.toTitle (stream t))
824toTitle t = unstream (S.toTitle (stream t))
866{-# INLINE toTitle #-}
825{-# INLINE toTitle #-}
@@ -1013,8 +972,6 @@ mapAccumR f = go
1013
972
1014-- | @'repeat' x@ is an infinite 'Text', with @x@ the value of every
973-- | @'repeat' x@ is an infinite 'Text', with @x@ the value of every
1015-- element.
974-- element.
1016−--
1017−-- @since 1.2.0.5
1018repeat :: Char -> Text
975repeat :: Char -> Text
1019repeat c = let t = Chunk (T.replicate smallChunkSize (T.singleton c)) t
976repeat c = let t = Chunk (T.replicate smallChunkSize (T.singleton c)) t
1020 in t
977 in t
@@ -1032,8 +989,6 @@ replicate n t
1032
989
1033-- | 'cycle' ties a finite, non-empty 'Text' into a circular one, or
990-- | 'cycle' ties a finite, non-empty 'Text' into a circular one, or
1034-- equivalently, the infinite repetition of the original 'Text'.
991-- equivalently, the infinite repetition of the original 'Text'.
1035−--
1036−-- @since 1.2.0.5
1037cycle :: Text -> Text
992cycle :: Text -> Text
1038cycle Empty = emptyError "cycle"
993cycle Empty = emptyError "cycle"
1039cycle t = let t' = foldrChunks Chunk t' t
994cycle t = let t' = foldrChunks Chunk t' t
@@ -1043,8 +998,6 @@ cycle t = let t' = foldrChunks Chunk t' t
1043-- of @f@ to @x@:
998-- of @f@ to @x@:
1044--
999--
1045-- > iterate f x == [x, f x, f (f x), ...]
1000-- > iterate f x == [x, f x, f (f x), ...]
1046−--
1047−-- @since 1.2.0.5
1048iterate :: (Char -> Char) -> Char -> Text
1001iterate :: (Char -> Char) -> Char -> Text
1049iterate f c = let t c' = Chunk (T.singleton c') (t (f c'))
1002iterate f c = let t c' = Chunk (T.singleton c') (t (f c'))
1050 in t c
1003 in t c
@@ -1108,8 +1061,6 @@ take i t0 = take' i t0
1108-- Examples:
1061-- Examples:
1109--
1062--
1110-- > takeEnd 3 "foobar" == "bar"
1063-- > takeEnd 3 "foobar" == "bar"
1111−--
1112−-- @since 1.1.1.0
1113takeEnd :: Int64 -> Text -> Text
1064takeEnd :: Int64 -> Text -> Text
1114takeEnd n t0
1065takeEnd n t0
1115 | n <= 0 = empty
1066 | n <= 0 = empty
@@ -1148,8 +1099,6 @@ drop i t0
1148-- Examples:
1099-- Examples:
1149--
1100--
1150-- > dropEnd 3 "foobar" == "foo"
1101-- > dropEnd 3 "foobar" == "foo"
1151−--
1152−-- @since 1.1.1.0
1153dropEnd :: Int64 -> Text -> Text
1102dropEnd :: Int64 -> Text -> Text
1154dropEnd n t0
1103dropEnd n t0
1155 | n <= 0 = t0
1104 | n <= 0 = t0
@@ -1170,20 +1119,11 @@ dropWords i t0
1170 | otherwise = drop' i t0
1119 | otherwise = drop' i t0
1171 where drop' 0 ts = ts
1120 where drop' 0 ts = ts
1172 drop' _ Empty = Empty
1121 drop' _ Empty = Empty
1173−#ifndef __GHCJS__
1174 drop' n (Chunk (T.Text arr off len) ts)
1122 drop' n (Chunk (T.Text arr off len) ts)
1175 | n < len' = chunk (text arr (off+n') (len-n')) ts
1123 | n < len' = chunk (text arr (off+n') (len-n')) ts
1176 | otherwise = drop' (n - len') ts
1124 | otherwise = drop' (n - len') ts
1177 where len' = fromIntegral len
1125 where len' = fromIntegral len
1178 n' = fromIntegral n
1126 n' = fromIntegral n
1179−#else
1180− drop' n (Chunk t@(T.Text jst) ts)
1181− | n < len' = chunk (T.Text $ js_substr1 n' jst) ts
1182− | otherwise = drop' (n - len') ts
1183− where len' = fromIntegral len
1184− len = T.length t
1185− n' = fromIntegral n
1186−#endif
1187
1127
1188-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1128-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1189-- returns the longest prefix (possibly empty) of elements that
1129-- returns the longest prefix (possibly empty) of elements that
@@ -1210,15 +1150,12 @@ takeWhile p t0 = takeWhile' t0
1210-- Examples:
1150-- Examples:
1211--
1151--
1212-- > takeWhileEnd (=='o') "foo" == "oo"
1152-- > takeWhileEnd (=='o') "foo" == "oo"
1213−--
1214−-- @since 1.2.2.0
1215takeWhileEnd :: (Char -> Bool) -> Text -> Text
1153takeWhileEnd :: (Char -> Bool) -> Text -> Text
1216takeWhileEnd p = takeChunk empty . L.reverse . toChunks
1154takeWhileEnd p = takeChunk empty . L.reverse . toChunks
1217 where takeChunk acc [] = acc
1155 where takeChunk acc [] = acc
1218− takeChunk acc (t:ts)
1156+ takeChunk acc (t:ts) = if T.length t' < T.length t
1219− | T.lengthWord16 t' < T.lengthWord16 t
1157+ then (Chunk t' acc)
1220− = chunk t' acc
1221− | otherwise = takeChunk (Chunk t' acc) ts
1158+ else takeChunk (Chunk t' acc) ts
1222 where t' = T.takeWhileEnd p t
1159 where t' = T.takeWhileEnd p t
1223{-# INLINE takeWhileEnd #-}
1160{-# INLINE takeWhileEnd #-}
1224
1161
@@ -1307,22 +1244,12 @@ splitAt = loop
1307-- values, and whose second is the remainder of the string.
1244-- values, and whose second is the remainder of the string.
1308splitAtWord :: Int64 -> Text -> PairS Text Text
1245splitAtWord :: Int64 -> Text -> PairS Text Text
1309splitAtWord _ Empty = empty :*: empty
1246splitAtWord _ Empty = empty :*: empty
1310−#ifndef __GHCJS__
1311splitAtWord x (Chunk c@(T.Text arr off len) cs)
1247splitAtWord x (Chunk c@(T.Text arr off len) cs)
1312 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1248 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1313 in Chunk c h :*: t
1249 in Chunk c h :*: t
1314 | otherwise = chunk (text arr off y) empty :*:
1250 | otherwise = chunk (text arr off y) empty :*:
1315 chunk (text arr (off+y) (len-y)) cs
1251 chunk (text arr (off+y) (len-y)) cs
1316 where y = fromIntegral x
1252 where y = fromIntegral x
1317−#else
1318−splitAtWord x (Chunk c@(T.Text jst) cs)
1319− | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1320− in Chunk c h :*: t
1321− | otherwise = chunk (T.Text (js_substr 0 (y-1) jst)) empty :*:
1322− chunk (T.Text (js_substr1 y jst)) cs
1323− where y = fromIntegral x
1324− len = T.length c
1325−#endif
1326
1253
1327-- | /O(n+m)/ Find the first instance of @needle@ (which must be
1254-- | /O(n+m)/ Find the first instance of @needle@ (which must be
1328-- non-'null') in @haystack@. The first element of the returned tuple
1255-- non-'null') in @haystack@. The first element of the returned tuple
@@ -1502,11 +1429,7 @@ splitOn pat src
1502 go _ [] cs = [cs]
1429 go _ [] cs = [cs]
1503 go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs
1430 go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs
1504 in h : go (x+l) xs (dropWords l t)
1431 in h : go (x+l) xs (dropWords l t)
1505−#ifndef __GHCJS__
1506 l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat
1432 l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat
1507−#else
1508− l = foldlChunks (\a t -> a + fromIntegral (T.length t)) 0 pat
1509−#endif
1510{-# INLINE [1] splitOn #-}
1433{-# INLINE [1] splitOn #-}
1511
1434
1512{-# RULES
1435{-# RULES
@@ -1770,8 +1693,3 @@ emptyError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": empty input")
1770
1693
1771impossibleError :: String -> a
1694impossibleError :: String -> a
1772impossibleError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": impossible case")
1695impossibleError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": impossible case")
1773−
1774−#ifdef __GHCJS__
1775−foreign import javascript unsafe "$2.substr($1)" js_substr1 :: Exts.Int -> JSString -> JSString
1776−foreign import javascript unsafe "$3.substr($1,$2)" js_substr :: Exts.Int -> Exts.Int -> JSString -> JSString
1777−#endif
Data/Text/Lazy/Builder.hs+1
@@ -11,6 +11,7 @@
11-- License : BSD-style (see LICENSE)
11-- License : BSD-style (see LICENSE)
12--
12--
13-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
13-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
14+-- Stability : experimental
14-- Portability : portable to Hugs and GHC
15-- Portability : portable to Hugs and GHC
15--
16--
16-- Efficient construction of lazy @Text@ values. The principal
17-- Efficient construction of lazy @Text@ values. The principal
Data/Text/Lazy/Builder/Int.hs+217−11
@@ -1,8 +1,15 @@
1+{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,
2+ UnboxedTuples #-}
3+#if __GLASGOW_HASKELL__ >= 702
4+{-# LANGUAGE Trustworthy #-}
5+#endif
6+
1-- Module: Data.Text.Lazy.Builder.Int
7-- Module: Data.Text.Lazy.Builder.Int
2-- Copyright: (c) 2013 Bryan O'Sullivan
8-- Copyright: (c) 2013 Bryan O'Sullivan
3-- (c) 2011 MailRank, Inc.
9-- (c) 2011 MailRank, Inc.
4-- License: BSD-style
10-- License: BSD-style
5-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
11-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
12+-- Stability: experimental
6-- Portability: portable
13-- Portability: portable
7--
14--
8-- Efficiently write an integral value to a 'Builder'.
15-- Efficiently write an integral value to a 'Builder'.
@@ -13,13 +20,6 @@ module Data.Text.Lazy.Builder.Int
13 , hexadecimal
20 , hexadecimal
14 ) where
21 ) where
15
22
16−-- import Data.Text.Lazy (Text)
17−import qualified Data.Text.Lazy as L
18−import qualified Data.Text as T
19−import qualified Data.JSString.Int as JSS
20−import Data.Text.Internal (Text (..))
21−import Data.Text.Lazy.Builder
22−
23import Data.Int (Int8, Int16, Int32, Int64)
23import Data.Int (Int8, Int16, Int32, Int64)
24import Data.Monoid (mempty)
24import Data.Monoid (mempty)
25import qualified Data.ByteString.Unsafe as B
25import qualified Data.ByteString.Unsafe as B
@@ -32,9 +32,6 @@ import GHC.Base (quotInt, remInt)
32import GHC.Num (quotRemInteger)
32import GHC.Num (quotRemInteger)
33import GHC.Types (Int(..))
33import GHC.Types (Int(..))
34import Control.Monad.ST
34import Control.Monad.ST
35−#if MIN_VERSION_base(4,11,0)
36−import Prelude hiding ((<>))
37−#endif
38
35
39#ifdef __GLASGOW_HASKELL__
36#ifdef __GLASGOW_HASKELL__
40# if defined(INTEGER_GMP)
37# if defined(INTEGER_GMP)
@@ -53,4 +50,213 @@ import GHC.Integer
53#endif
50#endif
54
51
55decimal :: Integral a => a -> Builder
52decimal :: Integral a => a -> Builder
56−decimal n = fromText $ Text $ JSS.decimal n
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.hs+15−20
@@ -11,23 +11,19 @@
11-- Write a floating point value to a 'Builder'.
11-- Write a floating point value to a 'Builder'.
12
12
13module Data.Text.Lazy.Builder.RealFloat
13module Data.Text.Lazy.Builder.RealFloat
14− (
14+ (
15− FPFormat(..)
15+ FPFormat(..)
16− , realFloat
16+ , realFloat
17− , formatRealFloat
17+ , formatRealFloat
18− ) where
18+ ) where
19−
19+
20−-- import Data.Array.Base (unsafeAt)
20+import Data.Array.Base (unsafeAt)
21−-- import Data.Array.IArray
21+import Data.Array.IArray
22import Data.Text.Internal.Builder.Functions ((<>), i2d)
22import Data.Text.Internal.Builder.Functions ((<>), i2d)
23import Data.Text.Lazy.Builder.Int (decimal)
23import Data.Text.Lazy.Builder.Int (decimal)
24import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)
24import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)
25import Data.Text.Lazy.Builder
25import Data.Text.Lazy.Builder
26import qualified Data.Text as T
26import qualified Data.Text as T
27−#if MIN_VERSION_base(4,11,0)
28−import Prelude hiding ((<>))
29−#endif
30−
31
27
32-- | Control the rendering of floating point numbers.
28-- | Control the rendering of floating point numbers.
33data FPFormat = Exponent
29data FPFormat = Exponent
@@ -37,7 +33,7 @@ data FPFormat = Exponent
37 | Generic
33 | Generic
38 -- ^ Use decimal notation for values between @0.1@ and
34 -- ^ Use decimal notation for values between @0.1@ and
39 -- @9,999,999@, and scientific notation otherwise.
35 -- @9,999,999@, and scientific notation otherwise.
40− deriving (Enum, Read, Show)
36+ deriving (Enum, Read, Show)
41
37
42-- | Show a signed 'RealFloat' value to full precision,
38-- | Show a signed 'RealFloat' value to full precision,
43-- using standard decimal notation for arguments whose absolute value lies
39-- using standard decimal notation for arguments whose absolute value lies
@@ -232,16 +228,15 @@ maxExpt = 1100
232
228
233expt :: Integer -> Int -> Integer
229expt :: Integer -> Int -> Integer
234expt base n
230expt base n
235− | base == 2 && n >= minExpt && n <= maxExpt = expts !! n
231+ | base == 2 && n >= minExpt && n <= maxExpt = expts `unsafeAt` n
236− | base == 10 && n <= maxExpt10 = expts10 !! n
232+ | base == 10 && n <= maxExpt10 = expts10 `unsafeAt` n
237 | otherwise = base^n
233 | otherwise = base^n
238
234
239−expts :: [Integer]
235+expts :: Array Int Integer
240−expts = [2^n | n <- [minExpt .. maxExpt]]
236+expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]
241
237
242maxExpt10 :: Int
238maxExpt10 :: Int
243maxExpt10 = 324
239maxExpt10 = 324
244
240
245−expts10 :: [Integer]
241+expts10 :: Array Int Integer
246−expts10 = [10^n | n <- [minExpt .. maxExpt10]]
242+expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]
247−
Data/Text/Lazy/Encoding.hs+3−13
@@ -8,13 +8,14 @@
8--
8--
9-- License : BSD-style
9-- License : BSD-style
10-- Maintainer : bos@serpentine.com
10-- Maintainer : bos@serpentine.com
11+-- Stability : experimental
11-- Portability : portable
12-- Portability : portable
12--
13--
13-- Functions for converting lazy 'Text' values to and from lazy
14-- Functions for converting lazy 'Text' values to and from lazy
14-- 'ByteString', using several standard encodings.
15-- 'ByteString', using several standard encodings.
15--
16--
16−-- To gain access to a much larger family of encodings, use the
17+-- To gain access to a much larger variety of encodings, use the
17−-- <http://hackage.haskell.org/package/text-icu text-icu package>.
18+-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>
18
19
19module Data.Text.Lazy.Encoding
20module Data.Text.Lazy.Encoding
20 (
21 (
@@ -140,7 +141,6 @@ decodeUtf8' bs = unsafeDupablePerformIO $ do
140 rnf (Chunk _ ts) = rnf ts
141 rnf (Chunk _ ts) = rnf ts
141{-# INLINE decodeUtf8' #-}
142{-# INLINE decodeUtf8' #-}
142
143
143−-- | Encode text using UTF-8 encoding.
144encodeUtf8 :: Text -> B.ByteString
144encodeUtf8 :: Text -> B.ByteString
145encodeUtf8 Empty = B.empty
145encodeUtf8 Empty = B.empty
146encodeUtf8 lt@(Chunk t _) =
146encodeUtf8 lt@(Chunk t _) =
@@ -154,20 +154,10 @@ encodeUtf8 lt@(Chunk t _) =
154 firstChunkSize = min B.smallChunkSize (4 * (T.length t + 1))
154 firstChunkSize = min B.smallChunkSize (4 * (T.length t + 1))
155 strategy = B.safeStrategy firstChunkSize B.defaultChunkSize
155 strategy = B.safeStrategy firstChunkSize B.defaultChunkSize
156
156
157−-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
158−--
159−-- @since 1.1.0.0
160encodeUtf8Builder :: Text -> B.Builder
157encodeUtf8Builder :: Text -> B.Builder
161encodeUtf8Builder =
158encodeUtf8Builder =
162 foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) Data.Monoid.mempty
159 foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) Data.Monoid.mempty
163
160
164−-- | Encode text using UTF-8 encoding and escape the ASCII characters using
165−-- a 'BP.BoundedPrim'.
166−--
167−-- Use this function is to implement efficient encoders for text-based formats
168−-- like JSON or HTML.
169−--
170−-- @since 1.1.0.0
171{-# INLINE encodeUtf8BuilderEscaped #-}
161{-# INLINE encodeUtf8BuilderEscaped #-}
172encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
162encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
173encodeUtf8BuilderEscaped prim =
163encodeUtf8BuilderEscaped prim =
Data/Text/Lazy/IO.hs+1
@@ -8,6 +8,7 @@
8-- (c) 2009 Simon Marlow
8-- (c) 2009 Simon Marlow
9-- License : BSD-style
9-- License : BSD-style
10-- Maintainer : bos@serpentine.com
10-- Maintainer : bos@serpentine.com
11+-- Stability : experimental
11-- Portability : GHC
12-- Portability : GHC
12--
13--
13-- Efficient locale-sensitive support for lazy text I\/O.
14-- Efficient locale-sensitive support for lazy text I\/O.
Data/Text/Lazy/Read.hs+4−3
@@ -11,6 +11,7 @@
11--
11--
12-- License : BSD-style
12-- License : BSD-style
13-- Maintainer : bos@serpentine.com
13-- Maintainer : bos@serpentine.com
14+-- Stability : experimental
14-- Portability : GHC
15-- Portability : GHC
15--
16--
16-- Functions used frequently when reading textual data.
17-- Functions used frequently when reading textual data.
@@ -67,9 +68,9 @@ decimal txt
67 go n d = (n * 10 + fromIntegral (digitToInt d))
68 go n d = (n * 10 + fromIntegral (digitToInt d))
68
69
69-- | Read a hexadecimal integer, consisting of an optional leading
70-- | Read a hexadecimal integer, consisting of an optional leading
70−-- @\"0x\"@ followed by at least one hexadecimal digit. Input is
71+-- @\"0x\"@ followed by at least one decimal digit. Input is consumed
71−-- consumed until a non-hex-digit or end of string is reached.
72+-- until a non-hex-digit or end of string is reached. This function
72−-- This function is case insensitive.
73+-- is case insensitive.
73--
74--
74-- This function does not handle leading sign characters. If you need
75-- This function does not handle leading sign characters. If you need
75-- to handle signed input, use @'signed' 'hexadecimal'@.
76-- to handle signed input, use @'signed' 'hexadecimal'@.
Data/Text/Read.hs+4−3
@@ -9,6 +9,7 @@
9--
9--
10-- License : BSD-style
10-- License : BSD-style
11-- Maintainer : bos@serpentine.com
11-- Maintainer : bos@serpentine.com
12+-- Stability : experimental
12-- Portability : GHC
13-- Portability : GHC
13--
14--
14-- Functions used frequently when reading textual data.
15-- Functions used frequently when reading textual data.
@@ -66,9 +67,9 @@ decimal txt
66 go n d = (n * 10 + fromIntegral (digitToInt d))
67 go n d = (n * 10 + fromIntegral (digitToInt d))
67
68
68-- | Read a hexadecimal integer, consisting of an optional leading
69-- | Read a hexadecimal integer, consisting of an optional leading
69−-- @\"0x\"@ followed by at least one hexadecimal digit. Input is
70+-- @\"0x\"@ followed by at least one decimal digit. Input is consumed
70−-- consumed until a non-hex-digit or end of string is reached.
71+-- until a non-hex-digit or end of string is reached. This function
71−-- This function is case insensitive.
72+-- is case insensitive.
72--
73--
73-- This function does not handle leading sign characters. If you need
74-- This function does not handle leading sign characters. If you need
74-- to handle signed input, use @'signed' 'hexadecimal'@.
75-- to handle signed input, use @'signed' 'hexadecimal'@.
Data/Text/Show.hs−2
@@ -46,8 +46,6 @@ unpack = S.unstreamList . stream
46-- fusion.
46-- fusion.
47--
47--
48-- This is exposed solely for people writing GHC rewrite rules.
48-- This is exposed solely for people writing GHC rewrite rules.
49−--
50−-- @since 1.2.1.1
51unpackCString# :: Addr# -> Text
49unpackCString# :: Addr# -> Text
52unpackCString# addr# = unstream (S.streamCString# addr#)
50unpackCString# addr# = unstream (S.streamCString# addr#)
53{-# NOINLINE unpackCString# #-}
51{-# NOINLINE unpackCString# #-}
Data/Text/Unsafe.hs+1−89
@@ -1,12 +1,10 @@
1{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
1{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
2−#ifdef __GHCJS__
3−{-# LANGUAGE JavaScriptFFI, ForeignFunctionInterface, UnliftedFFITypes #-}
4−#endif
5-- |
2-- |
6-- Module : Data.Text.Unsafe
3-- Module : Data.Text.Unsafe
7-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
4-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
8-- License : BSD-style
5-- License : BSD-style
9-- Maintainer : bos@serpentine.com
6-- Maintainer : bos@serpentine.com
7+-- Stability : experimental
10-- Portability : portable
8-- Portability : portable
11--
9--
12-- A module containing unsafe 'Text' operations, for very very careful
10-- A module containing unsafe 'Text' operations, for very very careful
@@ -34,47 +32,31 @@ import Control.Exception (assert)
34import Data.Text.Internal.Encoding.Utf16 (chr2)
32import Data.Text.Internal.Encoding.Utf16 (chr2)
35import Data.Text.Internal (Text(..))
33import Data.Text.Internal (Text(..))
36import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)
34import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)
37−#ifdef __GHCJS__
38−import Data.Coerce
39−import qualified Data.JSString.Raw as JSS
40−import GHC.Exts (Int(..), Int#, chr#, int2Word#, Char(..))
41−import GHC.Word (Word16(..))
42−import Data.JSString (JSString)
43−#else
44import Data.Text.Internal.Unsafe.Char (unsafeChr)
35import Data.Text.Internal.Unsafe.Char (unsafeChr)
45import qualified Data.Text.Array as A
36import qualified Data.Text.Array as A
46−#endif
47import GHC.IO (unsafeDupablePerformIO)
37import GHC.IO (unsafeDupablePerformIO)
48
38
49-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'
39-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'
50-- omits the check for the empty case, so there is an obligation on
40-- omits the check for the empty case, so there is an obligation on
51-- the programmer to provide a proof that the 'Text' is non-empty.
41-- the programmer to provide a proof that the 'Text' is non-empty.
52unsafeHead :: Text -> Char
42unsafeHead :: Text -> Char
53−#ifndef __GHCJS__
54unsafeHead (Text arr off _len)
43unsafeHead (Text arr off _len)
55 | m < 0xD800 || m > 0xDBFF = unsafeChr m
44 | m < 0xD800 || m > 0xDBFF = unsafeChr m
56 | otherwise = chr2 m n
45 | otherwise = chr2 m n
57 where m = A.unsafeIndex arr off
46 where m = A.unsafeIndex arr off
58 n = A.unsafeIndex arr (off+1)
47 n = A.unsafeIndex arr (off+1)
59−#else
60−unsafeHead = coerce JSS.rawHead
61−#endif
62{-# INLINE unsafeHead #-}
48{-# INLINE unsafeHead #-}
63
49
64-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'
50-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'
65-- omits the check for the empty case, so there is an obligation on
51-- omits the check for the empty case, so there is an obligation on
66-- the programmer to provide a proof that the 'Text' is non-empty.
52-- the programmer to provide a proof that the 'Text' is non-empty.
67unsafeTail :: Text -> Text
53unsafeTail :: Text -> Text
68−#ifndef __GHCJS__
69unsafeTail t@(Text arr off len) =
54unsafeTail t@(Text arr off len) =
70#if defined(ASSERTS)
55#if defined(ASSERTS)
71 assert (d <= len) $
56 assert (d <= len) $
72#endif
57#endif
73 Text arr (off+d) (len-d)
58 Text arr (off+d) (len-d)
74 where d = iter_ t 0
59 where d = iter_ t 0
75−#else
76−unsafeTail = coerce JSS.rawTail
77−#endif
78{-# INLINE unsafeTail #-}
60{-# INLINE unsafeTail #-}
79
61
80data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int
62data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int
@@ -83,7 +65,6 @@ data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int
83-- array, returning the current character and the delta to add to give
65-- array, returning the current character and the delta to add to give
84-- the next offset to iterate at.
66-- the next offset to iterate at.
85iter :: Text -> Int -> Iter
67iter :: Text -> Int -> Iter
86−#ifndef __GHCJS__
87iter (Text arr off _len) i
68iter (Text arr off _len) i
88 | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1
69 | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1
89 | otherwise = Iter (chr2 m n) 2
70 | otherwise = Iter (chr2 m n) 2
@@ -91,40 +72,20 @@ iter (Text arr off _len) i
91 n = A.unsafeIndex arr k
72 n = A.unsafeIndex arr k
92 j = off + i
73 j = off + i
93 k = j + 1
74 k = j + 1
94−#else
95−iter (Text txt) i
96− | m < 0xD800 || m > 0xDBFF = Iter (C# (chr# m#)) 1
97− | otherwise = Iter (chr2 m n) 2
98− where m# = js_charCodeAt j txt
99− n# = js_charCodeAt k txt
100− m = W16# (int2Word# m#)
101− n = W16# (int2Word# n#)
102− j = off + i
103− k = j + 1
104− off = 0
105−#endif
106{-# INLINE iter #-}
75{-# INLINE iter #-}
107
76
108-- | /O(1)/ Iterate one step through a UTF-16 array, returning the
77-- | /O(1)/ Iterate one step through a UTF-16 array, returning the
109-- delta to add to give the next offset to iterate at.
78-- delta to add to give the next offset to iterate at.
110iter_ :: Text -> Int -> Int
79iter_ :: Text -> Int -> Int
111−#ifndef __GHCJS__
112iter_ (Text arr off _len) i | m < 0xD800 || m > 0xDBFF = 1
80iter_ (Text arr off _len) i | m < 0xD800 || m > 0xDBFF = 1
113 | otherwise = 2
81 | otherwise = 2
114 where m = A.unsafeIndex arr (off+i)
82 where m = A.unsafeIndex arr (off+i)
115−#else
116−iter_ (Text txt) i | m < 0xD800 || m > 0xDBFF = 1
117− | otherwise = 2
118− where m# = js_charCodeAt i txt
119− m = W16# (int2Word# m#)
120−#endif
121{-# INLINE iter_ #-}
83{-# INLINE iter_ #-}
122
84
123-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
85-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
124-- returning the current character and the delta to add (i.e. a
86-- returning the current character and the delta to add (i.e. a
125-- negative number) to give the next offset to iterate at.
87-- negative number) to give the next offset to iterate at.
126reverseIter :: Text -> Int -> (Char,Int)
88reverseIter :: Text -> Int -> (Char,Int)
127−#ifndef __GHCJS__
128reverseIter (Text arr off _len) i
89reverseIter (Text arr off _len) i
129 | m < 0xDC00 || m > 0xDFFF = (unsafeChr m, -1)
90 | m < 0xDC00 || m > 0xDFFF = (unsafeChr m, -1)
130 | otherwise = (chr2 n m, -2)
91 | otherwise = (chr2 n m, -2)
@@ -132,80 +93,31 @@ reverseIter (Text arr off _len) i
132 n = A.unsafeIndex arr k
93 n = A.unsafeIndex arr k
133 j = off + i
94 j = off + i
134 k = j - 1
95 k = j - 1
135−#else
136−reverseIter (Text txt) i
137− | m < 0xDC00 || m > 0xDFFF = (C# (chr# m#), -1)
138− | otherwise = (chr2 n m, -2)
139− where m# = js_charCodeAt j txt
140− n# = js_charCodeAt k txt
141− m = W16# (int2Word# m#)
142− n = W16# (int2Word# n#)
143− j = off + i
144− k = j - 1
145− off = 0
146−#endif
147{-# INLINE reverseIter #-}
96{-# INLINE reverseIter #-}
148
97
149-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
98-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
150-- returning the delta to add (i.e. a negative number) to give the
99-- returning the delta to add (i.e. a negative number) to give the
151-- next offset to iterate at.
100-- next offset to iterate at.
152−--
153−-- @since 1.1.1.0
154reverseIter_ :: Text -> Int -> Int
101reverseIter_ :: Text -> Int -> Int
155−#ifndef __GHCJS__
156reverseIter_ (Text arr off _len) i
102reverseIter_ (Text arr off _len) i
157 | m < 0xDC00 || m > 0xDFFF = -1
103 | m < 0xDC00 || m > 0xDFFF = -1
158 | otherwise = -2
104 | otherwise = -2
159 where m = A.unsafeIndex arr (off+i)
105 where m = A.unsafeIndex arr (off+i)
160−#else
161−reverseIter_ (Text txt) i
162− | m < 0xDC00 || m > 0xDFFF = -1
163− | otherwise = -2
164− where m# = js_charCodeAt (off + i) txt
165− m = W16# (int2Word# m#)
166− off = 0
167−#endif
168{-# INLINE reverseIter_ #-}
106{-# INLINE reverseIter_ #-}
169
107
170-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
108-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
171-- is useful for sizing a target array appropriately before using
109-- is useful for sizing a target array appropriately before using
172-- 'unsafeCopyToPtr'.
110-- 'unsafeCopyToPtr'.
173lengthWord16 :: Text -> Int
111lengthWord16 :: Text -> Int
174−#ifndef __GHCJS__
175lengthWord16 (Text _arr _off len) = len
112lengthWord16 (Text _arr _off len) = len
176−#else
177−lengthWord16 (Text t) = js_length t
178−#endif
179{-# INLINE lengthWord16 #-}
113{-# INLINE lengthWord16 #-}
180
114
181-- | /O(1)/ Unchecked take of 'k' 'Word16's from the front of a 'Text'.
115-- | /O(1)/ Unchecked take of 'k' 'Word16's from the front of a 'Text'.
182takeWord16 :: Int -> Text -> Text
116takeWord16 :: Int -> Text -> Text
183−#ifndef __GHCJS__
184takeWord16 k (Text arr off _len) = Text arr off k
117takeWord16 k (Text arr off _len) = Text arr off k
185−#else
186−takeWord16 k (Text txt) = Text $ js_take k txt
187−#endif
188{-# INLINE takeWord16 #-}
118{-# INLINE takeWord16 #-}
189
119
190-- | /O(1)/ Unchecked drop of 'k' 'Word16's from the front of a 'Text'.
120-- | /O(1)/ Unchecked drop of 'k' 'Word16's from the front of a 'Text'.
191dropWord16 :: Int -> Text -> Text
121dropWord16 :: Int -> Text -> Text
192−#ifndef __GHCJS__
193dropWord16 k (Text arr off len) = Text arr (off+k) (len-k)
122dropWord16 k (Text arr off len) = Text arr (off+k) (len-k)
194−#else
195−dropWord16 k (Text txt) = Text $ js_drop k txt
196−#endif
197{-# INLINE dropWord16 #-}
123{-# INLINE dropWord16 #-}
198−
199−#ifdef __GHCJS__
200−foreign import javascript unsafe
201− "$2.charCodeAt($1)" js_charCodeAt :: Int -> JSString -> Int#
202−
203−foreign import javascript unsafe
204− "h$jsstringTake" js_take :: Int -> JSString -> JSString
205−
206−foreign import javascript unsafe
207− "h$jsstringDrop" js_drop :: Int -> JSString -> JSString
208−
209−foreign import javascript unsafe
210− "$1.length" js_length :: JSString -> Int
211−#endif
README.markdown+16−5
@@ -1,18 +1,29 @@
1−# `text`: Fast, packed Unicode strings, using stream fusion
1+# Text: Fast, packed Unicode strings, using stream fusion
2
2
3This package provides the Data.Text library, a library for the space-
3This package provides the Data.Text library, a library for the space-
4and time-efficient manipulation of Unicode text in Haskell.
4and time-efficient manipulation of Unicode text in Haskell.
5
5
6−**Please refer to the [package description on Hackage](https://hackage.haskell.org/package/text#description) for more information.**
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+
7
18
8# Get involved!
19# Get involved!
9
20
10Please report bugs via the
21Please report bugs via the
11−[github issue tracker](https://github.com/haskell/text/issues).
22+[github issue tracker](https://github.com/bos/text/issues).
12
23
13−Master [git repository](https://github.com/haskell/text):
24+Master [git repository](https://github.com/bos/text):
14
25
15−* `git clone git://github.com/haskell/text.git`
26+* `git clone git://github.com/bos/text.git`
16
27
17There's also a [Mercurial mirror](https://bitbucket.org/bos/text):
28There's also a [Mercurial mirror](https://bitbucket.org/bos/text):
18
29
benchmarks/.gitignore+1−4
@@ -1,4 +1 @@
1−/dist/
2−/dist-newstyle/
1+dist
3−/.ghc.environment.*
4−/cabal.project.local
benchmarks/cabal.projectdeleted−2
@@ -1,2 +0,0 @@
1−-- NB: we use a separate project
2−packages: .
benchmarks/haskell/Benchmarks.hs−2
@@ -10,7 +10,6 @@ import System.FilePath ((</>))
10import System.IO (IOMode (WriteMode), openFile, hSetEncoding, utf8)
10import System.IO (IOMode (WriteMode), openFile, hSetEncoding, utf8)
11
11
12import qualified Benchmarks.Builder as Builder
12import qualified Benchmarks.Builder as Builder
13−import qualified Benchmarks.Concat as Concat
14import qualified Benchmarks.DecodeUtf8 as DecodeUtf8
13import qualified Benchmarks.DecodeUtf8 as DecodeUtf8
15import qualified Benchmarks.EncodeUtf8 as EncodeUtf8
14import qualified Benchmarks.EncodeUtf8 as EncodeUtf8
16import qualified Benchmarks.Equality as Equality
15import qualified Benchmarks.Equality as Equality
@@ -42,7 +41,6 @@ benchmarks = do
42 -- Traditional benchmarks
41 -- Traditional benchmarks
43 bs <- sequence
42 bs <- sequence
44 [ Builder.benchmark
43 [ Builder.benchmark
45− , Concat.benchmark
46 , DecodeUtf8.benchmark "html" (tf "libya-chinese.html")
44 , DecodeUtf8.benchmark "html" (tf "libya-chinese.html")
47 , DecodeUtf8.benchmark "xml" (tf "yiwiki.xml")
45 , DecodeUtf8.benchmark "xml" (tf "yiwiki.xml")
48 , DecodeUtf8.benchmark "ascii" (tf "ascii.txt")
46 , DecodeUtf8.benchmark "ascii" (tf "ascii.txt")
benchmarks/haskell/Benchmarks/Concat.hsdeleted−25
@@ -1,25 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−
3−module Benchmarks.Concat (benchmark) where
4−
5−import Control.Monad.Trans.Writer
6−import Criterion (Benchmark, bgroup, bench, whnf)
7−import Data.Text as T
8−
9−benchmark :: IO Benchmark
10−benchmark = return $ bgroup "Concat"
11− [ bench "append" $ whnf (append4 "Text 1" "Text 2" "Text 3") "Text 4"
12− , bench "concat" $ whnf (concat4 "Text 1" "Text 2" "Text 3") "Text 4"
13− , bench "write" $ whnf (write4 "Text 1" "Text 2" "Text 3") "Text 4"
14− ]
15−
16−append4, concat4, write4 :: Text -> Text -> Text -> Text -> Text
17−
18−{-# NOINLINE append4 #-}
19−append4 x1 x2 x3 x4 = x1 `append` x2 `append` x3 `append` x4
20−
21−{-# NOINLINE concat4 #-}
22−concat4 x1 x2 x3 x4 = T.concat [x1, x2, x3, x4]
23−
24−{-# NOINLINE write4 #-}
25−write4 x1 x2 x3 x4 = execWriter $ tell x1 >> tell x2 >> tell x3 >> tell x4
benchmarks/text-benchmarks.cabal+8−82
@@ -12,7 +12,8 @@ author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
12maintainer: jaspervdj@gmail.com
12maintainer: jaspervdj@gmail.com
13category: Text
13category: Text
14build-type: Simple
14build-type: Simple
15+
15−cabal-version: >=1.8
16+cabal-version: >=1.2
16
17
17flag bytestring-builder
18flag bytestring-builder
18 description: Depend on the bytestring-builder package for backwards compatibility.
19 description: Depend on the bytestring-builder package for backwards compatibility.
@@ -25,12 +26,16 @@ flag llvm
25 manual: True
26 manual: True
26
27
27executable text-benchmarks
28executable 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
28 ghc-options: -Wall -O2 -rtsopts
34 ghc-options: -Wall -O2 -rtsopts
29 if flag(llvm)
35 if flag(llvm)
30 ghc-options: -fllvm
36 ghc-options: -fllvm
31 cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP
37 cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP
32− build-depends: array,
38+ build-depends: base == 4.*,
33− base == 4.*,
34 binary,
39 binary,
35 blaze-builder,
40 blaze-builder,
36 bytestring-lexing >= 0.5.0,
41 bytestring-lexing >= 0.5.0,
@@ -42,7 +47,6 @@ executable text-benchmarks
42 ghc-prim,
47 ghc-prim,
43 integer-gmp,
48 integer-gmp,
44 stringsearch,
49 stringsearch,
45− transformers,
46 utf8-string,
50 utf8-string,
47 vector
51 vector
48
52
@@ -52,87 +56,9 @@ executable text-benchmarks
52 else
56 else
53 build-depends: bytestring >= 0.10.4
57 build-depends: bytestring >= 0.10.4
54
58
55− -- modules for benchmark proper
56− c-sources: cbits/time_iconv.c
57− hs-source-dirs: haskell
58− main-is: Benchmarks.hs
59− other-modules:
60− Benchmarks.Builder
61− Benchmarks.Concat
62− Benchmarks.DecodeUtf8
63− Benchmarks.EncodeUtf8
64− Benchmarks.Equality
65− Benchmarks.FileRead
66− Benchmarks.FoldLines
67− Benchmarks.Mul
68− Benchmarks.Programs.BigTable
69− Benchmarks.Programs.Cut
70− Benchmarks.Programs.Fold
71− Benchmarks.Programs.Sort
72− Benchmarks.Programs.StripTags
73− Benchmarks.Programs.Throughput
74− Benchmarks.Pure
75− Benchmarks.ReadNumbers
76− Benchmarks.Replace
77− Benchmarks.Search
78− Benchmarks.Stream
79− Benchmarks.WordFrequencies
80−
81− -- Source code for IUT (implementation under test)
82− -- "borrowed" from parent folder
83− include-dirs: ../include
84− c-sources: ../cbits/cbits.c
85− hs-source-dirs: ..
86− other-modules:
87− Data.Text
88− Data.Text.Array
89− Data.Text.Encoding
90− Data.Text.Encoding.Error
91− Data.Text.Foreign
92− Data.Text.IO
93− Data.Text.Internal
94− Data.Text.Internal.Builder
95− Data.Text.Internal.Builder.Functions
96− Data.Text.Internal.Builder.Int.Digits
97− Data.Text.Internal.Builder.RealFloat.Functions
98− Data.Text.Internal.Encoding.Fusion
99− Data.Text.Internal.Encoding.Fusion.Common
100− Data.Text.Internal.Encoding.Utf16
101− Data.Text.Internal.Encoding.Utf32
102− Data.Text.Internal.Encoding.Utf8
103− Data.Text.Internal.Functions
104− Data.Text.Internal.Fusion
105− Data.Text.Internal.Fusion.CaseMapping
106− Data.Text.Internal.Fusion.Common
107− Data.Text.Internal.Fusion.Size
108− Data.Text.Internal.Fusion.Types
109− Data.Text.Internal.IO
110− Data.Text.Internal.Lazy
111− Data.Text.Internal.Lazy.Encoding.Fusion
112− Data.Text.Internal.Lazy.Fusion
113− Data.Text.Internal.Lazy.Search
114− Data.Text.Internal.Private
115− Data.Text.Internal.Read
116− Data.Text.Internal.Search
117− Data.Text.Internal.Unsafe
118− Data.Text.Internal.Unsafe.Char
119− Data.Text.Internal.Unsafe.Shift
120− 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
125− Data.Text.Lazy.IO
126− Data.Text.Lazy.Internal
127− Data.Text.Lazy.Read
128− Data.Text.Read
129− Data.Text.Unsafe
130− Data.Text.Show
131−
132executable text-multilang
59executable text-multilang
133 hs-source-dirs: haskell
60 hs-source-dirs: haskell
134 main-is: Multilang.hs
61 main-is: Multilang.hs
135− other-modules: Timer
136 ghc-options: -Wall -O2
62 ghc-options: -Wall -O2
137 build-depends: base == 4.*,
63 build-depends: base == 4.*,
138 bytestring,
64 bytestring,
cabal.projectdeleted−3
@@ -1,3 +0,0 @@
1−-- See http://cabal.readthedocs.io/en/latest/nix-local-build-overview.html
2−packages: .
3−tests: True
cbits/cbits.c+11−6
@@ -206,9 +206,11 @@ _hs_text_decode_utf8_state(uint16_t *const dest, size_t *destoff,
206 const uint8_t *srcend,
206 const uint8_t *srcend,
207 uint32_t *codepoint0, uint32_t *state0)
207 uint32_t *codepoint0, uint32_t *state0)
208{
208{
209− _hs_text_decode_utf8_int(dest, destoff, src, srcend, codepoint0, state0);
209+ uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, src, srcend,
210−
210+ codepoint0, state0);
211+ if (*state0 == UTF8_REJECT)
212+ ret -=1;
211− return *src;
213+ return ret;
212}
214}
213
215
214/*
216/*
@@ -220,9 +222,12 @@ _hs_text_decode_utf8(uint16_t *const dest, size_t *destoff,
220{
222{
221 uint32_t codepoint;
223 uint32_t codepoint;
222 uint32_t state = UTF8_ACCEPT;
224 uint32_t state = UTF8_ACCEPT;
223− _hs_text_decode_utf8_int(dest, destoff, &src, srcend,
225+ uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, &src, srcend,
224− &codepoint, &state);
226+ &codepoint, &state);
227+ /* Back up if we have an incomplete or invalid encoding */
228+ if (state != UTF8_ACCEPT)
229+ ret -= 1;
225− return src;
230+ return ret;
226}
231}
227
232
228void
233void
changelog.md+19−61
@@ -1,57 +1,15 @@
1−### 1.2.3.1 TBD
2−
3−* Make `decodeUtf8With` fail explicitly for unsupported non-BMP
4− replacement characters instead silent undefined behaviour (gh-213)
5−
6−### 1.2.3.0
7−
8−* Spec compliance: `toCaseFold` now follows the Unicode 9.0 spec
9− (updated from 8.0).
10−
11−* Bug fix: the lazy `takeWhileEnd` function violated the
12− [lazy text invariant](https://github.com/bos/text/blob/1.2.3.0/Data/Text/Internal/Lazy.hs#L51)
13− (gh-184).
14−
15−* Bug fix: Fixed usage of size hints causing incorrect behavior (gh-197).
16−
17−* New function: `unsnoc` (gh-173).
18−
19−* Reduce memory overhead in `encodeUTF8` (gh-194).
20−
21−* Improve UTF-8 decoder error-recovery (gh-182).
22−
23−* Minor documentation improvements (`@since` annotations, more
24− examples, clarifications).
25−
26−#### 1.2.2.2
27−
28−* The `toTitle` function now correctly handles letters that
29− immediately follow punctuation. Before, `"there's"` would turn into
30− `"There'S"`. Now, it becomes `"There's"`.
31−
32−* The implementation of unstreaming is faster, resulting in operations
33− such as `map` and `intersperse` speeding up by up to 30%, with
34− smaller code generated.
35−
36−* The optimised length comparison function is now more likely to be
37− used after some rewrite rule tweaking.
38−
39−* Bug fix: an off-by-one bug in `takeEnd` is fixed.
40−
41−* Bug fix: a logic error in `takeWord16` is fixed.
42−
43−#### 1.2.2.1
1+1.2.2.1
44
2
45* The switch to `integer-pure` in 1.2.2.0 was apparently mistaken.
3* The switch to `integer-pure` in 1.2.2.0 was apparently mistaken.
46 The build flag has been renamed accordingly. Your army of diligent
4 The build flag has been renamed accordingly. Your army of diligent
47 maintainers apologizes for the churn.
5 maintainers apologizes for the churn.
48
6
49−* Spec compliance: `toCaseFold` now follows the Unicode 8.0 spec
7+* Spec compliance: toCaseFold now follows the Unicode 8.0 spec
50 (updated from 7.0)
8 (updated from 7.0)
51
9
52* An STG lint error has been fixed
10* An STG lint error has been fixed
53
11
54−### 1.2.2.0
12+1.2.2.0
55
13
56* The `integer-simple` package, upon which this package optionally
14* The `integer-simple` package, upon which this package optionally
57 depended, has been replaced with `integer-pure`. The build flag has
15 depended, has been replaced with `integer-pure`. The build flag has
@@ -67,7 +25,7 @@
67 * if `base` >= 4.7: `PrintfArg`
25 * if `base` >= 4.7: `PrintfArg`
68 * if `base` >= 4.9: `Semigroup`
26 * if `base` >= 4.9: `Semigroup`
69
27
70−#### 1.2.1.3
28+1.2.1.3
71
29
72* Bug fix: As it turns out, moving the literal rewrite rules to simplifier
30* Bug fix: As it turns out, moving the literal rewrite rules to simplifier
73 phase 2 does not prevent competition with the `unpack` rule, which is
31 phase 2 does not prevent competition with the `unpack` rule, which is
@@ -75,7 +33,7 @@
75 test environment mistake. Moving literal rules back to phase 1 finally
33 test environment mistake. Moving literal rules back to phase 1 finally
76 fixes GHC Trac #10528 correctly.
34 fixes GHC Trac #10528 correctly.
77
35
78−#### 1.2.1.2
36+1.2.1.2
79
37
80* Bug fix: Run literal rewrite rules in simplifier phase 2.
38* Bug fix: Run literal rewrite rules in simplifier phase 2.
81 The behavior of the simplifier changed in GHC 7.10.2,
39 The behavior of the simplifier changed in GHC 7.10.2,
@@ -83,21 +41,21 @@
83 and long compilation times. See
41 and long compilation times. See
84 [GHC Trac #10528](https://ghc.haskell.org/trac/ghc/ticket/10528).
42 [GHC Trac #10528](https://ghc.haskell.org/trac/ghc/ticket/10528).
85
43
86−#### 1.2.1.1
44+1.2.1.1
87
45
88* Expose unpackCString#, which you should never use.
46* Expose unpackCString#, which you should never use.
89
47
90−### 1.2.1.0
48+1.2.1.0
91
49
92* Added Binary instances for both Text types. (If you have previously
50* Added Binary instances for both Text types. (If you have previously
93 been using the text-binary package to get a Binary instance, it is
51 been using the text-binary package to get a Binary instance, it is
94 now obsolete.)
52 now obsolete.)
95
53
96−#### 1.2.0.6
54+1.2.0.6
97
55
98* Fixed a space leak in UTF-8 decoding
56* Fixed a space leak in UTF-8 decoding
99
57
100−#### 1.2.0.5
58+1.2.0.5
101
59
102* Feature parity: repeat, cycle, iterate are now implemented for lazy
60* Feature parity: repeat, cycle, iterate are now implemented for lazy
103 Text, and the Data instance is more complete
61 Text, and the Data instance is more complete
@@ -117,26 +75,26 @@
117* Spec compliance: toCaseFold now follows the Unicode 7.0 spec
75* Spec compliance: toCaseFold now follows the Unicode 7.0 spec
118 (updated from 6.3)
76 (updated from 6.3)
119
77
120−#### 1.2.0.4
78+1.2.0.4
121
79
122* Fixed an incompatibility with base < 4.5
80* Fixed an incompatibility with base < 4.5
123
81
124−#### 1.2.0.3
82+1.2.0.3
125
83
126* Update formatRealFloat to correspond to the definition in versions
84* Update formatRealFloat to correspond to the definition in versions
127 of base newer than 4.5 (https://github.com/bos/text/issues/105)
85 of base newer than 4.5 (https://github.com/bos/text/issues/105)
128
86
129−#### 1.2.0.2
87+1.2.0.2
130
88
131* Bumped lower bound on deepseq to 1.4 for compatibility with the
89* Bumped lower bound on deepseq to 1.4 for compatibility with the
132 upcoming GHC 7.10
90 upcoming GHC 7.10
133
91
134−#### 1.2.0.1
92+1.2.0.1
135
93
136* Fixed a buffer overflow in rendering of large Integers
94* Fixed a buffer overflow in rendering of large Integers
137 (https://github.com/bos/text/issues/99)
95 (https://github.com/bos/text/issues/99)
138
96
139−## 1.2.0.0
97+1.2.0.0
140
98
141* Fixed an integer overflow in the replace function
99* Fixed an integer overflow in the replace function
142 (https://github.com/bos/text/issues/81)
100 (https://github.com/bos/text/issues/81)
@@ -149,7 +107,7 @@
149
107
150* Added an instance of IsList for GHC 7.8 and above
108* Added an instance of IsList for GHC 7.8 and above
151
109
152−### 1.1.1.0
110+1.1.1.0
153
111
154* The Data.Data instance now allows gunfold to work, via a virtual
112* The Data.Data instance now allows gunfold to work, via a virtual
155 pack constructor
113 pack constructor
@@ -159,12 +117,12 @@
159* Comparing the length of a Text against a number can now
117* Comparing the length of a Text against a number can now
160 short-circuit in more cases
118 short-circuit in more cases
161
119
162−#### 1.1.0.1
120+1.1.0.1
163
121
164* streamDecodeUtf8: fixed gh-70, did not return all unconsumed bytes
122* streamDecodeUtf8: fixed gh-70, did not return all unconsumed bytes
165 in single-byte chunks
123 in single-byte chunks
166
124
167−## 1.1.0.0
125+1.1.0.0
168
126
169* encodeUtf8: Performance is improved by up to 4x.
127* encodeUtf8: Performance is improved by up to 4x.
170
128
@@ -183,12 +141,12 @@
183 use at your own risk - there are no API stability guarantees for
141 use at your own risk - there are no API stability guarantees for
184 internal modules!
142 internal modules!
185
143
186−#### 1.0.0.1
144+1.0.0.1
187
145
188* decodeUtf8: Fixed a regression that caused us to incorrectly
146* decodeUtf8: Fixed a regression that caused us to incorrectly
189 identify truncated UTF-8 as valid (gh-61)
147 identify truncated UTF-8 as valid (gh-61)
190
148
191−# 1.0.0.0
149+1.0.0.0
192
150
193* Added support for Unicode 6.3.0 to case conversion functions
151* Added support for Unicode 6.3.0 to case conversion functions
194
152
tests-and-benchmarks.markdown+8−13
@@ -13,13 +13,10 @@ you can clone from one of the following locations:
13* Git mirror repository:
13* Git mirror repository:
14 [github.com/bos/text-test-data](https://github.com/bos/text-test-data)
14 [github.com/bos/text-test-data](https://github.com/bos/text-test-data)
15
15
16−You can clone either repository into the `tests` subdirectory using
16+You should clone that repository into the `tests` subdirectory (your
17−
17+clone must be named `text-test-data` locally), then run `make -C
18− cd tests/
18+tests/text-test-data` to uncompress the test files. Many tests and
19− make text-test-data # to clone from mercurial, OR
20− make VCS=git text-test-data # to clone from git
21−
22−Many tests and benchmarks will fail if the test files are missing.
19+benchmarks will fail if the test files are missing.
23
20
24Functional tests
21Functional tests
25----------------
22----------------
@@ -57,12 +54,10 @@ To compile the benchmarks, navigate to the `benchmarks` subdirectory and run
57
54
58 ./dist/build/text-benchmarks/text-benchmarks
55 ./dist/build/text-benchmarks/text-benchmarks
59
56
60−Or if you have a recent enough `cabal`, you can build and run the
57+However, since there's quite a lot of benchmarks, you usually don't want to
61−benchmarks via
58+run them all. Instead, use the `-l` flag to get a list of benchmarks:
62
59
63− cabal new-run exe:text-benchmarks -- --help
60+ ./dist/build/text-benchmarks/text-benchmarks
64
61
65−However, since there's quite a lot of benchmarks, you usually don't want to
66−run them all. Instead, use the `-l` flag to get a list of benchmarks
67−and run the ones you want to inspect. If you want to configure the benchmarks
62+And run the ones you want to inspect. If you want to configure the benchmarks
68further, the exact parameters can be changed in `Benchmarks.hs`.
63further, the exact parameters can be changed in `Benchmarks.hs`.
tests/Makefile+1−6
@@ -1,4 +1,3 @@
1−VCS = hg
2count = 1000
1count = 1000
3
2
4all: coverage literal-rule-test
3all: coverage literal-rule-test
@@ -13,11 +12,7 @@ build: text-test-data
13 cabal build
12 cabal build
14
13
15text-test-data:
14text-test-data:
16−ifeq ($(VCS),git)
17− git clone https://github.com/bos/text-test-data.git
18−else
19 hg clone https://bitbucket.org/bos/text-test-data
15 hg clone https://bitbucket.org/bos/text-test-data
20−endif
21 $(MAKE) -C text-test-data
16 $(MAKE) -C text-test-data
22
17
23coverage/text-tests.tix:
18coverage/text-tests.tix:
@@ -42,4 +37,4 @@ coverage/hpc_index.html: coverage/coverage.tix
42clean:
37clean:
43 rm -rf dist coverage .hpc
38 rm -rf dist coverage .hpc
44
39
45−.PHONY: all build clean coverage literal-rule-test
40+.PHONY: build coverage all literal-rule-test
tests/Tests/Properties.hs+21−94
@@ -9,9 +9,9 @@ module Tests.Properties
9 ) where
9 ) where
10
10
11import Control.Applicative ((<$>), (<*>))
11import Control.Applicative ((<$>), (<*>))
12−import Control.Arrow ((***), first, second)
12+import Control.Arrow ((***), second)
13import Data.Bits ((.&.))
13import Data.Bits ((.&.))
14−import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isLetter, isUpper, ord)
14+import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
15import Data.Int (Int8, Int16, Int32, Int64)
15import Data.Int (Int8, Int16, Int32, Int64)
16import Data.Monoid (Monoid(..))
16import Data.Monoid (Monoid(..))
17import Data.String (IsString(fromString))
17import Data.String (IsString(fromString))
@@ -23,7 +23,6 @@ import Data.Text.Internal.Search (indices)
23import Data.Text.Lazy.Read as TL
23import Data.Text.Lazy.Read as TL
24import Data.Text.Read as T
24import Data.Text.Read as T
25import Data.Word (Word, Word8, Word16, Word32, Word64)
25import Data.Word (Word, Word8, Word16, Word32, Word64)
26−import Data.Maybe (mapMaybe)
27import Numeric (showEFloat, showFFloat, showGFloat, showHex)
26import Numeric (showEFloat, showFFloat, showGFloat, showHex)
28import Prelude hiding (replicate)
27import Prelude hiding (replicate)
29import Test.Framework (Test, testGroup)
28import Test.Framework (Test, testGroup)
@@ -31,7 +30,6 @@ import Test.Framework.Providers.QuickCheck2 (testProperty)
31import Test.QuickCheck hiding ((.&.))
30import Test.QuickCheck hiding ((.&.))
32import Test.QuickCheck.Monadic
31import Test.QuickCheck.Monadic
33import Test.QuickCheck.Property (Property(..))
32import Test.QuickCheck.Property (Property(..))
34−import Test.QuickCheck.Unicode (char)
35import Tests.QuickCheckUtils
33import Tests.QuickCheckUtils
36import Tests.Utils
34import Tests.Utils
37import Text.Show.Functions ()
35import Text.Show.Functions ()
@@ -39,7 +37,6 @@ import qualified Control.Exception as Exception
39import qualified Data.Bits as Bits (shiftL, shiftR)
37import qualified Data.Bits as Bits (shiftL, shiftR)
40import qualified Data.ByteString as B
38import qualified Data.ByteString as B
41import qualified Data.ByteString.Lazy as BL
39import qualified Data.ByteString.Lazy as BL
42−import qualified Data.Char as C
43import qualified Data.List as L
40import qualified Data.List as L
44import qualified Data.Text as T
41import qualified Data.Text as T
45import qualified Data.Text.Encoding as E
42import qualified Data.Text.Encoding as E
@@ -63,10 +60,10 @@ t_pack_unpack = (T.unpack . T.pack) `eq` id
63tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
60tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
64t_stream_unstream = (S.unstream . S.stream) `eq` id
61t_stream_unstream = (S.unstream . S.stream) `eq` id
65tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
62tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
66−t_reverse_stream t = (S.reverse . S.reverseStream) t === t
63+t_reverse_stream t = (S.reverse . S.reverseStream) t == t
67−t_singleton c = [c] === (T.unpack . T.singleton) c
64+t_singleton c = [c] == (T.unpack . T.singleton) c
68−tl_singleton c = [c] === (TL.unpack . TL.singleton) c
65+tl_singleton c = [c] == (TL.unpack . TL.singleton) c
69−tl_unstreamChunks x = f 11 x === f 1000 x
66+tl_unstreamChunks x = f 11 x == f 1000 x
70 where f n = SL.unstreamChunks n . S.streamList
67 where f n = SL.unstreamChunks n . S.streamList
71tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
68tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
72tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
69tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
@@ -77,13 +74,13 @@ encodeL1 = B.pack . map (fromIntegral . fromEnum) . T.unpack
77encodeLazyL1 :: TL.Text -> BL.ByteString
74encodeLazyL1 :: TL.Text -> BL.ByteString
78encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
75encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
79
76
80−t_ascii t = E.decodeASCII (E.encodeUtf8 a) === a
77+t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a
81 where a = T.map (\c -> chr (ord c `mod` 128)) t
78 where a = T.map (\c -> chr (ord c `mod` 128)) t
82−tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) === a
79+tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a
83 where a = TL.map (\c -> chr (ord c `mod` 128)) t
80 where a = TL.map (\c -> chr (ord c `mod` 128)) t
84−t_latin1 t = E.decodeLatin1 (encodeL1 a) === a
81+t_latin1 t = E.decodeLatin1 (encodeL1 a) == a
85 where a = T.map (\c -> chr (ord c `mod` 256)) t
82 where a = T.map (\c -> chr (ord c `mod` 256)) t
86−tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) === a
83+tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) == a
87 where a = TL.map (\c -> chr (ord c `mod` 256)) t
84 where a = TL.map (\c -> chr (ord c `mod` 256)) t
88t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
85t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
89t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
86t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
@@ -114,7 +111,7 @@ t_utf8_undecoded = forAll genUnicode $ \t ->
114 let b = E.encodeUtf8 t
111 let b = E.encodeUtf8 t
115 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
112 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
116 leftover = (++ [B.empty]) . init . tail . B.inits
113 leftover = (++ [B.empty]) . init . tail . B.inits
117− in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b === ls
114+ in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b == ls
118
115
119data Badness = Solo | Leading | Trailing
116data Badness = Solo | Leading | Trailing
120 deriving (Eq, Show)
117 deriving (Eq, Show)
@@ -180,33 +177,6 @@ genInvalidUTF8 = B.pack <$> oneof [
180 k <- choose (0,n)
177 k <- choose (0,n)
181 vectorOf k gen
178 vectorOf k gen
182
179
183−-- See http://unicode.org/faq/utf_bom.html#gen8
184−-- A sequence such as <110xxxxx2 0xxxxxxx2> is illegal ...
185−-- When faced with this illegal byte sequence ... a UTF-8 conformant process
186−-- must treat the first byte 110xxxxx2 as an illegal termination error
187−-- (e.g. filter it out or replace by 0xFFFD) ...
188−-- ... and continue processing at the second byte 0xxxxxxx2
189−t_decode_with_error2 =
190− E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97]) === "xa"
191−t_decode_with_error3 =
192− E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xE0, 97, 97]) === "xaa"
193−t_decode_with_error4 =
194− E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xF0, 97, 97, 97]) === "xaaa"
195−
196−t_decode_with_error2' =
197− case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97]) of
198− E.Some x _ _ -> x === "xa"
199−t_decode_with_error3' =
200− case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97, 97]) of
201− E.Some x _ _ -> x === "xaa"
202−t_decode_with_error4' =
203− case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97, 97, 97]) of
204− E.Some x _ _ -> x === "xaaa"
205−
206−t_infix_concat bs1 text bs2 rep =
207− text `T.isInfixOf`
208− E.decodeUtf8With (\_ _ -> rep) (B.concat [bs1, E.encodeUtf8 text, bs2])
209−
210s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
180s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
211 where _types = s :: String
181 where _types = s :: String
212sf_Eq p s =
182sf_Eq p s =
@@ -231,8 +201,8 @@ t_mconcat = unsquare $
231 mconcat `eq` (unpackS . mconcat . L.map T.pack)
201 mconcat `eq` (unpackS . mconcat . L.map T.pack)
232tl_mconcat = unsquare $
202tl_mconcat = unsquare $
233 mconcat `eq` (unpackS . mconcat . L.map TL.pack)
203 mconcat `eq` (unpackS . mconcat . L.map TL.pack)
234−t_mempty = mempty === (unpackS (mempty :: T.Text))
204+t_mempty = mempty == (unpackS (mempty :: T.Text))
235−tl_mempty = mempty === (unpackS (mempty :: TL.Text))
205+tl_mempty = mempty == (unpackS (mempty :: TL.Text))
236t_IsString = fromString `eqP` (T.unpack . fromString)
206t_IsString = fromString `eqP` (T.unpack . fromString)
237tl_IsString = fromString `eqP` (TL.unpack . fromString)
207tl_IsString = fromString `eqP` (TL.unpack . fromString)
238
208
@@ -259,13 +229,6 @@ sf_uncons p = (uncons . L.filter p) `eqP`
259 (fmap (second unpackS) . S.uncons . S.filter p)
229 (fmap (second unpackS) . S.uncons . S.filter p)
260t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
230t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
261tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)
231tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)
262−
263−unsnoc xs@(_:_) = Just (init xs, last xs)
264−unsnoc [] = Nothing
265−
266−t_unsnoc = unsnoc `eqP` (fmap (first unpackS) . T.unsnoc)
267−tl_unsnoc = unsnoc `eqP` (fmap (first unpackS) . TL.unsnoc)
268−
269s_head = head `eqP` S.head
232s_head = head `eqP` S.head
270sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)
233sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)
271t_head = head `eqP` T.head
234t_head = head `eqP` T.head
@@ -363,19 +326,6 @@ t_toUpper_upper t = p (T.toUpper t) >= p t
363 where p = T.length . T.filter isUpper
326 where p = T.length . T.filter isUpper
364tl_toUpper_upper t = p (TL.toUpper t) >= p t
327tl_toUpper_upper t = p (TL.toUpper t) >= p t
365 where p = TL.length . TL.filter isUpper
328 where p = TL.length . TL.filter isUpper
366−t_toTitle_title t = all (<= 1) (caps w)
367− where caps = fmap (T.length . T.filter isUpper) . T.words . T.toTitle
368− -- TIL: there exist uppercase-only letters
369− w = T.filter (\c -> if C.isUpper c then C.toLower c /= c else True) t
370−t_toTitle_1stNotLower = and . notLow . T.toTitle . T.filter stable
371− where notLow = mapMaybe (fmap (not . isLower) . (T.find isLetter)) . T.words
372− -- Surprise! The Spanish/Portuguese ordinal indicators changed
373− -- from category Ll (letter, lowercase) to Lo (letter, other)
374− -- in Unicode 7.0
375− -- Oh, and there exist lowercase-only letters (see previous test)
376− stable c = if isLower c
377− then C.toUpper c /= c
378− else c /= '\170' && c /= '\186'
379
329
380justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
330justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
381justifyRight m n xs = L.replicate (m - length xs) n ++ xs
331justifyRight m n xs = L.replicate (m - length xs) n ++ xs
@@ -564,20 +514,12 @@ s_takeWhile p = L.takeWhile p `eqP` (unpackS . S.takeWhile p)
564s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)
514s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)
565sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
515sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
566 (unpackS . S.takeWhile p . S.filter q)
516 (unpackS . S.takeWhile p . S.filter q)
567−noMatch = do
568− c <- char
569− d <- suchThat char (/= c)
570− return (c,d)
571t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
517t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
572tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
518tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
573t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
519t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
574 (unpackS . T.takeWhileEnd p)
520 (unpackS . T.takeWhileEnd p)
575−t_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> T.null $
576− T.takeWhileEnd (==d) (T.snoc t c)
577tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
521tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
578 (unpackS . TL.takeWhileEnd p)
522 (unpackS . TL.takeWhileEnd p)
579−tl_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> TL.null $
580− TL.takeWhileEnd (==d) (TL.snoc t c)
581s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
523s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
582s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
524s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
583sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
525sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
@@ -778,7 +720,7 @@ tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
778 conc = T.concat . TL.toChunks
720 conc = T.concat . TL.toChunks
779t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
721t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
780 let s = T.intercalate t ts
722 let s = T.intercalate t ts
781− in Slow.indices t s === indices t s
723+ in Slow.indices t s == indices t s
782
724
783-- Bit shifts.
725-- Bit shifts.
784shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
726shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
@@ -870,18 +812,18 @@ tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a
870-- Reading.
812-- Reading.
871
813
872t_decimal (n::Int) s =
814t_decimal (n::Int) s =
873− T.signed T.decimal (T.pack (show n) `T.append` t) === Right (n,t)
815+ T.signed T.decimal (T.pack (show n) `T.append` t) == Right (n,t)
874 where t = T.dropWhile isDigit s
816 where t = T.dropWhile isDigit s
875tl_decimal (n::Int) s =
817tl_decimal (n::Int) s =
876− TL.signed TL.decimal (TL.pack (show n) `TL.append` t) === Right (n,t)
818+ TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
877 where t = TL.dropWhile isDigit s
819 where t = TL.dropWhile isDigit s
878t_hexadecimal m s ox =
820t_hexadecimal m s ox =
879− T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) === Right (n,t)
821+ T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
880 where t = T.dropWhile isHexDigit s
822 where t = T.dropWhile isHexDigit s
881 p = if ox then "0x" else ""
823 p = if ox then "0x" else ""
882 n = getPositive m :: Int
824 n = getPositive m :: Int
883tl_hexadecimal m s ox =
825tl_hexadecimal m s ox =
884− TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) === Right (n,t)
826+ TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
885 where t = TL.dropWhile isHexDigit s
827 where t = TL.dropWhile isHexDigit s
886 p = if ox then "0x" else ""
828 p = if ox then "0x" else ""
887 n = getPositive m :: Int
829 n = getPositive m :: Int
@@ -925,11 +867,11 @@ tl_write_read_line e m b t = write_read head TL.filter TL.hPutStrLn
925
867
926t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
868t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
927t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
869t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
928−t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) === t
870+t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) == t
929 where n = small m
871 where n = small m
930t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
872t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
931
873
932−t_copy t = T.copy t === t
874+t_copy t = T.copy t == t
933
875
934-- Regression tests.
876-- Regression tests.
935s_filter_eq s = S.filter p t == S.streamList (filter p s)
877s_filter_eq s = S.filter p t == S.streamList (filter p s)
@@ -982,15 +924,6 @@ tests =
982 testGroup "errors" [
924 testGroup "errors" [
983 testProperty "t_utf8_err" t_utf8_err,
925 testProperty "t_utf8_err" t_utf8_err,
984 testProperty "t_utf8_err'" t_utf8_err'
926 testProperty "t_utf8_err'" t_utf8_err'
985− ],
986− testGroup "error recovery" [
987− testProperty "t_decode_with_error2" t_decode_with_error2,
988− testProperty "t_decode_with_error3" t_decode_with_error3,
989− testProperty "t_decode_with_error4" t_decode_with_error4,
990− testProperty "t_decode_with_error2'" t_decode_with_error2',
991− testProperty "t_decode_with_error3'" t_decode_with_error3',
992− testProperty "t_decode_with_error4'" t_decode_with_error4',
993− testProperty "t_infix_concat" t_infix_concat
994 ]
927 ]
995 ],
928 ],
996
929
@@ -1034,8 +967,6 @@ tests =
1034 testProperty "sf_uncons" sf_uncons,
967 testProperty "sf_uncons" sf_uncons,
1035 testProperty "t_uncons" t_uncons,
968 testProperty "t_uncons" t_uncons,
1036 testProperty "tl_uncons" tl_uncons,
969 testProperty "tl_uncons" tl_uncons,
1037− testProperty "t_unsnoc" t_unsnoc,
1038− testProperty "tl_unsnoc" tl_unsnoc,
1039 testProperty "s_head" s_head,
970 testProperty "s_head" s_head,
1040 testProperty "sf_head" sf_head,
971 testProperty "sf_head" sf_head,
1041 testProperty "t_head" t_head,
972 testProperty "t_head" t_head,
@@ -1099,9 +1030,7 @@ tests =
1099 testProperty "tl_toLower_lower" tl_toLower_lower,
1030 testProperty "tl_toLower_lower" tl_toLower_lower,
1100 testProperty "t_toUpper_length" t_toUpper_length,
1031 testProperty "t_toUpper_length" t_toUpper_length,
1101 testProperty "t_toUpper_upper" t_toUpper_upper,
1032 testProperty "t_toUpper_upper" t_toUpper_upper,
1102− testProperty "tl_toUpper_upper" tl_toUpper_upper,
1033+ testProperty "tl_toUpper_upper" tl_toUpper_upper
1103− testProperty "t_toTitle_title" t_toTitle_title,
1104− testProperty "t_toTitle_1stNotLower" t_toTitle_1stNotLower
1105 ],
1034 ],
1106
1035
1107 testGroup "justification" [
1036 testGroup "justification" [
@@ -1218,9 +1147,7 @@ tests =
1218 testProperty "t_takeWhile" t_takeWhile,
1147 testProperty "t_takeWhile" t_takeWhile,
1219 testProperty "tl_takeWhile" tl_takeWhile,
1148 testProperty "tl_takeWhile" tl_takeWhile,
1220 testProperty "t_takeWhileEnd" t_takeWhileEnd,
1149 testProperty "t_takeWhileEnd" t_takeWhileEnd,
1221− testProperty "t_takeWhileEnd_null" t_takeWhileEnd_null,
1222 testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1150 testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1223− testProperty "tl_takeWhileEnd_null" tl_takeWhileEnd_null,
1224 testProperty "sf_dropWhile" sf_dropWhile,
1151 testProperty "sf_dropWhile" sf_dropWhile,
1225 testProperty "s_dropWhile" s_dropWhile,
1152 testProperty "s_dropWhile" s_dropWhile,
1226 testProperty "s_dropWhile_s" s_dropWhile_s,
1153 testProperty "s_dropWhile_s" s_dropWhile_s,
tests/Tests/QuickCheckUtils.hs+1−1
@@ -106,7 +106,7 @@ smallArbitrary = sized $ \n -> resize (smallish n) arbitrary
106 where smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs
106 where smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs
107
107
108instance Arbitrary T.Text where
108instance Arbitrary T.Text where
109− arbitrary = T.pack `fmap` string
109+ arbitrary = T.pack `fmap` arbitrary
110 shrink = map T.pack . shrink . T.unpack
110 shrink = map T.pack . shrink . T.unpack
111
111
112instance Arbitrary TL.Text where
112instance Arbitrary TL.Text where
tests/Tests/Regressions.hs−11
@@ -72,16 +72,6 @@ mapAccumL_resize = do
72 assertEqual "mapAccumL should correctly size buffers for two-word results"
72 assertEqual "mapAccumL should correctly size buffers for two-word results"
73 (count * 2) (T.lengthWord16 (snd val))
73 (count * 2) (T.lengthWord16 (snd val))
74
74
75−-- See GitHub #197
76−t197 :: IO ()
77−t197 =
78− assertBool "length (filter (==',') \"0,00\") should be 1" (currencyParser "0,00")
79− where
80− currencyParser x = cond == 1
81− where
82− cond = length fltr
83− fltr = filter (== ',') x
84−
85tests :: F.Test
75tests :: F.Test
86tests = F.testGroup "Regressions"
76tests = F.testGroup "Regressions"
87 [ F.testCase "hGetContents_crash" hGetContents_crash
77 [ F.testCase "hGetContents_crash" hGetContents_crash
@@ -89,5 +79,4 @@ tests = F.testGroup "Regressions"
89 , F.testCase "mapAccumL_resize" mapAccumL_resize
79 , F.testCase "mapAccumL_resize" mapAccumL_resize
90 , F.testCase "replicate_crash" replicate_crash
80 , F.testCase "replicate_crash" replicate_crash
91 , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe
81 , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe
92− , F.testCase "t197" t197
93 ]
82 ]
tests/text-tests.cabal+3−18
@@ -20,11 +20,6 @@ flag hpc
20 default: False
20 default: False
21 manual: True
21 manual: True
22
22
23−flag bytestring-builder
24− description: Depend on the bytestring-builder package for backwards compatibility.
25− default: False
26− manual: False
27−
28executable text-tests
23executable text-tests
29 main-is: Tests.hs
24 main-is: Tests.hs
30
25
@@ -53,21 +48,16 @@ executable text-tests
53 HUnit >= 1.2,
48 HUnit >= 1.2,
54 QuickCheck >= 2.7,
49 QuickCheck >= 2.7,
55 base == 4.*,
50 base == 4.*,
51+ bytestring,
56 deepseq,
52 deepseq,
57 directory,
53 directory,
58− quickcheck-unicode >= 1.0.1.0,
54+ quickcheck-unicode,
59 random,
55 random,
60 test-framework >= 0.4,
56 test-framework >= 0.4,
61 test-framework-hunit >= 0.2,
57 test-framework-hunit >= 0.2,
62 test-framework-quickcheck2 >= 0.2,
58 test-framework-quickcheck2 >= 0.2,
63 text-tests
59 text-tests
64
60
65− if flag(bytestring-builder)
66− build-depends: bytestring >= 0.9 && < 0.10.4,
67− bytestring-builder >= 0.10.4
68− else
69− build-depends: bytestring >= 0.10.4
70−
71executable text-tests-stdio
61executable text-tests-stdio
72 main-is: Tests/IO.hs
62 main-is: Tests/IO.hs
73
63
@@ -147,12 +137,7 @@ library
147 array,
137 array,
148 base == 4.*,
138 base == 4.*,
149 binary,
139 binary,
140+ bytestring,
150 deepseq,
141 deepseq,
151 ghc-prim,
142 ghc-prim,
152 integer-gmp
143 integer-gmp
153−
154− if flag(bytestring-builder)
155− build-depends: bytestring >= 0.9 && < 0.10.4,
156− bytestring-builder >= 0.10.4
157− else
158− build-depends: bytestring >= 0.10.4
text.cabal+52−124
@@ -1,7 +1,7 @@
1name: text
1name: text
2−version: 1.2.3.0
2+version: 1.2.2.1
3−homepage: https://github.com/haskell/text
3+homepage: https://github.com/bos/text
4−bug-reports: https://github.com/haskell/text/issues
4+bug-reports: https://github.com/bos/text/issues
5synopsis: An efficient packed Unicode text type.
5synopsis: An efficient packed Unicode text type.
6description:
6description:
7 .
7 .
@@ -14,13 +14,11 @@ description:
14 in terms of large data quantities and high speed.
14 in terms of large data quantities and high speed.
15 .
15 .
16 The 'Text' type provides character-encoding, type-safe case
16 The 'Text' type provides character-encoding, type-safe case
17− conversion via whole-string case conversion functions (see "Data.Text").
17+ conversion via whole-string case conversion functions. It also
18− It also provides a range of functions for converting 'Text' values to
18+ provides a range of functions for converting 'Text' values to and from
19− and from 'ByteStrings', using several standard encodings
19+ 'ByteStrings', using several standard encodings.
20− (see "Data.Text.Encoding").
21 .
20 .
22− Efficient locale-sensitive support for text IO is also supported
21+ Efficient locale-sensitive support for text IO is also supported.
23− (see "Data.Text.IO").
24 .
22 .
25 These modules are intended to be imported qualified, to avoid name
23 These modules are intended to be imported qualified, to avoid name
26 clashes with Prelude functions, e.g.
24 clashes with Prelude functions, e.g.
@@ -30,9 +28,8 @@ description:
30 To use an extended and very rich family of functions for working
28 To use an extended and very rich family of functions for working
31 with Unicode text (including normalization, regular expressions,
29 with Unicode text (including normalization, regular expressions,
32 non-standard encodings, text breaking, and locales), see
30 non-standard encodings, text breaking, and locales), see
31+ the @text-icu@ package:
33− the [text-icu package](https://hackage.haskell.org/package/text-icu)
32+ <http://hackage.haskell.org/package/text-icu>
34− based on the well-respected and liberally
35− licensed [ICU library](http://site.icu-project.org/).
36
33
37license: BSD2
34license: BSD2
38license-file: LICENSE
35license-file: LICENSE
@@ -42,8 +39,6 @@ copyright: 2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper
42category: Data, Text
39category: Data, Text
43build-type: Simple
40build-type: Simple
44cabal-version: >= 1.8
41cabal-version: >= 1.8
45−tested-with: GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4,
46− GHC==7.6.3, GHC==7.4.2, GHC==7.2.2, GHC==7.0.4
47extra-source-files:
42extra-source-files:
48 -- scripts/CaseFolding.txt
43 -- scripts/CaseFolding.txt
49 -- scripts/SpecialCasing.txt
44 -- scripts/SpecialCasing.txt
@@ -70,9 +65,7 @@ extra-source-files:
70 tests/text-tests.cabal
65 tests/text-tests.cabal
71
66
72flag bytestring-builder
67flag bytestring-builder
73− description:
74− Depend on the [bytestring-builder](https://hackage.haskell.org/package/bytestring-builder)
75− package for backwards compatibility.
68+ description: Depend on the bytestring-builder package for backwards compatibility.
76 default: False
69 default: False
77 manual: False
70 manual: False
78
71
@@ -82,9 +75,7 @@ flag developer
82 manual: True
75 manual: True
83
76
84flag integer-simple
77flag integer-simple
85− description:
86− Use the [simple integer library](http://hackage.haskell.org/package/integer-simple)
78+ description: Use the simple integer library instead of GMP
87− instead of [integer-gmp](http://hackage.haskell.org/package/integer-gmp)
88 default: False
79 default: False
89 manual: False
80 manual: False
90
81
@@ -167,114 +158,51 @@ library
167 cpp-options: -DINTEGER_GMP
158 cpp-options: -DINTEGER_GMP
168 build-depends: integer-gmp >= 0.2
159 build-depends: integer-gmp >= 0.2
169
160
170−-- test-suite tests
161+test-suite tests
171−-- type: exitcode-stdio-1.0
162+ type: exitcode-stdio-1.0
163+ hs-source-dirs: tests .
164+ main-is: Tests.hs
172−-- c-sources: cbits/cbits.c
165+ c-sources: cbits/cbits.c
173−-- include-dirs: include
166+ include-dirs: include
174
167
175−-- ghc-options:
168+ ghc-options:
176−-- -Wall -threaded -rtsopts
169+ -Wall -threaded -O0 -rtsopts
177
170
178−-- cpp-options:
171+ cpp-options:
179−-- -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE
172+ -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE
180
173
181−-- -- modules specific to test-suite
182−-- hs-source-dirs: tests
183−-- main-is: Tests.hs
184−-- other-modules:
185−-- Tests.Properties
186−-- Tests.Properties.Mul
187−-- Tests.QuickCheckUtils
188−-- Tests.Regressions
189−-- Tests.SlowFunctions
190−-- Tests.Utils
191−
192−-- -- Same as in `library` stanza; this is needed by cabal for accurate
193−-- -- file-monitoring as well as to avoid `-Wmissing-home-modules`
194−-- -- warnings We can't use an inter-package library dependency because
195−-- -- of different `ghc-options`/`cpp-options` (as a side-benefitt,
196−-- -- this enables per-component build parallelism in `cabal
197−-- -- new-build`!); We could, however, use cabal-version:2.2's `common`
198−-- -- blocks at some point in the future to reduce the duplication.
199−-- hs-source-dirs: .
200−-- other-modules:
201−-- Data.Text
202−-- Data.Text.Array
203−-- Data.Text.Encoding
204−-- Data.Text.Encoding.Error
205−-- Data.Text.Foreign
206−-- Data.Text.IO
207−-- Data.Text.Internal
208−-- Data.Text.Internal.Builder
209−-- Data.Text.Internal.Builder.Functions
210−-- Data.Text.Internal.Builder.Int.Digits
211−-- Data.Text.Internal.Builder.RealFloat.Functions
212−-- Data.Text.Internal.Encoding.Fusion
213−-- Data.Text.Internal.Encoding.Fusion.Common
214−-- Data.Text.Internal.Encoding.Utf16
215−-- Data.Text.Internal.Encoding.Utf32
216−-- Data.Text.Internal.Encoding.Utf8
217−-- Data.Text.Internal.Functions
218−-- Data.Text.Internal.Fusion
219−-- Data.Text.Internal.Fusion.CaseMapping
220−-- Data.Text.Internal.Fusion.Common
221−-- Data.Text.Internal.Fusion.Size
222−-- Data.Text.Internal.Fusion.Types
223−-- Data.Text.Internal.IO
224−-- Data.Text.Internal.Lazy
225−-- Data.Text.Internal.Lazy.Encoding.Fusion
226−-- Data.Text.Internal.Lazy.Fusion
227−-- Data.Text.Internal.Lazy.Search
228−-- Data.Text.Internal.Private
229−-- Data.Text.Internal.Read
230−-- Data.Text.Internal.Search
231−-- Data.Text.Internal.Unsafe
232−-- Data.Text.Internal.Unsafe.Char
233−-- Data.Text.Internal.Unsafe.Shift
234−-- Data.Text.Lazy
235−-- Data.Text.Lazy.Builder
236−-- Data.Text.Lazy.Builder.Int
237−-- Data.Text.Lazy.Builder.RealFloat
238−-- Data.Text.Lazy.Encoding
239−-- Data.Text.Lazy.IO
240−-- Data.Text.Lazy.Internal
241−-- Data.Text.Lazy.Read
242−-- Data.Text.Read
243−-- Data.Text.Unsafe
244−-- Data.Text.Show
245−
246−-- build-depends:
174+ build-depends:
247−-- HUnit >= 1.2,
175+ HUnit >= 1.2,
248−-- QuickCheck >= 2.7 && < 2.10,
176+ QuickCheck >= 2.7,
249−-- array,
177+ array,
250−-- base,
178+ base,
251−-- binary,
179+ binary,
252−-- deepseq,
180+ deepseq,
253−-- directory,
181+ directory,
254−-- ghc-prim,
182+ ghc-prim,
255−-- quickcheck-unicode >= 1.0.1.0,
183+ quickcheck-unicode,
256−-- random,
184+ random,
257−-- test-framework >= 0.4,
185+ test-framework >= 0.4,
258−-- test-framework-hunit >= 0.2,
186+ test-framework-hunit >= 0.2,
259−-- test-framework-quickcheck2 >= 0.2
187+ test-framework-quickcheck2 >= 0.2
260
188
261−-- if flag(bytestring-builder)
189+ if flag(bytestring-builder)
262−-- build-depends: bytestring >= 0.9 && < 0.10.4,
190+ build-depends: bytestring >= 0.9 && < 0.10.4,
263−-- bytestring-builder >= 0.10.4
191+ bytestring-builder >= 0.10.4
264−-- else
192+ else
265−-- build-depends: bytestring >= 0.10.4
193+ build-depends: bytestring >= 0.10.4
266
194
267−-- if flag(integer-simple)
195+ if flag(integer-simple)
268−-- cpp-options: -DINTEGER_SIMPLE
196+ cpp-options: -DINTEGER_SIMPLE
269−-- build-depends: integer-simple >= 0.1 && < 0.5
197+ build-depends: integer-simple >= 0.1 && < 0.5
270−-- else
198+ else
271−-- cpp-options: -DINTEGER_GMP
199+ cpp-options: -DINTEGER_GMP
272−-- build-depends: integer-gmp >= 0.2
200+ build-depends: integer-gmp >= 0.2
273
201
274−-- source-repository head
202+source-repository head
275−-- type: git
203+ type: git
276−-- location: https://github.com/haskell/text
204+ location: https://github.com/bos/text
277
205
278−-- source-repository head
206+source-repository head
279−-- type: mercurial
207+ type: mercurial
280−-- location: https://bitbucket.org/bos/text
208+ location: https://bitbucket.org/bos/text