on master help sign in
Data/JSString/Text.hsdeleted−64
since splitsnapshots
unifiedsplit
@@ -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+505−616
@@ -6,7 +6,7 @@
6#if __GLASGOW_HASKELL__ >= 708
6#if __GLASGOW_HASKELL__ >= 708
7{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeFamilies #-}
8#endif
8#endif
9−{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI #-}
9+
10-- |
10-- |
11-- Module : Data.Text
11-- Module : Data.Text
12-- Copyright : (c) 2009, 2010, 2011, 2012 Bryan O'Sullivan,
12-- Copyright : (c) 2009, 2010, 2011, 2012 Bryan O'Sullivan,
@@ -223,16 +223,16 @@ import qualified Data.Text.Internal.Fusion as S
223import qualified Data.Text.Internal.Fusion.Common as S
223import qualified Data.Text.Internal.Fusion.Common as S
224import Data.Text.Encoding (decodeUtf8', encodeUtf8)
224import Data.Text.Encoding (decodeUtf8', encodeUtf8)
225import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
225import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
226−-- import Data.Text.Internal.Private (span_)
226+import Data.Text.Internal.Private (span_)
227import Data.Text.Internal (Text(..), empty, firstf, mul, safe, text)
227import Data.Text.Internal (Text(..), empty, firstf, mul, safe, text)
228−-- import Data.Text.Show (singleton, unpack, unpackCString#)
228+import Data.Text.Show (singleton, unpack, unpackCString#)
229import qualified Prelude as P
229import qualified Prelude as P
230import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
230import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
231 reverseIter_, unsafeHead, unsafeTail)
231 reverseIter_, unsafeHead, unsafeTail)
232import Data.Text.Internal.Unsafe.Char (unsafeChr)
232import Data.Text.Internal.Unsafe.Char (unsafeChr)
233import qualified Data.Text.Internal.Functions as F
233import qualified Data.Text.Internal.Functions as F
234import qualified Data.Text.Internal.Encoding.Utf16 as U16
234import qualified Data.Text.Internal.Encoding.Utf16 as U16
235−-- import Data.Text.Internal.Search (indices)
235+import Data.Text.Internal.Search (indices)
236#if defined(__HADDOCK__)
236#if defined(__HADDOCK__)
237import Data.ByteString (ByteString)
237import Data.ByteString (ByteString)
238import qualified Data.Text.Lazy as L
238import qualified Data.Text.Lazy as L
@@ -246,28 +246,6 @@ import qualified GHC.Exts as Exts
246import Text.Printf (PrintfArg, formatArg, formatString)
246import Text.Printf (PrintfArg, formatArg, formatString)
247#endif
247#endif
248
248
249−-- GHCJS ------------------------------------------------------------
250−import Data.JSString (JSString)
251−import qualified Data.JSString as JSS
252−import qualified Data.JSString.Internal.Fusion as SJS
253−import qualified Data.JSString.Internal.Fusion.Common as SJS
254−import Data.Coerce
255−import GHC.Exts (Addr#)
256−
257−unpack :: Text -> String
258−unpack = coerce JSS.unpack
259−
260−singleton :: Char -> Text
261−singleton = coerce JSS.singleton
262−{-# INLINE [1] singleton #-}
263−
264−
265−-- | /O(n)/ Convert a literal string into a JSString. Subject to fusion.
266−unpackCString# :: Addr# -> Text
267−unpackCString# addr# = Text $ SJS.unstream (SJS.streamCString# addr#)
268−{-# NOINLINE unpackCString# #-}
269−---------------------------------------------------------------------
270−
271-- $strict
249-- $strict
272--
250--
273-- This package provides both strict and lazy 'Text' types. The
251-- This package provides both strict and lazy 'Text' types. The
@@ -343,17 +321,17 @@ unpackCString# addr# = Text $ SJS.unstream (SJS.streamCString# addr#)
343-- Functions that can be fused by the compiler are documented with the
321-- Functions that can be fused by the compiler are documented with the
344-- phrase \"Subject to fusion\".
322-- phrase \"Subject to fusion\".
345
323
346−-- instance Eq Text where
324+instance Eq Text where
347−-- Text arrA offA lenA == Text arrB offB lenB
325+ Text arrA offA lenA == Text arrB offB lenB
348−-- | lenA == lenB = A.equal arrA offA arrB offB lenA
326+ | lenA == lenB = A.equal arrA offA arrB offB lenA
349−-- | otherwise = False
327+ | otherwise = False
350−-- {-# INLINE (==) #-}
328+ {-# INLINE (==) #-}
351
329
352−-- instance Ord Text where
330+instance Ord Text where
353−-- compare = compareText
331+ compare = compareText
354
332
355−-- instance Read Text where
333+instance Read Text where
356−-- readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
334+ readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
357
335
358#if MIN_VERSION_base(4,9,0)
336#if MIN_VERSION_base(4,9,0)
359-- Semigroup orphan instances for older GHCs are provided by
337-- Semigroup orphan instances for older GHCs are provided by
@@ -363,17 +341,17 @@ instance Semigroup Text where
363 (<>) = append
341 (<>) = append
364#endif
342#endif
365
343
366−-- instance Monoid Text where
344+instance Monoid Text where
367−-- mempty = empty
345+ mempty = empty
368−-- #if MIN_VERSION_base(4,9,0)
346+#if MIN_VERSION_base(4,9,0)
369−-- mappend = (<>) -- future-proof definition
347+ mappend = (<>) -- future-proof definition
370−-- #else
348+#else
371−-- mappend = append
349+ mappend = append
372−-- #endif
350+#endif
373−-- mconcat = concat
351+ mconcat = concat
374
352
375−-- instance IsString Text where
353+instance IsString Text where
376−-- fromString = pack
354+ fromString = pack
377
355
378#if __GLASGOW_HASKELL__ >= 708
356#if __GLASGOW_HASKELL__ >= 708
379instance Exts.IsList Text where
357instance Exts.IsList Text where
@@ -409,18 +387,18 @@ instance Binary Text where
409-- and 'Data.Map.Map' is archived here:
387-- and 'Data.Map.Map' is archived here:
410-- <http://markmail.org/message/trovdc6zkphyi3cr#query:+page:1+mid:a46der3iacwjcf6n+state:results Proposal: Allow gunfold for Data.Map, ... >
388-- <http://markmail.org/message/trovdc6zkphyi3cr#query:+page:1+mid:a46der3iacwjcf6n+state:results Proposal: Allow gunfold for Data.Map, ... >
411
389
412−-- instance Data Text where
390+instance Data Text where
413−-- gfoldl f z txt = z pack `f` (unpack txt)
391+ gfoldl f z txt = z pack `f` (unpack txt)
414−-- toConstr _ = packConstr
392+ toConstr _ = packConstr
415−-- gunfold k z c = case constrIndex c of
393+ gunfold k z c = case constrIndex c of
416−-- 1 -> k (z pack)
394+ 1 -> k (z pack)
417−-- _ -> P.error "gunfold"
395+ _ -> P.error "gunfold"
418−-- dataTypeOf _ = textDataType
396+ dataTypeOf _ = textDataType
419
397
420#if MIN_VERSION_base(4,7,0)
398#if MIN_VERSION_base(4,7,0)
421-- | Only defined for @base-4.7.0.0@ and later
399-- | Only defined for @base-4.7.0.0@ and later
422instance PrintfArg Text where
400instance PrintfArg Text where
423− formatArg t = formatString $ unpack t
401+ formatArg txt = formatString $ unpack txt
424#endif
402#endif
425
403
426packConstr :: Constr
404packConstr :: Constr
@@ -429,19 +407,19 @@ packConstr = mkConstr textDataType "pack" [] Prefix
429textDataType :: DataType
407textDataType :: DataType
430textDataType = mkDataType "Data.Text.Text" [packConstr]
408textDataType = mkDataType "Data.Text.Text" [packConstr]
431
409
432−-- -- | /O(n)/ Compare two 'Text' values lexicographically.
410+-- | /O(n)/ Compare two 'Text' values lexicographically.
433−-- compareText :: Text -> Text -> Ordering
411+compareText :: Text -> Text -> Ordering
434−-- compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)
412+compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)
435−-- | lenA == 0 && lenB == 0 = EQ
413+ | lenA == 0 && lenB == 0 = EQ
436−-- | otherwise = go 0 0
414+ | otherwise = go 0 0
437−-- where
415+ where
438−-- go !i !j
416+ go !i !j
439−-- | i >= lenA || j >= lenB = compare lenA lenB
417+ | i >= lenA || j >= lenB = compare lenA lenB
440−-- | a < b = LT
418+ | a < b = LT
441−-- | a > b = GT
419+ | a > b = GT
442−-- | otherwise = go (i+di) (j+dj)
420+ | otherwise = go (i+di) (j+dj)
443−-- where Iter a di = iter ta i
421+ where Iter a di = iter ta i
444−-- Iter b dj = iter tb j
422+ Iter b dj = iter tb j
445
423
446-- -----------------------------------------------------------------------------
424-- -----------------------------------------------------------------------------
447-- * Conversion to/from 'Text'
425-- * Conversion to/from 'Text'
@@ -449,8 +427,7 @@ textDataType = mkDataType "Data.Text.Text" [packConstr]
449-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to
427-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to
450-- fusion. Performs replacement on invalid scalar values.
428-- fusion. Performs replacement on invalid scalar values.
451pack :: String -> Text
429pack :: String -> Text
452−pack = coerce JSS.pack
453−-- pack = unstream . S.map safe . S.streamList
430+pack = unstream . S.map safe . S.streamList
454{-# INLINE [1] pack #-}
431{-# INLINE [1] pack #-}
455
432
456-- -----------------------------------------------------------------------------
433-- -----------------------------------------------------------------------------
@@ -461,8 +438,7 @@ pack = coerce JSS.pack
461-- copying a new array. Subject to fusion. Performs replacement on
438-- copying a new array. Subject to fusion. Performs replacement on
462-- invalid scalar values.
439-- invalid scalar values.
463cons :: Char -> Text -> Text
440cons :: Char -> Text -> Text
464−cons = coerce JSS.cons
465−-- cons c t = unstream (S.cons (safe c) (stream t))
441+cons c t = unstream (S.cons (safe c) (stream t))
466{-# INLINE cons #-}
442{-# INLINE cons #-}
467
443
468infixr 5 `cons`
444infixr 5 `cons`
@@ -471,51 +447,47 @@ infixr 5 `cons`
471-- entire array in the process, unless fused. Subject to fusion.
447-- entire array in the process, unless fused. Subject to fusion.
472-- Performs replacement on invalid scalar values.
448-- Performs replacement on invalid scalar values.
473snoc :: Text -> Char -> Text
449snoc :: Text -> Char -> Text
474−snoc = coerce JSS.snoc
475−-- snoc t c = unstream (S.snoc (stream t) (safe c))
450+snoc t c = unstream (S.snoc (stream t) (safe c))
476{-# INLINE snoc #-}
451{-# INLINE snoc #-}
477
452
478-- | /O(n)/ Appends one 'Text' to the other by copying both of them
453-- | /O(n)/ Appends one 'Text' to the other by copying both of them
479-- into a new 'Text'. Subject to fusion.
454-- into a new 'Text'. Subject to fusion.
480append :: Text -> Text -> Text
455append :: Text -> Text -> Text
481−append = coerce JSS.append
482−-- append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
456+append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
483−-- | len1 == 0 = b
457+ | len1 == 0 = b
484−-- | len2 == 0 = a
458+ | len2 == 0 = a
485−-- | len > 0 = Text (A.run x) 0 len
459+ | len > 0 = Text (A.run x) 0 len
486−-- | otherwise = overflowError "append"
460+ | otherwise = overflowError "append"
487−-- where
461+ where
488−-- len = len1+len2
462+ len = len1+len2
489−-- x :: ST s (A.MArray s)
463+ x :: ST s (A.MArray s)
490−-- x = do
464+ x = do
491−-- arr <- A.new len
465+ arr <- A.new len
492−-- A.copyI arr 0 arr1 off1 len1
466+ A.copyI arr 0 arr1 off1 len1
493−-- A.copyI arr len1 arr2 off2 len
467+ A.copyI arr len1 arr2 off2 len
494−-- return arr
468+ return arr
495{-# NOINLINE append #-}
469{-# NOINLINE append #-}
496
470
497−-- {-# RULES
471+{-# RULES
498−-- "TEXT append -> fused" [~1] forall t1 t2.
472+"TEXT append -> fused" [~1] forall t1 t2.
499−-- append t1 t2 = unstream (S.append (stream t1) (stream t2))
473+ append t1 t2 = unstream (S.append (stream t1) (stream t2))
500−-- "TEXT append -> unfused" [1] forall t1 t2.
474+"TEXT append -> unfused" [1] forall t1 t2.
501−-- unstream (S.append (stream t1) (stream t2)) = append t1 t2
475+ unstream (S.append (stream t1) (stream t2)) = append t1 t2
502−-- #-}
476+ #-}
503
477
504-- | /O(1)/ Returns the first character of a 'Text', which must be
478-- | /O(1)/ Returns the first character of a 'Text', which must be
505-- non-empty. Subject to fusion.
479-- non-empty. Subject to fusion.
506head :: Text -> Char
480head :: Text -> Char
507−head = coerce JSS.head
508−-- head t = S.head (stream t)
481+head t = S.head (stream t)
509{-# INLINE head #-}
482{-# INLINE head #-}
510
483
511-- | /O(1)/ Returns the first character and rest of a 'Text', or
484-- | /O(1)/ Returns the first character and rest of a 'Text', or
512-- 'Nothing' if empty. Subject to fusion.
485-- 'Nothing' if empty. Subject to fusion.
513uncons :: Text -> Maybe (Char, Text)
486uncons :: Text -> Maybe (Char, Text)
514−uncons = coerce JSS.uncons
515−-- uncons t@(Text arr off len)
487+uncons t@(Text arr off len)
516−-- | len <= 0 = Nothing
488+ | len <= 0 = Nothing
517−-- | otherwise = Just $ let !(Iter c d) = iter t 0
489+ | otherwise = Just $ let !(Iter c d) = iter t 0
518−-- in (c, text arr (off+d) (len-d))
490+ in (c, text arr (off+d) (len-d))
519{-# INLINE [1] uncons #-}
491{-# INLINE [1] uncons #-}
520
492
521-- | Lifted from Control.Arrow and specialized.
493-- | Lifted from Control.Arrow and specialized.
@@ -525,86 +497,81 @@ second f (a, b) = (a, f b)
525-- | /O(1)/ Returns the last character of a 'Text', which must be
497-- | /O(1)/ Returns the last character of a 'Text', which must be
526-- non-empty. Subject to fusion.
498-- non-empty. Subject to fusion.
527last :: Text -> Char
499last :: Text -> Char
528−last = coerce JSS.last
529−-- last (Text arr off len)
500+last (Text arr off len)
530−-- | len <= 0 = emptyError "last"
501+ | len <= 0 = emptyError "last"
531−-- | n < 0xDC00 || n > 0xDFFF = unsafeChr n
502+ | n < 0xDC00 || n > 0xDFFF = unsafeChr n
532−-- | otherwise = U16.chr2 n0 n
503+ | otherwise = U16.chr2 n0 n
533−-- where n = A.unsafeIndex arr (off+len-1)
504+ where n = A.unsafeIndex arr (off+len-1)
534−-- n0 = A.unsafeIndex arr (off+len-2)
505+ n0 = A.unsafeIndex arr (off+len-2)
535{-# INLINE [1] last #-}
506{-# INLINE [1] last #-}
536
507
537−-- {-# RULES
508+{-# RULES
538−-- "TEXT last -> fused" [~1] forall t.
509+"TEXT last -> fused" [~1] forall t.
539−-- last t = S.last (stream t)
510+ last t = S.last (stream t)
540−-- "TEXT last -> unfused" [1] forall t.
511+"TEXT last -> unfused" [1] forall t.
541−-- S.last (stream t) = last t
512+ S.last (stream t) = last t
542−-- #-}
513+ #-}
543
514
544-- | /O(1)/ Returns all characters after the head of a 'Text', which
515-- | /O(1)/ Returns all characters after the head of a 'Text', which
545-- must be non-empty. Subject to fusion.
516-- must be non-empty. Subject to fusion.
546tail :: Text -> Text
517tail :: Text -> Text
547−tail = coerce JSS.tail
548−-- tail t@(Text arr off len)
518+tail t@(Text arr off len)
549−-- | len <= 0 = emptyError "tail"
519+ | len <= 0 = emptyError "tail"
550−-- | otherwise = text arr (off+d) (len-d)
520+ | otherwise = text arr (off+d) (len-d)
551−-- where d = iter_ t 0
521+ where d = iter_ t 0
552{-# INLINE [1] tail #-}
522{-# INLINE [1] tail #-}
553
523
554−-- {-# RULES
524+{-# RULES
555−-- "TEXT tail -> fused" [~1] forall t.
525+"TEXT tail -> fused" [~1] forall t.
556−-- tail t = unstream (S.tail (stream t))
526+ tail t = unstream (S.tail (stream t))
557−-- "TEXT tail -> unfused" [1] forall t.
527+"TEXT tail -> unfused" [1] forall t.
558−-- unstream (S.tail (stream t)) = tail t
528+ unstream (S.tail (stream t)) = tail t
559−-- #-}
529+ #-}
560
530
561-- | /O(1)/ Returns all but the last character of a 'Text', which must
531-- | /O(1)/ Returns all but the last character of a 'Text', which must
562-- be non-empty. Subject to fusion.
532-- be non-empty. Subject to fusion.
563init :: Text -> Text
533init :: Text -> Text
564−init = coerce JSS.init
565−-- init (Text arr off len) | len <= 0 = emptyError "init"
534+init (Text arr off len) | len <= 0 = emptyError "init"
566−-- | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)
535+ | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)
567−-- | otherwise = text arr off (len-1)
536+ | otherwise = text arr off (len-1)
568−-- where
537+ where
569−-- n = A.unsafeIndex arr (off+len-1)
538+ n = A.unsafeIndex arr (off+len-1)
570{-# INLINE [1] init #-}
539{-# INLINE [1] init #-}
571
540
572−-- {-# RULES
541+{-# RULES
573−-- "TEXT init -> fused" [~1] forall t.
542+"TEXT init -> fused" [~1] forall t.
574−-- init t = unstream (S.init (stream t))
543+ init t = unstream (S.init (stream t))
575−-- "TEXT init -> unfused" [1] forall t.
544+"TEXT init -> unfused" [1] forall t.
576−-- unstream (S.init (stream t)) = init t
545+ unstream (S.init (stream t)) = init t
577−-- #-}
546+ #-}
578
547
579-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
548-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
580-- fusion.
549-- fusion.
581null :: Text -> Bool
550null :: Text -> Bool
582−null = coerce JSS.null
583−-- null (Text _arr _off len) =
551+null (Text _arr _off len) =
584−-- #if defined(ASSERTS)
552+#if defined(ASSERTS)
585−-- assert (len >= 0) $
553+ assert (len >= 0) $
586−-- #endif
554+#endif
587−-- len <= 0
555+ len <= 0
588{-# INLINE [1] null #-}
556{-# INLINE [1] null #-}
589
557
590−-- {-# RULES
558+{-# RULES
591−-- "TEXT null -> fused" [~1] forall t.
559+"TEXT null -> fused" [~1] forall t.
592−-- null t = S.null (stream t)
560+ null t = S.null (stream t)
593−-- "TEXT null -> unfused" [1] forall t.
561+"TEXT null -> unfused" [1] forall t.
594−-- S.null (stream t) = null t
562+ S.null (stream t) = null t
595−-- #-}
563+ #-}
596
564
597-- | /O(1)/ Tests whether a 'Text' contains exactly one character.
565-- | /O(1)/ Tests whether a 'Text' contains exactly one character.
598-- Subject to fusion.
566-- Subject to fusion.
599−-- isSingleton :: Text -> Bool
567+isSingleton :: Text -> Bool
600−-- isSingleton = S.isSingleton . stream
568+isSingleton = S.isSingleton . stream
601−-- {-# INLINE isSingleton #-}
569+{-# INLINE isSingleton #-}
602
570
603-- | /O(n)/ Returns the number of characters in a 'Text'.
571-- | /O(n)/ Returns the number of characters in a 'Text'.
604-- Subject to fusion.
572-- Subject to fusion.
605length :: Text -> Int
573length :: Text -> Int
606−length = coerce JSS.length
607−-- length t = S.length (stream t)
574+length t = S.length (stream t)
608{-# INLINE [0] length #-}
575{-# INLINE [0] length #-}
609-- length needs to be phased after the compareN/length rules otherwise
576-- length needs to be phased after the compareN/length rules otherwise
610-- it may inline before the rules have an opportunity to fire.
577-- it may inline before the rules have an opportunity to fire.
@@ -616,44 +583,43 @@ length = coerce JSS.length
616-- of 'length', but can short circuit if the count of characters is
583-- of 'length', but can short circuit if the count of characters is
617-- greater than the number, and hence be more efficient.
584-- greater than the number, and hence be more efficient.
618compareLength :: Text -> Int -> Ordering
585compareLength :: Text -> Int -> Ordering
619−compareLength t n = compare (length t) n
620−-- compareLength t n = S.compareLengthI (stream t) n
586+compareLength t n = S.compareLengthI (stream t) n
621−-- {-# INLINE [1] compareLength #-}
587+{-# INLINE [1] compareLength #-}
622−--
588+
623−-- {-# RULES
589+{-# RULES
624−-- "TEXT compareN/length -> compareLength" [~1] forall t n.
590+"TEXT compareN/length -> compareLength" [~1] forall t n.
625−-- compare (length t) n = compareLength t n
591+ compare (length t) n = compareLength t n
626−-- #-}
592+ #-}
627−--
593+
628−-- {-# RULES
594+{-# RULES
629−-- "TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.
595+"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.
630−-- eqInt (length t) n = compareLength t n == EQ
596+ eqInt (length t) n = compareLength t n == EQ
631−-- #-}
597+ #-}
632−--
598+
633−-- {-# RULES
599+{-# RULES
634−-- "TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.
600+"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.
635−-- neInt (length t) n = compareLength t n /= EQ
601+ neInt (length t) n = compareLength t n /= EQ
636−-- #-}
602+ #-}
637−--
603+
638−-- {-# RULES
604+{-# RULES
639−-- "TEXT <N/length -> compareLength/==LT" [~1] forall t n.
605+"TEXT <N/length -> compareLength/==LT" [~1] forall t n.
640−-- ltInt (length t) n = compareLength t n == LT
606+ ltInt (length t) n = compareLength t n == LT
641−-- #-}
607+ #-}
642−--
608+
643−-- {-# RULES
609+{-# RULES
644−-- "TEXT <=N/length -> compareLength//=GT" [~1] forall t n.
610+"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.
645−-- leInt (length t) n = compareLength t n /= GT
611+ leInt (length t) n = compareLength t n /= GT
646−-- #-}
612+ #-}
647−--
613+
648−-- {-# RULES
614+{-# RULES
649−-- "TEXT >N/length -> compareLength/==GT" [~1] forall t n.
615+"TEXT >N/length -> compareLength/==GT" [~1] forall t n.
650−-- gtInt (length t) n = compareLength t n == GT
616+ gtInt (length t) n = compareLength t n == GT
651−-- #-}
617+ #-}
652−--
618+
653−-- {-# RULES
619+{-# RULES
654−-- "TEXT >=N/length -> compareLength//=LT" [~1] forall t n.
620+"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.
655−-- geInt (length t) n = compareLength t n /= LT
621+ geInt (length t) n = compareLength t n /= LT
656−-- #-}
622+ #-}
657
623
658-- -----------------------------------------------------------------------------
624-- -----------------------------------------------------------------------------
659-- * Transformations
625-- * Transformations
@@ -661,30 +627,26 @@ compareLength t n = compare (length t) n
661-- each element of @t@. Subject to fusion. Performs replacement on
627-- each element of @t@. Subject to fusion. Performs replacement on
662-- invalid scalar values.
628-- invalid scalar values.
663map :: (Char -> Char) -> Text -> Text
629map :: (Char -> Char) -> Text -> Text
664−map = coerce JSS.map
665−-- map f t = unstream (S.map (safe . f) (stream t))
630+map f t = unstream (S.map (safe . f) (stream t))
666{-# INLINE [1] map #-}
631{-# INLINE [1] map #-}
667
632
668-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of
633-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of
669-- 'Text's and concatenates the list after interspersing the first
634-- 'Text's and concatenates the list after interspersing the first
670-- argument between each element of the list.
635-- argument between each element of the list.
671intercalate :: Text -> [Text] -> Text
636intercalate :: Text -> [Text] -> Text
672−intercalate = coerce JSS.intercalate
673−-- intercalate t = concat . (F.intersperse t)
637+intercalate t = concat . (F.intersperse t)
674{-# INLINE intercalate #-}
638{-# INLINE intercalate #-}
675
639
676-- | /O(n)/ The 'intersperse' function takes a character and places it
640-- | /O(n)/ The 'intersperse' function takes a character and places it
677-- between the characters of a 'Text'. Subject to fusion. Performs
641-- between the characters of a 'Text'. Subject to fusion. Performs
678-- replacement on invalid scalar values.
642-- replacement on invalid scalar values.
679intersperse :: Char -> Text -> Text
643intersperse :: Char -> Text -> Text
680−intersperse = coerce JSS.intersperse
681−-- intersperse c t = unstream (S.intersperse (safe c) (stream t))
644+intersperse c t = unstream (S.intersperse (safe c) (stream t))
682{-# INLINE intersperse #-}
645{-# INLINE intersperse #-}
683
646
684-- | /O(n)/ Reverse the characters of a string. Subject to fusion.
647-- | /O(n)/ Reverse the characters of a string. Subject to fusion.
685reverse :: Text -> Text
648reverse :: Text -> Text
686−reverse = coerce JSS.reverse
687−-- reverse t = S.reverse (stream t)
649+reverse t = S.reverse (stream t)
688{-# INLINE reverse #-}
650{-# INLINE reverse #-}
689
651
690-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
652-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
@@ -718,29 +680,28 @@ replace :: Text
718 -> Text
680 -> Text
719 -- ^ @haystack@ in which to search.
681 -- ^ @haystack@ in which to search.
720 -> Text
682 -> Text
721−replace = coerce JSS.replace
722−-- replace needle@(Text _ _ neeLen)
683+replace needle@(Text _ _ neeLen)
723−-- (Text repArr repOff repLen)
684+ (Text repArr repOff repLen)
724−-- haystack@(Text hayArr hayOff hayLen)
685+ haystack@(Text hayArr hayOff hayLen)
725−-- | neeLen == 0 = emptyError "replace"
686+ | neeLen == 0 = emptyError "replace"
726−-- | L.null ixs = haystack
687+ | L.null ixs = haystack
727−-- | len > 0 = Text (A.run x) 0 len
688+ | len > 0 = Text (A.run x) 0 len
728−-- | otherwise = empty
689+ | otherwise = empty
729−-- where
690+ where
730−-- ixs = indices needle haystack
691+ ixs = indices needle haystack
731−-- len = hayLen - (neeLen - repLen) `mul` L.length ixs
692+ len = hayLen - (neeLen - repLen) `mul` L.length ixs
732−-- x :: ST s (A.MArray s)
693+ x :: ST s (A.MArray s)
733−-- x = do
694+ x = do
734−-- marr <- A.new len
695+ marr <- A.new len
735−-- let loop (i:is) o d = do
696+ let loop (i:is) o d = do
736−-- let d0 = d + i - o
697+ let d0 = d + i - o
737−-- d1 = d0 + repLen
698+ d1 = d0 + repLen
738−-- A.copyI marr d hayArr (hayOff+o) d0
699+ A.copyI marr d hayArr (hayOff+o) d0
739−-- A.copyI marr d0 repArr repOff d1
700+ A.copyI marr d0 repArr repOff d1
740−-- loop is (i + neeLen) d1
701+ loop is (i + neeLen) d1
741−-- loop [] o d = A.copyI marr d hayArr (hayOff+o) len
702+ loop [] o d = A.copyI marr d hayArr (hayOff+o) len
742−-- loop ixs 0 0
703+ loop ixs 0 0
743−-- return marr
704+ return marr
744
705
745-- ----------------------------------------------------------------------------
706-- ----------------------------------------------------------------------------
746-- ** Case conversions (folds)
707-- ** Case conversions (folds)
@@ -779,8 +740,7 @@ replace = coerce JSS.replace
779-- U+00B5) is case folded to \"&#x3bc;\" (small letter mu, U+03BC)
740-- U+00B5) is case folded to \"&#x3bc;\" (small letter mu, U+03BC)
780-- instead of itself.
741-- instead of itself.
781toCaseFold :: Text -> Text
742toCaseFold :: Text -> Text
782−-- toCaseFold t = unstream (S.toCaseFold (stream t))
743+toCaseFold t = unstream (S.toCaseFold (stream t))
783−toCaseFold = coerce JSS.toCaseFold
784{-# INLINE toCaseFold #-}
744{-# INLINE toCaseFold #-}
785
745
786-- | /O(n)/ Convert a string to lower case, using simple case
746-- | /O(n)/ Convert a string to lower case, using simple case
@@ -791,8 +751,7 @@ toCaseFold = coerce JSS.toCaseFold
791-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)
751-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)
792-- followed by \" &#x307;\" (combining dot above, U+0307).
752-- followed by \" &#x307;\" (combining dot above, U+0307).
793toLower :: Text -> Text
753toLower :: Text -> Text
794−-- toLower t = unstream (S.toLower (stream t))
754+toLower t = unstream (S.toLower (stream t))
795−toLower = coerce JSS.toLower
796{-# INLINE toLower #-}
755{-# INLINE toLower #-}
797
756
798-- | /O(n)/ Convert a string to upper case, using simple case
757-- | /O(n)/ Convert a string to upper case, using simple case
@@ -802,8 +761,7 @@ toLower = coerce JSS.toLower
802-- instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the
761-- instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the
803-- two-letter sequence \"SS\".
762-- two-letter sequence \"SS\".
804toUpper :: Text -> Text
763toUpper :: Text -> Text
805−-- toUpper t = unstream (S.toUpper (stream t))
764+toUpper t = unstream (S.toUpper (stream t))
806−toUpper = coerce JSS.toUpper
807{-# INLINE toUpper #-}
765{-# INLINE toUpper #-}
808
766
809-- | /O(n)/ Convert a string to title case, using simple case
767-- | /O(n)/ Convert a string to title case, using simple case
@@ -825,8 +783,7 @@ toUpper = coerce JSS.toUpper
825-- Fox\" is correctly title cased&#x2014;but this function will
783-- Fox\" is correctly title cased&#x2014;but this function will
826-- capitalize /every/ word.
784-- capitalize /every/ word.
827toTitle :: Text -> Text
785toTitle :: Text -> Text
828−toTitle = coerce JSS.toTitle
829−-- toTitle t = unstream (S.toTitle (stream t))
786+toTitle t = unstream (S.toTitle (stream t))
830{-# INLINE toTitle #-}
787{-# INLINE toTitle #-}
831
788
832-- | /O(n)/ Left-justify a string to the given length, using the
789-- | /O(n)/ Left-justify a string to the given length, using the
@@ -838,19 +795,18 @@ toTitle = coerce JSS.toTitle
838-- > justifyLeft 7 'x' "foo" == "fooxxxx"
795-- > justifyLeft 7 'x' "foo" == "fooxxxx"
839-- > justifyLeft 3 'x' "foobar" == "foobar"
796-- > justifyLeft 3 'x' "foobar" == "foobar"
840justifyLeft :: Int -> Char -> Text -> Text
797justifyLeft :: Int -> Char -> Text -> Text
841−justifyLeft = coerce JSS.justifyLeft
798+justifyLeft k c t
842−-- justifyLeft k c t
843−-- | len >= k = t
799+ | len >= k = t
844−-- | otherwise = t `append` replicateChar (k-len) c
800+ | otherwise = t `append` replicateChar (k-len) c
845−-- where len = length t
801+ where len = length t
846{-# INLINE [1] justifyLeft #-}
802{-# INLINE [1] justifyLeft #-}
847
803
848−-- {-# RULES
804+{-# RULES
849−-- "TEXT justifyLeft -> fused" [~1] forall k c t.
805+"TEXT justifyLeft -> fused" [~1] forall k c t.
850−-- justifyLeft k c t = unstream (S.justifyLeftI k c (stream t))
806+ justifyLeft k c t = unstream (S.justifyLeftI k c (stream t))
851−-- "TEXT justifyLeft -> unfused" [1] forall k c t.
807+"TEXT justifyLeft -> unfused" [1] forall k c t.
852−-- unstream (S.justifyLeftI k c (stream t)) = justifyLeft k c t
808+ unstream (S.justifyLeftI k c (stream t)) = justifyLeft k c t
853−-- #-}
809+ #-}
854
810
855-- | /O(n)/ Right-justify a string to the given length, using the
811-- | /O(n)/ Right-justify a string to the given length, using the
856-- specified fill character on the left. Performs replacement on
812-- specified fill character on the left. Performs replacement on
@@ -861,11 +817,10 @@ justifyLeft = coerce JSS.justifyLeft
861-- > justifyRight 7 'x' "bar" == "xxxxbar"
817-- > justifyRight 7 'x' "bar" == "xxxxbar"
862-- > justifyRight 3 'x' "foobar" == "foobar"
818-- > justifyRight 3 'x' "foobar" == "foobar"
863justifyRight :: Int -> Char -> Text -> Text
819justifyRight :: Int -> Char -> Text -> Text
864−justifyRight = coerce JSS.justifyRight
820+justifyRight k c t
865−-- justifyRight k c t
866−-- | len >= k = t
821+ | len >= k = t
867−-- | otherwise = replicateChar (k-len) c `append` t
822+ | otherwise = replicateChar (k-len) c `append` t
868−-- where len = length t
823+ where len = length t
869{-# INLINE justifyRight #-}
824{-# INLINE justifyRight #-}
870
825
871-- | /O(n)/ Center a string to the given length, using the specified
826-- | /O(n)/ Center a string to the given length, using the specified
@@ -876,14 +831,13 @@ justifyRight = coerce JSS.justifyRight
876--
831--
877-- > center 8 'x' "HS" = "xxxHSxxx"
832-- > center 8 'x' "HS" = "xxxHSxxx"
878center :: Int -> Char -> Text -> Text
833center :: Int -> Char -> Text -> Text
879−center = coerce JSS.center
834+center k c t
880−-- center k c t
881−-- | len >= k = t
835+ | len >= k = t
882−-- | otherwise = replicateChar l c `append` t `append` replicateChar r c
836+ | otherwise = replicateChar l c `append` t `append` replicateChar r c
883−-- where len = length t
837+ where len = length t
884−-- d = k - len
838+ d = k - len
885−-- r = d `quot` 2
839+ r = d `quot` 2
886−-- l = d - r
840+ l = d - r
887{-# INLINE center #-}
841{-# INLINE center #-}
888
842
889-- | /O(n)/ The 'transpose' function transposes the rows and columns
843-- | /O(n)/ The 'transpose' function transposes the rows and columns
@@ -891,8 +845,7 @@ center = coerce JSS.center
891-- 'unpack', and the list version of transpose, and is thus not very
845-- 'unpack', and the list version of transpose, and is thus not very
892-- efficient.
846-- efficient.
893transpose :: [Text] -> [Text]
847transpose :: [Text] -> [Text]
894−transpose = coerce JSS.transpose
895−-- transpose ts = P.map pack (L.transpose (P.map unpack ts))
848+transpose ts = P.map pack (L.transpose (P.map unpack ts))
896
849
897-- -----------------------------------------------------------------------------
850-- -----------------------------------------------------------------------------
898-- * Reducing 'Text's (folds)
851-- * Reducing 'Text's (folds)
@@ -902,27 +855,23 @@ transpose = coerce JSS.transpose
902-- reduces the 'Text' using the binary operator, from left to right.
855-- reduces the 'Text' using the binary operator, from left to right.
903-- Subject to fusion.
856-- Subject to fusion.
904foldl :: (a -> Char -> a) -> a -> Text -> a
857foldl :: (a -> Char -> a) -> a -> Text -> a
905−foldl f a0 (Text t) = JSS.foldl f a0 t
906−-- foldl f z t = S.foldl f z (stream t)
858+foldl f z t = S.foldl f z (stream t)
907{-# INLINE foldl #-}
859{-# INLINE foldl #-}
908
860
909-- | /O(n)/ A strict version of 'foldl'. Subject to fusion.
861-- | /O(n)/ A strict version of 'foldl'. Subject to fusion.
910foldl' :: (a -> Char -> a) -> a -> Text -> a
862foldl' :: (a -> Char -> a) -> a -> Text -> a
911−foldl' f a0 (Text t) = JSS.foldl' f a0 t
912−-- foldl' f z t = S.foldl' f z (stream t)
863+foldl' f z t = S.foldl' f z (stream t)
913{-# INLINE foldl' #-}
864{-# INLINE foldl' #-}
914
865
915-- | /O(n)/ A variant of 'foldl' that has no starting value argument,
866-- | /O(n)/ A variant of 'foldl' that has no starting value argument,
916-- and thus must be applied to a non-empty 'Text'. Subject to fusion.
867-- and thus must be applied to a non-empty 'Text'. Subject to fusion.
917foldl1 :: (Char -> Char -> Char) -> Text -> Char
868foldl1 :: (Char -> Char -> Char) -> Text -> Char
918−foldl1 = coerce JSS.foldl1
919−-- foldl1 f t = S.foldl1 f (stream t)
869+foldl1 f t = S.foldl1 f (stream t)
920{-# INLINE foldl1 #-}
870{-# INLINE foldl1 #-}
921
871
922-- | /O(n)/ A strict version of 'foldl1'. Subject to fusion.
872-- | /O(n)/ A strict version of 'foldl1'. Subject to fusion.
923foldl1' :: (Char -> Char -> Char) -> Text -> Char
873foldl1' :: (Char -> Char -> Char) -> Text -> Char
924−foldl1' = coerce JSS.foldl1'
925−-- foldl1' f t = S.foldl1' f (stream t)
874+foldl1' f t = S.foldl1' f (stream t)
926{-# INLINE foldl1' #-}
875{-# INLINE foldl1' #-}
927
876
928-- | /O(n)/ 'foldr', applied to a binary operator, a starting value
877-- | /O(n)/ 'foldr', applied to a binary operator, a starting value
@@ -930,16 +879,14 @@ foldl1' = coerce JSS.foldl1'
930-- reduces the 'Text' using the binary operator, from right to left.
879-- reduces the 'Text' using the binary operator, from right to left.
931-- Subject to fusion.
880-- Subject to fusion.
932foldr :: (Char -> a -> a) -> a -> Text -> a
881foldr :: (Char -> a -> a) -> a -> Text -> a
933−foldr f a0 (Text t) = JSS.foldr f a0 t
934−-- foldr f z t = S.foldr f z (stream t)
882+foldr f z t = S.foldr f z (stream t)
935{-# INLINE foldr #-}
883{-# INLINE foldr #-}
936
884
937-- | /O(n)/ A variant of 'foldr' that has no starting value argument,
885-- | /O(n)/ A variant of 'foldr' that has no starting value argument,
938-- and thus must be applied to a non-empty 'Text'. Subject to
886-- and thus must be applied to a non-empty 'Text'. Subject to
939-- fusion.
887-- fusion.
940foldr1 :: (Char -> Char -> Char) -> Text -> Char
888foldr1 :: (Char -> Char -> Char) -> Text -> Char
941−foldr1 = coerce JSS.foldr1
942−-- foldr1 f t = S.foldr1 f (stream t)
889+foldr1 f t = S.foldr1 f (stream t)
943{-# INLINE foldr1 #-}
890{-# INLINE foldr1 #-}
944
891
945-- -----------------------------------------------------------------------------
892-- -----------------------------------------------------------------------------
@@ -947,54 +894,48 @@ foldr1 = coerce JSS.foldr1
947
894
948-- | /O(n)/ Concatenate a list of 'Text's.
895-- | /O(n)/ Concatenate a list of 'Text's.
949concat :: [Text] -> Text
896concat :: [Text] -> Text
950−concat = coerce JSS.concat
951−-- concat ts = case ts' of
897+concat ts = case ts' of
952−-- [] -> empty
898+ [] -> empty
953−-- [t] -> t
899+ [t] -> t
954−-- _ -> Text (A.run go) 0 len
900+ _ -> Text (A.run go) 0 len
955−-- where
901+ where
956−-- ts' = L.filter (not . null) ts
902+ ts' = L.filter (not . null) ts
957−-- len = sumP "concat" $ L.map lengthWord16 ts'
903+ len = sumP "concat" $ L.map lengthWord16 ts'
958−-- go :: ST s (A.MArray s)
904+ go :: ST s (A.MArray s)
959−-- go = do
905+ go = do
960−-- arr <- A.new len
906+ arr <- A.new len
961−-- let step i (Text a o l) =
907+ let step i (Text a o l) =
962−-- let !j = i + l in A.copyI arr i a o j >> return j
908+ let !j = i + l in A.copyI arr i a o j >> return j
963−-- foldM step 0 ts' >> return arr
909+ foldM step 0 ts' >> return arr
964
910
965-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and
911-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and
966-- concatenate the results.
912-- concatenate the results.
967concatMap :: (Char -> Text) -> Text -> Text
913concatMap :: (Char -> Text) -> Text -> Text
968−concatMap = coerce JSS.concatMap
969−-- concatMap f = concat . foldr ((:) . f) []
914+concatMap f = concat . foldr ((:) . f) []
970{-# INLINE concatMap #-}
915{-# INLINE concatMap #-}
971
916
972-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
917-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
973-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
918-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
974any :: (Char -> Bool) -> Text -> Bool
919any :: (Char -> Bool) -> Text -> Bool
975−any = coerce JSS.any
976−-- any p t = S.any p (stream t)
920+any p t = S.any p (stream t)
977{-# INLINE any #-}
921{-# INLINE any #-}
978
922
979-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
923-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
980-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
924-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
981all :: (Char -> Bool) -> Text -> Bool
925all :: (Char -> Bool) -> Text -> Bool
982−all = coerce JSS.all
983−-- all p t = S.all p (stream t)
926+all p t = S.all p (stream t)
984{-# INLINE all #-}
927{-# INLINE all #-}
985
928
986-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which
929-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which
987-- must be non-empty. Subject to fusion.
930-- must be non-empty. Subject to fusion.
988maximum :: Text -> Char
931maximum :: Text -> Char
989−maximum = coerce JSS.maximum
990−-- maximum t = S.maximum (stream t)
932+maximum t = S.maximum (stream t)
991{-# INLINE maximum #-}
933{-# INLINE maximum #-}
992
934
993-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which
935-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which
994-- must be non-empty. Subject to fusion.
936-- must be non-empty. Subject to fusion.
995minimum :: Text -> Char
937minimum :: Text -> Char
996−minimum = coerce JSS.minimum
997−-- minimum t = S.minimum (stream t)
938+minimum t = S.minimum (stream t)
998{-# INLINE minimum #-}
939{-# INLINE minimum #-}
999
940
1000-- -----------------------------------------------------------------------------
941-- -----------------------------------------------------------------------------
@@ -1010,9 +951,8 @@ minimum = coerce JSS.minimum
1010--
951--
1011-- > last (scanl f z xs) == foldl f z xs.
952-- > last (scanl f z xs) == foldl f z xs.
1012scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
953scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
1013−scanl = coerce JSS.scanl
1014−-- scanl f z t = unstream (S.scanl g z (stream t))
954+scanl f z t = unstream (S.scanl g z (stream t))
1015−-- where g a b = safe (f a b)
955+ where g a b = safe (f a b)
1016{-# INLINE scanl #-}
956{-# INLINE scanl #-}
1017
957
1018-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting
958-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting
@@ -1021,9 +961,8 @@ scanl = coerce JSS.scanl
1021--
961--
1022-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
962-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
1023scanl1 :: (Char -> Char -> Char) -> Text -> Text
963scanl1 :: (Char -> Char -> Char) -> Text -> Text
1024−scanl1 = coerce JSS.scanl1
1025−-- scanl1 f t | null t = empty
964+scanl1 f t | null t = empty
1026−-- | otherwise = scanl f (unsafeHead t) (unsafeTail t)
965+ | otherwise = scanl f (unsafeHead t) (unsafeTail t)
1027{-# INLINE scanl1 #-}
966{-# INLINE scanl1 #-}
1028
967
1029-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'. Performs
968-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'. Performs
@@ -1031,18 +970,16 @@ scanl1 = coerce JSS.scanl1
1031--
970--
1032-- > scanr f v == reverse . scanl (flip f) v . reverse
971-- > scanr f v == reverse . scanl (flip f) v . reverse
1033scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
972scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
1034−scanr = coerce JSS.scanr
1035−-- scanr f z = S.reverse . S.reverseScanr g z . reverseStream
973+scanr f z = S.reverse . S.reverseScanr g z . reverseStream
1036−-- where g a b = safe (f a b)
974+ where g a b = safe (f a b)
1037{-# INLINE scanr #-}
975{-# INLINE scanr #-}
1038
976
1039-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting
977-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting
1040-- value argument. Subject to fusion. Performs replacement on
978-- value argument. Subject to fusion. Performs replacement on
1041-- invalid scalar values.
979-- invalid scalar values.
1042scanr1 :: (Char -> Char -> Char) -> Text -> Text
980scanr1 :: (Char -> Char -> Char) -> Text -> Text
1043−scanr1 = coerce JSS.scanr1
1044−-- scanr1 f t | null t = empty
981+scanr1 f t | null t = empty
1045−-- | otherwise = scanr f (last t) (init t)
982+ | otherwise = scanr f (last t) (init t)
1046{-# INLINE scanr1 #-}
983{-# INLINE scanr1 #-}
1047
984
1048-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
985-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
@@ -1050,11 +987,8 @@ scanr1 = coerce JSS.scanr1
1050-- parameter from left to right, and returns a final 'Text'. Performs
987-- parameter from left to right, and returns a final 'Text'. Performs
1051-- replacement on invalid scalar values.
988-- replacement on invalid scalar values.
1052mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
989mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
1053−mapAccumL f z0 (Text a) =
1054− let (a', t) = JSS.mapAccumL f z0 a
1055− in (a', Text t)
1056−-- mapAccumL f z0 = S.mapAccumL g z0 . stream
990+mapAccumL f z0 = S.mapAccumL g z0 . stream
1057−-- where g a b = second safe (f a b)
991+ where g a b = second safe (f a b)
1058{-# INLINE mapAccumL #-}
992{-# INLINE mapAccumL #-}
1059
993
1060-- | The 'mapAccumR' function behaves like a combination of 'map' and
994-- | The 'mapAccumR' function behaves like a combination of 'map' and
@@ -1064,11 +998,8 @@ mapAccumL f z0 (Text a) =
1064-- 'Text'.
998-- 'Text'.
1065-- Performs replacement on invalid scalar values.
999-- Performs replacement on invalid scalar values.
1066mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
1000mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
1067−mapAccumR f z0 (Text a) =
1068− let (a', t) = JSS.mapAccumR f z0 a
1069− in (a', Text t)
1070−-- mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream
1001+mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream
1071−-- where g a b = second safe (f a b)
1002+ where g a b = second safe (f a b)
1072{-# INLINE mapAccumR #-}
1003{-# INLINE mapAccumR #-}
1073
1004
1074-- -----------------------------------------------------------------------------
1005-- -----------------------------------------------------------------------------
@@ -1077,33 +1008,32 @@ mapAccumR f z0 (Text a) =
1077-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
1008-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
1078-- @t@ repeated @n@ times.
1009-- @t@ repeated @n@ times.
1079replicate :: Int -> Text -> Text
1010replicate :: Int -> Text -> Text
1080−replicate = coerce JSS.replicate
1081−-- replicate n t@(Text a o l)
1011+replicate n t@(Text a o l)
1082−-- | n <= 0 || l <= 0 = empty
1012+ | n <= 0 || l <= 0 = empty
1083−-- | n == 1 = t
1013+ | n == 1 = t
1084−-- | isSingleton t = replicateChar n (unsafeHead t)
1014+ | isSingleton t = replicateChar n (unsafeHead t)
1085−-- | otherwise = Text (A.run x) 0 len
1015+ | otherwise = Text (A.run x) 0 len
1086−-- where
1016+ where
1087−-- len = l `mul` n
1017+ len = l `mul` n
1088−-- x :: ST s (A.MArray s)
1018+ x :: ST s (A.MArray s)
1089−-- x = do
1019+ x = do
1090−-- arr <- A.new len
1020+ arr <- A.new len
1091−-- let loop !d !i | i >= n = return arr
1021+ let loop !d !i | i >= n = return arr
1092−-- | otherwise = let m = d + l
1022+ | otherwise = let m = d + l
1093−-- in A.copyI arr d a o m >> loop m (i+1)
1023+ in A.copyI arr d a o m >> loop m (i+1)
1094−-- loop 0 0
1024+ loop 0 0
1095{-# INLINE [1] replicate #-}
1025{-# INLINE [1] replicate #-}
1096
1026
1097−-- {-# RULES
1027+{-# RULES
1098−-- "TEXT replicate/singleton -> replicateChar" [~1] forall n c.
1028+"TEXT replicate/singleton -> replicateChar" [~1] forall n c.
1099−-- replicate n (singleton c) = replicateChar n c
1029+ replicate n (singleton c) = replicateChar n c
1100−-- #-}
1030+ #-}
1101
1031
1102-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
1032-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
1103-- value of every element. Subject to fusion.
1033-- value of every element. Subject to fusion.
1104−-- replicateChar :: Int -> Char -> Text
1034+replicateChar :: Int -> Char -> Text
1105−-- replicateChar n c = unstream (S.replicateCharI n (safe c))
1035+replicateChar n c = unstream (S.replicateCharI n (safe c))
1106−-- {-# INLINE replicateChar #-}
1036+{-# INLINE replicateChar #-}
1107
1037
1108-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'
1038-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'
1109-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a
1039-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a
@@ -1113,8 +1043,7 @@ replicate = coerce JSS.replicate
1113-- string, and @b@ is the seed value for further production. Subject
1043-- string, and @b@ is the seed value for further production. Subject
1114-- to fusion. Performs replacement on invalid scalar values.
1044-- to fusion. Performs replacement on invalid scalar values.
1115unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
1045unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
1116−unfoldr f a = Text $ JSS.unfoldr f a
1117−-- unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
1046+unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
1118{-# INLINE unfoldr #-}
1047{-# INLINE unfoldr #-}
1119
1048
1120-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed
1049-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed
@@ -1124,8 +1053,7 @@ unfoldr f a = Text $ JSS.unfoldr f a
1124-- correct, otherwise its performance is similar to 'unfoldr'. Subject
1053-- correct, otherwise its performance is similar to 'unfoldr'. Subject
1125-- to fusion. Performs replacement on invalid scalar values.
1054-- to fusion. Performs replacement on invalid scalar values.
1126unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text
1055unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text
1127−unfoldrN n f a0 = Text $ JSS.unfoldrN n f a0
1128−-- 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)
1129{-# INLINE unfoldrN #-}
1057{-# INLINE unfoldrN #-}
1130
1058
1131-- -----------------------------------------------------------------------------
1059-- -----------------------------------------------------------------------------
@@ -1135,26 +1063,25 @@ unfoldrN n f a0 = Text $ JSS.unfoldrN n f a0
1135-- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than
1063-- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than
1136-- the length of the Text. Subject to fusion.
1064-- the length of the Text. Subject to fusion.
1137take :: Int -> Text -> Text
1065take :: Int -> Text -> Text
1138−take = coerce JSS.take
1139−-- take n t@(Text arr off len)
1066+take n t@(Text arr off len)
1140−-- | n <= 0 = empty
1067+ | n <= 0 = empty
1141−-- | n >= len = t
1068+ | n >= len = t
1142−-- | otherwise = text arr off (iterN n t)
1069+ | otherwise = text arr off (iterN n t)
1143{-# INLINE [1] take #-}
1070{-# INLINE [1] take #-}
1144
1071
1145−-- iterN :: Int -> Text -> Int
1072+iterN :: Int -> Text -> Int
1146−-- iterN n t@(Text _arr _off len) = loop 0 0
1073+iterN n t@(Text _arr _off len) = loop 0 0
1147−-- where loop !i !cnt
1074+ where loop !i !cnt
1148−-- | i >= len || cnt >= n = i
1075+ | i >= len || cnt >= n = i
1149−-- | otherwise = loop (i+d) (cnt+1)
1076+ | otherwise = loop (i+d) (cnt+1)
1150−-- where d = iter_ t i
1077+ where d = iter_ t i
1151
1078
1152−-- {-# RULES
1079+{-# RULES
1153−-- "TEXT take -> fused" [~1] forall n t.
1080+"TEXT take -> fused" [~1] forall n t.
1154−-- take n t = unstream (S.take n (stream t))
1081+ take n t = unstream (S.take n (stream t))
1155−-- "TEXT take -> unfused" [1] forall n t.
1082+"TEXT take -> unfused" [1] forall n t.
1156−-- unstream (S.take n (stream t)) = take n t
1083+ unstream (S.take n (stream t)) = take n t
1157−-- #-}
1084+ #-}
1158
1085
1159-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after
1086-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after
1160-- taking @n@ characters from the end of @t@.
1087-- taking @n@ characters from the end of @t@.
@@ -1163,39 +1090,37 @@ take = coerce JSS.take
1163--
1090--
1164-- > takeEnd 3 "foobar" == "bar"
1091-- > takeEnd 3 "foobar" == "bar"
1165takeEnd :: Int -> Text -> Text
1092takeEnd :: Int -> Text -> Text
1166−takeEnd = coerce JSS.takeEnd
1167−-- takeEnd n t@(Text arr off len)
1093+takeEnd n t@(Text arr off len)
1168−-- | n <= 0 = empty
1094+ | n <= 0 = empty
1169−-- | n >= len = t
1095+ | n >= len = t
1170−-- | otherwise = text arr (off+i) (len-i)
1096+ | otherwise = text arr (off+i) (len-i)
1171−-- where i = iterNEnd n t
1097+ where i = iterNEnd n t
1172−
1098+
1173−-- iterNEnd :: Int -> Text -> Int
1099+iterNEnd :: Int -> Text -> Int
1174−-- iterNEnd n t@(Text _arr _off len) = loop (len-1) n
1100+iterNEnd n t@(Text _arr _off len) = loop (len-1) n
1175−-- where loop i !m
1101+ where loop i !m
1176−-- | i <= 0 = 0
1102+ | i <= 0 = 0
1177−-- | m <= 1 = i
1103+ | m <= 1 = i
1178−-- | otherwise = loop (i+d) (m-1)
1104+ | otherwise = loop (i+d) (m-1)
1179−-- where d = reverseIter_ t i
1105+ where d = reverseIter_ t i
1180
1106
1181-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1107-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1182-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1108-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1183-- is greater than the length of the 'Text'. Subject to fusion.
1109-- is greater than the length of the 'Text'. Subject to fusion.
1184drop :: Int -> Text -> Text
1110drop :: Int -> Text -> Text
1185−drop = coerce JSS.drop
1186−-- drop n t@(Text arr off len)
1111+drop n t@(Text arr off len)
1187−-- | n <= 0 = t
1112+ | n <= 0 = t
1188−-- | n >= len = empty
1113+ | n >= len = empty
1189−-- | otherwise = text arr (off+i) (len-i)
1114+ | otherwise = text arr (off+i) (len-i)
1190−-- where i = iterN n t
1115+ where i = iterN n t
1191{-# INLINE [1] drop #-}
1116{-# INLINE [1] drop #-}
1192
1117
1193−-- {-# RULES
1118+{-# RULES
1194−-- "TEXT drop -> fused" [~1] forall n t.
1119+"TEXT drop -> fused" [~1] forall n t.
1195−-- drop n t = unstream (S.drop n (stream t))
1120+ drop n t = unstream (S.drop n (stream t))
1196−-- "TEXT drop -> unfused" [1] forall n t.
1121+"TEXT drop -> unfused" [1] forall n t.
1197−-- unstream (S.drop n (stream t)) = drop n t
1122+ unstream (S.drop n (stream t)) = drop n t
1198−-- #-}
1123+ #-}
1199
1124
1200-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after
1125-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after
1201-- dropping @n@ characters from the end of @t@.
1126-- dropping @n@ characters from the end of @t@.
@@ -1204,30 +1129,28 @@ drop = coerce JSS.drop
1204--
1129--
1205-- > dropEnd 3 "foobar" == "foo"
1130-- > dropEnd 3 "foobar" == "foo"
1206dropEnd :: Int -> Text -> Text
1131dropEnd :: Int -> Text -> Text
1207−dropEnd = coerce JSS.dropEnd
1208−-- dropEnd n t@(Text arr off len)
1132+dropEnd n t@(Text arr off len)
1209−-- | n <= 0 = t
1133+ | n <= 0 = t
1210−-- | n >= len = empty
1134+ | n >= len = empty
1211−-- | otherwise = text arr off (iterNEnd n t)
1135+ | otherwise = text arr off (iterNEnd n t)
1212
1136
1213-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1137-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1214-- returns the longest prefix (possibly empty) of elements that
1138-- returns the longest prefix (possibly empty) of elements that
1215-- satisfy @p@. Subject to fusion.
1139-- satisfy @p@. Subject to fusion.
1216takeWhile :: (Char -> Bool) -> Text -> Text
1140takeWhile :: (Char -> Bool) -> Text -> Text
1217−takeWhile = coerce JSS.takeWhile
1218−-- takeWhile p t@(Text arr off len) = loop 0
1141+takeWhile p t@(Text arr off len) = loop 0
1219−-- where loop !i | i >= len = t
1142+ where loop !i | i >= len = t
1220−-- | p c = loop (i+d)
1143+ | p c = loop (i+d)
1221−-- | otherwise = text arr off i
1144+ | otherwise = text arr off i
1222−-- where Iter c d = iter t i
1145+ where Iter c d = iter t i
1223{-# INLINE [1] takeWhile #-}
1146{-# INLINE [1] takeWhile #-}
1224
1147
1225−-- {-# RULES
1148+{-# RULES
1226−-- "TEXT takeWhile -> fused" [~1] forall p t.
1149+"TEXT takeWhile -> fused" [~1] forall p t.
1227−-- takeWhile p t = unstream (S.takeWhile p (stream t))
1150+ takeWhile p t = unstream (S.takeWhile p (stream t))
1228−-- "TEXT takeWhile -> unfused" [1] forall p t.
1151+"TEXT takeWhile -> unfused" [1] forall p t.
1229−-- unstream (S.takeWhile p (stream t)) = takeWhile p t
1152+ unstream (S.takeWhile p (stream t)) = takeWhile p t
1230−-- #-}
1153+ #-}
1231
1154
1232-- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',
1155-- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',
1233-- returns the longest suffix (possibly empty) of elements that
1156-- returns the longest suffix (possibly empty) of elements that
@@ -1236,39 +1159,36 @@ takeWhile = coerce JSS.takeWhile
1236--
1159--
1237-- > takeWhileEnd (=='o') "foo" == "oo"
1160-- > takeWhileEnd (=='o') "foo" == "oo"
1238takeWhileEnd :: (Char -> Bool) -> Text -> Text
1161takeWhileEnd :: (Char -> Bool) -> Text -> Text
1239−takeWhileEnd = P.undefined -- TODO
1240−-- takeWhileEnd :: (Char -> Bool) -> Text -> Text
1241−-- takeWhileEnd p t@(Text arr off len) = loop (len-1) len
1162+takeWhileEnd p t@(Text arr off len) = loop (len-1) len
1242−-- where loop !i !l | l <= 0 = t
1163+ where loop !i !l | l <= 0 = t
1243−-- | p c = loop (i+d) (l+d)
1164+ | p c = loop (i+d) (l+d)
1244−-- | otherwise = text arr (off+l) (len-l)
1165+ | otherwise = text arr (off+l) (len-l)
1245−-- where (c,d) = reverseIter t i
1166+ where (c,d) = reverseIter t i
1246{-# INLINE [1] takeWhileEnd #-}
1167{-# INLINE [1] takeWhileEnd #-}
1247
1168
1248−-- {-# RULES
1169+{-# RULES
1249−-- "TEXT takeWhileEnd -> fused" [~1] forall p t.
1170+"TEXT takeWhileEnd -> fused" [~1] forall p t.
1250−-- takeWhileEnd p t = S.reverse (S.takeWhile p (S.reverseStream t))
1171+ takeWhileEnd p t = S.reverse (S.takeWhile p (S.reverseStream t))
1251−-- "TEXT takeWhileEnd -> unfused" [1] forall p t.
1172+"TEXT takeWhileEnd -> unfused" [1] forall p t.
1252−-- S.reverse (S.takeWhile p (S.reverseStream t)) = takeWhileEnd p t
1173+ S.reverse (S.takeWhile p (S.reverseStream t)) = takeWhileEnd p t
1253−-- #-}
1174+ #-}
1254
1175
1255-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1176-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1256-- 'takeWhile' @p@ @t@. Subject to fusion.
1177-- 'takeWhile' @p@ @t@. Subject to fusion.
1257dropWhile :: (Char -> Bool) -> Text -> Text
1178dropWhile :: (Char -> Bool) -> Text -> Text
1258−dropWhile = coerce JSS.dropWhile
1259−-- dropWhile p t@(Text arr off len) = loop 0 0
1179+dropWhile p t@(Text arr off len) = loop 0 0
1260−-- where loop !i !l | l >= len = empty
1180+ where loop !i !l | l >= len = empty
1261−-- | p c = loop (i+d) (l+d)
1181+ | p c = loop (i+d) (l+d)
1262−-- | otherwise = Text arr (off+i) (len-l)
1182+ | otherwise = Text arr (off+i) (len-l)
1263−
1183+ where Iter c d = iter t i
1264{-# INLINE [1] dropWhile #-}
1184{-# INLINE [1] dropWhile #-}
1265
1185
1266−-- {-# RULES
1186+{-# RULES
1267−-- "TEXT dropWhile -> fused" [~1] forall p t.
1187+"TEXT dropWhile -> fused" [~1] forall p t.
1268−-- dropWhile p t = unstream (S.dropWhile p (stream t))
1188+ dropWhile p t = unstream (S.dropWhile p (stream t))
1269−-- "TEXT dropWhile -> unfused" [1] forall p t.
1189+"TEXT dropWhile -> unfused" [1] forall p t.
1270−-- unstream (S.dropWhile p (stream t)) = dropWhile p t
1190+ unstream (S.dropWhile p (stream t)) = dropWhile p t
1271−-- #-}
1191+ #-}
1272
1192
1273-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1193-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1274-- dropping characters that satisfy the predicate @p@ from the end of
1194-- dropping characters that satisfy the predicate @p@ from the end of
@@ -1278,20 +1198,19 @@ dropWhile = coerce JSS.dropWhile
1278--
1198--
1279-- > dropWhileEnd (=='.') "foo..." == "foo"
1199-- > dropWhileEnd (=='.') "foo..." == "foo"
1280dropWhileEnd :: (Char -> Bool) -> Text -> Text
1200dropWhileEnd :: (Char -> Bool) -> Text -> Text
1281−dropWhileEnd = coerce JSS.dropWhileEnd
1282−-- dropWhileEnd p t@(Text arr off len) = loop (len-1) len
1201+dropWhileEnd p t@(Text arr off len) = loop (len-1) len
1283−-- where loop !i !l | l <= 0 = empty
1202+ where loop !i !l | l <= 0 = empty
1284−-- | p c = loop (i+d) (l+d)
1203+ | p c = loop (i+d) (l+d)
1285−-- | otherwise = Text arr off l
1204+ | otherwise = Text arr off l
1286−-- where (c,d) = reverseIter t i
1205+ where (c,d) = reverseIter t i
1287{-# INLINE [1] dropWhileEnd #-}
1206{-# INLINE [1] dropWhileEnd #-}
1288
1207
1289−-- {-# RULES
1208+{-# RULES
1290−-- "TEXT dropWhileEnd -> fused" [~1] forall p t.
1209+"TEXT dropWhileEnd -> fused" [~1] forall p t.
1291−-- dropWhileEnd p t = S.reverse (S.dropWhile p (S.reverseStream t))
1210+ dropWhileEnd p t = S.reverse (S.dropWhile p (S.reverseStream t))
1292−-- "TEXT dropWhileEnd -> unfused" [1] forall p t.
1211+"TEXT dropWhileEnd -> unfused" [1] forall p t.
1293−-- S.reverse (S.dropWhile p (S.reverseStream t)) = dropWhileEnd p t
1212+ S.reverse (S.dropWhile p (S.reverseStream t)) = dropWhileEnd p t
1294−-- #-}
1213+ #-}
1295
1214
1296-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1215-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1297-- dropping characters that satisfy the predicate @p@ from both the
1216-- dropping characters that satisfy the predicate @p@ from both the
@@ -1326,49 +1245,45 @@ strip = dropAround isSpace
1326-- prefix of @t@ of length @n@, and whose second is the remainder of
1245-- prefix of @t@ of length @n@, and whose second is the remainder of
1327-- the string. It is equivalent to @('take' n t, 'drop' n t)@.
1246-- the string. It is equivalent to @('take' n t, 'drop' n t)@.
1328splitAt :: Int -> Text -> (Text, Text)
1247splitAt :: Int -> Text -> (Text, Text)
1329−splitAt = coerce JSS.splitAt
1330−-- splitAt n t@(Text arr off len)
1248+splitAt n t@(Text arr off len)
1331−-- | n <= 0 = (empty, t)
1249+ | n <= 0 = (empty, t)
1332−-- | n >= len = (t, empty)
1250+ | n >= len = (t, empty)
1333−-- | otherwise = let k = iterN n t
1251+ | otherwise = let k = iterN n t
1334−-- in (text arr off k, text arr (off+k) (len-k))
1252+ in (text arr off k, text arr (off+k) (len-k))
1335
1253
1336-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
1254-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
1337-- a pair whose first element is the longest prefix (possibly empty)
1255-- a pair whose first element is the longest prefix (possibly empty)
1338-- of @t@ of elements that satisfy @p@, and whose second is the
1256-- of @t@ of elements that satisfy @p@, and whose second is the
1339-- remainder of the list.
1257-- remainder of the list.
1340span :: (Char -> Bool) -> Text -> (Text, Text)
1258span :: (Char -> Bool) -> Text -> (Text, Text)
1341−span = coerce JSS.span
1342−-- span p t = case span_ p t of
1259+span p t = case span_ p t of
1343−-- (# hd,tl #) -> (hd,tl)
1260+ (# hd,tl #) -> (hd,tl)
1344{-# INLINE span #-}
1261{-# INLINE span #-}
1345
1262
1346-- | /O(n)/ 'break' is like 'span', but the prefix returned is
1263-- | /O(n)/ 'break' is like 'span', but the prefix returned is
1347-- over elements that fail the predicate @p@.
1264-- over elements that fail the predicate @p@.
1348break :: (Char -> Bool) -> Text -> (Text, Text)
1265break :: (Char -> Bool) -> Text -> (Text, Text)
1349−break = coerce JSS.break
1350−-- break p = span (not . p)
1266+break p = span (not . p)
1351{-# INLINE break #-}
1267{-# INLINE break #-}
1352
1268
1353-- | /O(n)/ Group characters in a string according to a predicate.
1269-- | /O(n)/ Group characters in a string according to a predicate.
1354groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
1270groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
1355−groupBy = coerce JSS.groupBy
1356−-- groupBy p = loop
1271+groupBy p = loop
1357−-- where
1272+ where
1358−-- loop t@(Text arr off len)
1273+ loop t@(Text arr off len)
1359−-- | null t = []
1274+ | null t = []
1360−-- | otherwise = text arr off n : loop (text arr (off+n) (len-n))
1275+ | otherwise = text arr off n : loop (text arr (off+n) (len-n))
1361−-- where Iter c d = iter t 0
1276+ where Iter c d = iter t 0
1362−-- n = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))
1277+ n = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))
1363
1278
1364-- | Returns the /array/ index (in units of 'Word16') at which a
1279-- | Returns the /array/ index (in units of 'Word16') at which a
1365-- character may be found. This is /not/ the same as the logical
1280-- character may be found. This is /not/ the same as the logical
1366-- index returned by e.g. 'findIndex'.
1281-- index returned by e.g. 'findIndex'.
1367−-- findAIndexOrEnd :: (Char -> Bool) -> Text -> Int
1282+findAIndexOrEnd :: (Char -> Bool) -> Text -> Int
1368−-- findAIndexOrEnd q t@(Text _arr _off len) = go 0
1283+findAIndexOrEnd q t@(Text _arr _off len) = go 0
1369−-- where go !i | i >= len || q c = i
1284+ where go !i | i >= len || q c = i
1370−-- | otherwise = go (i+d)
1285+ | otherwise = go (i+d)
1371−-- where Iter c d = iter t i
1286+ where Iter c d = iter t i
1372
1287
1373-- | /O(n)/ Group characters in a string by equality.
1288-- | /O(n)/ Group characters in a string by equality.
1374group :: Text -> [Text]
1289group :: Text -> [Text]
@@ -1377,17 +1292,15 @@ group = groupBy (==)
1377-- | /O(n)/ Return all initial segments of the given 'Text', shortest
1292-- | /O(n)/ Return all initial segments of the given 'Text', shortest
1378-- first.
1293-- first.
1379inits :: Text -> [Text]
1294inits :: Text -> [Text]
1380−inits = coerce JSS.inits
1381−-- inits t@(Text arr off len) = loop 0
1295+inits t@(Text arr off len) = loop 0
1382−-- where loop i | i >= len = [t]
1296+ where loop i | i >= len = [t]
1383−-- | otherwise = Text arr off i : loop (i + iter_ t i)
1297+ | otherwise = Text arr off i : loop (i + iter_ t i)
1384
1298
1385-- | /O(n)/ Return all final segments of the given 'Text', longest
1299-- | /O(n)/ Return all final segments of the given 'Text', longest
1386-- first.
1300-- first.
1387tails :: Text -> [Text]
1301tails :: Text -> [Text]
1388−tails = coerce JSS.tails
1389−-- tails t | null t = [empty]
1302+tails t | null t = [empty]
1390−-- | otherwise = t : tails (unsafeTail t)
1303+ | otherwise = t : tails (unsafeTail t)
1391
1304
1392-- $split
1305-- $split
1393--
1306--
@@ -1420,20 +1333,19 @@ splitOn :: Text
1420 -> Text
1333 -> Text
1421 -- ^ Input text.
1334 -- ^ Input text.
1422 -> [Text]
1335 -> [Text]
1423−splitOn = coerce JSS.splitOn
1424−-- splitOn pat@(Text _ _ l) src@(Text arr off len)
1336+splitOn pat@(Text _ _ l) src@(Text arr off len)
1425−-- | l <= 0 = emptyError "splitOn"
1337+ | l <= 0 = emptyError "splitOn"
1426−-- | isSingleton pat = split (== unsafeHead pat) src
1338+ | isSingleton pat = split (== unsafeHead pat) src
1427−-- | otherwise = go 0 (indices pat src)
1339+ | otherwise = go 0 (indices pat src)
1428−-- where
1340+ where
1429−-- go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs
1341+ go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs
1430−-- go s _ = [text arr (s+off) (len-s)]
1342+ go s _ = [text arr (s+off) (len-s)]
1431{-# INLINE [1] splitOn #-}
1343{-# INLINE [1] splitOn #-}
1432
1344
1433−-- {-# RULES
1345+{-# RULES
1434−-- "TEXT splitOn/singleton -> split/==" [~1] forall c t.
1346+"TEXT splitOn/singleton -> split/==" [~1] forall c t.
1435−-- splitOn (singleton c) t = split (==c) t
1347+ splitOn (singleton c) t = split (==c) t
1436−-- #-}
1348+ #-}
1437
1349
1438-- | /O(n)/ Splits a 'Text' into components delimited by separators,
1350-- | /O(n)/ Splits a 'Text' into components delimited by separators,
1439-- where the predicate returns True for a separator element. The
1351-- where the predicate returns True for a separator element. The
@@ -1443,12 +1355,11 @@ splitOn = coerce JSS.splitOn
1443-- > split (=='a') "aabbaca" == ["","","bb","c",""]
1355-- > split (=='a') "aabbaca" == ["","","bb","c",""]
1444-- > split (=='a') "" == [""]
1356-- > split (=='a') "" == [""]
1445split :: (Char -> Bool) -> Text -> [Text]
1357split :: (Char -> Bool) -> Text -> [Text]
1446−split = coerce JSS.split
1447−-- split _ t@(Text _off _arr 0) = [t]
1358+split _ t@(Text _off _arr 0) = [t]
1448−-- split p t = loop t
1359+split p t = loop t
1449−-- where loop s | null s' = [l]
1360+ where loop s | null s' = [l]
1450−-- | otherwise = l : loop (unsafeTail s')
1361+ | otherwise = l : loop (unsafeTail s')
1451−-- where (# l, s' #) = span_ (not . p) s
1362+ where (# l, s' #) = span_ (not . p) s
1452{-# INLINE split #-}
1363{-# INLINE split #-}
1453
1364
1454-- | /O(n)/ Splits a 'Text' into components of length @k@. The last
1365-- | /O(n)/ Splits a 'Text' into components of length @k@. The last
@@ -1458,12 +1369,11 @@ split = coerce JSS.split
1458-- > chunksOf 3 "foobarbaz" == ["foo","bar","baz"]
1369-- > chunksOf 3 "foobarbaz" == ["foo","bar","baz"]
1459-- > chunksOf 4 "haskell.org" == ["hask","ell.","org"]
1370-- > chunksOf 4 "haskell.org" == ["hask","ell.","org"]
1460chunksOf :: Int -> Text -> [Text]
1371chunksOf :: Int -> Text -> [Text]
1461−chunksOf = coerce JSS.chunksOf
1372+chunksOf k = go
1462−-- chunksOf k = go
1463−-- where
1373+ where
1464−-- go t = case splitAt k t of
1374+ go t = case splitAt k t of
1465−-- (a,b) | null a -> []
1375+ (a,b) | null a -> []
1466−-- | otherwise -> a : go b
1376+ | otherwise -> a : go b
1467{-# INLINE chunksOf #-}
1377{-# INLINE chunksOf #-}
1468
1378
1469-- ----------------------------------------------------------------------------
1379-- ----------------------------------------------------------------------------
@@ -1476,8 +1386,7 @@ chunksOf = coerce JSS.chunksOf
1476-- returns the first element matching the predicate, or 'Nothing' if
1386-- returns the first element matching the predicate, or 'Nothing' if
1477-- there is no such element.
1387-- there is no such element.
1478find :: (Char -> Bool) -> Text -> Maybe Char
1388find :: (Char -> Bool) -> Text -> Maybe Char
1479−find = coerce JSS.find
1480−-- find p t = S.findBy p (stream t)
1389+find p t = S.findBy p (stream t)
1481{-# INLINE find #-}
1390{-# INLINE find #-}
1482
1391
1483-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',
1392-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',
@@ -1486,16 +1395,14 @@ find = coerce JSS.find
1486--
1395--
1487-- > partition p t == (filter p t, filter (not . p) t)
1396-- > partition p t == (filter p t, filter (not . p) t)
1488partition :: (Char -> Bool) -> Text -> (Text, Text)
1397partition :: (Char -> Bool) -> Text -> (Text, Text)
1489−partition = coerce JSS.partition
1490−-- partition p t = (filter p t, filter (not . p) t)
1398+partition p t = (filter p t, filter (not . p) t)
1491{-# INLINE partition #-}
1399{-# INLINE partition #-}
1492
1400
1493-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
1401-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
1494-- returns a 'Text' containing those characters that satisfy the
1402-- returns a 'Text' containing those characters that satisfy the
1495-- predicate.
1403-- predicate.
1496filter :: (Char -> Bool) -> Text -> Text
1404filter :: (Char -> Bool) -> Text -> Text
1497−filter = coerce JSS.filter
1498−-- filter p t = unstream (S.filter p (stream t))
1405+filter p t = unstream (S.filter p (stream t))
1499{-# INLINE filter #-}
1406{-# INLINE filter #-}
1500
1407
1501-- | /O(n+m)/ Find the first instance of @needle@ (which must be
1408-- | /O(n+m)/ Find the first instance of @needle@ (which must be
@@ -1520,12 +1427,11 @@ filter = coerce JSS.filter
1520-- In (unlikely) bad cases, this function's time complexity degrades
1427-- In (unlikely) bad cases, this function's time complexity degrades
1521-- towards /O(n*m)/.
1428-- towards /O(n*m)/.
1522breakOn :: Text -> Text -> (Text, Text)
1429breakOn :: Text -> Text -> (Text, Text)
1523−breakOn = coerce JSS.breakOn
1524−-- breakOn pat src@(Text arr off len)
1430+breakOn pat src@(Text arr off len)
1525−-- | null pat = emptyError "breakOn"
1431+ | null pat = emptyError "breakOn"
1526−-- | otherwise = case indices pat src of
1432+ | otherwise = case indices pat src of
1527−-- [] -> (src, empty)
1433+ [] -> (src, empty)
1528−-- (x:_) -> (text arr off x, text arr (off+x) (len-x))
1434+ (x:_) -> (text arr off x, text arr (off+x) (len-x))
1529{-# INLINE breakOn #-}
1435{-# INLINE breakOn #-}
1530
1436
1531-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
1437-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
@@ -1537,9 +1443,8 @@ breakOn = coerce JSS.breakOn
1537--
1443--
1538-- > breakOnEnd "::" "a::b::c" ==> ("a::b::", "c")
1444-- > breakOnEnd "::" "a::b::c" ==> ("a::b::", "c")
1539breakOnEnd :: Text -> Text -> (Text, Text)
1445breakOnEnd :: Text -> Text -> (Text, Text)
1540−breakOnEnd = coerce JSS.breakOnEnd
1541−-- breakOnEnd pat src = (reverse b, reverse a)
1446+breakOnEnd pat src = (reverse b, reverse a)
1542−-- where (a,b) = breakOn (reverse pat) (reverse src)
1447+ where (a,b) = breakOn (reverse pat) (reverse src)
1543{-# INLINE breakOnEnd #-}
1448{-# INLINE breakOnEnd #-}
1544
1449
1545-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in
1450-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in
@@ -1563,13 +1468,12 @@ breakOnEnd = coerce JSS.breakOnEnd
1563breakOnAll :: Text -- ^ @needle@ to search for
1468breakOnAll :: Text -- ^ @needle@ to search for
1564 -> Text -- ^ @haystack@ in which to search
1469 -> Text -- ^ @haystack@ in which to search
1565 -> [(Text, Text)]
1470 -> [(Text, Text)]
1566−breakOnAll = coerce JSS.breakOnAll
1567−-- breakOnAll pat src@(Text arr off slen)
1471+breakOnAll pat src@(Text arr off slen)
1568−-- | null pat = emptyError "breakOnAll"
1472+ | null pat = emptyError "breakOnAll"
1569−-- | otherwise = L.map step (indices pat src)
1473+ | otherwise = L.map step (indices pat src)
1570−-- where
1474+ where
1571−-- step x = (chunk 0 x, chunk x (slen-x))
1475+ step x = (chunk 0 x, chunk x (slen-x))
1572−-- chunk !n !l = text arr (n+off) l
1476+ chunk !n !l = text arr (n+off) l
1573{-# INLINE breakOnAll #-}
1477{-# INLINE breakOnAll #-}
1574
1478
1575-------------------------------------------------------------------------------
1479-------------------------------------------------------------------------------
@@ -1593,16 +1497,14 @@ breakOnAll = coerce JSS.breakOnAll
1593
1497
1594-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.
1498-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.
1595index :: Text -> Int -> Char
1499index :: Text -> Int -> Char
1596−index = coerce JSS.index
1597−-- index t n = S.index (stream t) n
1500+index t n = S.index (stream t) n
1598{-# INLINE index #-}
1501{-# INLINE index #-}
1599
1502
1600-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'
1503-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'
1601-- and returns the index of the first element in the 'Text' satisfying
1504-- and returns the index of the first element in the 'Text' satisfying
1602-- the predicate. Subject to fusion.
1505-- the predicate. Subject to fusion.
1603findIndex :: (Char -> Bool) -> Text -> Maybe Int
1506findIndex :: (Char -> Bool) -> Text -> Maybe Int
1604−findIndex = coerce JSS.findIndex
1605−-- findIndex p t = S.findIndex p (stream t)
1507+findIndex p t = S.findIndex p (stream t)
1606{-# INLINE findIndex #-}
1508{-# INLINE findIndex #-}
1607
1509
1608-- | /O(n+m)/ The 'count' function returns the number of times the
1510-- | /O(n+m)/ The 'count' function returns the number of times the
@@ -1612,23 +1514,22 @@ findIndex = coerce JSS.findIndex
1612-- In (unlikely) bad cases, this function's time complexity degrades
1514-- In (unlikely) bad cases, this function's time complexity degrades
1613-- towards /O(n*m)/.
1515-- towards /O(n*m)/.
1614count :: Text -> Text -> Int
1516count :: Text -> Text -> Int
1615−count = coerce JSS.count
1616−-- count pat src
1517+count pat src
1617−-- | null pat = emptyError "count"
1518+ | null pat = emptyError "count"
1618−-- | isSingleton pat = countChar (unsafeHead pat) src
1519+ | isSingleton pat = countChar (unsafeHead pat) src
1619−-- | otherwise = L.length (indices pat src)
1520+ | otherwise = L.length (indices pat src)
1620{-# INLINE [1] count #-}
1521{-# INLINE [1] count #-}
1621
1522
1622−-- {-# RULES
1523+{-# RULES
1623−-- "TEXT count/singleton -> countChar" [~1] forall c t.
1524+"TEXT count/singleton -> countChar" [~1] forall c t.
1624−-- count (singleton c) t = countChar c t
1525+ count (singleton c) t = countChar c t
1625−-- #-}
1526+ #-}
1626
1527
1627-- | /O(n)/ The 'countChar' function returns the number of times the
1528-- | /O(n)/ The 'countChar' function returns the number of times the
1628-- query element appears in the given 'Text'. Subject to fusion.
1529-- query element appears in the given 'Text'. Subject to fusion.
1629−-- countChar :: Char -> Text -> Int
1530+countChar :: Char -> Text -> Int
1630−-- countChar c t = S.countChar c (stream t)
1531+countChar c t = S.countChar c (stream t)
1631−-- {-# INLINE countChar #-}
1532+{-# INLINE countChar #-}
1632
1533
1633-------------------------------------------------------------------------------
1534-------------------------------------------------------------------------------
1634-- * Zipping
1535-- * Zipping
@@ -1638,46 +1539,42 @@ count = coerce JSS.count
1638-- excess elements of the longer 'Text' are discarded. This is
1539-- excess elements of the longer 'Text' are discarded. This is
1639-- equivalent to a pair of 'unpack' operations.
1540-- equivalent to a pair of 'unpack' operations.
1640zip :: Text -> Text -> [(Char,Char)]
1541zip :: Text -> Text -> [(Char,Char)]
1641−zip = coerce JSS.zip
1642−-- zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1542+zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1643{-# INLINE zip #-}
1543{-# INLINE zip #-}
1644
1544
1645-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1545-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1646-- given as the first argument, instead of a tupling function.
1546-- given as the first argument, instead of a tupling function.
1647-- Performs replacement on invalid scalar values.
1547-- Performs replacement on invalid scalar values.
1648zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1548zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1649−zipWith = coerce JSS.zipWith
1650−-- zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1549+zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1651−-- where g a b = safe (f a b)
1550+ where g a b = safe (f a b)
1652{-# INLINE zipWith #-}
1551{-# INLINE zipWith #-}
1653
1552
1654-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1553-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1655-- representing white space.
1554-- representing white space.
1656words :: Text -> [Text]
1555words :: Text -> [Text]
1657−words = coerce JSS.words
1658−-- words t@(Text arr off len) = loop 0 0
1556+words t@(Text arr off len) = loop 0 0
1659−-- where
1557+ where
1660−-- loop !start !n
1558+ loop !start !n
1661−-- | n >= len = if start == n
1559+ | n >= len = if start == n
1662−-- then []
1560+ then []
1663−-- else [Text arr (start+off) (n-start)]
1561+ else [Text arr (start+off) (n-start)]
1664−-- | isSpace c =
1562+ | isSpace c =
1665−-- if start == n
1563+ if start == n
1666−-- then loop (start+1) (start+1)
1564+ then loop (start+1) (start+1)
1667−-- else Text arr (start+off) (n-start) : loop (n+d) (n+d)
1565+ else Text arr (start+off) (n-start) : loop (n+d) (n+d)
1668−-- | otherwise = loop start (n+d)
1566+ | otherwise = loop start (n+d)
1669−-- where Iter c d = iter t n
1567+ where Iter c d = iter t n
1670{-# INLINE words #-}
1568{-# INLINE words #-}
1671
1569
1672-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at
1570-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at
1673-- newline 'Char's. The resulting strings do not contain newlines.
1571-- newline 'Char's. The resulting strings do not contain newlines.
1674lines :: Text -> [Text]
1572lines :: Text -> [Text]
1675−lines = coerce JSS.lines
1676−-- lines ps | null ps = []
1573+lines ps | null ps = []
1677−-- | otherwise = h : if null t
1574+ | otherwise = h : if null t
1678−-- then []
1575+ then []
1679−-- else lines (unsafeTail t)
1576+ else lines (unsafeTail t)
1680−-- where (# h,t #) = span_ (/= '\n') ps
1577+ where (# h,t #) = span_ (/= '\n') ps
1681{-# INLINE lines #-}
1578{-# INLINE lines #-}
1682
1579
1683{-
1580{-
@@ -1705,38 +1602,34 @@ lines' ps | null ps = []
1705-- | /O(n)/ Joins lines, after appending a terminating newline to
1602-- | /O(n)/ Joins lines, after appending a terminating newline to
1706-- each.
1603-- each.
1707unlines :: [Text] -> Text
1604unlines :: [Text] -> Text
1708−unlines = coerce JSS.unlines
1709−-- unlines = concat . L.map (`snoc` '\n')
1605+unlines = concat . L.map (`snoc` '\n')
1710{-# INLINE unlines #-}
1606{-# INLINE unlines #-}
1711
1607
1712-- | /O(n)/ Joins words using single space characters.
1608-- | /O(n)/ Joins words using single space characters.
1713unwords :: [Text] -> Text
1609unwords :: [Text] -> Text
1714−unwords = coerce JSS.unwords
1715−-- unwords = intercalate (singleton ' ')
1610+unwords = intercalate (singleton ' ')
1716{-# INLINE unwords #-}
1611{-# INLINE unwords #-}
1717
1612
1718-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns
1613-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns
1719-- 'True' iff the first is a prefix of the second. Subject to fusion.
1614-- 'True' iff the first is a prefix of the second. Subject to fusion.
1720isPrefixOf :: Text -> Text -> Bool
1615isPrefixOf :: Text -> Text -> Bool
1721−isPrefixOf = coerce JSS.isPrefixOf
1722−-- isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =
1616+isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =
1723−-- alen <= blen && S.isPrefixOf (stream a) (stream b)
1617+ alen <= blen && S.isPrefixOf (stream a) (stream b)
1724{-# INLINE [1] isPrefixOf #-}
1618{-# INLINE [1] isPrefixOf #-}
1725
1619
1726−-- {-# RULES
1620+{-# RULES
1727−-- "TEXT isPrefixOf -> fused" [~1] forall s t.
1621+"TEXT isPrefixOf -> fused" [~1] forall s t.
1728−-- isPrefixOf s t = S.isPrefixOf (stream s) (stream t)
1622+ isPrefixOf s t = S.isPrefixOf (stream s) (stream t)
1729−-- #-}
1623+ #-}
1730
1624
1731-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns
1625-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns
1732-- 'True' iff the first is a suffix of the second.
1626-- 'True' iff the first is a suffix of the second.
1733isSuffixOf :: Text -> Text -> Bool
1627isSuffixOf :: Text -> Text -> Bool
1734−isSuffixOf = coerce JSS.isSuffixOf
1735−-- isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =
1628+isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =
1736−-- d >= 0 && a == b'
1629+ d >= 0 && a == b'
1737−-- where d = blen - alen
1630+ where d = blen - alen
1738−-- b' | d == 0 = b
1631+ b' | d == 0 = b
1739−-- | otherwise = Text barr (boff+d) alen
1632+ | otherwise = Text barr (boff+d) alen
1740{-# INLINE isSuffixOf #-}
1633{-# INLINE isSuffixOf #-}
1741
1634
1742-- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns
1635-- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns
@@ -1746,17 +1639,16 @@ isSuffixOf = coerce JSS.isSuffixOf
1746-- In (unlikely) bad cases, this function's time complexity degrades
1639-- In (unlikely) bad cases, this function's time complexity degrades
1747-- towards /O(n*m)/.
1640-- towards /O(n*m)/.
1748isInfixOf :: Text -> Text -> Bool
1641isInfixOf :: Text -> Text -> Bool
1749−isInfixOf = coerce JSS.isInfixOf
1750−-- isInfixOf needle haystack
1642+isInfixOf needle haystack
1751−-- | null needle = True
1643+ | null needle = True
1752−-- | isSingleton needle = S.elem (unsafeHead needle) . S.stream $ haystack
1644+ | isSingleton needle = S.elem (unsafeHead needle) . S.stream $ haystack
1753−-- | otherwise = not . L.null . indices needle $ haystack
1645+ | otherwise = not . L.null . indices needle $ haystack
1754{-# INLINE [1] isInfixOf #-}
1646{-# INLINE [1] isInfixOf #-}
1755
1647
1756−-- {-# RULES
1648+{-# RULES
1757−-- "TEXT isInfixOf/singleton -> S.elem/S.stream" [~1] forall n h.
1649+"TEXT isInfixOf/singleton -> S.elem/S.stream" [~1] forall n h.
1758−-- isInfixOf (singleton n) h = S.elem n (S.stream h)
1650+ isInfixOf (singleton n) h = S.elem n (S.stream h)
1759−-- #-}
1651+ #-}
1760
1652
1761-------------------------------------------------------------------------------
1653-------------------------------------------------------------------------------
1762-- * View patterns
1654-- * View patterns
@@ -1780,10 +1672,9 @@ isInfixOf = coerce JSS.isInfixOf
1780-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf
1672-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf
1781-- > fnordLength _ = -1
1673-- > fnordLength _ = -1
1782stripPrefix :: Text -> Text -> Maybe Text
1674stripPrefix :: Text -> Text -> Maybe Text
1783−stripPrefix = coerce JSS.stripPrefix
1784−-- stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1675+stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1785−-- | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)
1676+ | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)
1786−-- | otherwise = Nothing
1677+ | otherwise = Nothing
1787
1678
1788-- | /O(n)/ Find the longest non-empty common prefix of two strings
1679-- | /O(n)/ Find the longest non-empty common prefix of two strings
1789-- and return it, along with the suffixes of each string at which they
1680-- and return it, along with the suffixes of each string at which they
@@ -1798,16 +1689,15 @@ stripPrefix = coerce JSS.stripPrefix
1798-- > commonPrefixes "veeble" "fetzer" == Nothing
1689-- > commonPrefixes "veeble" "fetzer" == Nothing
1799-- > commonPrefixes "" "baz" == Nothing
1690-- > commonPrefixes "" "baz" == Nothing
1800commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)
1691commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)
1801−commonPrefixes = coerce JSS.commonPrefixes
1802−-- commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1692+commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1803−-- where
1693+ where
1804−-- go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1694+ go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1805−-- | i > 0 = Just (Text arr0 off0 i,
1695+ | i > 0 = Just (Text arr0 off0 i,
1806−-- text arr0 (off0+i) (len0-i),
1696+ text arr0 (off0+i) (len0-i),
1807−-- text arr1 (off1+j) (len1-j))
1697+ text arr1 (off1+j) (len1-j))
1808−-- | otherwise = Nothing
1698+ | otherwise = Nothing
1809−-- where Iter a d0 = iter t0 i
1699+ where Iter a d0 = iter t0 i
1810−-- Iter b d1 = iter t1 j
1700+ Iter b d1 = iter t1 j
1811
1701
1812-- | /O(n)/ Return the prefix of the second string if its suffix
1702-- | /O(n)/ Return the prefix of the second string if its suffix
1813-- matches the entire first string.
1703-- matches the entire first string.
@@ -1828,22 +1718,21 @@ commonPrefixes = coerce JSS.commonPrefixes
1828-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre
1718-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre
1829-- > quuxLength _ = -1
1719-- > quuxLength _ = -1
1830stripSuffix :: Text -> Text -> Maybe Text
1720stripSuffix :: Text -> Text -> Maybe Text
1831−stripSuffix = coerce JSS.stripSuffix
1832−-- stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
1721+stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
1833−-- | p `isSuffixOf` t = Just $! text arr off (len-plen)
1722+ | p `isSuffixOf` t = Just $! text arr off (len-plen)
1834−-- | otherwise = Nothing
1723+ | otherwise = Nothing
1835−
1724+
1836−-- -- | Add a list of non-negative numbers. Errors out on overflow.
1725+-- | Add a list of non-negative numbers. Errors out on overflow.
1837−-- sumP :: String -> [Int] -> Int
1726+sumP :: String -> [Int] -> Int
1838−-- sumP fun = go 0
1727+sumP fun = go 0
1839−-- where go !a (x:xs)
1728+ where go !a (x:xs)
1840−-- | ax >= 0 = go ax xs
1729+ | ax >= 0 = go ax xs
1841−-- | otherwise = overflowError fun
1730+ | otherwise = overflowError fun
1842−-- where ax = a + x
1731+ where ax = a + x
1843−-- go a _ = a
1732+ go a _ = a
1844−
1733+
1845−-- emptyError :: String -> a
1734+emptyError :: String -> a
1846−-- emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"
1735+emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"
1847
1736
1848overflowError :: String -> a
1737overflowError :: String -> a
1849overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
1738overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
@@ -1857,10 +1746,10 @@ overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
1857-- copy \"breaks the link\" to the original array, allowing it to be
1746-- copy \"breaks the link\" to the original array, allowing it to be
1858-- garbage collected if there are no other live references to it.
1747-- garbage collected if there are no other live references to it.
1859copy :: Text -> Text
1748copy :: Text -> Text
1860−copy = P.id -- TODO
1861−-- copy (Text arr off len) = Text (A.run go) 0 len
1749+copy (Text arr off len) = Text (A.run go) 0 len
1862−-- where
1750+ where
1863−-- go :: ST s (A.MArray s)
1751+ go :: ST s (A.MArray s)
1864−-- go = do
1752+ go = do
1865−-- marr <- A.new len
1753+ marr <- A.new len
1866−
1754+ A.copyI marr 0 arr off len
1755+ return marr
Data/Text/Encoding.hs+64−105
@@ -3,7 +3,6 @@
3#if __GLASGOW_HASKELL__ >= 702
3#if __GLASGOW_HASKELL__ >= 702
4{-# LANGUAGE Trustworthy #-}
4{-# LANGUAGE Trustworthy #-}
5#endif
5#endif
6−{-# LANGUAGE UnboxedTuples #-}
7-- |
6-- |
8-- Module : Data.Text.Encoding
7-- Module : Data.Text.Encoding
9-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan,
8-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan,
@@ -74,10 +73,10 @@ import Data.ByteString as B
74import Data.ByteString.Internal as B hiding (c2w)
73import Data.ByteString.Internal as B hiding (c2w)
75import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
74import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
76import Data.Text.Internal (Text(..), safe, text)
75import Data.Text.Internal (Text(..), safe, text)
77−-- import Data.Text.Internal.Private (runText)
76+import Data.Text.Internal.Private (runText)
78import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
77import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
79import Data.Text.Internal.Unsafe.Shift (shiftR)
78import Data.Text.Internal.Unsafe.Shift (shiftR)
80−-- import Data.Text.Show ()
79+import Data.Text.Show ()
81import Data.Text.Unsafe (unsafeDupablePerformIO)
80import Data.Text.Unsafe (unsafeDupablePerformIO)
82import Data.Word (Word8, Word32)
81import Data.Word (Word8, Word32)
83import Foreign.C.Types (CSize(..))
82import Foreign.C.Types (CSize(..))
@@ -95,23 +94,7 @@ import qualified Data.Text.Internal.Encoding.Fusion as E
95import qualified Data.Text.Internal.Encoding.Utf16 as U16
94import qualified Data.Text.Internal.Encoding.Utf16 as U16
96import qualified Data.Text.Internal.Fusion as F
95import qualified Data.Text.Internal.Fusion as F
97
96
98−import GHC.Exts (ByteArray#, Int(..), Int#, Any)
99−{-
100#include "text_cbits.h"
97#include "text_cbits.h"
101−-}
102−
103−import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
104−import Data.ByteString (ByteString)
105−import Data.Text.Internal (Text)
106−
107−-------------------------------------
108−import GHCJS.Types
109−import GHCJS.Buffer
110−import Data.JSString (JSString)
111−import Unsafe.Coerce
112−import System.IO.Unsafe
113−-------------------------------------
114−
115
98
116-- $strict
99-- $strict
117--
100--
@@ -137,55 +120,39 @@ decodeASCII = decodeUtf8
137-- 'decodeLatin1' is semantically equivalent to
120-- 'decodeLatin1' is semantically equivalent to
138-- @Data.Text.pack . Data.ByteString.Char8.unpack@
121-- @Data.Text.pack . Data.ByteString.Char8.unpack@
139decodeLatin1 :: ByteString -> Text
122decodeLatin1 :: ByteString -> Text
140−decodeLatin1 = error "decodeLatin1"
141−-- decodeLatin1 (PS fp off len) = text a 0 len
123+decodeLatin1 (PS fp off len) = text a 0 len
142−-- where
124+ where
143−-- a = A.run (A.new len >>= unsafeIOToST . go)
125+ a = A.run (A.new len >>= unsafeIOToST . go)
144−-- go dest = withForeignPtr fp $ \ptr -> do
126+ go dest = withForeignPtr fp $ \ptr -> do
145−-- c_decode_latin1 (A.maBA dest) (ptr `plusPtr` off) (ptr `plusPtr` (off+len))
127+ c_decode_latin1 (A.maBA dest) (ptr `plusPtr` off) (ptr `plusPtr` (off+len))
146−-- return dest
128+ return dest
147−
148−-- foreign import javascript unsafe "h$textToString" js_toString :: JSVal -> Text
149−
150−foreign import javascript unsafe "h$textFromString" js_fromString :: JSString -> (# ByteArray#, Int# #)
151−foreign import javascript unsafe "String['fromCharCode']['apply'](null, $1['u8'])" js_decodeBytes :: JSVal -> JSString
152−foreign import javascript unsafe "h$decodeUtf8z($1, $2)" js_fromByteStringBuffer :: Buffer -> Int -> JSString
153−foreign import javascript unsafe "h$encodeUtf8($1)" js_encodeUtf8 :: JSString -> Buffer
154−foreign import javascript unsafe "h$encodeUtf8($1)" js_encodeUtf8Mut :: JSString -> MutableBuffer
155−foreign import javascript unsafe "h$encodeUtf16($1)" js_encodeUtf16 :: JSString -> Buffer
156−foreign import javascript unsafe "$1['length']" js_length :: JSString -> Int
157−foreign import javascript unsafe "h$jsstringTake" js_take :: Int -> JSString -> JSString
158
129
159-- | Decode a 'ByteString' containing UTF-8 encoded text.
130-- | Decode a 'ByteString' containing UTF-8 encoded text.
160decodeUtf8With :: OnDecodeError -> ByteString -> Text
131decodeUtf8With :: OnDecodeError -> ByteString -> Text
161−-- decodeUtf8With _ bs@(PS fp off len) = Text $ js_decodeBytes $ unsafeCoerce bs
162− -- decodeUtf8With _ bs = Text $ js_fromByteStringBuffer buf off
163−decodeUtf8With _ bs = Text $ js_take (len) $ js_fromByteStringBuffer buf off
164− where (buf, off, len) = fromByteString bs
165−-- decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
132+decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
166− -- let go dest = withForeignPtr fp $ \ptr ->
133+ let go dest = withForeignPtr fp $ \ptr ->
167− -- with (0::CSize) $ \destOffPtr -> do
134+ with (0::CSize) $ \destOffPtr -> do
168− -- let end = ptr `plusPtr` (off + len)
135+ let end = ptr `plusPtr` (off + len)
169− -- loop curPtr = do
136+ loop curPtr = do
170− -- curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end
137+ curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end
171− -- if curPtr' == end
138+ if curPtr' == end
172− -- then do
139+ then do
173− -- n <- peek destOffPtr
140+ n <- peek destOffPtr
174− -- unsafeSTToIO (done dest (fromIntegral n))
141+ unsafeSTToIO (done dest (fromIntegral n))
175− -- else do
142+ else do
176− -- x <- peek curPtr'
143+ x <- peek curPtr'
177− -- case onErr desc (Just x) of
144+ case onErr desc (Just x) of
178− -- Nothing -> loop $ curPtr' `plusPtr` 1
145+ Nothing -> loop $ curPtr' `plusPtr` 1
179− -- Just c -> do
146+ Just c -> do
180− -- destOff <- peek destOffPtr
147+ destOff <- peek destOffPtr
181− -- w <- unsafeSTToIO $
148+ w <- unsafeSTToIO $
182− -- unsafeWrite dest (fromIntegral destOff) (safe c)
149+ unsafeWrite dest (fromIntegral destOff) (safe c)
183− -- poke destOffPtr (destOff + fromIntegral w)
150+ poke destOffPtr (destOff + fromIntegral w)
184− -- loop $ curPtr' `plusPtr` 1
151+ loop $ curPtr' `plusPtr` 1
185− -- loop (ptr `plusPtr` off)
152+ loop (ptr `plusPtr` off)
186− -- (unsafeIOToST . go) =<< A.new len
153+ (unsafeIOToST . go) =<< A.new len
187− -- where
154+ where
188− -- desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
155+ desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
189{- INLINE[0] decodeUtf8With #-}
156{- INLINE[0] decodeUtf8With #-}
190
157
191-- $stream
158-- $stream
@@ -285,9 +252,8 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
285 let end = ptr `plusPtr` (off + len)
252 let end = ptr `plusPtr` (off + len)
286 loop curPtr = do
253 loop curPtr = do
287 poke curPtrPtr curPtr
254 poke curPtrPtr curPtr
288− curPtr' <- error "c_decode_utf8_with_state: needs to be implemented"
289− -- curPtr' <- c_decode_utf8_with_state (A.maBA dest) destOffPtr
255+ curPtr' <- c_decode_utf8_with_state (A.maBA dest) destOffPtr
290− -- curPtrPtr end codepointPtr statePtr
256+ curPtrPtr end codepointPtr statePtr
291 state <- peek statePtr
257 state <- peek statePtr
292 case state of
258 case state of
293 UTF8_REJECT -> do
259 UTF8_REJECT -> do
@@ -330,8 +296,8 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
330decodeUtf8 :: ByteString -> Text
296decodeUtf8 :: ByteString -> Text
331decodeUtf8 = decodeUtf8With strictDecode
297decodeUtf8 = decodeUtf8With strictDecode
332{-# INLINE[0] decodeUtf8 #-}
298{-# INLINE[0] decodeUtf8 #-}
333−-- {-# RULES "STREAM stream/decodeUtf8 fusion" [1]
299+{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
334−-- forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}
300+ forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}
335
301
336-- | Decode a 'ByteString' containing UTF-8 encoded text.
302-- | Decode a 'ByteString' containing UTF-8 encoded text.
337--
303--
@@ -360,13 +326,9 @@ encodeUtf8BuilderEscaped be =
360 where
326 where
361 bound = max 4 $ BP.sizeBound be
327 bound = max 4 $ BP.sizeBound be
362
328
363− mkBuildstep (Text t) !k =
329+ mkBuildstep (Text arr off len) !k =
364− -- mkBuildstep (Text arr off len) !k =
365 outerLoop off
330 outerLoop off
366 where
331 where
367− off = 0
368− (arr, len) = let (# ba, len' #) = js_fromString t
369− in (A.Array ba, I# len')
370 iend = off + len
332 iend = off + len
371
333
372 outerLoop !i0 !br@(B.BufferRange op0 ope)
334 outerLoop !i0 !br@(B.BufferRange op0 ope)
@@ -406,27 +368,24 @@ encodeUtf8BuilderEscaped be =
406 where
368 where
407 poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)
369 poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)
408
370
409−
410−
411-- | Encode text using UTF-8 encoding.
371-- | Encode text using UTF-8 encoding.
412encodeUtf8 :: Text -> ByteString
372encodeUtf8 :: Text -> ByteString
413−encodeUtf8 (Text txt) = toByteString 0 (Just (js_length txt)) $ js_encodeUtf8 txt
373+encodeUtf8 (Text arr off len)
414−-- encodeUtf8 (Text arr off len)
415−-- | len == 0 = B.empty
374+ | len == 0 = B.empty
416−-- | otherwise = unsafeDupablePerformIO $ do
375+ | otherwise = unsafeDupablePerformIO $ do
417−-- fp <- mallocByteString (len*4)
376+ fp <- mallocByteString (len*4)
418−-- withForeignPtr fp $ \ptr ->
377+ withForeignPtr fp $ \ptr ->
419−-- with ptr $ \destPtr -> do
378+ with ptr $ \destPtr -> do
420−-- c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
379+ c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
421−-- newDest <- peek destPtr
380+ newDest <- peek destPtr
422−-- let utf8len = newDest `minusPtr` ptr
381+ let utf8len = newDest `minusPtr` ptr
423−-- if utf8len >= len `shiftR` 1
382+ if utf8len >= len `shiftR` 1
424−-- then return (PS fp 0 utf8len)
383+ then return (PS fp 0 utf8len)
425−-- else do
384+ else do
426−-- fp' <- mallocByteString utf8len
385+ fp' <- mallocByteString utf8len
427−-- withForeignPtr fp' $ \ptr' -> do
386+ withForeignPtr fp' $ \ptr' -> do
428−-- memcpy ptr' ptr (fromIntegral utf8len)
387+ memcpy ptr' ptr (fromIntegral utf8len)
429−-- return (PS fp' 0 utf8len)
388+ return (PS fp' 0 utf8len)
430
389
431-- | Decode text from little endian UTF-16 encoding.
390-- | Decode text from little endian UTF-16 encoding.
432decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
391decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
@@ -504,17 +463,17 @@ encodeUtf32BE :: Text -> ByteString
504encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
463encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
505{-# INLINE encodeUtf32BE #-}
464{-# INLINE encodeUtf32BE #-}
506
465
507−-- foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8
466+foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8
508−-- :: MutableByteArray# s -> Ptr CSize
467+ :: MutableByteArray# s -> Ptr CSize
509−-- -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
468+ -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
510
469
511−-- foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state
470+foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state
512−-- :: MutableByteArray# s -> Ptr CSize
471+ :: MutableByteArray# s -> Ptr CSize
513−-- -> Ptr (Ptr Word8) -> Ptr Word8
472+ -> Ptr (Ptr Word8) -> Ptr Word8
514−-- -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)
473+ -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)
515
474
516−-- foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
475+foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
517−-- :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
476+ :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
518
477
519−-- foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
478+foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
520−-- :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()
479+ :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()
Data/Text/IO.hs−16
@@ -185,11 +185,7 @@ hPutStr h t = do
185 | otherwise -> writeBlocksRaw h buf str
185 | otherwise -> writeBlocksRaw h buf str
186
186
187hPutChars :: Handle -> Stream Char -> IO ()
187hPutChars :: Handle -> Stream Char -> IO ()
188−#ifndef __GHCJS__
189hPutChars h (Stream next0 s0 _len) = loop s0
188hPutChars h (Stream next0 s0 _len) = loop s0
190−#else
191−hPutChars h (Stream next0 s0) = loop s0
192−#endif
193 where
189 where
194 loop !s = case next0 s of
190 loop !s = case next0 s of
195 Done -> return ()
191 Done -> return ()
@@ -207,11 +203,7 @@ hPutChars h (Stream next0 s0) = loop s0
207-- handling gave a few more percent on top.
203-- handling gave a few more percent on top.
208
204
209writeLines :: Handle -> Newline -> Buffer CharBufElem -> Stream Char -> IO ()
205writeLines :: Handle -> Newline -> Buffer CharBufElem -> Stream Char -> IO ()
210−#ifndef __GHCJS__
211writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0
206writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0
212−#else
213−writeLines h nl buf0 (Stream next0 s0) = outer s0 buf0
214−#endif
215 where
207 where
216 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
208 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
217 where
209 where
@@ -231,11 +223,7 @@ writeLines h nl buf0 (Stream next0 s0) = outer s0 buf0
231 commit = commitBuffer h raw len
223 commit = commitBuffer h raw len
232
224
233writeBlocksCRLF :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
225writeBlocksCRLF :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
234−#ifndef __GHCJS__
235writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0
226writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0
236−#else
237−writeBlocksCRLF h buf0 (Stream next0 s0) = outer s0 buf0
238−#endif
239 where
227 where
240 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
228 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
241 where
229 where
@@ -251,11 +239,7 @@ writeBlocksCRLF h buf0 (Stream next0 s0) = outer s0 buf0
251 commit = commitBuffer h raw len
239 commit = commitBuffer h raw len
252
240
253writeBlocksRaw :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
241writeBlocksRaw :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
254−#ifndef __GHCJS__
255writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0
242writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0
256−#else
257−writeBlocksRaw h buf0 (Stream next0 s0) = outer s0 buf0
258−#endif
259 where
243 where
260 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
244 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
261 where
245 where
Data/Text/Internal.hs+125−42
@@ -1,61 +1,127 @@
1−{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples, MagicHash,
1+{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples #-}
2− BangPatterns, ForeignFunctionInterface, JavaScriptFFI, GeneralizedNewtypeDeriving #-}
2+{-# OPTIONS_HADDOCK not-home #-}
3−{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes,
3+
4− GHCForeignImportPrim, MagicHash, FlexibleInstances #-}
4+-- |
5+-- Module : Data.Text.Internal
6+-- Copyright : (c) 2008, 2009 Tom Harper,
7+-- (c) 2009, 2010 Bryan O'Sullivan,
8+-- (c) 2009 Duncan Coutts
9+--
10+-- License : BSD-style
11+-- Maintainer : bos@serpentine.com
12+-- Stability : experimental
13+-- Portability : GHC
14+--
15+-- A module containing private 'Text' internals. This exposes the
16+-- 'Text' representation and low level construction functions.
17+-- Modules which extend the 'Text' system may need to use this module.
18+--
19+-- You should not use this module unless you are determined to monkey
20+-- with the internals, as the functions here do just about nothing to
21+-- preserve data invariants. You have been warned!
22+
23+#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
24+#include "MachDeps.h"
25+#endif
26+
5module Data.Text.Internal
27module Data.Text.Internal
6− ( module Data.Text.Internal
28+ (
29+ -- * Types
30+ -- $internals
31+ Text(..)
32+ -- * Construction
33+ , text
34+ , textP
35+ -- * Safety
7− , JSS.safe
36+ , safe
37+ -- * Code that must be here for accessibility
38+ , empty
39+ , empty_
40+ -- * Utilities
8− , JSS.firstf
41+ , firstf
42+ -- * Checked multiplication
43+ , mul
44+ , mul32
45+ , mul64
46+ -- * Debugging
47+ , showText
9− ) where
48+ ) where
10−
11−import Data.String (IsString(..))
12−import Data.Coerce
13−import Data.Data
14−import Data.Maybe
15−import Data.Binary
16−import Control.DeepSeq
17−import Data.Semigroup
18−import Data.Char
19−import qualified Data.JSString as JSS
20−import qualified Data.JSString.Internal as JSSS
21−import qualified Data.JSString.Internal.Type as JSS
22−import Data.JSString hiding (empty)
23−import qualified Data.Text.Array as A
24
49
50+#if defined(ASSERTS)
51+import Control.Exception (assert)
52+#endif
25import Data.Bits
53import Data.Bits
26import Data.Int (Int32, Int64)
54import Data.Int (Int32, Int64)
27−-- import Data.Text.Internal.Unsafe.Char (ord)
55+import Data.Text.Internal.Unsafe.Char (ord)
28import Data.Typeable (Typeable)
56import Data.Typeable (Typeable)
29−import GHC.Exts (ByteArray#, Char(..), ord#, andI#, (/=#), isTrue#)
30−-- import qualified Data.Text.Array as A
57+import qualified Data.Text.Array as A
31−import GHCJS.Marshal.Pure
32−import GHCJS.Marshal
33
58
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)
34
65
35−newtype Text = Text JSString
66+-- | Smart constructor.
36− deriving ( Show, Eq, Ord, IsString, Monoid, Read, Data
67+text_ :: A.Array -> Int -> Int -> Text
37− , PToJSVal, PFromJSVal, FromJSVal, ToJSVal
68+text_ arr off len =
38− )
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_ #-}
39
79
80+-- | /O(1)/ The empty 'Text'.
40empty :: Text
81empty :: Text
41−empty = Text JSS.empty
82+empty = Text A.empty 0 0
42{-# INLINE [1] empty #-}
83{-# INLINE [1] empty #-}
43
84
85+-- | A non-inlined version of 'empty'.
44empty_ :: Text
86empty_ :: Text
45−empty_ = Text JSS.empty
87+empty_ = Text A.empty 0 0
46{-# NOINLINE empty_ #-}
88{-# NOINLINE empty_ #-}
47
89
48−foreign import javascript unsafe
49− "String.fromCharCode.apply(null, $1['u8'])"
50− js_decodeBytes :: ByteArray# -> JSString
51−
52-- | Construct a 'Text' without invisibly pinning its byte array in
90-- | Construct a 'Text' without invisibly pinning its byte array in
53-- memory if its length has dwindled to zero.
91-- memory if its length has dwindled to zero.
54text :: A.Array -> Int -> Int -> Text
92text :: A.Array -> Int -> Int -> Text
55−-- text arr off len | len == 0 = empty
93+text arr off len | len == 0 = empty
56−-- | otherwise = text_ arr off len
94+ | otherwise = text_ arr off len
57−text (A.Array ba) off len | len == 0 = empty
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
58− | otherwise = Text (js_decodeBytes ba)
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
59
125
60-- | Checked multiplication. Calls 'error' if the result would
126-- | Checked multiplication. Calls 'error' if the result would
61-- overflow.
127-- overflow.
@@ -102,4 +168,21 @@ mul32 a b = case fromIntegral a * fromIntegral b of
102{-# INLINE mul32 #-}
168{-# INLINE mul32 #-}
103infixl 7 `mul32`
169infixl 7 `mul32`
104
170
105−--------------------------------------
171+-- $internals
172+--
173+-- Internally, the 'Text' type is represented as an array of 'Word16'
174+-- UTF-16 code units. The offset and length fields in the constructor
175+-- are in these units, /not/ units of 'Char'.
176+--
177+-- Invariants that all functions must maintain:
178+--
179+-- * Since the 'Text' type uses UTF-16 internally, it cannot represent
180+-- characters in the reserved surrogate code point range U+D800 to
181+-- U+DFFF. To maintain this invariant, the 'safe' function maps
182+-- 'Char' values in this range to the replacement character (U+FFFD,
183+-- \'&#xfffd;\').
184+--
185+-- * A leading (or \"high\") surrogate code unit (0xD800–0xDBFF) must
186+-- always be followed by a trailing (or \"low\") surrogate code unit
187+-- (0xDC00-0xDFFF). A trailing surrogate code unit must always be
188+-- preceded by a leading surrogate code unit.
Data/Text/Internal/Builder.hs+5−47
@@ -1,6 +1,4 @@
1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
2−{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes, UnboxedTuples,
3− MagicHash #-}
4{-# OPTIONS_HADDOCK not-home #-}
2{-# OPTIONS_HADDOCK not-home #-}
5
3
6-----------------------------------------------------------------------------
4-----------------------------------------------------------------------------
@@ -75,8 +73,6 @@ import qualified Data.Text as S
75import qualified Data.Text.Array as A
73import qualified Data.Text.Array as A
76import qualified Data.Text.Lazy as L
74import qualified Data.Text.Lazy as L
77
75
78−import Data.JSString (JSString)
79−import GHC.Exts (ByteArray#, Int#, Int(I#))
80------------------------------------------------------------------------
76------------------------------------------------------------------------
81
77
82-- | A @Builder@ is an efficient way to build lazy @Text@ values.
78-- | A @Builder@ is an efficient way to build lazy @Text@ values.
@@ -168,17 +164,10 @@ copyLimit = 128
168-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@
164-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@
169--
165--
170fromText :: S.Text -> Builder
166fromText :: S.Text -> Builder
171−fromText t@(Text t')
167+fromText t@(Text arr off l)
172 | S.null t = empty
168 | S.null t = empty
173 | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)
169 | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)
174 | otherwise = flush `append` mapBuilder (t :)
170 | otherwise = flush `append` mapBuilder (t :)
175− where
176− (# ba, len #) = js_fromString t'
177− (arr, off, l) = (A.Array ba, 0, I# len)
178−-- fromText t@(Text arr off l)
179−-- | S.null t = empty
180−-- | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)
181−-- | otherwise = flush `append` mapBuilder (t :)
182{-# INLINE [1] fromText #-}
171{-# INLINE [1] fromText #-}
183
172
184{-# RULES
173{-# RULES
@@ -193,10 +182,10 @@ fromText t@(Text t')
193fromString :: String -> Builder
182fromString :: String -> Builder
194fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
183fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
195 let loop !marr !o !u !l [] = k (Buffer marr o u l)
184 let loop !marr !o !u !l [] = k (Buffer marr o u l)
196− loop marr o@(I# o#) u@(I# u#) l s@(c:cs)
185+ loop marr o u l s@(c:cs)
197 | l <= 1 = do
186 | l <= 1 = do
198 arr <- A.unsafeFreeze marr
187 arr <- A.unsafeFreeze marr
199− let !t = Text $ js_toString (A.aBA arr) o# u#
188+ let !t = Text arr o u
200 marr' <- A.new chunkSize
189 marr' <- A.new chunkSize
201 ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
190 ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
202 return $ t : ts
191 return $ t : ts
@@ -206,21 +195,6 @@ fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
206 in loop p0 o0 u0 l0 str
195 in loop p0 o0 u0 l0 str
207 where
196 where
208 chunkSize = smallChunkSize
197 chunkSize = smallChunkSize
209−-- fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
210−-- let loop !marr !o !u !l [] = k (Buffer marr o u l)
211−-- loop marr o u l s@(c:cs)
212−-- | l <= 1 = do
213−-- arr <- A.unsafeFreeze marr
214−-- let !t = Text arr o u
215−-- marr' <- A.new chunkSize
216−-- ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
217−-- return $ t : ts
218−-- | otherwise = do
219−-- n <- unsafeWrite marr (o+u) c
220−-- loop marr o (u+n) (l-n) cs
221−-- in loop p0 o0 u0 l0 str
222−-- where
223−-- chunkSize = smallChunkSize
224{-# INLINE fromString #-}
198{-# INLINE fromString #-}
225
199
226-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying
200-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying
@@ -260,24 +234,16 @@ toLazyTextWith chunkSize m = L.fromChunks (runST $
260-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,
234-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,
261-- yielding a new chunk in the result lazy @Text@.
235-- yielding a new chunk in the result lazy @Text@.
262flush :: Builder
236flush :: Builder
263−flush = Builder $ \ k buf@(Buffer p o@(I# o#) u@(I# u#) l) ->
237+flush = Builder $ \ k buf@(Buffer p o u l) ->
264 if u == 0
238 if u == 0
265 then k buf
239 then k buf
266 else do arr <- A.unsafeFreeze p
240 else do arr <- A.unsafeFreeze p
267 let !b = Buffer p (o+u) 0 l
241 let !b = Buffer p (o+u) 0 l
268− !t = Text $ js_toString (A.aBA arr) o# u#
242+ !t = Text arr o u
269 ts <- inlineInterleaveST (k b)
243 ts <- inlineInterleaveST (k b)
270 return $! t : ts
244 return $! t : ts
271{-# INLINE [1] flush #-}
245{-# INLINE [1] flush #-}
272-- defer inlining so that flush/flush rule may fire.
246-- defer inlining so that flush/flush rule may fire.
273−-- flush = Builder $ \ k buf@(Buffer p o u l) ->
274−-- if u == 0
275−-- then k buf
276−-- else do arr <- A.unsafeFreeze p
277−-- let !b = Buffer p (o+u) 0 l
278−-- !t = Text arr o u
279−-- ts <- inlineInterleaveST (k b)
280−-- return $! t : ts
281
247
282------------------------------------------------------------------------
248------------------------------------------------------------------------
283
249
@@ -361,11 +327,3 @@ append' (Builder f) (Builder g) = Builder (f . g)
361 append flush flush = flush
327 append flush flush = flush
362
328
363 #-}
329 #-}
364−
365−foreign import javascript unsafe
366− "h$textFromString"
367− js_fromString :: JSString -> (# ByteArray#, Int# #)
368−
369−foreign import javascript unsafe
370− "h$textToString"
371− js_toString :: ByteArray# -> Int# -> Int# -> JSString
Data/Text/Internal/Encoding/Fusion.hs+8−10
@@ -55,7 +55,7 @@ import qualified Data.Text.Internal.Encoding.Utf32 as U32
55import Data.Text.Unsafe (unsafeDupablePerformIO)
55import Data.Text.Unsafe (unsafeDupablePerformIO)
56
56
57streamASCII :: ByteString -> Stream Char
57streamASCII :: ByteString -> Stream Char
58−streamASCII bs = Stream next 0 -- (maxSize l)
58+streamASCII bs = Stream next 0 (maxSize l)
59 where
59 where
60 l = B.length bs
60 l = B.length bs
61 {-# INLINE next #-}
61 {-# INLINE next #-}
@@ -70,7 +70,7 @@ streamASCII bs = Stream next 0 -- (maxSize l)
70-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8
70-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8
71-- encoding.
71-- encoding.
72streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
72streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
73−streamUtf8 onErr bs = Stream next 0 -- (maxSize l)
73+streamUtf8 onErr bs = Stream next 0 (maxSize l)
74 where
74 where
75 l = B.length bs
75 l = B.length bs
76 next i
76 next i
@@ -91,7 +91,7 @@ streamUtf8 onErr bs = Stream next 0 -- (maxSize l)
91-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
91-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
92-- endian UTF-16 encoding.
92-- endian UTF-16 encoding.
93streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
93streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
94−streamUtf16LE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 1))
94+streamUtf16LE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))
95 where
95 where
96 l = B.length bs
96 l = B.length bs
97 {-# INLINE next #-}
97 {-# INLINE next #-}
@@ -109,7 +109,7 @@ streamUtf16LE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 1))
109-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
109-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
110-- endian UTF-16 encoding.
110-- endian UTF-16 encoding.
111streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
111streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
112−streamUtf16BE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 1))
112+streamUtf16BE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))
113 where
113 where
114 l = B.length bs
114 l = B.length bs
115 {-# INLINE next #-}
115 {-# INLINE next #-}
@@ -127,7 +127,7 @@ streamUtf16BE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 1))
127-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
127-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
128-- endian UTF-32 encoding.
128-- endian UTF-32 encoding.
129streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
129streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
130−streamUtf32BE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 2))
130+streamUtf32BE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))
131 where
131 where
132 l = B.length bs
132 l = B.length bs
133 {-# INLINE next #-}
133 {-# INLINE next #-}
@@ -147,7 +147,7 @@ streamUtf32BE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 2))
147-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
147-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
148-- endian UTF-32 encoding.
148-- endian UTF-32 encoding.
149streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
149streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
150−streamUtf32LE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 2))
150+streamUtf32LE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))
151 where
151 where
152 l = B.length bs
152 l = B.length bs
153 {-# INLINE next #-}
153 {-# INLINE next #-}
@@ -166,10 +166,8 @@ streamUtf32LE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 2))
166
166
167-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.
167-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.
168unstream :: Stream Word8 -> ByteString
168unstream :: Stream Word8 -> ByteString
169−-- unstream (Stream next s0 len) = unsafeDupablePerformIO $ do
169+unstream (Stream next s0 len) = unsafeDupablePerformIO $ do
170−unstream (Stream next s0) = unsafeDupablePerformIO $ do
171− -- let mlen = upperBound 4 len
170+ let mlen = upperBound 4 len
172− let mlen = 4
173 mallocByteString mlen >>= loop mlen 0 s0
171 mallocByteString mlen >>= loop mlen 0 s0
174 where
172 where
175 loop !n !off !s fp = case next s of
173 loop !n !off !s fp = case next s of
Data/Text/Internal/Encoding/Fusion/Common.hs+4−8
@@ -37,8 +37,7 @@ import Data.Text.Internal.Unsafe.Shift (shiftR)
37import Data.Word (Word8)
37import Data.Word (Word8)
38
38
39restreamUtf16BE :: Stream Char -> Stream Word8
39restreamUtf16BE :: Stream Char -> Stream Word8
40−-- restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
40+restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
41−restreamUtf16BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
42 where
41 where
43 next (RS0 s) = case next0 s of
42 next (RS0 s) = case next0 s of
44 Done -> Done
43 Done -> Done
@@ -62,8 +61,7 @@ restreamUtf16BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
62{-# INLINE restreamUtf16BE #-}
61{-# INLINE restreamUtf16BE #-}
63
62
64restreamUtf16LE :: Stream Char -> Stream Word8
63restreamUtf16LE :: Stream Char -> Stream Word8
65−-- restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
64+restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
66−restreamUtf16LE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
67 where
65 where
68 next (RS0 s) = case next0 s of
66 next (RS0 s) = case next0 s of
69 Done -> Done
67 Done -> Done
@@ -87,8 +85,7 @@ restreamUtf16LE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
87{-# INLINE restreamUtf16LE #-}
85{-# INLINE restreamUtf16LE #-}
88
86
89restreamUtf32BE :: Stream Char -> Stream Word8
87restreamUtf32BE :: Stream Char -> Stream Word8
90−restreamUtf32BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
88+restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
91−-- restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
92 where
89 where
93 next (RS0 s) = case next0 s of
90 next (RS0 s) = case next0 s of
94 Done -> Done
91 Done -> Done
@@ -107,8 +104,7 @@ restreamUtf32BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
107{-# INLINE restreamUtf32BE #-}
104{-# INLINE restreamUtf32BE #-}
108
105
109restreamUtf32LE :: Stream Char -> Stream Word8
106restreamUtf32LE :: Stream Char -> Stream Word8
110−restreamUtf32LE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
107+restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
111−-- restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
112 where
108 where
113 next (RS0 s) = case next0 s of
109 next (RS0 s) = case next0 s of
114 Done -> Done
110 Done -> Done
Data/Text/Internal/Fusion.hs+180−42
@@ -28,79 +28,217 @@ module Data.Text.Internal.Fusion
28 , unstream
28 , unstream
29 , reverseStream
29 , reverseStream
30
30
31− , Data.Text.Internal.Fusion.length
31+ , length
32
32
33 -- * Transformations
33 -- * Transformations
34− , Data.Text.Internal.Fusion.reverse
34+ , reverse
35
35
36 -- * Construction
36 -- * Construction
37 -- ** Scans
37 -- ** Scans
38 , reverseScanr
38 , reverseScanr
39
39
40 -- ** Accumulating maps
40 -- ** Accumulating maps
41− , Data.Text.Internal.Fusion.mapAccumL
41+ , mapAccumL
42
42
43 -- ** Generation and unfolding
43 -- ** Generation and unfolding
44 , unfoldrN
44 , unfoldrN
45
45
46 -- * Indexing
46 -- * Indexing
47− , Data.Text.Internal.Fusion.index
47+ , index
48− , Data.Text.Internal.Fusion.findIndex
48+ , findIndex
49 , countChar
49 , countChar
50 ) where
50 ) where
51
51
52−import GHC.Exts (Char(..), Int(..), chr#, Int#, isTrue#, (-#), (+#), (>=#))
52+import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,
53−
53+ Num(..), Ord(..), ($), (&&),
54−import Prelude hiding (length, reverse)
54+ fromIntegral, otherwise)
55−import Data.Char
55+import Data.Bits ((.&.))
56−
57−import Data.JSString.Internal.Type (JSString(..))
56+import Data.Text.Internal (Text(..))
58−import qualified Data.JSString.Internal.Type as I
57+import Data.Text.Internal.Private (runText)
58+import Data.Text.Internal.Unsafe.Char (ord, unsafeChr, unsafeWrite)
59−import Data.JSString.Internal.Fusion.Types
59+import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
60+import qualified Data.Text.Array as A
60−import qualified Data.JSString.Internal.Fusion.Common as S
61+import qualified Data.Text.Internal.Fusion.Common as S
61−
62+import Data.Text.Internal.Fusion.Types
62−import System.IO.Unsafe
63−
64−import GHCJS.Prim
65−
66−import Data.Coerce
67−import Data.Text.Internal
63+import Data.Text.Internal.Fusion.Size
68−import qualified Data.JSString.Internal.Fusion as JSS
64+import qualified Data.Text.Internal as I
69−import Data.JSString.Internal.Fusion.Types (Stream(..))
65+import qualified Data.Text.Internal.Encoding.Utf16 as U16
70
66
71default(Int)
67default(Int)
72
68
69+-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
73stream :: Text -> Stream Char
70stream :: Text -> Stream Char
74−stream = coerce JSS.stream
71+stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)
75−
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)
81+{-# INLINE [0] stream #-}
82+
83+-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate
84+-- backwards.
76reverseStream :: Text -> Stream Char
85reverseStream :: Text -> Stream Char
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)
77−reverseStream = coerce JSS.reverseStream
96+{-# INLINE [0] reverseStream #-}
78−
97+
98+-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
79unstream :: Stream Char -> Text
99unstream :: Stream Char -> Text
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
80−unstream = coerce JSS.unstream
130+{-# INLINE [0] unstream #-}
131+{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
132+
133+
134+-- ----------------------------------------------------------------------------
135+-- * Basic stream functions
81
136
82length :: Stream Char -> Int
137length :: Stream Char -> Int
138+length = S.lengthI
83−length = JSS.length
139+{-# INLINE[0] length #-}
84
140
141+-- | /O(n)/ Reverse the characters of a string.
85reverse :: Stream Char -> Text
142reverse :: Stream Char -> Text
86−reverse = coerce JSS.reverse
143+reverse (Stream next s len0)
87−
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
174+{-# INLINE [0] reverse #-}
175+
176+-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with
177+-- the input and result reversed.
88reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
178reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
89−reverseScanr = JSS.reverseScanr
179+reverseScanr f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
90−
180+ where
91−mapAccumL :: (a -> Char -> (a, Char)) -> a -> Stream Char -> (a, Text)
181+ {-# INLINE next #-}
92−mapAccumL f z0 st =
182+ next (Scan1 z s) = Yield z (Scan2 z s)
93− let (a, t) = JSS.mapAccumL f z0 st
183+ next (Scan2 z s) = case next0 s of
94− in (a, Text t)
184+ Yield x s' -> let !x' = f x z
95−
185+ in Yield x' (Scan2 x' s')
186+ Skip s' -> Skip (Scan2 z s')
187+ Done -> Done
188+{-# INLINE reverseScanr #-}
189+
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.
96unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char
194unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char
195+unfoldrN n = S.unfoldrNI n
97−unfoldrN = JSS.unfoldrN
196+{-# INLINE [0] unfoldrN #-}
197+
198+-------------------------------------------------------------------------------
199+-- ** Indexing streams
98
200
201+-- | /O(n)/ stream index (subscript) operator, starting from 0.
99index :: Stream Char -> Int -> Char
202index :: Stream Char -> Int -> Char
100−index = JSS.index
203+index = S.indexI
204+{-# INLINE [0] index #-}
101
205
206+-- | The 'findIndex' function takes a predicate and a stream and
207+-- returns the index of the first element in the stream
208+-- satisfying the predicate.
102findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int
209findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int
210+findIndex = S.findIndexI
103−findIndex = JSS.findIndex
211+{-# INLINE [0] findIndex #-}
104
212
213+-- | /O(n)/ The 'count' function returns the number of times the query
214+-- element appears in the given stream.
105countChar :: Char -> Stream Char -> Int
215countChar :: Char -> Stream Char -> Int
216+countChar = S.countCharI
106−countChar = JSS.countChar
217+{-# INLINE [0] countChar #-}
218+
219+-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
220+-- function to each element of a 'Text', passing an accumulating
221+-- parameter from left to right, and returns a final 'Text'.
222+mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)
223+mapAccumL f z0 (Stream next0 s0 len) = (nz, I.text na 0 nl)
224+ where
225+ (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)
226+ where mlen = upperBound 4 len
227+ outer arr top = loop
228+ where
229+ loop !z !s !i =
230+ case next0 s of
231+ Done -> return (arr, (z,i))
232+ Skip s' -> loop z s' i
233+ Yield x s'
234+ | j >= top -> {-# SCC "mapAccumL/resize" #-} do
235+ let top' = (top + 1) `shiftL` 1
236+ arr' <- A.new top'
237+ A.copyM arr' 0 arr 0 top
238+ outer arr' top' z s i
239+ | otherwise -> do d <- unsafeWrite arr i c
240+ loop z' s' (i+d)
241+ where (z',c) = f z x
242+ j | ord c < 0x10000 = i
243+ | otherwise = i + 1
244+{-# INLINE [0] mapAccumL #-}
Data/Text/Internal/Fusion/Common.hs+922−968
@@ -14,971 +14,925 @@
14--
14--
15-- Common stream fusion functionality for text.
15-- Common stream fusion functionality for text.
16
16
17−module Data.Text.Internal.Fusion.Common (module Data.JSString.Internal.Fusion.Common) where
17+module Data.Text.Internal.Fusion.Common
18−import Data.JSString.Internal.Fusion.Common
18+ (
19−-- module Data.Text.Internal.Fusion.Common
19+ -- * Creation and elimination
20−-- (
20+ singleton
21−-- -- * Creation and elimination
21+ , streamList
22−-- singleton
22+ , unstreamList
23−-- , streamList
23+ , streamCString#
24−-- , unstreamList
24+
25−-- , streamCString#
25+ -- * Basic interface
26−
26+ , cons
27−-- -- * Basic interface
27+ , snoc
28−-- , cons
28+ , append
29−-- , snoc
29+ , head
30−-- , append
30+ , uncons
31−-- , head
31+ , last
32−-- , uncons
32+ , tail
33−-- , last
33+ , init
34−-- , tail
34+ , null
35−-- , init
35+ , lengthI
36−-- , null
36+ , compareLengthI
37−-- , lengthI
37+ , isSingleton
38−-- , compareLengthI
38+
39−-- , isSingleton
39+ -- * Transformations
40−
40+ , map
41−-- -- * Transformations
41+ , intercalate
42−-- , map
42+ , intersperse
43−-- , intercalate
43+
44−-- , intersperse
44+ -- ** Case conversion
45−
45+ -- $case
46−-- -- ** Case conversion
46+ , toCaseFold
47−-- -- $case
47+ , toLower
48−-- , toCaseFold
48+ , toTitle
49−-- , toLower
49+ , toUpper
50−-- , toTitle
50+
51−-- , toUpper
51+ -- ** Justification
52−
52+ , justifyLeftI
53−-- -- ** Justification
53+
54−-- , justifyLeftI
54+ -- * Folds
55−
55+ , foldl
56−-- -- * Folds
56+ , foldl'
57−-- , foldl
57+ , foldl1
58−-- , foldl'
58+ , foldl1'
59−-- , foldl1
59+ , foldr
60−-- , foldl1'
60+ , foldr1
61−-- , foldr
61+
62−-- , foldr1
62+ -- ** Special folds
63−
63+ , concat
64−-- -- ** Special folds
64+ , concatMap
65−-- , concat
65+ , any
66−-- , concatMap
66+ , all
67−-- , any
67+ , maximum
68−-- , all
68+ , minimum
69−-- , maximum
69+
70−-- , minimum
70+ -- * Construction
71−
71+ -- ** Scans
72−-- -- * Construction
72+ , scanl
73−-- -- ** Scans
73+
74−-- , scanl
74+ -- ** Generation and unfolding
75−
75+ , replicateCharI
76−-- -- ** Generation and unfolding
76+ , replicateI
77−-- , replicateCharI
77+ , unfoldr
78−-- , replicateI
78+ , unfoldrNI
79−-- , unfoldr
79+
80−-- , unfoldrNI
80+ -- * Substrings
81−
81+ -- ** Breaking strings
82−-- -- * Substrings
82+ , take
83−-- -- ** Breaking strings
83+ , drop
84−-- , take
84+ , takeWhile
85−-- , drop
85+ , dropWhile
86−-- , takeWhile
86+
87−-- , dropWhile
87+ -- * Predicates
88−
88+ , isPrefixOf
89−-- -- * Predicates
89+
90−-- , isPrefixOf
90+ -- * Searching
91−
91+ , elem
92−-- -- * Searching
92+ , filter
93−-- , elem
93+
94−-- , filter
94+ -- * Indexing
95−
95+ , findBy
96−-- -- * Indexing
96+ , indexI
97−-- , findBy
97+ , findIndexI
98−-- , indexI
98+ , countCharI
99−-- , findIndexI
99+
100−-- , countCharI
100+ -- * Zipping and unzipping
101−
101+ , zipWith
102−-- -- * Zipping and unzipping
102+ ) where
103−-- , zipWith
103+
104−-- ) where
104+import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
105−
105+ Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),
106−-- import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
106+ (&&), fromIntegral, otherwise)
107−-- Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),
107+import qualified Data.List as L
108−-- (&&), fromIntegral, otherwise)
108+import qualified Prelude as P
109−-- import qualified Data.List as L
109+import Data.Bits (shiftL)
110−-- import qualified Prelude as P
110+import Data.Char (isLetter)
111−-- import Data.Bits (shiftL)
111+import Data.Int (Int64)
112−-- import Data.Char (isLetter)
112+import Data.Text.Internal.Fusion.Types
113−-- import Data.Int (Int64)
113+import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,
114−-- import Data.Text.Internal.Fusion.Types
114+ upperMapping)
115−-- import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,
115+import Data.Text.Internal.Fusion.Size
116−-- upperMapping)
116+import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)
117−-- import Data.Text.Internal.Fusion.Size
117+import GHC.Types (Char(..), Int(..))
118−-- import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)
118+
119−-- import GHC.Types (Char(..), Int(..))
119+singleton :: Char -> Stream Char
120−
120+singleton c = Stream next False 1
121−-- singleton :: Char -> Stream Char
121+ where next False = Yield c True
122−-- singleton c = Stream next False -- 1
122+ next True = Done
123−-- where next False = Yield c True
123+{-# INLINE [0] singleton #-}
124−-- next True = Done
124+
125−-- {-# INLINE [0] singleton #-}
125+streamList :: [a] -> Stream a
126−
126+{-# INLINE [0] streamList #-}
127−-- streamList :: [a] -> Stream a
127+streamList s = Stream next s unknownSize
128−-- {-# INLINE [0] streamList #-}
128+ where next [] = Done
129−-- streamList s = Stream next s -- unknownSize
129+ next (x:xs) = Yield x xs
130−-- where next [] = Done
130+
131−-- next (x:xs) = Yield x xs
131+unstreamList :: Stream a -> [a]
132−
132+unstreamList (Stream next s0 _len) = unfold s0
133−-- unstreamList :: Stream a -> [a]
133+ where unfold !s = case next s of
134−-- -- unstreamList (Stream next s0 _len) = unfold s0
134+ Done -> []
135−-- unstreamList (Stream next s0) = unfold s0
135+ Skip s' -> unfold s'
136−-- where unfold !s = case next s of
136+ Yield x s' -> x : unfold s'
137−-- Done -> []
137+{-# INLINE [0] unstreamList #-}
138−-- Skip s' -> unfold s'
138+
139−-- Yield x s' -> x : unfold s'
139+{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}
140−-- {-# INLINE [0] unstreamList #-}
140+
141−
141+-- | Stream the UTF-8-like packed encoding used by GHC to represent
142−-- {-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}
142+-- constant strings in generated code.
143−
143+--
144−-- -- | Stream the UTF-8-like packed encoding used by GHC to represent
144+-- This encoding uses the byte sequence "\xc0\x80" to represent NUL,
145−-- -- constant strings in generated code.
145+-- and the string is NUL-terminated.
146−-- --
146+streamCString# :: Addr# -> Stream Char
147−-- -- This encoding uses the byte sequence "\xc0\x80" to represent NUL,
147+streamCString# addr = Stream step 0 unknownSize
148−-- -- and the string is NUL-terminated.
148+ where
149−-- streamCString# :: Addr# -> Stream Char
149+ step !i
150−-- streamCString# addr = Stream step 0 -- unknownSize
150+ | b == 0 = Done
151−-- where
151+ | b <= 0x7f = Yield (C# b#) (i+1)
152−-- step !i
152+ | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1
153−-- | b == 0 = Done
153+ in Yield c (i+2)
154−-- | b <= 0x7f = Yield (C# b#) (i+1)
154+ | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +
155−-- | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1
155+ (next 1 `shiftL` 6) +
156−-- in Yield c (i+2)
156+ next 2
157−-- | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +
157+ in Yield c (i+3)
158−-- (next 1 `shiftL` 6) +
158+ | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +
159−-- next 2
159+ (next 1 `shiftL` 12) +
160−-- in Yield c (i+3)
160+ (next 2 `shiftL` 6) +
161−-- | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +
161+ next 3
162−-- (next 1 `shiftL` 12) +
162+ in Yield c (i+4)
163−-- (next 2 `shiftL` 6) +
163+ where b = I# (ord# b#)
164−-- next 3
164+ next n = I# (ord# (at# (i+n))) - 0x80
165−-- in Yield c (i+4)
165+ !b# = at# i
166−-- where b = I# (ord# b#)
166+ at# (I# i#) = indexCharOffAddr# addr i#
167−-- next n = I# (ord# (at# (i+n))) - 0x80
167+ chr (I# i#) = C# (chr# i#)
168−-- !b# = at# i
168+{-# INLINE [0] streamCString# #-}
169−-- at# (I# i#) = indexCharOffAddr# addr i#
169+
170−-- chr (I# i#) = C# (chr# i#)
170+-- ----------------------------------------------------------------------------
171−-- {-# INLINE [0] streamCString# #-}
171+-- * Basic stream functions
172−
172+
173−-- -- ----------------------------------------------------------------------------
173+data C s = C0 !s
174−-- -- * Basic stream functions
174+ | C1 !s
175−
175+
176−-- data C s = C0 !s
176+-- | /O(n)/ Adds a character to the front of a Stream Char.
177−-- | C1 !s
177+cons :: Char -> Stream Char -> Stream Char
178−
178+cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
179−-- -- | /O(n)/ Adds a character to the front of a Stream Char.
179+ where
180−-- cons :: Char -> Stream Char -> Stream Char
180+ next (C1 s) = Yield w (C0 s)
181−-- -- cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
181+ next (C0 s) = case next0 s of
182−-- cons !w (Stream next0 s0) = Stream next (C1 s0) -- (len+1)
182+ Done -> Done
183−-- where
183+ Skip s' -> Skip (C0 s')
184−-- next (C1 s) = Yield w (C0 s)
184+ Yield x s' -> Yield x (C0 s')
185−-- next (C0 s) = case next0 s of
185+{-# INLINE [0] cons #-}
186−-- Done -> Done
186+
187−-- Skip s' -> Skip (C0 s')
187+data Snoc a = N
188−-- Yield x s' -> Yield x (C0 s')
188+ | J !a
189−-- {-# INLINE [0] cons #-}
189+
190−
190+-- | /O(n)/ Adds a character to the end of a stream.
191−-- data Snoc a = N
191+snoc :: Stream Char -> Char -> Stream Char
192−-- | J !a
192+snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
193−
193+ where
194−-- -- | /O(n)/ Adds a character to the end of a stream.
194+ next (J xs) = case next0 xs of
195−-- snoc :: Stream Char -> Char -> Stream Char
195+ Done -> Yield w N
196−-- -- snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
196+ Skip xs' -> Skip (J xs')
197−-- snoc (Stream next0 xs0) w = Stream next (J xs0) -- (len+1)
197+ Yield x xs' -> Yield x (J xs')
198−-- where
198+ next N = Done
199−-- next (J xs) = case next0 xs of
199+{-# INLINE [0] snoc #-}
200−-- Done -> Yield w N
200+
201−-- Skip xs' -> Skip (J xs')
201+data E l r = L !l
202−-- Yield x xs' -> Yield x (J xs')
202+ | R !r
203−-- next N = Done
203+
204−-- {-# INLINE [0] snoc #-}
204+-- | /O(n)/ Appends one Stream to the other.
205−
205+append :: Stream Char -> Stream Char -> Stream Char
206−-- data E l r = L !l
206+append (Stream next0 s01 len1) (Stream next1 s02 len2) =
207−-- | R !r
207+ Stream next (L s01) (len1 + len2)
208−
208+ where
209−-- -- | /O(n)/ Appends one Stream to the other.
209+ next (L s1) = case next0 s1 of
210−-- append :: Stream Char -> Stream Char -> Stream Char
210+ Done -> Skip (R s02)
211−-- -- append (Stream next0 s01 len1) (Stream next1 s02 len2) =
211+ Skip s1' -> Skip (L s1')
212−-- -- Stream next (L s01) (len1 + len2)
212+ Yield x s1' -> Yield x (L s1')
213−-- append (Stream next0 s01) (Stream next1 s02) =
213+ next (R s2) = case next1 s2 of
214−-- Stream next (L s01)
214+ Done -> Done
215−-- where
215+ Skip s2' -> Skip (R s2')
216−-- next (L s1) = case next0 s1 of
216+ Yield x s2' -> Yield x (R s2')
217−-- Done -> Skip (R s02)
217+{-# INLINE [0] append #-}
218−-- Skip s1' -> Skip (L s1')
218+
219−-- Yield x s1' -> Yield x (L s1')
219+-- | /O(1)/ Returns the first character of a Text, which must be non-empty.
220−-- next (R s2) = case next1 s2 of
220+-- Subject to array fusion.
221−-- Done -> Done
221+head :: Stream Char -> Char
222−-- Skip s2' -> Skip (R s2')
222+head (Stream next s0 _len) = loop_head s0
223−-- Yield x s2' -> Yield x (R s2')
223+ where
224−-- {-# INLINE [0] append #-}
224+ loop_head !s = case next s of
225−
225+ Yield x _ -> x
226−-- -- | /O(1)/ Returns the first character of a Text, which must be non-empty.
226+ Skip s' -> loop_head s'
227−-- -- Subject to array fusion.
227+ Done -> head_empty
228−-- head :: Stream Char -> Char
228+{-# INLINE [0] head #-}
229−-- -- head (Stream next s0 _len) = loop_head s0
229+
230−-- head (Stream next s0) = loop_head s0
230+head_empty :: a
231−-- where
231+head_empty = streamError "head" "Empty stream"
232−-- loop_head !s = case next s of
232+{-# NOINLINE head_empty #-}
233−-- Yield x _ -> x
233+
234−-- Skip s' -> loop_head s'
234+-- | /O(1)/ Returns the first character and remainder of a 'Stream
235−-- Done -> head_empty
235+-- Char', or 'Nothing' if empty. Subject to array fusion.
236−-- {-# INLINE [0] head #-}
236+uncons :: Stream Char -> Maybe (Char, Stream Char)
237−
237+uncons (Stream next s0 len) = loop_uncons s0
238−-- head_empty :: a
238+ where
239−-- head_empty = streamError "head" "Empty stream"
239+ loop_uncons !s = case next s of
240−-- {-# NOINLINE head_empty #-}
240+ Yield x s1 -> Just (x, Stream next s1 (len-1))
241−
241+ Skip s' -> loop_uncons s'
242−-- -- | /O(1)/ Returns the first character and remainder of a 'Stream
242+ Done -> Nothing
243−-- -- Char', or 'Nothing' if empty. Subject to array fusion.
243+{-# INLINE [0] uncons #-}
244−-- uncons :: Stream Char -> Maybe (Char, Stream Char)
244+
245−-- -- uncons (Stream next s0 len) = loop_uncons s0
245+-- | /O(n)/ Returns the last character of a 'Stream Char', which must
246−-- uncons (Stream next s0) = loop_uncons s0
246+-- be non-empty.
247−-- where
247+last :: Stream Char -> Char
248−-- loop_uncons !s = case next s of
248+last (Stream next s0 _len) = loop0_last s0
249−-- Yield x s1 -> Just (x, Stream next s1)
249+ where
250−-- Skip s' -> loop_uncons s'
250+ loop0_last !s = case next s of
251−-- Done -> Nothing
251+ Done -> emptyError "last"
252−-- {-# INLINE [0] uncons #-}
252+ Skip s' -> loop0_last s'
253−
253+ Yield x s' -> loop_last x s'
254−-- -- | /O(n)/ Returns the last character of a 'Stream Char', which must
254+ loop_last !x !s = case next s of
255−-- -- be non-empty.
255+ Done -> x
256−-- last :: Stream Char -> Char
256+ Skip s' -> loop_last x s'
257−-- -- last (Stream next s0 _len) = loop0_last s0
257+ Yield x' s' -> loop_last x' s'
258−-- last (Stream next s0) = loop0_last s0
258+{-# INLINE[0] last #-}
259−-- where
259+
260−-- loop0_last !s = case next s of
260+-- | /O(1)/ Returns all characters after the head of a Stream Char, which must
261−-- Done -> emptyError "last"
261+-- be non-empty.
262−-- Skip s' -> loop0_last s'
262+tail :: Stream Char -> Stream Char
263−-- Yield x s' -> loop_last x s'
263+tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)
264−-- loop_last !x !s = case next s of
264+ where
265−-- Done -> x
265+ next (C0 s) = case next0 s of
266−-- Skip s' -> loop_last x s'
266+ Done -> emptyError "tail"
267−-- Yield x' s' -> loop_last x' s'
267+ Skip s' -> Skip (C0 s')
268−-- {-# INLINE[0] last #-}
268+ Yield _ s' -> Skip (C1 s')
269−
269+ next (C1 s) = case next0 s of
270−-- -- | /O(1)/ Returns all characters after the head of a Stream Char, which must
270+ Done -> Done
271−-- -- be non-empty.
271+ Skip s' -> Skip (C1 s')
272−-- tail :: Stream Char -> Stream Char
272+ Yield x s' -> Yield x (C1 s')
273−-- -- tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)
273+{-# INLINE [0] tail #-}
274−-- tail (Stream next0 s0) = Stream next (C0 s0) -- (len-1)
274+
275−-- where
275+data Init s = Init0 !s
276−-- next (C0 s) = case next0 s of
276+ | Init1 {-# UNPACK #-} !Char !s
277−-- Done -> emptyError "tail"
277+
278−-- Skip s' -> Skip (C0 s')
278+-- | /O(1)/ Returns all but the last character of a Stream Char, which
279−-- Yield _ s' -> Skip (C1 s')
279+-- must be non-empty.
280−-- next (C1 s) = case next0 s of
280+init :: Stream Char -> Stream Char
281−-- Done -> Done
281+init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)
282−-- Skip s' -> Skip (C1 s')
282+ where
283−-- Yield x s' -> Yield x (C1 s')
283+ next (Init0 s) = case next0 s of
284−-- {-# INLINE [0] tail #-}
284+ Done -> emptyError "init"
285−
285+ Skip s' -> Skip (Init0 s')
286−-- data Init s = Init0 !s
286+ Yield x s' -> Skip (Init1 x s')
287−-- | Init1 {-# UNPACK #-} !Char !s
287+ next (Init1 x s) = case next0 s of
288−
288+ Done -> Done
289−-- -- | /O(1)/ Returns all but the last character of a Stream Char, which
289+ Skip s' -> Skip (Init1 x s')
290−-- -- must be non-empty.
290+ Yield x' s' -> Yield x (Init1 x' s')
291−-- init :: Stream Char -> Stream Char
291+{-# INLINE [0] init #-}
292−-- -- init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)
292+
293−-- init (Stream next0 s0) = Stream next (Init0 s0) -- (len-1)
293+-- | /O(1)/ Tests whether a Stream Char is empty or not.
294−-- where
294+null :: Stream Char -> Bool
295−-- next (Init0 s) = case next0 s of
295+null (Stream next s0 _len) = loop_null s0
296−-- Done -> emptyError "init"
296+ where
297−-- Skip s' -> Skip (Init0 s')
297+ loop_null !s = case next s of
298−-- Yield x s' -> Skip (Init1 x s')
298+ Done -> True
299−-- next (Init1 x s) = case next0 s of
299+ Yield _ _ -> False
300−-- Done -> Done
300+ Skip s' -> loop_null s'
301−-- Skip s' -> Skip (Init1 x s')
301+{-# INLINE[0] null #-}
302−-- Yield x' s' -> Yield x (Init1 x' s')
302+
303−-- {-# INLINE [0] init #-}
303+-- | /O(n)/ Returns the number of characters in a string.
304−
304+lengthI :: Integral a => Stream Char -> a
305−-- -- | /O(1)/ Tests whether a Stream Char is empty or not.
305+lengthI (Stream next s0 _len) = loop_length 0 s0
306−-- null :: Stream Char -> Bool
306+ where
307−-- -- null (Stream next s0 _len) = loop_null s0
307+ loop_length !z s = case next s of
308−-- null (Stream next s0) = loop_null s0
308+ Done -> z
309−-- where
309+ Skip s' -> loop_length z s'
310−-- loop_null !s = case next s of
310+ Yield _ s' -> loop_length (z + 1) s'
311−-- Done -> True
311+{-# INLINE[0] lengthI #-}
312−-- Yield _ _ -> False
312+
313−-- Skip s' -> loop_null s'
313+-- | /O(n)/ Compares the count of characters in a string to a number.
314−-- {-# INLINE[0] null #-}
314+-- Subject to fusion.
315−
315+--
316−-- -- | /O(n)/ Returns the number of characters in a string.
316+-- This function gives the same answer as comparing against the result
317−-- lengthI :: Integral a => Stream Char -> a
317+-- of 'lengthI', but can short circuit if the count of characters is
318−-- -- lengthI (Stream next s0 _len) = loop_length 0 s0
318+-- greater than the number or if the stream can't possibly be as long
319−-- lengthI (Stream next s0) = loop_length 0 s0
319+-- as the number supplied, and hence be more efficient.
320−-- where
320+compareLengthI :: Integral a => Stream Char -> a -> Ordering
321−-- loop_length !z s = case next s of
321+compareLengthI (Stream next s0 len) n =
322−-- Done -> z
322+ case compareSize len (fromIntegral n) of
323−-- Skip s' -> loop_length z s'
323+ Just o -> o
324−-- Yield _ s' -> loop_length (z + 1) s'
324+ Nothing -> loop_cmp 0 s0
325−-- {-# INLINE[0] lengthI #-}
325+ where
326−
326+ loop_cmp !z s = case next s of
327−-- -- | /O(n)/ Compares the count of characters in a string to a number.
327+ Done -> compare z n
328−-- -- Subject to fusion.
328+ Skip s' -> loop_cmp z s'
329−-- --
329+ Yield _ s' | z > n -> GT
330−-- -- This function gives the same answer as comparing against the result
330+ | otherwise -> loop_cmp (z + 1) s'
331−-- -- of 'lengthI', but can short circuit if the count of characters is
331+{-# INLINE[0] compareLengthI #-}
332−-- -- greater than the number or if the stream can't possibly be as long
332+
333−-- -- as the number supplied, and hence be more efficient.
333+-- | /O(n)/ Indicate whether a string contains exactly one element.
334−-- compareLengthI :: Integral a => Stream Char -> a -> Ordering
334+isSingleton :: Stream Char -> Bool
335−-- -- compareLengthI (Stream next s0 len) n =
335+isSingleton (Stream next s0 _len) = loop 0 s0
336−-- compareLengthI (Stream next s0) n =
336+ where
337−-- -- case compareSize len (fromIntegral n) of
337+ loop !z s = case next s of
338−-- -- Just o -> o
338+ Done -> z == (1::Int)
339−-- -- Nothing -> loop_cmp 0 s0
339+ Skip s' -> loop z s'
340−-- loop_cmp 0 s0
340+ Yield _ s'
341−-- where
341+ | z >= 1 -> False
342−-- loop_cmp !z s = case next s of
342+ | otherwise -> loop (z+1) s'
343−-- Done -> compare z n
343+{-# INLINE[0] isSingleton #-}
344−-- Skip s' -> loop_cmp z s'
344+
345−-- Yield _ s' | z > n -> GT
345+-- ----------------------------------------------------------------------------
346−-- | otherwise -> loop_cmp (z + 1) s'
346+-- * Stream transformations
347−-- {-# INLINE[0] compareLengthI #-}
347+
348−
348+-- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@
349−-- -- | /O(n)/ Indicate whether a string contains exactly one element.
349+-- to each element of @xs@.
350−-- isSingleton :: Stream Char -> Bool
350+map :: (Char -> Char) -> Stream Char -> Stream Char
351−-- -- isSingleton (Stream next s0 _len) = loop 0 s0
351+map f (Stream next0 s0 len) = Stream next s0 len
352−-- isSingleton (Stream next s0) = loop 0 s0
352+ where
353−-- where
353+ next !s = case next0 s of
354−-- loop !z s = case next s of
354+ Done -> Done
355−-- Done -> z == (1::Int)
355+ Skip s' -> Skip s'
356−-- Skip s' -> loop z s'
356+ Yield x s' -> Yield (f x) s'
357−-- Yield _ s'
357+{-# INLINE [0] map #-}
358−-- | z >= 1 -> False
358+
359−-- | otherwise -> loop (z+1) s'
359+{-#
360−-- {-# INLINE[0] isSingleton #-}
360+ RULES "STREAM map/map fusion" forall f g s.
361−
361+ map f (map g s) = map (\x -> f (g x)) s
362−-- -- ----------------------------------------------------------------------------
362+ #-}
363−-- -- * Stream transformations
363+
364−
364+data I s = I1 !s
365−-- -- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@
365+ | I2 !s {-# UNPACK #-} !Char
366−-- -- to each element of @xs@.
366+ | I3 !s
367−-- map :: (Char -> Char) -> Stream Char -> Stream Char
367+
368−-- -- map f (Stream next0 s0 len) = Stream next s0 len
368+-- | /O(n)/ Take a character and place it between each of the
369−-- map f (Stream next0 s0) = Stream next s0 -- len
369+-- characters of a 'Stream Char'.
370−-- where
370+intersperse :: Char -> Stream Char -> Stream Char
371−-- next !s = case next0 s of
371+intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len
372−-- Done -> Done
372+ where
373−-- Skip s' -> Skip s'
373+ next (I1 s) = case next0 s of
374−-- Yield x s' -> Yield (f x) s'
374+ Done -> Done
375−-- {-# INLINE [0] map #-}
375+ Skip s' -> Skip (I1 s')
376−
376+ Yield x s' -> Skip (I2 s' x)
377−-- {-#
377+ next (I2 s x) = Yield x (I3 s)
378−-- RULES "STREAM map/map fusion" forall f g s.
378+ next (I3 s) = case next0 s of
379−-- map f (map g s) = map (\x -> f (g x)) s
379+ Done -> Done
380−-- #-}
380+ Skip s' -> Skip (I3 s')
381−
381+ Yield x s' -> Yield c (I2 s' x)
382−-- data I s = I1 !s
382+{-# INLINE [0] intersperse #-}
383−-- | I2 !s {-# UNPACK #-} !Char
383+
384−-- | I3 !s
384+-- ----------------------------------------------------------------------------
385−
385+-- ** Case conversions (folds)
386−-- -- | /O(n)/ Take a character and place it between each of the
386+
387−-- -- characters of a 'Stream Char'.
387+-- $case
388−-- intersperse :: Char -> Stream Char -> Stream Char
388+--
389−-- intersperse c (Stream next0 s0) = Stream next (I1 s0) -- len
389+-- With Unicode text, it is incorrect to use combinators like @map
390−-- -- intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len
390+-- toUpper@ to case convert each character of a string individually.
391−-- where
391+-- Instead, use the whole-string case conversion functions from this
392−-- next (I1 s) = case next0 s of
392+-- module. For correctness in different writing systems, these
393−-- Done -> Done
393+-- functions may map one input character to two or three output
394−-- Skip s' -> Skip (I1 s')
394+-- characters.
395−-- Yield x s' -> Skip (I2 s' x)
395+
396−-- next (I2 s x) = Yield x (I3 s)
396+caseConvert :: (forall s. Char -> s -> Step (CC s) Char)
397−-- next (I3 s) = case next0 s of
397+ -> Stream Char -> Stream Char
398−-- Done -> Done
398+caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len
399−-- Skip s' -> Skip (I3 s')
399+ where
400−-- Yield x s' -> Yield c (I2 s' x)
400+ next (CC s '\0' _) =
401−-- {-# INLINE [0] intersperse #-}
401+ case next0 s of
402−
402+ Done -> Done
403−-- -- ----------------------------------------------------------------------------
403+ Skip s' -> Skip (CC s' '\0' '\0')
404−-- -- ** Case conversions (folds)
404+ Yield c s' -> remap c s'
405−
405+ next (CC s a b) = Yield a (CC s b '\0')
406−-- -- $case
406+
407−-- --
407+-- | /O(n)/ Convert a string to folded case. This function is mainly
408−-- -- With Unicode text, it is incorrect to use combinators like @map
408+-- useful for performing caseless (or case insensitive) string
409−-- -- toUpper@ to case convert each character of a string individually.
409+-- comparisons.
410−-- -- Instead, use the whole-string case conversion functions from this
410+--
411−-- -- module. For correctness in different writing systems, these
411+-- A string @x@ is a caseless match for a string @y@ if and only if:
412−-- -- functions may map one input character to two or three output
412+--
413−-- -- characters.
413+-- @toCaseFold x == toCaseFold y@
414−
414+--
415−-- caseConvert :: (forall s. Char -> s -> Step (CC s) Char)
415+-- The result string may be longer than the input string, and may
416−-- -> Stream Char -> Stream Char
416+-- differ from applying 'toLower' to the input string. For instance,
417−-- -- caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len
417+-- the Armenian small ligature men now (U+FB13) is case folded to the
418−-- caseConvert remap (Stream next0 s0) = Stream next (CC s0 '\0' '\0') -- len
418+-- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is
419−-- where
419+-- case folded to the Greek small letter letter mu (U+03BC) instead of
420−-- next (CC s '\0' _) =
420+-- itself.
421−-- case next0 s of
421+toCaseFold :: Stream Char -> Stream Char
422−-- Done -> Done
422+toCaseFold = caseConvert foldMapping
423−-- Skip s' -> Skip (CC s' '\0' '\0')
423+{-# INLINE [0] toCaseFold #-}
424−-- Yield c s' -> remap c s'
424+
425−-- next (CC s a b) = Yield a (CC s b '\0')
425+-- | /O(n)/ Convert a string to upper case, using simple case
426−
426+-- conversion. The result string may be longer than the input string.
427−-- -- | /O(n)/ Convert a string to folded case. This function is mainly
427+-- For instance, the German eszett (U+00DF) maps to the two-letter
428−-- -- useful for performing caseless (or case insensitive) string
428+-- sequence SS.
429−-- -- comparisons.
429+toUpper :: Stream Char -> Stream Char
430−-- --
430+toUpper = caseConvert upperMapping
431−-- -- A string @x@ is a caseless match for a string @y@ if and only if:
431+{-# INLINE [0] toUpper #-}
432−-- --
432+
433−-- -- @toCaseFold x == toCaseFold y@
433+-- | /O(n)/ Convert a string to lower case, using simple case
434−-- --
434+-- conversion. The result string may be longer than the input string.
435−-- -- The result string may be longer than the input string, and may
435+-- For instance, the Latin capital letter I with dot above (U+0130)
436−-- -- differ from applying 'toLower' to the input string. For instance,
436+-- maps to the sequence Latin small letter i (U+0069) followed by
437−-- -- the Armenian small ligature men now (U+FB13) is case folded to the
437+-- combining dot above (U+0307).
438−-- -- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is
438+toLower :: Stream Char -> Stream Char
439−-- -- case folded to the Greek small letter letter mu (U+03BC) instead of
439+toLower = caseConvert lowerMapping
440−-- -- itself.
440+{-# INLINE [0] toLower #-}
441−-- toCaseFold :: Stream Char -> Stream Char
441+
442−-- toCaseFold = caseConvert foldMapping
442+-- | /O(n)/ Convert a string to title case, using simple case
443−-- {-# INLINE [0] toCaseFold #-}
443+-- conversion.
444−
444+--
445−-- -- | /O(n)/ Convert a string to upper case, using simple case
445+-- The first letter of the input is converted to title case, as is
446−-- -- conversion. The result string may be longer than the input string.
446+-- every subsequent letter that immediately follows a non-letter.
447−-- -- For instance, the German eszett (U+00DF) maps to the two-letter
447+-- Every letter that immediately follows another letter is converted
448−-- -- sequence SS.
448+-- to lower case.
449−-- toUpper :: Stream Char -> Stream Char
449+--
450−-- toUpper = caseConvert upperMapping
450+-- The result string may be longer than the input string. For example,
451−-- {-# INLINE [0] toUpper #-}
451+-- the Latin small ligature &#xfb02; (U+FB02) is converted to the
452−
452+-- sequence Latin capital letter F (U+0046) followed by Latin small
453−-- -- | /O(n)/ Convert a string to lower case, using simple case
453+-- letter l (U+006C).
454−-- -- conversion. The result string may be longer than the input string.
454+--
455−-- -- For instance, the Latin capital letter I with dot above (U+0130)
455+-- /Note/: this function does not take language or culture specific
456−-- -- maps to the sequence Latin small letter i (U+0069) followed by
456+-- rules into account. For instance, in English, different style
457−-- -- combining dot above (U+0307).
457+-- guides disagree on whether the book name \"The Hill of the Red
458−-- toLower :: Stream Char -> Stream Char
458+-- Fox\" is correctly title cased&#x2014;but this function will
459−-- toLower = caseConvert lowerMapping
459+-- capitalize /every/ word.
460−-- {-# INLINE [0] toLower #-}
460+toTitle :: Stream Char -> Stream Char
461−
461+toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len
462−-- -- | /O(n)/ Convert a string to title case, using simple case
462+ where
463−-- -- conversion.
463+ next (CC (letter :*: s) '\0' _) =
464−-- --
464+ case next0 s of
465−-- -- The first letter of the input is converted to title case, as is
465+ Done -> Done
466−-- -- every subsequent letter that immediately follows a non-letter.
466+ Skip s' -> Skip (CC (letter :*: s') '\0' '\0')
467−-- -- Every letter that immediately follows another letter is converted
467+ Yield c s'
468−-- -- to lower case.
468+ | letter' -> if letter
469−-- --
469+ then lowerMapping c (letter' :*: s')
470−-- -- The result string may be longer than the input string. For example,
470+ else titleMapping c (letter' :*: s')
471−-- -- the Latin small ligature &#xfb02; (U+FB02) is converted to the
471+ | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')
472−-- -- sequence Latin capital letter F (U+0046) followed by Latin small
472+ where letter' = isLetter c
473−-- -- letter l (U+006C).
473+ next (CC s a b) = Yield a (CC s b '\0')
474−-- --
474+{-# INLINE [0] toTitle #-}
475−-- -- /Note/: this function does not take language or culture specific
475+
476−-- -- rules into account. For instance, in English, different style
476+data Justify i s = Just1 !i !s
477−-- -- guides disagree on whether the book name \"The Hill of the Red
477+ | Just2 !i !s
478−-- -- Fox\" is correctly title cased&#x2014;but this function will
478+
479−-- -- capitalize /every/ word.
479+justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
480−-- toTitle :: Stream Char -> Stream Char
480+justifyLeftI k c (Stream next0 s0 len) =
481−-- -- toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len
481+ Stream next (Just1 0 s0) (larger (fromIntegral k) len)
482−-- toTitle (Stream next0 s0) = Stream next (CC (False :*: s0) '\0' '\0') -- len
482+ where
483−-- where
483+ next (Just1 n s) =
484−-- next (CC (letter :*: s) '\0' _) =
484+ case next0 s of
485−-- case next0 s of
485+ Done -> next (Just2 n s)
486−-- Done -> Done
486+ Skip s' -> Skip (Just1 n s')
487−-- Skip s' -> Skip (CC (letter :*: s') '\0' '\0')
487+ Yield x s' -> Yield x (Just1 (n+1) s')
488−-- Yield c s'
488+ next (Just2 n s)
489−-- | letter' -> if letter
489+ | n < k = Yield c (Just2 (n+1) s)
490−-- then lowerMapping c (letter' :*: s')
490+ | otherwise = Done
491−-- else titleMapping c (letter' :*: s')
491+ {-# INLINE next #-}
492−-- | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')
492+{-# INLINE [0] justifyLeftI #-}
493−-- where letter' = isLetter c
493+
494−-- next (CC s a b) = Yield a (CC s b '\0')
494+-- ----------------------------------------------------------------------------
495−-- {-# INLINE [0] toTitle #-}
495+-- * Reducing Streams (folds)
496−
496+
497−-- data Justify i s = Just1 !i !s
497+-- | foldl, applied to a binary operator, a starting value (typically the
498−-- | Just2 !i !s
498+-- left-identity of the operator), and a Stream, reduces the Stream using the
499−
499+-- binary operator, from left to right.
500−-- justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
500+foldl :: (b -> Char -> b) -> b -> Stream Char -> b
501−-- -- justifyLeftI k c (Stream next0 s0 len) =
501+foldl f z0 (Stream next s0 _len) = loop_foldl z0 s0
502−-- justifyLeftI k c (Stream next0 s0) =
502+ where
503−-- Stream next (Just1 0 s0) -- (larger (fromIntegral k) len)
503+ loop_foldl z !s = case next s of
504−-- where
504+ Done -> z
505−-- next (Just1 n s) =
505+ Skip s' -> loop_foldl z s'
506−-- case next0 s of
506+ Yield x s' -> loop_foldl (f z x) s'
507−-- Done -> next (Just2 n s)
507+{-# INLINE [0] foldl #-}
508−-- Skip s' -> Skip (Just1 n s')
508+
509−-- Yield x s' -> Yield x (Just1 (n+1) s')
509+-- | A strict version of foldl.
510−-- next (Just2 n s)
510+foldl' :: (b -> Char -> b) -> b -> Stream Char -> b
511−-- | n < k = Yield c (Just2 (n+1) s)
511+foldl' f z0 (Stream next s0 _len) = loop_foldl' z0 s0
512−-- | otherwise = Done
512+ where
513−-- {-# INLINE next #-}
513+ loop_foldl' !z !s = case next s of
514−-- {-# INLINE [0] justifyLeftI #-}
514+ Done -> z
515−
515+ Skip s' -> loop_foldl' z s'
516−-- -- ----------------------------------------------------------------------------
516+ Yield x s' -> loop_foldl' (f z x) s'
517−-- -- * Reducing Streams (folds)
517+{-# INLINE [0] foldl' #-}
518−
518+
519−-- -- | foldl, applied to a binary operator, a starting value (typically the
519+-- | foldl1 is a variant of foldl that has no starting value argument,
520−-- -- left-identity of the operator), and a Stream, reduces the Stream using the
520+-- and thus must be applied to non-empty Streams.
521−-- -- binary operator, from left to right.
521+foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char
522−-- foldl :: (b -> Char -> b) -> b -> Stream Char -> b
522+foldl1 f (Stream next s0 _len) = loop0_foldl1 s0
523−-- -- foldl f z0 (Stream next s0 _len) = loop_foldl z0 s0
523+ where
524−-- foldl f z0 (Stream next s0) = loop_foldl z0 s0
524+ loop0_foldl1 !s = case next s of
525−-- where
525+ Skip s' -> loop0_foldl1 s'
526−-- loop_foldl z !s = case next s of
526+ Yield x s' -> loop_foldl1 x s'
527−-- Done -> z
527+ Done -> emptyError "foldl1"
528−-- Skip s' -> loop_foldl z s'
528+ loop_foldl1 z !s = case next s of
529−-- Yield x s' -> loop_foldl (f z x) s'
529+ Done -> z
530−-- {-# INLINE [0] foldl #-}
530+ Skip s' -> loop_foldl1 z s'
531−
531+ Yield x s' -> loop_foldl1 (f z x) s'
532−-- -- | A strict version of foldl.
532+{-# INLINE [0] foldl1 #-}
533−-- foldl' :: (b -> Char -> b) -> b -> Stream Char -> b
533+
534−-- -- foldl' f z0 (Stream next s0 _len) = loop_foldl' z0 s0
534+-- | A strict version of foldl1.
535−-- foldl' f z0 (Stream next s0) = loop_foldl' z0 s0
535+foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char
536−-- where
536+foldl1' f (Stream next s0 _len) = loop0_foldl1' s0
537−-- loop_foldl' !z !s = case next s of
537+ where
538−-- Done -> z
538+ loop0_foldl1' !s = case next s of
539−-- Skip s' -> loop_foldl' z s'
539+ Skip s' -> loop0_foldl1' s'
540−-- Yield x s' -> loop_foldl' (f z x) s'
540+ Yield x s' -> loop_foldl1' x s'
541−-- {-# INLINE [0] foldl' #-}
541+ Done -> emptyError "foldl1"
542−
542+ loop_foldl1' !z !s = case next s of
543−-- -- | foldl1 is a variant of foldl that has no starting value argument,
543+ Done -> z
544−-- -- and thus must be applied to non-empty Streams.
544+ Skip s' -> loop_foldl1' z s'
545−-- foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char
545+ Yield x s' -> loop_foldl1' (f z x) s'
546−-- -- foldl1 f (Stream next s0 _len) = loop0_foldl1 s0
546+{-# INLINE [0] foldl1' #-}
547−-- foldl1 f (Stream next s0) = loop0_foldl1 s0
547+
548−-- where
548+-- | 'foldr', applied to a binary operator, a starting value (typically the
549−-- loop0_foldl1 !s = case next s of
549+-- right-identity of the operator), and a stream, reduces the stream using the
550−-- Skip s' -> loop0_foldl1 s'
550+-- binary operator, from right to left.
551−-- Yield x s' -> loop_foldl1 x s'
551+foldr :: (Char -> b -> b) -> b -> Stream Char -> b
552−-- Done -> emptyError "foldl1"
552+foldr f z (Stream next s0 _len) = loop_foldr s0
553−-- loop_foldl1 z !s = case next s of
553+ where
554−-- Done -> z
554+ loop_foldr !s = case next s of
555−-- Skip s' -> loop_foldl1 z s'
555+ Done -> z
556−-- Yield x s' -> loop_foldl1 (f z x) s'
556+ Skip s' -> loop_foldr s'
557−-- {-# INLINE [0] foldl1 #-}
557+ Yield x s' -> f x (loop_foldr s')
558−
558+{-# INLINE [0] foldr #-}
559−-- -- | A strict version of foldl1.
559+
560−-- foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char
560+-- | foldr1 is a variant of 'foldr' that has no starting value argument,
561−-- -- foldl1' f (Stream next s0 _len) = loop0_foldl1' s0
561+-- and thus must be applied to non-empty streams.
562−-- foldl1' f (Stream next s0) = loop0_foldl1' s0
562+-- Subject to array fusion.
563−-- where
563+foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char
564−-- loop0_foldl1' !s = case next s of
564+foldr1 f (Stream next s0 _len) = loop0_foldr1 s0
565−-- Skip s' -> loop0_foldl1' s'
565+ where
566−-- Yield x s' -> loop_foldl1' x s'
566+ loop0_foldr1 !s = case next s of
567−-- Done -> emptyError "foldl1"
567+ Done -> emptyError "foldr1"
568−-- loop_foldl1' !z !s = case next s of
568+ Skip s' -> loop0_foldr1 s'
569−-- Done -> z
569+ Yield x s' -> loop_foldr1 x s'
570−-- Skip s' -> loop_foldl1' z s'
570+
571−-- Yield x s' -> loop_foldl1' (f z x) s'
571+ loop_foldr1 x !s = case next s of
572−-- {-# INLINE [0] foldl1' #-}
572+ Done -> x
573−
573+ Skip s' -> loop_foldr1 x s'
574−-- -- | 'foldr', applied to a binary operator, a starting value (typically the
574+ Yield x' s' -> f x (loop_foldr1 x' s')
575−-- -- right-identity of the operator), and a stream, reduces the stream using the
575+{-# INLINE [0] foldr1 #-}
576−-- -- binary operator, from right to left.
576+
577−-- foldr :: (Char -> b -> b) -> b -> Stream Char -> b
577+intercalate :: Stream Char -> [Stream Char] -> Stream Char
578−-- -- foldr f z (Stream next s0 _len) = loop_foldr s0
578+intercalate s = concat . (L.intersperse s)
579−-- foldr f z (Stream next s0) = loop_foldr s0
579+{-# INLINE [0] intercalate #-}
580−-- where
580+
581−-- loop_foldr !s = case next s of
581+-- ----------------------------------------------------------------------------
582−-- Done -> z
582+-- ** Special folds
583−-- Skip s' -> loop_foldr s'
583+
584−-- Yield x s' -> f x (loop_foldr s')
584+-- | /O(n)/ Concatenate a list of streams. Subject to array fusion.
585−-- {-# INLINE [0] foldr #-}
585+concat :: [Stream Char] -> Stream Char
586−
586+concat = L.foldr append empty
587−-- -- | foldr1 is a variant of 'foldr' that has no starting value argument,
587+{-# INLINE [0] concat #-}
588−-- -- and thus must be applied to non-empty streams.
588+
589−-- -- Subject to array fusion.
589+-- | Map a function over a stream that results in a stream and concatenate the
590−-- foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char
590+-- results.
591−-- -- foldr1 f (Stream next s0 _len) = loop0_foldr1 s0
591+concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char
592−-- foldr1 f (Stream next s0) = loop0_foldr1 s0
592+concatMap f = foldr (append . f) empty
593−-- where
593+{-# INLINE [0] concatMap #-}
594−-- loop0_foldr1 !s = case next s of
594+
595−-- Done -> emptyError "foldr1"
595+-- | /O(n)/ any @p @xs determines if any character in the stream
596−-- Skip s' -> loop0_foldr1 s'
596+-- @xs@ satisfies the predicate @p@.
597−-- Yield x s' -> loop_foldr1 x s'
597+any :: (Char -> Bool) -> Stream Char -> Bool
598−
598+any p (Stream next0 s0 _len) = loop_any s0
599−-- loop_foldr1 x !s = case next s of
599+ where
600−-- Done -> x
600+ loop_any !s = case next0 s of
601−-- Skip s' -> loop_foldr1 x s'
601+ Done -> False
602−-- Yield x' s' -> f x (loop_foldr1 x' s')
602+ Skip s' -> loop_any s'
603−-- {-# INLINE [0] foldr1 #-}
603+ Yield x s' | p x -> True
604−
604+ | otherwise -> loop_any s'
605−-- intercalate :: Stream Char -> [Stream Char] -> Stream Char
605+{-# INLINE [0] any #-}
606−-- intercalate s = concat . (L.intersperse s)
606+
607−-- {-# INLINE [0] intercalate #-}
607+-- | /O(n)/ all @p @xs determines if all characters in the 'Text'
608−
608+-- @xs@ satisfy the predicate @p@.
609−-- -- ----------------------------------------------------------------------------
609+all :: (Char -> Bool) -> Stream Char -> Bool
610−-- -- ** Special folds
610+all p (Stream next0 s0 _len) = loop_all s0
611−
611+ where
612−-- -- | /O(n)/ Concatenate a list of streams. Subject to array fusion.
612+ loop_all !s = case next0 s of
613−-- concat :: [Stream Char] -> Stream Char
613+ Done -> True
614−-- concat = L.foldr append empty
614+ Skip s' -> loop_all s'
615−-- {-# INLINE [0] concat #-}
615+ Yield x s' | p x -> loop_all s'
616−
616+ | otherwise -> False
617−-- -- | Map a function over a stream that results in a stream and concatenate the
617+{-# INLINE [0] all #-}
618−-- -- results.
618+
619−-- concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char
619+-- | /O(n)/ maximum returns the maximum value from a stream, which must be
620−-- concatMap f = foldr (append . f) empty
620+-- non-empty.
621−-- {-# INLINE [0] concatMap #-}
621+maximum :: Stream Char -> Char
622−
622+maximum (Stream next0 s0 _len) = loop0_maximum s0
623−-- -- | /O(n)/ any @p @xs determines if any character in the stream
623+ where
624−-- -- @xs@ satisfies the predicate @p@.
624+ loop0_maximum !s = case next0 s of
625−-- any :: (Char -> Bool) -> Stream Char -> Bool
625+ Done -> emptyError "maximum"
626−-- -- any p (Stream next0 s0 _len) = loop_any s0
626+ Skip s' -> loop0_maximum s'
627−-- any p (Stream next0 s0) = loop_any s0
627+ Yield x s' -> loop_maximum x s'
628−-- where
628+ loop_maximum !z !s = case next0 s of
629−-- loop_any !s = case next0 s of
629+ Done -> z
630−-- Done -> False
630+ Skip s' -> loop_maximum z s'
631−-- Skip s' -> loop_any s'
631+ Yield x s'
632−-- Yield x s' | p x -> True
632+ | x > z -> loop_maximum x s'
633−-- | otherwise -> loop_any s'
633+ | otherwise -> loop_maximum z s'
634−-- {-# INLINE [0] any #-}
634+{-# INLINE [0] maximum #-}
635−
635+
636−-- -- | /O(n)/ all @p @xs determines if all characters in the 'Text'
636+-- | /O(n)/ minimum returns the minimum value from a 'Text', which must be
637−-- -- @xs@ satisfy the predicate @p@.
637+-- non-empty.
638−-- all :: (Char -> Bool) -> Stream Char -> Bool
638+minimum :: Stream Char -> Char
639−-- -- all p (Stream next0 s0 _len) = loop_all s0
639+minimum (Stream next0 s0 _len) = loop0_minimum s0
640−-- all p (Stream next0 s0) = loop_all s0
640+ where
641−-- where
641+ loop0_minimum !s = case next0 s of
642−-- loop_all !s = case next0 s of
642+ Done -> emptyError "minimum"
643−-- Done -> True
643+ Skip s' -> loop0_minimum s'
644−-- Skip s' -> loop_all s'
644+ Yield x s' -> loop_minimum x s'
645−-- Yield x s' | p x -> loop_all s'
645+ loop_minimum !z !s = case next0 s of
646−-- | otherwise -> False
646+ Done -> z
647−-- {-# INLINE [0] all #-}
647+ Skip s' -> loop_minimum z s'
648−
648+ Yield x s'
649−-- -- | /O(n)/ maximum returns the maximum value from a stream, which must be
649+ | x < z -> loop_minimum x s'
650−-- -- non-empty.
650+ | otherwise -> loop_minimum z s'
651−-- maximum :: Stream Char -> Char
651+{-# INLINE [0] minimum #-}
652−-- -- maximum (Stream next0 s0 _len) = loop0_maximum s0
652+
653−-- maximum (Stream next0 s0) = loop0_maximum s0
653+-- -----------------------------------------------------------------------------
654−-- where
654+-- * Building streams
655−-- loop0_maximum !s = case next0 s of
655+
656−-- Done -> emptyError "maximum"
656+scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
657−-- Skip s' -> loop0_maximum s'
657+scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
658−-- Yield x s' -> loop_maximum x s'
658+ where
659−-- loop_maximum !z !s = case next0 s of
659+ {-# INLINE next #-}
660−-- Done -> z
660+ next (Scan1 z s) = Yield z (Scan2 z s)
661−-- Skip s' -> loop_maximum z s'
661+ next (Scan2 z s) = case next0 s of
662−-- Yield x s'
662+ Yield x s' -> let !x' = f z x
663−-- | x > z -> loop_maximum x s'
663+ in Yield x' (Scan2 x' s')
664−-- | otherwise -> loop_maximum z s'
664+ Skip s' -> Skip (Scan2 z s')
665−-- {-# INLINE [0] maximum #-}
665+ Done -> Done
666−
666+{-# INLINE [0] scanl #-}
667−-- -- | /O(n)/ minimum returns the minimum value from a 'Text', which must be
667+
668−-- -- non-empty.
668+-- -----------------------------------------------------------------------------
669−-- minimum :: Stream Char -> Char
669+-- ** Generating and unfolding streams
670−-- -- minimum (Stream next0 s0 _len) = loop0_minimum s0
670+
671−-- minimum (Stream next0 s0) = loop0_minimum s0
671+replicateCharI :: Integral a => a -> Char -> Stream Char
672−-- where
672+replicateCharI !n !c
673−-- loop0_minimum !s = case next0 s of
673+ | n < 0 = empty
674−-- Done -> emptyError "minimum"
674+ | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
675−-- Skip s' -> loop0_minimum s'
675+ where
676−-- Yield x s' -> loop_minimum x s'
676+ next !i | i >= n = Done
677−-- loop_minimum !z !s = case next0 s of
677+ | otherwise = Yield c (i + 1)
678−-- Done -> z
678+{-# INLINE [0] replicateCharI #-}
679−-- Skip s' -> loop_minimum z s'
679+
680−-- Yield x s'
680+data RI s = RI !s {-# UNPACK #-} !Int64
681−-- | x < z -> loop_minimum x s'
681+
682−-- | otherwise -> loop_minimum z s'
682+replicateI :: Int64 -> Stream Char -> Stream Char
683−-- {-# INLINE [0] minimum #-}
683+replicateI n (Stream next0 s0 len) =
684−
684+ Stream next (RI s0 0) (fromIntegral (max 0 n) * len)
685−-- -- -----------------------------------------------------------------------------
685+ where
686−-- -- * Building streams
686+ next (RI s k)
687−
687+ | k >= n = Done
688−-- scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
688+ | otherwise = case next0 s of
689−-- -- scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
689+ Done -> Skip (RI s0 (k+1))
690−-- scanl f z0 (Stream next0 s0) = Stream next (Scan1 z0 s0) -- (len+1) -- HINT maybe too low
690+ Skip s' -> Skip (RI s' k)
691−-- where
691+ Yield x s' -> Yield x (RI s' k)
692−-- {-# INLINE next #-}
692+{-# INLINE [0] replicateI #-}
693−-- next (Scan1 z s) = Yield z (Scan2 z s)
693+
694−-- next (Scan2 z s) = case next0 s of
694+-- | /O(n)/, where @n@ is the length of the result. The unfoldr function
695−-- Yield x s' -> let !x' = f z x
695+-- is analogous to the List 'unfoldr'. unfoldr builds a stream
696−-- in Yield x' (Scan2 x' s')
696+-- from a seed value. The function takes the element and returns
697−-- Skip s' -> Skip (Scan2 z s')
697+-- Nothing if it is done producing the stream or returns Just
698−-- Done -> Done
698+-- (a,b), in which case, a is the next Char in the string, and b is
699−-- {-# INLINE [0] scanl #-}
699+-- the seed value for further production.
700−
700+unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char
701−-- -- -----------------------------------------------------------------------------
701+unfoldr f s0 = Stream next s0 1 -- HINT maybe too low
702−-- -- ** Generating and unfolding streams
702+ where
703−
703+ {-# INLINE next #-}
704−-- replicateCharI :: Integral a => a -> Char -> Stream Char
704+ next !s = case f s of
705−-- replicateCharI n c
705+ Nothing -> Done
706−-- | n < 0 = empty
706+ Just (w, s') -> Yield w s'
707−-- | otherwise = Stream next 0 -- (fromIntegral n) -- HINT maybe too low
707+{-# INLINE [0] unfoldr #-}
708−-- where
708+
709−-- next i | i >= n = Done
709+-- | /O(n)/ Like 'unfoldr', 'unfoldrNI' builds a stream from a seed
710−-- | otherwise = Yield c (i + 1)
710+-- value. However, the length of the result is limited by the
711−-- {-# INLINE [0] replicateCharI #-}
711+-- first argument to 'unfoldrNI'. This function is more efficient than
712−
712+-- 'unfoldr' when the length of the result is known.
713−-- data RI s = RI !s {-# UNPACK #-} !Int64
713+unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char
714−
714+unfoldrNI n f s0 | n < 0 = empty
715−-- replicateI :: Int64 -> Stream Char -> Stream Char
715+ | otherwise = Stream next (0 :*: s0) (fromIntegral (n*2)) -- HINT maybe too high
716−-- -- replicateI n (Stream next0 s0 len) =
716+ where
717−-- replicateI n (Stream next0 s0) =
717+ {-# INLINE next #-}
718−-- Stream next (RI s0 0) -- (fromIntegral (max 0 n) * len)
718+ next (z :*: s) = case f s of
719−-- where
719+ Nothing -> Done
720−-- next (RI s k)
720+ Just (w, s') | z >= n -> Done
721−-- | k >= n = Done
721+ | otherwise -> Yield w ((z + 1) :*: s')
722−-- | otherwise = case next0 s of
722+{-# INLINE unfoldrNI #-}
723−-- Done -> Skip (RI s0 (k+1))
723+
724−-- Skip s' -> Skip (RI s' k)
724+-------------------------------------------------------------------------------
725−-- Yield x s' -> Yield x (RI s' k)
725+-- * Substreams
726−-- {-# INLINE [0] replicateI #-}
726+
727−
727+-- | /O(n)/ take n, applied to a stream, returns the prefix of the
728−-- -- | /O(n)/, where @n@ is the length of the result. The unfoldr function
728+-- stream of length @n@, or the stream itself if @n@ is greater than the
729−-- -- is analogous to the List 'unfoldr'. unfoldr builds a stream
729+-- length of the stream.
730−-- -- from a seed value. The function takes the element and returns
730+take :: Integral a => a -> Stream Char -> Stream Char
731−-- -- Nothing if it is done producing the stream or returns Just
731+take n0 (Stream next0 s0 len) =
732−-- -- (a,b), in which case, a is the next Char in the string, and b is
732+ Stream next (n0 :*: s0) (smaller len (fromIntegral (max 0 n0)))
733−-- -- the seed value for further production.
733+ where
734−-- unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char
734+ {-# INLINE next #-}
735−-- unfoldr f s0 = Stream next s0 -- 1 -- HINT maybe too low
735+ next (n :*: s) | n <= 0 = Done
736−-- where
736+ | otherwise = case next0 s of
737−-- {-# INLINE next #-}
737+ Done -> Done
738−-- next !s = case f s of
738+ Skip s' -> Skip (n :*: s')
739−-- Nothing -> Done
739+ Yield x s' -> Yield x ((n-1) :*: s')
740−-- Just (w, s') -> Yield w s'
740+{-# INLINE [0] take #-}
741−-- {-# INLINE [0] unfoldr #-}
741+
742−
742+data Drop a s = NS !s
743−-- -- | /O(n)/ Like 'unfoldr', 'unfoldrNI' builds a stream from a seed
743+ | JS !a !s
744−-- -- value. However, the length of the result is limited by the
744+
745−-- -- first argument to 'unfoldrNI'. This function is more efficient than
745+-- | /O(n)/ drop n, applied to a stream, returns the suffix of the
746−-- -- 'unfoldr' when the length of the result is known.
746+-- stream after the first @n@ characters, or the empty stream if @n@
747−-- unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char
747+-- is greater than the length of the stream.
748−-- unfoldrNI n f s0 | n < 0 = empty
748+drop :: Integral a => a -> Stream Char -> Stream Char
749−-- | otherwise = Stream next (0 :*: s0) -- (fromIntegral (n*2)) -- HINT maybe too high
749+drop n0 (Stream next0 s0 len) =
750−-- where
750+ Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))
751−-- {-# INLINE next #-}
751+ where
752−-- next (z :*: s) = case f s of
752+ {-# INLINE next #-}
753−-- Nothing -> Done
753+ next (JS n s)
754−-- Just (w, s') | z >= n -> Done
754+ | n <= 0 = Skip (NS s)
755−-- | otherwise -> Yield w ((z + 1) :*: s')
755+ | otherwise = case next0 s of
756−-- {-# INLINE unfoldrNI #-}
756+ Done -> Done
757−
757+ Skip s' -> Skip (JS n s')
758−-- -------------------------------------------------------------------------------
758+ Yield _ s' -> Skip (JS (n-1) s')
759−-- -- * Substreams
759+ next (NS s) = case next0 s of
760−
760+ Done -> Done
761−-- -- | /O(n)/ take n, applied to a stream, returns the prefix of the
761+ Skip s' -> Skip (NS s')
762−-- -- stream of length @n@, or the stream itself if @n@ is greater than the
762+ Yield x s' -> Yield x (NS s')
763−-- -- length of the stream.
763+{-# INLINE [0] drop #-}
764−-- take :: Integral a => a -> Stream Char -> Stream Char
764+
765−-- take n0 (Stream next0 s0) =
765+-- | takeWhile, applied to a predicate @p@ and a stream, returns the
766−-- -- take n0 (Stream next0 s0 len) =
766+-- longest prefix (possibly empty) of elements that satisfy p.
767−-- Stream next (n0 :*: s0) -- (smaller len (fromIntegral (max 0 n0)))
767+takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char
768−-- where
768+takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
769−-- {-# INLINE next #-}
769+ where
770−-- next (n :*: s) | n <= 0 = Done
770+ {-# INLINE next #-}
771−-- | otherwise = case next0 s of
771+ next !s = case next0 s of
772−-- Done -> Done
772+ Done -> Done
773−-- Skip s' -> Skip (n :*: s')
773+ Skip s' -> Skip s'
774−-- Yield x s' -> Yield x ((n-1) :*: s')
774+ Yield x s' | p x -> Yield x s'
775−-- {-# INLINE [0] take #-}
775+ | otherwise -> Done
776−
776+{-# INLINE [0] takeWhile #-}
777−-- data Drop a s = NS !s
777+
778−-- | JS !a !s
778+-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
779−
779+dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
780−-- -- | /O(n)/ drop n, applied to a stream, returns the suffix of the
780+dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
781−-- -- stream after the first @n@ characters, or the empty stream if @n@
781+ where
782−-- -- is greater than the length of the stream.
782+ {-# INLINE next #-}
783−-- drop :: Integral a => a -> Stream Char -> Stream Char
783+ next (L s) = case next0 s of
784−-- -- drop n0 (Stream next0 s0 len) =
784+ Done -> Done
785−-- drop n0 (Stream next0 s0) =
785+ Skip s' -> Skip (L s')
786−-- Stream next (JS n0 s0) -- (len - fromIntegral (max 0 n0))
786+ Yield x s' | p x -> Skip (L s')
787−-- where
787+ | otherwise -> Yield x (R s')
788−-- {-# INLINE next #-}
788+ next (R s) = case next0 s of
789−-- next (JS n s)
789+ Done -> Done
790−-- | n <= 0 = Skip (NS s)
790+ Skip s' -> Skip (R s')
791−-- | otherwise = case next0 s of
791+ Yield x s' -> Yield x (R s')
792−-- Done -> Done
792+{-# INLINE [0] dropWhile #-}
793−-- Skip s' -> Skip (JS n s')
793+
794−-- Yield _ s' -> Skip (JS (n-1) s')
794+-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
795−-- next (NS s) = case next0 s of
795+-- 'True' iff the first is a prefix of the second.
796−-- Done -> Done
796+isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool
797−-- Skip s' -> Skip (NS s')
797+isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
798−-- Yield x s' -> Yield x (NS s')
798+ where
799−-- {-# INLINE [0] drop #-}
799+ loop Done _ = True
800−
800+ loop _ Done = False
801−-- -- | takeWhile, applied to a predicate @p@ and a stream, returns the
801+ loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
802−-- -- longest prefix (possibly empty) of elements that satisfy p.
802+ loop (Skip s1') x2 = loop (next1 s1') x2
803−-- takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char
803+ loop x1 (Skip s2') = loop x1 (next2 s2')
804−-- -- takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
804+ loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
805−-- takeWhile p (Stream next0 s0) = Stream next s0 -- len -- HINT maybe too high
805+ loop (next1 s1') (next2 s2')
806−-- where
806+{-# INLINE [0] isPrefixOf #-}
807−-- {-# INLINE next #-}
807+
808−-- next !s = case next0 s of
808+-- ----------------------------------------------------------------------------
809−-- Done -> Done
809+-- * Searching
810−-- Skip s' -> Skip s'
810+
811−-- Yield x s' | p x -> Yield x s'
811+-------------------------------------------------------------------------------
812−-- | otherwise -> Done
812+-- ** Searching by equality
813−-- {-# INLINE [0] takeWhile #-}
813+
814−
814+-- | /O(n)/ elem is the stream membership predicate.
815−-- -- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
815+elem :: Char -> Stream Char -> Bool
816−-- dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
816+elem w (Stream next s0 _len) = loop_elem s0
817−-- -- dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
817+ where
818−-- dropWhile p (Stream next0 s0) = Stream next (L s0) -- len -- HINT maybe too high
818+ loop_elem !s = case next s of
819−-- where
819+ Done -> False
820−-- {-# INLINE next #-}
820+ Skip s' -> loop_elem s'
821−-- next (L s) = case next0 s of
821+ Yield x s' | x == w -> True
822−-- Done -> Done
822+ | otherwise -> loop_elem s'
823−-- Skip s' -> Skip (L s')
823+{-# INLINE [0] elem #-}
824−-- Yield x s' | p x -> Skip (L s')
824+
825−-- | otherwise -> Yield x (R s')
825+-------------------------------------------------------------------------------
826−-- next (R s) = case next0 s of
826+-- ** Searching with a predicate
827−-- Done -> Done
827+
828−-- Skip s' -> Skip (R s')
828+-- | /O(n)/ The 'findBy' function takes a predicate and a stream,
829−-- Yield x s' -> Yield x (R s')
829+-- and returns the first element in matching the predicate, or 'Nothing'
830−-- {-# INLINE [0] dropWhile #-}
830+-- if there is no such element.
831−
831+
832−-- -- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
832+findBy :: (Char -> Bool) -> Stream Char -> Maybe Char
833−-- -- 'True' iff the first is a prefix of the second.
833+findBy p (Stream next s0 _len) = loop_find s0
834−-- isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool
834+ where
835−-- -- isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
835+ loop_find !s = case next s of
836−-- isPrefixOf (Stream next1 s1) (Stream next2 s2) = loop (next1 s1) (next2 s2)
836+ Done -> Nothing
837−-- where
837+ Skip s' -> loop_find s'
838−-- loop Done _ = True
838+ Yield x s' | p x -> Just x
839−-- loop _ Done = False
839+ | otherwise -> loop_find s'
840−-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
840+{-# INLINE [0] findBy #-}
841−-- loop (Skip s1') x2 = loop (next1 s1') x2
841+
842−-- loop x1 (Skip s2') = loop x1 (next2 s2')
842+-- | /O(n)/ Stream index (subscript) operator, starting from 0.
843−-- loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
843+indexI :: Integral a => Stream Char -> a -> Char
844−-- loop (next1 s1') (next2 s2')
844+indexI (Stream next s0 _len) n0
845−-- {-# INLINE [0] isPrefixOf #-}
845+ | n0 < 0 = streamError "index" "Negative index"
846−
846+ | otherwise = loop_index n0 s0
847−-- -- ----------------------------------------------------------------------------
847+ where
848−-- -- * Searching
848+ loop_index !n !s = case next s of
849−
849+ Done -> streamError "index" "Index too large"
850−-- -------------------------------------------------------------------------------
850+ Skip s' -> loop_index n s'
851−-- -- ** Searching by equality
851+ Yield x s' | n == 0 -> x
852−
852+ | otherwise -> loop_index (n-1) s'
853−-- -- | /O(n)/ elem is the stream membership predicate.
853+{-# INLINE [0] indexI #-}
854−-- elem :: Char -> Stream Char -> Bool
854+
855−-- -- elem w (Stream next s0 _len) = loop_elem s0
855+-- | /O(n)/ 'filter', applied to a predicate and a stream,
856−-- elem w (Stream next s0) = loop_elem s0
856+-- returns a stream containing those characters that satisfy the
857−-- where
857+-- predicate.
858−-- loop_elem !s = case next s of
858+filter :: (Char -> Bool) -> Stream Char -> Stream Char
859−-- Done -> False
859+filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
860−-- Skip s' -> loop_elem s'
860+ where
861−-- Yield x s' | x == w -> True
861+ next !s = case next0 s of
862−-- | otherwise -> loop_elem s'
862+ Done -> Done
863−-- {-# INLINE [0] elem #-}
863+ Skip s' -> Skip s'
864−
864+ Yield x s' | p x -> Yield x s'
865−-- -------------------------------------------------------------------------------
865+ | otherwise -> Skip s'
866−-- -- ** Searching with a predicate
866+{-# INLINE [0] filter #-}
867−
867+
868−-- -- | /O(n)/ The 'findBy' function takes a predicate and a stream,
868+{-# RULES
869−-- -- and returns the first element in matching the predicate, or 'Nothing'
869+ "STREAM filter/filter fusion" forall p q s.
870−-- -- if there is no such element.
870+ filter p (filter q s) = filter (\x -> q x && p x) s
871−
871+ #-}
872−-- findBy :: (Char -> Bool) -> Stream Char -> Maybe Char
872+
873−-- -- findBy p (Stream next s0 _len) = loop_find s0
873+-- | The 'findIndexI' function takes a predicate and a stream and
874−-- findBy p (Stream next s0) = loop_find s0
874+-- returns the index of the first element in the stream satisfying the
875−-- where
875+-- predicate.
876−-- loop_find !s = case next s of
876+findIndexI :: Integral a => (Char -> Bool) -> Stream Char -> Maybe a
877−-- Done -> Nothing
877+findIndexI p s = case findIndicesI p s of
878−-- Skip s' -> loop_find s'
878+ (i:_) -> Just i
879−-- Yield x s' | p x -> Just x
879+ _ -> Nothing
880−-- | otherwise -> loop_find s'
880+{-# INLINE [0] findIndexI #-}
881−-- {-# INLINE [0] findBy #-}
881+
882−
882+-- | The 'findIndicesI' function takes a predicate and a stream and
883−-- -- | /O(n)/ Stream index (subscript) operator, starting from 0.
883+-- returns all indices of the elements in the stream satisfying the
884−-- indexI :: Integral a => Stream Char -> a -> Char
884+-- predicate.
885−-- -- indexI (Stream next s0 _len) n0
885+findIndicesI :: Integral a => (Char -> Bool) -> Stream Char -> [a]
886−-- indexI (Stream next s0) n0
886+findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0
887−-- | n0 < 0 = streamError "index" "Negative index"
887+ where
888−-- | otherwise = loop_index n0 s0
888+ loop_findIndex !i !s = case next s of
889−-- where
889+ Done -> []
890−-- loop_index !n !s = case next s of
890+ Skip s' -> loop_findIndex i s' -- hmm. not caught by QC
891−-- Done -> streamError "index" "Index too large"
891+ Yield x s' | p x -> i : loop_findIndex (i+1) s'
892−-- Skip s' -> loop_index n s'
892+ | otherwise -> loop_findIndex (i+1) s'
893−-- Yield x s' | n == 0 -> x
893+{-# INLINE [0] findIndicesI #-}
894−-- | otherwise -> loop_index (n-1) s'
894+
895−-- {-# INLINE [0] indexI #-}
895+-------------------------------------------------------------------------------
896−
896+-- * Zipping
897−-- -- | /O(n)/ 'filter', applied to a predicate and a stream,
897+
898−-- -- returns a stream containing those characters that satisfy the
898+-- | Strict triple.
899−-- -- predicate.
899+data Zip a b m = Z1 !a !b
900−-- filter :: (Char -> Bool) -> Stream Char -> Stream Char
900+ | Z2 !a !b !m
901−-- -- filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
901+
902−-- filter p (Stream next0 s0) = Stream next s0 -- len -- HINT maybe too high
902+-- | zipWith generalises 'zip' by zipping with the function given as
903−-- where
903+-- the first argument, instead of a tupling function.
904−-- next !s = case next0 s of
904+zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
905−-- Done -> Done
905+zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
906−-- Skip s' -> Skip s'
906+ Stream next (Z1 sa0 sb0) (smaller len1 len2)
907−-- Yield x s' | p x -> Yield x s'
907+ where
908−-- | otherwise -> Skip s'
908+ next (Z1 sa sb) = case next0 sa of
909−-- {-# INLINE [0] filter #-}
909+ Done -> Done
910−
910+ Skip sa' -> Skip (Z1 sa' sb)
911−-- {-# RULES
911+ Yield a sa' -> Skip (Z2 sa' sb a)
912−-- "STREAM filter/filter fusion" forall p q s.
912+
913−-- filter p (filter q s) = filter (\x -> q x && p x) s
913+ next (Z2 sa' sb a) = case next1 sb of
914−-- #-}
914+ Done -> Done
915−
915+ Skip sb' -> Skip (Z2 sa' sb' a)
916−-- -- | The 'findIndexI' function takes a predicate and a stream and
916+ Yield b sb' -> Yield (f a b) (Z1 sa' sb')
917−-- -- returns the index of the first element in the stream satisfying the
917+{-# INLINE [0] zipWith #-}
918−-- -- predicate.
918+
919−-- findIndexI :: Integral a => (Char -> Bool) -> Stream Char -> Maybe a
919+-- | /O(n)/ The 'countCharI' function returns the number of times the
920−-- findIndexI p s = case findIndicesI p s of
920+-- query element appears in the given stream.
921−-- (i:_) -> Just i
921+countCharI :: Integral a => Char -> Stream Char -> a
922−-- _ -> Nothing
922+countCharI a (Stream next s0 _len) = loop 0 s0
923−-- {-# INLINE [0] findIndexI #-}
923+ where
924−
924+ loop !i !s = case next s of
925−-- -- | The 'findIndicesI' function takes a predicate and a stream and
925+ Done -> i
926−-- -- returns all indices of the elements in the stream satisfying the
926+ Skip s' -> loop i s'
927−-- -- predicate.
927+ Yield x s' | a == x -> loop (i+1) s'
928−-- findIndicesI :: Integral a => (Char -> Bool) -> Stream Char -> [a]
928+ | otherwise -> loop i s'
929−-- -- findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0
929+{-# INLINE [0] countCharI #-}
930−-- findIndicesI p (Stream next s0) = loop_findIndex 0 s0
930+
931−-- where
931+streamError :: String -> String -> a
932−-- loop_findIndex !i !s = case next s of
932+streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg
933−-- Done -> []
933+
934−-- Skip s' -> loop_findIndex i s' -- hmm. not caught by QC
934+emptyError :: String -> a
935−-- Yield x s' | p x -> i : loop_findIndex (i+1) s'
935+emptyError func = internalError func "Empty input"
936−-- | otherwise -> loop_findIndex (i+1) s'
936+
937−-- {-# INLINE [0] findIndicesI #-}
937+internalError :: String -> a
938−
938+internalError func = streamError func "Internal error"
939−-- -------------------------------------------------------------------------------
940−-- -- * Zipping
941−
942−-- -- | Strict triple.
943−-- data Zip a b m = Z1 !a !b
944−-- | Z2 !a !b !m
945−
946−-- -- | zipWith generalises 'zip' by zipping with the function given as
947−-- -- the first argument, instead of a tupling function.
948−-- zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
949−-- -- zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
950−-- zipWith f (Stream next0 sa0) (Stream next1 sb0) =
951−-- Stream next (Z1 sa0 sb0) -- (smaller len1 len2)
952−-- where
953−-- next (Z1 sa sb) = case next0 sa of
954−-- Done -> Done
955−-- Skip sa' -> Skip (Z1 sa' sb)
956−-- Yield a sa' -> Skip (Z2 sa' sb a)
957−
958−-- next (Z2 sa' sb a) = case next1 sb of
959−-- Done -> Done
960−-- Skip sb' -> Skip (Z2 sa' sb' a)
961−-- Yield b sb' -> Yield (f a b) (Z1 sa' sb')
962−-- {-# INLINE [0] zipWith #-}
963−
964−-- -- | /O(n)/ The 'countCharI' function returns the number of times the
965−-- -- query element appears in the given stream.
966−-- countCharI :: Integral a => Char -> Stream Char -> a
967−-- -- countCharI a (Stream next s0 _len) = loop 0 s0
968−-- countCharI a (Stream next s0) = loop 0 s0
969−-- where
970−-- loop !i !s = case next s of
971−-- Done -> i
972−-- Skip s' -> loop i s'
973−-- Yield x s' | a == x -> loop (i+1) s'
974−-- | otherwise -> loop i s'
975−-- {-# INLINE [0] countCharI #-}
976−
977−-- streamError :: String -> String -> a
978−-- streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg
979−
980−-- emptyError :: String -> a
981−-- emptyError func = internalError func "Empty input"
982−
983−-- internalError :: String -> a
984−-- internalError func = streamError func "Internal error"
Data/Text/Internal/Fusion/Types.hs+99−102
@@ -19,107 +19,104 @@
19
19
20module Data.Text.Internal.Fusion.Types
20module Data.Text.Internal.Fusion.Types
21 (
21 (
22− -- CC(..)
22+ CC(..)
23− -- , PairS(..)
23+ , PairS(..)
24− -- , Scan(..)
24+ , Scan(..)
25− -- , RS(..)
25+ , RS(..)
26− -- , Step(..)
26+ , Step(..)
27− -- , Stream(..)
27+ , Stream(..)
28− -- , empty
28+ , empty
29− module Data.JSString.Internal.Fusion.Types
30 ) where
29 ) where
31
30
32−-- import Data.Text.Internal.Fusion.Size
31+import Data.Text.Internal.Fusion.Size
33−-- import Data.Word (Word8)
32+import Data.Word (Word8)
34−
33+
35−import Data.JSString.Internal.Fusion.Types
36−
37−-- -- | Specialised tuple for case conversion.
34+-- | Specialised tuple for case conversion.
38−-- data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char
35+data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char
39−
36+
40−-- -- | Restreaming state.
37+-- | Restreaming state.
41−-- data RS s
38+data RS s
42−-- = RS0 !s
39+ = RS0 !s
43−-- | RS1 !s {-# UNPACK #-} !Word8
40+ | RS1 !s {-# UNPACK #-} !Word8
44−-- | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
41+ | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
45−-- | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
42+ | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
46−
43+
47−-- -- | Strict pair.
44+-- | Strict pair.
48−-- data PairS a b = !a :*: !b
45+data PairS a b = !a :*: !b
49−-- -- deriving (Eq, Ord, Show)
46+ -- deriving (Eq, Ord, Show)
50−-- infixl 2 :*:
47+infixl 2 :*:
51−
48+
52−-- -- | An intermediate result in a scan.
49+-- | An intermediate result in a scan.
53−-- data Scan s = Scan1 {-# UNPACK #-} !Char !s
50+data Scan s = Scan1 {-# UNPACK #-} !Char !s
54−-- | Scan2 {-# UNPACK #-} !Char !s
51+ | Scan2 {-# UNPACK #-} !Char !s
55−
52+
56−-- -- | Intermediate result in a processing pipeline.
53+-- | Intermediate result in a processing pipeline.
57−-- data Step s a = Done
54+data Step s a = Done
58−-- | Skip !s
55+ | Skip !s
59−-- | Yield !a !s
56+ | Yield !a !s
60−
57+
61−-- {-
58+{-
62−-- instance (Show a) => Show (Step s a)
59+instance (Show a) => Show (Step s a)
63−-- where show Done = "Done"
60+ where show Done = "Done"
64−-- show (Skip _) = "Skip"
61+ show (Skip _) = "Skip"
65−-- show (Yield x _) = "Yield " ++ show x
62+ show (Yield x _) = "Yield " ++ show x
66−-- -}
63+-}
67−
64+
68−-- instance (Eq a) => Eq (Stream a) where
65+instance (Eq a) => Eq (Stream a) where
69−-- (==) = eq
66+ (==) = eq
70−
67+
71−-- instance (Ord a) => Ord (Stream a) where
68+instance (Ord a) => Ord (Stream a) where
72−-- compare = cmp
69+ compare = cmp
73−
70+
74−-- -- The length hint in a Stream has two roles. If its value is zero,
71+-- The length hint in a Stream has two roles. If its value is zero,
75−-- -- we trust it, and treat the stream as empty. Otherwise, we treat it
72+-- we trust it, and treat the stream as empty. Otherwise, we treat it
76−-- -- as a hint: it should usually be accurate, so we use it when
73+-- as a hint: it should usually be accurate, so we use it when
77−-- -- unstreaming to decide what size array to allocate. However, the
74+-- unstreaming to decide what size array to allocate. However, the
78−-- -- unstreaming functions must be able to cope with the hint being too
75+-- unstreaming functions must be able to cope with the hint being too
79−-- -- small or too large.
76+-- small or too large.
80−-- --
77+--
81−-- -- The size hint tries to track the UTF-16 code points in a stream,
78+-- The size hint tries to track the UTF-16 code points in a stream,
82−-- -- but often counts the number of characters instead. It can easily
79+-- but often counts the number of characters instead. It can easily
83−-- -- undercount if, for instance, a transformed stream contains astral
80+-- undercount if, for instance, a transformed stream contains astral
84−-- -- plane characters (those above 0x10000).
81+-- plane characters (those above 0x10000).
85−
82+
86−-- data Stream a =
83+data Stream a =
87−-- forall s. Stream
84+ forall s. Stream
88−-- (s -> Step s a) -- stepper function
85+ (s -> Step s a) -- stepper function
89−-- !s -- current state
86+ !s -- current state
90−-- !Size -- size hint
87+ !Size -- size hint
91−
88+
92−-- -- | /O(n)/ Determines if two streams are equal.
89+-- | /O(n)/ Determines if two streams are equal.
93−-- eq :: (Eq a) => Stream a -> Stream a -> Bool
90+eq :: (Eq a) => Stream a -> Stream a -> Bool
94−-- eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
91+eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
95−-- where
92+ where
96−-- loop Done Done = True
93+ loop Done Done = True
97−-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
94+ loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
98−-- loop (Skip s1') x2 = loop (next1 s1') x2
95+ loop (Skip s1') x2 = loop (next1 s1') x2
99−-- loop x1 (Skip s2') = loop x1 (next2 s2')
96+ loop x1 (Skip s2') = loop x1 (next2 s2')
100−-- loop Done _ = False
97+ loop Done _ = False
101−-- loop _ Done = False
98+ loop _ Done = False
102−-- loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
99+ loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
103−-- loop (next1 s1') (next2 s2')
100+ loop (next1 s1') (next2 s2')
104−-- {-# INLINE [0] eq #-}
101+{-# INLINE [0] eq #-}
105−
102+
106−-- cmp :: (Ord a) => Stream a -> Stream a -> Ordering
103+cmp :: (Ord a) => Stream a -> Stream a -> Ordering
107−-- cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
104+cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
108−-- where
105+ where
109−-- loop Done Done = EQ
106+ loop Done Done = EQ
110−-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
107+ loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
111−-- loop (Skip s1') x2 = loop (next1 s1') x2
108+ loop (Skip s1') x2 = loop (next1 s1') x2
112−-- loop x1 (Skip s2') = loop x1 (next2 s2')
109+ loop x1 (Skip s2') = loop x1 (next2 s2')
113−-- loop Done _ = LT
110+ loop Done _ = LT
114−-- loop _ Done = GT
111+ loop _ Done = GT
115−-- loop (Yield x1 s1') (Yield x2 s2') =
112+ loop (Yield x1 s1') (Yield x2 s2') =
116−-- case compare x1 x2 of
113+ case compare x1 x2 of
117−-- EQ -> loop (next1 s1') (next2 s2')
114+ EQ -> loop (next1 s1') (next2 s2')
118−-- other -> other
115+ other -> other
119−-- {-# INLINE [0] cmp #-}
116+{-# INLINE [0] cmp #-}
120−
117+
121−-- -- | The empty stream.
118+-- | The empty stream.
122−-- empty :: Stream a
119+empty :: Stream a
123−-- empty = Stream next () 0
120+empty = Stream next () 0
124−-- where next _ = Done
121+ where next _ = Done
125−-- {-# INLINE [0] empty #-}
122+{-# INLINE [0] empty #-}
Data/Text/Internal/IO.hs−8
@@ -95,11 +95,7 @@ unpack !buf !r !w
95 | r >= w = return T.empty
95 | r >= w = return T.empty
96 | otherwise = withRawBuffer buf go
96 | otherwise = withRawBuffer buf go
97 where
97 where
98−#ifndef __GHCJS__
99 go pbuf = return $! unstream (Stream next r (exactSize (w-r)))
98 go pbuf = return $! unstream (Stream next r (exactSize (w-r)))
100−#else
101− go pbuf = return $! unstream (Stream next r)
102−#endif
103 where
99 where
104 next !i | i >= w = Done
100 next !i | i >= w = Done
105 | otherwise = Yield (ix i) (i+1)
101 | otherwise = Yield (ix i) (i+1)
@@ -112,11 +108,7 @@ unpack_nl !buf !r !w
112 | otherwise = withRawBuffer buf $ go
108 | otherwise = withRawBuffer buf $ go
113 where
109 where
114 go pbuf = do
110 go pbuf = do
115−#ifndef __GHCJS__
116 let !t = unstream (Stream next r (maxSize (w-r)))
111 let !t = unstream (Stream next r (maxSize (w-r)))
117−#else
118− let !t = unstream (Stream next r)
119−#endif
120 w' = w - 1
112 w' = w - 1
121 return $ if ix w' == '\r'
113 return $ if ix w' == '\r'
122 then (t,w')
114 then (t,w')
Data/Text/Internal/Lazy.hs+10−18
@@ -44,10 +44,6 @@ import Data.Typeable (Typeable)
44import Foreign.Storable (sizeOf)
44import Foreign.Storable (sizeOf)
45import qualified Data.Text.Internal as T
45import qualified Data.Text.Internal as T
46
46
47−-- GHCJS
48−import qualified Data.Text as TT
49−--
50−
51data Text = Empty
47data Text = Empty
52 | Chunk {-# UNPACK #-} !T.Text Text
48 | Chunk {-# UNPACK #-} !T.Text Text
53 deriving (Typeable)
49 deriving (Typeable)
@@ -61,20 +57,18 @@ data Text = Empty
61-- | Check the invariant strictly.
57-- | Check the invariant strictly.
62strictInvariant :: Text -> Bool
58strictInvariant :: Text -> Bool
63strictInvariant Empty = True
59strictInvariant Empty = True
64−-- TODO only used for QuickCheck ?
65−-- strictInvariant x@(Chunk (T.Text _ _ len) cs)
60+strictInvariant x@(Chunk (T.Text _ _ len) cs)
66−-- | len > 0 = strictInvariant cs
61+ | len > 0 = strictInvariant cs
67−-- | otherwise = error $ "Data.Text.Lazy: invariant violation: "
62+ | otherwise = error $ "Data.Text.Lazy: invariant violation: "
68−-- ++ showStructure x
63+ ++ showStructure x
69
64
70-- | Check the invariant lazily.
65-- | Check the invariant lazily.
71lazyInvariant :: Text -> Text
66lazyInvariant :: Text -> Text
72lazyInvariant Empty = Empty
67lazyInvariant Empty = Empty
73−-- TODO only used for quickcheck
74−-- lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)
68+lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)
75−-- | len > 0 = Chunk c (lazyInvariant cs)
69+ | len > 0 = Chunk c (lazyInvariant cs)
76−-- | otherwise = error $ "Data.Text.Lazy: invariant violation: "
70+ | otherwise = error $ "Data.Text.Lazy: invariant violation: "
77−-- ++ showStructure x
71+ ++ showStructure x
78
72
79-- | Display the internal structure of a lazy 'Text'.
73-- | Display the internal structure of a lazy 'Text'.
80showStructure :: Text -> String
74showStructure :: Text -> String
@@ -86,10 +80,8 @@ showStructure (Chunk t ts) =
86-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.
80-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.
87chunk :: T.Text -> Text -> Text
81chunk :: T.Text -> Text -> Text
88{-# INLINE chunk #-}
82{-# INLINE chunk #-}
89−chunk t ts | TT.length t == 0 = ts
90− | otherwise = Chunk t ts
91−-- chunk t@(T.Text _ _ len) ts | len == 0 = ts
83+chunk t@(T.Text _ _ len) ts | len == 0 = ts
92−-- | otherwise = Chunk t ts
84+ | otherwise = Chunk t ts
93
85
94-- | Smart constructor for 'Empty'.
86-- | Smart constructor for 'Empty'.
95empty :: Text
87empty :: Text
Data/Text/Internal/Lazy/Encoding/Fusion.hs−26
@@ -38,9 +38,7 @@ import qualified Data.ByteString.Unsafe as B
38import Data.Text.Internal.Encoding.Fusion.Common
38import Data.Text.Internal.Encoding.Fusion.Common
39import Data.Text.Encoding.Error
39import Data.Text.Encoding.Error
40import Data.Text.Internal.Fusion (Step(..), Stream(..))
40import Data.Text.Internal.Fusion (Step(..), Stream(..))
41−#ifndef __GHCJS__
42import Data.Text.Internal.Fusion.Size
41import Data.Text.Internal.Fusion.Size
43−#endif
44import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)
42import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)
45import Data.Text.Internal.Unsafe.Shift (shiftL)
43import Data.Text.Internal.Unsafe.Shift (shiftL)
46import Data.Word (Word8, Word16, Word32)
44import Data.Word (Word8, Word16, Word32)
@@ -67,11 +65,7 @@ data T = T !ByteString !S {-# UNPACK #-} !Int
67-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using
65-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using
68-- UTF-8 encoding.
66-- UTF-8 encoding.
69streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
67streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
70−#ifndef __GHCJS__
71streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize
68streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize
72−#else
73−streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
74−#endif
75 where
69 where
76 next (T bs@(Chunk ps _) S0 i)
70 next (T bs@(Chunk ps _) S0 i)
77 | i < len && U8.validate1 a =
71 | i < len && U8.validate1 a =
@@ -113,11 +107,7 @@ streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
113-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
107-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
114-- endian UTF-16 encoding.
108-- endian UTF-16 encoding.
115streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
109streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
116−#ifndef __GHCJS__
117streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
110streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
118−#else
119−streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
120−#endif
121 where
111 where
122 next (T bs@(Chunk ps _) S0 i)
112 next (T bs@(Chunk ps _) S0 i)
123 | i + 1 < len && U16.validate1 x1 =
113 | i + 1 < len && U16.validate1 x1 =
@@ -157,11 +147,7 @@ streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
157-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
147-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
158-- endian UTF-16 encoding.
148-- endian UTF-16 encoding.
159streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
149streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
160−#ifndef __GHCJS__
161streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
150streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
162−#else
163−streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
164−#endif
165 where
151 where
166 next (T bs@(Chunk ps _) S0 i)
152 next (T bs@(Chunk ps _) S0 i)
167 | i + 1 < len && U16.validate1 x1 =
153 | i + 1 < len && U16.validate1 x1 =
@@ -201,11 +187,7 @@ streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
201-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
187-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
202-- endian UTF-32 encoding.
188-- endian UTF-32 encoding.
203streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
189streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
204−#ifndef __GHCJS__
205streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
190streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
206−#else
207−streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
208−#endif
209 where
191 where
210 next (T bs@(Chunk ps _) S0 i)
192 next (T bs@(Chunk ps _) S0 i)
211 | i + 3 < len && U32.validate x =
193 | i + 3 < len && U32.validate x =
@@ -249,11 +231,7 @@ streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
249-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
231-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
250-- endian UTF-32 encoding.
232-- endian UTF-32 encoding.
251streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
233streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
252−#ifndef __GHCJS__
253streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
234streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
254−#else
255−streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
256−#endif
257 where
235 where
258 next (T bs@(Chunk ps _) S0 i)
236 next (T bs@(Chunk ps _) S0 i)
259 | i + 3 < len && U32.validate x =
237 | i + 3 < len && U32.validate x =
@@ -296,11 +274,7 @@ streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
296
274
297-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
275-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
298unstreamChunks :: Int -> Stream Word8 -> ByteString
276unstreamChunks :: Int -> Stream Word8 -> ByteString
299−#ifndef __GHCJS__
300unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)
277unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)
301−#else
302−unstreamChunks chunkSize (Stream next s0) = chunk s0 4
303−#endif
304 where chunk s1 len1 = unsafeDupablePerformIO $ do
278 where chunk s1 len1 = unsafeDupablePerformIO $ do
305 let len = max 4 (min len1 chunkSize)
279 let len = max 4 (min len1 chunkSize)
306 mallocByteString len >>= loop len 0 s1
280 mallocByteString len >>= loop len 0 s1
Data/Text/Internal/Lazy/Fusion.hs−62
@@ -1,10 +1,4 @@
1{-# LANGUAGE BangPatterns #-}
1{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE CPP #-}
3−#ifdef __GHCJS__
4−{-# LANGUAGE ForeignFunctionInterface #-}
5−{-# LANGUAGE MagicHash #-}
6−{-# LANGUAGE UnliftedFFITypes #-}
7−#endif
8-- |
2-- |
9-- Module : Data.Text.Lazy.Fusion
3-- Module : Data.Text.Lazy.Fusion
10-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
@@ -35,14 +29,7 @@ import Prelude hiding (length)
35import qualified Data.Text.Internal.Fusion.Common as S
29import qualified Data.Text.Internal.Fusion.Common as S
36import Control.Monad.ST (runST)
30import Control.Monad.ST (runST)
37import Data.Text.Internal.Fusion.Types
31import Data.Text.Internal.Fusion.Types
38−#ifndef __GHCJS__
39import Data.Text.Internal.Fusion.Size (isEmpty, unknownSize)
32import Data.Text.Internal.Fusion.Size (isEmpty, unknownSize)
40−#else
41−import Data.JSString (JSString)
42−import qualified Data.JSString as JSS
43−import GHC.Base (Int(..))
44−import GHC.Exts (ByteArray#, Int#)
45−#endif
46import Data.Text.Internal.Lazy
33import Data.Text.Internal.Lazy
47import qualified Data.Text.Internal as I
34import qualified Data.Text.Internal as I
48import qualified Data.Text.Array as A
35import qualified Data.Text.Array as A
@@ -55,7 +42,6 @@ default(Int64)
55
42
56-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
43-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
57stream :: Text -> Stream Char
44stream :: Text -> Stream Char
58−#ifndef __GHCJS__
59stream text = Stream next (text :*: 0) unknownSize
45stream text = Stream next (text :*: 0) unknownSize
60 where
46 where
61 next (Empty :*: _) = Done
47 next (Empty :*: _) = Done
@@ -63,22 +49,11 @@ stream text = Stream next (text :*: 0) unknownSize
63 | i >= len = next (ts :*: 0)
49 | i >= len = next (ts :*: 0)
64 | otherwise = Yield c (txt :*: i+d)
50 | otherwise = Yield c (txt :*: i+d)
65 where Iter c d = iter t i
51 where Iter c d = iter t i
66−#else
67−stream text = Stream next (text :*: 0) -- unknownSize
68− where
69− next (Empty :*: _) = Done
70− next (txt@(Chunk t@(I.Text jst) ts) :*: i)
71− | i >= JSS.length jst = next (ts :*: 0)
72− | otherwise = Yield c (txt :*: i+d)
73− where Iter c d = iter t i
74−#endif
75{-# INLINE [0] stream #-}
52{-# INLINE [0] stream #-}
76
53
77−-- TODO
78-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given
54-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given
79-- chunk size.
55-- chunk size.
80unstreamChunks :: Int -> Stream Char -> Text
56unstreamChunks :: Int -> Stream Char -> Text
81−#ifndef __GHCJS__
82unstreamChunks !chunkSize (Stream next s0 len0)
57unstreamChunks !chunkSize (Stream next s0 len0)
83 | isEmpty len0 = Empty
58 | isEmpty len0 = Empty
84 | otherwise = outer s0
59 | otherwise = outer s0
@@ -109,36 +84,6 @@ unstreamChunks !chunkSize (Stream next s0 len0)
109 finish marr len s' = do
84 finish marr len s' = do
110 arr <- A.unsafeFreeze marr
85 arr <- A.unsafeFreeze marr
111 return (I.Text arr 0 len `Chunk` outer s')
86 return (I.Text arr 0 len `Chunk` outer s')
112−#else
113−unstreamChunks !chunkSize (Stream next s0) = outer s0
114− where
115− outer so = {-# SCC "unstreamChunks/outer" #-}
116− case next so of
117− Done -> Empty
118− Skip s' -> outer s'
119− Yield x s' -> runST $ do
120− a <- A.new unknownLength
121− unsafeWrite a 0 x >>= inner a unknownLength s'
122− where unknownLength = 4
123− where
124− inner marr !len s !i
125− | i + 1 >= chunkSize = finish marr i s
126− | i + 1 >= len = {-# SCC "unstreamChunks/resize" #-} do
127− let newLen = min (len `shiftL` 1) chunkSize
128− marr' <- A.new newLen
129− A.copyM marr' 0 marr 0 len
130− inner marr' newLen s i
131− | otherwise =
132− {-# SCC "unstreamChunks/inner" #-}
133− case next s of
134− Done -> finish marr i s
135− Skip s' -> inner marr len s' i
136− Yield x s' -> do d <- unsafeWrite marr i x
137− inner marr len s' (i+d)
138− finish marr (I# len#) s' = do
139− arr <- A.unsafeFreeze marr
140− return (I.Text (js_toString (A.aBA arr) 0# len#) `Chunk` outer s')
141−#endif
142{-# INLINE [0] unstreamChunks #-}
87{-# INLINE [0] unstreamChunks #-}
143
88
144-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using
89-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using
@@ -173,10 +118,3 @@ index = S.indexI
173countChar :: Char -> Stream Char -> Int64
118countChar :: Char -> Stream Char -> Int64
174countChar = S.countCharI
119countChar = S.countCharI
175{-# INLINE [0] countChar #-}
120{-# INLINE [0] countChar #-}
176−
177−#ifdef __GHCJS__
178−foreign import javascript unsafe
179− "h$textToString"
180− js_toString :: ByteArray# -> Int# -> Int# -> JSString
181−#endif
182−
Data/Text/Internal/Lazy/Search.hs+11−55
@@ -1,7 +1,4 @@
1{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
1{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
2−{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes, JavaScriptFFI,
3− UnboxedTuples, DeriveDataTypeable, GHCForeignImportPrim,
4− MagicHash, FlexibleInstances, BangPatterns, Rank2Types, CPP #-}
5
2
6-- |
3-- |
7-- Module : Data.Text.Lazy.Search
4-- Module : Data.Text.Lazy.Search
@@ -34,17 +31,6 @@ import Data.Text.Internal.Lazy (Text(..), foldlChunks)
34import Data.Bits ((.|.), (.&.))
31import Data.Bits ((.|.), (.&.))
35import Data.Text.Internal.Unsafe.Shift (shiftL)
32import Data.Text.Internal.Unsafe.Shift (shiftL)
36
33
37−import Data.JSString (JSString)
38−import qualified Data.Text as TT
39−import GHC.Exts (Int(..), Int#, ByteArray#)
40−
41−foreign import javascript unsafe
42− "h$textFromString"
43− js_fromString :: JSString -> (# ByteArray#, Int# #)
44−
45−fromString :: T.Text -> (# ByteArray#, Int# #)
46−fromString (T.Text txt) = js_fromString txt
47−
48-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
34-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
49-- @needle@ within @haystack@.
35-- @needle@ within @haystack@.
50--
36--
@@ -61,10 +47,8 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)
61 | nlen == 1 = indicesOne (nindex 0) 0 k ks
47 | nlen == 1 = indicesOne (nindex 0) 0 k ks
62 | otherwise = advance k ks 0 0
48 | otherwise = advance k ks 0 0
63 where
49 where
64− -- advance x@(T.Text _ _ l) xs = scan
50+ advance x@(T.Text _ _ l) xs = scan
65− advance x xs = scan
66 where
51 where
67− l = TT.length x
68 scan !g !i
52 scan !g !i
69 | i >= m = case xs of
53 | i >= m = case xs of
70 Empty -> []
54 Empty -> []
@@ -88,23 +72,11 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)
88 nlast = nlen - 1
72 nlast = nlen - 1
89 nindex = index n ns
73 nindex = index n ns
90 z = foldlChunks fin 0 needle
74 z = foldlChunks fin 0 needle
91− where
92− -- fin _ (T.Text farr foff flen) =
93− fin _ t =
94− let foff = 0
95− (farr, flen) =
96− let (# ba, len #) = fromString t
97− in (A.Array ba, I# len)
98− in A.unsafeIndex farr (foff+flen-1)
75+ where fin _ (T.Text farr foff flen) = A.unsafeIndex farr (foff+flen-1)
99 (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)
76 (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)
100 swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)
77 swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)
101− -- buildTable (T.Text xarr xoff xlen) xs = go
78+ buildTable (T.Text xarr xoff xlen) xs = go
102− buildTable t xs = go
103 where
79 where
104− xoff = 0
105− (xarr, xlen) =
106− let (# ba, len #) = fromString t
107− in (A.Array ba, I# len)
108 go !(g::Int64) !i !msk !skp
80 go !(g::Int64) !i !msk !skp
109 | i >= xlast = case xs of
81 | i >= xlast = case xs of
110 Empty -> (msk .|. swizzle z) :*: skp
82 Empty -> (msk .|. swizzle z) :*: skp
@@ -119,22 +91,17 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)
119 -- given offset would fail.
91 -- given offset would fail.
120 lackingHay q = go 0
92 lackingHay q = go 0
121 where
93 where
122− -- go p (T.Text _ _ l) ps = p' < q && case ps of
94+ go p (T.Text _ _ l) ps = p' < q && case ps of
123− go p t ps = p' < q && case ps of
124− Empty -> True
95+ Empty -> True
125− Chunk r rs -> go p' r rs
96+ Chunk r rs -> go p' r rs
126− where
127− l = TT.length t
128− p' = p + fromIntegral l
97+ where p' = p + fromIntegral l
129−
130indices _ _ = []
98indices _ _ = []
131
99
132-- | Fast index into a partly unpacked 'Text'. We take into account
100-- | Fast index into a partly unpacked 'Text'. We take into account
133-- the possibility that the caller might try to access one element
101-- the possibility that the caller might try to access one element
134-- past the end.
102-- past the end.
135index :: T.Text -> Text -> Int64 -> Word16
103index :: T.Text -> Text -> Int64 -> Word16
136−-- index (T.Text arr off len) xs !i
104+index (T.Text arr off len) xs !i
137−index t xs !i
138 | j < len = A.unsafeIndex arr (off+j)
105 | j < len = A.unsafeIndex arr (off+j)
139 | otherwise = case xs of
106 | otherwise = case xs of
140 Empty
107 Empty
@@ -143,24 +110,14 @@ index t xs !i
143 -- should never happen, due to lackingHay above
110 -- should never happen, due to lackingHay above
144 | otherwise -> emptyError "index"
111 | otherwise -> emptyError "index"
145 Chunk c cs -> index c cs (i-fromIntegral len)
112 Chunk c cs -> index c cs (i-fromIntegral len)
146− where
147− j = fromIntegral i
113+ where j = fromIntegral i
148− off = 0
149− (arr, len) =
150− let (# ba, len' #) = fromString t
151− in (A.Array ba, I# len')
152
114
153-- | A variant of 'indices' that scans linearly for a single 'Word16'.
115-- | A variant of 'indices' that scans linearly for a single 'Word16'.
154indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]
116indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]
155indicesOne c = chunk
117indicesOne c = chunk
156 where
118 where
157− -- chunk !i (T.Text oarr ooff olen) os = go 0
119+ chunk !i (T.Text oarr ooff olen) os = go 0
158− chunk !i t os = go 0
159 where
120 where
160− ooff = 0
161− (oarr, olen) =
162− let (# ba, len #) = fromString t
163− in (A.Array ba, I# len)
164 go h | h >= olen = case os of
121 go h | h >= olen = case os of
165 Empty -> []
122 Empty -> []
166 Chunk y ys -> chunk (i+fromIntegral olen) y ys
123 Chunk y ys -> chunk (i+fromIntegral olen) y ys
@@ -171,8 +128,7 @@ indicesOne c = chunk
171-- | The number of 'Word16' values in a 'Text'.
128-- | The number of 'Word16' values in a 'Text'.
172wordLength :: Text -> Int64
129wordLength :: Text -> Int64
173wordLength = foldlChunks sumLength 0
130wordLength = foldlChunks sumLength 0
174− where sumLength i t = i + fromIntegral (TT.length t)
175− -- where sumLength i (T.Text _ _ l) = i + fromIntegral l
131+ where sumLength i (T.Text _ _ l) = i + fromIntegral l
176
132
177emptyError :: String -> a
133emptyError :: String -> a
178emptyError fun = error ("Data.Text.Lazy.Search." ++ fun ++ ": empty input")
134emptyError fun = error ("Data.Text.Lazy.Search." ++ fun ++ ": empty input")
Data/Text/Internal/Private.hs+1−8
@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples, CPP #-}
1+{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples #-}
2
2
3-- |
3-- |
4-- Module : Data.Text.Internal.Private
4-- Module : Data.Text.Internal.Private
@@ -19,12 +19,8 @@ import Control.Monad.ST (ST, runST)
19import Data.Text.Internal (Text(..), text)
19import Data.Text.Internal (Text(..), text)
20import Data.Text.Unsafe (Iter(..), iter)
20import Data.Text.Unsafe (Iter(..), iter)
21import qualified Data.Text.Array as A
21import qualified Data.Text.Array as A
22−#ifdef __GHCJS__
23−import qualified Data.JSString as JSS
24−#endif
25
22
26span_ :: (Char -> Bool) -> Text -> (# Text, Text #)
23span_ :: (Char -> Bool) -> Text -> (# Text, Text #)
27−#ifndef __GHCJS__
28span_ p t@(Text arr off len) = (# hd,tl #)
24span_ p t@(Text arr off len) = (# hd,tl #)
29 where hd = text arr off k
25 where hd = text arr off k
30 tl = text arr (off+k) (len-k)
26 tl = text arr (off+k) (len-k)
@@ -32,9 +28,6 @@ span_ p t@(Text arr off len) = (# hd,tl #)
32 loop !i | i < len && p c = loop (i+d)
28 loop !i | i < len && p c = loop (i+d)
33 | otherwise = i
29 | otherwise = i
34 where Iter c d = iter t i
30 where Iter c d = iter t i
35−#else
36−span_ p (Text t) = let (# a, b #) = JSS.span_ p t in (# Text a, Text b #)
37−#endif
38{-# INLINE span_ #-}
31{-# INLINE span_ #-}
39
32
40runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text
33runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text
Data/Text/Internal/Search.hs+37−40
@@ -37,8 +37,6 @@ import Data.Text.Internal (Text(..))
37import Data.Bits ((.|.), (.&.))
37import Data.Bits ((.|.), (.&.))
38import Data.Text.Internal.Unsafe.Shift (shiftL)
38import Data.Text.Internal.Unsafe.Shift (shiftL)
39
39
40−import qualified Data.JSString.Internal.Search as JSS
41−
42data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
40data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
43
41
44-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
42-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
@@ -51,42 +49,41 @@ data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
51indices :: Text -- ^ Substring to search for (@needle@)
49indices :: Text -- ^ Substring to search for (@needle@)
52 -> Text -- ^ Text to search in (@haystack@)
50 -> Text -- ^ Text to search in (@haystack@)
53 -> [Int]
51 -> [Int]
54−indices = coerce JSS.indices
55−-- indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)
52+indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)
56−-- | nlen == 1 = scanOne (nindex 0)
53+ | nlen == 1 = scanOne (nindex 0)
57−-- | nlen <= 0 || ldiff < 0 = []
54+ | nlen <= 0 || ldiff < 0 = []
58−-- | otherwise = scan 0
55+ | otherwise = scan 0
59−-- where
56+ where
60−-- ldiff = hlen - nlen
57+ ldiff = hlen - nlen
61−-- nlast = nlen - 1
58+ nlast = nlen - 1
62−-- z = nindex nlast
59+ z = nindex nlast
63−-- nindex k = A.unsafeIndex narr (noff+k)
60+ nindex k = A.unsafeIndex narr (noff+k)
64−-- hindex k = A.unsafeIndex harr (hoff+k)
61+ hindex k = A.unsafeIndex harr (hoff+k)
65−-- hindex' k | k == hlen = 0
62+ hindex' k | k == hlen = 0
66−-- | otherwise = A.unsafeIndex harr (hoff+k)
63+ | otherwise = A.unsafeIndex harr (hoff+k)
67−-- buildTable !i !msk !skp
64+ buildTable !i !msk !skp
68−-- | i >= nlast = (msk .|. swizzle z) :* skp
65+ | i >= nlast = (msk .|. swizzle z) :* skp
69−-- | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'
66+ | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'
70−-- where c = nindex i
67+ where c = nindex i
71−-- skp' | c == z = nlen - i - 2
68+ skp' | c == z = nlen - i - 2
72−-- | otherwise = skp
69+ | otherwise = skp
73−-- swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)
70+ swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)
74−-- scan !i
71+ scan !i
75−-- | i > ldiff = []
72+ | i > ldiff = []
76−-- | c == z && candidateMatch 0 = i : scan (i + nlen)
73+ | c == z && candidateMatch 0 = i : scan (i + nlen)
77−-- | otherwise = scan (i + delta)
74+ | otherwise = scan (i + delta)
78−-- where c = hindex (i + nlast)
75+ where c = hindex (i + nlast)
79−-- candidateMatch !j
76+ candidateMatch !j
80−-- | j >= nlast = True
77+ | j >= nlast = True
81−-- | hindex (i+j) /= nindex j = False
78+ | hindex (i+j) /= nindex j = False
82−-- | otherwise = candidateMatch (j+1)
79+ | otherwise = candidateMatch (j+1)
83−-- delta | nextInPattern = nlen + 1
80+ delta | nextInPattern = nlen + 1
84−-- | c == z = skip + 1
81+ | c == z = skip + 1
85−-- | otherwise = 1
82+ | otherwise = 1
86−-- where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0
83+ where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0
87−-- !(mask :* skip) = buildTable 0 0 (nlen-2)
84+ !(mask :* skip) = buildTable 0 0 (nlen-2)
88−-- scanOne c = loop 0
85+ scanOne c = loop 0
89−-- where loop !i | i >= hlen = []
86+ where loop !i | i >= hlen = []
90−-- | hindex i == c = i : loop (i+1)
87+ | hindex i == c = i : loop (i+1)
91−-- | otherwise = loop (i+1)
88+ | otherwise = loop (i+1)
92{-# INLINE indices #-}
89{-# INLINE indices #-}
Data/Text/Lazy.hs+52−58
@@ -301,16 +301,15 @@ equal :: Text -> Text -> Bool
301equal Empty Empty = True
301equal Empty Empty = True
302equal Empty _ = False
302equal Empty _ = False
303equal _ Empty = False
303equal _ Empty = False
304−equal _ _ = error "Data.Text.Lazy.equal: not implemented."
305−-- equal (Chunk a as) (Chunk b bs) =
304+equal (Chunk a as) (Chunk b bs) =
306−-- case compare lenA lenB of
305+ case compare lenA lenB of
307−-- LT -> a == (T.takeWord16 lenA b) &&
306+ LT -> a == (T.takeWord16 lenA b) &&
308−-- as `equal` Chunk (T.dropWord16 lenA b) bs
307+ as `equal` Chunk (T.dropWord16 lenA b) bs
309−-- EQ -> a == b && as `equal` bs
308+ EQ -> a == b && as `equal` bs
310−-- GT -> T.takeWord16 lenB a == b &&
309+ GT -> T.takeWord16 lenB a == b &&
311−-- Chunk (T.dropWord16 lenB a) as `equal` bs
310+ Chunk (T.dropWord16 lenB a) as `equal` bs
312−-- where lenA = T.lengthWord16 a
311+ where lenA = T.lengthWord16 a
313−-- lenB = T.lengthWord16 b
312+ lenB = T.lengthWord16 b
314
313
315instance Eq Text where
314instance Eq Text where
316 (==) = equal
315 (==) = equal
@@ -323,19 +322,18 @@ compareText :: Text -> Text -> Ordering
323compareText Empty Empty = EQ
322compareText Empty Empty = EQ
324compareText Empty _ = LT
323compareText Empty _ = LT
325compareText _ Empty = GT
324compareText _ Empty = GT
326−compareText (Chunk a0 as) (Chunk b0 bs) = error "Data.Text.Lazy.compareText: not implemented."
325+compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0
327−-- compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0
326+ where
328−-- where
327+ outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0
329−-- outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0
328+ where
330−-- where
331−-- go !i !j
329+ go !i !j
332−-- | i >= lenA = compareText as (chunk (T.Text arrB (offB+j) (lenB-j)) bs)
330+ | i >= lenA = compareText as (chunk (T.Text arrB (offB+j) (lenB-j)) bs)
333−-- | j >= lenB = compareText (chunk (T.Text arrA (offA+i) (lenA-i)) as) bs
331+ | j >= lenB = compareText (chunk (T.Text arrA (offA+i) (lenA-i)) as) bs
334−-- | a < b = LT
332+ | a < b = LT
335−-- | a > b = GT
333+ | a > b = GT
336−-- | otherwise = go (i+di) (j+dj)
334+ | otherwise = go (i+di) (j+dj)
337−-- where T.Iter a di = T.iter ta i
335+ where T.Iter a di = T.iter ta i
338−-- T.Iter b dj = T.iter tb j
336+ T.Iter b dj = T.iter tb j
339
337
340instance Show Text where
338instance Show Text where
341 showsPrec p ps r = showsPrec p (unpack ps) r
339 showsPrec p ps r = showsPrec p (unpack ps) r
@@ -547,7 +545,7 @@ tail Empty = emptyError "tail"
547 unstream (S.tail (stream t)) = tail t
545 unstream (S.tail (stream t)) = tail t
548 #-}
546 #-}
549
547
550−-- | /O(1)/ Returns all but the last character of a 'Text', which must
548+-- | /O(n\/c)/ Returns all but the last character of a 'Text', which must
551-- be non-empty. Subject to fusion.
549-- be non-empty. Subject to fusion.
552init :: Text -> Text
550init :: Text -> Text
553init (Chunk t0 ts0) = go t0 ts0
551init (Chunk t0 ts0) = go t0 ts0
@@ -583,7 +581,7 @@ isSingleton :: Text -> Bool
583isSingleton = S.isSingleton . stream
581isSingleton = S.isSingleton . stream
584{-# INLINE isSingleton #-}
582{-# INLINE isSingleton #-}
585
583
586−-- | /O(1)/ Returns the last character of a 'Text', which must be
584+-- | /O(n\/c)/ Returns the last character of a 'Text', which must be
587-- non-empty. Subject to fusion.
585-- non-empty. Subject to fusion.
588last :: Text -> Char
586last :: Text -> Char
589last Empty = emptyError "last"
587last Empty = emptyError "last"
@@ -1116,17 +1114,16 @@ dropEnd n t0
1116-- values dropped, or the empty 'Text' if @n@ is greater than the
1114-- values dropped, or the empty 'Text' if @n@ is greater than the
1117-- number of 'Word16' values present.
1115-- number of 'Word16' values present.
1118dropWords :: Int64 -> Text -> Text
1116dropWords :: Int64 -> Text -> Text
1119−dropWords = P.undefined
1117+dropWords i t0
1120−-- dropWords i t0
1121−-- | i <= 0 = t0
1118+ | i <= 0 = t0
1122−-- | otherwise = drop' i t0
1119+ | otherwise = drop' i t0
1123−-- where drop' 0 ts = ts
1120+ where drop' 0 ts = ts
1124−-- drop' _ Empty = Empty
1121+ drop' _ Empty = Empty
1125−-- drop' n (Chunk (T.Text arr off len) ts)
1122+ drop' n (Chunk (T.Text arr off len) ts)
1126−-- | n < len' = chunk (text arr (off+n') (len-n')) ts
1123+ | n < len' = chunk (text arr (off+n') (len-n')) ts
1127−-- | otherwise = drop' (n - len') ts
1124+ | otherwise = drop' (n - len') ts
1128−-- where len' = fromIntegral len
1125+ where len' = fromIntegral len
1129−-- n' = fromIntegral n
1126+ n' = fromIntegral n
1130
1127
1131-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1128-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1132-- returns the longest prefix (possibly empty) of elements that
1129-- returns the longest prefix (possibly empty) of elements that
@@ -1247,13 +1244,12 @@ splitAt = loop
1247-- values, and whose second is the remainder of the string.
1244-- values, and whose second is the remainder of the string.
1248splitAtWord :: Int64 -> Text -> PairS Text Text
1245splitAtWord :: Int64 -> Text -> PairS Text Text
1249splitAtWord _ Empty = empty :*: empty
1246splitAtWord _ Empty = empty :*: empty
1250−splitAtWord _ _ = P.undefined
1251−-- splitAtWord x (Chunk c@(T.Text arr off len) cs)
1247+splitAtWord x (Chunk c@(T.Text arr off len) cs)
1252−-- | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1248+ | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1253−-- in Chunk c h :*: t
1249+ in Chunk c h :*: t
1254−-- | otherwise = chunk (text arr off y) empty :*:
1250+ | otherwise = chunk (text arr off y) empty :*:
1255−-- chunk (text arr (off+y) (len-y)) cs
1251+ chunk (text arr (off+y) (len-y)) cs
1256−-- where y = fromIntegral x
1252+ where y = fromIntegral x
1257
1253
1258-- | /O(n+m)/ Find the first instance of @needle@ (which must be
1254-- | /O(n+m)/ Find the first instance of @needle@ (which must be
1259-- non-'null') in @haystack@. The first element of the returned tuple
1255-- non-'null') in @haystack@. The first element of the returned tuple
@@ -1425,16 +1421,15 @@ splitOn :: Text
1425 -> Text
1421 -> Text
1426 -- ^ Input text.
1422 -- ^ Input text.
1427 -> [Text]
1423 -> [Text]
1428−splitOn = P.undefined
1424+splitOn pat src
1429−-- splitOn pat src
1430−-- | null pat = emptyError "splitOn"
1425+ | null pat = emptyError "splitOn"
1431−-- | isSingleton pat = split (== head pat) src
1426+ | isSingleton pat = split (== head pat) src
1432−-- | otherwise = go 0 (indices pat src) src
1427+ | otherwise = go 0 (indices pat src) src
1433−-- where
1428+ where
1434−-- go _ [] cs = [cs]
1429+ go _ [] cs = [cs]
1435−-- go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs
1430+ go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs
1436−-- in h : go (x+l) xs (dropWords l t)
1431+ in h : go (x+l) xs (dropWords l t)
1437−-- l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat
1432+ l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat
1438{-# INLINE [1] splitOn #-}
1433{-# INLINE [1] splitOn #-}
1439
1434
1440{-# RULES
1435{-# RULES
@@ -1536,11 +1531,10 @@ isSuffixOf x y = reverse x `isPrefixOf` reverse y
1536-- In (unlikely) bad cases, this function's time complexity degrades
1531-- In (unlikely) bad cases, this function's time complexity degrades
1537-- towards /O(n*m)/.
1532-- towards /O(n*m)/.
1538isInfixOf :: Text -> Text -> Bool
1533isInfixOf :: Text -> Text -> Bool
1539−isInfixOf _ _ = True
1540−-- isInfixOf needle haystack
1534+isInfixOf needle haystack
1541−-- | null needle = True
1535+ | null needle = True
1542−-- | isSingleton needle = S.elem (head needle) . S.stream $ haystack
1536+ | isSingleton needle = S.elem (head needle) . S.stream $ haystack
1543−-- | otherwise = not . L.null . indices needle $ haystack
1537+ | otherwise = not . L.null . indices needle $ haystack
1544{-# INLINE [1] isInfixOf #-}
1538{-# INLINE [1] isInfixOf #-}
1545
1539
1546{-# RULES
1540{-# RULES
Data/Text/Lazy/Builder/Int.hs+259−9
@@ -1,12 +1,262 @@
1−module Data.Text.Lazy.Builder.Int where
1+{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,
2+ UnboxedTuples #-}
3+#if __GLASGOW_HASKELL__ >= 702
4+{-# LANGUAGE Trustworthy #-}
5+#endif
2
6
3−import Data.Text.Lazy (Text)
7+-- Module: Data.Text.Lazy.Builder.Int
4−import qualified Data.Text.Lazy as L
8+-- Copyright: (c) 2013 Bryan O'Sullivan
5−import qualified Data.Text as T
9+-- (c) 2011 MailRank, Inc.
6−import qualified Data.JSString.Int as JSS
10+-- License: BSD-style
7−import Data.Text.Lazy.Builder
11+-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
12+-- Stability: experimental
13+-- Portability: portable
14+--
15+-- Efficiently write an integral value to a 'Builder'.
16+
17+module Data.Text.Lazy.Builder.Int
18+ (
19+ decimal
20+ , hexadecimal
21+ ) where
22+
23+import Data.Int (Int8, Int16, Int32, Int64)
8−import Data.Monoid
24+import Data.Monoid (mempty)
25+import qualified Data.ByteString.Unsafe as B
26+import Data.Text.Internal.Builder.Functions ((<>), i2d)
27+import Data.Text.Internal.Builder
28+import Data.Text.Internal.Builder.Int.Digits (digits)
29+import Data.Text.Array
30+import Data.Word (Word, Word8, Word16, Word32, Word64)
31+import GHC.Base (quotInt, remInt)
32+import GHC.Num (quotRemInteger)
33+import GHC.Types (Int(..))
34+import Control.Monad.ST
35+
36+#ifdef __GLASGOW_HASKELL__
37+# if defined(INTEGER_GMP)
38+import GHC.Integer.GMP.Internals (Integer(S#))
39+# elif defined(INTEGER_SIMPLE)
40+import GHC.Integer
41+# else
42+# error "You need to use either GMP or integer-simple."
43+# endif
44+#endif
45+
46+#if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE)
47+# define PAIR(a,b) (# a,b #)
48+#else
49+# define PAIR(a,b) (a,b)
50+#endif
9
51
10decimal :: Integral a => a -> Builder
52decimal :: Integral a => a -> Builder
11−-- decimal n = L.fromChunks [T.Text $ JSS.decimal n]
53+{-# RULES "decimal/Int8" decimal = boundedDecimal :: Int8 -> Builder #-}
12−decimal _ = mempty
54+{-# RULES "decimal/Int" decimal = boundedDecimal :: Int -> Builder #-}
55+{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}
56+{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}
57+{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}
58+{-# RULES "decimal/Word" decimal = positive :: Data.Word.Word -> Builder #-}
59+{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}
60+{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}
61+{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}
62+{-# RULES "decimal/Word64" decimal = positive :: Word64 -> Builder #-}
63+{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}
64+decimal i = decimal' (<= -128) i
65+{-# NOINLINE decimal #-}
66+
67+boundedDecimal :: (Integral a, Bounded a) => a -> Builder
68+{-# SPECIALIZE boundedDecimal :: Int -> Builder #-}
69+{-# SPECIALIZE boundedDecimal :: Int8 -> Builder #-}
70+{-# SPECIALIZE boundedDecimal :: Int16 -> Builder #-}
71+{-# SPECIALIZE boundedDecimal :: Int32 -> Builder #-}
72+{-# SPECIALIZE boundedDecimal :: Int64 -> Builder #-}
73+boundedDecimal i = decimal' (== minBound) i
74+
75+decimal' :: (Integral a) => (a -> Bool) -> a -> Builder
76+{-# INLINE decimal' #-}
77+decimal' p i
78+ | i < 0 = if p i
79+ then let (q, r) = i `quotRem` 10
80+ qq = -q
81+ !n = countDigits qq
82+ in writeN (n + 2) $ \marr off -> do
83+ unsafeWrite marr off minus
84+ posDecimal marr (off+1) n qq
85+ unsafeWrite marr (off+n+1) (i2w (-r))
86+ else let j = -i
87+ !n = countDigits j
88+ in writeN (n + 1) $ \marr off ->
89+ unsafeWrite marr off minus >> posDecimal marr (off+1) n j
90+ | otherwise = positive i
91+
92+positive :: (Integral a) => a -> Builder
93+{-# SPECIALIZE positive :: Int -> Builder #-}
94+{-# SPECIALIZE positive :: Int8 -> Builder #-}
95+{-# SPECIALIZE positive :: Int16 -> Builder #-}
96+{-# SPECIALIZE positive :: Int32 -> Builder #-}
97+{-# SPECIALIZE positive :: Int64 -> Builder #-}
98+{-# SPECIALIZE positive :: Word -> Builder #-}
99+{-# SPECIALIZE positive :: Word8 -> Builder #-}
100+{-# SPECIALIZE positive :: Word16 -> Builder #-}
101+{-# SPECIALIZE positive :: Word32 -> Builder #-}
102+{-# SPECIALIZE positive :: Word64 -> Builder #-}
103+positive i
104+ | i < 10 = writeN 1 $ \marr off -> unsafeWrite marr off (i2w i)
105+ | otherwise = let !n = countDigits i
106+ in writeN n $ \marr off -> posDecimal marr off n i
107+
108+posDecimal :: (Integral a) =>
109+ forall s. MArray s -> Int -> Int -> a -> ST s ()
110+{-# INLINE posDecimal #-}
111+posDecimal marr off0 ds v0 = go (off0 + ds - 1) v0
112+ where go off v
113+ | v >= 100 = do
114+ let (q, r) = v `quotRem` 100
115+ write2 off r
116+ go (off - 2) q
117+ | v < 10 = unsafeWrite marr off (i2w v)
118+ | otherwise = write2 off v
119+ write2 off i0 = do
120+ let i = fromIntegral i0; j = i + i
121+ unsafeWrite marr off $ get (j + 1)
122+ unsafeWrite marr (off - 1) $ get j
123+ get = fromIntegral . B.unsafeIndex digits
124+
125+minus, zero :: Word16
126+{-# INLINE minus #-}
127+{-# INLINE zero #-}
128+minus = 45
129+zero = 48
130+
131+i2w :: (Integral a) => a -> Word16
132+{-# INLINE i2w #-}
133+i2w v = zero + fromIntegral v
134+
135+countDigits :: (Integral a) => a -> Int
136+{-# INLINE countDigits #-}
137+countDigits v0
138+ | fromIntegral v64 == v0 = go 1 v64
139+ | otherwise = goBig 1 (fromIntegral v0)
140+ where v64 = fromIntegral v0
141+ goBig !k (v :: Integer)
142+ | v > big = goBig (k + 19) (v `quot` big)
143+ | otherwise = go k (fromIntegral v)
144+ big = 10000000000000000000
145+ go !k (v :: Word64)
146+ | v < 10 = k
147+ | v < 100 = k + 1
148+ | v < 1000 = k + 2
149+ | v < 1000000000000 =
150+ k + if v < 100000000
151+ then if v < 1000000
152+ then if v < 10000
153+ then 3
154+ else 4 + fin v 100000
155+ else 6 + fin v 10000000
156+ else if v < 10000000000
157+ then 8 + fin v 1000000000
158+ else 10 + fin v 100000000000
159+ | otherwise = go (k + 12) (v `quot` 1000000000000)
160+ fin v n = if v >= n then 1 else 0
161+
162+hexadecimal :: Integral a => a -> Builder
163+{-# SPECIALIZE hexadecimal :: Int -> Builder #-}
164+{-# SPECIALIZE hexadecimal :: Int8 -> Builder #-}
165+{-# SPECIALIZE hexadecimal :: Int16 -> Builder #-}
166+{-# SPECIALIZE hexadecimal :: Int32 -> Builder #-}
167+{-# SPECIALIZE hexadecimal :: Int64 -> Builder #-}
168+{-# SPECIALIZE hexadecimal :: Word -> Builder #-}
169+{-# SPECIALIZE hexadecimal :: Word8 -> Builder #-}
170+{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-}
171+{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-}
172+{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-}
173+{-# RULES "hexadecimal/Integer"
174+ hexadecimal = hexInteger :: Integer -> Builder #-}
175+hexadecimal i
176+ | i < 0 = error hexErrMsg
177+ | otherwise = go i
178+ where
179+ go n | n < 16 = hexDigit n
180+ | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)
181+{-# NOINLINE[0] hexadecimal #-}
182+
183+hexInteger :: Integer -> Builder
184+hexInteger i
185+ | i < 0 = error hexErrMsg
186+ | otherwise = integer 16 i
187+
188+hexErrMsg :: String
189+hexErrMsg = "Data.Text.Lazy.Builder.Int.hexadecimal: applied to negative number"
190+
191+hexDigit :: Integral a => a -> Builder
192+hexDigit n
193+ | n <= 9 = singleton $! i2d (fromIntegral n)
194+ | otherwise = singleton $! toEnum (fromIntegral n + 87)
195+{-# INLINE hexDigit #-}
196+
197+data T = T !Integer !Int
198+
199+integer :: Int -> Integer -> Builder
200+#ifdef INTEGER_GMP
201+integer 10 (S# i#) = decimal (I# i#)
202+integer 16 (S# i#) = hexadecimal (I# i#)
203+#endif
204+integer base i
205+ | i < 0 = singleton '-' <> go (-i)
206+ | otherwise = go i
207+ where
208+ go n | n < maxInt = int (fromInteger n)
209+ | otherwise = putH (splitf (maxInt * maxInt) n)
210+
211+ splitf p n
212+ | p > n = [n]
213+ | otherwise = splith p (splitf (p*p) n)
214+
215+ splith p (n:ns) = case n `quotRemInteger` p of
216+ PAIR(q,r) | q > 0 -> q : r : splitb p ns
217+ | otherwise -> r : splitb p ns
218+ splith _ _ = error "splith: the impossible happened."
219+
220+ splitb p (n:ns) = case n `quotRemInteger` p of
221+ PAIR(q,r) -> q : r : splitb p ns
222+ splitb _ _ = []
223+
224+ T maxInt10 maxDigits10 =
225+ until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1)
226+ where mi = fromIntegral (maxBound :: Int)
227+ T maxInt16 maxDigits16 =
228+ until ((>mi) . (*16) . fstT) (\(T n d) -> T (n*16) (d+1)) (T 16 1)
229+ where mi = fromIntegral (maxBound :: Int)
230+
231+ fstT (T a _) = a
232+
233+ maxInt | base == 10 = maxInt10
234+ | otherwise = maxInt16
235+ maxDigits | base == 10 = maxDigits10
236+ | otherwise = maxDigits16
237+
238+ putH (n:ns) = case n `quotRemInteger` maxInt of
239+ PAIR(x,y)
240+ | q > 0 -> int q <> pblock r <> putB ns
241+ | otherwise -> int r <> putB ns
242+ where q = fromInteger x
243+ r = fromInteger y
244+ putH _ = error "putH: the impossible happened"
245+
246+ putB (n:ns) = case n `quotRemInteger` maxInt of
247+ PAIR(x,y) -> pblock q <> pblock r <> putB ns
248+ where q = fromInteger x
249+ r = fromInteger y
250+ putB _ = Data.Monoid.mempty
251+
252+ int :: Int -> Builder
253+ int x | base == 10 = decimal x
254+ | otherwise = hexadecimal x
255+
256+ pblock = loop maxDigits
257+ where
258+ loop !d !n
259+ | d == 1 = hexDigit n
260+ | otherwise = loop (d-1) q <> hexDigit r
261+ where q = n `quotInt` base
262+ r = n `remInt` base
Data/Text/Lazy/Builder/RealFloat.hs+233−2
@@ -1,4 +1,29 @@
1+{-# LANGUAGE CPP, OverloadedStrings #-}
2+#if __GLASGOW_HASKELL__ >= 702
3+{-# LANGUAGE Trustworthy #-}
4+#endif
5+
6+-- |
7+-- Module: Data.Text.Lazy.Builder.RealFloat
8+-- Copyright: (c) The University of Glasgow 1994-2002
9+-- License: see libraries/base/LICENSE
10+--
11+-- Write a floating point value to a 'Builder'.
12+
1−module Data.Text.Lazy.Builder.RealFloat (FPFormat(..)) where
13+module Data.Text.Lazy.Builder.RealFloat
14+ (
15+ FPFormat(..)
16+ , realFloat
17+ , formatRealFloat
18+ ) where
19+
20+import Data.Array.Base (unsafeAt)
21+import Data.Array.IArray
22+import Data.Text.Internal.Builder.Functions ((<>), i2d)
23+import Data.Text.Lazy.Builder.Int (decimal)
24+import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)
25+import Data.Text.Lazy.Builder
26+import qualified Data.Text as T
2
27
3-- | Control the rendering of floating point numbers.
28-- | Control the rendering of floating point numbers.
4data FPFormat = Exponent
29data FPFormat = Exponent
@@ -8,4 +33,210 @@ data FPFormat = Exponent
8 | Generic
33 | Generic
9 -- ^ Use decimal notation for values between @0.1@ and
34 -- ^ Use decimal notation for values between @0.1@ and
10 -- @9,999,999@, and scientific notation otherwise.
35 -- @9,999,999@, and scientific notation otherwise.
11− deriving (Enum, Read, Show)
36+ deriving (Enum, Read, Show)
37+
38+-- | Show a signed 'RealFloat' value to full precision,
39+-- using standard decimal notation for arguments whose absolute value lies
40+-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
41+realFloat :: (RealFloat a) => a -> Builder
42+{-# SPECIALIZE realFloat :: Float -> Builder #-}
43+{-# SPECIALIZE realFloat :: Double -> Builder #-}
44+realFloat x = formatRealFloat Generic Nothing x
45+
46+formatRealFloat :: (RealFloat a) =>
47+ FPFormat
48+ -> Maybe Int -- ^ Number of decimal places to render.
49+ -> a
50+ -> Builder
51+{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Float -> Builder #-}
52+{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Double -> Builder #-}
53+formatRealFloat fmt decs x
54+ | isNaN x = "NaN"
55+ | isInfinite x = if x < 0 then "-Infinity" else "Infinity"
56+ | x < 0 || isNegativeZero x = singleton '-' <> doFmt fmt (floatToDigits (-x))
57+ | otherwise = doFmt fmt (floatToDigits x)
58+ where
59+ doFmt format (is, e) =
60+ let ds = map i2d is in
61+ case format of
62+ Generic ->
63+ doFmt (if e < 0 || e > 7 then Exponent else Fixed)
64+ (is,e)
65+ Exponent ->
66+ case decs of
67+ Nothing ->
68+ let show_e' = decimal (e-1) in
69+ case ds of
70+ "0" -> "0.0e0"
71+ [d] -> singleton d <> ".0e" <> show_e'
72+ (d:ds') -> singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> show_e'
73+ [] -> error "formatRealFloat/doFmt/Exponent: []"
74+ Just dec ->
75+ let dec' = max dec 1 in
76+ case is of
77+ [0] -> "0." <> fromText (T.replicate dec' "0") <> "e0"
78+ _ ->
79+ let
80+ (ei,is') = roundTo (dec'+1) is
81+ (d:ds') = map i2d (if ei > 0 then init is' else is')
82+ in
83+ singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> decimal (e-1+ei)
84+ Fixed ->
85+ let
86+ mk0 ls = case ls of { "" -> "0" ; _ -> fromString ls}
87+ in
88+ case decs of
89+ Nothing
90+ | e <= 0 -> "0." <> fromText (T.replicate (-e) "0") <> fromString ds
91+ | otherwise ->
92+ let
93+ f 0 s rs = mk0 (reverse s) <> singleton '.' <> mk0 rs
94+ f n s "" = f (n-1) ('0':s) ""
95+ f n s (r:rs) = f (n-1) (r:s) rs
96+ in
97+ f e "" ds
98+ Just dec ->
99+ let dec' = max dec 0 in
100+ if e >= 0 then
101+ let
102+ (ei,is') = roundTo (dec' + e) is
103+ (ls,rs) = splitAt (e+ei) (map i2d is')
104+ in
105+ mk0 ls <> (if null rs then "" else singleton '.' <> fromString rs)
106+ else
107+ let
108+ (ei,is') = roundTo dec' (replicate (-e) 0 ++ is)
109+ d:ds' = map i2d (if ei > 0 then is' else 0:is')
110+ in
111+ singleton d <> (if null ds' then "" else singleton '.' <> fromString ds')
112+
113+
114+-- Based on "Printing Floating-Point Numbers Quickly and Accurately"
115+-- by R.G. Burger and R.K. Dybvig in PLDI 96.
116+-- This version uses a much slower logarithm estimator. It should be improved.
117+
118+-- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number,
119+-- and returns a list of digits and an exponent.
120+-- In particular, if @x>=0@, and
121+--
122+-- > floatToDigits base x = ([d1,d2,...,dn], e)
123+--
124+-- then
125+--
126+-- (1) @n >= 1@
127+--
128+-- (2) @x = 0.d1d2...dn * (base**e)@
129+--
130+-- (3) @0 <= di <= base-1@
131+
132+floatToDigits :: (RealFloat a) => a -> ([Int], Int)
133+{-# SPECIALIZE floatToDigits :: Float -> ([Int], Int) #-}
134+{-# SPECIALIZE floatToDigits :: Double -> ([Int], Int) #-}
135+floatToDigits 0 = ([0], 0)
136+floatToDigits x =
137+ let
138+ (f0, e0) = decodeFloat x
139+ (minExp0, _) = floatRange x
140+ p = floatDigits x
141+ b = floatRadix x
142+ minExp = minExp0 - p -- the real minimum exponent
143+ -- Haskell requires that f be adjusted so denormalized numbers
144+ -- will have an impossibly low exponent. Adjust for this.
145+ (f, e) =
146+ let n = minExp - e0 in
147+ if n > 0 then (f0 `quot` (expt b n), e0+n) else (f0, e0)
148+ (r, s, mUp, mDn) =
149+ if e >= 0 then
150+ let be = expt b e in
151+ if f == expt b (p-1) then
152+ (f*be*b*2, 2*b, be*b, be) -- according to Burger and Dybvig
153+ else
154+ (f*be*2, 2, be, be)
155+ else
156+ if e > minExp && f == expt b (p-1) then
157+ (f*b*2, expt b (-e+1)*2, b, 1)
158+ else
159+ (f*2, expt b (-e)*2, 1, 1)
160+ k :: Int
161+ k =
162+ let
163+ k0 :: Int
164+ k0 =
165+ if b == 2 then
166+ -- logBase 10 2 is very slightly larger than 8651/28738
167+ -- (about 5.3558e-10), so if log x >= 0, the approximation
168+ -- k1 is too small, hence we add one and need one fixup step less.
169+ -- If log x < 0, the approximation errs rather on the high side.
170+ -- That is usually more than compensated for by ignoring the
171+ -- fractional part of logBase 2 x, but when x is a power of 1/2
172+ -- or slightly larger and the exponent is a multiple of the
173+ -- denominator of the rational approximation to logBase 10 2,
174+ -- k1 is larger than logBase 10 x. If k1 > 1 + logBase 10 x,
175+ -- we get a leading zero-digit we don't want.
176+ -- With the approximation 3/10, this happened for
177+ -- 0.5^1030, 0.5^1040, ..., 0.5^1070 and values close above.
178+ -- The approximation 8651/28738 guarantees k1 < 1 + logBase 10 x
179+ -- for IEEE-ish floating point types with exponent fields
180+ -- <= 17 bits and mantissae of several thousand bits, earlier
181+ -- convergents to logBase 10 2 would fail for long double.
182+ -- Using quot instead of div is a little faster and requires
183+ -- fewer fixup steps for negative lx.
184+ let lx = p - 1 + e0
185+ k1 = (lx * 8651) `quot` 28738
186+ in if lx >= 0 then k1 + 1 else k1
187+ else
188+ -- f :: Integer, log :: Float -> Float,
189+ -- ceiling :: Float -> Int
190+ ceiling ((log (fromInteger (f+1) :: Float) +
191+ fromIntegral e * log (fromInteger b)) /
192+ log 10)
193+--WAS: fromInt e * log (fromInteger b))
194+
195+ fixup n =
196+ if n >= 0 then
197+ if r + mUp <= expt 10 n * s then n else fixup (n+1)
198+ else
199+ if expt 10 (-n) * (r + mUp) <= s then n else fixup (n+1)
200+ in
201+ fixup k0
202+
203+ gen ds rn sN mUpN mDnN =
204+ let
205+ (dn, rn') = (rn * 10) `quotRem` sN
206+ mUpN' = mUpN * 10
207+ mDnN' = mDnN * 10
208+ in
209+ case (rn' < mDnN', rn' + mUpN' > sN) of
210+ (True, False) -> dn : ds
211+ (False, True) -> dn+1 : ds
212+ (True, True) -> if rn' * 2 < sN then dn : ds else dn+1 : ds
213+ (False, False) -> gen (dn:ds) rn' sN mUpN' mDnN'
214+
215+ rds =
216+ if k >= 0 then
217+ gen [] r (s * expt 10 k) mUp mDn
218+ else
219+ let bk = expt 10 (-k) in
220+ gen [] (r * bk) s (mUp * bk) (mDn * bk)
221+ in
222+ (map fromIntegral (reverse rds), k)
223+
224+-- Exponentiation with a cache for the most common numbers.
225+minExpt, maxExpt :: Int
226+minExpt = 0
227+maxExpt = 1100
228+
229+expt :: Integer -> Int -> Integer
230+expt base n
231+ | base == 2 && n >= minExpt && n <= maxExpt = expts `unsafeAt` n
232+ | base == 10 && n <= maxExpt10 = expts10 `unsafeAt` n
233+ | otherwise = base^n
234+
235+expts :: Array Int Integer
236+expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]
237+
238+maxExpt10 :: Int
239+maxExpt10 = 324
240+
241+expts10 :: Array Int Integer
242+expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]
Data/Text/Unsafe.hs−87
@@ -1,7 +1,4 @@
1{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
1{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
2−#ifdef __GHCJS__
3−{-# LANGUAGE JavaScriptFFI, ForeignFunctionInterface, UnliftedFFITypes #-}
4−#endif
5-- |
2-- |
6-- Module : Data.Text.Unsafe
3-- Module : Data.Text.Unsafe
7-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
4-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
@@ -35,47 +32,31 @@ import Control.Exception (assert)
35import Data.Text.Internal.Encoding.Utf16 (chr2)
32import Data.Text.Internal.Encoding.Utf16 (chr2)
36import Data.Text.Internal (Text(..))
33import Data.Text.Internal (Text(..))
37import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)
34import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)
38−#ifdef __GHCJS__
39−import Data.Coerce
40−import qualified Data.JSString.Raw as JSS
41−import GHC.Exts (Int(..), Int#, chr#, int2Word#, Char(..))
42−import GHC.Word (Word16(..))
43−import Data.JSString (JSString)
44−#else
45import Data.Text.Internal.Unsafe.Char (unsafeChr)
35import Data.Text.Internal.Unsafe.Char (unsafeChr)
46import qualified Data.Text.Array as A
36import qualified Data.Text.Array as A
47−#endif
48import GHC.IO (unsafeDupablePerformIO)
37import GHC.IO (unsafeDupablePerformIO)
49
38
50-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'
39-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'
51-- omits the check for the empty case, so there is an obligation on
40-- omits the check for the empty case, so there is an obligation on
52-- the programmer to provide a proof that the 'Text' is non-empty.
41-- the programmer to provide a proof that the 'Text' is non-empty.
53unsafeHead :: Text -> Char
42unsafeHead :: Text -> Char
54−#ifndef __GHCJS__
55unsafeHead (Text arr off _len)
43unsafeHead (Text arr off _len)
56 | m < 0xD800 || m > 0xDBFF = unsafeChr m
44 | m < 0xD800 || m > 0xDBFF = unsafeChr m
57 | otherwise = chr2 m n
45 | otherwise = chr2 m n
58 where m = A.unsafeIndex arr off
46 where m = A.unsafeIndex arr off
59 n = A.unsafeIndex arr (off+1)
47 n = A.unsafeIndex arr (off+1)
60−#else
61−unsafeHead = coerce JSS.rawHead
62−#endif
63{-# INLINE unsafeHead #-}
48{-# INLINE unsafeHead #-}
64
49
65-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'
50-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'
66-- omits the check for the empty case, so there is an obligation on
51-- omits the check for the empty case, so there is an obligation on
67-- the programmer to provide a proof that the 'Text' is non-empty.
52-- the programmer to provide a proof that the 'Text' is non-empty.
68unsafeTail :: Text -> Text
53unsafeTail :: Text -> Text
69−#ifndef __GHCJS__
70unsafeTail t@(Text arr off len) =
54unsafeTail t@(Text arr off len) =
71#if defined(ASSERTS)
55#if defined(ASSERTS)
72 assert (d <= len) $
56 assert (d <= len) $
73#endif
57#endif
74 Text arr (off+d) (len-d)
58 Text arr (off+d) (len-d)
75 where d = iter_ t 0
59 where d = iter_ t 0
76−#else
77−unsafeTail = coerce JSS.rawTail
78−#endif
79{-# INLINE unsafeTail #-}
60{-# INLINE unsafeTail #-}
80
61
81data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int
62data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int
@@ -84,7 +65,6 @@ data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int
84-- array, returning the current character and the delta to add to give
65-- array, returning the current character and the delta to add to give
85-- the next offset to iterate at.
66-- the next offset to iterate at.
86iter :: Text -> Int -> Iter
67iter :: Text -> Int -> Iter
87−#ifndef __GHCJS__
88iter (Text arr off _len) i
68iter (Text arr off _len) i
89 | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1
69 | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1
90 | otherwise = Iter (chr2 m n) 2
70 | otherwise = Iter (chr2 m n) 2
@@ -92,40 +72,20 @@ iter (Text arr off _len) i
92 n = A.unsafeIndex arr k
72 n = A.unsafeIndex arr k
93 j = off + i
73 j = off + i
94 k = j + 1
74 k = j + 1
95−#else
96−iter (Text txt) i
97− | m < 0xD800 || m > 0xDBFF = Iter (C# (chr# m#)) 1
98− | otherwise = Iter (chr2 m n) 2
99− where m# = js_charCodeAt j txt
100− n# = js_charCodeAt k txt
101− m = W16# (int2Word# m#)
102− n = W16# (int2Word# n#)
103− j = off + i
104− k = j + 1
105− off = 0
106−#endif
107{-# INLINE iter #-}
75{-# INLINE iter #-}
108
76
109-- | /O(1)/ Iterate one step through a UTF-16 array, returning the
77-- | /O(1)/ Iterate one step through a UTF-16 array, returning the
110-- delta to add to give the next offset to iterate at.
78-- delta to add to give the next offset to iterate at.
111iter_ :: Text -> Int -> Int
79iter_ :: Text -> Int -> Int
112−#ifndef __GHCJS__
113iter_ (Text arr off _len) i | m < 0xD800 || m > 0xDBFF = 1
80iter_ (Text arr off _len) i | m < 0xD800 || m > 0xDBFF = 1
114 | otherwise = 2
81 | otherwise = 2
115 where m = A.unsafeIndex arr (off+i)
82 where m = A.unsafeIndex arr (off+i)
116−#else
117−iter_ (Text txt) i | m < 0xD800 || m > 0xDBFF = 1
118− | otherwise = 2
119− where m# = js_charCodeAt i txt
120− m = W16# (int2Word# m#)
121−#endif
122{-# INLINE iter_ #-}
83{-# INLINE iter_ #-}
123
84
124-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
85-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
125-- returning the current character and the delta to add (i.e. a
86-- returning the current character and the delta to add (i.e. a
126-- negative number) to give the next offset to iterate at.
87-- negative number) to give the next offset to iterate at.
127reverseIter :: Text -> Int -> (Char,Int)
88reverseIter :: Text -> Int -> (Char,Int)
128−#ifndef __GHCJS__
129reverseIter (Text arr off _len) i
89reverseIter (Text arr off _len) i
130 | m < 0xDC00 || m > 0xDFFF = (unsafeChr m, -1)
90 | m < 0xDC00 || m > 0xDFFF = (unsafeChr m, -1)
131 | otherwise = (chr2 n m, -2)
91 | otherwise = (chr2 n m, -2)
@@ -133,78 +93,31 @@ reverseIter (Text arr off _len) i
133 n = A.unsafeIndex arr k
93 n = A.unsafeIndex arr k
134 j = off + i
94 j = off + i
135 k = j - 1
95 k = j - 1
136−#else
137−reverseIter (Text txt) i
138− | m < 0xDC00 || m > 0xDFFF = (C# (chr# m#), -1)
139− | otherwise = (chr2 n m, -2)
140− where m# = js_charCodeAt j txt
141− n# = js_charCodeAt k txt
142− m = W16# (int2Word# m#)
143− n = W16# (int2Word# n#)
144− j = off + i
145− k = j - 1
146− off = 0
147−#endif
148{-# INLINE reverseIter #-}
96{-# INLINE reverseIter #-}
149
97
150-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
98-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
151-- returning the delta to add (i.e. a negative number) to give the
99-- returning the delta to add (i.e. a negative number) to give the
152-- next offset to iterate at.
100-- next offset to iterate at.
153reverseIter_ :: Text -> Int -> Int
101reverseIter_ :: Text -> Int -> Int
154−#ifndef __GHCJS__
155reverseIter_ (Text arr off _len) i
102reverseIter_ (Text arr off _len) i
156 | m < 0xDC00 || m > 0xDFFF = -1
103 | m < 0xDC00 || m > 0xDFFF = -1
157 | otherwise = -2
104 | otherwise = -2
158 where m = A.unsafeIndex arr (off+i)
105 where m = A.unsafeIndex arr (off+i)
159−#else
160−reverseIter_ (Text txt) i
161− | m < 0xDC00 || m > 0xDFFF = -1
162− | otherwise = -2
163− where m# = js_charCodeAt (off + i) txt
164− m = W16# (int2Word# m#)
165− off = 0
166−#endif
167{-# INLINE reverseIter_ #-}
106{-# INLINE reverseIter_ #-}
168
107
169-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
108-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
170-- is useful for sizing a target array appropriately before using
109-- is useful for sizing a target array appropriately before using
171-- 'unsafeCopyToPtr'.
110-- 'unsafeCopyToPtr'.
172lengthWord16 :: Text -> Int
111lengthWord16 :: Text -> Int
173−#ifndef __GHCJS__
174lengthWord16 (Text _arr _off len) = len
112lengthWord16 (Text _arr _off len) = len
175−#else
176−lengthWord16 (Text t) = js_length t
177−#endif
178{-# INLINE lengthWord16 #-}
113{-# INLINE lengthWord16 #-}
179
114
180-- | /O(1)/ Unchecked take of 'k' 'Word16's from the front of a 'Text'.
115-- | /O(1)/ Unchecked take of 'k' 'Word16's from the front of a 'Text'.
181takeWord16 :: Int -> Text -> Text
116takeWord16 :: Int -> Text -> Text
182−#ifndef __GHCJS__
183takeWord16 k (Text arr off _len) = Text arr off k
117takeWord16 k (Text arr off _len) = Text arr off k
184−#else
185−takeWord16 k (Text txt) = Text $ js_take k txt
186−#endif
187{-# INLINE takeWord16 #-}
118{-# INLINE takeWord16 #-}
188
119
189-- | /O(1)/ Unchecked drop of 'k' 'Word16's from the front of a 'Text'.
120-- | /O(1)/ Unchecked drop of 'k' 'Word16's from the front of a 'Text'.
190dropWord16 :: Int -> Text -> Text
121dropWord16 :: Int -> Text -> Text
191−#ifndef __GHCJS__
192dropWord16 k (Text arr off len) = Text arr (off+k) (len-k)
122dropWord16 k (Text arr off len) = Text arr (off+k) (len-k)
193−#else
194−dropWord16 k (Text txt) = Text $ js_drop k txt
195−#endif
196{-# INLINE dropWord16 #-}
123{-# INLINE dropWord16 #-}
197−
198−#ifdef __GHCJS__
199−foreign import javascript unsafe
200− "$2.charCodeAt($1)" js_charCodeAt :: Int -> JSString -> Int#
201−
202−foreign import javascript unsafe
203− "h$jsstringTake" js_take :: Int -> JSString -> JSString
204−
205−foreign import javascript unsafe
206− "h$jsstringDrop" js_drop :: Int -> JSString -> JSString
207−
208−foreign import javascript unsafe
209− "$1.length" js_length :: JSString -> Int
210−#endif
text.cabal+60−65
@@ -88,13 +88,13 @@ library
88 Data.Text.Array
88 Data.Text.Array
89 Data.Text.Encoding
89 Data.Text.Encoding
90 Data.Text.Encoding.Error
90 Data.Text.Encoding.Error
91− -- Data.Text.Foreign
91+ Data.Text.Foreign
92 Data.Text.IO
92 Data.Text.IO
93 Data.Text.Internal
93 Data.Text.Internal
94 Data.Text.Internal.Builder
94 Data.Text.Internal.Builder
95− -- Data.Text.Internal.Builder.Functions
95+ Data.Text.Internal.Builder.Functions
96− -- Data.Text.Internal.Builder.Int.Digits
96+ Data.Text.Internal.Builder.Int.Digits
97− -- Data.Text.Internal.Builder.RealFloat.Functions
97+ Data.Text.Internal.Builder.RealFloat.Functions
98 Data.Text.Internal.Encoding.Fusion
98 Data.Text.Internal.Encoding.Fusion
99 Data.Text.Internal.Encoding.Fusion.Common
99 Data.Text.Internal.Encoding.Fusion.Common
100 Data.Text.Internal.Encoding.Utf16
100 Data.Text.Internal.Encoding.Utf16
@@ -106,14 +106,14 @@ library
106 Data.Text.Internal.Fusion.Common
106 Data.Text.Internal.Fusion.Common
107 Data.Text.Internal.Fusion.Size
107 Data.Text.Internal.Fusion.Size
108 Data.Text.Internal.Fusion.Types
108 Data.Text.Internal.Fusion.Types
109− -- Data.Text.Internal.IO
109+ Data.Text.Internal.IO
110 Data.Text.Internal.Lazy
110 Data.Text.Internal.Lazy
111− -- Data.Text.Internal.Lazy.Encoding.Fusion
111+ Data.Text.Internal.Lazy.Encoding.Fusion
112 Data.Text.Internal.Lazy.Fusion
112 Data.Text.Internal.Lazy.Fusion
113 Data.Text.Internal.Lazy.Search
113 Data.Text.Internal.Lazy.Search
114− -- Data.Text.Internal.Private
114+ Data.Text.Internal.Private
115 Data.Text.Internal.Read
115 Data.Text.Internal.Read
116− -- Data.Text.Internal.Search
116+ Data.Text.Internal.Search
117 Data.Text.Internal.Unsafe
117 Data.Text.Internal.Unsafe
118 Data.Text.Internal.Unsafe.Char
118 Data.Text.Internal.Unsafe.Char
119 Data.Text.Internal.Unsafe.Shift
119 Data.Text.Internal.Unsafe.Shift
@@ -124,23 +124,18 @@ library
124 Data.Text.Lazy.Encoding
124 Data.Text.Lazy.Encoding
125 Data.Text.Lazy.IO
125 Data.Text.Lazy.IO
126 Data.Text.Lazy.Internal
126 Data.Text.Lazy.Internal
127− -- Data.Text.Lazy.Read
127+ Data.Text.Lazy.Read
128 Data.Text.Read
128 Data.Text.Read
129 Data.Text.Unsafe
129 Data.Text.Unsafe
130
130
131− -- moved from ghcjs-base
132− -- reflex-dom depends in it
133− Data.JSString.Text
134− -- other-modules:
131+ other-modules:
135− -- Data.Text.Show
132+ Data.Text.Show
136
133
137 build-depends:
134 build-depends:
138− -- array >= 0.3,
135+ array >= 0.3,
139 base >= 4.2 && < 5,
136 base >= 4.2 && < 5,
140 binary,
137 binary,
141 deepseq >= 1.1.0.0,
138 deepseq >= 1.1.0.0,
142− ghcjs-base,
143− ghcjs-prim,
144 ghc-prim >= 0.2
139 ghc-prim >= 0.2
145
140
146 if flag(bytestring-builder)
141 if flag(bytestring-builder)
@@ -163,51 +158,51 @@ library
163 cpp-options: -DINTEGER_GMP
158 cpp-options: -DINTEGER_GMP
164 build-depends: integer-gmp >= 0.2
159 build-depends: integer-gmp >= 0.2
165
160
166−-- test-suite tests
161+test-suite tests
167−-- type: exitcode-stdio-1.0
162+ type: exitcode-stdio-1.0
168−-- hs-source-dirs: tests .
163+ hs-source-dirs: tests .
169−-- main-is: Tests.hs
164+ main-is: Tests.hs
170−-- c-sources: cbits/cbits.c
165+ c-sources: cbits/cbits.c
171−-- include-dirs: include
166+ include-dirs: include
172−
167+
173−-- ghc-options:
168+ ghc-options:
174−-- -Wall -threaded -O0 -rtsopts
169+ -Wall -threaded -O0 -rtsopts
175−
170+
176−-- cpp-options:
171+ cpp-options:
177−-- -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE
172+ -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE
178−
173+
179−-- build-depends:
174+ build-depends:
180−-- HUnit >= 1.2,
175+ HUnit >= 1.2,
181−-- QuickCheck >= 2.7,
176+ QuickCheck >= 2.7,
182−-- array,
177+ array,
183−-- base,
178+ base,
184−-- binary,
179+ binary,
185−-- deepseq,
180+ deepseq,
186−-- directory,
181+ directory,
187−-- ghc-prim,
182+ ghc-prim,
188−-- quickcheck-unicode,
183+ quickcheck-unicode,
189−-- random,
184+ random,
190−-- test-framework >= 0.4,
185+ test-framework >= 0.4,
191−-- test-framework-hunit >= 0.2,
186+ test-framework-hunit >= 0.2,
192−-- test-framework-quickcheck2 >= 0.2
187+ test-framework-quickcheck2 >= 0.2
193−
188+
194−-- if flag(bytestring-builder)
189+ if flag(bytestring-builder)
195−-- build-depends: bytestring >= 0.9 && < 0.10.4,
190+ build-depends: bytestring >= 0.9 && < 0.10.4,
196−-- bytestring-builder >= 0.10.4
191+ bytestring-builder >= 0.10.4
197−-- else
192+ else
198−-- build-depends: bytestring >= 0.10.4
193+ build-depends: bytestring >= 0.10.4
199−
194+
200−-- if flag(integer-simple)
195+ if flag(integer-simple)
201−-- cpp-options: -DINTEGER_SIMPLE
196+ cpp-options: -DINTEGER_SIMPLE
202−-- build-depends: integer-simple >= 0.1 && < 0.5
197+ build-depends: integer-simple >= 0.1 && < 0.5
203−-- else
198+ else
204−-- cpp-options: -DINTEGER_GMP
199+ cpp-options: -DINTEGER_GMP
205−-- build-depends: integer-gmp >= 0.2
200+ build-depends: integer-gmp >= 0.2
206−
201+
207−-- source-repository head
202+source-repository head
208−-- type: git
203+ type: git
209−-- location: https://github.com/bos/text
204+ location: https://github.com/bos/text
210−
205+
211−-- source-repository head
206+source-repository head
212−-- type: mercurial
207+ type: mercurial
213−-- location: https://bitbucket.org/bos/text
208+ location: https://bitbucket.org/bos/text