@@ -14,971 +14,925 @@
1414--
1515-- Common stream fusion functionality for text.
1616
17−module Data.Text.Internal.Fusion.Common (module Data.JSString.Internal.Fusion.Common) where
18−import Data.JSString.Internal.Fusion.Common
19−-- module Data.Text.Internal.Fusion.Common
20−-- (
21−-- -- * Creation and elimination
22−-- singleton
23−-- , streamList
24−-- , unstreamList
25−-- , streamCString#
26−
27−-- -- * Basic interface
28−-- , cons
29−-- , snoc
30−-- , append
31−-- , head
32−-- , uncons
33−-- , last
34−-- , tail
35−-- , init
36−-- , null
37−-- , lengthI
38−-- , compareLengthI
39−-- , isSingleton
40−
41−-- -- * Transformations
42−-- , map
43−-- , intercalate
44−-- , intersperse
45−
46−-- -- ** Case conversion
47−-- -- $case
48−-- , toCaseFold
49−-- , toLower
50−-- , toTitle
51−-- , toUpper
52−
53−-- -- ** Justification
54−-- , justifyLeftI
55−
56−-- -- * Folds
57−-- , foldl
58−-- , foldl'
59−-- , foldl1
60−-- , foldl1'
61−-- , foldr
62−-- , foldr1
63−
64−-- -- ** Special folds
65−-- , concat
66−-- , concatMap
67−-- , any
68−-- , all
69−-- , maximum
70−-- , minimum
71−
72−-- -- * Construction
73−-- -- ** Scans
74−-- , scanl
75−
76−-- -- ** Generation and unfolding
77−-- , replicateCharI
78−-- , replicateI
79−-- , unfoldr
80−-- , unfoldrNI
81−
82−-- -- * Substrings
83−-- -- ** Breaking strings
84−-- , take
85−-- , drop
86−-- , takeWhile
87−-- , dropWhile
88−
89−-- -- * Predicates
90−-- , isPrefixOf
91−
92−-- -- * Searching
93−-- , elem
94−-- , filter
95−
96−-- -- * Indexing
97−-- , findBy
98−-- , indexI
99−-- , findIndexI
100−-- , countCharI
101−
102−-- -- * Zipping and unzipping
103−-- , zipWith
104−-- ) where
105−
106−-- import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
107−-- Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),
108−-- (&&), fromIntegral, otherwise)
109−-- import qualified Data.List as L
110−-- import qualified Prelude as P
111−-- import Data.Bits (shiftL)
112−-- import Data.Char (isLetter)
113−-- import Data.Int (Int64)
114−-- import Data.Text.Internal.Fusion.Types
115−-- import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,
116−-- upperMapping)
117−-- import Data.Text.Internal.Fusion.Size
118−-- import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)
119−-- import GHC.Types (Char(..), Int(..))
120−
121−-- singleton :: Char -> Stream Char
122−-- singleton c = Stream next False -- 1
123−-- where next False = Yield c True
124−-- next True = Done
125−-- {-# INLINE [0] singleton #-}
126−
127−-- streamList :: [a] -> Stream a
128−-- {-# INLINE [0] streamList #-}
129−-- streamList s = Stream next s -- unknownSize
130−-- where next [] = Done
131−-- next (x:xs) = Yield x xs
132−
133−-- unstreamList :: Stream a -> [a]
134−-- -- unstreamList (Stream next s0 _len) = unfold s0
135−-- unstreamList (Stream next s0) = unfold s0
136−-- where unfold !s = case next s of
137−-- Done -> []
138−-- Skip s' -> unfold s'
139−-- Yield x s' -> x : unfold s'
140−-- {-# INLINE [0] unstreamList #-}
141−
142−-- {-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}
143−
144−-- -- | Stream the UTF-8-like packed encoding used by GHC to represent
145−-- -- constant strings in generated code.
146−-- --
147−-- -- This encoding uses the byte sequence "\xc0\x80" to represent NUL,
148−-- -- and the string is NUL-terminated.
149−-- streamCString# :: Addr# -> Stream Char
150−-- streamCString# addr = Stream step 0 -- unknownSize
151−-- where
152−-- step !i
153−-- | b == 0 = Done
154−-- | b <= 0x7f = Yield (C# b#) (i+1)
155−-- | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1
156−-- in Yield c (i+2)
157−-- | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +
158−-- (next 1 `shiftL` 6) +
159−-- next 2
160−-- in Yield c (i+3)
161−-- | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +
162−-- (next 1 `shiftL` 12) +
163−-- (next 2 `shiftL` 6) +
164−-- next 3
165−-- in Yield c (i+4)
166−-- where b = I# (ord# b#)
167−-- next n = I# (ord# (at# (i+n))) - 0x80
168−-- !b# = at# i
169−-- at# (I# i#) = indexCharOffAddr# addr i#
170−-- chr (I# i#) = C# (chr# i#)
171−-- {-# INLINE [0] streamCString# #-}
172−
173−-- -- ----------------------------------------------------------------------------
174−-- -- * Basic stream functions
175−
176−-- data C s = C0 !s
177−-- | C1 !s
178−
179−-- -- | /O(n)/ Adds a character to the front of a Stream Char.
180−-- cons :: Char -> Stream Char -> Stream Char
181−-- -- cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
182−-- cons !w (Stream next0 s0) = Stream next (C1 s0) -- (len+1)
183−-- where
184−-- next (C1 s) = Yield w (C0 s)
185−-- next (C0 s) = case next0 s of
186−-- Done -> Done
187−-- Skip s' -> Skip (C0 s')
188−-- Yield x s' -> Yield x (C0 s')
189−-- {-# INLINE [0] cons #-}
190−
191−-- data Snoc a = N
192−-- | J !a
193−
194−-- -- | /O(n)/ Adds a character to the end of a stream.
195−-- snoc :: Stream Char -> Char -> Stream Char
196−-- -- snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
197−-- snoc (Stream next0 xs0) w = Stream next (J xs0) -- (len+1)
198−-- where
199−-- next (J xs) = case next0 xs of
200−-- Done -> Yield w N
201−-- Skip xs' -> Skip (J xs')
202−-- Yield x xs' -> Yield x (J xs')
203−-- next N = Done
204−-- {-# INLINE [0] snoc #-}
205−
206−-- data E l r = L !l
207−-- | R !r
208−
209−-- -- | /O(n)/ Appends one Stream to the other.
210−-- append :: Stream Char -> Stream Char -> Stream Char
211−-- -- append (Stream next0 s01 len1) (Stream next1 s02 len2) =
212−-- -- Stream next (L s01) (len1 + len2)
213−-- append (Stream next0 s01) (Stream next1 s02) =
214−-- Stream next (L s01)
215−-- where
216−-- next (L s1) = case next0 s1 of
217−-- Done -> Skip (R s02)
218−-- Skip s1' -> Skip (L s1')
219−-- Yield x s1' -> Yield x (L s1')
220−-- next (R s2) = case next1 s2 of
221−-- Done -> Done
222−-- Skip s2' -> Skip (R s2')
223−-- Yield x s2' -> Yield x (R s2')
224−-- {-# INLINE [0] append #-}
225−
226−-- -- | /O(1)/ Returns the first character of a Text, which must be non-empty.
227−-- -- Subject to array fusion.
228−-- head :: Stream Char -> Char
229−-- -- head (Stream next s0 _len) = loop_head s0
230−-- head (Stream next s0) = loop_head s0
231−-- where
232−-- loop_head !s = case next s of
233−-- Yield x _ -> x
234−-- Skip s' -> loop_head s'
235−-- Done -> head_empty
236−-- {-# INLINE [0] head #-}
237−
238−-- head_empty :: a
239−-- head_empty = streamError "head" "Empty stream"
240−-- {-# NOINLINE head_empty #-}
241−
242−-- -- | /O(1)/ Returns the first character and remainder of a 'Stream
243−-- -- Char', or 'Nothing' if empty. Subject to array fusion.
244−-- uncons :: Stream Char -> Maybe (Char, Stream Char)
245−-- -- uncons (Stream next s0 len) = loop_uncons s0
246−-- uncons (Stream next s0) = loop_uncons s0
247−-- where
248−-- loop_uncons !s = case next s of
249−-- Yield x s1 -> Just (x, Stream next s1)
250−-- Skip s' -> loop_uncons s'
251−-- Done -> Nothing
252−-- {-# INLINE [0] uncons #-}
253−
254−-- -- | /O(n)/ Returns the last character of a 'Stream Char', which must
255−-- -- be non-empty.
256−-- last :: Stream Char -> Char
257−-- -- last (Stream next s0 _len) = loop0_last s0
258−-- last (Stream next s0) = loop0_last s0
259−-- where
260−-- loop0_last !s = case next s of
261−-- Done -> emptyError "last"
262−-- Skip s' -> loop0_last s'
263−-- Yield x s' -> loop_last x s'
264−-- loop_last !x !s = case next s of
265−-- Done -> x
266−-- Skip s' -> loop_last x s'
267−-- Yield x' s' -> loop_last x' s'
268−-- {-# INLINE[0] last #-}
269−
270−-- -- | /O(1)/ Returns all characters after the head of a Stream Char, which must
271−-- -- be non-empty.
272−-- tail :: Stream Char -> Stream Char
273−-- -- tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)
274−-- tail (Stream next0 s0) = Stream next (C0 s0) -- (len-1)
275−-- where
276−-- next (C0 s) = case next0 s of
277−-- Done -> emptyError "tail"
278−-- Skip s' -> Skip (C0 s')
279−-- Yield _ s' -> Skip (C1 s')
280−-- next (C1 s) = case next0 s of
281−-- Done -> Done
282−-- Skip s' -> Skip (C1 s')
283−-- Yield x s' -> Yield x (C1 s')
284−-- {-# INLINE [0] tail #-}
285−
286−-- data Init s = Init0 !s
287−-- | Init1 {-# UNPACK #-} !Char !s
288−
289−-- -- | /O(1)/ Returns all but the last character of a Stream Char, which
290−-- -- must be non-empty.
291−-- init :: Stream Char -> Stream Char
292−-- -- init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)
293−-- init (Stream next0 s0) = Stream next (Init0 s0) -- (len-1)
294−-- where
295−-- next (Init0 s) = case next0 s of
296−-- Done -> emptyError "init"
297−-- Skip s' -> Skip (Init0 s')
298−-- Yield x s' -> Skip (Init1 x s')
299−-- next (Init1 x s) = case next0 s of
300−-- Done -> Done
301−-- Skip s' -> Skip (Init1 x s')
302−-- Yield x' s' -> Yield x (Init1 x' s')
303−-- {-# INLINE [0] init #-}
304−
305−-- -- | /O(1)/ Tests whether a Stream Char is empty or not.
306−-- null :: Stream Char -> Bool
307−-- -- null (Stream next s0 _len) = loop_null s0
308−-- null (Stream next s0) = loop_null s0
309−-- where
310−-- loop_null !s = case next s of
311−-- Done -> True
312−-- Yield _ _ -> False
313−-- Skip s' -> loop_null s'
314−-- {-# INLINE[0] null #-}
315−
316−-- -- | /O(n)/ Returns the number of characters in a string.
317−-- lengthI :: Integral a => Stream Char -> a
318−-- -- lengthI (Stream next s0 _len) = loop_length 0 s0
319−-- lengthI (Stream next s0) = loop_length 0 s0
320−-- where
321−-- loop_length !z s = case next s of
322−-- Done -> z
323−-- Skip s' -> loop_length z s'
324−-- Yield _ s' -> loop_length (z + 1) s'
325−-- {-# INLINE[0] lengthI #-}
326−
327−-- -- | /O(n)/ Compares the count of characters in a string to a number.
328−-- -- Subject to fusion.
329−-- --
330−-- -- This function gives the same answer as comparing against the result
331−-- -- of 'lengthI', but can short circuit if the count of characters is
332−-- -- greater than the number or if the stream can't possibly be as long
333−-- -- as the number supplied, and hence be more efficient.
334−-- compareLengthI :: Integral a => Stream Char -> a -> Ordering
335−-- -- compareLengthI (Stream next s0 len) n =
336−-- compareLengthI (Stream next s0) n =
337−-- -- case compareSize len (fromIntegral n) of
338−-- -- Just o -> o
339−-- -- Nothing -> loop_cmp 0 s0
340−-- loop_cmp 0 s0
341−-- where
342−-- loop_cmp !z s = case next s of
343−-- Done -> compare z n
344−-- Skip s' -> loop_cmp z s'
345−-- Yield _ s' | z > n -> GT
346−-- | otherwise -> loop_cmp (z + 1) s'
347−-- {-# INLINE[0] compareLengthI #-}
348−
349−-- -- | /O(n)/ Indicate whether a string contains exactly one element.
350−-- isSingleton :: Stream Char -> Bool
351−-- -- isSingleton (Stream next s0 _len) = loop 0 s0
352−-- isSingleton (Stream next s0) = loop 0 s0
353−-- where
354−-- loop !z s = case next s of
355−-- Done -> z == (1::Int)
356−-- Skip s' -> loop z s'
357−-- Yield _ s'
358−-- | z >= 1 -> False
359−-- | otherwise -> loop (z+1) s'
360−-- {-# INLINE[0] isSingleton #-}
361−
362−-- -- ----------------------------------------------------------------------------
363−-- -- * Stream transformations
364−
365−-- -- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@
366−-- -- to each element of @xs@.
367−-- map :: (Char -> Char) -> Stream Char -> Stream Char
368−-- -- map f (Stream next0 s0 len) = Stream next s0 len
369−-- map f (Stream next0 s0) = Stream next s0 -- len
370−-- where
371−-- next !s = case next0 s of
372−-- Done -> Done
373−-- Skip s' -> Skip s'
374−-- Yield x s' -> Yield (f x) s'
375−-- {-# INLINE [0] map #-}
376−
377−-- {-#
378−-- RULES "STREAM map/map fusion" forall f g s.
379−-- map f (map g s) = map (\x -> f (g x)) s
380−-- #-}
381−
382−-- data I s = I1 !s
383−-- | I2 !s {-# UNPACK #-} !Char
384−-- | I3 !s
385−
386−-- -- | /O(n)/ Take a character and place it between each of the
387−-- -- characters of a 'Stream Char'.
388−-- intersperse :: Char -> Stream Char -> Stream Char
389−-- intersperse c (Stream next0 s0) = Stream next (I1 s0) -- len
390−-- -- intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len
391−-- where
392−-- next (I1 s) = case next0 s of
393−-- Done -> Done
394−-- Skip s' -> Skip (I1 s')
395−-- Yield x s' -> Skip (I2 s' x)
396−-- next (I2 s x) = Yield x (I3 s)
397−-- next (I3 s) = case next0 s of
398−-- Done -> Done
399−-- Skip s' -> Skip (I3 s')
400−-- Yield x s' -> Yield c (I2 s' x)
401−-- {-# INLINE [0] intersperse #-}
402−
403−-- -- ----------------------------------------------------------------------------
404−-- -- ** Case conversions (folds)
405−
406−-- -- $case
407−-- --
408−-- -- With Unicode text, it is incorrect to use combinators like @map
409−-- -- toUpper@ to case convert each character of a string individually.
410−-- -- Instead, use the whole-string case conversion functions from this
411−-- -- module. For correctness in different writing systems, these
412−-- -- functions may map one input character to two or three output
413−-- -- characters.
414−
415−-- caseConvert :: (forall s. Char -> s -> Step (CC s) Char)
416−-- -> Stream Char -> Stream Char
417−-- -- caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len
418−-- caseConvert remap (Stream next0 s0) = Stream next (CC s0 '\0' '\0') -- len
419−-- where
420−-- next (CC s '\0' _) =
421−-- case next0 s of
422−-- Done -> Done
423−-- Skip s' -> Skip (CC s' '\0' '\0')
424−-- Yield c s' -> remap c s'
425−-- next (CC s a b) = Yield a (CC s b '\0')
426−
427−-- -- | /O(n)/ Convert a string to folded case. This function is mainly
428−-- -- useful for performing caseless (or case insensitive) string
429−-- -- comparisons.
430−-- --
431−-- -- A string @x@ is a caseless match for a string @y@ if and only if:
432−-- --
433−-- -- @toCaseFold x == toCaseFold y@
434−-- --
435−-- -- The result string may be longer than the input string, and may
436−-- -- differ from applying 'toLower' to the input string. For instance,
437−-- -- the Armenian small ligature men now (U+FB13) is case folded to the
438−-- -- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is
439−-- -- case folded to the Greek small letter letter mu (U+03BC) instead of
440−-- -- itself.
441−-- toCaseFold :: Stream Char -> Stream Char
442−-- toCaseFold = caseConvert foldMapping
443−-- {-# INLINE [0] toCaseFold #-}
444−
445−-- -- | /O(n)/ Convert a string to upper case, using simple case
446−-- -- conversion. The result string may be longer than the input string.
447−-- -- For instance, the German eszett (U+00DF) maps to the two-letter
448−-- -- sequence SS.
449−-- toUpper :: Stream Char -> Stream Char
450−-- toUpper = caseConvert upperMapping
451−-- {-# INLINE [0] toUpper #-}
452−
453−-- -- | /O(n)/ Convert a string to lower case, using simple case
454−-- -- conversion. The result string may be longer than the input string.
455−-- -- For instance, the Latin capital letter I with dot above (U+0130)
456−-- -- maps to the sequence Latin small letter i (U+0069) followed by
457−-- -- combining dot above (U+0307).
458−-- toLower :: Stream Char -> Stream Char
459−-- toLower = caseConvert lowerMapping
460−-- {-# INLINE [0] toLower #-}
461−
462−-- -- | /O(n)/ Convert a string to title case, using simple case
463−-- -- conversion.
464−-- --
465−-- -- The first letter of the input is converted to title case, as is
466−-- -- every subsequent letter that immediately follows a non-letter.
467−-- -- Every letter that immediately follows another letter is converted
468−-- -- to lower case.
469−-- --
470−-- -- The result string may be longer than the input string. For example,
471−-- -- the Latin small ligature fl (U+FB02) is converted to the
472−-- -- sequence Latin capital letter F (U+0046) followed by Latin small
473−-- -- letter l (U+006C).
474−-- --
475−-- -- /Note/: this function does not take language or culture specific
476−-- -- rules into account. For instance, in English, different style
477−-- -- guides disagree on whether the book name \"The Hill of the Red
478−-- -- Fox\" is correctly title cased—but this function will
479−-- -- capitalize /every/ word.
480−-- toTitle :: Stream Char -> Stream Char
481−-- -- toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len
482−-- toTitle (Stream next0 s0) = Stream next (CC (False :*: s0) '\0' '\0') -- len
483−-- where
484−-- next (CC (letter :*: s) '\0' _) =
485−-- case next0 s of
486−-- Done -> Done
487−-- Skip s' -> Skip (CC (letter :*: s') '\0' '\0')
488−-- Yield c s'
489−-- | letter' -> if letter
490−-- then lowerMapping c (letter' :*: s')
491−-- else titleMapping c (letter' :*: s')
492−-- | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')
493−-- where letter' = isLetter c
494−-- next (CC s a b) = Yield a (CC s b '\0')
495−-- {-# INLINE [0] toTitle #-}
496−
497−-- data Justify i s = Just1 !i !s
498−-- | Just2 !i !s
499−
500−-- justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
501−-- -- justifyLeftI k c (Stream next0 s0 len) =
502−-- justifyLeftI k c (Stream next0 s0) =
503−-- Stream next (Just1 0 s0) -- (larger (fromIntegral k) len)
504−-- where
505−-- next (Just1 n s) =
506−-- case next0 s of
507−-- Done -> next (Just2 n s)
508−-- Skip s' -> Skip (Just1 n s')
509−-- Yield x s' -> Yield x (Just1 (n+1) s')
510−-- next (Just2 n s)
511−-- | n < k = Yield c (Just2 (n+1) s)
512−-- | otherwise = Done
513−-- {-# INLINE next #-}
514−-- {-# INLINE [0] justifyLeftI #-}
515−
516−-- -- ----------------------------------------------------------------------------
517−-- -- * Reducing Streams (folds)
518−
519−-- -- | foldl, applied to a binary operator, a starting value (typically the
520−-- -- left-identity of the operator), and a Stream, reduces the Stream using the
521−-- -- binary operator, from left to right.
522−-- foldl :: (b -> Char -> b) -> b -> Stream Char -> b
523−-- -- foldl f z0 (Stream next s0 _len) = loop_foldl z0 s0
524−-- foldl f z0 (Stream next s0) = loop_foldl z0 s0
525−-- where
526−-- loop_foldl z !s = case next s of
527−-- Done -> z
528−-- Skip s' -> loop_foldl z s'
529−-- Yield x s' -> loop_foldl (f z x) s'
530−-- {-# INLINE [0] foldl #-}
531−
532−-- -- | A strict version of foldl.
533−-- foldl' :: (b -> Char -> b) -> b -> Stream Char -> b
534−-- -- foldl' f z0 (Stream next s0 _len) = loop_foldl' z0 s0
535−-- foldl' f z0 (Stream next s0) = loop_foldl' z0 s0
536−-- where
537−-- loop_foldl' !z !s = case next s of
538−-- Done -> z
539−-- Skip s' -> loop_foldl' z s'
540−-- Yield x s' -> loop_foldl' (f z x) s'
541−-- {-# INLINE [0] foldl' #-}
542−
543−-- -- | foldl1 is a variant of foldl that has no starting value argument,
544−-- -- and thus must be applied to non-empty Streams.
545−-- foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char
546−-- -- foldl1 f (Stream next s0 _len) = loop0_foldl1 s0
547−-- foldl1 f (Stream next s0) = loop0_foldl1 s0
548−-- where
549−-- loop0_foldl1 !s = case next s of
550−-- Skip s' -> loop0_foldl1 s'
551−-- Yield x s' -> loop_foldl1 x s'
552−-- Done -> emptyError "foldl1"
553−-- loop_foldl1 z !s = case next s of
554−-- Done -> z
555−-- Skip s' -> loop_foldl1 z s'
556−-- Yield x s' -> loop_foldl1 (f z x) s'
557−-- {-# INLINE [0] foldl1 #-}
558−
559−-- -- | A strict version of foldl1.
560−-- foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char
561−-- -- foldl1' f (Stream next s0 _len) = loop0_foldl1' s0
562−-- foldl1' f (Stream next s0) = loop0_foldl1' s0
563−-- where
564−-- loop0_foldl1' !s = case next s of
565−-- Skip s' -> loop0_foldl1' s'
566−-- Yield x s' -> loop_foldl1' x s'
567−-- Done -> emptyError "foldl1"
568−-- loop_foldl1' !z !s = case next s of
569−-- Done -> z
570−-- Skip s' -> loop_foldl1' z s'
571−-- Yield x s' -> loop_foldl1' (f z x) s'
572−-- {-# INLINE [0] foldl1' #-}
573−
574−-- -- | 'foldr', applied to a binary operator, a starting value (typically the
575−-- -- right-identity of the operator), and a stream, reduces the stream using the
576−-- -- binary operator, from right to left.
577−-- foldr :: (Char -> b -> b) -> b -> Stream Char -> b
578−-- -- foldr f z (Stream next s0 _len) = loop_foldr s0
579−-- foldr f z (Stream next s0) = loop_foldr s0
580−-- where
581−-- loop_foldr !s = case next s of
582−-- Done -> z
583−-- Skip s' -> loop_foldr s'
584−-- Yield x s' -> f x (loop_foldr s')
585−-- {-# INLINE [0] foldr #-}
586−
587−-- -- | foldr1 is a variant of 'foldr' that has no starting value argument,
588−-- -- and thus must be applied to non-empty streams.
589−-- -- Subject to array fusion.
590−-- foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char
591−-- -- foldr1 f (Stream next s0 _len) = loop0_foldr1 s0
592−-- foldr1 f (Stream next s0) = loop0_foldr1 s0
593−-- where
594−-- loop0_foldr1 !s = case next s of
595−-- Done -> emptyError "foldr1"
596−-- Skip s' -> loop0_foldr1 s'
597−-- Yield x s' -> loop_foldr1 x s'
598−
599−-- loop_foldr1 x !s = case next s of
600−-- Done -> x
601−-- Skip s' -> loop_foldr1 x s'
602−-- Yield x' s' -> f x (loop_foldr1 x' s')
603−-- {-# INLINE [0] foldr1 #-}
604−
605−-- intercalate :: Stream Char -> [Stream Char] -> Stream Char
606−-- intercalate s = concat . (L.intersperse s)
607−-- {-# INLINE [0] intercalate #-}
608−
609−-- -- ----------------------------------------------------------------------------
610−-- -- ** Special folds
611−
612−-- -- | /O(n)/ Concatenate a list of streams. Subject to array fusion.
613−-- concat :: [Stream Char] -> Stream Char
614−-- concat = L.foldr append empty
615−-- {-# INLINE [0] concat #-}
616−
617−-- -- | Map a function over a stream that results in a stream and concatenate the
618−-- -- results.
619−-- concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char
620−-- concatMap f = foldr (append . f) empty
621−-- {-# INLINE [0] concatMap #-}
622−
623−-- -- | /O(n)/ any @p @xs determines if any character in the stream
624−-- -- @xs@ satisfies the predicate @p@.
625−-- any :: (Char -> Bool) -> Stream Char -> Bool
626−-- -- any p (Stream next0 s0 _len) = loop_any s0
627−-- any p (Stream next0 s0) = loop_any s0
628−-- where
629−-- loop_any !s = case next0 s of
630−-- Done -> False
631−-- Skip s' -> loop_any s'
632−-- Yield x s' | p x -> True
633−-- | otherwise -> loop_any s'
634−-- {-# INLINE [0] any #-}
635−
636−-- -- | /O(n)/ all @p @xs determines if all characters in the 'Text'
637−-- -- @xs@ satisfy the predicate @p@.
638−-- all :: (Char -> Bool) -> Stream Char -> Bool
639−-- -- all p (Stream next0 s0 _len) = loop_all s0
640−-- all p (Stream next0 s0) = loop_all s0
641−-- where
642−-- loop_all !s = case next0 s of
643−-- Done -> True
644−-- Skip s' -> loop_all s'
645−-- Yield x s' | p x -> loop_all s'
646−-- | otherwise -> False
647−-- {-# INLINE [0] all #-}
648−
649−-- -- | /O(n)/ maximum returns the maximum value from a stream, which must be
650−-- -- non-empty.
651−-- maximum :: Stream Char -> Char
652−-- -- maximum (Stream next0 s0 _len) = loop0_maximum s0
653−-- maximum (Stream next0 s0) = loop0_maximum s0
654−-- where
655−-- loop0_maximum !s = case next0 s of
656−-- Done -> emptyError "maximum"
657−-- Skip s' -> loop0_maximum s'
658−-- Yield x s' -> loop_maximum x s'
659−-- loop_maximum !z !s = case next0 s of
660−-- Done -> z
661−-- Skip s' -> loop_maximum z s'
662−-- Yield x s'
663−-- | x > z -> loop_maximum x s'
664−-- | otherwise -> loop_maximum z s'
665−-- {-# INLINE [0] maximum #-}
666−
667−-- -- | /O(n)/ minimum returns the minimum value from a 'Text', which must be
668−-- -- non-empty.
669−-- minimum :: Stream Char -> Char
670−-- -- minimum (Stream next0 s0 _len) = loop0_minimum s0
671−-- minimum (Stream next0 s0) = loop0_minimum s0
672−-- where
673−-- loop0_minimum !s = case next0 s of
674−-- Done -> emptyError "minimum"
675−-- Skip s' -> loop0_minimum s'
676−-- Yield x s' -> loop_minimum x s'
677−-- loop_minimum !z !s = case next0 s of
678−-- Done -> z
679−-- Skip s' -> loop_minimum z s'
680−-- Yield x s'
681−-- | x < z -> loop_minimum x s'
682−-- | otherwise -> loop_minimum z s'
683−-- {-# INLINE [0] minimum #-}
684−
685−-- -- -----------------------------------------------------------------------------
686−-- -- * Building streams
687−
688−-- scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
689−-- -- scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
690−-- scanl f z0 (Stream next0 s0) = Stream next (Scan1 z0 s0) -- (len+1) -- HINT maybe too low
691−-- where
692−-- {-# INLINE next #-}
693−-- next (Scan1 z s) = Yield z (Scan2 z s)
694−-- next (Scan2 z s) = case next0 s of
695−-- Yield x s' -> let !x' = f z x
696−-- in Yield x' (Scan2 x' s')
697−-- Skip s' -> Skip (Scan2 z s')
698−-- Done -> Done
699−-- {-# INLINE [0] scanl #-}
700−
701−-- -- -----------------------------------------------------------------------------
702−-- -- ** Generating and unfolding streams
703−
704−-- replicateCharI :: Integral a => a -> Char -> Stream Char
705−-- replicateCharI n c
706−-- | n < 0 = empty
707−-- | otherwise = Stream next 0 -- (fromIntegral n) -- HINT maybe too low
708−-- where
709−-- next i | i >= n = Done
710−-- | otherwise = Yield c (i + 1)
711−-- {-# INLINE [0] replicateCharI #-}
712−
713−-- data RI s = RI !s {-# UNPACK #-} !Int64
714−
715−-- replicateI :: Int64 -> Stream Char -> Stream Char
716−-- -- replicateI n (Stream next0 s0 len) =
717−-- replicateI n (Stream next0 s0) =
718−-- Stream next (RI s0 0) -- (fromIntegral (max 0 n) * len)
719−-- where
720−-- next (RI s k)
721−-- | k >= n = Done
722−-- | otherwise = case next0 s of
723−-- Done -> Skip (RI s0 (k+1))
724−-- Skip s' -> Skip (RI s' k)
725−-- Yield x s' -> Yield x (RI s' k)
726−-- {-# INLINE [0] replicateI #-}
727−
728−-- -- | /O(n)/, where @n@ is the length of the result. The unfoldr function
729−-- -- is analogous to the List 'unfoldr'. unfoldr builds a stream
730−-- -- from a seed value. The function takes the element and returns
731−-- -- Nothing if it is done producing the stream or returns Just
732−-- -- (a,b), in which case, a is the next Char in the string, and b is
733−-- -- the seed value for further production.
734−-- unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char
735−-- unfoldr f s0 = Stream next s0 -- 1 -- HINT maybe too low
736−-- where
737−-- {-# INLINE next #-}
738−-- next !s = case f s of
739−-- Nothing -> Done
740−-- Just (w, s') -> Yield w s'
741−-- {-# INLINE [0] unfoldr #-}
742−
743−-- -- | /O(n)/ Like 'unfoldr', 'unfoldrNI' builds a stream from a seed
744−-- -- value. However, the length of the result is limited by the
745−-- -- first argument to 'unfoldrNI'. This function is more efficient than
746−-- -- 'unfoldr' when the length of the result is known.
747−-- unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char
748−-- unfoldrNI n f s0 | n < 0 = empty
749−-- | otherwise = Stream next (0 :*: s0) -- (fromIntegral (n*2)) -- HINT maybe too high
750−-- where
751−-- {-# INLINE next #-}
752−-- next (z :*: s) = case f s of
753−-- Nothing -> Done
754−-- Just (w, s') | z >= n -> Done
755−-- | otherwise -> Yield w ((z + 1) :*: s')
756−-- {-# INLINE unfoldrNI #-}
757−
758−-- -------------------------------------------------------------------------------
759−-- -- * Substreams
760−
761−-- -- | /O(n)/ take n, applied to a stream, returns the prefix of the
762−-- -- stream of length @n@, or the stream itself if @n@ is greater than the
763−-- -- length of the stream.
764−-- take :: Integral a => a -> Stream Char -> Stream Char
765−-- take n0 (Stream next0 s0) =
766−-- -- take n0 (Stream next0 s0 len) =
767−-- Stream next (n0 :*: s0) -- (smaller len (fromIntegral (max 0 n0)))
768−-- where
769−-- {-# INLINE next #-}
770−-- next (n :*: s) | n <= 0 = Done
771−-- | otherwise = case next0 s of
772−-- Done -> Done
773−-- Skip s' -> Skip (n :*: s')
774−-- Yield x s' -> Yield x ((n-1) :*: s')
775−-- {-# INLINE [0] take #-}
776−
777−-- data Drop a s = NS !s
778−-- | JS !a !s
779−
780−-- -- | /O(n)/ drop n, applied to a stream, returns the suffix of the
781−-- -- stream after the first @n@ characters, or the empty stream if @n@
782−-- -- is greater than the length of the stream.
783−-- drop :: Integral a => a -> Stream Char -> Stream Char
784−-- -- drop n0 (Stream next0 s0 len) =
785−-- drop n0 (Stream next0 s0) =
786−-- Stream next (JS n0 s0) -- (len - fromIntegral (max 0 n0))
787−-- where
788−-- {-# INLINE next #-}
789−-- next (JS n s)
790−-- | n <= 0 = Skip (NS s)
791−-- | otherwise = case next0 s of
792−-- Done -> Done
793−-- Skip s' -> Skip (JS n s')
794−-- Yield _ s' -> Skip (JS (n-1) s')
795−-- next (NS s) = case next0 s of
796−-- Done -> Done
797−-- Skip s' -> Skip (NS s')
798−-- Yield x s' -> Yield x (NS s')
799−-- {-# INLINE [0] drop #-}
800−
801−-- -- | takeWhile, applied to a predicate @p@ and a stream, returns the
802−-- -- longest prefix (possibly empty) of elements that satisfy p.
803−-- takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char
804−-- -- takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
805−-- takeWhile p (Stream next0 s0) = Stream next s0 -- len -- HINT maybe too high
806−-- where
807−-- {-# INLINE next #-}
808−-- next !s = case next0 s of
809−-- Done -> Done
810−-- Skip s' -> Skip s'
811−-- Yield x s' | p x -> Yield x s'
812−-- | otherwise -> Done
813−-- {-# INLINE [0] takeWhile #-}
814−
815−-- -- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
816−-- dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
817−-- -- dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
818−-- dropWhile p (Stream next0 s0) = Stream next (L s0) -- len -- HINT maybe too high
819−-- where
820−-- {-# INLINE next #-}
821−-- next (L s) = case next0 s of
822−-- Done -> Done
823−-- Skip s' -> Skip (L s')
824−-- Yield x s' | p x -> Skip (L s')
825−-- | otherwise -> Yield x (R s')
826−-- next (R s) = case next0 s of
827−-- Done -> Done
828−-- Skip s' -> Skip (R s')
829−-- Yield x s' -> Yield x (R s')
830−-- {-# INLINE [0] dropWhile #-}
831−
832−-- -- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
833−-- -- 'True' iff the first is a prefix of the second.
834−-- isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool
835−-- -- isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
836−-- isPrefixOf (Stream next1 s1) (Stream next2 s2) = loop (next1 s1) (next2 s2)
837−-- where
838−-- loop Done _ = True
839−-- loop _ Done = False
840−-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
841−-- loop (Skip s1') x2 = loop (next1 s1') x2
842−-- loop x1 (Skip s2') = loop x1 (next2 s2')
843−-- loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
844−-- loop (next1 s1') (next2 s2')
845−-- {-# INLINE [0] isPrefixOf #-}
846−
847−-- -- ----------------------------------------------------------------------------
848−-- -- * Searching
849−
850−-- -------------------------------------------------------------------------------
851−-- -- ** Searching by equality
852−
853−-- -- | /O(n)/ elem is the stream membership predicate.
854−-- elem :: Char -> Stream Char -> Bool
855−-- -- elem w (Stream next s0 _len) = loop_elem s0
856−-- elem w (Stream next s0) = loop_elem s0
857−-- where
858−-- loop_elem !s = case next s of
859−-- Done -> False
860−-- Skip s' -> loop_elem s'
861−-- Yield x s' | x == w -> True
862−-- | otherwise -> loop_elem s'
863−-- {-# INLINE [0] elem #-}
864−
865−-- -------------------------------------------------------------------------------
866−-- -- ** Searching with a predicate
867−
868−-- -- | /O(n)/ The 'findBy' function takes a predicate and a stream,
869−-- -- and returns the first element in matching the predicate, or 'Nothing'
870−-- -- if there is no such element.
871−
872−-- findBy :: (Char -> Bool) -> Stream Char -> Maybe Char
873−-- -- findBy p (Stream next s0 _len) = loop_find s0
874−-- findBy p (Stream next s0) = loop_find s0
875−-- where
876−-- loop_find !s = case next s of
877−-- Done -> Nothing
878−-- Skip s' -> loop_find s'
879−-- Yield x s' | p x -> Just x
880−-- | otherwise -> loop_find s'
881−-- {-# INLINE [0] findBy #-}
882−
883−-- -- | /O(n)/ Stream index (subscript) operator, starting from 0.
884−-- indexI :: Integral a => Stream Char -> a -> Char
885−-- -- indexI (Stream next s0 _len) n0
886−-- indexI (Stream next s0) n0
887−-- | n0 < 0 = streamError "index" "Negative index"
888−-- | otherwise = loop_index n0 s0
889−-- where
890−-- loop_index !n !s = case next s of
891−-- Done -> streamError "index" "Index too large"
892−-- Skip s' -> loop_index n s'
893−-- Yield x s' | n == 0 -> x
894−-- | otherwise -> loop_index (n-1) s'
895−-- {-# INLINE [0] indexI #-}
896−
897−-- -- | /O(n)/ 'filter', applied to a predicate and a stream,
898−-- -- returns a stream containing those characters that satisfy the
899−-- -- predicate.
900−-- filter :: (Char -> Bool) -> Stream Char -> Stream Char
901−-- -- filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
902−-- filter p (Stream next0 s0) = Stream next s0 -- len -- HINT maybe too high
903−-- where
904−-- next !s = case next0 s of
905−-- Done -> Done
906−-- Skip s' -> Skip s'
907−-- Yield x s' | p x -> Yield x s'
908−-- | otherwise -> Skip s'
909−-- {-# INLINE [0] filter #-}
910−
911−-- {-# RULES
912−-- "STREAM filter/filter fusion" forall p q s.
913−-- filter p (filter q s) = filter (\x -> q x && p x) s
914−-- #-}
915−
916−-- -- | The 'findIndexI' function takes a predicate and a stream and
917−-- -- returns the index of the first element in the stream satisfying the
918−-- -- predicate.
919−-- findIndexI :: Integral a => (Char -> Bool) -> Stream Char -> Maybe a
920−-- findIndexI p s = case findIndicesI p s of
921−-- (i:_) -> Just i
922−-- _ -> Nothing
923−-- {-# INLINE [0] findIndexI #-}
924−
925−-- -- | The 'findIndicesI' function takes a predicate and a stream and
926−-- -- returns all indices of the elements in the stream satisfying the
927−-- -- predicate.
928−-- findIndicesI :: Integral a => (Char -> Bool) -> Stream Char -> [a]
929−-- -- findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0
930−-- findIndicesI p (Stream next s0) = loop_findIndex 0 s0
931−-- where
932−-- loop_findIndex !i !s = case next s of
933−-- Done -> []
934−-- Skip s' -> loop_findIndex i s' -- hmm. not caught by QC
935−-- Yield x s' | p x -> i : loop_findIndex (i+1) s'
936−-- | otherwise -> loop_findIndex (i+1) s'
937−-- {-# INLINE [0] findIndicesI #-}
938−
939−-- -------------------------------------------------------------------------------
940−-- -- * Zipping
941−
942−-- -- | Strict triple.
943−-- data Zip a b m = Z1 !a !b
944−-- | Z2 !a !b !m
945−
946−-- -- | zipWith generalises 'zip' by zipping with the function given as
947−-- -- the first argument, instead of a tupling function.
948−-- zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
949−-- -- zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
950−-- zipWith f (Stream next0 sa0) (Stream next1 sb0) =
951−-- Stream next (Z1 sa0 sb0) -- (smaller len1 len2)
952−-- where
953−-- next (Z1 sa sb) = case next0 sa of
954−-- Done -> Done
955−-- Skip sa' -> Skip (Z1 sa' sb)
956−-- Yield a sa' -> Skip (Z2 sa' sb a)
957−
958−-- next (Z2 sa' sb a) = case next1 sb of
959−-- Done -> Done
960−-- Skip sb' -> Skip (Z2 sa' sb' a)
961−-- Yield b sb' -> Yield (f a b) (Z1 sa' sb')
962−-- {-# INLINE [0] zipWith #-}
963−
964−-- -- | /O(n)/ The 'countCharI' function returns the number of times the
965−-- -- query element appears in the given stream.
966−-- countCharI :: Integral a => Char -> Stream Char -> a
967−-- -- countCharI a (Stream next s0 _len) = loop 0 s0
968−-- countCharI a (Stream next s0) = loop 0 s0
969−-- where
970−-- loop !i !s = case next s of
971−-- Done -> i
972−-- Skip s' -> loop i s'
973−-- Yield x s' | a == x -> loop (i+1) s'
974−-- | otherwise -> loop i s'
975−-- {-# INLINE [0] countCharI #-}
976−
977−-- streamError :: String -> String -> a
978−-- streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg
979−
980−-- emptyError :: String -> a
981−-- emptyError func = internalError func "Empty input"
982−
983−-- internalError :: String -> a
984−-- internalError func = streamError func "Internal error"
17+module Data.Text.Internal.Fusion.Common
18+ (
19+ -- * Creation and elimination
20+ singleton
21+ , streamList
22+ , unstreamList
23+ , streamCString#
24+
25+ -- * Basic interface
26+ , cons
27+ , snoc
28+ , append
29+ , head
30+ , uncons
31+ , last
32+ , tail
33+ , init
34+ , null
35+ , lengthI
36+ , compareLengthI
37+ , isSingleton
38+
39+ -- * Transformations
40+ , map
41+ , intercalate
42+ , intersperse
43+
44+ -- ** Case conversion
45+ -- $case
46+ , toCaseFold
47+ , toLower
48+ , toTitle
49+ , toUpper
50+
51+ -- ** Justification
52+ , justifyLeftI
53+
54+ -- * Folds
55+ , foldl
56+ , foldl'
57+ , foldl1
58+ , foldl1'
59+ , foldr
60+ , foldr1
61+
62+ -- ** Special folds
63+ , concat
64+ , concatMap
65+ , any
66+ , all
67+ , maximum
68+ , minimum
69+
70+ -- * Construction
71+ -- ** Scans
72+ , scanl
73+
74+ -- ** Generation and unfolding
75+ , replicateCharI
76+ , replicateI
77+ , unfoldr
78+ , unfoldrNI
79+
80+ -- * Substrings
81+ -- ** Breaking strings
82+ , take
83+ , drop
84+ , takeWhile
85+ , dropWhile
86+
87+ -- * Predicates
88+ , isPrefixOf
89+
90+ -- * Searching
91+ , elem
92+ , filter
93+
94+ -- * Indexing
95+ , findBy
96+ , indexI
97+ , findIndexI
98+ , countCharI
99+
100+ -- * Zipping and unzipping
101+ , zipWith
102+ ) where
103+
104+import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
105+ Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),
106+ (&&), fromIntegral, otherwise)
107+import qualified Data.List as L
108+import qualified Prelude as P
109+import Data.Bits (shiftL)
110+import Data.Char (isLetter)
111+import Data.Int (Int64)
112+import Data.Text.Internal.Fusion.Types
113+import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,
114+ upperMapping)
115+import Data.Text.Internal.Fusion.Size
116+import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)
117+import GHC.Types (Char(..), Int(..))
118+
119+singleton :: Char -> Stream Char
120+singleton c = Stream next False 1
121+ where next False = Yield c True
122+ next True = Done
123+{-# INLINE [0] singleton #-}
124+
125+streamList :: [a] -> Stream a
126+{-# INLINE [0] streamList #-}
127+streamList s = Stream next s unknownSize
128+ where next [] = Done
129+ next (x:xs) = Yield x xs
130+
131+unstreamList :: Stream a -> [a]
132+unstreamList (Stream next s0 _len) = unfold s0
133+ where unfold !s = case next s of
134+ Done -> []
135+ Skip s' -> unfold s'
136+ Yield x s' -> x : unfold s'
137+{-# INLINE [0] unstreamList #-}
138+
139+{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}
140+
141+-- | Stream the UTF-8-like packed encoding used by GHC to represent
142+-- constant strings in generated code.
143+--
144+-- This encoding uses the byte sequence "\xc0\x80" to represent NUL,
145+-- and the string is NUL-terminated.
146+streamCString# :: Addr# -> Stream Char
147+streamCString# addr = Stream step 0 unknownSize
148+ where
149+ step !i
150+ | b == 0 = Done
151+ | b <= 0x7f = Yield (C# b#) (i+1)
152+ | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1
153+ in Yield c (i+2)
154+ | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +
155+ (next 1 `shiftL` 6) +
156+ next 2
157+ in Yield c (i+3)
158+ | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +
159+ (next 1 `shiftL` 12) +
160+ (next 2 `shiftL` 6) +
161+ next 3
162+ in Yield c (i+4)
163+ where b = I# (ord# b#)
164+ next n = I# (ord# (at# (i+n))) - 0x80
165+ !b# = at# i
166+ at# (I# i#) = indexCharOffAddr# addr i#
167+ chr (I# i#) = C# (chr# i#)
168+{-# INLINE [0] streamCString# #-}
169+
170+-- ----------------------------------------------------------------------------
171+-- * Basic stream functions
172+
173+data C s = C0 !s
174+ | C1 !s
175+
176+-- | /O(n)/ Adds a character to the front of a Stream Char.
177+cons :: Char -> Stream Char -> Stream Char
178+cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
179+ where
180+ next (C1 s) = Yield w (C0 s)
181+ next (C0 s) = case next0 s of
182+ Done -> Done
183+ Skip s' -> Skip (C0 s')
184+ Yield x s' -> Yield x (C0 s')
185+{-# INLINE [0] cons #-}
186+
187+data Snoc a = N
188+ | J !a
189+
190+-- | /O(n)/ Adds a character to the end of a stream.
191+snoc :: Stream Char -> Char -> Stream Char
192+snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
193+ where
194+ next (J xs) = case next0 xs of
195+ Done -> Yield w N
196+ Skip xs' -> Skip (J xs')
197+ Yield x xs' -> Yield x (J xs')
198+ next N = Done
199+{-# INLINE [0] snoc #-}
200+
201+data E l r = L !l
202+ | R !r
203+
204+-- | /O(n)/ Appends one Stream to the other.
205+append :: Stream Char -> Stream Char -> Stream Char
206+append (Stream next0 s01 len1) (Stream next1 s02 len2) =
207+ Stream next (L s01) (len1 + len2)
208+ where
209+ next (L s1) = case next0 s1 of
210+ Done -> Skip (R s02)
211+ Skip s1' -> Skip (L s1')
212+ Yield x s1' -> Yield x (L s1')
213+ next (R s2) = case next1 s2 of
214+ Done -> Done
215+ Skip s2' -> Skip (R s2')
216+ Yield x s2' -> Yield x (R s2')
217+{-# INLINE [0] append #-}
218+
219+-- | /O(1)/ Returns the first character of a Text, which must be non-empty.
220+-- Subject to array fusion.
221+head :: Stream Char -> Char
222+head (Stream next s0 _len) = loop_head s0
223+ where
224+ loop_head !s = case next s of
225+ Yield x _ -> x
226+ Skip s' -> loop_head s'
227+ Done -> head_empty
228+{-# INLINE [0] head #-}
229+
230+head_empty :: a
231+head_empty = streamError "head" "Empty stream"
232+{-# NOINLINE head_empty #-}
233+
234+-- | /O(1)/ Returns the first character and remainder of a 'Stream
235+-- Char', or 'Nothing' if empty. Subject to array fusion.
236+uncons :: Stream Char -> Maybe (Char, Stream Char)
237+uncons (Stream next s0 len) = loop_uncons s0
238+ where
239+ loop_uncons !s = case next s of
240+ Yield x s1 -> Just (x, Stream next s1 (len-1))
241+ Skip s' -> loop_uncons s'
242+ Done -> Nothing
243+{-# INLINE [0] uncons #-}
244+
245+-- | /O(n)/ Returns the last character of a 'Stream Char', which must
246+-- be non-empty.
247+last :: Stream Char -> Char
248+last (Stream next s0 _len) = loop0_last s0
249+ where
250+ loop0_last !s = case next s of
251+ Done -> emptyError "last"
252+ Skip s' -> loop0_last s'
253+ Yield x s' -> loop_last x s'
254+ loop_last !x !s = case next s of
255+ Done -> x
256+ Skip s' -> loop_last x s'
257+ Yield x' s' -> loop_last x' s'
258+{-# INLINE[0] last #-}
259+
260+-- | /O(1)/ Returns all characters after the head of a Stream Char, which must
261+-- be non-empty.
262+tail :: Stream Char -> Stream Char
263+tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)
264+ where
265+ next (C0 s) = case next0 s of
266+ Done -> emptyError "tail"
267+ Skip s' -> Skip (C0 s')
268+ Yield _ s' -> Skip (C1 s')
269+ next (C1 s) = case next0 s of
270+ Done -> Done
271+ Skip s' -> Skip (C1 s')
272+ Yield x s' -> Yield x (C1 s')
273+{-# INLINE [0] tail #-}
274+
275+data Init s = Init0 !s
276+ | Init1 {-# UNPACK #-} !Char !s
277+
278+-- | /O(1)/ Returns all but the last character of a Stream Char, which
279+-- must be non-empty.
280+init :: Stream Char -> Stream Char
281+init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)
282+ where
283+ next (Init0 s) = case next0 s of
284+ Done -> emptyError "init"
285+ Skip s' -> Skip (Init0 s')
286+ Yield x s' -> Skip (Init1 x s')
287+ next (Init1 x s) = case next0 s of
288+ Done -> Done
289+ Skip s' -> Skip (Init1 x s')
290+ Yield x' s' -> Yield x (Init1 x' s')
291+{-# INLINE [0] init #-}
292+
293+-- | /O(1)/ Tests whether a Stream Char is empty or not.
294+null :: Stream Char -> Bool
295+null (Stream next s0 _len) = loop_null s0
296+ where
297+ loop_null !s = case next s of
298+ Done -> True
299+ Yield _ _ -> False
300+ Skip s' -> loop_null s'
301+{-# INLINE[0] null #-}
302+
303+-- | /O(n)/ Returns the number of characters in a string.
304+lengthI :: Integral a => Stream Char -> a
305+lengthI (Stream next s0 _len) = loop_length 0 s0
306+ where
307+ loop_length !z s = case next s of
308+ Done -> z
309+ Skip s' -> loop_length z s'
310+ Yield _ s' -> loop_length (z + 1) s'
311+{-# INLINE[0] lengthI #-}
312+
313+-- | /O(n)/ Compares the count of characters in a string to a number.
314+-- Subject to fusion.
315+--
316+-- This function gives the same answer as comparing against the result
317+-- of 'lengthI', but can short circuit if the count of characters is
318+-- greater than the number or if the stream can't possibly be as long
319+-- as the number supplied, and hence be more efficient.
320+compareLengthI :: Integral a => Stream Char -> a -> Ordering
321+compareLengthI (Stream next s0 len) n =
322+ case compareSize len (fromIntegral n) of
323+ Just o -> o
324+ Nothing -> loop_cmp 0 s0
325+ where
326+ loop_cmp !z s = case next s of
327+ Done -> compare z n
328+ Skip s' -> loop_cmp z s'
329+ Yield _ s' | z > n -> GT
330+ | otherwise -> loop_cmp (z + 1) s'
331+{-# INLINE[0] compareLengthI #-}
332+
333+-- | /O(n)/ Indicate whether a string contains exactly one element.
334+isSingleton :: Stream Char -> Bool
335+isSingleton (Stream next s0 _len) = loop 0 s0
336+ where
337+ loop !z s = case next s of
338+ Done -> z == (1::Int)
339+ Skip s' -> loop z s'
340+ Yield _ s'
341+ | z >= 1 -> False
342+ | otherwise -> loop (z+1) s'
343+{-# INLINE[0] isSingleton #-}
344+
345+-- ----------------------------------------------------------------------------
346+-- * Stream transformations
347+
348+-- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@
349+-- to each element of @xs@.
350+map :: (Char -> Char) -> Stream Char -> Stream Char
351+map f (Stream next0 s0 len) = Stream next s0 len
352+ where
353+ next !s = case next0 s of
354+ Done -> Done
355+ Skip s' -> Skip s'
356+ Yield x s' -> Yield (f x) s'
357+{-# INLINE [0] map #-}
358+
359+{-#
360+ RULES "STREAM map/map fusion" forall f g s.
361+ map f (map g s) = map (\x -> f (g x)) s
362+ #-}
363+
364+data I s = I1 !s
365+ | I2 !s {-# UNPACK #-} !Char
366+ | I3 !s
367+
368+-- | /O(n)/ Take a character and place it between each of the
369+-- characters of a 'Stream Char'.
370+intersperse :: Char -> Stream Char -> Stream Char
371+intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len
372+ where
373+ next (I1 s) = case next0 s of
374+ Done -> Done
375+ Skip s' -> Skip (I1 s')
376+ Yield x s' -> Skip (I2 s' x)
377+ next (I2 s x) = Yield x (I3 s)
378+ next (I3 s) = case next0 s of
379+ Done -> Done
380+ Skip s' -> Skip (I3 s')
381+ Yield x s' -> Yield c (I2 s' x)
382+{-# INLINE [0] intersperse #-}
383+
384+-- ----------------------------------------------------------------------------
385+-- ** Case conversions (folds)
386+
387+-- $case
388+--
389+-- With Unicode text, it is incorrect to use combinators like @map
390+-- toUpper@ to case convert each character of a string individually.
391+-- Instead, use the whole-string case conversion functions from this
392+-- module. For correctness in different writing systems, these
393+-- functions may map one input character to two or three output
394+-- characters.
395+
396+caseConvert :: (forall s. Char -> s -> Step (CC s) Char)
397+ -> Stream Char -> Stream Char
398+caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len
399+ where
400+ next (CC s '\0' _) =
401+ case next0 s of
402+ Done -> Done
403+ Skip s' -> Skip (CC s' '\0' '\0')
404+ Yield c s' -> remap c s'
405+ next (CC s a b) = Yield a (CC s b '\0')
406+
407+-- | /O(n)/ Convert a string to folded case. This function is mainly
408+-- useful for performing caseless (or case insensitive) string
409+-- comparisons.
410+--
411+-- A string @x@ is a caseless match for a string @y@ if and only if:
412+--
413+-- @toCaseFold x == toCaseFold y@
414+--
415+-- The result string may be longer than the input string, and may
416+-- differ from applying 'toLower' to the input string. For instance,
417+-- the Armenian small ligature men now (U+FB13) is case folded to the
418+-- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is
419+-- case folded to the Greek small letter letter mu (U+03BC) instead of
420+-- itself.
421+toCaseFold :: Stream Char -> Stream Char
422+toCaseFold = caseConvert foldMapping
423+{-# INLINE [0] toCaseFold #-}
424+
425+-- | /O(n)/ Convert a string to upper case, using simple case
426+-- conversion. The result string may be longer than the input string.
427+-- For instance, the German eszett (U+00DF) maps to the two-letter
428+-- sequence SS.
429+toUpper :: Stream Char -> Stream Char
430+toUpper = caseConvert upperMapping
431+{-# INLINE [0] toUpper #-}
432+
433+-- | /O(n)/ Convert a string to lower case, using simple case
434+-- conversion. The result string may be longer than the input string.
435+-- For instance, the Latin capital letter I with dot above (U+0130)
436+-- maps to the sequence Latin small letter i (U+0069) followed by
437+-- combining dot above (U+0307).
438+toLower :: Stream Char -> Stream Char
439+toLower = caseConvert lowerMapping
440+{-# INLINE [0] toLower #-}
441+
442+-- | /O(n)/ Convert a string to title case, using simple case
443+-- conversion.
444+--
445+-- The first letter of the input is converted to title case, as is
446+-- every subsequent letter that immediately follows a non-letter.
447+-- Every letter that immediately follows another letter is converted
448+-- to lower case.
449+--
450+-- The result string may be longer than the input string. For example,
451+-- the Latin small ligature fl (U+FB02) is converted to the
452+-- sequence Latin capital letter F (U+0046) followed by Latin small
453+-- letter l (U+006C).
454+--
455+-- /Note/: this function does not take language or culture specific
456+-- rules into account. For instance, in English, different style
457+-- guides disagree on whether the book name \"The Hill of the Red
458+-- Fox\" is correctly title cased—but this function will
459+-- capitalize /every/ word.
460+toTitle :: Stream Char -> Stream Char
461+toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len
462+ where
463+ next (CC (letter :*: s) '\0' _) =
464+ case next0 s of
465+ Done -> Done
466+ Skip s' -> Skip (CC (letter :*: s') '\0' '\0')
467+ Yield c s'
468+ | letter' -> if letter
469+ then lowerMapping c (letter' :*: s')
470+ else titleMapping c (letter' :*: s')
471+ | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')
472+ where letter' = isLetter c
473+ next (CC s a b) = Yield a (CC s b '\0')
474+{-# INLINE [0] toTitle #-}
475+
476+data Justify i s = Just1 !i !s
477+ | Just2 !i !s
478+
479+justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
480+justifyLeftI k c (Stream next0 s0 len) =
481+ Stream next (Just1 0 s0) (larger (fromIntegral k) len)
482+ where
483+ next (Just1 n s) =
484+ case next0 s of
485+ Done -> next (Just2 n s)
486+ Skip s' -> Skip (Just1 n s')
487+ Yield x s' -> Yield x (Just1 (n+1) s')
488+ next (Just2 n s)
489+ | n < k = Yield c (Just2 (n+1) s)
490+ | otherwise = Done
491+ {-# INLINE next #-}
492+{-# INLINE [0] justifyLeftI #-}
493+
494+-- ----------------------------------------------------------------------------
495+-- * Reducing Streams (folds)
496+
497+-- | foldl, applied to a binary operator, a starting value (typically the
498+-- left-identity of the operator), and a Stream, reduces the Stream using the
499+-- binary operator, from left to right.
500+foldl :: (b -> Char -> b) -> b -> Stream Char -> b
501+foldl f z0 (Stream next s0 _len) = loop_foldl z0 s0
502+ where
503+ loop_foldl z !s = case next s of
504+ Done -> z
505+ Skip s' -> loop_foldl z s'
506+ Yield x s' -> loop_foldl (f z x) s'
507+{-# INLINE [0] foldl #-}
508+
509+-- | A strict version of foldl.
510+foldl' :: (b -> Char -> b) -> b -> Stream Char -> b
511+foldl' f z0 (Stream next s0 _len) = loop_foldl' z0 s0
512+ where
513+ loop_foldl' !z !s = case next s of
514+ Done -> z
515+ Skip s' -> loop_foldl' z s'
516+ Yield x s' -> loop_foldl' (f z x) s'
517+{-# INLINE [0] foldl' #-}
518+
519+-- | foldl1 is a variant of foldl that has no starting value argument,
520+-- and thus must be applied to non-empty Streams.
521+foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char
522+foldl1 f (Stream next s0 _len) = loop0_foldl1 s0
523+ where
524+ loop0_foldl1 !s = case next s of
525+ Skip s' -> loop0_foldl1 s'
526+ Yield x s' -> loop_foldl1 x s'
527+ Done -> emptyError "foldl1"
528+ loop_foldl1 z !s = case next s of
529+ Done -> z
530+ Skip s' -> loop_foldl1 z s'
531+ Yield x s' -> loop_foldl1 (f z x) s'
532+{-# INLINE [0] foldl1 #-}
533+
534+-- | A strict version of foldl1.
535+foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char
536+foldl1' f (Stream next s0 _len) = loop0_foldl1' s0
537+ where
538+ loop0_foldl1' !s = case next s of
539+ Skip s' -> loop0_foldl1' s'
540+ Yield x s' -> loop_foldl1' x s'
541+ Done -> emptyError "foldl1"
542+ loop_foldl1' !z !s = case next s of
543+ Done -> z
544+ Skip s' -> loop_foldl1' z s'
545+ Yield x s' -> loop_foldl1' (f z x) s'
546+{-# INLINE [0] foldl1' #-}
547+
548+-- | 'foldr', applied to a binary operator, a starting value (typically the
549+-- right-identity of the operator), and a stream, reduces the stream using the
550+-- binary operator, from right to left.
551+foldr :: (Char -> b -> b) -> b -> Stream Char -> b
552+foldr f z (Stream next s0 _len) = loop_foldr s0
553+ where
554+ loop_foldr !s = case next s of
555+ Done -> z
556+ Skip s' -> loop_foldr s'
557+ Yield x s' -> f x (loop_foldr s')
558+{-# INLINE [0] foldr #-}
559+
560+-- | foldr1 is a variant of 'foldr' that has no starting value argument,
561+-- and thus must be applied to non-empty streams.
562+-- Subject to array fusion.
563+foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char
564+foldr1 f (Stream next s0 _len) = loop0_foldr1 s0
565+ where
566+ loop0_foldr1 !s = case next s of
567+ Done -> emptyError "foldr1"
568+ Skip s' -> loop0_foldr1 s'
569+ Yield x s' -> loop_foldr1 x s'
570+
571+ loop_foldr1 x !s = case next s of
572+ Done -> x
573+ Skip s' -> loop_foldr1 x s'
574+ Yield x' s' -> f x (loop_foldr1 x' s')
575+{-# INLINE [0] foldr1 #-}
576+
577+intercalate :: Stream Char -> [Stream Char] -> Stream Char
578+intercalate s = concat . (L.intersperse s)
579+{-# INLINE [0] intercalate #-}
580+
581+-- ----------------------------------------------------------------------------
582+-- ** Special folds
583+
584+-- | /O(n)/ Concatenate a list of streams. Subject to array fusion.
585+concat :: [Stream Char] -> Stream Char
586+concat = L.foldr append empty
587+{-# INLINE [0] concat #-}
588+
589+-- | Map a function over a stream that results in a stream and concatenate the
590+-- results.
591+concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char
592+concatMap f = foldr (append . f) empty
593+{-# INLINE [0] concatMap #-}
594+
595+-- | /O(n)/ any @p @xs determines if any character in the stream
596+-- @xs@ satisfies the predicate @p@.
597+any :: (Char -> Bool) -> Stream Char -> Bool
598+any p (Stream next0 s0 _len) = loop_any s0
599+ where
600+ loop_any !s = case next0 s of
601+ Done -> False
602+ Skip s' -> loop_any s'
603+ Yield x s' | p x -> True
604+ | otherwise -> loop_any s'
605+{-# INLINE [0] any #-}
606+
607+-- | /O(n)/ all @p @xs determines if all characters in the 'Text'
608+-- @xs@ satisfy the predicate @p@.
609+all :: (Char -> Bool) -> Stream Char -> Bool
610+all p (Stream next0 s0 _len) = loop_all s0
611+ where
612+ loop_all !s = case next0 s of
613+ Done -> True
614+ Skip s' -> loop_all s'
615+ Yield x s' | p x -> loop_all s'
616+ | otherwise -> False
617+{-# INLINE [0] all #-}
618+
619+-- | /O(n)/ maximum returns the maximum value from a stream, which must be
620+-- non-empty.
621+maximum :: Stream Char -> Char
622+maximum (Stream next0 s0 _len) = loop0_maximum s0
623+ where
624+ loop0_maximum !s = case next0 s of
625+ Done -> emptyError "maximum"
626+ Skip s' -> loop0_maximum s'
627+ Yield x s' -> loop_maximum x s'
628+ loop_maximum !z !s = case next0 s of
629+ Done -> z
630+ Skip s' -> loop_maximum z s'
631+ Yield x s'
632+ | x > z -> loop_maximum x s'
633+ | otherwise -> loop_maximum z s'
634+{-# INLINE [0] maximum #-}
635+
636+-- | /O(n)/ minimum returns the minimum value from a 'Text', which must be
637+-- non-empty.
638+minimum :: Stream Char -> Char
639+minimum (Stream next0 s0 _len) = loop0_minimum s0
640+ where
641+ loop0_minimum !s = case next0 s of
642+ Done -> emptyError "minimum"
643+ Skip s' -> loop0_minimum s'
644+ Yield x s' -> loop_minimum x s'
645+ loop_minimum !z !s = case next0 s of
646+ Done -> z
647+ Skip s' -> loop_minimum z s'
648+ Yield x s'
649+ | x < z -> loop_minimum x s'
650+ | otherwise -> loop_minimum z s'
651+{-# INLINE [0] minimum #-}
652+
653+-- -----------------------------------------------------------------------------
654+-- * Building streams
655+
656+scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
657+scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
658+ where
659+ {-# INLINE next #-}
660+ next (Scan1 z s) = Yield z (Scan2 z s)
661+ next (Scan2 z s) = case next0 s of
662+ Yield x s' -> let !x' = f z x
663+ in Yield x' (Scan2 x' s')
664+ Skip s' -> Skip (Scan2 z s')
665+ Done -> Done
666+{-# INLINE [0] scanl #-}
667+
668+-- -----------------------------------------------------------------------------
669+-- ** Generating and unfolding streams
670+
671+replicateCharI :: Integral a => a -> Char -> Stream Char
672+replicateCharI !n !c
673+ | n < 0 = empty
674+ | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
675+ where
676+ next !i | i >= n = Done
677+ | otherwise = Yield c (i + 1)
678+{-# INLINE [0] replicateCharI #-}
679+
680+data RI s = RI !s {-# UNPACK #-} !Int64
681+
682+replicateI :: Int64 -> Stream Char -> Stream Char
683+replicateI n (Stream next0 s0 len) =
684+ Stream next (RI s0 0) (fromIntegral (max 0 n) * len)
685+ where
686+ next (RI s k)
687+ | k >= n = Done
688+ | otherwise = case next0 s of
689+ Done -> Skip (RI s0 (k+1))
690+ Skip s' -> Skip (RI s' k)
691+ Yield x s' -> Yield x (RI s' k)
692+{-# INLINE [0] replicateI #-}
693+
694+-- | /O(n)/, where @n@ is the length of the result. The unfoldr function
695+-- is analogous to the List 'unfoldr'. unfoldr builds a stream
696+-- from a seed value. The function takes the element and returns
697+-- Nothing if it is done producing the stream or returns Just
698+-- (a,b), in which case, a is the next Char in the string, and b is
699+-- the seed value for further production.
700+unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char
701+unfoldr f s0 = Stream next s0 1 -- HINT maybe too low
702+ where
703+ {-# INLINE next #-}
704+ next !s = case f s of
705+ Nothing -> Done
706+ Just (w, s') -> Yield w s'
707+{-# INLINE [0] unfoldr #-}
708+
709+-- | /O(n)/ Like 'unfoldr', 'unfoldrNI' builds a stream from a seed
710+-- value. However, the length of the result is limited by the
711+-- first argument to 'unfoldrNI'. This function is more efficient than
712+-- 'unfoldr' when the length of the result is known.
713+unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char
714+unfoldrNI n f s0 | n < 0 = empty
715+ | otherwise = Stream next (0 :*: s0) (fromIntegral (n*2)) -- HINT maybe too high
716+ where
717+ {-# INLINE next #-}
718+ next (z :*: s) = case f s of
719+ Nothing -> Done
720+ Just (w, s') | z >= n -> Done
721+ | otherwise -> Yield w ((z + 1) :*: s')
722+{-# INLINE unfoldrNI #-}
723+
724+-------------------------------------------------------------------------------
725+-- * Substreams
726+
727+-- | /O(n)/ take n, applied to a stream, returns the prefix of the
728+-- stream of length @n@, or the stream itself if @n@ is greater than the
729+-- length of the stream.
730+take :: Integral a => a -> Stream Char -> Stream Char
731+take n0 (Stream next0 s0 len) =
732+ Stream next (n0 :*: s0) (smaller len (fromIntegral (max 0 n0)))
733+ where
734+ {-# INLINE next #-}
735+ next (n :*: s) | n <= 0 = Done
736+ | otherwise = case next0 s of
737+ Done -> Done
738+ Skip s' -> Skip (n :*: s')
739+ Yield x s' -> Yield x ((n-1) :*: s')
740+{-# INLINE [0] take #-}
741+
742+data Drop a s = NS !s
743+ | JS !a !s
744+
745+-- | /O(n)/ drop n, applied to a stream, returns the suffix of the
746+-- stream after the first @n@ characters, or the empty stream if @n@
747+-- is greater than the length of the stream.
748+drop :: Integral a => a -> Stream Char -> Stream Char
749+drop n0 (Stream next0 s0 len) =
750+ Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))
751+ where
752+ {-# INLINE next #-}
753+ next (JS n s)
754+ | n <= 0 = Skip (NS s)
755+ | otherwise = case next0 s of
756+ Done -> Done
757+ Skip s' -> Skip (JS n s')
758+ Yield _ s' -> Skip (JS (n-1) s')
759+ next (NS s) = case next0 s of
760+ Done -> Done
761+ Skip s' -> Skip (NS s')
762+ Yield x s' -> Yield x (NS s')
763+{-# INLINE [0] drop #-}
764+
765+-- | takeWhile, applied to a predicate @p@ and a stream, returns the
766+-- longest prefix (possibly empty) of elements that satisfy p.
767+takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char
768+takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
769+ where
770+ {-# INLINE next #-}
771+ next !s = case next0 s of
772+ Done -> Done
773+ Skip s' -> Skip s'
774+ Yield x s' | p x -> Yield x s'
775+ | otherwise -> Done
776+{-# INLINE [0] takeWhile #-}
777+
778+-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
779+dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
780+dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
781+ where
782+ {-# INLINE next #-}
783+ next (L s) = case next0 s of
784+ Done -> Done
785+ Skip s' -> Skip (L s')
786+ Yield x s' | p x -> Skip (L s')
787+ | otherwise -> Yield x (R s')
788+ next (R s) = case next0 s of
789+ Done -> Done
790+ Skip s' -> Skip (R s')
791+ Yield x s' -> Yield x (R s')
792+{-# INLINE [0] dropWhile #-}
793+
794+-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
795+-- 'True' iff the first is a prefix of the second.
796+isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool
797+isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
798+ where
799+ loop Done _ = True
800+ loop _ Done = False
801+ loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
802+ loop (Skip s1') x2 = loop (next1 s1') x2
803+ loop x1 (Skip s2') = loop x1 (next2 s2')
804+ loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
805+ loop (next1 s1') (next2 s2')
806+{-# INLINE [0] isPrefixOf #-}
807+
808+-- ----------------------------------------------------------------------------
809+-- * Searching
810+
811+-------------------------------------------------------------------------------
812+-- ** Searching by equality
813+
814+-- | /O(n)/ elem is the stream membership predicate.
815+elem :: Char -> Stream Char -> Bool
816+elem w (Stream next s0 _len) = loop_elem s0
817+ where
818+ loop_elem !s = case next s of
819+ Done -> False
820+ Skip s' -> loop_elem s'
821+ Yield x s' | x == w -> True
822+ | otherwise -> loop_elem s'
823+{-# INLINE [0] elem #-}
824+
825+-------------------------------------------------------------------------------
826+-- ** Searching with a predicate
827+
828+-- | /O(n)/ The 'findBy' function takes a predicate and a stream,
829+-- and returns the first element in matching the predicate, or 'Nothing'
830+-- if there is no such element.
831+
832+findBy :: (Char -> Bool) -> Stream Char -> Maybe Char
833+findBy p (Stream next s0 _len) = loop_find s0
834+ where
835+ loop_find !s = case next s of
836+ Done -> Nothing
837+ Skip s' -> loop_find s'
838+ Yield x s' | p x -> Just x
839+ | otherwise -> loop_find s'
840+{-# INLINE [0] findBy #-}
841+
842+-- | /O(n)/ Stream index (subscript) operator, starting from 0.
843+indexI :: Integral a => Stream Char -> a -> Char
844+indexI (Stream next s0 _len) n0
845+ | n0 < 0 = streamError "index" "Negative index"
846+ | otherwise = loop_index n0 s0
847+ where
848+ loop_index !n !s = case next s of
849+ Done -> streamError "index" "Index too large"
850+ Skip s' -> loop_index n s'
851+ Yield x s' | n == 0 -> x
852+ | otherwise -> loop_index (n-1) s'
853+{-# INLINE [0] indexI #-}
854+
855+-- | /O(n)/ 'filter', applied to a predicate and a stream,
856+-- returns a stream containing those characters that satisfy the
857+-- predicate.
858+filter :: (Char -> Bool) -> Stream Char -> Stream Char
859+filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
860+ where
861+ next !s = case next0 s of
862+ Done -> Done
863+ Skip s' -> Skip s'
864+ Yield x s' | p x -> Yield x s'
865+ | otherwise -> Skip s'
866+{-# INLINE [0] filter #-}
867+
868+{-# RULES
869+ "STREAM filter/filter fusion" forall p q s.
870+ filter p (filter q s) = filter (\x -> q x && p x) s
871+ #-}
872+
873+-- | The 'findIndexI' function takes a predicate and a stream and
874+-- returns the index of the first element in the stream satisfying the
875+-- predicate.
876+findIndexI :: Integral a => (Char -> Bool) -> Stream Char -> Maybe a
877+findIndexI p s = case findIndicesI p s of
878+ (i:_) -> Just i
879+ _ -> Nothing
880+{-# INLINE [0] findIndexI #-}
881+
882+-- | The 'findIndicesI' function takes a predicate and a stream and
883+-- returns all indices of the elements in the stream satisfying the
884+-- predicate.
885+findIndicesI :: Integral a => (Char -> Bool) -> Stream Char -> [a]
886+findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0
887+ where
888+ loop_findIndex !i !s = case next s of
889+ Done -> []
890+ Skip s' -> loop_findIndex i s' -- hmm. not caught by QC
891+ Yield x s' | p x -> i : loop_findIndex (i+1) s'
892+ | otherwise -> loop_findIndex (i+1) s'
893+{-# INLINE [0] findIndicesI #-}
894+
895+-------------------------------------------------------------------------------
896+-- * Zipping
897+
898+-- | Strict triple.
899+data Zip a b m = Z1 !a !b
900+ | Z2 !a !b !m
901+
902+-- | zipWith generalises 'zip' by zipping with the function given as
903+-- the first argument, instead of a tupling function.
904+zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
905+zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
906+ Stream next (Z1 sa0 sb0) (smaller len1 len2)
907+ where
908+ next (Z1 sa sb) = case next0 sa of
909+ Done -> Done
910+ Skip sa' -> Skip (Z1 sa' sb)
911+ Yield a sa' -> Skip (Z2 sa' sb a)
912+
913+ next (Z2 sa' sb a) = case next1 sb of
914+ Done -> Done
915+ Skip sb' -> Skip (Z2 sa' sb' a)
916+ Yield b sb' -> Yield (f a b) (Z1 sa' sb')
917+{-# INLINE [0] zipWith #-}
918+
919+-- | /O(n)/ The 'countCharI' function returns the number of times the
920+-- query element appears in the given stream.
921+countCharI :: Integral a => Char -> Stream Char -> a
922+countCharI a (Stream next s0 _len) = loop 0 s0
923+ where
924+ loop !i !s = case next s of
925+ Done -> i
926+ Skip s' -> loop i s'
927+ Yield x s' | a == x -> loop (i+1) s'
928+ | otherwise -> loop i s'
929+{-# INLINE [0] countCharI #-}
930+
931+streamError :: String -> String -> a
932+streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg
933+
934+emptyError :: String -> a
935+emptyError func = internalError func "Empty input"
936+
937+internalError :: String -> a
938+internalError func = streamError func "Internal error"