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