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