on master help sign in
52 files changed+2002−3347
since splitsnapshots
unifiedsplit
.gitignore+3−10 .hgtags−1 .travis.yml−111 Data/JSString/Text.hs−64 Data/Text.hs+391−690 Data/Text/Array.hs+1−4 Data/Text/Encoding.hs+11−95 Data/Text/Encoding/Error.hs+1 Data/Text/Foreign.hs+2−5 Data/Text/IO.hs+1−20 Data/Text/Internal.hs+125−48 Data/Text/Internal/Builder.hs+5−47 Data/Text/Internal/Encoding/Fusion.hs+8−10 Data/Text/Internal/Encoding/Fusion/Common.hs+4−8 Data/Text/Internal/Fusion.hs+166−40 Data/Text/Internal/Fusion/CaseMapping.hs+4−164 Data/Text/Internal/Fusion/Common.hs+922−968 Data/Text/Internal/Fusion/Size.hs+7−33 Data/Text/Internal/Fusion/Types.hs+99−102 Data/Text/Internal/IO.hs−8 Data/Text/Internal/Lazy.hs+1−20 Data/Text/Internal/Lazy/Encoding/Fusion.hs−26 Data/Text/Internal/Lazy/Fusion.hs−62 Data/Text/Internal/Lazy/Search.hs+11−55 Data/Text/Internal/Private.hs+1−8 Data/Text/Internal/Search.hs+37−40 Data/Text/Lazy.hs+21−103 Data/Text/Lazy/Builder.hs+1 Data/Text/Lazy/Builder/Int.hs+1−3 Data/Text/Lazy/Builder/RealFloat.hs+15−20 Data/Text/Lazy/Encoding.hs+3−13 Data/Text/Lazy/IO.hs+1 Data/Text/Lazy/Read.hs+4−3 Data/Text/Read.hs+4−3 Data/Text/Show.hs−2 Data/Text/Unsafe.hs+1−89 README.markdown+16−5 benchmarks/.gitignore+1−4 benchmarks/cabal.project−2 benchmarks/haskell/Benchmarks.hs−2 benchmarks/haskell/Benchmarks/Concat.hs−25 benchmarks/text-benchmarks.cabal+8−82 cabal.project−3 cbits/cbits.c+11−6 changelog.md+19−61 tests-and-benchmarks.markdown+8−13 tests/Makefile+1−6 tests/Tests/Properties.hs+21−94 tests/Tests/QuickCheckUtils.hs+1−1 tests/Tests/Regressions.hs−11 tests/text-tests.cabal+3−18 text.cabal+62−139
.gitignore+3−10
@@ -1,10 +1,3 @@
1−/dist/
2−/dist-boot/
3−/dist-install/
4−/dist-newstyle/
5−/cabal-dev/
6−/cabal.sandbox.config
7−/ghc.mk
8−/GNUmakefile
9−/.ghc.environment.*
10−/cabal.project.local
1+dist
2+cabal-dev
3+cabal.sandbox.config
.hgtags−1
@@ -64,4 +64,3 @@ f8a60279237c1c28e094868740d9188dd94fcc9e 1.2.0.0
6464631fd055e27fa10983e17e9ad36d1b285b85c661 1.2.1.3
65658221a68ed5ec37028357df9c6c25f52320e54ad9 1.2.2.0
6666ce1c5ac65eb9f5580114b4e380092b05a485e95d 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−690
@@ -6,7 +6,7 @@
66#if __GLASGOW_HASKELL__ >= 708
77{-# LANGUAGE TypeFamilies #-}
88#endif
9−{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI, UnliftedFFITypes #-}
9+
1010-- |
1111-- Module : Data.Text
1212-- Copyright : (c) 2009, 2010, 2011, 2012 Bryan O'Sullivan,
@@ -15,6 +15,7 @@
1515--
1616-- License : BSD-style
1717-- Maintainer : bos@serpentine.com
18+-- Stability : experimental
1819-- Portability : GHC
1920--
2021-- A time and space-efficient implementation of Unicode text.
@@ -31,9 +32,8 @@
3132--
3233-- To use an extended and very rich family of functions for working
3334-- with Unicode text (including normalization, regular expressions,
34−-- non-standard encodings, text breaking, and locales), see the
35−-- <http://hackage.haskell.org/package/text-icu text-icu package >.
36−--
35+-- non-standard encodings, text breaking, and locales), see
36+-- <http://hackage.haskell.org/package/text-icu the text-icu package >.
3737
3838module Data.Text
3939 (
@@ -43,9 +43,6 @@ module Data.Text
4343 -- * Acceptable data
4444 -- $replacement
4545
46− -- * Definition of character
47− -- $character_definition
48−
4946 -- * Fusion
5047 -- $fusion
5148
@@ -63,7 +60,6 @@ module Data.Text
6360 , snoc
6461 , append
6562 , uncons
66− , unsnoc
6763 , head
6864 , last
6965 , tail
@@ -227,17 +223,16 @@ import qualified Data.Text.Internal.Fusion as S
227223import qualified Data.Text.Internal.Fusion.Common as S
228224import Data.Text.Encoding (decodeUtf8', encodeUtf8)
229225import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
230−-- import Data.Text.Internal.Private (span_)
231−import Data.Text.Internal (Text(..), empty, empty_, firstf, mul, safe, text)
232−-- import Data.Text.Show (singleton, unpack, unpackCString#)
226+import Data.Text.Internal.Private (span_)
227+import Data.Text.Internal (Text(..), empty, firstf, mul, safe, text)
228+import Data.Text.Show (singleton, unpack, unpackCString#)
233229import qualified Prelude as P
234230import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
235− reverseIter_, unsafeHead, unsafeTail,
236− unsafeDupablePerformIO)
231+ reverseIter_, unsafeHead, unsafeTail)
237232import Data.Text.Internal.Unsafe.Char (unsafeChr)
238233import qualified Data.Text.Internal.Functions as F
239234import qualified Data.Text.Internal.Encoding.Utf16 as U16
240−-- import Data.Text.Internal.Search (indices)
235+import Data.Text.Internal.Search (indices)
241236#if defined(__HADDOCK__)
242237import Data.ByteString (ByteString)
243238import qualified Data.Text.Lazy as L
@@ -251,68 +246,6 @@ import qualified GHC.Exts as Exts
251246import Text.Printf (PrintfArg, formatArg, formatString)
252247#endif
253248
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−
316249-- $strict
317250--
318251-- This package provides both strict and lazy 'Text' types. The
@@ -388,31 +321,22 @@ unpackCString# addr# = Text $ SJS.unstream (SJS.streamCString# addr#)
388321-- Functions that can be fused by the compiler are documented with the
389322-- phrase \"Subject to fusion\".
390323
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 (==) #-}
396324instance Eq Text where
397− Text x == Text y = x == y
398−
399−-- instance Ord Text where
400−-- compare = compareText
325+ Text arrA offA lenA == Text arrB offB lenB
326+ | lenA == lenB = A.equal arrA offA arrB offB lenA
327+ | otherwise = False
328+ {-# INLINE (==) #-}
401329
402330instance Ord Text where
403− compare (Text x) (Text y) = compare x y
331+ compare = compareText
404332
405333instance Read Text where
406334 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
407335
408336#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
411−-- provided by
412−-- the [semigroups](http://hackage.haskell.org/package/semigroups)
413−-- package
414−--
415−-- @since 1.2.2.0
337+-- Semigroup orphan instances for older GHCs are provided by
338+-- 'semigroups` package
339+
416340instance Semigroup Text where
417341 (<>) = append
418342#endif
@@ -430,7 +354,6 @@ instance IsString Text where
430354 fromString = pack
431355
432356#if __GLASGOW_HASKELL__ >= 708
433−-- | @since 1.2.0.0
434357instance Exts.IsList Text where
435358 type Item Text = Char
436359 fromList = pack
@@ -441,7 +364,6 @@ instance Exts.IsList Text where
441364instance NFData Text where rnf !_ = ()
442365#endif
443366
444−-- | @since 1.2.1.0
445367instance Binary Text where
446368 put t = put (encodeUtf8 t)
447369 get = do
@@ -475,10 +397,8 @@ instance Data Text where
475397
476398#if MIN_VERSION_base(4,7,0)
477399-- | Only defined for @base-4.7.0.0@ and later
478−--
479−-- @since 1.2.2.0
480400instance PrintfArg Text where
481− formatArg t = formatString $ unpack t
401+ formatArg txt = formatString $ unpack txt
482402#endif
483403
484404packConstr :: Constr
@@ -487,19 +407,19 @@ packConstr = mkConstr textDataType "pack" [] Prefix
487407textDataType :: DataType
488408textDataType = mkDataType "Data.Text.Text" [packConstr]
489409
490−-- -- | /O(n)/ Compare two 'Text' values lexicographically.
491−-- compareText :: Text -> Text -> Ordering
492−-- compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)
493−-- | lenA == 0 && lenB == 0 = EQ
494−-- | otherwise = go 0 0
495−-- where
496−-- go !i !j
497−-- | i >= lenA || j >= lenB = compare lenA lenB
498−-- | a < b = LT
499−-- | a > b = GT
500−-- | otherwise = go (i+di) (j+dj)
501−-- where Iter a di = iter ta i
502−-- Iter b dj = iter tb j
410+-- | /O(n)/ Compare two 'Text' values lexicographically.
411+compareText :: Text -> Text -> Ordering
412+compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)
413+ | lenA == 0 && lenB == 0 = EQ
414+ | otherwise = go 0 0
415+ where
416+ go !i !j
417+ | i >= lenA || j >= lenB = compare lenA lenB
418+ | a < b = LT
419+ | a > b = GT
420+ | otherwise = go (i+di) (j+dj)
421+ where Iter a di = iter ta i
422+ Iter b dj = iter tb j
503423
504424-- -----------------------------------------------------------------------------
505425-- * Conversion to/from 'Text'
@@ -507,8 +427,7 @@ textDataType = mkDataType "Data.Text.Text" [packConstr]
507427-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to
508428-- fusion. Performs replacement on invalid scalar values.
509429pack :: String -> Text
510−pack = coerce JSS.pack
511−-- pack = unstream . S.map safe . S.streamList
430+pack = unstream . S.map safe . S.streamList
512431{-# INLINE [1] pack #-}
513432
514433-- -----------------------------------------------------------------------------
@@ -519,8 +438,7 @@ pack = coerce JSS.pack
519438-- copying a new array. Subject to fusion. Performs replacement on
520439-- invalid scalar values.
521440cons :: 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))
524442{-# INLINE cons #-}
525443
526444infixr 5 `cons`
@@ -529,27 +447,25 @@ infixr 5 `cons`
529447-- entire array in the process, unless fused. Subject to fusion.
530448-- Performs replacement on invalid scalar values.
531449snoc :: 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))
534451{-# INLINE snoc #-}
535452
536453-- | /O(n)/ Appends one 'Text' to the other by copying both of them
537454-- into a new 'Text'. Subject to fusion.
538455append :: Text -> Text -> Text
539−append = coerce JSS.append
540−-- append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
541−-- | len1 == 0 = b
542−-- | len2 == 0 = a
543−-- | len > 0 = Text (A.run x) 0 len
544−-- | otherwise = overflowError "append"
545−-- where
546−-- len = len1+len2
547−-- x :: ST s (A.MArray s)
548−-- x = do
549−-- arr <- A.new len
550−-- A.copyI arr 0 arr1 off1 len1
551−-- A.copyI arr len1 arr2 off2 len
552−-- return arr
456+append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
457+ | len1 == 0 = b
458+ | len2 == 0 = a
459+ | len > 0 = Text (A.run x) 0 len
460+ | otherwise = overflowError "append"
461+ where
462+ len = len1+len2
463+ x :: ST s (A.MArray s)
464+ x = do
465+ arr <- A.new len
466+ A.copyI arr 0 arr1 off1 len1
467+ A.copyI arr len1 arr2 off2 len
468+ return arr
553469{-# NOINLINE append #-}
554470
555471{-# RULES
@@ -562,18 +478,16 @@ append = coerce JSS.append
562478-- | /O(1)/ Returns the first character of a 'Text', which must be
563479-- non-empty. Subject to fusion.
564480head :: Text -> Char
565−head = coerce JSS.head
566−-- head t = S.head (stream t)
481+head t = S.head (stream t)
567482{-# INLINE head #-}
568483
569484-- | /O(1)/ Returns the first character and rest of a 'Text', or
570485-- 'Nothing' if empty. Subject to fusion.
571486uncons :: Text -> Maybe (Char, Text)
572−uncons = coerce JSS.uncons
573−-- uncons t@(Text arr off len)
574−-- | len <= 0 = Nothing
575−-- | otherwise = Just $ let !(Iter c d) = iter t 0
576−-- in (c, text arr (off+d) (len-d))
487+uncons t@(Text arr off len)
488+ | len <= 0 = Nothing
489+ | otherwise = Just $ let !(Iter c d) = iter t 0
490+ in (c, text arr (off+d) (len-d))
577491{-# INLINE [1] uncons #-}
578492
579493-- | Lifted from Control.Arrow and specialized.
@@ -583,13 +497,12 @@ second f (a, b) = (a, f b)
583497-- | /O(1)/ Returns the last character of a 'Text', which must be
584498-- non-empty. Subject to fusion.
585499last :: Text -> Char
586−last = coerce JSS.last
587−-- last (Text arr off len)
588−-- | len <= 0 = emptyError "last"
589−-- | n < 0xDC00 || n > 0xDFFF = unsafeChr n
590−-- | otherwise = U16.chr2 n0 n
591−-- where n = A.unsafeIndex arr (off+len-1)
592−-- n0 = A.unsafeIndex arr (off+len-2)
500+last (Text arr off len)
501+ | len <= 0 = emptyError "last"
502+ | n < 0xDC00 || n > 0xDFFF = unsafeChr n
503+ | otherwise = U16.chr2 n0 n
504+ where n = A.unsafeIndex arr (off+len-1)
505+ n0 = A.unsafeIndex arr (off+len-2)
593506{-# INLINE [1] last #-}
594507
595508{-# RULES
@@ -602,11 +515,10 @@ last = coerce JSS.last
602515-- | /O(1)/ Returns all characters after the head of a 'Text', which
603516-- must be non-empty. Subject to fusion.
604517tail :: Text -> Text
605−tail = coerce JSS.tail
606−-- tail t@(Text arr off len)
607−-- | len <= 0 = emptyError "tail"
608−-- | otherwise = text arr (off+d) (len-d)
609−-- where d = iter_ t 0
518+tail t@(Text arr off len)
519+ | len <= 0 = emptyError "tail"
520+ | otherwise = text arr (off+d) (len-d)
521+ where d = iter_ t 0
610522{-# INLINE [1] tail #-}
611523
612524{-# RULES
@@ -619,12 +531,11 @@ tail = coerce JSS.tail
619531-- | /O(1)/ Returns all but the last character of a 'Text', which must
620532-- be non-empty. Subject to fusion.
621533init :: Text -> Text
622−init = coerce JSS.init
623−-- init (Text arr off len) | len <= 0 = emptyError "init"
624−-- | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)
625−-- | otherwise = text arr off (len-1)
626−-- where
627−-- n = A.unsafeIndex arr (off+len-1)
534+init (Text arr off len) | len <= 0 = emptyError "init"
535+ | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)
536+ | otherwise = text arr off (len-1)
537+ where
538+ n = A.unsafeIndex arr (off+len-1)
628539{-# INLINE [1] init #-}
629540
630541{-# RULES
@@ -634,29 +545,14 @@ init = coerce JSS.init
634545 unstream (S.init (stream t)) = init t
635546 #-}
636547
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 = coerce JSS.unsnoc
643−-- unsnoc (Text arr off len)
644−-- | len <= 0 = Nothing
645−-- | n < 0xDC00 || n > 0xDFFF = Just (text arr off (len-1), unsafeChr n)
646−-- | otherwise = Just (text arr off (len-2), U16.chr2 n0 n)
647−-- where n = A.unsafeIndex arr (off+len-1)
648−-- n0 = A.unsafeIndex arr (off+len-2)
649−{-# INLINE [1] unsnoc #-}
650−
651548-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
652549-- fusion.
653550null :: Text -> Bool
654−null = coerce JSS.null
655−-- null (Text _arr _off len) =
656−-- #if defined(ASSERTS)
657−-- assert (len >= 0) $
658−-- #endif
659−-- len <= 0
551+null (Text _arr _off len) =
552+#if defined(ASSERTS)
553+ assert (len >= 0) $
554+#endif
555+ len <= 0
660556{-# INLINE [1] null #-}
661557
662558{-# RULES
@@ -668,15 +564,14 @@ null = coerce JSS.null
668564
669565-- | /O(1)/ Tests whether a 'Text' contains exactly one character.
670566-- Subject to fusion.
671−-- isSingleton :: Text -> Bool
672−-- isSingleton = S.isSingleton . stream
673−-- {-# INLINE isSingleton #-}
567+isSingleton :: Text -> Bool
568+isSingleton = S.isSingleton . stream
569+{-# INLINE isSingleton #-}
674570
675571-- | /O(n)/ Returns the number of characters in a 'Text'.
676572-- Subject to fusion.
677573length :: Text -> Int
678−length = coerce JSS.length
679−-- length t = S.length (stream t)
574+length t = S.length (stream t)
680575{-# INLINE [0] length #-}
681576-- length needs to be phased after the compareN/length rules otherwise
682577-- it may inline before the rules have an opportunity to fire.
@@ -729,58 +624,29 @@ compareLength t n = S.compareLengthI (stream t) n
729624-- -----------------------------------------------------------------------------
730625-- * Transformations
731626-- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to
732−-- each element of @t@.
733−--
734−-- Example:
735−--
736−-- >>> let message = pack "I am not angry. Not at all."
737−-- >>> T.map (\c -> if c == '.' then '!' else c) message
738−-- "I am not angry! Not at all!"
739−--
740−-- Subject to fusion. Performs replacement on invalid scalar values.
627+-- each element of @t@. Subject to fusion. Performs replacement on
628+-- invalid scalar values.
741629map :: (Char -> Char) -> Text -> Text
742−map = coerce JSS.map
743−-- map f t = unstream (S.map (safe . f) (stream t))
630+map f t = unstream (S.map (safe . f) (stream t))
744631{-# INLINE [1] map #-}
745632
746633-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of
747634-- 'Text's and concatenates the list after interspersing the first
748635-- argument between each element of the list.
749−--
750−-- Example:
751−--
752−-- >>> T.intercalate "NI!" ["We", "seek", "the", "Holy", "Grail"]
753−-- "WeNI!seekNI!theNI!HolyNI!Grail"
754636intercalate :: Text -> [Text] -> Text
755−intercalate = coerce JSS.intercalate
756−-- intercalate t = concat . (F.intersperse t)
637+intercalate t = concat . (F.intersperse t)
757638{-# INLINE intercalate #-}
758639
759640-- | /O(n)/ The 'intersperse' function takes a character and places it
760−-- between the characters of a 'Text'.
761−--
762−-- Example:
763−--
764−-- >>> T.intersperse '.' "SHIELD"
765−-- "S.H.I.E.L.D"
766−--
767−-- Subject to fusion. Performs replacement on invalid scalar values.
641+-- between the characters of a 'Text'. Subject to fusion. Performs
642+-- replacement on invalid scalar values.
768643intersperse :: Char -> Text -> Text
769−intersperse = coerce JSS.intersperse
770−-- intersperse c t = unstream (S.intersperse (safe c) (stream t))
644+intersperse c t = unstream (S.intersperse (safe c) (stream t))
771645{-# INLINE intersperse #-}
772646
773−-- | /O(n)/ Reverse the characters of a string.
774−--
775−-- Example:
776−--
777−-- >>> T.reverse "desrever"
778−-- "reversed"
779−--
780−-- Subject to fusion.
647+-- | /O(n)/ Reverse the characters of a string. Subject to fusion.
781648reverse :: Text -> Text
782−reverse = coerce JSS.reverse
783−-- reverse t = S.reverse (stream t)
649+reverse t = S.reverse (stream t)
784650{-# INLINE reverse #-}
785651
786652-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
@@ -797,14 +663,12 @@ reverse = coerce JSS.reverse
797663-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
798664-- be replaced recursively:
799665--
800−-- >>> replace "oo" "foo" "oo"
801−-- "foo"
666+-- > replace "oo" "foo" "oo" == "foo"
802667--
803668-- In cases where several instances of @needle@ overlap, only the
804669-- first one will be replaced:
805670--
806−-- >>> replace "ofo" "bar" "ofofo"
807−-- "barfo"
671+-- > replace "ofo" "bar" "ofofo" == "barfo"
808672--
809673-- In (unlikely) bad cases, this function's time complexity degrades
810674-- towards /O(n*m)/.
@@ -816,29 +680,28 @@ replace :: Text
816680 -> Text
817681 -- ^ @haystack@ in which to search.
818682 -> Text
819−replace = coerce JSS.replace
820−-- replace needle@(Text _ _ neeLen)
821−-- (Text repArr repOff repLen)
822−-- haystack@(Text hayArr hayOff hayLen)
823−-- | neeLen == 0 = emptyError "replace"
824−-- | L.null ixs = haystack
825−-- | len > 0 = Text (A.run x) 0 len
826−-- | otherwise = empty
827−-- where
828−-- ixs = indices needle haystack
829−-- len = hayLen - (neeLen - repLen) `mul` L.length ixs
830−-- x :: ST s (A.MArray s)
831−-- x = do
832−-- marr <- A.new len
833−-- let loop (i:is) o d = do
834−-- let d0 = d + i - o
835−-- d1 = d0 + repLen
836−-- A.copyI marr d hayArr (hayOff+o) d0
837−-- A.copyI marr d0 repArr repOff d1
838−-- loop is (i + neeLen) d1
839−-- loop [] o d = A.copyI marr d hayArr (hayOff+o) len
840−-- loop ixs 0 0
841−-- return marr
683+replace needle@(Text _ _ neeLen)
684+ (Text repArr repOff repLen)
685+ haystack@(Text hayArr hayOff hayLen)
686+ | neeLen == 0 = emptyError "replace"
687+ | L.null ixs = haystack
688+ | len > 0 = Text (A.run x) 0 len
689+ | otherwise = empty
690+ where
691+ ixs = indices needle haystack
692+ len = hayLen - (neeLen - repLen) `mul` L.length ixs
693+ x :: ST s (A.MArray s)
694+ x = do
695+ marr <- A.new len
696+ let loop (i:is) o d = do
697+ let d0 = d + i - o
698+ d1 = d0 + repLen
699+ A.copyI marr d hayArr (hayOff+o) d0
700+ A.copyI marr d0 repArr repOff d1
701+ loop is (i + neeLen) d1
702+ loop [] o d = A.copyI marr d hayArr (hayOff+o) len
703+ loop ixs 0 0
704+ return marr
842705
843706-- ----------------------------------------------------------------------------
844707-- ** Case conversions (folds)
@@ -877,8 +740,7 @@ replace = coerce JSS.replace
877740-- U+00B5) is case folded to \"&#x3bc;\" (small letter mu, U+03BC)
878741-- instead of itself.
879742toCaseFold :: Text -> Text
880−-- toCaseFold t = unstream (S.toCaseFold (stream t))
881−toCaseFold = coerce JSS.toCaseFold
743+toCaseFold t = unstream (S.toCaseFold (stream t))
882744{-# INLINE toCaseFold #-}
883745
884746-- | /O(n)/ Convert a string to lower case, using simple case
@@ -889,8 +751,7 @@ toCaseFold = coerce JSS.toCaseFold
889751-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)
890752-- followed by \" &#x307;\" (combining dot above, U+0307).
891753toLower :: Text -> Text
892−-- toLower t = unstream (S.toLower (stream t))
893−toLower = coerce JSS.toLower
754+toLower t = unstream (S.toLower (stream t))
894755{-# INLINE toLower #-}
895756
896757-- | /O(n)/ Convert a string to upper case, using simple case
@@ -900,8 +761,7 @@ toLower = coerce JSS.toLower
900761-- instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the
901762-- two-letter sequence \"SS\".
902763toUpper :: Text -> Text
903−-- toUpper t = unstream (S.toUpper (stream t))
904−toUpper = coerce JSS.toUpper
764+toUpper t = unstream (S.toUpper (stream t))
905765{-# INLINE toUpper #-}
906766
907767-- | /O(n)/ Convert a string to title case, using simple case
@@ -922,11 +782,8 @@ toUpper = coerce JSS.toUpper
922782-- guides disagree on whether the book name \"The Hill of the Red
923783-- Fox\" is correctly title cased&#x2014;but this function will
924784-- capitalize /every/ word.
925−--
926−-- @since 1.0.0.0
927785toTitle :: Text -> Text
928−toTitle = coerce JSS.toTitle
929−-- toTitle t = unstream (S.toTitle (stream t))
786+toTitle t = unstream (S.toTitle (stream t))
930787{-# INLINE toTitle #-}
931788
932789-- | /O(n)/ Left-justify a string to the given length, using the
@@ -935,17 +792,13 @@ toTitle = coerce JSS.toTitle
935792--
936793-- Examples:
937794--
938−-- >>> justifyLeft 7 'x' "foo"
939−-- "fooxxxx"
940−--
941−-- >>> justifyLeft 3 'x' "foobar"
942−-- "foobar"
795+-- > justifyLeft 7 'x' "foo" == "fooxxxx"
796+-- > justifyLeft 3 'x' "foobar" == "foobar"
943797justifyLeft :: Int -> Char -> Text -> Text
944−justifyLeft = coerce JSS.justifyLeft
945−-- justifyLeft k c t
946−-- | len >= k = t
947−-- | otherwise = t `append` replicateChar (k-len) c
948−-- where len = length t
798+justifyLeft k c t
799+ | len >= k = t
800+ | otherwise = t `append` replicateChar (k-len) c
801+ where len = length t
949802{-# INLINE [1] justifyLeft #-}
950803
951804{-# RULES
@@ -961,17 +814,13 @@ justifyLeft = coerce JSS.justifyLeft
961814--
962815-- Examples:
963816--
964−-- >>> justifyRight 7 'x' "bar"
965−-- "xxxxbar"
966−--
967−-- >>> justifyRight 3 'x' "foobar"
968−-- "foobar"
817+-- > justifyRight 7 'x' "bar" == "xxxxbar"
818+-- > justifyRight 3 'x' "foobar" == "foobar"
969819justifyRight :: Int -> Char -> Text -> Text
970−justifyRight = coerce JSS.justifyRight
971−-- justifyRight k c t
972−-- | len >= k = t
973−-- | otherwise = replicateChar (k-len) c `append` t
974−-- where len = length t
820+justifyRight k c t
821+ | len >= k = t
822+ | otherwise = replicateChar (k-len) c `append` t
823+ where len = length t
975824{-# INLINE justifyRight #-}
976825
977826-- | /O(n)/ Center a string to the given length, using the specified
@@ -980,34 +829,23 @@ justifyRight = coerce JSS.justifyRight
980829--
981830-- Examples:
982831--
983−-- >>> center 8 'x' "HS"
984−-- "xxxHSxxx"
832+-- > center 8 'x' "HS" = "xxxHSxxx"
985833center :: Int -> Char -> Text -> Text
986−center = coerce JSS.center
987−-- center k c t
988−-- | len >= k = t
989−-- | otherwise = replicateChar l c `append` t `append` replicateChar r c
990−-- where len = length t
991−-- d = k - len
992−-- r = d `quot` 2
993−-- l = d - r
834+center k c t
835+ | len >= k = t
836+ | otherwise = replicateChar l c `append` t `append` replicateChar r c
837+ where len = length t
838+ d = k - len
839+ r = d `quot` 2
840+ l = d - r
994841{-# INLINE center #-}
995842
996843-- | /O(n)/ The 'transpose' function transposes the rows and columns
997844-- of its 'Text' argument. Note that this function uses 'pack',
998845-- 'unpack', and the list version of transpose, and is thus not very
999846-- efficient.
1000−--
1001−-- Examples:
1002−--
1003−-- >>> transpose ["green","orange"]
1004−-- ["go","rr","ea","en","ng","e"]
1005−--
1006−-- >>> transpose ["blue","red"]
1007−-- ["br","le","ud","e"]
1008847transpose :: [Text] -> [Text]
1009−transpose = coerce JSS.transpose
1010−-- transpose ts = P.map pack (L.transpose (P.map unpack ts))
848+transpose ts = P.map pack (L.transpose (P.map unpack ts))
1011849
1012850-- -----------------------------------------------------------------------------
1013851-- * Reducing 'Text's (folds)
@@ -1017,27 +855,23 @@ transpose = coerce JSS.transpose
1017855-- reduces the 'Text' using the binary operator, from left to right.
1018856-- Subject to fusion.
1019857foldl :: (a -> Char -> a) -> a -> Text -> a
1020−foldl f a0 (Text t) = JSS.foldl f a0 t
1021−-- foldl f z t = S.foldl f z (stream t)
858+foldl f z t = S.foldl f z (stream t)
1022859{-# INLINE foldl #-}
1023860
1024861-- | /O(n)/ A strict version of 'foldl'. Subject to fusion.
1025862foldl' :: (a -> Char -> a) -> a -> Text -> a
1026−foldl' f a0 (Text t) = JSS.foldl' f a0 t
1027−-- foldl' f z t = S.foldl' f z (stream t)
863+foldl' f z t = S.foldl' f z (stream t)
1028864{-# INLINE foldl' #-}
1029865
1030866-- | /O(n)/ A variant of 'foldl' that has no starting value argument,
1031867-- and thus must be applied to a non-empty 'Text'. Subject to fusion.
1032868foldl1 :: (Char -> Char -> Char) -> Text -> Char
1033−foldl1 = coerce JSS.foldl1
1034−-- foldl1 f t = S.foldl1 f (stream t)
869+foldl1 f t = S.foldl1 f (stream t)
1035870{-# INLINE foldl1 #-}
1036871
1037872-- | /O(n)/ A strict version of 'foldl1'. Subject to fusion.
1038873foldl1' :: (Char -> Char -> Char) -> Text -> Char
1039−foldl1' = coerce JSS.foldl1'
1040−-- foldl1' f t = S.foldl1' f (stream t)
874+foldl1' f t = S.foldl1' f (stream t)
1041875{-# INLINE foldl1' #-}
1042876
1043877-- | /O(n)/ 'foldr', applied to a binary operator, a starting value
@@ -1045,16 +879,14 @@ foldl1' = coerce JSS.foldl1'
1045879-- reduces the 'Text' using the binary operator, from right to left.
1046880-- Subject to fusion.
1047881foldr :: (Char -> a -> a) -> a -> Text -> a
1048−foldr f a0 (Text t) = JSS.foldr f a0 t
1049−-- foldr f z t = S.foldr f z (stream t)
882+foldr f z t = S.foldr f z (stream t)
1050883{-# INLINE foldr #-}
1051884
1052885-- | /O(n)/ A variant of 'foldr' that has no starting value argument,
1053886-- and thus must be applied to a non-empty 'Text'. Subject to
1054887-- fusion.
1055888foldr1 :: (Char -> Char -> Char) -> Text -> Char
1056−foldr1 = coerce JSS.foldr1
1057−-- foldr1 f t = S.foldr1 f (stream t)
889+foldr1 f t = S.foldr1 f (stream t)
1058890{-# INLINE foldr1 #-}
1059891
1060892-- -----------------------------------------------------------------------------
@@ -1062,54 +894,48 @@ foldr1 = coerce JSS.foldr1
1062894
1063895-- | /O(n)/ Concatenate a list of 'Text's.
1064896concat :: [Text] -> Text
1065−concat = coerce JSS.concat
1066−-- concat ts = case ts' of
1067−-- [] -> empty
1068−-- [t] -> t
1069−-- _ -> Text (A.run go) 0 len
1070−-- where
1071−-- ts' = L.filter (not . null) ts
1072−-- len = sumP "concat" $ L.map lengthWord16 ts'
1073−-- go :: ST s (A.MArray s)
1074−-- go = do
1075−-- arr <- A.new len
1076−-- let step i (Text a o l) =
1077−-- let !j = i + l in A.copyI arr i a o j >> return j
1078−-- foldM step 0 ts' >> return arr
897+concat ts = case ts' of
898+ [] -> empty
899+ [t] -> t
900+ _ -> Text (A.run go) 0 len
901+ where
902+ ts' = L.filter (not . null) ts
903+ len = sumP "concat" $ L.map lengthWord16 ts'
904+ go :: ST s (A.MArray s)
905+ go = do
906+ arr <- A.new len
907+ let step i (Text a o l) =
908+ let !j = i + l in A.copyI arr i a o j >> return j
909+ foldM step 0 ts' >> return arr
1079910
1080911-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and
1081912-- concatenate the results.
1082913concatMap :: (Char -> Text) -> Text -> Text
1083−concatMap = coerce JSS.concatMap
1084−-- concatMap f = concat . foldr ((:) . f) []
914+concatMap f = concat . foldr ((:) . f) []
1085915{-# INLINE concatMap #-}
1086916
1087917-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
1088918-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
1089919any :: (Char -> Bool) -> Text -> Bool
1090−any = coerce JSS.any
1091−-- any p t = S.any p (stream t)
920+any p t = S.any p (stream t)
1092921{-# INLINE any #-}
1093922
1094923-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
1095924-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
1096925all :: (Char -> Bool) -> Text -> Bool
1097−all = coerce JSS.all
1098−-- all p t = S.all p (stream t)
926+all p t = S.all p (stream t)
1099927{-# INLINE all #-}
1100928
1101929-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which
1102930-- must be non-empty. Subject to fusion.
1103931maximum :: Text -> Char
1104−maximum = coerce JSS.maximum
1105−-- maximum t = S.maximum (stream t)
932+maximum t = S.maximum (stream t)
1106933{-# INLINE maximum #-}
1107934
1108935-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which
1109936-- must be non-empty. Subject to fusion.
1110937minimum :: Text -> Char
1111−minimum = coerce JSS.minimum
1112−-- minimum t = S.minimum (stream t)
938+minimum t = S.minimum (stream t)
1113939{-# INLINE minimum #-}
1114940
1115941-- -----------------------------------------------------------------------------
@@ -1125,9 +951,8 @@ minimum = coerce JSS.minimum
1125951--
1126952-- > last (scanl f z xs) == foldl f z xs.
1127953scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
1128−scanl = coerce JSS.scanl
1129−-- scanl f z t = unstream (S.scanl g z (stream t))
1130−-- where g a b = safe (f a b)
954+scanl f z t = unstream (S.scanl g z (stream t))
955+ where g a b = safe (f a b)
1131956{-# INLINE scanl #-}
1132957
1133958-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting
@@ -1136,9 +961,8 @@ scanl = coerce JSS.scanl
1136961--
1137962-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
1138963scanl1 :: (Char -> Char -> Char) -> Text -> Text
1139−scanl1 = coerce JSS.scanl1
1140−-- scanl1 f t | null t = empty
1141−-- | otherwise = scanl f (unsafeHead t) (unsafeTail t)
964+scanl1 f t | null t = empty
965+ | otherwise = scanl f (unsafeHead t) (unsafeTail t)
1142966{-# INLINE scanl1 #-}
1143967
1144968-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'. Performs
@@ -1146,18 +970,16 @@ scanl1 = coerce JSS.scanl1
1146970--
1147971-- > scanr f v == reverse . scanl (flip f) v . reverse
1148972scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
1149−scanr = coerce JSS.scanr
1150−-- scanr f z = S.reverse . S.reverseScanr g z . reverseStream
1151−-- where g a b = safe (f a b)
973+scanr f z = S.reverse . S.reverseScanr g z . reverseStream
974+ where g a b = safe (f a b)
1152975{-# INLINE scanr #-}
1153976
1154977-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting
1155978-- value argument. Subject to fusion. Performs replacement on
1156979-- invalid scalar values.
1157980scanr1 :: (Char -> Char -> Char) -> Text -> Text
1158−scanr1 = coerce JSS.scanr1
1159−-- scanr1 f t | null t = empty
1160−-- | otherwise = scanr f (last t) (init t)
981+scanr1 f t | null t = empty
982+ | otherwise = scanr f (last t) (init t)
1161983{-# INLINE scanr1 #-}
1162984
1163985-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
@@ -1165,11 +987,8 @@ scanr1 = coerce JSS.scanr1
1165987-- parameter from left to right, and returns a final 'Text'. Performs
1166988-- replacement on invalid scalar values.
1167989mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
1168−mapAccumL f z0 (Text a) =
1169− let (a', t) = JSS.mapAccumL f z0 a
1170− in (a', Text t)
1171−-- mapAccumL f z0 = S.mapAccumL g z0 . stream
1172−-- where g a b = second safe (f a b)
990+mapAccumL f z0 = S.mapAccumL g z0 . stream
991+ where g a b = second safe (f a b)
1173992{-# INLINE mapAccumL #-}
1174993
1175994-- | The 'mapAccumR' function behaves like a combination of 'map' and
@@ -1179,11 +998,8 @@ mapAccumL f z0 (Text a) =
1179998-- 'Text'.
1180999-- Performs replacement on invalid scalar values.
11811000mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
1182−mapAccumR f z0 (Text a) =
1183− let (a', t) = JSS.mapAccumR f z0 a
1184− in (a', Text t)
1185−-- mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream
1186−-- where g a b = second safe (f a b)
1001+mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream
1002+ where g a b = second safe (f a b)
11871003{-# INLINE mapAccumR #-}
11881004
11891005-- -----------------------------------------------------------------------------
@@ -1192,21 +1008,20 @@ mapAccumR f z0 (Text a) =
11921008-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
11931009-- @t@ repeated @n@ times.
11941010replicate :: Int -> Text -> Text
1195−replicate = coerce JSS.replicate
1196−-- replicate n t@(Text a o l)
1197−-- | n <= 0 || l <= 0 = empty
1198−-- | n == 1 = t
1199−-- | isSingleton t = replicateChar n (unsafeHead t)
1200−-- | otherwise = Text (A.run x) 0 len
1201−-- where
1202−-- len = l `mul` n
1203−-- x :: ST s (A.MArray s)
1204−-- x = do
1205−-- arr <- A.new len
1206−-- let loop !d !i | i >= n = return arr
1207−-- | otherwise = let m = d + l
1208−-- in A.copyI arr d a o m >> loop m (i+1)
1209−-- loop 0 0
1011+replicate n t@(Text a o l)
1012+ | n <= 0 || l <= 0 = empty
1013+ | n == 1 = t
1014+ | isSingleton t = replicateChar n (unsafeHead t)
1015+ | otherwise = Text (A.run x) 0 len
1016+ where
1017+ len = l `mul` n
1018+ x :: ST s (A.MArray s)
1019+ x = do
1020+ arr <- A.new len
1021+ let loop !d !i | i >= n = return arr
1022+ | otherwise = let m = d + l
1023+ in A.copyI arr d a o m >> loop m (i+1)
1024+ loop 0 0
12101025{-# INLINE [1] replicate #-}
12111026
12121027{-# RULES
@@ -1217,19 +1032,8 @@ replicate = coerce JSS.replicate
12171032-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
12181033-- value of every element. Subject to fusion.
12191034replicateChar :: Int -> Char -> Text
1220−#ifndef __GHCJS__
12211035replicateChar n c = unstream (S.replicateCharI n (safe c))
12221036{-# INLINE replicateChar #-}
1223−#else
1224−replicateChar n c = Text $ js_replicateChar n c
1225−{-# INLINE [1] replicateChar #-}
1226−{-# RULES
1227−"JSSTRING replicateChar -> fused" [~1] forall n c.
1228− replicateChar n c = unstream (S.replicateCharI n (safe c))
1229−"JSSTRING replicateChar -> unfused" [1] forall n c.
1230− unstream (S.replicateCharI n (safe c)) = replicateChar n c
1231− #-}
1232−#endif
12331037
12341038-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'
12351039-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a
@@ -1239,8 +1043,7 @@ replicateChar n c = Text $ js_replicateChar n c
12391043-- string, and @b@ is the seed value for further production. Subject
12401044-- to fusion. Performs replacement on invalid scalar values.
12411045unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
1242−unfoldr f a = Text $ JSS.unfoldr f a
1243−-- unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
1046+unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
12441047{-# INLINE unfoldr #-}
12451048
12461049-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed
@@ -1250,8 +1053,7 @@ unfoldr f a = Text $ JSS.unfoldr f a
12501053-- correct, otherwise its performance is similar to 'unfoldr'. Subject
12511054-- to fusion. Performs replacement on invalid scalar values.
12521055unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text
1253−unfoldrN n f a0 = Text $ JSS.unfoldrN n f a0
1254−-- 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)
12551057{-# INLINE unfoldrN #-}
12561058
12571059-- -----------------------------------------------------------------------------
@@ -1261,19 +1063,18 @@ unfoldrN n f a0 = Text $ JSS.unfoldrN n f a0
12611063-- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than
12621064-- the length of the Text. Subject to fusion.
12631065take :: Int -> Text -> Text
1264−take = coerce JSS.take
1265−-- take n t@(Text arr off len)
1266−-- | n <= 0 = empty
1267−-- | n >= len = t
1268−-- | otherwise = text arr off (iterN n t)
1066+take n t@(Text arr off len)
1067+ | n <= 0 = empty
1068+ | n >= len = t
1069+ | otherwise = text arr off (iterN n t)
12691070{-# INLINE [1] take #-}
12701071
1271−-- iterN :: Int -> Text -> Int
1272−-- iterN n t@(Text _arr _off len) = loop 0 0
1273−-- where loop !i !cnt
1274−-- | i >= len || cnt >= n = i
1275−-- | otherwise = loop (i+d) (cnt+1)
1276−-- where d = iter_ t i
1072+iterN :: Int -> Text -> Int
1073+iterN n t@(Text _arr _off len) = loop 0 0
1074+ where loop !i !cnt
1075+ | i >= len || cnt >= n = i
1076+ | otherwise = loop (i+d) (cnt+1)
1077+ where d = iter_ t i
12771078
12781079{-# RULES
12791080"TEXT take -> fused" [~1] forall n t.
@@ -1287,36 +1088,31 @@ take = coerce JSS.take
12871088--
12881089-- Examples:
12891090--
1290−-- >>> takeEnd 3 "foobar"
1291−-- "bar"
1292−--
1293−-- @since 1.1.1.0
1091+-- > takeEnd 3 "foobar" == "bar"
12941092takeEnd :: Int -> Text -> Text
1295−takeEnd = coerce JSS.takeEnd
1296−-- takeEnd n t@(Text arr off len)
1297−-- | n <= 0 = empty
1298−-- | n >= len = t
1299−-- | otherwise = text arr (off+i) (len-i)
1300−-- where i = iterNEnd n t
1301−
1302−-- iterNEnd :: Int -> Text -> Int
1303−-- iterNEnd n t@(Text _arr _off len) = loop (len-1) n
1304−-- where loop i !m
1305−-- | i <= 0 = 0
1306−-- | m <= 1 = i
1307−-- | otherwise = loop (i+d) (m-1)
1308−-- where d = reverseIter_ t i
1093+takeEnd n t@(Text arr off len)
1094+ | n <= 0 = empty
1095+ | n >= len = t
1096+ | otherwise = text arr (off+i) (len-i)
1097+ where i = iterNEnd n t
1098+
1099+iterNEnd :: Int -> Text -> Int
1100+iterNEnd n t@(Text _arr _off len) = loop (len-1) n
1101+ where loop i !m
1102+ | i <= 0 = 0
1103+ | m <= 1 = i
1104+ | otherwise = loop (i+d) (m-1)
1105+ where d = reverseIter_ t i
13091106
13101107-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
13111108-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
13121109-- is greater than the length of the 'Text'. Subject to fusion.
13131110drop :: Int -> Text -> Text
1314−drop = coerce JSS.drop
1315−-- drop n t@(Text arr off len)
1316−-- | n <= 0 = t
1317−-- | n >= len = empty
1318−-- | otherwise = text arr (off+i) (len-i)
1319−-- where i = iterN n t
1111+drop n t@(Text arr off len)
1112+ | n <= 0 = t
1113+ | n >= len = empty
1114+ | otherwise = text arr (off+i) (len-i)
1115+ where i = iterN n t
13201116{-# INLINE [1] drop #-}
13211117
13221118{-# RULES
@@ -1331,27 +1127,22 @@ drop = coerce JSS.drop
13311127--
13321128-- Examples:
13331129--
1334−-- >>> dropEnd 3 "foobar"
1335−-- "foo"
1336−--
1337−-- @since 1.1.1.0
1130+-- > dropEnd 3 "foobar" == "foo"
13381131dropEnd :: Int -> Text -> Text
1339−dropEnd = coerce JSS.dropEnd
1340−-- dropEnd n t@(Text arr off len)
1341−-- | n <= 0 = t
1342−-- | n >= len = empty
1343−-- | otherwise = text arr off (iterNEnd n t)
1132+dropEnd n t@(Text arr off len)
1133+ | n <= 0 = t
1134+ | n >= len = empty
1135+ | otherwise = text arr off (iterNEnd n t)
13441136
13451137-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
13461138-- returns the longest prefix (possibly empty) of elements that
13471139-- satisfy @p@. Subject to fusion.
13481140takeWhile :: (Char -> Bool) -> Text -> Text
1349−takeWhile = coerce JSS.takeWhile
1350−-- takeWhile p t@(Text arr off len) = loop 0
1351−-- where loop !i | i >= len = t
1352−-- | p c = loop (i+d)
1353−-- | otherwise = text arr off i
1354−-- where Iter c d = iter t i
1141+takeWhile p t@(Text arr off len) = loop 0
1142+ where loop !i | i >= len = t
1143+ | p c = loop (i+d)
1144+ | otherwise = text arr off i
1145+ where Iter c d = iter t i
13551146{-# INLINE [1] takeWhile #-}
13561147
13571148{-# RULES
@@ -1366,25 +1157,13 @@ takeWhile = coerce JSS.takeWhile
13661157-- satisfy @p@. Subject to fusion.
13671158-- Examples:
13681159--
1369−-- >>> takeWhileEnd (=='o') "foo"
1370−-- "oo"
1371−--
1372−-- @since 1.2.2.0
1160+-- > takeWhileEnd (=='o') "foo" == "oo"
13731161takeWhileEnd :: (Char -> Bool) -> Text -> Text
1374−#ifndef __GHCJS__
13751162takeWhileEnd p t@(Text arr off len) = loop (len-1) len
13761163 where loop !i !l | l <= 0 = t
13771164 | p c = loop (i+d) (l+d)
13781165 | otherwise = text arr (off+l) (len-l)
13791166 where (c,d) = reverseIter t i
1380−#else
1381−takeWhileEnd p t@(Text jst) = loop (len-1) len
1382− where loop !i !l | l <= 0 = t
1383− | p c = loop (i+d) (l+d)
1384− | otherwise = Text $ js_substr1 l jst
1385− where (c,d) = reverseIter t i
1386− len = length t
1387−#endif
13881167{-# INLINE [1] takeWhileEnd #-}
13891168
13901169{-# RULES
@@ -1397,12 +1176,11 @@ takeWhileEnd p t@(Text jst) = loop (len-1) len
13971176-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
13981177-- 'takeWhile' @p@ @t@. Subject to fusion.
13991178dropWhile :: (Char -> Bool) -> Text -> Text
1400−dropWhile = coerce JSS.dropWhile
1401−-- dropWhile p t@(Text arr off len) = loop 0 0
1402−-- where loop !i !l | l >= len = empty
1403−-- | p c = loop (i+d) (l+d)
1404−-- | otherwise = Text arr (off+i) (len-l)
1405−
1179+dropWhile p t@(Text arr off len) = loop 0 0
1180+ where loop !i !l | l >= len = empty
1181+ | p c = loop (i+d) (l+d)
1182+ | otherwise = Text arr (off+i) (len-l)
1183+ where Iter c d = iter t i
14061184{-# INLINE [1] dropWhile #-}
14071185
14081186{-# RULES
@@ -1418,15 +1196,13 @@ dropWhile = coerce JSS.dropWhile
14181196--
14191197-- Examples:
14201198--
1421−-- >>> dropWhileEnd (=='.') "foo..."
1422−-- "foo"
1199+-- > dropWhileEnd (=='.') "foo..." == "foo"
14231200dropWhileEnd :: (Char -> Bool) -> Text -> Text
1424−dropWhileEnd = coerce JSS.dropWhileEnd
1425−-- dropWhileEnd p t@(Text arr off len) = loop (len-1) len
1426−-- where loop !i !l | l <= 0 = empty
1427−-- | p c = loop (i+d) (l+d)
1428−-- | otherwise = Text arr off l
1429−-- where (c,d) = reverseIter t i
1201+dropWhileEnd p t@(Text arr off len) = loop (len-1) len
1202+ where loop !i !l | l <= 0 = empty
1203+ | p c = loop (i+d) (l+d)
1204+ | otherwise = Text arr off l
1205+ where (c,d) = reverseIter t i
14301206{-# INLINE [1] dropWhileEnd #-}
14311207
14321208{-# RULES
@@ -1469,49 +1245,45 @@ strip = dropAround isSpace
14691245-- prefix of @t@ of length @n@, and whose second is the remainder of
14701246-- the string. It is equivalent to @('take' n t, 'drop' n t)@.
14711247splitAt :: Int -> Text -> (Text, Text)
1472−splitAt = coerce JSS.splitAt
1473−-- splitAt n t@(Text arr off len)
1474−-- | n <= 0 = (empty, t)
1475−-- | n >= len = (t, empty)
1476−-- | otherwise = let k = iterN n t
1477−-- in (text arr off k, text arr (off+k) (len-k))
1248+splitAt n t@(Text arr off len)
1249+ | n <= 0 = (empty, t)
1250+ | n >= len = (t, empty)
1251+ | otherwise = let k = iterN n t
1252+ in (text arr off k, text arr (off+k) (len-k))
14781253
14791254-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
14801255-- a pair whose first element is the longest prefix (possibly empty)
14811256-- of @t@ of elements that satisfy @p@, and whose second is the
14821257-- remainder of the list.
14831258span :: (Char -> Bool) -> Text -> (Text, Text)
1484−span = coerce JSS.span
1485−-- span p t = case span_ p t of
1486−-- (# hd,tl #) -> (hd,tl)
1259+span p t = case span_ p t of
1260+ (# hd,tl #) -> (hd,tl)
14871261{-# INLINE span #-}
14881262
14891263-- | /O(n)/ 'break' is like 'span', but the prefix returned is
14901264-- over elements that fail the predicate @p@.
14911265break :: (Char -> Bool) -> Text -> (Text, Text)
1492−break = coerce JSS.break
1493−-- break p = span (not . p)
1266+break p = span (not . p)
14941267{-# INLINE break #-}
14951268
14961269-- | /O(n)/ Group characters in a string according to a predicate.
14971270groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
1498−groupBy = coerce JSS.groupBy
1499−-- groupBy p = loop
1500−-- where
1501−-- loop t@(Text arr off len)
1502−-- | null t = []
1503−-- | otherwise = text arr off n : loop (text arr (off+n) (len-n))
1504−-- where Iter c d = iter t 0
1505−-- n = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))
1271+groupBy p = loop
1272+ where
1273+ loop t@(Text arr off len)
1274+ | null t = []
1275+ | otherwise = text arr off n : loop (text arr (off+n) (len-n))
1276+ where Iter c d = iter t 0
1277+ n = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))
15061278
15071279-- | Returns the /array/ index (in units of 'Word16') at which a
15081280-- character may be found. This is /not/ the same as the logical
15091281-- index returned by e.g. 'findIndex'.
1510−-- findAIndexOrEnd :: (Char -> Bool) -> Text -> Int
1511−-- findAIndexOrEnd q t@(Text _arr _off len) = go 0
1512−-- where go !i | i >= len || q c = i
1513−-- | otherwise = go (i+d)
1514−-- where Iter c d = iter t i
1282+findAIndexOrEnd :: (Char -> Bool) -> Text -> Int
1283+findAIndexOrEnd q t@(Text _arr _off len) = go 0
1284+ where go !i | i >= len || q c = i
1285+ | otherwise = go (i+d)
1286+ where Iter c d = iter t i
15151287
15161288-- | /O(n)/ Group characters in a string by equality.
15171289group :: Text -> [Text]
@@ -1520,17 +1292,15 @@ group = groupBy (==)
15201292-- | /O(n)/ Return all initial segments of the given 'Text', shortest
15211293-- first.
15221294inits :: Text -> [Text]
1523−inits = coerce JSS.inits
1524−-- inits t@(Text arr off len) = loop 0
1525−-- where loop i | i >= len = [t]
1526−-- | otherwise = Text arr off i : loop (i + iter_ t i)
1295+inits t@(Text arr off len) = loop 0
1296+ where loop i | i >= len = [t]
1297+ | otherwise = Text arr off i : loop (i + iter_ t i)
15271298
15281299-- | /O(n)/ Return all final segments of the given 'Text', longest
15291300-- first.
15301301tails :: Text -> [Text]
1531−tails = coerce JSS.tails
1532−-- tails t | null t = [empty]
1533−-- | otherwise = t : tails (unsafeTail t)
1302+tails t | null t = [empty]
1303+ | otherwise = t : tails (unsafeTail t)
15341304
15351305-- $split
15361306--
@@ -1544,14 +1314,9 @@ tails = coerce JSS.tails
15441314--
15451315-- Examples:
15461316--
1547−-- >>> splitOn "\r\n" "a\r\nb\r\nd\r\ne"
1548−-- ["a","b","d","e"]
1549−--
1550−-- >>> splitOn "aaa" "aaaXaaaXaaaXaaa"
1551−-- ["","X","X","X",""]
1552−--
1553−-- >>> splitOn "x" "x"
1554−-- ["",""]
1317+-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]
1318+-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]
1319+-- > splitOn "x" "x" == ["",""]
15551320--
15561321-- and
15571322--
@@ -1568,14 +1333,13 @@ splitOn :: Text
15681333 -> Text
15691334 -- ^ Input text.
15701335 -> [Text]
1571−splitOn = coerce JSS.splitOn
1572−-- splitOn pat@(Text _ _ l) src@(Text arr off len)
1573−-- | l <= 0 = emptyError "splitOn"
1574−-- | isSingleton pat = split (== unsafeHead pat) src
1575−-- | otherwise = go 0 (indices pat src)
1576−-- where
1577−-- go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs
1578−-- go s _ = [text arr (s+off) (len-s)]
1336+splitOn pat@(Text _ _ l) src@(Text arr off len)
1337+ | l <= 0 = emptyError "splitOn"
1338+ | isSingleton pat = split (== unsafeHead pat) src
1339+ | otherwise = go 0 (indices pat src)
1340+ where
1341+ go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs
1342+ go s _ = [text arr (s+off) (len-s)]
15791343{-# INLINE [1] splitOn #-}
15801344
15811345{-# RULES
@@ -1588,36 +1352,28 @@ splitOn = coerce JSS.splitOn
15881352-- resulting components do not contain the separators. Two adjacent
15891353-- separators result in an empty component in the output. eg.
15901354--
1591−-- >>> split (=='a') "aabbaca"
1592−-- ["","","bb","c",""]
1593−--
1594−-- >>> split (=='a') ""
1595−-- [""]
1355+-- > split (=='a') "aabbaca" == ["","","bb","c",""]
1356+-- > split (=='a') "" == [""]
15961357split :: (Char -> Bool) -> Text -> [Text]
1597−split = coerce JSS.split
1598−-- split _ t@(Text _off _arr 0) = [t]
1599−-- split p t = loop t
1600−-- where loop s | null s' = [l]
1601−-- | otherwise = l : loop (unsafeTail s')
1602−-- where (# l, s' #) = span_ (not . p) s
1358+split _ t@(Text _off _arr 0) = [t]
1359+split p t = loop t
1360+ where loop s | null s' = [l]
1361+ | otherwise = l : loop (unsafeTail s')
1362+ where (# l, s' #) = span_ (not . p) s
16031363{-# INLINE split #-}
16041364
16051365-- | /O(n)/ Splits a 'Text' into components of length @k@. The last
16061366-- element may be shorter than the other chunks, depending on the
16071367-- length of the input. Examples:
16081368--
1609−-- >>> chunksOf 3 "foobarbaz"
1610−-- ["foo","bar","baz"]
1611−--
1612−-- >>> chunksOf 4 "haskell.org"
1613−-- ["hask","ell.","org"]
1369+-- > chunksOf 3 "foobarbaz" == ["foo","bar","baz"]
1370+-- > chunksOf 4 "haskell.org" == ["hask","ell.","org"]
16141371chunksOf :: Int -> Text -> [Text]
1615−chunksOf = coerce JSS.chunksOf
1616−-- chunksOf k = go
1617−-- where
1618−-- go t = case splitAt k t of
1619−-- (a,b) | null a -> []
1620−-- | otherwise -> a : go b
1372+chunksOf k = go
1373+ where
1374+ go t = case splitAt k t of
1375+ (a,b) | null a -> []
1376+ | otherwise -> a : go b
16211377{-# INLINE chunksOf #-}
16221378
16231379-- ----------------------------------------------------------------------------
@@ -1630,8 +1386,7 @@ chunksOf = coerce JSS.chunksOf
16301386-- returns the first element matching the predicate, or 'Nothing' if
16311387-- there is no such element.
16321388find :: (Char -> Bool) -> Text -> Maybe Char
1633−find = coerce JSS.find
1634−-- find p t = S.findBy p (stream t)
1389+find p t = S.findBy p (stream t)
16351390{-# INLINE find #-}
16361391
16371392-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',
@@ -1640,16 +1395,14 @@ find = coerce JSS.find
16401395--
16411396-- > partition p t == (filter p t, filter (not . p) t)
16421397partition :: (Char -> Bool) -> Text -> (Text, Text)
1643−partition = coerce JSS.partition
1644−-- partition p t = (filter p t, filter (not . p) t)
1398+partition p t = (filter p t, filter (not . p) t)
16451399{-# INLINE partition #-}
16461400
16471401-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
16481402-- returns a 'Text' containing those characters that satisfy the
16491403-- predicate.
16501404filter :: (Char -> Bool) -> Text -> Text
1651−filter = coerce JSS.filter
1652−-- filter p t = unstream (S.filter p (stream t))
1405+filter p t = unstream (S.filter p (stream t))
16531406{-# INLINE filter #-}
16541407
16551408-- | /O(n+m)/ Find the first instance of @needle@ (which must be
@@ -1659,11 +1412,8 @@ filter = coerce JSS.filter
16591412--
16601413-- Examples:
16611414--
1662−-- >>> breakOn "::" "a::b::c"
1663−-- ("a","::b::c")
1664−--
1665−-- >>> breakOn "/" "foobar"
1666−-- ("foobar","")
1415+-- > breakOn "::" "a::b::c" ==> ("a", "::b::c")
1416+-- > breakOn "/" "foobar" ==> ("foobar", "")
16671417--
16681418-- Laws:
16691419--
@@ -1677,12 +1427,11 @@ filter = coerce JSS.filter
16771427-- In (unlikely) bad cases, this function's time complexity degrades
16781428-- towards /O(n*m)/.
16791429breakOn :: Text -> Text -> (Text, Text)
1680−breakOn = coerce JSS.breakOn
1681−-- breakOn pat src@(Text arr off len)
1682−-- | null pat = emptyError "breakOn"
1683−-- | otherwise = case indices pat src of
1684−-- [] -> (src, empty)
1685−-- (x:_) -> (text arr off x, text arr (off+x) (len-x))
1430+breakOn pat src@(Text arr off len)
1431+ | null pat = emptyError "breakOn"
1432+ | otherwise = case indices pat src of
1433+ [] -> (src, empty)
1434+ (x:_) -> (text arr off x, text arr (off+x) (len-x))
16861435{-# INLINE breakOn #-}
16871436
16881437-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
@@ -1692,12 +1441,10 @@ breakOn = coerce JSS.breakOn
16921441-- up to and including the last match of @needle@. The second is the
16931442-- remainder of @haystack@, following the match.
16941443--
1695−-- >>> breakOnEnd "::" "a::b::c"
1696−-- ("a::b::","c")
1444+-- > breakOnEnd "::" "a::b::c" ==> ("a::b::", "c")
16971445breakOnEnd :: Text -> Text -> (Text, Text)
1698−breakOnEnd = coerce JSS.breakOnEnd
1699−-- breakOnEnd pat src = (reverse b, reverse a)
1700−-- where (a,b) = breakOn (reverse pat) (reverse src)
1446+breakOnEnd pat src = (reverse b, reverse a)
1447+ where (a,b) = breakOn (reverse pat) (reverse src)
17011448{-# INLINE breakOnEnd #-}
17021449
17031450-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in
@@ -1709,11 +1456,10 @@ breakOnEnd = coerce JSS.breakOnEnd
17091456--
17101457-- Examples:
17111458--
1712−-- >>> breakOnAll "::" ""
1713−-- []
1714−--
1715−-- >>> breakOnAll "/" "a/b/c/"
1716−-- [("a","/b/c/"),("a/b","/c/"),("a/b/c","/")]
1459+-- > breakOnAll "::" ""
1460+-- > ==> []
1461+-- > breakOnAll "/" "a/b/c/"
1462+-- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]
17171463--
17181464-- In (unlikely) bad cases, this function's time complexity degrades
17191465-- towards /O(n*m)/.
@@ -1722,13 +1468,12 @@ breakOnEnd = coerce JSS.breakOnEnd
17221468breakOnAll :: Text -- ^ @needle@ to search for
17231469 -> Text -- ^ @haystack@ in which to search
17241470 -> [(Text, Text)]
1725−breakOnAll = coerce JSS.breakOnAll
1726−-- breakOnAll pat src@(Text arr off slen)
1727−-- | null pat = emptyError "breakOnAll"
1728−-- | otherwise = L.map step (indices pat src)
1729−-- where
1730−-- step x = (chunk 0 x, chunk x (slen-x))
1731−-- chunk !n !l = text arr (n+off) l
1471+breakOnAll pat src@(Text arr off slen)
1472+ | null pat = emptyError "breakOnAll"
1473+ | otherwise = L.map step (indices pat src)
1474+ where
1475+ step x = (chunk 0 x, chunk x (slen-x))
1476+ chunk !n !l = text arr (n+off) l
17321477{-# INLINE breakOnAll #-}
17331478
17341479-------------------------------------------------------------------------------
@@ -1752,16 +1497,14 @@ breakOnAll = coerce JSS.breakOnAll
17521497
17531498-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.
17541499index :: Text -> Int -> Char
1755−index = coerce JSS.index
1756−-- index t n = S.index (stream t) n
1500+index t n = S.index (stream t) n
17571501{-# INLINE index #-}
17581502
17591503-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'
17601504-- and returns the index of the first element in the 'Text' satisfying
17611505-- the predicate. Subject to fusion.
17621506findIndex :: (Char -> Bool) -> Text -> Maybe Int
1763−findIndex = coerce JSS.findIndex
1764−-- findIndex p t = S.findIndex p (stream t)
1507+findIndex p t = S.findIndex p (stream t)
17651508{-# INLINE findIndex #-}
17661509
17671510-- | /O(n+m)/ The 'count' function returns the number of times the
@@ -1771,11 +1514,10 @@ findIndex = coerce JSS.findIndex
17711514-- In (unlikely) bad cases, this function's time complexity degrades
17721515-- towards /O(n*m)/.
17731516count :: Text -> Text -> Int
1774−count = coerce JSS.count
1775−-- count pat src
1776−-- | null pat = emptyError "count"
1777−-- | isSingleton pat = countChar (unsafeHead pat) src
1778−-- | otherwise = L.length (indices pat src)
1517+count pat src
1518+ | null pat = emptyError "count"
1519+ | isSingleton pat = countChar (unsafeHead pat) src
1520+ | otherwise = L.length (indices pat src)
17791521{-# INLINE [1] count #-}
17801522
17811523{-# RULES
@@ -1797,46 +1539,42 @@ countChar c t = S.countChar c (stream t)
17971539-- excess elements of the longer 'Text' are discarded. This is
17981540-- equivalent to a pair of 'unpack' operations.
17991541zip :: Text -> Text -> [(Char,Char)]
1800−zip = coerce JSS.zip
1801−-- zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1542+zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
18021543{-# INLINE zip #-}
18031544
18041545-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
18051546-- given as the first argument, instead of a tupling function.
18061547-- Performs replacement on invalid scalar values.
18071548zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1808−zipWith = coerce JSS.zipWith
1809−-- zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1810−-- where g a b = safe (f a b)
1549+zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1550+ where g a b = safe (f a b)
18111551{-# INLINE zipWith #-}
18121552
18131553-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
18141554-- representing white space.
18151555words :: Text -> [Text]
1816−words = coerce JSS.words
1817−-- words t@(Text arr off len) = loop 0 0
1818−-- where
1819−-- loop !start !n
1820−-- | n >= len = if start == n
1821−-- then []
1822−-- else [Text arr (start+off) (n-start)]
1823−-- | isSpace c =
1824−-- if start == n
1825−-- then loop (start+1) (start+1)
1826−-- else Text arr (start+off) (n-start) : loop (n+d) (n+d)
1827−-- | otherwise = loop start (n+d)
1828−-- where Iter c d = iter t n
1556+words t@(Text arr off len) = loop 0 0
1557+ where
1558+ loop !start !n
1559+ | n >= len = if start == n
1560+ then []
1561+ else [Text arr (start+off) (n-start)]
1562+ | isSpace c =
1563+ if start == n
1564+ then loop (start+1) (start+1)
1565+ else Text arr (start+off) (n-start) : loop (n+d) (n+d)
1566+ | otherwise = loop start (n+d)
1567+ where Iter c d = iter t n
18291568{-# INLINE words #-}
18301569
18311570-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at
18321571-- newline 'Char's. The resulting strings do not contain newlines.
18331572lines :: Text -> [Text]
1834−lines = coerce JSS.lines
1835−-- lines ps | null ps = []
1836−-- | otherwise = h : if null t
1837−-- then []
1838−-- else lines (unsafeTail t)
1839−-- where (# h,t #) = span_ (/= '\n') ps
1573+lines ps | null ps = []
1574+ | otherwise = h : if null t
1575+ then []
1576+ else lines (unsafeTail t)
1577+ where (# h,t #) = span_ (/= '\n') ps
18401578{-# INLINE lines #-}
18411579
18421580{-
@@ -1864,40 +1602,34 @@ lines' ps | null ps = []
18641602-- | /O(n)/ Joins lines, after appending a terminating newline to
18651603-- each.
18661604unlines :: [Text] -> Text
1867−unlines = coerce JSS.unlines
1868−-- unlines = concat . L.map (`snoc` '\n')
1605+unlines = concat . L.map (`snoc` '\n')
18691606{-# INLINE unlines #-}
18701607
18711608-- | /O(n)/ Joins words using single space characters.
18721609unwords :: [Text] -> Text
1873−unwords = coerce JSS.unwords
1874−-- unwords = intercalate (singleton ' ')
1610+unwords = intercalate (singleton ' ')
18751611{-# INLINE unwords #-}
18761612
18771613-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns
18781614-- 'True' iff the first is a prefix of the second. Subject to fusion.
18791615isPrefixOf :: Text -> Text -> Bool
1880−isPrefixOf = coerce JSS.isPrefixOf
1881−-- isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =
1882−-- alen <= blen && S.isPrefixOf (stream a) (stream b)
1616+isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =
1617+ alen <= blen && S.isPrefixOf (stream a) (stream b)
18831618{-# INLINE [1] isPrefixOf #-}
18841619
18851620{-# RULES
18861621"TEXT isPrefixOf -> fused" [~1] forall s t.
18871622 isPrefixOf s t = S.isPrefixOf (stream s) (stream t)
1888−"JSSTRING isPrefixOf -> unfused" [1] forall x y.
1889− S.isPrefixOf (stream x) (stream y) = isPrefixOf x y
18901623 #-}
18911624
18921625-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns
18931626-- 'True' iff the first is a suffix of the second.
18941627isSuffixOf :: Text -> Text -> Bool
1895−isSuffixOf = coerce JSS.isSuffixOf
1896−-- isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =
1897−-- d >= 0 && a == b'
1898−-- where d = blen - alen
1899−-- b' | d == 0 = b
1900−-- | otherwise = Text barr (boff+d) alen
1628+isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =
1629+ d >= 0 && a == b'
1630+ where d = blen - alen
1631+ b' | d == 0 = b
1632+ | otherwise = Text barr (boff+d) alen
19011633{-# INLINE isSuffixOf #-}
19021634
19031635-- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns
@@ -1907,11 +1639,10 @@ isSuffixOf = coerce JSS.isSuffixOf
19071639-- In (unlikely) bad cases, this function's time complexity degrades
19081640-- towards /O(n*m)/.
19091641isInfixOf :: Text -> Text -> Bool
1910−isInfixOf = coerce JSS.isInfixOf
1911−-- isInfixOf needle haystack
1912−-- | null needle = True
1913−-- | isSingleton needle = S.elem (unsafeHead needle) . S.stream $ haystack
1914−-- | otherwise = not . L.null . indices needle $ haystack
1642+isInfixOf needle haystack
1643+ | null needle = True
1644+ | isSingleton needle = S.elem (unsafeHead needle) . S.stream $ haystack
1645+ | otherwise = not . L.null . indices needle $ haystack
19151646{-# INLINE [1] isInfixOf #-}
19161647
19171648{-# RULES
@@ -1927,14 +1658,9 @@ isInfixOf = coerce JSS.isInfixOf
19271658--
19281659-- Examples:
19291660--
1930−-- >>> stripPrefix "foo" "foobar"
1931−-- Just "bar"
1932−--
1933−-- >>> stripPrefix "" "baz"
1934−-- Just "baz"
1935−--
1936−-- >>> stripPrefix "foo" "quux"
1937−-- Nothing
1661+-- > stripPrefix "foo" "foobar" == Just "bar"
1662+-- > stripPrefix "" "baz" == Just "baz"
1663+-- > stripPrefix "foo" "quux" == Nothing
19381664--
19391665-- This is particularly useful with the @ViewPatterns@ extension to
19401666-- GHC, as follows:
@@ -1946,10 +1672,9 @@ isInfixOf = coerce JSS.isInfixOf
19461672-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf
19471673-- > fnordLength _ = -1
19481674stripPrefix :: Text -> Text -> Maybe Text
1949−stripPrefix = coerce JSS.stripPrefix
1950−-- stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1951−-- | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)
1952−-- | otherwise = Nothing
1675+stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1676+ | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)
1677+ | otherwise = Nothing
19531678
19541679-- | /O(n)/ Find the longest non-empty common prefix of two strings
19551680-- and return it, along with the suffixes of each string at which they
@@ -1960,39 +1685,28 @@ stripPrefix = coerce JSS.stripPrefix
19601685--
19611686-- Examples:
19621687--
1963−-- >>> commonPrefixes "foobar" "fooquux"
1964−-- Just ("foo","bar","quux")
1965−--
1966−-- >>> commonPrefixes "veeble" "fetzer"
1967−-- Nothing
1968−--
1969−-- >>> commonPrefixes "" "baz"
1970−-- Nothing
1688+-- > commonPrefixes "foobar" "fooquux" == Just ("foo","bar","quux")
1689+-- > commonPrefixes "veeble" "fetzer" == Nothing
1690+-- > commonPrefixes "" "baz" == Nothing
19711691commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)
1972−commonPrefixes = coerce JSS.commonPrefixes
1973−-- commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1974−-- where
1975−-- go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1976−-- | i > 0 = Just (Text arr0 off0 i,
1977−-- text arr0 (off0+i) (len0-i),
1978−-- text arr1 (off1+j) (len1-j))
1979−-- | otherwise = Nothing
1980−-- where Iter a d0 = iter t0 i
1981−-- Iter b d1 = iter t1 j
1692+commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1693+ where
1694+ go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1695+ | i > 0 = Just (Text arr0 off0 i,
1696+ text arr0 (off0+i) (len0-i),
1697+ text arr1 (off1+j) (len1-j))
1698+ | otherwise = Nothing
1699+ where Iter a d0 = iter t0 i
1700+ Iter b d1 = iter t1 j
19821701
19831702-- | /O(n)/ Return the prefix of the second string if its suffix
19841703-- matches the entire first string.
19851704--
19861705-- Examples:
19871706--
1988−-- >>> stripSuffix "bar" "foobar"
1989−-- Just "foo"
1990−--
1991−-- >>> stripSuffix "" "baz"
1992−-- Just "baz"
1993−--
1994−-- >>> stripSuffix "foo" "quux"
1995−-- Nothing
1707+-- > stripSuffix "bar" "foobar" == Just "foo"
1708+-- > stripSuffix "" "baz" == Just "baz"
1709+-- > stripSuffix "foo" "quux" == Nothing
19961710--
19971711-- This is particularly useful with the @ViewPatterns@ extension to
19981712-- GHC, as follows:
@@ -2004,22 +1718,21 @@ commonPrefixes = coerce JSS.commonPrefixes
20041718-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre
20051719-- > quuxLength _ = -1
20061720stripSuffix :: Text -> Text -> Maybe Text
2007−stripSuffix = coerce JSS.stripSuffix
2008−-- stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
2009−-- | p `isSuffixOf` t = Just $! text arr off (len-plen)
2010−-- | otherwise = Nothing
2011−
2012−-- -- | Add a list of non-negative numbers. Errors out on overflow.
2013−-- sumP :: String -> [Int] -> Int
2014−-- sumP fun = go 0
2015−-- where go !a (x:xs)
2016−-- | ax >= 0 = go ax xs
2017−-- | otherwise = overflowError fun
2018−-- where ax = a + x
2019−-- go a _ = a
2020−
2021−-- emptyError :: String -> a
2022−-- emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"
1721+stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
1722+ | p `isSuffixOf` t = Just $! text arr off (len-plen)
1723+ | otherwise = Nothing
1724+
1725+-- | Add a list of non-negative numbers. Errors out on overflow.
1726+sumP :: String -> [Int] -> Int
1727+sumP fun = go 0
1728+ where go !a (x:xs)
1729+ | ax >= 0 = go ax xs
1730+ | otherwise = overflowError fun
1731+ where ax = a + x
1732+ go a _ = a
1733+
1734+emptyError :: String -> a
1735+emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"
20231736
20241737overflowError :: String -> a
20251738overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
@@ -2033,22 +1746,10 @@ overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
20331746-- copy \"breaks the link\" to the original array, allowing it to be
20341747-- garbage collected if there are no other live references to it.
20351748copy :: Text -> Text
2036−copy = P.id -- TODO
2037−-- copy (Text arr off len) = Text (A.run go) 0 len
2038−-- where
2039−-- go :: ST s (A.MArray s)
2040−-- go = do
2041−-- marr <- A.new len
2042−
2043−foreign import javascript unsafe
2044− "h$jsstringReplicateChar" js_replicateChar :: Int -> Char -> JSString
2045−foreign import javascript unsafe
2046− "$2.substr($1)" js_substr1 :: Int -> JSString -> JSString
2047−
2048−-------------------------------------------------
2049−-- NOTE: the named chunk below used by doctest;
2050−-- verify the doctests via `doctest -fobject-code Data/Text.hs`
2051−
2052−-- $setup
2053−-- >>> :set -XOverloadedStrings
2054−-- >>> import qualified Data.Text as T
1749+copy (Text arr off len) = Text (A.run go) 0 len
1750+ where
1751+ go :: ST s (A.MArray s)
1752+ go = do
1753+ marr <- A.new len
1754+ A.copyI marr 0 arr off len
1755+ return marr
Data/Text/Array.hs+1−4
@@ -7,6 +7,7 @@
77--
88-- License : BSD-style
99-- Maintainer : bos@serpentine.com
10+-- Stability : experimental
1011-- Portability : portable
1112--
1213-- Packed, unboxed, heap-resident arrays. Suitable for performance
@@ -79,8 +80,6 @@ import GHC.Word (Word16(..))
7980import Prelude hiding (length, read)
8081
8182-- | Immutable array type.
82−--
83−-- The 'Array' constructor is exposed since @text-1.1.1.3@
8483data Array = Array {
8584 aBA :: ByteArray#
8685#if defined(ASSERTS)
@@ -89,8 +88,6 @@ data Array = Array {
8988 }
9089
9190-- | Mutable array type, for use in the ST monad.
92−--
93−-- The 'MArray' constructor is exposed since @text-1.1.1.3@
9491data MArray s = MArray {
9592 maBA :: MutableByteArray# s
9693#if defined(ASSERTS)
Data/Text/Encoding.hs+11−95
@@ -3,7 +3,6 @@
33#if __GLASGOW_HASKELL__ >= 702
44{-# LANGUAGE Trustworthy #-}
55#endif
6−{-# LANGUAGE UnboxedTuples #-}
76-- |
87-- Module : Data.Text.Encoding
98-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan,
@@ -12,13 +11,14 @@
1211--
1312-- License : BSD-style
1413-- Maintainer : bos@serpentine.com
14+-- Stability : experimental
1515-- Portability : portable
1616--
1717-- Functions for converting 'Text' values to and from 'ByteString',
1818-- using several standard encodings.
1919--
2020-- 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>
2222
2323module Data.Text.Encoding
2424 (
@@ -66,7 +66,7 @@ import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
6666import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)
6767#endif
6868
69−import Control.Exception (evaluate, try, throwIO, ErrorCall(ErrorCall))
69+import Control.Exception (evaluate, try)
7070import Control.Monad.ST (runST)
7171import Data.Bits ((.&.))
7272import Data.ByteString as B
@@ -76,16 +76,10 @@ import Data.Text.Internal (Text(..), safe, text)
7676import Data.Text.Internal.Private (runText)
7777import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
7878import Data.Text.Internal.Unsafe.Shift (shiftR)
79−#ifndef __GHCJS__
8079import Data.Text.Show ()
81−#endif
8280import Data.Text.Unsafe (unsafeDupablePerformIO)
8381import Data.Word (Word8, Word32)
84−#if __GLASGOW_HASKELL__ >= 703
85−import Foreign.C.Types (CSize(CSize))
86−#else
87−import Foreign.C.Types (CSize)
88−#endif
82+import Foreign.C.Types (CSize(..))
8983import Foreign.ForeignPtr (withForeignPtr)
9084import Foreign.Marshal.Utils (with)
9185import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
@@ -101,12 +95,6 @@ import qualified Data.Text.Internal.Encoding.Utf16 as U16
10195import qualified Data.Text.Internal.Fusion as F
10296
10397#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
11098
11199-- $strict
112100--
@@ -140,13 +128,6 @@ decodeLatin1 (PS fp off len) = text a 0 len
140128 return dest
141129
142130-- | 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.
150131decodeUtf8With :: OnDecodeError -> ByteString -> Text
151132decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
152133 let go dest = withForeignPtr fp $ \ptr ->
@@ -162,52 +143,16 @@ decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
162143 x <- peek curPtr'
163144 case onErr desc (Just x) of
164145 Nothing -> loop $ curPtr' `plusPtr` 1
165− Just c
166− | c > '\xFFFF' -> throwUnsupportedReplChar
167− | otherwise -> do
168− destOff <- peek destOffPtr
169− w <- unsafeSTToIO $
170− unsafeWrite dest (fromIntegral destOff)
171− (safe c)
172− poke destOffPtr (destOff + fromIntegral w)
173− loop $ curPtr' `plusPtr` 1
146+ Just c -> do
147+ destOff <- peek destOffPtr
148+ w <- unsafeSTToIO $
149+ unsafeWrite dest (fromIntegral destOff) (safe c)
150+ poke destOffPtr (destOff + fromIntegral w)
151+ loop $ curPtr' `plusPtr` 1
174152 loop (ptr `plusPtr` off)
175153 (unsafeIOToST . go) =<< A.new len
176154 where
177155 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.
211156{- INLINE[0] decodeUtf8With #-}
212157
213158-- $stream
@@ -264,8 +209,6 @@ decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
264209-- or continuation where it is encountered.
265210
266211-- | A stream oriented decoding result.
267−--
268−-- @since 1.0.0.0
269212data Decoding = Some Text ByteString (ByteString -> Decoding)
270213
271214instance Show Decoding where
@@ -285,15 +228,11 @@ newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable)
285228-- thrown (either by this function or a continuation) that cannot be
286229-- caught in pure code. For more control over the handling of invalid
287230-- data, use 'streamDecodeUtf8With'.
288−--
289−-- @since 1.0.0.0
290231streamDecodeUtf8 :: ByteString -> Decoding
291232streamDecodeUtf8 = streamDecodeUtf8With strictDecode
292233
293234-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
294235-- encoded text.
295−--
296−-- @since 1.0.0.0
297236streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
298237streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
299238 where
@@ -369,8 +308,6 @@ decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDec
369308{-# INLINE decodeUtf8' #-}
370309
371310-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
372−--
373−-- @since 1.1.0.0
374311encodeUtf8Builder :: Text -> B.Builder
375312encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
376313
@@ -379,8 +316,6 @@ encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
379316--
380317-- Use this function is to implement efficient encoders for text-based formats
381318-- like JSON or HTML.
382−--
383−-- @since 1.1.0.0
384319{-# INLINE encodeUtf8BuilderEscaped #-}
385320-- TODO: Extend documentation with references to source code in @blaze-html@
386321-- or @aeson@ that uses this function.
@@ -391,18 +326,9 @@ encodeUtf8BuilderEscaped be =
391326 where
392327 bound = max 4 $ BP.sizeBound be
393328
394−#ifndef __GHCJS__
395329 mkBuildstep (Text arr off len) !k =
396−#else
397− mkBuildstep (Text t) !k =
398−#endif
399330 outerLoop off
400331 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
406332 iend = off + len
407333
408334 outerLoop !i0 !br@(B.BufferRange op0 ope)
@@ -444,11 +370,10 @@ encodeUtf8BuilderEscaped be =
444370
445371-- | Encode text using UTF-8 encoding.
446372encodeUtf8 :: Text -> ByteString
447−#ifndef __GHCJS__
448373encodeUtf8 (Text arr off len)
449374 | len == 0 = B.empty
450375 | 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)
452377 withForeignPtr fp $ \ptr ->
453378 with ptr $ \destPtr -> do
454379 c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
@@ -461,10 +386,6 @@ encodeUtf8 (Text arr off len)
461386 withForeignPtr fp' $ \ptr' -> do
462387 memcpy ptr' ptr (fromIntegral utf8len)
463388 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
468389
469390-- | Decode text from little endian UTF-16 encoding.
470391decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
@@ -554,10 +475,5 @@ foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_stat
554475foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
555476 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
556477
557−#ifndef __GHCJS__
558478foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
559479 :: 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 @@
1010--
1111-- License : BSD-style
1212-- Maintainer : bos@serpentine.com
13+-- Stability : experimental
1314-- Portability : GHC
1415--
1516-- Types and functions for dealing with encoding and decoding errors
Data/Text/Foreign.hs+2−5
@@ -5,6 +5,7 @@
55--
66-- License : BSD-style
77-- Maintainer : bos@serpentine.com
8+-- Stability : experimental
89-- Portability : GHC
910--
1011-- Support for using 'Text' data with native code via the Haskell
@@ -107,7 +108,7 @@ takeWord16 (I16 n) t@(Text arr off len)
107108 | n >= len || m >= len = t
108109 | otherwise = Text arr off m
109110 where
110− m | w < 0xD800 || w > 0xDBFF = n
111+ m | w < 0xDB00 || w > 0xD8FF = n
111112 | otherwise = n+1
112113 w = A.unsafeIndex arr (off+n-1)
113114
@@ -156,8 +157,6 @@ asForeignPtr t@(Text _arr _off len) = do
156157-- | /O(n)/ Decode a C string with explicit length, which is assumed
157158-- to have been encoded as UTF-8. If decoding fails, a
158159-- 'UnicodeException' is thrown.
159−--
160−-- @since 1.0.0.0
161160peekCStringLen :: CStringLen -> IO Text
162161peekCStringLen cs = do
163162 bs <- unsafePackCStringLen cs
@@ -170,7 +169,5 @@ peekCStringLen cs = do
170169-- The temporary storage is freed when the subcomputation terminates
171170-- (either normally or via an exception), so the pointer to the
172171-- temporary storage must /not/ be used after this function returns.
173−--
174−-- @since 1.0.0.0
175172withCStringLen :: Text -> (CStringLen -> IO a) -> IO a
176173withCStringLen t act = unsafeUseAsCStringLen (encodeUtf8 t) act
Data/Text/IO.hs+1−20
@@ -8,6 +8,7 @@
88-- (c) 2009 Simon Marlow
99-- License : BSD-style
1010-- Maintainer : bos@serpentine.com
11+-- Stability : experimental
1112-- Portability : GHC
1213--
1314-- Efficient locale-sensitive support for text I\/O.
@@ -184,11 +185,7 @@ hPutStr h t = do
184185 | otherwise -> writeBlocksRaw h buf str
185186
186187hPutChars :: Handle -> Stream Char -> IO ()
187−#ifndef __GHCJS__
188188hPutChars h (Stream next0 s0 _len) = loop s0
189−#else
190−hPutChars h (Stream next0 s0) = loop s0
191−#endif
192189 where
193190 loop !s = case next0 s of
194191 Done -> return ()
@@ -206,11 +203,7 @@ hPutChars h (Stream next0 s0) = loop s0
206203-- handling gave a few more percent on top.
207204
208205writeLines :: Handle -> Newline -> Buffer CharBufElem -> Stream Char -> IO ()
209−#ifndef __GHCJS__
210206writeLines 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
214207 where
215208 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
216209 where
@@ -230,11 +223,7 @@ writeLines h nl buf0 (Stream next0 s0) = outer s0 buf0
230223 commit = commitBuffer h raw len
231224
232225writeBlocksCRLF :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
233−#ifndef __GHCJS__
234226writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0
235−#else
236−writeBlocksCRLF h buf0 (Stream next0 s0) = outer s0 buf0
237−#endif
238227 where
239228 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
240229 where
@@ -250,11 +239,7 @@ writeBlocksCRLF h buf0 (Stream next0 s0) = outer s0 buf0
250239 commit = commitBuffer h raw len
251240
252241writeBlocksRaw :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
253−#ifndef __GHCJS__
254242writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0
255−#else
256−writeBlocksRaw h buf0 (Stream next0 s0) = outer s0 buf0
257−#endif
258243 where
259244 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
260245 where
@@ -351,7 +336,3 @@ putStrLn = hPutStrLn stdout
351336-- >
352337-- > putStr_Utf16LE :: Text -> IO ()
353338-- > 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,
2− BangPatterns, ForeignFunctionInterface, JavaScriptFFI, GeneralizedNewtypeDeriving #-}
3−{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes,
4− GHCForeignImportPrim, MagicHash, FlexibleInstances #-}
1+{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples #-}
2+{-# OPTIONS_HADDOCK not-home #-}
3+
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+
527module Data.Text.Internal
6− ( module Data.Text.Internal
7− , JSS.safe
8− , JSS.firstf
9− ) 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
28+ (
29+ -- * Types
30+ -- $internals
31+ Text(..)
32+ -- * Construction
33+ , text
34+ , textP
35+ -- * Safety
36+ , safe
37+ -- * Code that must be here for accessibility
38+ , empty
39+ , empty_
40+ -- * Utilities
41+ , firstf
42+ -- * Checked multiplication
43+ , mul
44+ , mul32
45+ , mul64
46+ -- * Debugging
47+ , showText
48+ ) where
2449
50+#if defined(ASSERTS)
51+import Control.Exception (assert)
52+#endif
2553import Data.Bits
2654import Data.Int (Int32, Int64)
27−-- import Data.Text.Internal.Unsafe.Char (ord)
55+import Data.Text.Internal.Unsafe.Char (ord)
2856import Data.Typeable (Typeable)
29−import GHC.Exts (ByteArray#, Char(..), ord#, andI#, (/=#), isTrue#, (==#), Int(..), Int#, isTrue#)
30−-- import qualified Data.Text.Array as A
31−import GHCJS.Marshal.Pure
32−import GHCJS.Marshal
33−import qualified GHC.CString as GHC
34−
57+import qualified Data.Text.Array as A
3558
36−newtype Text = Text JSString
37− deriving (PToJSVal, PFromJSVal, FromJSVal, ToJSVal)
59+-- | A space efficient, packed, unboxed Unicode text type.
60+data Text = Text
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)
3865
39−instance Show Text where
40− showsPrec p (Text jsstring) r = showsPrec p jsstring r
66+-- | Smart constructor.
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_ #-}
4179
80+-- | /O(1)/ The empty 'Text'.
4281empty :: Text
43−empty = Text JSS.empty
82+empty = Text A.empty 0 0
4483{-# INLINE [1] empty #-}
4584
85+-- | A non-inlined version of 'empty'.
4686empty_ :: Text
47−empty_ = Text JSS.empty
87+empty_ = Text A.empty 0 0
4888{-# NOINLINE empty_ #-}
4989
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($1,$2,$3)"
56− js_textToString :: ByteArray# -> Int# -> Int# -> JSString
57−
5890-- | Construct a 'Text' without invisibly pinning its byte array in
5991-- memory if its length has dwindled to zero.
6092text :: A.Array -> Int -> Int -> Text
61−-- text arr off len | len == 0 = empty
62−-- | otherwise = text_ arr off len
63−text (A.Array ba) (I# off#) (I# len#) | isTrue# (len# ==# 0#) = empty
64− | otherwise = Text $ js_textToString ba off# len#
93+text arr off len | len == 0 = empty
94+ | otherwise = text_ arr off len
95+{-# INLINE text #-}
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
65125
66126-- | Checked multiplication. Calls 'error' if the result would
67127-- overflow.
@@ -108,4 +168,21 @@ mul32 a b = case fromIntegral a * fromIntegral b of
108168{-# INLINE mul32 #-}
109169infixl 7 `mul32`
110170
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 @@
11{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
2−{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes, UnboxedTuples,
3− MagicHash #-}
42{-# OPTIONS_HADDOCK not-home #-}
53
64-----------------------------------------------------------------------------
@@ -75,8 +73,6 @@ import qualified Data.Text as S
7573import qualified Data.Text.Array as A
7674import qualified Data.Text.Lazy as L
7775
78−import Data.JSString (JSString)
79−import GHC.Exts (ByteArray#, Int#, Int(I#))
8076------------------------------------------------------------------------
8177
8278-- | A @Builder@ is an efficient way to build lazy @Text@ values.
@@ -168,17 +164,10 @@ copyLimit = 128
168164-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@
169165--
170166fromText :: S.Text -> Builder
171−fromText t@(Text t')
167+fromText t@(Text arr off l)
172168 | S.null t = empty
173169 | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)
174170 | 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 :)
182171{-# INLINE [1] fromText #-}
183172
184173{-# RULES
@@ -193,10 +182,10 @@ fromText t@(Text t')
193182fromString :: String -> Builder
194183fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
195184 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)
197186 | l <= 1 = do
198187 arr <- A.unsafeFreeze marr
199− let !t = Text $ js_toString (A.aBA arr) o# u#
188+ let !t = Text arr o u
200189 marr' <- A.new chunkSize
201190 ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
202191 return $ t : ts
@@ -206,21 +195,6 @@ fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
206195 in loop p0 o0 u0 l0 str
207196 where
208197 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
224198{-# INLINE fromString #-}
225199
226200-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying
@@ -260,24 +234,16 @@ toLazyTextWith chunkSize m = L.fromChunks (runST $
260234-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,
261235-- yielding a new chunk in the result lazy @Text@.
262236flush :: 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) ->
264238 if u == 0
265239 then k buf
266240 else do arr <- A.unsafeFreeze p
267241 let !b = Buffer p (o+u) 0 l
268− !t = Text $ js_toString (A.aBA arr) o# u#
242+ !t = Text arr o u
269243 ts <- inlineInterleaveST (k b)
270244 return $! t : ts
271245{-# INLINE [1] flush #-}
272246-- 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
281247
282248------------------------------------------------------------------------
283249
@@ -361,11 +327,3 @@ append' (Builder f) (Builder g) = Builder (f . g)
361327 append flush flush = flush
362328
363329 #-}
364−
365−foreign import javascript unsafe
366− "h$textFromString"
367− js_fromString :: JSString -> (# ByteArray#, Int# #)
368−
369−foreign import javascript unsafe
370− "h$textToString($1,$2,$3)"
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
5555import Data.Text.Unsafe (unsafeDupablePerformIO)
5656
5757streamASCII :: ByteString -> Stream Char
58−streamASCII bs = Stream next 0 -- (maxSize l)
58+streamASCII bs = Stream next 0 (maxSize l)
5959 where
6060 l = B.length bs
6161 {-# INLINE next #-}
@@ -70,7 +70,7 @@ streamASCII bs = Stream next 0 -- (maxSize l)
7070-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8
7171-- encoding.
7272streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
73−streamUtf8 onErr bs = Stream next 0 -- (maxSize l)
73+streamUtf8 onErr bs = Stream next 0 (maxSize l)
7474 where
7575 l = B.length bs
7676 next i
@@ -91,7 +91,7 @@ streamUtf8 onErr bs = Stream next 0 -- (maxSize l)
9191-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
9292-- endian UTF-16 encoding.
9393streamUtf16LE :: 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))
9595 where
9696 l = B.length bs
9797 {-# INLINE next #-}
@@ -109,7 +109,7 @@ streamUtf16LE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 1))
109109-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
110110-- endian UTF-16 encoding.
111111streamUtf16BE :: 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))
113113 where
114114 l = B.length bs
115115 {-# INLINE next #-}
@@ -127,7 +127,7 @@ streamUtf16BE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 1))
127127-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
128128-- endian UTF-32 encoding.
129129streamUtf32BE :: 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))
131131 where
132132 l = B.length bs
133133 {-# INLINE next #-}
@@ -147,7 +147,7 @@ streamUtf32BE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 2))
147147-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
148148-- endian UTF-32 encoding.
149149streamUtf32LE :: 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))
151151 where
152152 l = B.length bs
153153 {-# INLINE next #-}
@@ -166,10 +166,8 @@ streamUtf32LE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 2))
166166
167167-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.
168168unstream :: Stream Word8 -> ByteString
169−-- unstream (Stream next s0 len) = unsafeDupablePerformIO $ do
170−unstream (Stream next s0) = unsafeDupablePerformIO $ do
171− -- let mlen = upperBound 4 len
172− let mlen = 4
169+unstream (Stream next s0 len) = unsafeDupablePerformIO $ do
170+ let mlen = upperBound 4 len
173171 mallocByteString mlen >>= loop mlen 0 s0
174172 where
175173 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)
3737import Data.Word (Word8)
3838
3939restreamUtf16BE :: Stream Char -> Stream Word8
40−-- restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
41−restreamUtf16BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
40+restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
4241 where
4342 next (RS0 s) = case next0 s of
4443 Done -> Done
@@ -62,8 +61,7 @@ restreamUtf16BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
6261{-# INLINE restreamUtf16BE #-}
6362
6463restreamUtf16LE :: Stream Char -> Stream Word8
65−-- restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
66−restreamUtf16LE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
64+restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
6765 where
6866 next (RS0 s) = case next0 s of
6967 Done -> Done
@@ -87,8 +85,7 @@ restreamUtf16LE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
8785{-# INLINE restreamUtf16LE #-}
8886
8987restreamUtf32BE :: Stream Char -> Stream Word8
90−restreamUtf32BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
91−-- restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
88+restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
9289 where
9390 next (RS0 s) = case next0 s of
9491 Done -> Done
@@ -107,8 +104,7 @@ restreamUtf32BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
107104{-# INLINE restreamUtf32BE #-}
108105
109106restreamUtf32LE :: Stream Char -> Stream Word8
110−restreamUtf32LE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
111−-- restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
107+restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
112108 where
113109 next (RS0 s) = case next0 s of
114110 Done -> Done
Data/Text/Internal/Fusion.hs+166−40
@@ -28,91 +28,217 @@ module Data.Text.Internal.Fusion
2828 , unstream
2929 , reverseStream
3030
31− , Data.Text.Internal.Fusion.length
31+ , length
3232
3333 -- * Transformations
34− , Data.Text.Internal.Fusion.reverse
34+ , reverse
3535
3636 -- * Construction
3737 -- ** Scans
3838 , reverseScanr
3939
4040 -- ** Accumulating maps
41− , Data.Text.Internal.Fusion.mapAccumL
41+ , mapAccumL
4242
4343 -- ** Generation and unfolding
4444 , unfoldrN
4545
4646 -- * Indexing
47− , Data.Text.Internal.Fusion.index
48− , Data.Text.Internal.Fusion.findIndex
47+ , index
48+ , findIndex
4949 , countChar
5050 ) where
5151
52−import GHC.Exts (Char(..), Int(..), chr#, Int#, isTrue#, (-#), (+#), (>=#))
53−
54−import Prelude hiding (length, reverse)
55−import Data.Char
56−
57−import Data.JSString.Internal.Type (JSString(..))
58−import qualified Data.JSString.Internal.Type as I
59−import Data.JSString.Internal.Fusion.Types
60−import qualified Data.JSString.Internal.Fusion.Common as S
61−
62−import System.IO.Unsafe
63−
64−import GHCJS.Prim
65−
66−import Data.Coerce
67−import Data.Text.Internal
68−import qualified Data.JSString.Internal.Fusion as JSS
69−import Data.JSString.Internal.Fusion.Types (Stream(..))
52+import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,
53+ Num(..), Ord(..), ($), (&&),
54+ fromIntegral, otherwise)
55+import Data.Bits ((.&.))
56+import Data.Text.Internal (Text(..))
57+import Data.Text.Internal.Private (runText)
58+import Data.Text.Internal.Unsafe.Char (ord, unsafeChr, unsafeWrite)
59+import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
60+import qualified Data.Text.Array as A
61+import qualified Data.Text.Internal.Fusion.Common as S
62+import Data.Text.Internal.Fusion.Types
63+import Data.Text.Internal.Fusion.Size
64+import qualified Data.Text.Internal as I
65+import qualified Data.Text.Internal.Encoding.Utf16 as U16
7066
7167default(Int)
7268
69+-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
7370stream :: 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)
7581{-# INLINE [0] stream #-}
7682
83+-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate
84+-- backwards.
7785reverseStream :: 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)
7996{-# INLINE [0] reverseStream #-}
8097
98+-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
8199unstream :: 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
83130{-# INLINE [0] unstream #-}
84131{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
85132
133+
134+-- ----------------------------------------------------------------------------
135+-- * Basic stream functions
136+
86137length :: Stream Char -> Int
87−length = JSS.length
88−{-# INLINE [0] length #-}
138+length = S.lengthI
139+{-# INLINE[0] length #-}
89140
141+-- | /O(n)/ Reverse the characters of a string.
90142reverse :: 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
92174{-# INLINE [0] reverse #-}
93175
176+-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with
177+-- the input and result reversed.
94178reverseScanr :: (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
96188{-# INLINE reverseScanr #-}
97189
98−mapAccumL :: (a -> Char -> (a, Char)) -> a -> Stream Char -> (a, Text)
99−mapAccumL f z0 st =
100− let (a, t) = JSS.mapAccumL f z0 st
101− in (a, Text t)
102−{-# INLINE [0] mapAccumL #-}
103−
190+-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
191+-- value. However, the length of the result is limited by the
192+-- first argument to 'unfoldrN'. This function is more efficient than
193+-- 'unfoldr' when the length of the result is known.
104194unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char
105−unfoldrN = JSS.unfoldrN
195+unfoldrN n = S.unfoldrNI n
106196{-# INLINE [0] unfoldrN #-}
107197
198+-------------------------------------------------------------------------------
199+-- ** Indexing streams
200+
201+-- | /O(n)/ stream index (subscript) operator, starting from 0.
108202index :: Stream Char -> Int -> Char
109−index = JSS.index
203+index = S.indexI
110204{-# INLINE [0] index #-}
111205
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.
112209findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int
113−findIndex = JSS.findIndex
210+findIndex = S.findIndexI
114211{-# INLINE [0] findIndex #-}
115212
213+-- | /O(n)/ The 'count' function returns the number of times the query
214+-- element appears in the given stream.
116215countChar :: Char -> Stream Char -> Int
117−countChar = JSS.countChar
216+countChar = S.countCharI
118217{-# 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 @@
11{-# LANGUAGE Rank2Types #-}
22-- AUTOMATICALLY GENERATED - DO NOT EDIT
33-- Generated by scripts/CaseMapping.hs
4−-- CaseFolding-9.0.0.txt
5−-- Date: 2016-03-02, 18:54:54 GMT
6−-- SpecialCasing-9.0.0.txt
7−-- Date: 2016-03-02, 18:55:13 GMT
4+-- CaseFolding-8.0.0.txt
5+-- Date: 2015-01-13, 18:16:36 GMT [MD]
6+-- SpecialCasing-8.0.0.txt
7+-- Date: 2014-12-16, 23:08:04 GMT [MD]
88
99module Data.Text.Internal.Fusion.CaseMapping where
1010import Data.Char
@@ -371,24 +371,6 @@ foldMapping '\x13fb' s = Yield '\x13f3' (CC s '\x0000' '\x0000')
371371foldMapping '\x13fc' s = Yield '\x13f4' (CC s '\x0000' '\x0000')
372372-- CHEROKEE SMALL LETTER MV
373373foldMapping '\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')
392374-- LATIN SMALL LETTER H WITH LINE BELOW
393375foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')
394376-- LATIN SMALL LETTER T WITH DIAERESIS
@@ -563,8 +545,6 @@ foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')
563545foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')
564546-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
565547foldMapping '\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')
568548-- LATIN CAPITAL LETTER J WITH CROSSED-TAIL
569549foldMapping '\xa7b2' s = Yield '\x029d' (CC s '\x0000' '\x0000')
570550-- LATIN CAPITAL LETTER CHI
@@ -757,78 +737,6 @@ foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')
757737foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')
758738-- ARMENIAN SMALL LIGATURE MEN XEH
759739foldMapping '\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')
832740-- OLD HUNGARIAN CAPITAL LETTER A
833741foldMapping '\x10c80' s = Yield '\x10cc0' (CC s '\x0000' '\x0000')
834742-- OLD HUNGARIAN CAPITAL LETTER AA
@@ -931,72 +839,4 @@ foldMapping '\x10cb0' s = Yield '\x10cf0' (CC s '\x0000' '\x0000')
931839foldMapping '\x10cb1' s = Yield '\x10cf1' (CC s '\x0000' '\x0000')
932840-- OLD HUNGARIAN CAPITAL LETTER US
933841foldMapping '\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')
1002842foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
Data/Text/Internal/Fusion/Common.hs+922−968
@@ -14,971 +14,925 @@
1414--
1515-- Common stream fusion functionality for text.
1616
17−module Data.Text.Internal.Fusion.Common (module Data.JSString.Internal.Fusion.Common) where
18−import Data.JSString.Internal.Fusion.Common
19−-- module Data.Text.Internal.Fusion.Common
20−-- (
21−-- -- * Creation and elimination
22−-- singleton
23−-- , streamList
24−-- , unstreamList
25−-- , streamCString#
26−
27−-- -- * Basic interface
28−-- , cons
29−-- , snoc
30−-- , append
31−-- , head
32−-- , uncons
33−-- , last
34−-- , tail
35−-- , init
36−-- , null
37−-- , lengthI
38−-- , compareLengthI
39−-- , isSingleton
40−
41−-- -- * Transformations
42−-- , map
43−-- , intercalate
44−-- , intersperse
45−
46−-- -- ** Case conversion
47−-- -- $case
48−-- , toCaseFold
49−-- , toLower
50−-- , toTitle
51−-- , toUpper
52−
53−-- -- ** Justification
54−-- , justifyLeftI
55−
56−-- -- * Folds
57−-- , foldl
58−-- , foldl'
59−-- , foldl1
60−-- , foldl1'
61−-- , foldr
62−-- , foldr1
63−
64−-- -- ** Special folds
65−-- , concat
66−-- , concatMap
67−-- , any
68−-- , all
69−-- , maximum
70−-- , minimum
71−
72−-- -- * Construction
73−-- -- ** Scans
74−-- , scanl
75−
76−-- -- ** Generation and unfolding
77−-- , replicateCharI
78−-- , replicateI
79−-- , unfoldr
80−-- , unfoldrNI
81−
82−-- -- * Substrings
83−-- -- ** Breaking strings
84−-- , take
85−-- , drop
86−-- , takeWhile
87−-- , dropWhile
88−
89−-- -- * Predicates
90−-- , isPrefixOf
91−
92−-- -- * Searching
93−-- , elem
94−-- , filter
95−
96−-- -- * Indexing
97−-- , findBy
98−-- , indexI
99−-- , findIndexI
100−-- , countCharI
101−
102−-- -- * Zipping and unzipping
103−-- , zipWith
104−-- ) where
105−
106−-- import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
107−-- Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),
108−-- (&&), fromIntegral, otherwise)
109−-- import qualified Data.List as L
110−-- import qualified Prelude as P
111−-- import Data.Bits (shiftL)
112−-- import Data.Char (isLetter)
113−-- import Data.Int (Int64)
114−-- import Data.Text.Internal.Fusion.Types
115−-- import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,
116−-- upperMapping)
117−-- import Data.Text.Internal.Fusion.Size
118−-- import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)
119−-- import GHC.Types (Char(..), Int(..))
120−
121−-- singleton :: Char -> Stream Char
122−-- singleton c = Stream next False -- 1
123−-- where next False = Yield c True
124−-- next True = Done
125−-- {-# INLINE [0] singleton #-}
126−
127−-- streamList :: [a] -> Stream a
128−-- {-# INLINE [0] streamList #-}
129−-- streamList s = Stream next s -- unknownSize
130−-- where next [] = Done
131−-- next (x:xs) = Yield x xs
132−
133−-- unstreamList :: Stream a -> [a]
134−-- -- unstreamList (Stream next s0 _len) = unfold s0
135−-- unstreamList (Stream next s0) = unfold s0
136−-- where unfold !s = case next s of
137−-- Done -> []
138−-- Skip s' -> unfold s'
139−-- Yield x s' -> x : unfold s'
140−-- {-# INLINE [0] unstreamList #-}
141−
142−-- {-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}
143−
144−-- -- | Stream the UTF-8-like packed encoding used by GHC to represent
145−-- -- constant strings in generated code.
146−-- --
147−-- -- This encoding uses the byte sequence "\xc0\x80" to represent NUL,
148−-- -- and the string is NUL-terminated.
149−-- streamCString# :: Addr# -> Stream Char
150−-- streamCString# addr = Stream step 0 -- unknownSize
151−-- where
152−-- step !i
153−-- | b == 0 = Done
154−-- | b <= 0x7f = Yield (C# b#) (i+1)
155−-- | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1
156−-- in Yield c (i+2)
157−-- | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +
158−-- (next 1 `shiftL` 6) +
159−-- next 2
160−-- in Yield c (i+3)
161−-- | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +
162−-- (next 1 `shiftL` 12) +
163−-- (next 2 `shiftL` 6) +
164−-- next 3
165−-- in Yield c (i+4)
166−-- where b = I# (ord# b#)
167−-- next n = I# (ord# (at# (i+n))) - 0x80
168−-- !b# = at# i
169−-- at# (I# i#) = indexCharOffAddr# addr i#
170−-- chr (I# i#) = C# (chr# i#)
171−-- {-# INLINE [0] streamCString# #-}
172−
173−-- -- ----------------------------------------------------------------------------
174−-- -- * Basic stream functions
175−
176−-- data C s = C0 !s
177−-- | C1 !s
178−
179−-- -- | /O(n)/ Adds a character to the front of a Stream Char.
180−-- cons :: Char -> Stream Char -> Stream Char
181−-- -- cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
182−-- cons !w (Stream next0 s0) = Stream next (C1 s0) -- (len+1)
183−-- where
184−-- next (C1 s) = Yield w (C0 s)
185−-- next (C0 s) = case next0 s of
186−-- Done -> Done
187−-- Skip s' -> Skip (C0 s')
188−-- Yield x s' -> Yield x (C0 s')
189−-- {-# INLINE [0] cons #-}
190−
191−-- data Snoc a = N
192−-- | J !a
193−
194−-- -- | /O(n)/ Adds a character to the end of a stream.
195−-- snoc :: Stream Char -> Char -> Stream Char
196−-- -- snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
197−-- snoc (Stream next0 xs0) w = Stream next (J xs0) -- (len+1)
198−-- where
199−-- next (J xs) = case next0 xs of
200−-- Done -> Yield w N
201−-- Skip xs' -> Skip (J xs')
202−-- Yield x xs' -> Yield x (J xs')
203−-- next N = Done
204−-- {-# INLINE [0] snoc #-}
205−
206−-- data E l r = L !l
207−-- | R !r
208−
209−-- -- | /O(n)/ Appends one Stream to the other.
210−-- append :: Stream Char -> Stream Char -> Stream Char
211−-- -- append (Stream next0 s01 len1) (Stream next1 s02 len2) =
212−-- -- Stream next (L s01) (len1 + len2)
213−-- append (Stream next0 s01) (Stream next1 s02) =
214−-- Stream next (L s01)
215−-- where
216−-- next (L s1) = case next0 s1 of
217−-- Done -> Skip (R s02)
218−-- Skip s1' -> Skip (L s1')
219−-- Yield x s1' -> Yield x (L s1')
220−-- next (R s2) = case next1 s2 of
221−-- Done -> Done
222−-- Skip s2' -> Skip (R s2')
223−-- Yield x s2' -> Yield x (R s2')
224−-- {-# INLINE [0] append #-}
225−
226−-- -- | /O(1)/ Returns the first character of a Text, which must be non-empty.
227−-- -- Subject to array fusion.
228−-- head :: Stream Char -> Char
229−-- -- head (Stream next s0 _len) = loop_head s0
230−-- head (Stream next s0) = loop_head s0
231−-- where
232−-- loop_head !s = case next s of
233−-- Yield x _ -> x
234−-- Skip s' -> loop_head s'
235−-- Done -> head_empty
236−-- {-# INLINE [0] head #-}
237−
238−-- head_empty :: a
239−-- head_empty = streamError "head" "Empty stream"
240−-- {-# NOINLINE head_empty #-}
241−
242−-- -- | /O(1)/ Returns the first character and remainder of a 'Stream
243−-- -- Char', or 'Nothing' if empty. Subject to array fusion.
244−-- uncons :: Stream Char -> Maybe (Char, Stream Char)
245−-- -- uncons (Stream next s0 len) = loop_uncons s0
246−-- uncons (Stream next s0) = loop_uncons s0
247−-- where
248−-- loop_uncons !s = case next s of
249−-- Yield x s1 -> Just (x, Stream next s1)
250−-- Skip s' -> loop_uncons s'
251−-- Done -> Nothing
252−-- {-# INLINE [0] uncons #-}
253−
254−-- -- | /O(n)/ Returns the last character of a 'Stream Char', which must
255−-- -- be non-empty.
256−-- last :: Stream Char -> Char
257−-- -- last (Stream next s0 _len) = loop0_last s0
258−-- last (Stream next s0) = loop0_last s0
259−-- where
260−-- loop0_last !s = case next s of
261−-- Done -> emptyError "last"
262−-- Skip s' -> loop0_last s'
263−-- Yield x s' -> loop_last x s'
264−-- loop_last !x !s = case next s of
265−-- Done -> x
266−-- Skip s' -> loop_last x s'
267−-- Yield x' s' -> loop_last x' s'
268−-- {-# INLINE[0] last #-}
269−
270−-- -- | /O(1)/ Returns all characters after the head of a Stream Char, which must
271−-- -- be non-empty.
272−-- tail :: Stream Char -> Stream Char
273−-- -- tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)
274−-- tail (Stream next0 s0) = Stream next (C0 s0) -- (len-1)
275−-- where
276−-- next (C0 s) = case next0 s of
277−-- Done -> emptyError "tail"
278−-- Skip s' -> Skip (C0 s')
279−-- Yield _ s' -> Skip (C1 s')
280−-- next (C1 s) = case next0 s of
281−-- Done -> Done
282−-- Skip s' -> Skip (C1 s')
283−-- Yield x s' -> Yield x (C1 s')
284−-- {-# INLINE [0] tail #-}
285−
286−-- data Init s = Init0 !s
287−-- | Init1 {-# UNPACK #-} !Char !s
288−
289−-- -- | /O(1)/ Returns all but the last character of a Stream Char, which
290−-- -- must be non-empty.
291−-- init :: Stream Char -> Stream Char
292−-- -- init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)
293−-- init (Stream next0 s0) = Stream next (Init0 s0) -- (len-1)
294−-- where
295−-- next (Init0 s) = case next0 s of
296−-- Done -> emptyError "init"
297−-- Skip s' -> Skip (Init0 s')
298−-- Yield x s' -> Skip (Init1 x s')
299−-- next (Init1 x s) = case next0 s of
300−-- Done -> Done
301−-- Skip s' -> Skip (Init1 x s')
302−-- Yield x' s' -> Yield x (Init1 x' s')
303−-- {-# INLINE [0] init #-}
304−
305−-- -- | /O(1)/ Tests whether a Stream Char is empty or not.
306−-- null :: Stream Char -> Bool
307−-- -- null (Stream next s0 _len) = loop_null s0
308−-- null (Stream next s0) = loop_null s0
309−-- where
310−-- loop_null !s = case next s of
311−-- Done -> True
312−-- Yield _ _ -> False
313−-- Skip s' -> loop_null s'
314−-- {-# INLINE[0] null #-}
315−
316−-- -- | /O(n)/ Returns the number of characters in a string.
317−-- lengthI :: Integral a => Stream Char -> a
318−-- -- lengthI (Stream next s0 _len) = loop_length 0 s0
319−-- lengthI (Stream next s0) = loop_length 0 s0
320−-- where
321−-- loop_length !z s = case next s of
322−-- Done -> z
323−-- Skip s' -> loop_length z s'
324−-- Yield _ s' -> loop_length (z + 1) s'
325−-- {-# INLINE[0] lengthI #-}
326−
327−-- -- | /O(n)/ Compares the count of characters in a string to a number.
328−-- -- Subject to fusion.
329−-- --
330−-- -- This function gives the same answer as comparing against the result
331−-- -- of 'lengthI', but can short circuit if the count of characters is
332−-- -- greater than the number or if the stream can't possibly be as long
333−-- -- as the number supplied, and hence be more efficient.
334−-- compareLengthI :: Integral a => Stream Char -> a -> Ordering
335−-- -- compareLengthI (Stream next s0 len) n =
336−-- compareLengthI (Stream next s0) n =
337−-- -- case compareSize len (fromIntegral n) of
338−-- -- Just o -> o
339−-- -- Nothing -> loop_cmp 0 s0
340−-- loop_cmp 0 s0
341−-- where
342−-- loop_cmp !z s = case next s of
343−-- Done -> compare z n
344−-- Skip s' -> loop_cmp z s'
345−-- Yield _ s' | z > n -> GT
346−-- | otherwise -> loop_cmp (z + 1) s'
347−-- {-# INLINE[0] compareLengthI #-}
348−
349−-- -- | /O(n)/ Indicate whether a string contains exactly one element.
350−-- isSingleton :: Stream Char -> Bool
351−-- -- isSingleton (Stream next s0 _len) = loop 0 s0
352−-- isSingleton (Stream next s0) = loop 0 s0
353−-- where
354−-- loop !z s = case next s of
355−-- Done -> z == (1::Int)
356−-- Skip s' -> loop z s'
357−-- Yield _ s'
358−-- | z >= 1 -> False
359−-- | otherwise -> loop (z+1) s'
360−-- {-# INLINE[0] isSingleton #-}
361−
362−-- -- ----------------------------------------------------------------------------
363−-- -- * Stream transformations
364−
365−-- -- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@
366−-- -- to each element of @xs@.
367−-- map :: (Char -> Char) -> Stream Char -> Stream Char
368−-- -- map f (Stream next0 s0 len) = Stream next s0 len
369−-- map f (Stream next0 s0) = Stream next s0 -- len
370−-- where
371−-- next !s = case next0 s of
372−-- Done -> Done
373−-- Skip s' -> Skip s'
374−-- Yield x s' -> Yield (f x) s'
375−-- {-# INLINE [0] map #-}
376−
377−-- {-#
378−-- RULES "STREAM map/map fusion" forall f g s.
379−-- map f (map g s) = map (\x -> f (g x)) s
380−-- #-}
381−
382−-- data I s = I1 !s
383−-- | I2 !s {-# UNPACK #-} !Char
384−-- | I3 !s
385−
386−-- -- | /O(n)/ Take a character and place it between each of the
387−-- -- characters of a 'Stream Char'.
388−-- intersperse :: Char -> Stream Char -> Stream Char
389−-- intersperse c (Stream next0 s0) = Stream next (I1 s0) -- len
390−-- -- intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len
391−-- where
392−-- next (I1 s) = case next0 s of
393−-- Done -> Done
394−-- Skip s' -> Skip (I1 s')
395−-- Yield x s' -> Skip (I2 s' x)
396−-- next (I2 s x) = Yield x (I3 s)
397−-- next (I3 s) = case next0 s of
398−-- Done -> Done
399−-- Skip s' -> Skip (I3 s')
400−-- Yield x s' -> Yield c (I2 s' x)
401−-- {-# INLINE [0] intersperse #-}
402−
403−-- -- ----------------------------------------------------------------------------
404−-- -- ** Case conversions (folds)
405−
406−-- -- $case
407−-- --
408−-- -- With Unicode text, it is incorrect to use combinators like @map
409−-- -- toUpper@ to case convert each character of a string individually.
410−-- -- Instead, use the whole-string case conversion functions from this
411−-- -- module. For correctness in different writing systems, these
412−-- -- functions may map one input character to two or three output
413−-- -- characters.
414−
415−-- caseConvert :: (forall s. Char -> s -> Step (CC s) Char)
416−-- -> Stream Char -> Stream Char
417−-- -- caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len
418−-- caseConvert remap (Stream next0 s0) = Stream next (CC s0 '\0' '\0') -- len
419−-- where
420−-- next (CC s '\0' _) =
421−-- case next0 s of
422−-- Done -> Done
423−-- Skip s' -> Skip (CC s' '\0' '\0')
424−-- Yield c s' -> remap c s'
425−-- next (CC s a b) = Yield a (CC s b '\0')
426−
427−-- -- | /O(n)/ Convert a string to folded case. This function is mainly
428−-- -- useful for performing caseless (or case insensitive) string
429−-- -- comparisons.
430−-- --
431−-- -- A string @x@ is a caseless match for a string @y@ if and only if:
432−-- --
433−-- -- @toCaseFold x == toCaseFold y@
434−-- --
435−-- -- The result string may be longer than the input string, and may
436−-- -- differ from applying 'toLower' to the input string. For instance,
437−-- -- the Armenian small ligature men now (U+FB13) is case folded to the
438−-- -- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is
439−-- -- case folded to the Greek small letter letter mu (U+03BC) instead of
440−-- -- itself.
441−-- toCaseFold :: Stream Char -> Stream Char
442−-- toCaseFold = caseConvert foldMapping
443−-- {-# INLINE [0] toCaseFold #-}
444−
445−-- -- | /O(n)/ Convert a string to upper case, using simple case
446−-- -- conversion. The result string may be longer than the input string.
447−-- -- For instance, the German eszett (U+00DF) maps to the two-letter
448−-- -- sequence SS.
449−-- toUpper :: Stream Char -> Stream Char
450−-- toUpper = caseConvert upperMapping
451−-- {-# INLINE [0] toUpper #-}
452−
453−-- -- | /O(n)/ Convert a string to lower case, using simple case
454−-- -- conversion. The result string may be longer than the input string.
455−-- -- For instance, the Latin capital letter I with dot above (U+0130)
456−-- -- maps to the sequence Latin small letter i (U+0069) followed by
457−-- -- combining dot above (U+0307).
458−-- toLower :: Stream Char -> Stream Char
459−-- toLower = caseConvert lowerMapping
460−-- {-# INLINE [0] toLower #-}
461−
462−-- -- | /O(n)/ Convert a string to title case, using simple case
463−-- -- conversion.
464−-- --
465−-- -- The first letter of the input is converted to title case, as is
466−-- -- every subsequent letter that immediately follows a non-letter.
467−-- -- Every letter that immediately follows another letter is converted
468−-- -- to lower case.
469−-- --
470−-- -- The result string may be longer than the input string. For example,
471−-- -- the Latin small ligature &#xfb02; (U+FB02) is converted to the
472−-- -- sequence Latin capital letter F (U+0046) followed by Latin small
473−-- -- letter l (U+006C).
474−-- --
475−-- -- /Note/: this function does not take language or culture specific
476−-- -- rules into account. For instance, in English, different style
477−-- -- guides disagree on whether the book name \"The Hill of the Red
478−-- -- Fox\" is correctly title cased&#x2014;but this function will
479−-- -- capitalize /every/ word.
480−-- toTitle :: Stream Char -> Stream Char
481−-- -- toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len
482−-- toTitle (Stream next0 s0) = Stream next (CC (False :*: s0) '\0' '\0') -- len
483−-- where
484−-- next (CC (letter :*: s) '\0' _) =
485−-- case next0 s of
486−-- Done -> Done
487−-- Skip s' -> Skip (CC (letter :*: s') '\0' '\0')
488−-- Yield c s'
489−-- | letter' -> if letter
490−-- then lowerMapping c (letter' :*: s')
491−-- else titleMapping c (letter' :*: s')
492−-- | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')
493−-- where letter' = isLetter c
494−-- next (CC s a b) = Yield a (CC s b '\0')
495−-- {-# INLINE [0] toTitle #-}
496−
497−-- data Justify i s = Just1 !i !s
498−-- | Just2 !i !s
499−
500−-- justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
501−-- -- justifyLeftI k c (Stream next0 s0 len) =
502−-- justifyLeftI k c (Stream next0 s0) =
503−-- Stream next (Just1 0 s0) -- (larger (fromIntegral k) len)
504−-- where
505−-- next (Just1 n s) =
506−-- case next0 s of
507−-- Done -> next (Just2 n s)
508−-- Skip s' -> Skip (Just1 n s')
509−-- Yield x s' -> Yield x (Just1 (n+1) s')
510−-- next (Just2 n s)
511−-- | n < k = Yield c (Just2 (n+1) s)
512−-- | otherwise = Done
513−-- {-# INLINE next #-}
514−-- {-# INLINE [0] justifyLeftI #-}
515−
516−-- -- ----------------------------------------------------------------------------
517−-- -- * Reducing Streams (folds)
518−
519−-- -- | foldl, applied to a binary operator, a starting value (typically the
520−-- -- left-identity of the operator), and a Stream, reduces the Stream using the
521−-- -- binary operator, from left to right.
522−-- foldl :: (b -> Char -> b) -> b -> Stream Char -> b
523−-- -- foldl f z0 (Stream next s0 _len) = loop_foldl z0 s0
524−-- foldl f z0 (Stream next s0) = loop_foldl z0 s0
525−-- where
526−-- loop_foldl z !s = case next s of
527−-- Done -> z
528−-- Skip s' -> loop_foldl z s'
529−-- Yield x s' -> loop_foldl (f z x) s'
530−-- {-# INLINE [0] foldl #-}
531−
532−-- -- | A strict version of foldl.
533−-- foldl' :: (b -> Char -> b) -> b -> Stream Char -> b
534−-- -- foldl' f z0 (Stream next s0 _len) = loop_foldl' z0 s0
535−-- foldl' f z0 (Stream next s0) = loop_foldl' z0 s0
536−-- where
537−-- loop_foldl' !z !s = case next s of
538−-- Done -> z
539−-- Skip s' -> loop_foldl' z s'
540−-- Yield x s' -> loop_foldl' (f z x) s'
541−-- {-# INLINE [0] foldl' #-}
542−
543−-- -- | foldl1 is a variant of foldl that has no starting value argument,
544−-- -- and thus must be applied to non-empty Streams.
545−-- foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char
546−-- -- foldl1 f (Stream next s0 _len) = loop0_foldl1 s0
547−-- foldl1 f (Stream next s0) = loop0_foldl1 s0
548−-- where
549−-- loop0_foldl1 !s = case next s of
550−-- Skip s' -> loop0_foldl1 s'
551−-- Yield x s' -> loop_foldl1 x s'
552−-- Done -> emptyError "foldl1"
553−-- loop_foldl1 z !s = case next s of
554−-- Done -> z
555−-- Skip s' -> loop_foldl1 z s'
556−-- Yield x s' -> loop_foldl1 (f z x) s'
557−-- {-# INLINE [0] foldl1 #-}
558−
559−-- -- | A strict version of foldl1.
560−-- foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char
561−-- -- foldl1' f (Stream next s0 _len) = loop0_foldl1' s0
562−-- foldl1' f (Stream next s0) = loop0_foldl1' s0
563−-- where
564−-- loop0_foldl1' !s = case next s of
565−-- Skip s' -> loop0_foldl1' s'
566−-- Yield x s' -> loop_foldl1' x s'
567−-- Done -> emptyError "foldl1"
568−-- loop_foldl1' !z !s = case next s of
569−-- Done -> z
570−-- Skip s' -> loop_foldl1' z s'
571−-- Yield x s' -> loop_foldl1' (f z x) s'
572−-- {-# INLINE [0] foldl1' #-}
573−
574−-- -- | 'foldr', applied to a binary operator, a starting value (typically the
575−-- -- right-identity of the operator), and a stream, reduces the stream using the
576−-- -- binary operator, from right to left.
577−-- foldr :: (Char -> b -> b) -> b -> Stream Char -> b
578−-- -- foldr f z (Stream next s0 _len) = loop_foldr s0
579−-- foldr f z (Stream next s0) = loop_foldr s0
580−-- where
581−-- loop_foldr !s = case next s of
582−-- Done -> z
583−-- Skip s' -> loop_foldr s'
584−-- Yield x s' -> f x (loop_foldr s')
585−-- {-# INLINE [0] foldr #-}
586−
587−-- -- | foldr1 is a variant of 'foldr' that has no starting value argument,
588−-- -- and thus must be applied to non-empty streams.
589−-- -- Subject to array fusion.
590−-- foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char
591−-- -- foldr1 f (Stream next s0 _len) = loop0_foldr1 s0
592−-- foldr1 f (Stream next s0) = loop0_foldr1 s0
593−-- where
594−-- loop0_foldr1 !s = case next s of
595−-- Done -> emptyError "foldr1"
596−-- Skip s' -> loop0_foldr1 s'
597−-- Yield x s' -> loop_foldr1 x s'
598−
599−-- loop_foldr1 x !s = case next s of
600−-- Done -> x
601−-- Skip s' -> loop_foldr1 x s'
602−-- Yield x' s' -> f x (loop_foldr1 x' s')
603−-- {-# INLINE [0] foldr1 #-}
604−
605−-- intercalate :: Stream Char -> [Stream Char] -> Stream Char
606−-- intercalate s = concat . (L.intersperse s)
607−-- {-# INLINE [0] intercalate #-}
608−
609−-- -- ----------------------------------------------------------------------------
610−-- -- ** Special folds
611−
612−-- -- | /O(n)/ Concatenate a list of streams. Subject to array fusion.
613−-- concat :: [Stream Char] -> Stream Char
614−-- concat = L.foldr append empty
615−-- {-# INLINE [0] concat #-}
616−
617−-- -- | Map a function over a stream that results in a stream and concatenate the
618−-- -- results.
619−-- concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char
620−-- concatMap f = foldr (append . f) empty
621−-- {-# INLINE [0] concatMap #-}
622−
623−-- -- | /O(n)/ any @p @xs determines if any character in the stream
624−-- -- @xs@ satisfies the predicate @p@.
625−-- any :: (Char -> Bool) -> Stream Char -> Bool
626−-- -- any p (Stream next0 s0 _len) = loop_any s0
627−-- any p (Stream next0 s0) = loop_any s0
628−-- where
629−-- loop_any !s = case next0 s of
630−-- Done -> False
631−-- Skip s' -> loop_any s'
632−-- Yield x s' | p x -> True
633−-- | otherwise -> loop_any s'
634−-- {-# INLINE [0] any #-}
635−
636−-- -- | /O(n)/ all @p @xs determines if all characters in the 'Text'
637−-- -- @xs@ satisfy the predicate @p@.
638−-- all :: (Char -> Bool) -> Stream Char -> Bool
639−-- -- all p (Stream next0 s0 _len) = loop_all s0
640−-- all p (Stream next0 s0) = loop_all s0
641−-- where
642−-- loop_all !s = case next0 s of
643−-- Done -> True
644−-- Skip s' -> loop_all s'
645−-- Yield x s' | p x -> loop_all s'
646−-- | otherwise -> False
647−-- {-# INLINE [0] all #-}
648−
649−-- -- | /O(n)/ maximum returns the maximum value from a stream, which must be
650−-- -- non-empty.
651−-- maximum :: Stream Char -> Char
652−-- -- maximum (Stream next0 s0 _len) = loop0_maximum s0
653−-- maximum (Stream next0 s0) = loop0_maximum s0
654−-- where
655−-- loop0_maximum !s = case next0 s of
656−-- Done -> emptyError "maximum"
657−-- Skip s' -> loop0_maximum s'
658−-- Yield x s' -> loop_maximum x s'
659−-- loop_maximum !z !s = case next0 s of
660−-- Done -> z
661−-- Skip s' -> loop_maximum z s'
662−-- Yield x s'
663−-- | x > z -> loop_maximum x s'
664−-- | otherwise -> loop_maximum z s'
665−-- {-# INLINE [0] maximum #-}
666−
667−-- -- | /O(n)/ minimum returns the minimum value from a 'Text', which must be
668−-- -- non-empty.
669−-- minimum :: Stream Char -> Char
670−-- -- minimum (Stream next0 s0 _len) = loop0_minimum s0
671−-- minimum (Stream next0 s0) = loop0_minimum s0
672−-- where
673−-- loop0_minimum !s = case next0 s of
674−-- Done -> emptyError "minimum"
675−-- Skip s' -> loop0_minimum s'
676−-- Yield x s' -> loop_minimum x s'
677−-- loop_minimum !z !s = case next0 s of
678−-- Done -> z
679−-- Skip s' -> loop_minimum z s'
680−-- Yield x s'
681−-- | x < z -> loop_minimum x s'
682−-- | otherwise -> loop_minimum z s'
683−-- {-# INLINE [0] minimum #-}
684−
685−-- -- -----------------------------------------------------------------------------
686−-- -- * Building streams
687−
688−-- scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
689−-- -- scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
690−-- scanl f z0 (Stream next0 s0) = Stream next (Scan1 z0 s0) -- (len+1) -- HINT maybe too low
691−-- where
692−-- {-# INLINE next #-}
693−-- next (Scan1 z s) = Yield z (Scan2 z s)
694−-- next (Scan2 z s) = case next0 s of
695−-- Yield x s' -> let !x' = f z x
696−-- in Yield x' (Scan2 x' s')
697−-- Skip s' -> Skip (Scan2 z s')
698−-- Done -> Done
699−-- {-# INLINE [0] scanl #-}
700−
701−-- -- -----------------------------------------------------------------------------
702−-- -- ** Generating and unfolding streams
703−
704−-- replicateCharI :: Integral a => a -> Char -> Stream Char
705−-- replicateCharI n c
706−-- | n < 0 = empty
707−-- | otherwise = Stream next 0 -- (fromIntegral n) -- HINT maybe too low
708−-- where
709−-- next i | i >= n = Done
710−-- | otherwise = Yield c (i + 1)
711−-- {-# INLINE [0] replicateCharI #-}
712−
713−-- data RI s = RI !s {-# UNPACK #-} !Int64
714−
715−-- replicateI :: Int64 -> Stream Char -> Stream Char
716−-- -- replicateI n (Stream next0 s0 len) =
717−-- replicateI n (Stream next0 s0) =
718−-- Stream next (RI s0 0) -- (fromIntegral (max 0 n) * len)
719−-- where
720−-- next (RI s k)
721−-- | k >= n = Done
722−-- | otherwise = case next0 s of
723−-- Done -> Skip (RI s0 (k+1))
724−-- Skip s' -> Skip (RI s' k)
725−-- Yield x s' -> Yield x (RI s' k)
726−-- {-# INLINE [0] replicateI #-}
727−
728−-- -- | /O(n)/, where @n@ is the length of the result. The unfoldr function
729−-- -- is analogous to the List 'unfoldr'. unfoldr builds a stream
730−-- -- from a seed value. The function takes the element and returns
731−-- -- Nothing if it is done producing the stream or returns Just
732−-- -- (a,b), in which case, a is the next Char in the string, and b is
733−-- -- the seed value for further production.
734−-- unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char
735−-- unfoldr f s0 = Stream next s0 -- 1 -- HINT maybe too low
736−-- where
737−-- {-# INLINE next #-}
738−-- next !s = case f s of
739−-- Nothing -> Done
740−-- Just (w, s') -> Yield w s'
741−-- {-# INLINE [0] unfoldr #-}
742−
743−-- -- | /O(n)/ Like 'unfoldr', 'unfoldrNI' builds a stream from a seed
744−-- -- value. However, the length of the result is limited by the
745−-- -- first argument to 'unfoldrNI'. This function is more efficient than
746−-- -- 'unfoldr' when the length of the result is known.
747−-- unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char
748−-- unfoldrNI n f s0 | n < 0 = empty
749−-- | otherwise = Stream next (0 :*: s0) -- (fromIntegral (n*2)) -- HINT maybe too high
750−-- where
751−-- {-# INLINE next #-}
752−-- next (z :*: s) = case f s of
753−-- Nothing -> Done
754−-- Just (w, s') | z >= n -> Done
755−-- | otherwise -> Yield w ((z + 1) :*: s')
756−-- {-# INLINE unfoldrNI #-}
757−
758−-- -------------------------------------------------------------------------------
759−-- -- * Substreams
760−
761−-- -- | /O(n)/ take n, applied to a stream, returns the prefix of the
762−-- -- stream of length @n@, or the stream itself if @n@ is greater than the
763−-- -- length of the stream.
764−-- take :: Integral a => a -> Stream Char -> Stream Char
765−-- take n0 (Stream next0 s0) =
766−-- -- take n0 (Stream next0 s0 len) =
767−-- Stream next (n0 :*: s0) -- (smaller len (fromIntegral (max 0 n0)))
768−-- where
769−-- {-# INLINE next #-}
770−-- next (n :*: s) | n <= 0 = Done
771−-- | otherwise = case next0 s of
772−-- Done -> Done
773−-- Skip s' -> Skip (n :*: s')
774−-- Yield x s' -> Yield x ((n-1) :*: s')
775−-- {-# INLINE [0] take #-}
776−
777−-- data Drop a s = NS !s
778−-- | JS !a !s
779−
780−-- -- | /O(n)/ drop n, applied to a stream, returns the suffix of the
781−-- -- stream after the first @n@ characters, or the empty stream if @n@
782−-- -- is greater than the length of the stream.
783−-- drop :: Integral a => a -> Stream Char -> Stream Char
784−-- -- drop n0 (Stream next0 s0 len) =
785−-- drop n0 (Stream next0 s0) =
786−-- Stream next (JS n0 s0) -- (len - fromIntegral (max 0 n0))
787−-- where
788−-- {-# INLINE next #-}
789−-- next (JS n s)
790−-- | n <= 0 = Skip (NS s)
791−-- | otherwise = case next0 s of
792−-- Done -> Done
793−-- Skip s' -> Skip (JS n s')
794−-- Yield _ s' -> Skip (JS (n-1) s')
795−-- next (NS s) = case next0 s of
796−-- Done -> Done
797−-- Skip s' -> Skip (NS s')
798−-- Yield x s' -> Yield x (NS s')
799−-- {-# INLINE [0] drop #-}
800−
801−-- -- | takeWhile, applied to a predicate @p@ and a stream, returns the
802−-- -- longest prefix (possibly empty) of elements that satisfy p.
803−-- takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char
804−-- -- takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
805−-- takeWhile p (Stream next0 s0) = Stream next s0 -- len -- HINT maybe too high
806−-- where
807−-- {-# INLINE next #-}
808−-- next !s = case next0 s of
809−-- Done -> Done
810−-- Skip s' -> Skip s'
811−-- Yield x s' | p x -> Yield x s'
812−-- | otherwise -> Done
813−-- {-# INLINE [0] takeWhile #-}
814−
815−-- -- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
816−-- dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
817−-- -- dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
818−-- dropWhile p (Stream next0 s0) = Stream next (L s0) -- len -- HINT maybe too high
819−-- where
820−-- {-# INLINE next #-}
821−-- next (L s) = case next0 s of
822−-- Done -> Done
823−-- Skip s' -> Skip (L s')
824−-- Yield x s' | p x -> Skip (L s')
825−-- | otherwise -> Yield x (R s')
826−-- next (R s) = case next0 s of
827−-- Done -> Done
828−-- Skip s' -> Skip (R s')
829−-- Yield x s' -> Yield x (R s')
830−-- {-# INLINE [0] dropWhile #-}
831−
832−-- -- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
833−-- -- 'True' iff the first is a prefix of the second.
834−-- isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool
835−-- -- isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
836−-- isPrefixOf (Stream next1 s1) (Stream next2 s2) = loop (next1 s1) (next2 s2)
837−-- where
838−-- loop Done _ = True
839−-- loop _ Done = False
840−-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
841−-- loop (Skip s1') x2 = loop (next1 s1') x2
842−-- loop x1 (Skip s2') = loop x1 (next2 s2')
843−-- loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
844−-- loop (next1 s1') (next2 s2')
845−-- {-# INLINE [0] isPrefixOf #-}
846−
847−-- -- ----------------------------------------------------------------------------
848−-- -- * Searching
849−
850−-- -------------------------------------------------------------------------------
851−-- -- ** Searching by equality
852−
853−-- -- | /O(n)/ elem is the stream membership predicate.
854−-- elem :: Char -> Stream Char -> Bool
855−-- -- elem w (Stream next s0 _len) = loop_elem s0
856−-- elem w (Stream next s0) = loop_elem s0
857−-- where
858−-- loop_elem !s = case next s of
859−-- Done -> False
860−-- Skip s' -> loop_elem s'
861−-- Yield x s' | x == w -> True
862−-- | otherwise -> loop_elem s'
863−-- {-# INLINE [0] elem #-}
864−
865−-- -------------------------------------------------------------------------------
866−-- -- ** Searching with a predicate
867−
868−-- -- | /O(n)/ The 'findBy' function takes a predicate and a stream,
869−-- -- and returns the first element in matching the predicate, or 'Nothing'
870−-- -- if there is no such element.
871−
872−-- findBy :: (Char -> Bool) -> Stream Char -> Maybe Char
873−-- -- findBy p (Stream next s0 _len) = loop_find s0
874−-- findBy p (Stream next s0) = loop_find s0
875−-- where
876−-- loop_find !s = case next s of
877−-- Done -> Nothing
878−-- Skip s' -> loop_find s'
879−-- Yield x s' | p x -> Just x
880−-- | otherwise -> loop_find s'
881−-- {-# INLINE [0] findBy #-}
882−
883−-- -- | /O(n)/ Stream index (subscript) operator, starting from 0.
884−-- indexI :: Integral a => Stream Char -> a -> Char
885−-- -- indexI (Stream next s0 _len) n0
886−-- indexI (Stream next s0) n0
887−-- | n0 < 0 = streamError "index" "Negative index"
888−-- | otherwise = loop_index n0 s0
889−-- where
890−-- loop_index !n !s = case next s of
891−-- Done -> streamError "index" "Index too large"
892−-- Skip s' -> loop_index n s'
893−-- Yield x s' | n == 0 -> x
894−-- | otherwise -> loop_index (n-1) s'
895−-- {-# INLINE [0] indexI #-}
896−
897−-- -- | /O(n)/ 'filter', applied to a predicate and a stream,
898−-- -- returns a stream containing those characters that satisfy the
899−-- -- predicate.
900−-- filter :: (Char -> Bool) -> Stream Char -> Stream Char
901−-- -- filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
902−-- filter p (Stream next0 s0) = Stream next s0 -- len -- HINT maybe too high
903−-- where
904−-- next !s = case next0 s of
905−-- Done -> Done
906−-- Skip s' -> Skip s'
907−-- Yield x s' | p x -> Yield x s'
908−-- | otherwise -> Skip s'
909−-- {-# INLINE [0] filter #-}
910−
911−-- {-# RULES
912−-- "STREAM filter/filter fusion" forall p q s.
913−-- filter p (filter q s) = filter (\x -> q x && p x) s
914−-- #-}
915−
916−-- -- | The 'findIndexI' function takes a predicate and a stream and
917−-- -- returns the index of the first element in the stream satisfying the
918−-- -- predicate.
919−-- findIndexI :: Integral a => (Char -> Bool) -> Stream Char -> Maybe a
920−-- findIndexI p s = case findIndicesI p s of
921−-- (i:_) -> Just i
922−-- _ -> Nothing
923−-- {-# INLINE [0] findIndexI #-}
924−
925−-- -- | The 'findIndicesI' function takes a predicate and a stream and
926−-- -- returns all indices of the elements in the stream satisfying the
927−-- -- predicate.
928−-- findIndicesI :: Integral a => (Char -> Bool) -> Stream Char -> [a]
929−-- -- findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0
930−-- findIndicesI p (Stream next s0) = loop_findIndex 0 s0
931−-- where
932−-- loop_findIndex !i !s = case next s of
933−-- Done -> []
934−-- Skip s' -> loop_findIndex i s' -- hmm. not caught by QC
935−-- Yield x s' | p x -> i : loop_findIndex (i+1) s'
936−-- | otherwise -> loop_findIndex (i+1) s'
937−-- {-# INLINE [0] findIndicesI #-}
938−
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"
17+module Data.Text.Internal.Fusion.Common
18+ (
19+ -- * Creation and elimination
20+ singleton
21+ , streamList
22+ , unstreamList
23+ , streamCString#
24+
25+ -- * Basic interface
26+ , cons
27+ , snoc
28+ , append
29+ , head
30+ , uncons
31+ , last
32+ , tail
33+ , init
34+ , null
35+ , lengthI
36+ , compareLengthI
37+ , isSingleton
38+
39+ -- * Transformations
40+ , map
41+ , intercalate
42+ , intersperse
43+
44+ -- ** Case conversion
45+ -- $case
46+ , toCaseFold
47+ , toLower
48+ , toTitle
49+ , toUpper
50+
51+ -- ** Justification
52+ , justifyLeftI
53+
54+ -- * Folds
55+ , foldl
56+ , foldl'
57+ , foldl1
58+ , foldl1'
59+ , foldr
60+ , foldr1
61+
62+ -- ** Special folds
63+ , concat
64+ , concatMap
65+ , any
66+ , all
67+ , maximum
68+ , minimum
69+
70+ -- * Construction
71+ -- ** Scans
72+ , scanl
73+
74+ -- ** Generation and unfolding
75+ , replicateCharI
76+ , replicateI
77+ , unfoldr
78+ , unfoldrNI
79+
80+ -- * Substrings
81+ -- ** Breaking strings
82+ , take
83+ , drop
84+ , takeWhile
85+ , dropWhile
86+
87+ -- * Predicates
88+ , isPrefixOf
89+
90+ -- * Searching
91+ , elem
92+ , filter
93+
94+ -- * Indexing
95+ , findBy
96+ , indexI
97+ , findIndexI
98+ , countCharI
99+
100+ -- * Zipping and unzipping
101+ , zipWith
102+ ) where
103+
104+import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
105+ Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),
106+ (&&), fromIntegral, otherwise)
107+import qualified Data.List as L
108+import qualified Prelude as P
109+import Data.Bits (shiftL)
110+import Data.Char (isLetter)
111+import Data.Int (Int64)
112+import Data.Text.Internal.Fusion.Types
113+import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,
114+ upperMapping)
115+import Data.Text.Internal.Fusion.Size
116+import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)
117+import GHC.Types (Char(..), Int(..))
118+
119+singleton :: Char -> Stream Char
120+singleton c = Stream next False 1
121+ where next False = Yield c True
122+ next True = Done
123+{-# INLINE [0] singleton #-}
124+
125+streamList :: [a] -> Stream a
126+{-# INLINE [0] streamList #-}
127+streamList s = Stream next s unknownSize
128+ where next [] = Done
129+ next (x:xs) = Yield x xs
130+
131+unstreamList :: Stream a -> [a]
132+unstreamList (Stream next s0 _len) = unfold s0
133+ where unfold !s = case next s of
134+ Done -> []
135+ Skip s' -> unfold s'
136+ Yield x s' -> x : unfold s'
137+{-# INLINE [0] unstreamList #-}
138+
139+{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}
140+
141+-- | Stream the UTF-8-like packed encoding used by GHC to represent
142+-- constant strings in generated code.
143+--
144+-- This encoding uses the byte sequence "\xc0\x80" to represent NUL,
145+-- and the string is NUL-terminated.
146+streamCString# :: Addr# -> Stream Char
147+streamCString# addr = Stream step 0 unknownSize
148+ where
149+ step !i
150+ | b == 0 = Done
151+ | b <= 0x7f = Yield (C# b#) (i+1)
152+ | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1
153+ in Yield c (i+2)
154+ | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +
155+ (next 1 `shiftL` 6) +
156+ next 2
157+ in Yield c (i+3)
158+ | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +
159+ (next 1 `shiftL` 12) +
160+ (next 2 `shiftL` 6) +
161+ next 3
162+ in Yield c (i+4)
163+ where b = I# (ord# b#)
164+ next n = I# (ord# (at# (i+n))) - 0x80
165+ !b# = at# i
166+ at# (I# i#) = indexCharOffAddr# addr i#
167+ chr (I# i#) = C# (chr# i#)
168+{-# INLINE [0] streamCString# #-}
169+
170+-- ----------------------------------------------------------------------------
171+-- * Basic stream functions
172+
173+data C s = C0 !s
174+ | C1 !s
175+
176+-- | /O(n)/ Adds a character to the front of a Stream Char.
177+cons :: Char -> Stream Char -> Stream Char
178+cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
179+ where
180+ next (C1 s) = Yield w (C0 s)
181+ next (C0 s) = case next0 s of
182+ Done -> Done
183+ Skip s' -> Skip (C0 s')
184+ Yield x s' -> Yield x (C0 s')
185+{-# INLINE [0] cons #-}
186+
187+data Snoc a = N
188+ | J !a
189+
190+-- | /O(n)/ Adds a character to the end of a stream.
191+snoc :: Stream Char -> Char -> Stream Char
192+snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
193+ where
194+ next (J xs) = case next0 xs of
195+ Done -> Yield w N
196+ Skip xs' -> Skip (J xs')
197+ Yield x xs' -> Yield x (J xs')
198+ next N = Done
199+{-# INLINE [0] snoc #-}
200+
201+data E l r = L !l
202+ | R !r
203+
204+-- | /O(n)/ Appends one Stream to the other.
205+append :: Stream Char -> Stream Char -> Stream Char
206+append (Stream next0 s01 len1) (Stream next1 s02 len2) =
207+ Stream next (L s01) (len1 + len2)
208+ where
209+ next (L s1) = case next0 s1 of
210+ Done -> Skip (R s02)
211+ Skip s1' -> Skip (L s1')
212+ Yield x s1' -> Yield x (L s1')
213+ next (R s2) = case next1 s2 of
214+ Done -> Done
215+ Skip s2' -> Skip (R s2')
216+ Yield x s2' -> Yield x (R s2')
217+{-# INLINE [0] append #-}
218+
219+-- | /O(1)/ Returns the first character of a Text, which must be non-empty.
220+-- Subject to array fusion.
221+head :: Stream Char -> Char
222+head (Stream next s0 _len) = loop_head s0
223+ where
224+ loop_head !s = case next s of
225+ Yield x _ -> x
226+ Skip s' -> loop_head s'
227+ Done -> head_empty
228+{-# INLINE [0] head #-}
229+
230+head_empty :: a
231+head_empty = streamError "head" "Empty stream"
232+{-# NOINLINE head_empty #-}
233+
234+-- | /O(1)/ Returns the first character and remainder of a 'Stream
235+-- Char', or 'Nothing' if empty. Subject to array fusion.
236+uncons :: Stream Char -> Maybe (Char, Stream Char)
237+uncons (Stream next s0 len) = loop_uncons s0
238+ where
239+ loop_uncons !s = case next s of
240+ Yield x s1 -> Just (x, Stream next s1 (len-1))
241+ Skip s' -> loop_uncons s'
242+ Done -> Nothing
243+{-# INLINE [0] uncons #-}
244+
245+-- | /O(n)/ Returns the last character of a 'Stream Char', which must
246+-- be non-empty.
247+last :: Stream Char -> Char
248+last (Stream next s0 _len) = loop0_last s0
249+ where
250+ loop0_last !s = case next s of
251+ Done -> emptyError "last"
252+ Skip s' -> loop0_last s'
253+ Yield x s' -> loop_last x s'
254+ loop_last !x !s = case next s of
255+ Done -> x
256+ Skip s' -> loop_last x s'
257+ Yield x' s' -> loop_last x' s'
258+{-# INLINE[0] last #-}
259+
260+-- | /O(1)/ Returns all characters after the head of a Stream Char, which must
261+-- be non-empty.
262+tail :: Stream Char -> Stream Char
263+tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)
264+ where
265+ next (C0 s) = case next0 s of
266+ Done -> emptyError "tail"
267+ Skip s' -> Skip (C0 s')
268+ Yield _ s' -> Skip (C1 s')
269+ next (C1 s) = case next0 s of
270+ Done -> Done
271+ Skip s' -> Skip (C1 s')
272+ Yield x s' -> Yield x (C1 s')
273+{-# INLINE [0] tail #-}
274+
275+data Init s = Init0 !s
276+ | Init1 {-# UNPACK #-} !Char !s
277+
278+-- | /O(1)/ Returns all but the last character of a Stream Char, which
279+-- must be non-empty.
280+init :: Stream Char -> Stream Char
281+init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)
282+ where
283+ next (Init0 s) = case next0 s of
284+ Done -> emptyError "init"
285+ Skip s' -> Skip (Init0 s')
286+ Yield x s' -> Skip (Init1 x s')
287+ next (Init1 x s) = case next0 s of
288+ Done -> Done
289+ Skip s' -> Skip (Init1 x s')
290+ Yield x' s' -> Yield x (Init1 x' s')
291+{-# INLINE [0] init #-}
292+
293+-- | /O(1)/ Tests whether a Stream Char is empty or not.
294+null :: Stream Char -> Bool
295+null (Stream next s0 _len) = loop_null s0
296+ where
297+ loop_null !s = case next s of
298+ Done -> True
299+ Yield _ _ -> False
300+ Skip s' -> loop_null s'
301+{-# INLINE[0] null #-}
302+
303+-- | /O(n)/ Returns the number of characters in a string.
304+lengthI :: Integral a => Stream Char -> a
305+lengthI (Stream next s0 _len) = loop_length 0 s0
306+ where
307+ loop_length !z s = case next s of
308+ Done -> z
309+ Skip s' -> loop_length z s'
310+ Yield _ s' -> loop_length (z + 1) s'
311+{-# INLINE[0] lengthI #-}
312+
313+-- | /O(n)/ Compares the count of characters in a string to a number.
314+-- Subject to fusion.
315+--
316+-- This function gives the same answer as comparing against the result
317+-- of 'lengthI', but can short circuit if the count of characters is
318+-- greater than the number or if the stream can't possibly be as long
319+-- as the number supplied, and hence be more efficient.
320+compareLengthI :: Integral a => Stream Char -> a -> Ordering
321+compareLengthI (Stream next s0 len) n =
322+ case compareSize len (fromIntegral n) of
323+ Just o -> o
324+ Nothing -> loop_cmp 0 s0
325+ where
326+ loop_cmp !z s = case next s of
327+ Done -> compare z n
328+ Skip s' -> loop_cmp z s'
329+ Yield _ s' | z > n -> GT
330+ | otherwise -> loop_cmp (z + 1) s'
331+{-# INLINE[0] compareLengthI #-}
332+
333+-- | /O(n)/ Indicate whether a string contains exactly one element.
334+isSingleton :: Stream Char -> Bool
335+isSingleton (Stream next s0 _len) = loop 0 s0
336+ where
337+ loop !z s = case next s of
338+ Done -> z == (1::Int)
339+ Skip s' -> loop z s'
340+ Yield _ s'
341+ | z >= 1 -> False
342+ | otherwise -> loop (z+1) s'
343+{-# INLINE[0] isSingleton #-}
344+
345+-- ----------------------------------------------------------------------------
346+-- * Stream transformations
347+
348+-- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@
349+-- to each element of @xs@.
350+map :: (Char -> Char) -> Stream Char -> Stream Char
351+map f (Stream next0 s0 len) = Stream next s0 len
352+ where
353+ next !s = case next0 s of
354+ Done -> Done
355+ Skip s' -> Skip s'
356+ Yield x s' -> Yield (f x) s'
357+{-# INLINE [0] map #-}
358+
359+{-#
360+ RULES "STREAM map/map fusion" forall f g s.
361+ map f (map g s) = map (\x -> f (g x)) s
362+ #-}
363+
364+data I s = I1 !s
365+ | I2 !s {-# UNPACK #-} !Char
366+ | I3 !s
367+
368+-- | /O(n)/ Take a character and place it between each of the
369+-- characters of a 'Stream Char'.
370+intersperse :: Char -> Stream Char -> Stream Char
371+intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len
372+ where
373+ next (I1 s) = case next0 s of
374+ Done -> Done
375+ Skip s' -> Skip (I1 s')
376+ Yield x s' -> Skip (I2 s' x)
377+ next (I2 s x) = Yield x (I3 s)
378+ next (I3 s) = case next0 s of
379+ Done -> Done
380+ Skip s' -> Skip (I3 s')
381+ Yield x s' -> Yield c (I2 s' x)
382+{-# INLINE [0] intersperse #-}
383+
384+-- ----------------------------------------------------------------------------
385+-- ** Case conversions (folds)
386+
387+-- $case
388+--
389+-- With Unicode text, it is incorrect to use combinators like @map
390+-- toUpper@ to case convert each character of a string individually.
391+-- Instead, use the whole-string case conversion functions from this
392+-- module. For correctness in different writing systems, these
393+-- functions may map one input character to two or three output
394+-- characters.
395+
396+caseConvert :: (forall s. Char -> s -> Step (CC s) Char)
397+ -> Stream Char -> Stream Char
398+caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len
399+ where
400+ next (CC s '\0' _) =
401+ case next0 s of
402+ Done -> Done
403+ Skip s' -> Skip (CC s' '\0' '\0')
404+ Yield c s' -> remap c s'
405+ next (CC s a b) = Yield a (CC s b '\0')
406+
407+-- | /O(n)/ Convert a string to folded case. This function is mainly
408+-- useful for performing caseless (or case insensitive) string
409+-- comparisons.
410+--
411+-- A string @x@ is a caseless match for a string @y@ if and only if:
412+--
413+-- @toCaseFold x == toCaseFold y@
414+--
415+-- The result string may be longer than the input string, and may
416+-- differ from applying 'toLower' to the input string. For instance,
417+-- the Armenian small ligature men now (U+FB13) is case folded to the
418+-- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is
419+-- case folded to the Greek small letter letter mu (U+03BC) instead of
420+-- itself.
421+toCaseFold :: Stream Char -> Stream Char
422+toCaseFold = caseConvert foldMapping
423+{-# INLINE [0] toCaseFold #-}
424+
425+-- | /O(n)/ Convert a string to upper case, using simple case
426+-- conversion. The result string may be longer than the input string.
427+-- For instance, the German eszett (U+00DF) maps to the two-letter
428+-- sequence SS.
429+toUpper :: Stream Char -> Stream Char
430+toUpper = caseConvert upperMapping
431+{-# INLINE [0] toUpper #-}
432+
433+-- | /O(n)/ Convert a string to lower case, using simple case
434+-- conversion. The result string may be longer than the input string.
435+-- For instance, the Latin capital letter I with dot above (U+0130)
436+-- maps to the sequence Latin small letter i (U+0069) followed by
437+-- combining dot above (U+0307).
438+toLower :: Stream Char -> Stream Char
439+toLower = caseConvert lowerMapping
440+{-# INLINE [0] toLower #-}
441+
442+-- | /O(n)/ Convert a string to title case, using simple case
443+-- conversion.
444+--
445+-- The first letter of the input is converted to title case, as is
446+-- every subsequent letter that immediately follows a non-letter.
447+-- Every letter that immediately follows another letter is converted
448+-- to lower case.
449+--
450+-- The result string may be longer than the input string. For example,
451+-- the Latin small ligature &#xfb02; (U+FB02) is converted to the
452+-- sequence Latin capital letter F (U+0046) followed by Latin small
453+-- letter l (U+006C).
454+--
455+-- /Note/: this function does not take language or culture specific
456+-- rules into account. For instance, in English, different style
457+-- guides disagree on whether the book name \"The Hill of the Red
458+-- Fox\" is correctly title cased&#x2014;but this function will
459+-- capitalize /every/ word.
460+toTitle :: Stream Char -> Stream Char
461+toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len
462+ where
463+ next (CC (letter :*: s) '\0' _) =
464+ case next0 s of
465+ Done -> Done
466+ Skip s' -> Skip (CC (letter :*: s') '\0' '\0')
467+ Yield c s'
468+ | letter' -> if letter
469+ then lowerMapping c (letter' :*: s')
470+ else titleMapping c (letter' :*: s')
471+ | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')
472+ where letter' = isLetter c
473+ next (CC s a b) = Yield a (CC s b '\0')
474+{-# INLINE [0] toTitle #-}
475+
476+data Justify i s = Just1 !i !s
477+ | Just2 !i !s
478+
479+justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
480+justifyLeftI k c (Stream next0 s0 len) =
481+ Stream next (Just1 0 s0) (larger (fromIntegral k) len)
482+ where
483+ next (Just1 n s) =
484+ case next0 s of
485+ Done -> next (Just2 n s)
486+ Skip s' -> Skip (Just1 n s')
487+ Yield x s' -> Yield x (Just1 (n+1) s')
488+ next (Just2 n s)
489+ | n < k = Yield c (Just2 (n+1) s)
490+ | otherwise = Done
491+ {-# INLINE next #-}
492+{-# INLINE [0] justifyLeftI #-}
493+
494+-- ----------------------------------------------------------------------------
495+-- * Reducing Streams (folds)
496+
497+-- | foldl, applied to a binary operator, a starting value (typically the
498+-- left-identity of the operator), and a Stream, reduces the Stream using the
499+-- binary operator, from left to right.
500+foldl :: (b -> Char -> b) -> b -> Stream Char -> b
501+foldl f z0 (Stream next s0 _len) = loop_foldl z0 s0
502+ where
503+ loop_foldl z !s = case next s of
504+ Done -> z
505+ Skip s' -> loop_foldl z s'
506+ Yield x s' -> loop_foldl (f z x) s'
507+{-# INLINE [0] foldl #-}
508+
509+-- | A strict version of foldl.
510+foldl' :: (b -> Char -> b) -> b -> Stream Char -> b
511+foldl' f z0 (Stream next s0 _len) = loop_foldl' z0 s0
512+ where
513+ loop_foldl' !z !s = case next s of
514+ Done -> z
515+ Skip s' -> loop_foldl' z s'
516+ Yield x s' -> loop_foldl' (f z x) s'
517+{-# INLINE [0] foldl' #-}
518+
519+-- | foldl1 is a variant of foldl that has no starting value argument,
520+-- and thus must be applied to non-empty Streams.
521+foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char
522+foldl1 f (Stream next s0 _len) = loop0_foldl1 s0
523+ where
524+ loop0_foldl1 !s = case next s of
525+ Skip s' -> loop0_foldl1 s'
526+ Yield x s' -> loop_foldl1 x s'
527+ Done -> emptyError "foldl1"
528+ loop_foldl1 z !s = case next s of
529+ Done -> z
530+ Skip s' -> loop_foldl1 z s'
531+ Yield x s' -> loop_foldl1 (f z x) s'
532+{-# INLINE [0] foldl1 #-}
533+
534+-- | A strict version of foldl1.
535+foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char
536+foldl1' f (Stream next s0 _len) = loop0_foldl1' s0
537+ where
538+ loop0_foldl1' !s = case next s of
539+ Skip s' -> loop0_foldl1' s'
540+ Yield x s' -> loop_foldl1' x s'
541+ Done -> emptyError "foldl1"
542+ loop_foldl1' !z !s = case next s of
543+ Done -> z
544+ Skip s' -> loop_foldl1' z s'
545+ Yield x s' -> loop_foldl1' (f z x) s'
546+{-# INLINE [0] foldl1' #-}
547+
548+-- | 'foldr', applied to a binary operator, a starting value (typically the
549+-- right-identity of the operator), and a stream, reduces the stream using the
550+-- binary operator, from right to left.
551+foldr :: (Char -> b -> b) -> b -> Stream Char -> b
552+foldr f z (Stream next s0 _len) = loop_foldr s0
553+ where
554+ loop_foldr !s = case next s of
555+ Done -> z
556+ Skip s' -> loop_foldr s'
557+ Yield x s' -> f x (loop_foldr s')
558+{-# INLINE [0] foldr #-}
559+
560+-- | foldr1 is a variant of 'foldr' that has no starting value argument,
561+-- and thus must be applied to non-empty streams.
562+-- Subject to array fusion.
563+foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char
564+foldr1 f (Stream next s0 _len) = loop0_foldr1 s0
565+ where
566+ loop0_foldr1 !s = case next s of
567+ Done -> emptyError "foldr1"
568+ Skip s' -> loop0_foldr1 s'
569+ Yield x s' -> loop_foldr1 x s'
570+
571+ loop_foldr1 x !s = case next s of
572+ Done -> x
573+ Skip s' -> loop_foldr1 x s'
574+ Yield x' s' -> f x (loop_foldr1 x' s')
575+{-# INLINE [0] foldr1 #-}
576+
577+intercalate :: Stream Char -> [Stream Char] -> Stream Char
578+intercalate s = concat . (L.intersperse s)
579+{-# INLINE [0] intercalate #-}
580+
581+-- ----------------------------------------------------------------------------
582+-- ** Special folds
583+
584+-- | /O(n)/ Concatenate a list of streams. Subject to array fusion.
585+concat :: [Stream Char] -> Stream Char
586+concat = L.foldr append empty
587+{-# INLINE [0] concat #-}
588+
589+-- | Map a function over a stream that results in a stream and concatenate the
590+-- results.
591+concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char
592+concatMap f = foldr (append . f) empty
593+{-# INLINE [0] concatMap #-}
594+
595+-- | /O(n)/ any @p @xs determines if any character in the stream
596+-- @xs@ satisfies the predicate @p@.
597+any :: (Char -> Bool) -> Stream Char -> Bool
598+any p (Stream next0 s0 _len) = loop_any s0
599+ where
600+ loop_any !s = case next0 s of
601+ Done -> False
602+ Skip s' -> loop_any s'
603+ Yield x s' | p x -> True
604+ | otherwise -> loop_any s'
605+{-# INLINE [0] any #-}
606+
607+-- | /O(n)/ all @p @xs determines if all characters in the 'Text'
608+-- @xs@ satisfy the predicate @p@.
609+all :: (Char -> Bool) -> Stream Char -> Bool
610+all p (Stream next0 s0 _len) = loop_all s0
611+ where
612+ loop_all !s = case next0 s of
613+ Done -> True
614+ Skip s' -> loop_all s'
615+ Yield x s' | p x -> loop_all s'
616+ | otherwise -> False
617+{-# INLINE [0] all #-}
618+
619+-- | /O(n)/ maximum returns the maximum value from a stream, which must be
620+-- non-empty.
621+maximum :: Stream Char -> Char
622+maximum (Stream next0 s0 _len) = loop0_maximum s0
623+ where
624+ loop0_maximum !s = case next0 s of
625+ Done -> emptyError "maximum"
626+ Skip s' -> loop0_maximum s'
627+ Yield x s' -> loop_maximum x s'
628+ loop_maximum !z !s = case next0 s of
629+ Done -> z
630+ Skip s' -> loop_maximum z s'
631+ Yield x s'
632+ | x > z -> loop_maximum x s'
633+ | otherwise -> loop_maximum z s'
634+{-# INLINE [0] maximum #-}
635+
636+-- | /O(n)/ minimum returns the minimum value from a 'Text', which must be
637+-- non-empty.
638+minimum :: Stream Char -> Char
639+minimum (Stream next0 s0 _len) = loop0_minimum s0
640+ where
641+ loop0_minimum !s = case next0 s of
642+ Done -> emptyError "minimum"
643+ Skip s' -> loop0_minimum s'
644+ Yield x s' -> loop_minimum x s'
645+ loop_minimum !z !s = case next0 s of
646+ Done -> z
647+ Skip s' -> loop_minimum z s'
648+ Yield x s'
649+ | x < z -> loop_minimum x s'
650+ | otherwise -> loop_minimum z s'
651+{-# INLINE [0] minimum #-}
652+
653+-- -----------------------------------------------------------------------------
654+-- * Building streams
655+
656+scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
657+scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
658+ where
659+ {-# INLINE next #-}
660+ next (Scan1 z s) = Yield z (Scan2 z s)
661+ next (Scan2 z s) = case next0 s of
662+ Yield x s' -> let !x' = f z x
663+ in Yield x' (Scan2 x' s')
664+ Skip s' -> Skip (Scan2 z s')
665+ Done -> Done
666+{-# INLINE [0] scanl #-}
667+
668+-- -----------------------------------------------------------------------------
669+-- ** Generating and unfolding streams
670+
671+replicateCharI :: Integral a => a -> Char -> Stream Char
672+replicateCharI !n !c
673+ | n < 0 = empty
674+ | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
675+ where
676+ next !i | i >= n = Done
677+ | otherwise = Yield c (i + 1)
678+{-# INLINE [0] replicateCharI #-}
679+
680+data RI s = RI !s {-# UNPACK #-} !Int64
681+
682+replicateI :: Int64 -> Stream Char -> Stream Char
683+replicateI n (Stream next0 s0 len) =
684+ Stream next (RI s0 0) (fromIntegral (max 0 n) * len)
685+ where
686+ next (RI s k)
687+ | k >= n = Done
688+ | otherwise = case next0 s of
689+ Done -> Skip (RI s0 (k+1))
690+ Skip s' -> Skip (RI s' k)
691+ Yield x s' -> Yield x (RI s' k)
692+{-# INLINE [0] replicateI #-}
693+
694+-- | /O(n)/, where @n@ is the length of the result. The unfoldr function
695+-- is analogous to the List 'unfoldr'. unfoldr builds a stream
696+-- from a seed value. The function takes the element and returns
697+-- Nothing if it is done producing the stream or returns Just
698+-- (a,b), in which case, a is the next Char in the string, and b is
699+-- the seed value for further production.
700+unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char
701+unfoldr f s0 = Stream next s0 1 -- HINT maybe too low
702+ where
703+ {-# INLINE next #-}
704+ next !s = case f s of
705+ Nothing -> Done
706+ Just (w, s') -> Yield w s'
707+{-# INLINE [0] unfoldr #-}
708+
709+-- | /O(n)/ Like 'unfoldr', 'unfoldrNI' builds a stream from a seed
710+-- value. However, the length of the result is limited by the
711+-- first argument to 'unfoldrNI'. This function is more efficient than
712+-- 'unfoldr' when the length of the result is known.
713+unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char
714+unfoldrNI n f s0 | n < 0 = empty
715+ | otherwise = Stream next (0 :*: s0) (fromIntegral (n*2)) -- HINT maybe too high
716+ where
717+ {-# INLINE next #-}
718+ next (z :*: s) = case f s of
719+ Nothing -> Done
720+ Just (w, s') | z >= n -> Done
721+ | otherwise -> Yield w ((z + 1) :*: s')
722+{-# INLINE unfoldrNI #-}
723+
724+-------------------------------------------------------------------------------
725+-- * Substreams
726+
727+-- | /O(n)/ take n, applied to a stream, returns the prefix of the
728+-- stream of length @n@, or the stream itself if @n@ is greater than the
729+-- length of the stream.
730+take :: Integral a => a -> Stream Char -> Stream Char
731+take n0 (Stream next0 s0 len) =
732+ Stream next (n0 :*: s0) (smaller len (fromIntegral (max 0 n0)))
733+ where
734+ {-# INLINE next #-}
735+ next (n :*: s) | n <= 0 = Done
736+ | otherwise = case next0 s of
737+ Done -> Done
738+ Skip s' -> Skip (n :*: s')
739+ Yield x s' -> Yield x ((n-1) :*: s')
740+{-# INLINE [0] take #-}
741+
742+data Drop a s = NS !s
743+ | JS !a !s
744+
745+-- | /O(n)/ drop n, applied to a stream, returns the suffix of the
746+-- stream after the first @n@ characters, or the empty stream if @n@
747+-- is greater than the length of the stream.
748+drop :: Integral a => a -> Stream Char -> Stream Char
749+drop n0 (Stream next0 s0 len) =
750+ Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))
751+ where
752+ {-# INLINE next #-}
753+ next (JS n s)
754+ | n <= 0 = Skip (NS s)
755+ | otherwise = case next0 s of
756+ Done -> Done
757+ Skip s' -> Skip (JS n s')
758+ Yield _ s' -> Skip (JS (n-1) s')
759+ next (NS s) = case next0 s of
760+ Done -> Done
761+ Skip s' -> Skip (NS s')
762+ Yield x s' -> Yield x (NS s')
763+{-# INLINE [0] drop #-}
764+
765+-- | takeWhile, applied to a predicate @p@ and a stream, returns the
766+-- longest prefix (possibly empty) of elements that satisfy p.
767+takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char
768+takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
769+ where
770+ {-# INLINE next #-}
771+ next !s = case next0 s of
772+ Done -> Done
773+ Skip s' -> Skip s'
774+ Yield x s' | p x -> Yield x s'
775+ | otherwise -> Done
776+{-# INLINE [0] takeWhile #-}
777+
778+-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
779+dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
780+dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
781+ where
782+ {-# INLINE next #-}
783+ next (L s) = case next0 s of
784+ Done -> Done
785+ Skip s' -> Skip (L s')
786+ Yield x s' | p x -> Skip (L s')
787+ | otherwise -> Yield x (R s')
788+ next (R s) = case next0 s of
789+ Done -> Done
790+ Skip s' -> Skip (R s')
791+ Yield x s' -> Yield x (R s')
792+{-# INLINE [0] dropWhile #-}
793+
794+-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
795+-- 'True' iff the first is a prefix of the second.
796+isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool
797+isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
798+ where
799+ loop Done _ = True
800+ loop _ Done = False
801+ loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
802+ loop (Skip s1') x2 = loop (next1 s1') x2
803+ loop x1 (Skip s2') = loop x1 (next2 s2')
804+ loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
805+ loop (next1 s1') (next2 s2')
806+{-# INLINE [0] isPrefixOf #-}
807+
808+-- ----------------------------------------------------------------------------
809+-- * Searching
810+
811+-------------------------------------------------------------------------------
812+-- ** Searching by equality
813+
814+-- | /O(n)/ elem is the stream membership predicate.
815+elem :: Char -> Stream Char -> Bool
816+elem w (Stream next s0 _len) = loop_elem s0
817+ where
818+ loop_elem !s = case next s of
819+ Done -> False
820+ Skip s' -> loop_elem s'
821+ Yield x s' | x == w -> True
822+ | otherwise -> loop_elem s'
823+{-# INLINE [0] elem #-}
824+
825+-------------------------------------------------------------------------------
826+-- ** Searching with a predicate
827+
828+-- | /O(n)/ The 'findBy' function takes a predicate and a stream,
829+-- and returns the first element in matching the predicate, or 'Nothing'
830+-- if there is no such element.
831+
832+findBy :: (Char -> Bool) -> Stream Char -> Maybe Char
833+findBy p (Stream next s0 _len) = loop_find s0
834+ where
835+ loop_find !s = case next s of
836+ Done -> Nothing
837+ Skip s' -> loop_find s'
838+ Yield x s' | p x -> Just x
839+ | otherwise -> loop_find s'
840+{-# INLINE [0] findBy #-}
841+
842+-- | /O(n)/ Stream index (subscript) operator, starting from 0.
843+indexI :: Integral a => Stream Char -> a -> Char
844+indexI (Stream next s0 _len) n0
845+ | n0 < 0 = streamError "index" "Negative index"
846+ | otherwise = loop_index n0 s0
847+ where
848+ loop_index !n !s = case next s of
849+ Done -> streamError "index" "Index too large"
850+ Skip s' -> loop_index n s'
851+ Yield x s' | n == 0 -> x
852+ | otherwise -> loop_index (n-1) s'
853+{-# INLINE [0] indexI #-}
854+
855+-- | /O(n)/ 'filter', applied to a predicate and a stream,
856+-- returns a stream containing those characters that satisfy the
857+-- predicate.
858+filter :: (Char -> Bool) -> Stream Char -> Stream Char
859+filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
860+ where
861+ next !s = case next0 s of
862+ Done -> Done
863+ Skip s' -> Skip s'
864+ Yield x s' | p x -> Yield x s'
865+ | otherwise -> Skip s'
866+{-# INLINE [0] filter #-}
867+
868+{-# RULES
869+ "STREAM filter/filter fusion" forall p q s.
870+ filter p (filter q s) = filter (\x -> q x && p x) s
871+ #-}
872+
873+-- | The 'findIndexI' function takes a predicate and a stream and
874+-- returns the index of the first element in the stream satisfying the
875+-- predicate.
876+findIndexI :: Integral a => (Char -> Bool) -> Stream Char -> Maybe a
877+findIndexI p s = case findIndicesI p s of
878+ (i:_) -> Just i
879+ _ -> Nothing
880+{-# INLINE [0] findIndexI #-}
881+
882+-- | The 'findIndicesI' function takes a predicate and a stream and
883+-- returns all indices of the elements in the stream satisfying the
884+-- predicate.
885+findIndicesI :: Integral a => (Char -> Bool) -> Stream Char -> [a]
886+findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0
887+ where
888+ loop_findIndex !i !s = case next s of
889+ Done -> []
890+ Skip s' -> loop_findIndex i s' -- hmm. not caught by QC
891+ Yield x s' | p x -> i : loop_findIndex (i+1) s'
892+ | otherwise -> loop_findIndex (i+1) s'
893+{-# INLINE [0] findIndicesI #-}
894+
895+-------------------------------------------------------------------------------
896+-- * Zipping
897+
898+-- | Strict triple.
899+data Zip a b m = Z1 !a !b
900+ | Z2 !a !b !m
901+
902+-- | zipWith generalises 'zip' by zipping with the function given as
903+-- the first argument, instead of a tupling function.
904+zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
905+zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
906+ Stream next (Z1 sa0 sb0) (smaller len1 len2)
907+ where
908+ next (Z1 sa sb) = case next0 sa of
909+ Done -> Done
910+ Skip sa' -> Skip (Z1 sa' sb)
911+ Yield a sa' -> Skip (Z2 sa' sb a)
912+
913+ next (Z2 sa' sb a) = case next1 sb of
914+ Done -> Done
915+ Skip sb' -> Skip (Z2 sa' sb' a)
916+ Yield b sb' -> Yield (f a b) (Z1 sa' sb')
917+{-# INLINE [0] zipWith #-}
918+
919+-- | /O(n)/ The 'countCharI' function returns the number of times the
920+-- query element appears in the given stream.
921+countCharI :: Integral a => Char -> Stream Char -> a
922+countCharI a (Stream next s0 _len) = loop 0 s0
923+ where
924+ loop !i !s = case next s of
925+ Done -> i
926+ Skip s' -> loop i s'
927+ Yield x s' | a == x -> loop (i+1) s'
928+ | otherwise -> loop i s'
929+{-# INLINE [0] countCharI #-}
930+
931+streamError :: String -> String -> a
932+streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg
933+
934+emptyError :: String -> a
935+emptyError func = internalError func "Empty input"
936+
937+internalError :: String -> a
938+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 #-}
22{-# OPTIONS_GHC -fno-warn-missing-methods #-}
33-- |
44-- Module : Data.Text.Internal.Fusion.Internal
@@ -19,16 +19,11 @@
1919module Data.Text.Internal.Fusion.Size
2020 (
2121 Size
22− -- * Sizes
22+ , exactly
2323 , exactSize
2424 , maxSize
2525 , betweenSize
2626 , unknownSize
27− , unionSize
28− , charSize
29− , codePointsSize
30− -- * Querying sizes
31− , exactly
3227 , smaller
3328 , larger
3429 , upperBound
@@ -37,13 +32,11 @@ module Data.Text.Internal.Fusion.Size
3732 , isEmpty
3833 ) where
3934
40−import Data.Char (ord)
4135import Data.Text.Internal (mul)
4236#if defined(ASSERTS)
4337import Control.Exception (assert)
4438#endif
4539
46−-- | A size in UTF-16 code units.
4740data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.
4841 | Unknown -- ^ Unknown size.
4942 deriving (Eq, Show)
@@ -53,17 +46,6 @@ exactly (Between na nb) | na == nb = Just na
5346exactly _ = Nothing
5447{-# INLINE exactly #-}
5548
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−
6749exactSize :: Int -> Size
6850exactSize n =
6951#if defined(ASSERTS)
@@ -89,10 +71,6 @@ betweenSize m n =
8971 Between m n
9072{-# INLINE betweenSize #-}
9173
92−unionSize :: Size -> Size -> Size
93−unionSize (Between a b) (Between c d) = Between (min a c) (max b d)
94−unionSize _ _ = Unknown
95−
9674unknownSize :: Size
9775unknownSize = Unknown
9876{-# INLINE unknownSize #-}
@@ -162,15 +140,11 @@ lowerBound _ (Between n _) = n
162140lowerBound k _ = k
163141{-# INLINE lowerBound #-}
164142
165−-- | Determine the ordering relationship between two 'Size's, or 'Nothing' in
166−-- the indeterminate case.
167−compareSize :: Size -> Size -> Maybe Ordering
168−compareSize (Between ma mb) (Between na nb)
169− | mb < na = Just LT
170− | ma > nb = Just GT
171− | ma == mb
172− , ma == na
173− , ma == nb = Just EQ
143+compareSize :: Size -> Int -> Maybe Ordering
144+compareSize (Between ma mb) n
145+ | mb < n = Just LT
146+ | ma > n = Just GT
147+ | ma == n && mb == n = Just EQ
174148compareSize _ _ = Nothing
175149
176150
Data/Text/Internal/Fusion/Types.hs+99−102
@@ -19,107 +19,104 @@
1919
2020module Data.Text.Internal.Fusion.Types
2121 (
22− -- CC(..)
23− -- , PairS(..)
24− -- , Scan(..)
25− -- , RS(..)
26− -- , Step(..)
27− -- , Stream(..)
28− -- , empty
29− module Data.JSString.Internal.Fusion.Types
22+ CC(..)
23+ , PairS(..)
24+ , Scan(..)
25+ , RS(..)
26+ , Step(..)
27+ , Stream(..)
28+ , empty
3029 ) where
3130
32−-- import Data.Text.Internal.Fusion.Size
33−-- import Data.Word (Word8)
34−
35−import Data.JSString.Internal.Fusion.Types
36−
37−-- -- | Specialised tuple for case conversion.
38−-- data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char
39−
40−-- -- | Restreaming state.
41−-- data RS s
42−-- = RS0 !s
43−-- | RS1 !s {-# UNPACK #-} !Word8
44−-- | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
45−-- | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
46−
47−-- -- | Strict pair.
48−-- data PairS a b = !a :*: !b
49−-- -- deriving (Eq, Ord, Show)
50−-- infixl 2 :*:
51−
52−-- -- | An intermediate result in a scan.
53−-- data Scan s = Scan1 {-# UNPACK #-} !Char !s
54−-- | Scan2 {-# UNPACK #-} !Char !s
55−
56−-- -- | Intermediate result in a processing pipeline.
57−-- data Step s a = Done
58−-- | Skip !s
59−-- | Yield !a !s
60−
61−-- {-
62−-- instance (Show a) => Show (Step s a)
63−-- where show Done = "Done"
64−-- show (Skip _) = "Skip"
65−-- show (Yield x _) = "Yield " ++ show x
66−-- -}
67−
68−-- instance (Eq a) => Eq (Stream a) where
69−-- (==) = eq
70−
71−-- instance (Ord a) => Ord (Stream a) where
72−-- compare = cmp
73−
74−-- -- 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
76−-- -- as a hint: it should usually be accurate, so we use it when
77−-- -- unstreaming to decide what size array to allocate. However, the
78−-- -- unstreaming functions must be able to cope with the hint being too
79−-- -- small or too large.
80−-- --
81−-- -- The size hint tries to track the UTF-16 code units in a stream,
82−-- -- but often counts the number of code points instead. It can easily
83−-- -- undercount if, for instance, a transformed stream contains astral
84−-- -- plane code points (those above 0x10000).
85−
86−-- data Stream a =
87−-- forall s. Stream
88−-- (s -> Step s a) -- stepper function
89−-- !s -- current state
90−-- !Size -- size hint in code units
91−
92−-- -- | /O(n)/ Determines if two streams are equal.
93−-- eq :: (Eq a) => Stream a -> Stream a -> Bool
94−-- eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
95−-- where
96−-- loop Done Done = True
97−-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
98−-- loop (Skip s1') x2 = loop (next1 s1') x2
99−-- loop x1 (Skip s2') = loop x1 (next2 s2')
100−-- loop Done _ = False
101−-- loop _ Done = False
102−-- loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
103−-- loop (next1 s1') (next2 s2')
104−-- {-# INLINE [0] eq #-}
105−
106−-- cmp :: (Ord a) => Stream a -> Stream a -> Ordering
107−-- cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
108−-- where
109−-- loop Done Done = EQ
110−-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
111−-- loop (Skip s1') x2 = loop (next1 s1') x2
112−-- loop x1 (Skip s2') = loop x1 (next2 s2')
113−-- loop Done _ = LT
114−-- loop _ Done = GT
115−-- loop (Yield x1 s1') (Yield x2 s2') =
116−-- case compare x1 x2 of
117−-- EQ -> loop (next1 s1') (next2 s2')
118−-- other -> other
119−-- {-# INLINE [0] cmp #-}
120−
121−-- -- | The empty stream.
122−-- empty :: Stream a
123−-- empty = Stream next () 0
124−-- where next _ = Done
125−-- {-# INLINE [0] empty #-}
31+import Data.Text.Internal.Fusion.Size
32+import Data.Word (Word8)
33+
34+-- | Specialised tuple for case conversion.
35+data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char
36+
37+-- | Restreaming state.
38+data RS s
39+ = RS0 !s
40+ | RS1 !s {-# UNPACK #-} !Word8
41+ | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
42+ | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
43+
44+-- | Strict pair.
45+data PairS a b = !a :*: !b
46+ -- deriving (Eq, Ord, Show)
47+infixl 2 :*:
48+
49+-- | An intermediate result in a scan.
50+data Scan s = Scan1 {-# UNPACK #-} !Char !s
51+ | Scan2 {-# UNPACK #-} !Char !s
52+
53+-- | Intermediate result in a processing pipeline.
54+data Step s a = Done
55+ | Skip !s
56+ | Yield !a !s
57+
58+{-
59+instance (Show a) => Show (Step s a)
60+ where show Done = "Done"
61+ show (Skip _) = "Skip"
62+ show (Yield x _) = "Yield " ++ show x
63+-}
64+
65+instance (Eq a) => Eq (Stream a) where
66+ (==) = eq
67+
68+instance (Ord a) => Ord (Stream a) where
69+ compare = cmp
70+
71+-- The length hint in a Stream has two roles. If its value is zero,
72+-- we trust it, and treat the stream as empty. Otherwise, we treat it
73+-- as a hint: it should usually be accurate, so we use it when
74+-- unstreaming to decide what size array to allocate. However, the
75+-- unstreaming functions must be able to cope with the hint being too
76+-- small or too large.
77+--
78+-- The size hint tries to track the UTF-16 code points in a stream,
79+-- but often counts the number of characters instead. It can easily
80+-- undercount if, for instance, a transformed stream contains astral
81+-- plane characters (those above 0x10000).
82+
83+data Stream a =
84+ forall s. Stream
85+ (s -> Step s a) -- stepper function
86+ !s -- current state
87+ !Size -- size hint
88+
89+-- | /O(n)/ Determines if two streams are equal.
90+eq :: (Eq a) => Stream a -> Stream a -> Bool
91+eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
92+ where
93+ loop Done Done = True
94+ loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
95+ loop (Skip s1') x2 = loop (next1 s1') x2
96+ loop x1 (Skip s2') = loop x1 (next2 s2')
97+ loop Done _ = False
98+ loop _ Done = False
99+ loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
100+ loop (next1 s1') (next2 s2')
101+{-# INLINE [0] eq #-}
102+
103+cmp :: (Ord a) => Stream a -> Stream a -> Ordering
104+cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
105+ where
106+ loop Done Done = EQ
107+ loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
108+ loop (Skip s1') x2 = loop (next1 s1') x2
109+ loop x1 (Skip s2') = loop x1 (next2 s2')
110+ loop Done _ = LT
111+ loop _ Done = GT
112+ loop (Yield x1 s1') (Yield x2 s2') =
113+ case compare x1 x2 of
114+ EQ -> loop (next1 s1') (next2 s2')
115+ other -> other
116+{-# INLINE [0] cmp #-}
117+
118+-- | The empty stream.
119+empty :: Stream a
120+empty = Stream next () 0
121+ where next _ = Done
122+{-# INLINE [0] empty #-}
Data/Text/Internal/IO.hs−8
@@ -95,11 +95,7 @@ unpack !buf !r !w
9595 | r >= w = return T.empty
9696 | otherwise = withRawBuffer buf go
9797 where
98−#ifndef __GHCJS__
9998 go pbuf = return $! unstream (Stream next r (exactSize (w-r)))
100−#else
101− go pbuf = return $! unstream (Stream next r)
102−#endif
10399 where
104100 next !i | i >= w = Done
105101 | otherwise = Yield (ix i) (i+1)
@@ -112,11 +108,7 @@ unpack_nl !buf !r !w
112108 | otherwise = withRawBuffer buf $ go
113109 where
114110 go pbuf = do
115−#ifndef __GHCJS__
116111 let !t = unstream (Stream next r (maxSize (w-r)))
117−#else
118− let !t = unstream (Stream next r)
119−#endif
120112 w' = w - 1
121113 return $ if ix w' == '\r'
122114 then (t,w')
Data/Text/Internal/Lazy.hs+1−20
@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, DeriveDataTypeable, CPP #-}
1+{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
22{-# OPTIONS_HADDOCK not-home #-}
33
44-- |
@@ -44,10 +44,6 @@ import Data.Typeable (Typeable)
4444import Foreign.Storable (sizeOf)
4545import qualified Data.Text.Internal as T
4646
47−#ifdef __GHCJS__
48−import qualified Data.Text as TT
49−#endif
50−
5147data Text = Empty
5248 | Chunk {-# UNPACK #-} !T.Text Text
5349 deriving (Typeable)
@@ -61,26 +57,16 @@ data Text = Empty
6157-- | Check the invariant strictly.
6258strictInvariant :: Text -> Bool
6359strictInvariant Empty = True
64−#ifndef __GHCJS__
6560strictInvariant x@(Chunk (T.Text _ _ len) cs)
6661 | len > 0 = strictInvariant cs
67−#else
68−strictInvariant x@(Chunk t cs)
69− | TT.length t > 0 = strictInvariant cs
70−#endif
7162 | otherwise = error $ "Data.Text.Lazy: invariant violation: "
7263 ++ showStructure x
7364
7465-- | Check the invariant lazily.
7566lazyInvariant :: Text -> Text
7667lazyInvariant Empty = Empty
77−#ifndef __GHCJS__
7868lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)
7969 | 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
8470 | otherwise = error $ "Data.Text.Lazy: invariant violation: "
8571 ++ showStructure x
8672
@@ -94,13 +80,8 @@ showStructure (Chunk t ts) =
9480-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.
9581chunk :: T.Text -> Text -> Text
9682{-# INLINE chunk #-}
97−#ifndef __GHCJS__
9883chunk t@(T.Text _ _ len) ts | len == 0 = ts
9984 | otherwise = Chunk t ts
100−#else
101−chunk t ts | TT.null t = ts
102− | otherwise = Chunk t ts
103−#endif
10485
10586-- | Smart constructor for 'Empty'.
10687empty :: Text
Data/Text/Internal/Lazy/Encoding/Fusion.hs−26
@@ -38,9 +38,7 @@ import qualified Data.ByteString.Unsafe as B
3838import Data.Text.Internal.Encoding.Fusion.Common
3939import Data.Text.Encoding.Error
4040import Data.Text.Internal.Fusion (Step(..), Stream(..))
41−#ifndef __GHCJS__
4241import Data.Text.Internal.Fusion.Size
43−#endif
4442import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)
4543import Data.Text.Internal.Unsafe.Shift (shiftL)
4644import Data.Word (Word8, Word16, Word32)
@@ -67,11 +65,7 @@ data T = T !ByteString !S {-# UNPACK #-} !Int
6765-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using
6866-- UTF-8 encoding.
6967streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
70−#ifndef __GHCJS__
7168streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize
72−#else
73−streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
74−#endif
7569 where
7670 next (T bs@(Chunk ps _) S0 i)
7771 | i < len && U8.validate1 a =
@@ -113,11 +107,7 @@ streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
113107-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
114108-- endian UTF-16 encoding.
115109streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
116−#ifndef __GHCJS__
117110streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
118−#else
119−streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
120−#endif
121111 where
122112 next (T bs@(Chunk ps _) S0 i)
123113 | i + 1 < len && U16.validate1 x1 =
@@ -157,11 +147,7 @@ streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
157147-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
158148-- endian UTF-16 encoding.
159149streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
160−#ifndef __GHCJS__
161150streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
162−#else
163−streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
164−#endif
165151 where
166152 next (T bs@(Chunk ps _) S0 i)
167153 | i + 1 < len && U16.validate1 x1 =
@@ -201,11 +187,7 @@ streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
201187-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
202188-- endian UTF-32 encoding.
203189streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
204−#ifndef __GHCJS__
205190streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
206−#else
207−streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
208−#endif
209191 where
210192 next (T bs@(Chunk ps _) S0 i)
211193 | i + 3 < len && U32.validate x =
@@ -249,11 +231,7 @@ streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
249231-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
250232-- endian UTF-32 encoding.
251233streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
252−#ifndef __GHCJS__
253234streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
254−#else
255−streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
256−#endif
257235 where
258236 next (T bs@(Chunk ps _) S0 i)
259237 | i + 3 < len && U32.validate x =
@@ -296,11 +274,7 @@ streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
296274
297275-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
298276unstreamChunks :: Int -> Stream Word8 -> ByteString
299−#ifndef __GHCJS__
300277unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)
301−#else
302−unstreamChunks chunkSize (Stream next s0) = chunk s0 4
303−#endif
304278 where chunk s1 len1 = unsafeDupablePerformIO $ do
305279 let len = max 4 (min len1 chunkSize)
306280 mallocByteString len >>= loop len 0 s1
Data/Text/Internal/Lazy/Fusion.hs−62
@@ -1,10 +1,4 @@
11{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE CPP #-}
3−#ifdef __GHCJS__
4−{-# LANGUAGE ForeignFunctionInterface #-}
5−{-# LANGUAGE MagicHash #-}
6−{-# LANGUAGE UnliftedFFITypes #-}
7−#endif
82-- |
93-- Module : Data.Text.Lazy.Fusion
104-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
@@ -35,14 +29,7 @@ import Prelude hiding (length)
3529import qualified Data.Text.Internal.Fusion.Common as S
3630import Control.Monad.ST (runST)
3731import Data.Text.Internal.Fusion.Types
38−#ifndef __GHCJS__
3932import 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
4633import Data.Text.Internal.Lazy
4734import qualified Data.Text.Internal as I
4835import qualified Data.Text.Array as A
@@ -55,7 +42,6 @@ default(Int64)
5542
5643-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
5744stream :: Text -> Stream Char
58−#ifndef __GHCJS__
5945stream text = Stream next (text :*: 0) unknownSize
6046 where
6147 next (Empty :*: _) = Done
@@ -63,22 +49,11 @@ stream text = Stream next (text :*: 0) unknownSize
6349 | i >= len = next (ts :*: 0)
6450 | otherwise = Yield c (txt :*: i+d)
6551 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
7552{-# INLINE [0] stream #-}
7653
77−-- TODO
7854-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given
7955-- chunk size.
8056unstreamChunks :: Int -> Stream Char -> Text
81−#ifndef __GHCJS__
8257unstreamChunks !chunkSize (Stream next s0 len0)
8358 | isEmpty len0 = Empty
8459 | otherwise = outer s0
@@ -109,36 +84,6 @@ unstreamChunks !chunkSize (Stream next s0 len0)
10984 finish marr len s' = do
11085 arr <- A.unsafeFreeze marr
11186 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
14287{-# INLINE [0] unstreamChunks #-}
14388
14489-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using
@@ -173,10 +118,3 @@ index = S.indexI
173118countChar :: Char -> Stream Char -> Int64
174119countChar = S.countCharI
175120{-# INLINE [0] countChar #-}
176−
177−#ifdef __GHCJS__
178−foreign import javascript unsafe
179− "h$textToString($1,$2,$3)"
180− js_toString :: ByteArray# -> Int# -> Int# -> JSString
181−#endif
182−
Data/Text/Internal/Lazy/Search.hs+11−55
@@ -1,7 +1,4 @@
11{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
2−{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes, JavaScriptFFI,
3− UnboxedTuples, DeriveDataTypeable, GHCForeignImportPrim,
4− MagicHash, FlexibleInstances, BangPatterns, Rank2Types, CPP #-}
52
63-- |
74-- Module : Data.Text.Lazy.Search
@@ -34,17 +31,6 @@ import Data.Text.Internal.Lazy (Text(..), foldlChunks)
3431import Data.Bits ((.|.), (.&.))
3532import Data.Text.Internal.Unsafe.Shift (shiftL)
3633
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−
4834-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
4935-- @needle@ within @haystack@.
5036--
@@ -61,10 +47,8 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)
6147 | nlen == 1 = indicesOne (nindex 0) 0 k ks
6248 | otherwise = advance k ks 0 0
6349 where
64− -- advance x@(T.Text _ _ l) xs = scan
65− advance x xs = scan
50+ advance x@(T.Text _ _ l) xs = scan
6651 where
67− l = TT.length x
6852 scan !g !i
6953 | i >= m = case xs of
7054 Empty -> []
@@ -88,23 +72,11 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)
8872 nlast = nlen - 1
8973 nindex = index n ns
9074 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)
9976 (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)
10077 swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)
101− -- buildTable (T.Text xarr xoff xlen) xs = go
102− buildTable t xs = go
78+ buildTable (T.Text xarr xoff xlen) xs = go
10379 where
104− xoff = 0
105− (xarr, xlen) =
106− let (# ba, len #) = fromString t
107− in (A.Array ba, I# len)
10880 go !(g::Int64) !i !msk !skp
10981 | i >= xlast = case xs of
11082 Empty -> (msk .|. swizzle z) :*: skp
@@ -119,22 +91,17 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)
11991 -- given offset would fail.
12092 lackingHay q = go 0
12193 where
122− -- go p (T.Text _ _ l) ps = p' < q && case ps of
123− go p t ps = p' < q && case ps of
124− Empty -> True
125− Chunk r rs -> go p' r rs
126− where
127− l = TT.length t
128− p' = p + fromIntegral l
129−
94+ go p (T.Text _ _ l) ps = p' < q && case ps of
95+ Empty -> True
96+ Chunk r rs -> go p' r rs
97+ where p' = p + fromIntegral l
13098indices _ _ = []
13199
132100-- | Fast index into a partly unpacked 'Text'. We take into account
133101-- the possibility that the caller might try to access one element
134102-- past the end.
135103index :: T.Text -> Text -> Int64 -> Word16
136−-- index (T.Text arr off len) xs !i
137−index t xs !i
104+index (T.Text arr off len) xs !i
138105 | j < len = A.unsafeIndex arr (off+j)
139106 | otherwise = case xs of
140107 Empty
@@ -143,24 +110,14 @@ index t xs !i
143110 -- should never happen, due to lackingHay above
144111 | otherwise -> emptyError "index"
145112 Chunk c cs -> index c cs (i-fromIntegral len)
146− where
147− j = fromIntegral i
148− off = 0
149− (arr, len) =
150− let (# ba, len' #) = fromString t
151− in (A.Array ba, I# len')
113+ where j = fromIntegral i
152114
153115-- | A variant of 'indices' that scans linearly for a single 'Word16'.
154116indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]
155117indicesOne c = chunk
156118 where
157− -- chunk !i (T.Text oarr ooff olen) os = go 0
158− chunk !i t os = go 0
119+ chunk !i (T.Text oarr ooff olen) os = go 0
159120 where
160− ooff = 0
161− (oarr, olen) =
162− let (# ba, len #) = fromString t
163− in (A.Array ba, I# len)
164121 go h | h >= olen = case os of
165122 Empty -> []
166123 Chunk y ys -> chunk (i+fromIntegral olen) y ys
@@ -171,8 +128,7 @@ indicesOne c = chunk
171128-- | The number of 'Word16' values in a 'Text'.
172129wordLength :: Text -> Int64
173130wordLength = 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
176132
177133emptyError :: String -> a
178134emptyError 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 #-}
22
33-- |
44-- Module : Data.Text.Internal.Private
@@ -19,12 +19,8 @@ import Control.Monad.ST (ST, runST)
1919import Data.Text.Internal (Text(..), text)
2020import Data.Text.Unsafe (Iter(..), iter)
2121import qualified Data.Text.Array as A
22−#ifdef __GHCJS__
23−import qualified Data.JSString as JSS
24−#endif
2522
2623span_ :: (Char -> Bool) -> Text -> (# Text, Text #)
27−#ifndef __GHCJS__
2824span_ p t@(Text arr off len) = (# hd,tl #)
2925 where hd = text arr off k
3026 tl = text arr (off+k) (len-k)
@@ -32,9 +28,6 @@ span_ p t@(Text arr off len) = (# hd,tl #)
3228 loop !i | i < len && p c = loop (i+d)
3329 | otherwise = i
3430 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
3831{-# INLINE span_ #-}
3932
4033runText :: (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(..))
3737import Data.Bits ((.|.), (.&.))
3838import Data.Text.Internal.Unsafe.Shift (shiftL)
3939
40−import qualified Data.JSString.Internal.Search as JSS
41−
4240data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
4341
4442-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
@@ -51,42 +49,41 @@ data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
5149indices :: Text -- ^ Substring to search for (@needle@)
5250 -> Text -- ^ Text to search in (@haystack@)
5351 -> [Int]
54−indices = coerce JSS.indices
55−-- indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)
56−-- | nlen == 1 = scanOne (nindex 0)
57−-- | nlen <= 0 || ldiff < 0 = []
58−-- | otherwise = scan 0
59−-- where
60−-- ldiff = hlen - nlen
61−-- nlast = nlen - 1
62−-- z = nindex nlast
63−-- nindex k = A.unsafeIndex narr (noff+k)
64−-- hindex k = A.unsafeIndex harr (hoff+k)
65−-- hindex' k | k == hlen = 0
66−-- | otherwise = A.unsafeIndex harr (hoff+k)
67−-- buildTable !i !msk !skp
68−-- | i >= nlast = (msk .|. swizzle z) :* skp
69−-- | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'
70−-- where c = nindex i
71−-- skp' | c == z = nlen - i - 2
72−-- | otherwise = skp
73−-- swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)
74−-- scan !i
75−-- | i > ldiff = []
76−-- | c == z && candidateMatch 0 = i : scan (i + nlen)
77−-- | otherwise = scan (i + delta)
78−-- where c = hindex (i + nlast)
79−-- candidateMatch !j
80−-- | j >= nlast = True
81−-- | hindex (i+j) /= nindex j = False
82−-- | otherwise = candidateMatch (j+1)
83−-- delta | nextInPattern = nlen + 1
84−-- | c == z = skip + 1
85−-- | otherwise = 1
86−-- where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0
87−-- !(mask :* skip) = buildTable 0 0 (nlen-2)
88−-- scanOne c = loop 0
89−-- where loop !i | i >= hlen = []
90−-- | hindex i == c = i : loop (i+1)
91−-- | otherwise = loop (i+1)
52+indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)
53+ | nlen == 1 = scanOne (nindex 0)
54+ | nlen <= 0 || ldiff < 0 = []
55+ | otherwise = scan 0
56+ where
57+ ldiff = hlen - nlen
58+ nlast = nlen - 1
59+ z = nindex nlast
60+ nindex k = A.unsafeIndex narr (noff+k)
61+ hindex k = A.unsafeIndex harr (hoff+k)
62+ hindex' k | k == hlen = 0
63+ | otherwise = A.unsafeIndex harr (hoff+k)
64+ buildTable !i !msk !skp
65+ | i >= nlast = (msk .|. swizzle z) :* skp
66+ | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'
67+ where c = nindex i
68+ skp' | c == z = nlen - i - 2
69+ | otherwise = skp
70+ swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)
71+ scan !i
72+ | i > ldiff = []
73+ | c == z && candidateMatch 0 = i : scan (i + nlen)
74+ | otherwise = scan (i + delta)
75+ where c = hindex (i + nlast)
76+ candidateMatch !j
77+ | j >= nlast = True
78+ | hindex (i+j) /= nindex j = False
79+ | otherwise = candidateMatch (j+1)
80+ delta | nextInPattern = nlen + 1
81+ | c == z = skip + 1
82+ | otherwise = 1
83+ where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0
84+ !(mask :* skip) = buildTable 0 0 (nlen-2)
85+ scanOne c = loop 0
86+ where loop !i | i >= hlen = []
87+ | hindex i == c = i : loop (i+1)
88+ | otherwise = loop (i+1)
9289{-# INLINE indices #-}
Data/Text/Lazy.hs+21−103
@@ -6,15 +6,14 @@
66#if __GLASGOW_HASKELL__ >= 708
77{-# LANGUAGE TypeFamilies #-}
88#endif
9−#ifdef __GHCJS__
10−{-# LANGUAGE ForeignFunctionInterface #-}
11−#endif
9+
1210-- |
1311-- Module : Data.Text.Lazy
1412-- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan
1513--
1614-- License : BSD-style
1715-- Maintainer : bos@serpentine.com
16+-- Stability : experimental
1817-- Portability : GHC
1918--
2019-- A time and space-efficient implementation of Unicode text using
@@ -69,7 +68,6 @@ module Data.Text.Lazy
6968 , snoc
7069 , append
7170 , uncons
72− , unsnoc
7371 , head
7472 , last
7573 , tail
@@ -246,9 +244,6 @@ import GHC.Prim (Addr#)
246244#if MIN_VERSION_base(4,7,0)
247245import Text.Printf (PrintfArg, formatArg, formatString)
248246#endif
249−#ifdef __GHCJS__
250−import Data.JSString (JSString)
251−#endif
252247
253248-- $fusion
254249--
@@ -278,16 +273,14 @@ import Data.JSString (JSString)
278273-- $replacement
279274--
280275-- 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 >.
283−-- As such, a 'Text' cannot contain values in the range U+D800 to
284−-- U+DFFF inclusive. Haskell implementations admit all Unicode code
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.
288−-- This means that there are some 'Char' values that are not valid
289−-- Unicode scalar values, and the functions in this module must handle
290−-- those cases.
276+-- in &#xa7;3.9, definition D76 of the Unicode 5.2 standard:
277+-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35>. As
278+-- such, a 'Text' cannot contain values in the range U+D800 to U+DFFF
279+-- inclusive. Haskell implementations admit all Unicode code points
280+-- (&#xa7;3.4, definition D10) as 'Char' values, including code points
281+-- from this invalid range. This means that there are some 'Char'
282+-- values that are not valid Unicode scalar values, and the functions
283+-- in this module must handle those cases.
291284--
292285-- Within this module, many functions construct a 'Text' from one or
293286-- more 'Char' values. Those functions will substitute 'Char' values
@@ -301,8 +294,8 @@ import Data.JSString (JSString)
301294-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate
302295-- code points, and so cannot be represented. The functions replace
303296-- invalid scalar values, instead of dropping them, as a security
304−-- measure. For details, see
305−-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters Unicode Technical Report 36, §3.5 >.)
297+-- measure. For details, see Unicode Technical Report 36, &#xa7;3.5:
298+-- <http://unicode.org/reports/tr36#Deletion_of_Noncharacters>)
306299
307300equal :: Text -> Text -> Bool
308301equal Empty Empty = True
@@ -331,7 +324,6 @@ compareText Empty _ = LT
331324compareText _ Empty = GT
332325compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0
333326 where
334−#ifndef __GHCJS__
335327 outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0
336328 where
337329 go !i !j
@@ -342,20 +334,6 @@ compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0
342334 | otherwise = go (i+di) (j+dj)
343335 where T.Iter a di = T.iter ta i
344336 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
359337
360338instance Show Text where
361339 showsPrec p ps r = showsPrec p (unpack ps) r
@@ -364,13 +342,9 @@ instance Read Text where
364342 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
365343
366344#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
369−-- provided by
370−-- the [semigroups](http://hackage.haskell.org/package/semigroups)
371−-- package
372−--
373−-- @since 1.2.2.0
345+-- Semigroup orphan instances for older GHCs are provided by
346+-- 'semigroups` package
347+
374348instance Semigroup Text where
375349 (<>) = append
376350#endif
@@ -388,7 +362,6 @@ instance IsString Text where
388362 fromString = pack
389363
390364#if __GLASGOW_HASKELL__ >= 708
391−-- | @since 1.2.0.0
392365instance Exts.IsList Text where
393366 type Item Text = Char
394367 fromList = pack
@@ -401,7 +374,6 @@ instance NFData Text where
401374 rnf (Chunk _ ts) = rnf ts
402375#endif
403376
404−-- | @since 1.2.1.0
405377instance Binary Text where
406378 put t = put (encodeUtf8 t)
407379 get = do
@@ -425,8 +397,6 @@ instance Data Text where
425397
426398#if MIN_VERSION_base(4,7,0)
427399-- | Only defined for @base-4.7.0.0@ and later
428−--
429−-- @since 1.2.2.0
430400instance PrintfArg Text where
431401 formatArg txt = formatString $ unpack txt
432402#endif
@@ -505,7 +475,9 @@ fromStrict t = chunk t Empty
505475-- -----------------------------------------------------------------------------
506476-- * Basic functions
507477
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.
509481cons :: Char -> Text -> Text
510482cons c t = Chunk (T.singleton c) t
511483{-# INLINE [1] cons #-}
@@ -589,17 +561,6 @@ init Empty = emptyError "init"
589561 unstream (S.init (stream t)) = init t
590562 #-}
591563
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−
603564-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
604565-- fusion.
605566null :: Text -> Bool
@@ -859,8 +820,6 @@ toUpper t = unstream (S.toUpper (stream t))
859820-- guides disagree on whether the book name \"The Hill of the Red
860821-- Fox\" is correctly title cased&#x2014;but this function will
861822-- capitalize /every/ word.
862−--
863−-- @since 1.0.0.0
864823toTitle :: Text -> Text
865824toTitle t = unstream (S.toTitle (stream t))
866825{-# INLINE toTitle #-}
@@ -1013,8 +972,6 @@ mapAccumR f = go
1013972
1014973-- | @'repeat' x@ is an infinite 'Text', with @x@ the value of every
1015974-- element.
1016−--
1017−-- @since 1.2.0.5
1018975repeat :: Char -> Text
1019976repeat c = let t = Chunk (T.replicate smallChunkSize (T.singleton c)) t
1020977 in t
@@ -1032,8 +989,6 @@ replicate n t
1032989
1033990-- | 'cycle' ties a finite, non-empty 'Text' into a circular one, or
1034991-- equivalently, the infinite repetition of the original 'Text'.
1035−--
1036−-- @since 1.2.0.5
1037992cycle :: Text -> Text
1038993cycle Empty = emptyError "cycle"
1039994cycle t = let t' = foldrChunks Chunk t' t
@@ -1043,8 +998,6 @@ cycle t = let t' = foldrChunks Chunk t' t
1043998-- of @f@ to @x@:
1044999--
10451000-- > iterate f x == [x, f x, f (f x), ...]
1046−--
1047−-- @since 1.2.0.5
10481001iterate :: (Char -> Char) -> Char -> Text
10491002iterate f c = let t c' = Chunk (T.singleton c') (t (f c'))
10501003 in t c
@@ -1108,8 +1061,6 @@ take i t0 = take' i t0
11081061-- Examples:
11091062--
11101063-- > takeEnd 3 "foobar" == "bar"
1111−--
1112−-- @since 1.1.1.0
11131064takeEnd :: Int64 -> Text -> Text
11141065takeEnd n t0
11151066 | n <= 0 = empty
@@ -1148,8 +1099,6 @@ drop i t0
11481099-- Examples:
11491100--
11501101-- > dropEnd 3 "foobar" == "foo"
1151−--
1152−-- @since 1.1.1.0
11531102dropEnd :: Int64 -> Text -> Text
11541103dropEnd n t0
11551104 | n <= 0 = t0
@@ -1170,20 +1119,11 @@ dropWords i t0
11701119 | otherwise = drop' i t0
11711120 where drop' 0 ts = ts
11721121 drop' _ Empty = Empty
1173−#ifndef __GHCJS__
11741122 drop' n (Chunk (T.Text arr off len) ts)
11751123 | n < len' = chunk (text arr (off+n') (len-n')) ts
11761124 | otherwise = drop' (n - len') ts
11771125 where len' = fromIntegral len
11781126 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
11871127
11881128-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
11891129-- returns the longest prefix (possibly empty) of elements that
@@ -1210,15 +1150,12 @@ takeWhile p t0 = takeWhile' t0
12101150-- Examples:
12111151--
12121152-- > takeWhileEnd (=='o') "foo" == "oo"
1213−--
1214−-- @since 1.2.2.0
12151153takeWhileEnd :: (Char -> Bool) -> Text -> Text
12161154takeWhileEnd p = takeChunk empty . L.reverse . toChunks
12171155 where takeChunk acc [] = acc
1218− takeChunk acc (t:ts)
1219− | T.lengthWord16 t' < T.lengthWord16 t
1220− = chunk t' acc
1221− | otherwise = takeChunk (Chunk t' acc) ts
1156+ takeChunk acc (t:ts) = if T.length t' < T.length t
1157+ then (Chunk t' acc)
1158+ else takeChunk (Chunk t' acc) ts
12221159 where t' = T.takeWhileEnd p t
12231160{-# INLINE takeWhileEnd #-}
12241161
@@ -1307,22 +1244,12 @@ splitAt = loop
13071244-- values, and whose second is the remainder of the string.
13081245splitAtWord :: Int64 -> Text -> PairS Text Text
13091246splitAtWord _ Empty = empty :*: empty
1310−#ifndef __GHCJS__
13111247splitAtWord x (Chunk c@(T.Text arr off len) cs)
13121248 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
13131249 in Chunk c h :*: t
13141250 | otherwise = chunk (text arr off y) empty :*:
13151251 chunk (text arr (off+y) (len-y)) cs
13161252 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
13261253
13271254-- | /O(n+m)/ Find the first instance of @needle@ (which must be
13281255-- non-'null') in @haystack@. The first element of the returned tuple
@@ -1502,11 +1429,7 @@ splitOn pat src
15021429 go _ [] cs = [cs]
15031430 go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs
15041431 in h : go (x+l) xs (dropWords l t)
1505−#ifndef __GHCJS__
15061432 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
15101433{-# INLINE [1] splitOn #-}
15111434
15121435{-# RULES
@@ -1770,8 +1693,3 @@ emptyError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": empty input")
17701693
17711694impossibleError :: String -> a
17721695impossibleError 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 @@
1111-- License : BSD-style (see LICENSE)
1212--
1313-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
14+-- Stability : experimental
1415-- Portability : portable to Hugs and GHC
1516--
1617-- Efficient construction of lazy @Text@ values. The principal
Data/Text/Lazy/Builder/Int.hs+1−3
@@ -9,6 +9,7 @@
99-- (c) 2011 MailRank, Inc.
1010-- License: BSD-style
1111-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
12+-- Stability: experimental
1213-- Portability: portable
1314--
1415-- Efficiently write an integral value to a 'Builder'.
@@ -31,9 +32,6 @@ import GHC.Base (quotInt, remInt)
3132import GHC.Num (quotRemInteger)
3233import GHC.Types (Int(..))
3334import Control.Monad.ST
34−#if MIN_VERSION_base(4,11,0)
35−import Prelude hiding ((<>))
36−#endif
3735
3836#ifdef __GLASGOW_HASKELL__
3937# if defined(INTEGER_GMP)
Data/Text/Lazy/Builder/RealFloat.hs+15−20
@@ -11,23 +11,19 @@
1111-- Write a floating point value to a 'Builder'.
1212
1313module Data.Text.Lazy.Builder.RealFloat
14− (
15− FPFormat(..)
16− , realFloat
17− , formatRealFloat
18− ) where
19−
20−-- import Data.Array.Base (unsafeAt)
21−-- import Data.Array.IArray
14+ (
15+ FPFormat(..)
16+ , realFloat
17+ , formatRealFloat
18+ ) where
19+
20+import Data.Array.Base (unsafeAt)
21+import Data.Array.IArray
2222import Data.Text.Internal.Builder.Functions ((<>), i2d)
2323import Data.Text.Lazy.Builder.Int (decimal)
2424import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)
2525import Data.Text.Lazy.Builder
2626import qualified Data.Text as T
27−#if MIN_VERSION_base(4,11,0)
28−import Prelude hiding ((<>))
29−#endif
30−
3127
3228-- | Control the rendering of floating point numbers.
3329data FPFormat = Exponent
@@ -37,7 +33,7 @@ data FPFormat = Exponent
3733 | Generic
3834 -- ^ Use decimal notation for values between @0.1@ and
3935 -- @9,999,999@, and scientific notation otherwise.
40− deriving (Enum, Read, Show)
36+ deriving (Enum, Read, Show)
4137
4238-- | Show a signed 'RealFloat' value to full precision,
4339-- using standard decimal notation for arguments whose absolute value lies
@@ -232,16 +228,15 @@ maxExpt = 1100
232228
233229expt :: Integer -> Int -> Integer
234230expt base n
235− | base == 2 && n >= minExpt && n <= maxExpt = expts !! n
236− | base == 10 && n <= maxExpt10 = expts10 !! n
231+ | base == 2 && n >= minExpt && n <= maxExpt = expts `unsafeAt` n
232+ | base == 10 && n <= maxExpt10 = expts10 `unsafeAt` n
237233 | otherwise = base^n
238234
239−expts :: [Integer]
240−expts = [2^n | n <- [minExpt .. maxExpt]]
235+expts :: Array Int Integer
236+expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]
241237
242238maxExpt10 :: Int
243239maxExpt10 = 324
244240
245−expts10 :: [Integer]
246−expts10 = [10^n | n <- [minExpt .. maxExpt10]]
247−
241+expts10 :: Array Int Integer
242+expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]
Data/Text/Lazy/Encoding.hs+3−13
@@ -8,13 +8,14 @@
88--
99-- License : BSD-style
1010-- Maintainer : bos@serpentine.com
11+-- Stability : experimental
1112-- Portability : portable
1213--
1314-- Functions for converting lazy 'Text' values to and from lazy
1415-- 'ByteString', using several standard encodings.
1516--
16−-- To gain access to a much larger family of encodings, use the
17−-- <http://hackage.haskell.org/package/text-icu text-icu package>.
17+-- To gain access to a much larger variety of encodings, use the
18+-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>
1819
1920module Data.Text.Lazy.Encoding
2021 (
@@ -140,7 +141,6 @@ decodeUtf8' bs = unsafeDupablePerformIO $ do
140141 rnf (Chunk _ ts) = rnf ts
141142{-# INLINE decodeUtf8' #-}
142143
143−-- | Encode text using UTF-8 encoding.
144144encodeUtf8 :: Text -> B.ByteString
145145encodeUtf8 Empty = B.empty
146146encodeUtf8 lt@(Chunk t _) =
@@ -154,20 +154,10 @@ encodeUtf8 lt@(Chunk t _) =
154154 firstChunkSize = min B.smallChunkSize (4 * (T.length t + 1))
155155 strategy = B.safeStrategy firstChunkSize B.defaultChunkSize
156156
157−-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
158−--
159−-- @since 1.1.0.0
160157encodeUtf8Builder :: Text -> B.Builder
161158encodeUtf8Builder =
162159 foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) Data.Monoid.mempty
163160
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
171161{-# INLINE encodeUtf8BuilderEscaped #-}
172162encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
173163encodeUtf8BuilderEscaped prim =
Data/Text/Lazy/IO.hs+1
@@ -8,6 +8,7 @@
88-- (c) 2009 Simon Marlow
99-- License : BSD-style
1010-- Maintainer : bos@serpentine.com
11+-- Stability : experimental
1112-- Portability : GHC
1213--
1314-- Efficient locale-sensitive support for lazy text I\/O.
Data/Text/Lazy/Read.hs+4−3
@@ -11,6 +11,7 @@
1111--
1212-- License : BSD-style
1313-- Maintainer : bos@serpentine.com
14+-- Stability : experimental
1415-- Portability : GHC
1516--
1617-- Functions used frequently when reading textual data.
@@ -67,9 +68,9 @@ decimal txt
6768 go n d = (n * 10 + fromIntegral (digitToInt d))
6869
6970-- | Read a hexadecimal integer, consisting of an optional leading
70−-- @\"0x\"@ followed by at least one hexadecimal digit. Input is
71−-- consumed until a non-hex-digit or end of string is reached.
72−-- This function is case insensitive.
71+-- @\"0x\"@ followed by at least one decimal digit. Input is consumed
72+-- until a non-hex-digit or end of string is reached. This function
73+-- is case insensitive.
7374--
7475-- This function does not handle leading sign characters. If you need
7576-- to handle signed input, use @'signed' 'hexadecimal'@.
Data/Text/Read.hs+4−3
@@ -9,6 +9,7 @@
99--
1010-- License : BSD-style
1111-- Maintainer : bos@serpentine.com
12+-- Stability : experimental
1213-- Portability : GHC
1314--
1415-- Functions used frequently when reading textual data.
@@ -66,9 +67,9 @@ decimal txt
6667 go n d = (n * 10 + fromIntegral (digitToInt d))
6768
6869-- | Read a hexadecimal integer, consisting of an optional leading
69−-- @\"0x\"@ followed by at least one hexadecimal digit. Input is
70−-- consumed until a non-hex-digit or end of string is reached.
71−-- This function is case insensitive.
70+-- @\"0x\"@ followed by at least one decimal digit. Input is consumed
71+-- until a non-hex-digit or end of string is reached. This function
72+-- is case insensitive.
7273--
7374-- This function does not handle leading sign characters. If you need
7475-- to handle signed input, use @'signed' 'hexadecimal'@.
Data/Text/Show.hs−2
@@ -46,8 +46,6 @@ unpack = S.unstreamList . stream
4646-- fusion.
4747--
4848-- This is exposed solely for people writing GHC rewrite rules.
49−--
50−-- @since 1.2.1.1
5149unpackCString# :: Addr# -> Text
5250unpackCString# addr# = unstream (S.streamCString# addr#)
5351{-# NOINLINE unpackCString# #-}
Data/Text/Unsafe.hs+1−89
@@ -1,12 +1,10 @@
11{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
2−#ifdef __GHCJS__
3−{-# LANGUAGE JavaScriptFFI, ForeignFunctionInterface, UnliftedFFITypes #-}
4−#endif
52-- |
63-- Module : Data.Text.Unsafe
74-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
85-- License : BSD-style
96-- Maintainer : bos@serpentine.com
7+-- Stability : experimental
108-- Portability : portable
119--
1210-- A module containing unsafe 'Text' operations, for very very careful
@@ -34,47 +32,31 @@ import Control.Exception (assert)
3432import Data.Text.Internal.Encoding.Utf16 (chr2)
3533import Data.Text.Internal (Text(..))
3634import 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
4435import Data.Text.Internal.Unsafe.Char (unsafeChr)
4536import qualified Data.Text.Array as A
46−#endif
4737import GHC.IO (unsafeDupablePerformIO)
4838
4939-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'
5040-- omits the check for the empty case, so there is an obligation on
5141-- the programmer to provide a proof that the 'Text' is non-empty.
5242unsafeHead :: Text -> Char
53−#ifndef __GHCJS__
5443unsafeHead (Text arr off _len)
5544 | m < 0xD800 || m > 0xDBFF = unsafeChr m
5645 | otherwise = chr2 m n
5746 where m = A.unsafeIndex arr off
5847 n = A.unsafeIndex arr (off+1)
59−#else
60−unsafeHead = coerce JSS.rawHead
61−#endif
6248{-# INLINE unsafeHead #-}
6349
6450-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'
6551-- omits the check for the empty case, so there is an obligation on
6652-- the programmer to provide a proof that the 'Text' is non-empty.
6753unsafeTail :: Text -> Text
68−#ifndef __GHCJS__
6954unsafeTail t@(Text arr off len) =
7055#if defined(ASSERTS)
7156 assert (d <= len) $
7257#endif
7358 Text arr (off+d) (len-d)
7459 where d = iter_ t 0
75−#else
76−unsafeTail = coerce JSS.rawTail
77−#endif
7860{-# INLINE unsafeTail #-}
7961
8062data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int
@@ -83,7 +65,6 @@ data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int
8365-- array, returning the current character and the delta to add to give
8466-- the next offset to iterate at.
8567iter :: Text -> Int -> Iter
86−#ifndef __GHCJS__
8768iter (Text arr off _len) i
8869 | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1
8970 | otherwise = Iter (chr2 m n) 2
@@ -91,40 +72,20 @@ iter (Text arr off _len) i
9172 n = A.unsafeIndex arr k
9273 j = off + i
9374 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
10675{-# INLINE iter #-}
10776
10877-- | /O(1)/ Iterate one step through a UTF-16 array, returning the
10978-- delta to add to give the next offset to iterate at.
11079iter_ :: Text -> Int -> Int
111−#ifndef __GHCJS__
11280iter_ (Text arr off _len) i | m < 0xD800 || m > 0xDBFF = 1
11381 | otherwise = 2
11482 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
12183{-# INLINE iter_ #-}
12284
12385-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
12486-- returning the current character and the delta to add (i.e. a
12587-- negative number) to give the next offset to iterate at.
12688reverseIter :: Text -> Int -> (Char,Int)
127−#ifndef __GHCJS__
12889reverseIter (Text arr off _len) i
12990 | m < 0xDC00 || m > 0xDFFF = (unsafeChr m, -1)
13091 | otherwise = (chr2 n m, -2)
@@ -132,80 +93,31 @@ reverseIter (Text arr off _len) i
13293 n = A.unsafeIndex arr k
13394 j = off + i
13495 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
14796{-# INLINE reverseIter #-}
14897
14998-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
15099-- returning the delta to add (i.e. a negative number) to give the
151100-- next offset to iterate at.
152−--
153−-- @since 1.1.1.0
154101reverseIter_ :: Text -> Int -> Int
155−#ifndef __GHCJS__
156102reverseIter_ (Text arr off _len) i
157103 | m < 0xDC00 || m > 0xDFFF = -1
158104 | otherwise = -2
159105 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
168106{-# INLINE reverseIter_ #-}
169107
170108-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
171109-- is useful for sizing a target array appropriately before using
172110-- 'unsafeCopyToPtr'.
173111lengthWord16 :: Text -> Int
174−#ifndef __GHCJS__
175112lengthWord16 (Text _arr _off len) = len
176−#else
177−lengthWord16 (Text t) = js_length t
178−#endif
179113{-# INLINE lengthWord16 #-}
180114
181115-- | /O(1)/ Unchecked take of 'k' 'Word16's from the front of a 'Text'.
182116takeWord16 :: Int -> Text -> Text
183−#ifndef __GHCJS__
184117takeWord16 k (Text arr off _len) = Text arr off k
185−#else
186−takeWord16 k (Text txt) = Text $ js_take k txt
187−#endif
188118{-# INLINE takeWord16 #-}
189119
190120-- | /O(1)/ Unchecked drop of 'k' 'Word16's from the front of a 'Text'.
191121dropWord16 :: Int -> Text -> Text
192−#ifndef __GHCJS__
193122dropWord16 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
197123{-# 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
22
33This package provides the Data.Text library, a library for the space-
44and time-efficient manipulation of Unicode text in Haskell.
55
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+
718
819# Get involved!
920
1021Please report bugs via the
11−[github issue tracker](https://github.com/haskell/text/issues).
22+[github issue tracker](https://github.com/bos/text/issues).
1223
13−Master [git repository](https://github.com/haskell/text):
24+Master [git repository](https://github.com/bos/text):
1425
15−* `git clone git://github.com/haskell/text.git`
26+* `git clone git://github.com/bos/text.git`
1627
1728There's also a [Mercurial mirror](https://bitbucket.org/bos/text):
1829
benchmarks/.gitignore+1−4
@@ -1,4 +1 @@
1−/dist/
2−/dist-newstyle/
3−/.ghc.environment.*
4−/cabal.project.local
1+dist
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 ((</>))
1010import System.IO (IOMode (WriteMode), openFile, hSetEncoding, utf8)
1111
1212import qualified Benchmarks.Builder as Builder
13−import qualified Benchmarks.Concat as Concat
1413import qualified Benchmarks.DecodeUtf8 as DecodeUtf8
1514import qualified Benchmarks.EncodeUtf8 as EncodeUtf8
1615import qualified Benchmarks.Equality as Equality
@@ -42,7 +41,6 @@ benchmarks = do
4241 -- Traditional benchmarks
4342 bs <- sequence
4443 [ Builder.benchmark
45− , Concat.benchmark
4644 , DecodeUtf8.benchmark "html" (tf "libya-chinese.html")
4745 , DecodeUtf8.benchmark "xml" (tf "yiwiki.xml")
4846 , 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>,
1212maintainer: jaspervdj@gmail.com
1313category: Text
1414build-type: Simple
15−cabal-version: >=1.8
15+
16+cabal-version: >=1.2
1617
1718flag bytestring-builder
1819 description: Depend on the bytestring-builder package for backwards compatibility.
@@ -25,12 +26,16 @@ flag llvm
2526 manual: True
2627
2728executable 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
2834 ghc-options: -Wall -O2 -rtsopts
2935 if flag(llvm)
3036 ghc-options: -fllvm
3137 cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP
32− build-depends: array,
33− base == 4.*,
38+ build-depends: base == 4.*,
3439 binary,
3540 blaze-builder,
3641 bytestring-lexing >= 0.5.0,
@@ -42,7 +47,6 @@ executable text-benchmarks
4247 ghc-prim,
4348 integer-gmp,
4449 stringsearch,
45− transformers,
4650 utf8-string,
4751 vector
4852
@@ -52,87 +56,9 @@ executable text-benchmarks
5256 else
5357 build-depends: bytestring >= 0.10.4
5458
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−
13259executable text-multilang
13360 hs-source-dirs: haskell
13461 main-is: Multilang.hs
135− other-modules: Timer
13662 ghc-options: -Wall -O2
13763 build-depends: base == 4.*,
13864 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,
206206 const uint8_t *srcend,
207207 uint32_t *codepoint0, uint32_t *state0)
208208{
209− _hs_text_decode_utf8_int(dest, destoff, src, srcend, codepoint0, state0);
210−
211− return *src;
209+ uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, src, srcend,
210+ codepoint0, state0);
211+ if (*state0 == UTF8_REJECT)
212+ ret -=1;
213+ return ret;
212214}
213215
214216/*
@@ -220,9 +222,12 @@ _hs_text_decode_utf8(uint16_t *const dest, size_t *destoff,
220222{
221223 uint32_t codepoint;
222224 uint32_t state = UTF8_ACCEPT;
223− _hs_text_decode_utf8_int(dest, destoff, &src, srcend,
224− &codepoint, &state);
225− return src;
225+ uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, &src, srcend,
226+ &codepoint, &state);
227+ /* Back up if we have an incomplete or invalid encoding */
228+ if (state != UTF8_ACCEPT)
229+ ret -= 1;
230+ return ret;
226231}
227232
228233void
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
442
453* The switch to `integer-pure` in 1.2.2.0 was apparently mistaken.
464 The build flag has been renamed accordingly. Your army of diligent
475 maintainers apologizes for the churn.
486
49−* Spec compliance: `toCaseFold` now follows the Unicode 8.0 spec
7+* Spec compliance: toCaseFold now follows the Unicode 8.0 spec
508 (updated from 7.0)
519
5210* An STG lint error has been fixed
5311
54−### 1.2.2.0
12+1.2.2.0
5513
5614* The `integer-simple` package, upon which this package optionally
5715 depended, has been replaced with `integer-pure`. The build flag has
@@ -67,7 +25,7 @@
6725 * if `base` >= 4.7: `PrintfArg`
6826 * if `base` >= 4.9: `Semigroup`
6927
70−#### 1.2.1.3
28+1.2.1.3
7129
7230* Bug fix: As it turns out, moving the literal rewrite rules to simplifier
7331 phase 2 does not prevent competition with the `unpack` rule, which is
@@ -75,7 +33,7 @@
7533 test environment mistake. Moving literal rules back to phase 1 finally
7634 fixes GHC Trac #10528 correctly.
7735
78−#### 1.2.1.2
36+1.2.1.2
7937
8038* Bug fix: Run literal rewrite rules in simplifier phase 2.
8139 The behavior of the simplifier changed in GHC 7.10.2,
@@ -83,21 +41,21 @@
8341 and long compilation times. See
8442 [GHC Trac #10528](https://ghc.haskell.org/trac/ghc/ticket/10528).
8543
86−#### 1.2.1.1
44+1.2.1.1
8745
8846* Expose unpackCString#, which you should never use.
8947
90−### 1.2.1.0
48+1.2.1.0
9149
9250* Added Binary instances for both Text types. (If you have previously
9351 been using the text-binary package to get a Binary instance, it is
9452 now obsolete.)
9553
96−#### 1.2.0.6
54+1.2.0.6
9755
9856* Fixed a space leak in UTF-8 decoding
9957
100−#### 1.2.0.5
58+1.2.0.5
10159
10260* Feature parity: repeat, cycle, iterate are now implemented for lazy
10361 Text, and the Data instance is more complete
@@ -117,26 +75,26 @@
11775* Spec compliance: toCaseFold now follows the Unicode 7.0 spec
11876 (updated from 6.3)
11977
120−#### 1.2.0.4
78+1.2.0.4
12179
12280* Fixed an incompatibility with base < 4.5
12381
124−#### 1.2.0.3
82+1.2.0.3
12583
12684* Update formatRealFloat to correspond to the definition in versions
12785 of base newer than 4.5 (https://github.com/bos/text/issues/105)
12886
129−#### 1.2.0.2
87+1.2.0.2
13088
13189* Bumped lower bound on deepseq to 1.4 for compatibility with the
13290 upcoming GHC 7.10
13391
134−#### 1.2.0.1
92+1.2.0.1
13593
13694* Fixed a buffer overflow in rendering of large Integers
13795 (https://github.com/bos/text/issues/99)
13896
139−## 1.2.0.0
97+1.2.0.0
14098
14199* Fixed an integer overflow in the replace function
142100 (https://github.com/bos/text/issues/81)
@@ -149,7 +107,7 @@
149107
150108* Added an instance of IsList for GHC 7.8 and above
151109
152−### 1.1.1.0
110+1.1.1.0
153111
154112* The Data.Data instance now allows gunfold to work, via a virtual
155113 pack constructor
@@ -159,12 +117,12 @@
159117* Comparing the length of a Text against a number can now
160118 short-circuit in more cases
161119
162−#### 1.1.0.1
120+1.1.0.1
163121
164122* streamDecodeUtf8: fixed gh-70, did not return all unconsumed bytes
165123 in single-byte chunks
166124
167−## 1.1.0.0
125+1.1.0.0
168126
169127* encodeUtf8: Performance is improved by up to 4x.
170128
@@ -183,12 +141,12 @@
183141 use at your own risk - there are no API stability guarantees for
184142 internal modules!
185143
186−#### 1.0.0.1
144+1.0.0.1
187145
188146* decodeUtf8: Fixed a regression that caused us to incorrectly
189147 identify truncated UTF-8 as valid (gh-61)
190148
191−# 1.0.0.0
149+1.0.0.0
192150
193151* Added support for Unicode 6.3.0 to case conversion functions
194152
tests-and-benchmarks.markdown+8−13
@@ -13,13 +13,10 @@ you can clone from one of the following locations:
1313* Git mirror repository:
1414 [github.com/bos/text-test-data](https://github.com/bos/text-test-data)
1515
16−You can clone either repository into the `tests` subdirectory using
17−
18− cd tests/
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.
16+You should clone that repository into the `tests` subdirectory (your
17+clone must be named `text-test-data` locally), then run `make -C
18+tests/text-test-data` to uncompress the test files. Many tests and
19+benchmarks will fail if the test files are missing.
2320
2421Functional tests
2522----------------
@@ -57,12 +54,10 @@ To compile the benchmarks, navigate to the `benchmarks` subdirectory and run
5754
5855 ./dist/build/text-benchmarks/text-benchmarks
5956
60−Or if you have a recent enough `cabal`, you can build and run the
61−benchmarks via
57+However, since there's quite a lot of benchmarks, you usually don't want to
58+run them all. Instead, use the `-l` flag to get a list of benchmarks:
6259
63− cabal new-run exe:text-benchmarks -- --help
60+ ./dist/build/text-benchmarks/text-benchmarks
6461
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
6863further, the exact parameters can be changed in `Benchmarks.hs`.
tests/Makefile+1−6
@@ -1,4 +1,3 @@
1−VCS = hg
21count = 1000
32
43all: coverage literal-rule-test
@@ -13,11 +12,7 @@ build: text-test-data
1312 cabal build
1413
1514text-test-data:
16−ifeq ($(VCS),git)
17− git clone https://github.com/bos/text-test-data.git
18−else
1915 hg clone https://bitbucket.org/bos/text-test-data
20−endif
2116 $(MAKE) -C text-test-data
2217
2318coverage/text-tests.tix:
@@ -42,4 +37,4 @@ coverage/hpc_index.html: coverage/coverage.tix
4237clean:
4338 rm -rf dist coverage .hpc
4439
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
99 ) where
1010
1111import Control.Applicative ((<$>), (<*>))
12−import Control.Arrow ((***), first, second)
12+import Control.Arrow ((***), second)
1313import 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)
1515import Data.Int (Int8, Int16, Int32, Int64)
1616import Data.Monoid (Monoid(..))
1717import Data.String (IsString(fromString))
@@ -23,7 +23,6 @@ import Data.Text.Internal.Search (indices)
2323import Data.Text.Lazy.Read as TL
2424import Data.Text.Read as T
2525import Data.Word (Word, Word8, Word16, Word32, Word64)
26−import Data.Maybe (mapMaybe)
2726import Numeric (showEFloat, showFFloat, showGFloat, showHex)
2827import Prelude hiding (replicate)
2928import Test.Framework (Test, testGroup)
@@ -31,7 +30,6 @@ import Test.Framework.Providers.QuickCheck2 (testProperty)
3130import Test.QuickCheck hiding ((.&.))
3231import Test.QuickCheck.Monadic
3332import Test.QuickCheck.Property (Property(..))
34−import Test.QuickCheck.Unicode (char)
3533import Tests.QuickCheckUtils
3634import Tests.Utils
3735import Text.Show.Functions ()
@@ -39,7 +37,6 @@ import qualified Control.Exception as Exception
3937import qualified Data.Bits as Bits (shiftL, shiftR)
4038import qualified Data.ByteString as B
4139import qualified Data.ByteString.Lazy as BL
42−import qualified Data.Char as C
4340import qualified Data.List as L
4441import qualified Data.Text as T
4542import qualified Data.Text.Encoding as E
@@ -63,10 +60,10 @@ t_pack_unpack = (T.unpack . T.pack) `eq` id
6360tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
6461t_stream_unstream = (S.unstream . S.stream) `eq` id
6562tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
66−t_reverse_stream t = (S.reverse . S.reverseStream) t === t
67−t_singleton c = [c] === (T.unpack . T.singleton) c
68−tl_singleton c = [c] === (TL.unpack . TL.singleton) c
69−tl_unstreamChunks x = f 11 x === f 1000 x
63+t_reverse_stream t = (S.reverse . S.reverseStream) t == t
64+t_singleton c = [c] == (T.unpack . T.singleton) c
65+tl_singleton c = [c] == (TL.unpack . TL.singleton) c
66+tl_unstreamChunks x = f 11 x == f 1000 x
7067 where f n = SL.unstreamChunks n . S.streamList
7168tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
7269tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
@@ -77,13 +74,13 @@ encodeL1 = B.pack . map (fromIntegral . fromEnum) . T.unpack
7774encodeLazyL1 :: TL.Text -> BL.ByteString
7875encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
7976
80−t_ascii t = E.decodeASCII (E.encodeUtf8 a) === a
77+t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a
8178 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
8380 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
8582 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
8784 where a = TL.map (\c -> chr (ord c `mod` 256)) t
8885t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
8986t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
@@ -114,7 +111,7 @@ t_utf8_undecoded = forAll genUnicode $ \t ->
114111 let b = E.encodeUtf8 t
115112 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
116113 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
118115
119116data Badness = Solo | Leading | Trailing
120117 deriving (Eq, Show)
@@ -180,33 +177,6 @@ genInvalidUTF8 = B.pack <$> oneof [
180177 k <- choose (0,n)
181178 vectorOf k gen
182179
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−
210180s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
211181 where _types = s :: String
212182sf_Eq p s =
@@ -231,8 +201,8 @@ t_mconcat = unsquare $
231201 mconcat `eq` (unpackS . mconcat . L.map T.pack)
232202tl_mconcat = unsquare $
233203 mconcat `eq` (unpackS . mconcat . L.map TL.pack)
234−t_mempty = mempty === (unpackS (mempty :: T.Text))
235−tl_mempty = mempty === (unpackS (mempty :: TL.Text))
204+t_mempty = mempty == (unpackS (mempty :: T.Text))
205+tl_mempty = mempty == (unpackS (mempty :: TL.Text))
236206t_IsString = fromString `eqP` (T.unpack . fromString)
237207tl_IsString = fromString `eqP` (TL.unpack . fromString)
238208
@@ -259,13 +229,6 @@ sf_uncons p = (uncons . L.filter p) `eqP`
259229 (fmap (second unpackS) . S.uncons . S.filter p)
260230t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
261231tl_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−
269232s_head = head `eqP` S.head
270233sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)
271234t_head = head `eqP` T.head
@@ -363,19 +326,6 @@ t_toUpper_upper t = p (T.toUpper t) >= p t
363326 where p = T.length . T.filter isUpper
364327tl_toUpper_upper t = p (TL.toUpper t) >= p t
365328 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'
379329
380330justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
381331justifyRight 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)
564514s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)
565515sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
566516 (unpackS . S.takeWhile p . S.filter q)
567−noMatch = do
568− c <- char
569− d <- suchThat char (/= c)
570− return (c,d)
571517t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
572518tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
573519t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
574520 (unpackS . T.takeWhileEnd p)
575−t_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> T.null $
576− T.takeWhileEnd (==d) (T.snoc t c)
577521tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
578522 (unpackS . TL.takeWhileEnd p)
579−tl_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> TL.null $
580− TL.takeWhileEnd (==d) (TL.snoc t c)
581523s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
582524s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
583525sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
@@ -778,7 +720,7 @@ tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
778720 conc = T.concat . TL.toChunks
779721t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
780722 let s = T.intercalate t ts
781− in Slow.indices t s === indices t s
723+ in Slow.indices t s == indices t s
782724
783725-- Bit shifts.
784726shiftL 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
870812-- Reading.
871813
872814t_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)
874816 where t = T.dropWhile isDigit s
875817tl_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)
877819 where t = TL.dropWhile isDigit s
878820t_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)
880822 where t = T.dropWhile isHexDigit s
881823 p = if ox then "0x" else ""
882824 n = getPositive m :: Int
883825tl_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)
885827 where t = TL.dropWhile isHexDigit s
886828 p = if ox then "0x" else ""
887829 n = getPositive m :: Int
@@ -925,11 +867,11 @@ tl_write_read_line e m b t = write_read head TL.filter TL.hPutStrLn
925867
926868t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
927869t_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
929871 where n = small m
930872t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
931873
932−t_copy t = T.copy t === t
874+t_copy t = T.copy t == t
933875
934876-- Regression tests.
935877s_filter_eq s = S.filter p t == S.streamList (filter p s)
@@ -982,15 +924,6 @@ tests =
982924 testGroup "errors" [
983925 testProperty "t_utf8_err" t_utf8_err,
984926 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
994927 ]
995928 ],
996929
@@ -1034,8 +967,6 @@ tests =
1034967 testProperty "sf_uncons" sf_uncons,
1035968 testProperty "t_uncons" t_uncons,
1036969 testProperty "tl_uncons" tl_uncons,
1037− testProperty "t_unsnoc" t_unsnoc,
1038− testProperty "tl_unsnoc" tl_unsnoc,
1039970 testProperty "s_head" s_head,
1040971 testProperty "sf_head" sf_head,
1041972 testProperty "t_head" t_head,
@@ -1099,9 +1030,7 @@ tests =
10991030 testProperty "tl_toLower_lower" tl_toLower_lower,
11001031 testProperty "t_toUpper_length" t_toUpper_length,
11011032 testProperty "t_toUpper_upper" t_toUpper_upper,
1102− testProperty "tl_toUpper_upper" tl_toUpper_upper,
1103− testProperty "t_toTitle_title" t_toTitle_title,
1104− testProperty "t_toTitle_1stNotLower" t_toTitle_1stNotLower
1033+ testProperty "tl_toUpper_upper" tl_toUpper_upper
11051034 ],
11061035
11071036 testGroup "justification" [
@@ -1218,9 +1147,7 @@ tests =
12181147 testProperty "t_takeWhile" t_takeWhile,
12191148 testProperty "tl_takeWhile" tl_takeWhile,
12201149 testProperty "t_takeWhileEnd" t_takeWhileEnd,
1221− testProperty "t_takeWhileEnd_null" t_takeWhileEnd_null,
12221150 testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1223− testProperty "tl_takeWhileEnd_null" tl_takeWhileEnd_null,
12241151 testProperty "sf_dropWhile" sf_dropWhile,
12251152 testProperty "s_dropWhile" s_dropWhile,
12261153 testProperty "s_dropWhile_s" s_dropWhile_s,
tests/Tests/QuickCheckUtils.hs+1−1
@@ -106,7 +106,7 @@ smallArbitrary = sized $ \n -> resize (smallish n) arbitrary
106106 where smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs
107107
108108instance Arbitrary T.Text where
109− arbitrary = T.pack `fmap` string
109+ arbitrary = T.pack `fmap` arbitrary
110110 shrink = map T.pack . shrink . T.unpack
111111
112112instance Arbitrary TL.Text where
tests/Tests/Regressions.hs−11
@@ -72,16 +72,6 @@ mapAccumL_resize = do
7272 assertEqual "mapAccumL should correctly size buffers for two-word results"
7373 (count * 2) (T.lengthWord16 (snd val))
7474
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−
8575tests :: F.Test
8676tests = F.testGroup "Regressions"
8777 [ F.testCase "hGetContents_crash" hGetContents_crash
@@ -89,5 +79,4 @@ tests = F.testGroup "Regressions"
8979 , F.testCase "mapAccumL_resize" mapAccumL_resize
9080 , F.testCase "replicate_crash" replicate_crash
9181 , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe
92− , F.testCase "t197" t197
9382 ]
tests/text-tests.cabal+3−18
@@ -20,11 +20,6 @@ flag hpc
2020 default: False
2121 manual: True
2222
23−flag bytestring-builder
24− description: Depend on the bytestring-builder package for backwards compatibility.
25− default: False
26− manual: False
27−
2823executable text-tests
2924 main-is: Tests.hs
3025
@@ -53,21 +48,16 @@ executable text-tests
5348 HUnit >= 1.2,
5449 QuickCheck >= 2.7,
5550 base == 4.*,
51+ bytestring,
5652 deepseq,
5753 directory,
58− quickcheck-unicode >= 1.0.1.0,
54+ quickcheck-unicode,
5955 random,
6056 test-framework >= 0.4,
6157 test-framework-hunit >= 0.2,
6258 test-framework-quickcheck2 >= 0.2,
6359 text-tests
6460
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−
7161executable text-tests-stdio
7262 main-is: Tests/IO.hs
7363
@@ -147,12 +137,7 @@ library
147137 array,
148138 base == 4.*,
149139 binary,
140+ bytestring,
150141 deepseq,
151142 ghc-prim,
152143 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+62−139
@@ -1,7 +1,7 @@
11name: text
2−version: 1.2.3.0
3−homepage: https://github.com/haskell/text
4−bug-reports: https://github.com/haskell/text/issues
2+version: 1.2.2.1
3+homepage: https://github.com/bos/text
4+bug-reports: https://github.com/bos/text/issues
55synopsis: An efficient packed Unicode text type.
66description:
77 .
@@ -14,13 +14,11 @@ description:
1414 in terms of large data quantities and high speed.
1515 .
1616 The 'Text' type provides character-encoding, type-safe case
17− conversion via whole-string case conversion functions (see "Data.Text").
18− It also provides a range of functions for converting 'Text' values to
19− and from 'ByteStrings', using several standard encodings
20− (see "Data.Text.Encoding").
17+ conversion via whole-string case conversion functions. It also
18+ provides a range of functions for converting 'Text' values to and from
19+ 'ByteStrings', using several standard encodings.
2120 .
22− Efficient locale-sensitive support for text IO is also supported
23− (see "Data.Text.IO").
21+ Efficient locale-sensitive support for text IO is also supported.
2422 .
2523 These modules are intended to be imported qualified, to avoid name
2624 clashes with Prelude functions, e.g.
@@ -30,9 +28,8 @@ description:
3028 To use an extended and very rich family of functions for working
3129 with Unicode text (including normalization, regular expressions,
3230 non-standard encodings, text breaking, and locales), see
33− the [text-icu package](https://hackage.haskell.org/package/text-icu)
34− based on the well-respected and liberally
35− licensed [ICU library](http://site.icu-project.org/).
31+ the @text-icu@ package:
32+ <http://hackage.haskell.org/package/text-icu>
3633
3734license: BSD2
3835license-file: LICENSE
@@ -42,8 +39,6 @@ copyright: 2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper
4239category: Data, Text
4340build-type: Simple
4441cabal-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
4742extra-source-files:
4843 -- scripts/CaseFolding.txt
4944 -- scripts/SpecialCasing.txt
@@ -70,9 +65,7 @@ extra-source-files:
7065 tests/text-tests.cabal
7166
7267flag 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.
7669 default: False
7770 manual: False
7871
@@ -82,9 +75,7 @@ flag developer
8275 manual: True
8376
8477flag integer-simple
85− description:
86− Use the [simple integer library](http://hackage.haskell.org/package/integer-simple)
87− instead of [integer-gmp](http://hackage.haskell.org/package/integer-gmp)
78+ description: Use the simple integer library instead of GMP
8879 default: False
8980 manual: False
9081
@@ -97,13 +88,13 @@ library
9788 Data.Text.Array
9889 Data.Text.Encoding
9990 Data.Text.Encoding.Error
100− -- Data.Text.Foreign
91+ Data.Text.Foreign
10192 Data.Text.IO
10293 Data.Text.Internal
10394 Data.Text.Internal.Builder
104− -- Data.Text.Internal.Builder.Functions
105− -- Data.Text.Internal.Builder.Int.Digits
106− -- Data.Text.Internal.Builder.RealFloat.Functions
95+ Data.Text.Internal.Builder.Functions
96+ Data.Text.Internal.Builder.Int.Digits
97+ Data.Text.Internal.Builder.RealFloat.Functions
10798 Data.Text.Internal.Encoding.Fusion
10899 Data.Text.Internal.Encoding.Fusion.Common
109100 Data.Text.Internal.Encoding.Utf16
@@ -115,14 +106,14 @@ library
115106 Data.Text.Internal.Fusion.Common
116107 Data.Text.Internal.Fusion.Size
117108 Data.Text.Internal.Fusion.Types
118− -- Data.Text.Internal.IO
109+ Data.Text.Internal.IO
119110 Data.Text.Internal.Lazy
120− -- Data.Text.Internal.Lazy.Encoding.Fusion
111+ Data.Text.Internal.Lazy.Encoding.Fusion
121112 Data.Text.Internal.Lazy.Fusion
122113 Data.Text.Internal.Lazy.Search
123114 Data.Text.Internal.Private
124115 Data.Text.Internal.Read
125− -- Data.Text.Internal.Search
116+ Data.Text.Internal.Search
126117 Data.Text.Internal.Unsafe
127118 Data.Text.Internal.Unsafe.Char
128119 Data.Text.Internal.Unsafe.Shift
@@ -133,23 +124,18 @@ library
133124 Data.Text.Lazy.Encoding
134125 Data.Text.Lazy.IO
135126 Data.Text.Lazy.Internal
136− -- Data.Text.Lazy.Read
127+ Data.Text.Lazy.Read
137128 Data.Text.Read
138129 Data.Text.Unsafe
139− -- moved from ghcjs-base
140− -- reflex-dom depends in it
141− Data.JSString.Text
142130
143− -- other-modules:
144− -- Data.Text.Show
131+ other-modules:
132+ Data.Text.Show
145133
146134 build-depends:
147135 array >= 0.3,
148136 base >= 4.2 && < 5,
149137 binary,
150138 deepseq >= 1.1.0.0,
151− ghcjs-base,
152− ghcjs-prim,
153139 ghc-prim >= 0.2
154140
155141 if flag(bytestring-builder)
@@ -172,114 +158,51 @@ library
172158 cpp-options: -DINTEGER_GMP
173159 build-depends: integer-gmp >= 0.2
174160
175−-- test-suite tests
176−-- type: exitcode-stdio-1.0
177−-- c-sources: cbits/cbits.c
178−-- include-dirs: include
161+test-suite tests
162+ type: exitcode-stdio-1.0
163+ hs-source-dirs: tests .
164+ main-is: Tests.hs
165+ c-sources: cbits/cbits.c
166+ include-dirs: include
179167
180−-- ghc-options:
181−-- -Wall -threaded -rtsopts
168+ ghc-options:
169+ -Wall -threaded -O0 -rtsopts
182170
183−-- cpp-options:
184−-- -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE
171+ cpp-options:
172+ -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE
185173
186−-- -- modules specific to test-suite
187−-- hs-source-dirs: tests
188−-- main-is: Tests.hs
189−-- other-modules:
190−-- Tests.Properties
191−-- Tests.Properties.Mul
192−-- Tests.QuickCheckUtils
193−-- Tests.Regressions
194−-- Tests.SlowFunctions
195−-- Tests.Utils
196−
197−-- -- Same as in `library` stanza; this is needed by cabal for accurate
198−-- -- file-monitoring as well as to avoid `-Wmissing-home-modules`
199−-- -- warnings We can't use an inter-package library dependency because
200−-- -- of different `ghc-options`/`cpp-options` (as a side-benefitt,
201−-- -- this enables per-component build parallelism in `cabal
202−-- -- new-build`!); We could, however, use cabal-version:2.2's `common`
203−-- -- blocks at some point in the future to reduce the duplication.
204−-- hs-source-dirs: .
205−-- other-modules:
206−-- Data.Text
207−-- Data.Text.Array
208−-- Data.Text.Encoding
209−-- Data.Text.Encoding.Error
210−-- Data.Text.Foreign
211−-- Data.Text.IO
212−-- Data.Text.Internal
213−-- Data.Text.Internal.Builder
214−-- Data.Text.Internal.Builder.Functions
215−-- Data.Text.Internal.Builder.Int.Digits
216−-- Data.Text.Internal.Builder.RealFloat.Functions
217−-- Data.Text.Internal.Encoding.Fusion
218−-- Data.Text.Internal.Encoding.Fusion.Common
219−-- Data.Text.Internal.Encoding.Utf16
220−-- Data.Text.Internal.Encoding.Utf32
221−-- Data.Text.Internal.Encoding.Utf8
222−-- Data.Text.Internal.Functions
223−-- Data.Text.Internal.Fusion
224−-- Data.Text.Internal.Fusion.CaseMapping
225−-- Data.Text.Internal.Fusion.Common
226−-- Data.Text.Internal.Fusion.Size
227−-- Data.Text.Internal.Fusion.Types
228−-- Data.Text.Internal.IO
229−-- Data.Text.Internal.Lazy
230−-- Data.Text.Internal.Lazy.Encoding.Fusion
231−-- Data.Text.Internal.Lazy.Fusion
232−-- Data.Text.Internal.Lazy.Search
233−-- Data.Text.Internal.Private
234−-- Data.Text.Internal.Read
235−-- Data.Text.Internal.Search
236−-- Data.Text.Internal.Unsafe
237−-- Data.Text.Internal.Unsafe.Char
238−-- Data.Text.Internal.Unsafe.Shift
239−-- Data.Text.Lazy
240−-- Data.Text.Lazy.Builder
241−-- Data.Text.Lazy.Builder.Int
242−-- Data.Text.Lazy.Builder.RealFloat
243−-- Data.Text.Lazy.Encoding
244−-- Data.Text.Lazy.IO
245−-- Data.Text.Lazy.Internal
246−-- Data.Text.Lazy.Read
247−-- Data.Text.Read
248−-- Data.Text.Unsafe
249−-- Data.Text.Show
250−
251−-- build-depends:
252−-- HUnit >= 1.2,
253−-- QuickCheck >= 2.7 && < 2.10,
254−-- array,
255−-- base,
256−-- binary,
257−-- deepseq,
258−-- directory,
259−-- ghc-prim,
260−-- quickcheck-unicode >= 1.0.1.0,
261−-- random,
262−-- test-framework >= 0.4,
263−-- test-framework-hunit >= 0.2,
264−-- test-framework-quickcheck2 >= 0.2
174+ build-depends:
175+ HUnit >= 1.2,
176+ QuickCheck >= 2.7,
177+ array,
178+ base,
179+ binary,
180+ deepseq,
181+ directory,
182+ ghc-prim,
183+ quickcheck-unicode,
184+ random,
185+ test-framework >= 0.4,
186+ test-framework-hunit >= 0.2,
187+ test-framework-quickcheck2 >= 0.2
265188
266−-- if flag(bytestring-builder)
267−-- build-depends: bytestring >= 0.9 && < 0.10.4,
268−-- bytestring-builder >= 0.10.4
269−-- else
270−-- build-depends: bytestring >= 0.10.4
189+ if flag(bytestring-builder)
190+ build-depends: bytestring >= 0.9 && < 0.10.4,
191+ bytestring-builder >= 0.10.4
192+ else
193+ build-depends: bytestring >= 0.10.4
271194
272−-- if flag(integer-simple)
273−-- cpp-options: -DINTEGER_SIMPLE
274−-- build-depends: integer-simple >= 0.1 && < 0.5
275−-- else
276−-- cpp-options: -DINTEGER_GMP
277−-- build-depends: integer-gmp >= 0.2
195+ if flag(integer-simple)
196+ cpp-options: -DINTEGER_SIMPLE
197+ build-depends: integer-simple >= 0.1 && < 0.5
198+ else
199+ cpp-options: -DINTEGER_GMP
200+ build-depends: integer-gmp >= 0.2
278201
279−-- source-repository head
280−-- type: git
281−-- location: https://github.com/haskell/text
202+source-repository head
203+ type: git
204+ location: https://github.com/bos/text
282205
283−-- source-repository head
284−-- type: mercurial
285−-- location: https://bitbucket.org/bos/text
206+source-repository head
207+ type: mercurial
208+ location: https://bitbucket.org/bos/text