text 0.1 → 0.2
raw patch · 18 files changed
+2446/−938 lines, 18 files
Files
- Data/Text.hs +46/−52
- Data/Text/Array.hs +3/−1
- Data/Text/Encoding.hs +1/−1
- Data/Text/Encoding/Fusion.hs +11/−155
- Data/Text/Encoding/Fusion/Common.hs +161/−0
- Data/Text/Foreign.hs +1/−1
- Data/Text/Fusion.hs +32/−722
- Data/Text/Fusion/Common.hs +760/−0
- Data/Text/Fusion/Internal.hs +118/−0
- Data/Text/Internal.hs +10/−2
- Data/Text/Lazy.hs +872/−0
- Data/Text/Lazy/Encoding.hs +48/−0
- Data/Text/Lazy/Encoding/Fusion.hs +129/−0
- Data/Text/Lazy/Fusion.hs +139/−0
- Data/Text/Lazy/Internal.hs +102/−0
- Data/Text/Unsafe.hs +2/−1
- Data/Text/UnsafeChar.hs +1/−1
- text.cabal +10/−2
Data/Text.hs view
@@ -8,7 +8,7 @@ -- (c) Duncan Coutts 2009 -- -- License : BSD-style--- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk, -- duncan@haskell.org -- Stability : experimental -- Portability : GHC@@ -137,16 +137,17 @@ , count -- * Zipping and unzipping+ , zip , zipWith -- -* Ordered text- , -- sort+ -- , sort ) where import Prelude (Char, Bool(..), Functor(..), Int, Maybe(..), String,- Eq(..), (++),+ Eq(..), Ord(..), (++), Read(..), Show(..),- (&&), (||), (+), (-), (<), (>), (<=), (>=), (.), ($),+ (&&), (||), (+), (-), (.), ($), not, return, otherwise) import Control.Exception (assert) import Data.Char (isSpace)@@ -158,8 +159,10 @@ import Data.String (IsString(..)) import qualified Data.Text.Fusion as S-import Data.Text.Fusion (Stream(..), Step(..), stream, reverseStream, unstream)-import Data.Text.Internal (Text(..), empty, text)+import qualified Data.Text.Fusion.Common as S+import Data.Text.Fusion (stream, reverseStream, unstream)++import Data.Text.Internal (Text(..), empty, text, textP) import qualified Prelude as P import Data.Text.Unsafe (iter, iter_, unsafeHead, unsafeTail) import Data.Text.UnsafeChar (unsafeChr)@@ -172,8 +175,13 @@ -- one 'Text' value. instance Eq Text where- t1 == t2 = (stream t1) `S.eq` (stream t2)+ t1 == t2 = stream t1 == stream t2+ {-# INLINE (==) #-} +instance Ord Text where+ compare t1 t2 = compare (stream t1) (stream t2)+ {-# INLINE compare #-}+ instance Show Text where showsPrec p ps r = showsPrec p (unpack ps) r @@ -195,36 +203,19 @@ -- -- This function is subject to array fusion. pack :: String -> Text-pack str = (unstream (stream_list str))- where- stream_list s0 = S.Stream next s0 (P.length s0) -- total guess- where- next [] = S.Done- next (x:xs) = S.Yield x xs+pack = unstream . S.streamList {-# INLINE [1] pack #-}--- TODO: Has to do validation! -- No, it doesn't, the -- | /O(n)/ Convert a Text into a String. -- Subject to array fusion. unpack :: Text -> String-unpack txt = (unstream_list (stream txt))- where- unstream_list (S.Stream next s0 _len) = unfold s0- where- unfold !s = case next s of- S.Done -> []- S.Skip s' -> unfold s'- S.Yield x s' -> x : unfold s'+unpack = S.unstreamList . stream {-# INLINE [1] unpack #-} -- | /O(1)/ Convert a character into a Text. -- Subject to array fusion. singleton :: Char -> Text-singleton c = unstream (Stream next (c:[]) 1)- where- {-# INLINE next #-}- next (k:ks) = Yield k ks- next [] = Done+singleton = unstream . S.singleton {-# INLINE [1] singleton #-} -- -----------------------------------------------------------------------------@@ -255,10 +246,10 @@ copy arr2 off2 (len2+off2) arr len1 return arr where- copy arr i max arr' j- | i >= max = return ()+ copy arr i top arr' j+ | i >= top = return () | otherwise = do A.unsafeWrite arr' j (arr `A.unsafeIndex` i)- copy arr (i+1) max arr' (j+1)+ copy arr (i+1) top arr' (j+1) {-# INLINE append #-} {-# RULES@@ -312,13 +303,6 @@ S.last (stream t) = last t #-} --- | Construct a 'Text' without invisibly pinning its byte array in--- memory if its length has dwindled to zero.-textP :: A.Array Word16 -> Int -> Int -> Text-textP arr off len | len == 0 = empty- | otherwise = text arr off len-{-# INLINE textP #-}- -- | /O(1)/ Returns all characters after the head of a 'Text', which -- must be non-empty. Subject to array fusion. tail :: Text -> Text@@ -517,7 +501,7 @@ -- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'. ----- > scanr f v t == reverse (scanl (flip f) v t)+-- > scanr f v == reverse . scanl (flip f) v . reverse scanr :: (Char -> Char -> Char) -> Char -> Text -> Text scanr f z = S.reverse . S.reverseScanr f z . reverseStream {-# INLINE scanr #-}@@ -554,7 +538,7 @@ -- ** Generating and unfolding 'Text's -- | /O(n)/ 'replicate' @n@ @c@ is a 'Text' of length @n@ with @c@ the--- value of every element.+-- value of every element. Subject to fusion. replicate :: Int -> Char -> Text replicate n c = unstream (S.replicate n c) {-# INLINE replicate #-}@@ -564,7 +548,8 @@ -- 'Text' from a seed value. The function takes the element and -- returns 'Nothing' if it is done producing the 'Text', otherwise -- 'Just' @(a,b)@. In this case, @a@ is the next 'Char' in the--- string, and @b@ is the seed value for further production.+-- string, and @b@ is the seed value for further production. Subject+-- to fusion. unfoldr :: (a -> Maybe (Char,a)) -> a -> Text unfoldr f s = unstream (S.unfoldr f s) {-# INLINE unfoldr #-}@@ -573,7 +558,8 @@ -- value. However, the length of the result should be limited by the -- first argument to 'unfoldrN'. This function is more efficient than -- 'unfoldr' when the maximum length of the result is known and--- correct, otherwise its performance is similar to 'unfoldr'.+-- correct, otherwise its performance is similar to 'unfoldr'. Subject+-- to fusion. unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text unfoldrN n f s = unstream (S.unfoldrN n f s) {-# INLINE unfoldrN #-}@@ -583,7 +569,7 @@ -- | /O(n)/ 'take' @n@, applied to a 'Text', returns the prefix of the -- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than--- the length of the Text.+-- the length of the Text. Subject to fusion. take :: Int -> Text -> Text take n t@(Text arr off len) | n <= 0 = empty@@ -605,15 +591,14 @@ -- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the -- 'Text' of length @n@, or the empty 'Text' if @n@ is greater than the--- length of the 'Text'.+-- length of the 'Text'. Subject to fusion. drop :: Int -> Text -> Text drop n t@(Text arr off len) | n <= 0 = t | n >= len = empty | otherwise = loop 0 0- where end = off + len- loop !i !cnt- | i >= end || cnt >= n = Text arr (off+i) (len-i)+ where loop !i !cnt+ | i >= len || cnt >= n = Text arr (off+i) (len-i) | otherwise = loop (i+d) (cnt+1) where d = iter_ t i {-# INLINE [1] drop #-}@@ -756,11 +741,10 @@ -- > splitWith (=='a') "aabbaca" == ["","","bb","c",""] -- > splitWith (=='a') [] == [] splitWith :: (Char -> Bool) -> Text -> [Text]-splitWith p = loop- where loop s | null s = []- | otherwise = if null s'- then [s]- else l : loop (unsafeTail s')+splitWith _ (Text _off _arr 0) = []+splitWith p t = loop t+ where loop s | null s' = [l]+ | otherwise = l : loop (unsafeTail s') where (l, s') = break p s {-# INLINE splitWith #-} @@ -837,7 +821,7 @@ ------------------------------------------------------------------------------- -- ** Indexing 'Text's --- | /O(1)/ 'Text' index (subscript) operator, starting from 0.+-- | /O(n)/ 'Text' index (subscript) operator, starting from 0. index :: Text -> Int -> Char index t n = S.index (stream t) n {-# INLINE index #-}@@ -881,10 +865,19 @@ ------------------------------------------------------------------------------- -- * Zipping +-- | /O(n)/ 'zip' takes two 'Text's and returns a list of+-- corresponding pairs of bytes. If one input 'Text' is short,+-- excess elements of the longer 'Text' are discarded. This is+-- equivalent to a pair of 'unpack' operations.+zip :: Text -> Text -> [(Char,Char)]+zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)+{-# INLINE [0] zip #-}+ -- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function -- given as the first argument, instead of a tupling function. zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text zipWith f t1 t2 = unstream (S.zipWith f (stream t1) (stream t2))+{-# INLINE [0] zipWith #-} -- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's -- representing white space.@@ -977,6 +970,7 @@ isInfixOf :: Text -> Text -> Bool isInfixOf needle haystack = L.any (isPrefixOf needle) (tails haystack) {-# INLINE isInfixOf #-}+-- TODO: a better implementation emptyError :: String -> a emptyError fun = P.error ("Data.Text." ++ fun ++ ": empty input")
Data/Text/Array.hs view
@@ -1,11 +1,13 @@ {-# LANGUAGE BangPatterns, CPP, ExistentialQuantification, MagicHash, Rank2Types, ScopedTypeVariables, UnboxedTuples #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-} -- | -- Module : Data.Text.Array -- Copyright : (c) Bryan O'Sullivan 2009 -- -- License : BSD-style--- Maintainer : bos@serpentine.com,+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,+-- duncan@haskell.org -- Stability : experimental -- Portability : portable --
Data/Text/Encoding.hs view
@@ -5,7 +5,7 @@ -- (c) Duncan Coutts 2009 -- -- License : BSD-style--- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk, -- duncan@haskell.org -- Stability : experimental -- Portability : portable
Data/Text/Encoding/Fusion.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE BangPatterns #-} -- |--- Module : Data.Text.Encoding+-- Module : Data.Text.Encoding.Fusion -- Copyright : (c) Tom Harper 2008-2009, -- (c) Bryan O'Sullivan 2009, -- (c) Duncan Coutts 2009@@ -28,22 +28,15 @@ -- * Unstreaming , unstream - -- * Restreaming- -- Restreaming is the act of converting from one 'Stream'- -- representation to another.- , restreamUtf8- , restreamUtf16LE- , restreamUtf16BE- , restreamUtf32LE- , restreamUtf32BE+ , module Data.Text.Encoding.Fusion.Common ) where import Control.Exception (assert)-import Data.Bits (shiftL, shiftR, (.&.))+import Data.Bits (shiftL) import Data.ByteString as B import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)-import Data.Char (ord) import Data.Text.Fusion (Step(..), Stream(..))+import Data.Text.Encoding.Fusion.Common import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32) import Data.Word (Word8, Word16, Word32) import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)@@ -55,15 +48,6 @@ import qualified Data.Text.Encoding.Utf16 as U16 import qualified Data.Text.Encoding.Utf32 as U32 --- Specialised, strict Maybe-like type.-data M = N- | J {-# UNPACK #-} !Word8- deriving (Eq, Ord, Show)---- Restreaming state.-data S s = S {-# UNPACK #-} !s- {-# UNPACK #-} !M {-# UNPACK #-} !M {-# UNPACK #-} !M- streamASCII :: ByteString -> Stream Char streamASCII bs = Stream next 0 l where@@ -174,149 +158,25 @@ idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32 {-# INLINE [0] streamUtf32LE #-} --- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.-restreamUtf8 :: Stream Char -> Stream Word8-restreamUtf8 (Stream next0 s0 len) =- Stream next (S s0 N N N) (len*2)- where- {-# INLINE next #-}- next (S s N N N) = case next0 s of- Done -> Done- Skip s' -> Skip (S s' N N N)- Yield x xs- | n <= 0x7F -> Yield c (S xs N N N)- | n <= 0x07FF -> Yield a2 (S xs (J b2) N N)- | n <= 0xFFFF -> Yield a3 (S xs (J b3) (J c3) N)- | otherwise -> Yield a4 (S xs (J b4) (J c4) (J d4))- where- n = ord x- c = fromIntegral n- (a2,b2) = U8.ord2 x- (a3,b3,c3) = U8.ord3 x- (a4,b4,c4,d4) = U8.ord4 x- next (S s (J x2) N N) = Yield x2 (S s N N N)- next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)- next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)- next _ = internalError "restreamUtf8"-{-# INLINE restreamUtf8 #-}--restreamUtf16BE :: Stream Char -> Stream Word8-restreamUtf16BE (Stream next0 s0 len) =- Stream next (S s0 N N N) (len*2)- where- {-# INLINE next #-}- next (S s N N N) = case next0 s of- Done -> Done- Skip s' -> Skip (S s' N N N)- Yield x xs- | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $- S xs (J $ fromIntegral n) N N- | otherwise -> Yield c1 $- S xs (J c2) (J c3) (J c4)- where- n = ord x- n1 = n - 0x10000- c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)- c2 = fromIntegral (n1 `shiftR` 10)- n2 = n1 .&. 0x3FF- c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)- c4 = fromIntegral n2- next (S s (J x2) N N) = Yield x2 (S s N N N)- next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)- next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)- next _ = internalError "restreamUtf16BE"-{-# INLINE restreamUtf16BE #-}--restreamUtf16LE :: Stream Char -> Stream Word8-restreamUtf16LE (Stream next0 s0 len) =- Stream next (S s0 N N N) (len*2)- where- {-# INLINE next #-}- next (S s N N N) = case next0 s of- Done -> Done- Skip s' -> Skip (S s' N N N)- Yield x xs- | n < 0x10000 -> Yield (fromIntegral n) $- S xs (J (fromIntegral $ shiftR n 8)) N N- | otherwise -> Yield c1 $- S xs (J c2) (J c3) (J c4)- where- n = ord x- n1 = n - 0x10000- c2 = fromIntegral (shiftR n1 18 + 0xD8)- c1 = fromIntegral (shiftR n1 10)- n2 = n1 .&. 0x3FF- c4 = fromIntegral (shiftR n2 8 + 0xDC)- c3 = fromIntegral n2- next (S s (J x2) N N) = Yield x2 (S s N N N)- next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)- next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)- next _ = internalError "restreamUtf16LE"-{-# INLINE restreamUtf16LE #-}--restreamUtf32BE :: Stream Char -> Stream Word8-restreamUtf32BE (Stream next0 s0 len) =- Stream next (S s0 N N N) (len*2)- where- {-# INLINE next #-}- next (S s N N N) = case next0 s of- Done -> Done- Skip s' -> Skip (S s' N N N)- Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))- where- n = ord x- c1 = fromIntegral $ shiftR n 24- c2 = fromIntegral $ shiftR n 16- c3 = fromIntegral $ shiftR n 8- c4 = fromIntegral n- next (S s (J x2) N N) = Yield x2 (S s N N N)- next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)- next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)- next _ = internalError "restreamUtf32BE"-{-# INLINE restreamUtf32BE #-}--restreamUtf32LE :: Stream Char -> Stream Word8-restreamUtf32LE (Stream next0 s0 len) =- Stream next (S s0 N N N) (len*2)- where- {-# INLINE next #-}- next (S s N N N) = case next0 s of- Done -> Done- Skip s' -> Skip (S s' N N N)- Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))- where- n = ord x- c4 = fromIntegral $ shiftR n 24- c3 = fromIntegral $ shiftR n 16- c2 = fromIntegral $ shiftR n 8- c1 = fromIntegral n- next (S s (J x2) N N) = Yield x2 (S s N N N)- next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)- next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)- next _ = internalError "restreamUtf32LE"-{-# INLINE restreamUtf32LE #-}-- -- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'. unstream :: Stream Word8 -> ByteString unstream (Stream next s0 len) = unsafePerformIO $ do- fp0 <- mallocByteString len- loop fp0 len 0 s0+ mallocByteString len >>= loop len 0 s0 where- loop !fp !n !off !s = case next s of+ loop !n !off !s fp = case next s of Done -> trimUp fp n off- Skip s' -> loop fp n off s'+ Skip s' -> loop n off s' fp Yield x s'- | n == off -> realloc fp n off s' x+ | off == n -> realloc fp n off s' x | otherwise -> do withForeignPtr fp $ \p -> pokeByteOff p off x- loop fp n (off+1) s'+ loop n (off+1) s' fp {-# NOINLINE realloc #-} realloc fp n off s x = do let n' = n+n fp' <- copy0 fp n n' withForeignPtr fp' $ \p -> pokeByteOff p off x- loop fp' n' (off+1) s+ loop n' (off+1) s fp' {-# NOINLINE trimUp #-} trimUp fp _ off = return $! PS fp 0 off copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)@@ -324,12 +184,8 @@ dest <- mallocByteString destLen withForeignPtr src $ \src' -> withForeignPtr dest $ \dest' ->- memcpy dest' src' (fromIntegral destLen)+ memcpy dest' src' (fromIntegral srcLen) return dest--internalError :: String -> a-internalError func =- error $ "Data.Text.Encoding.Fusion." ++ func ++ ": internal error" encodingError :: String -> a encodingError encoding =
+ Data/Text/Encoding/Fusion/Common.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE BangPatterns #-}++-- |+-- Module : Data.Text.Encoding.Fusion.Common+-- Copyright : (c) Tom Harper 2008-2009,+-- (c) Bryan O'Sullivan 2009,+-- (c) Duncan Coutts 2009+--+-- License : BSD-style+-- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,+-- duncan@haskell.org+-- Stability : experimental+-- Portability : portable+--+-- Fusible 'Stream'-oriented functions for converting between 'Text'+-- and several common encodings.++module Data.Text.Encoding.Fusion.Common+ (+ -- * Restreaming+ -- Restreaming is the act of converting from one 'Stream'+ -- representation to another.+ restreamUtf8+ , restreamUtf16LE+ , restreamUtf16BE+ , restreamUtf32LE+ , restreamUtf32BE+ ) where++import Data.Bits (shiftR, (.&.))+import Data.Char (ord)+import Data.Text.Fusion (Step(..), Stream(..))+import Data.Text.Fusion.Internal (M(..), S(..))+import Data.Word (Word8)+import qualified Data.Text.Encoding.Utf8 as U8++-- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.+restreamUtf8 :: Stream Char -> Stream Word8+restreamUtf8 (Stream next0 s0 len) =+ Stream next (S s0 N N N) (len*2)+ where+ {-# INLINE next #-}+ next (S s N N N) = case next0 s of+ Done -> Done+ Skip s' -> Skip (S s' N N N)+ Yield x xs+ | n <= 0x7F -> Yield c (S xs N N N)+ | n <= 0x07FF -> Yield a2 (S xs (J b2) N N)+ | n <= 0xFFFF -> Yield a3 (S xs (J b3) (J c3) N)+ | otherwise -> Yield a4 (S xs (J b4) (J c4) (J d4))+ where+ n = ord x+ c = fromIntegral n+ (a2,b2) = U8.ord2 x+ (a3,b3,c3) = U8.ord3 x+ (a4,b4,c4,d4) = U8.ord4 x+ next (S s (J x2) N N) = Yield x2 (S s N N N)+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)+ next _ = internalError "restreamUtf8"+{-# INLINE restreamUtf8 #-}++restreamUtf16BE :: Stream Char -> Stream Word8+restreamUtf16BE (Stream next0 s0 len) =+ Stream next (S s0 N N N) (len*2)+ where+ {-# INLINE next #-}+ next (S s N N N) = case next0 s of+ Done -> Done+ Skip s' -> Skip (S s' N N N)+ Yield x xs+ | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $+ S xs (J $ fromIntegral n) N N+ | otherwise -> Yield c1 $+ S xs (J c2) (J c3) (J c4)+ where+ n = ord x+ n1 = n - 0x10000+ c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)+ c2 = fromIntegral (n1 `shiftR` 10)+ n2 = n1 .&. 0x3FF+ c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)+ c4 = fromIntegral n2+ next (S s (J x2) N N) = Yield x2 (S s N N N)+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)+ next _ = internalError "restreamUtf16BE"+{-# INLINE restreamUtf16BE #-}++restreamUtf16LE :: Stream Char -> Stream Word8+restreamUtf16LE (Stream next0 s0 len) =+ Stream next (S s0 N N N) (len*2)+ where+ {-# INLINE next #-}+ next (S s N N N) = case next0 s of+ Done -> Done+ Skip s' -> Skip (S s' N N N)+ Yield x xs+ | n < 0x10000 -> Yield (fromIntegral n) $+ S xs (J (fromIntegral $ shiftR n 8)) N N+ | otherwise -> Yield c1 $+ S xs (J c2) (J c3) (J c4)+ where+ n = ord x+ n1 = n - 0x10000+ c2 = fromIntegral (shiftR n1 18 + 0xD8)+ c1 = fromIntegral (shiftR n1 10)+ n2 = n1 .&. 0x3FF+ c4 = fromIntegral (shiftR n2 8 + 0xDC)+ c3 = fromIntegral n2+ next (S s (J x2) N N) = Yield x2 (S s N N N)+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)+ next _ = internalError "restreamUtf16LE"+{-# INLINE restreamUtf16LE #-}++restreamUtf32BE :: Stream Char -> Stream Word8+restreamUtf32BE (Stream next0 s0 len) =+ Stream next (S s0 N N N) (len*2)+ where+ {-# INLINE next #-}+ next (S s N N N) = case next0 s of+ Done -> Done+ Skip s' -> Skip (S s' N N N)+ Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))+ where+ n = ord x+ c1 = fromIntegral $ shiftR n 24+ c2 = fromIntegral $ shiftR n 16+ c3 = fromIntegral $ shiftR n 8+ c4 = fromIntegral n+ next (S s (J x2) N N) = Yield x2 (S s N N N)+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)+ next _ = internalError "restreamUtf32BE"+{-# INLINE restreamUtf32BE #-}++restreamUtf32LE :: Stream Char -> Stream Word8+restreamUtf32LE (Stream next0 s0 len) =+ Stream next (S s0 N N N) (len*2)+ where+ {-# INLINE next #-}+ next (S s N N N) = case next0 s of+ Done -> Done+ Skip s' -> Skip (S s' N N N)+ Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))+ where+ n = ord x+ c4 = fromIntegral $ shiftR n 24+ c3 = fromIntegral $ shiftR n 16+ c2 = fromIntegral $ shiftR n 8+ c1 = fromIntegral n+ next (S s (J x2) N N) = Yield x2 (S s N N N)+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)+ next _ = internalError "restreamUtf32LE"+{-# INLINE restreamUtf32LE #-}++internalError :: String -> a+internalError func =+ error $ "Data.Text.Encoding.Fusion.Common." ++ func ++ ": internal error"
Data/Text/Foreign.hs view
@@ -4,7 +4,7 @@ -- Copyright : (c) Bryan O'Sullivan 2009 -- -- License : BSD-style--- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk, -- duncan@haskell.org -- Stability : experimental -- Portability : GHC
Data/Text/Fusion.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ExistentialQuantification, BangPatterns, MagicHash #-}+{-# LANGUAGE BangPatterns, MagicHash #-} -- | -- Module : Data.Text.Fusion@@ -7,7 +7,7 @@ -- (c) Duncan Coutts 2009 -- -- License : BSD-style--- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk, -- duncan@haskell.org -- Stability : experimental -- Portability : GHC@@ -24,72 +24,20 @@ , stream , unstream , reverseStream- , empty - -- * Basic interface- , cons- , snoc- , append- , uncons- , head- , tail- , last- , init- , null , length- , eq -- * Transformations- , map- , intercalate- , intersperse , reverse - -- * Folds- , foldl- , foldl'- , foldl1- , foldl1'- , foldr- , foldr1-- -- ** Special folds- , concat- , concatMap- , any- , all- , maximum- , minimum- -- * Construction -- ** Scans- , scanl , reverseScanr - -- ** Accumulating maps- , mapAccumL- -- ** Generation and unfolding- , replicate- , unfoldr , unfoldrN - -- * Substrings- -- ** Breaking strings- , take- , drop- , takeWhile- , dropWhile-- -- * Predicates- , isPrefixOf-- -- * Searching- , elem- , filter- -- * Indexing- , find , index , findIndex , findIndices@@ -97,57 +45,24 @@ , elemIndex , elemIndices , count-- -- * Zipping and unzipping- , zipWith ) where -import Prelude (Bool(..), Char, Either(..), Eq(..), Maybe(..), Monad(..),- Num(..), Ord(..), String, ($), (++), (.), (&&),+import Prelude (Bool(..), Char, Eq(..), Maybe(..), Monad(..), Int,+ Num(..), Ord(..), ($), (&&), fromIntegral, otherwise)-import Control.Monad (liftM2)-import Control.Monad.ST (runST)-import qualified Data.List as L-import GHC.Exts (Int(..), (+#)) import Data.Bits ((.&.), shiftR) import Data.Char (ord) import Data.Text.Internal (Text(..))-import Data.Text.UnsafeChar (unsafeChr, unsafeWrite, unsafeWriteRev)+import Data.Text.UnsafeChar (unsafeChr, unsafeWrite) import qualified Data.Text.Array as A+import qualified Data.Text.Fusion.Common as S+import Data.Text.Fusion.Internal import qualified Data.Text.Internal as I import qualified Data.Text.Encoding.Utf16 as U16 import qualified Prelude as P default(Int) -infixl 2 :!:-data PairS a b = !a :!: !b---- | Allow a function over a stream to switch between two states.-data Switch = S1 | S2--data Stream a =- forall s. Stream- (s -> Step s a) -- stepper function- !s -- current state- {-# UNPACK #-}!Int -- length hint---- The length hint in a Stream has two roles. If its value is zero,--- we trust it, and treat the stream as empty. Otherwise, we treat it--- as a hint: it should usually be accurate, so we use it when--- unstreaming to decide what size array to allocate. However, the--- unstreaming functions must be able to cope with the hint being too--- small or too large.------ The size hint tries to track the UTF-16 code points in a stream,--- but often counts the number of characters instead. It can easily--- undercount if, for instance, a transformed stream contains astral--- plane characters (those above 0x10000).--data Step s a = Done- | Skip !s- | Yield !a !s- -- | /O(n)/ Convert a 'Text' into a 'Stream Char'. stream :: Text -> Stream Char stream (Text arr off len) = Stream next off len@@ -178,235 +93,42 @@ n2 = A.unsafeIndex arr (i - 1) {-# INLINE [0] reverseStream #-} --- | /O(n)/ Convert a Stream Char into a Text.+-- | /O(n)/ Convert a 'Stream Char' into a 'Text'. unstream :: Stream Char -> Text unstream (Stream next0 s0 len)- | len == 0 = I.empty- | otherwise = Text (P.fst a) 0 (P.snd a)+ | len == 0 = I.empty+ | otherwise = I.textP (P.fst a) 0 (P.snd a) where- a = runST (A.unsafeNew len >>= (\arr -> loop arr len s0 0))+ a = A.run2 (A.unsafeNew len >>= (\arr -> loop arr len s0 0)) loop arr !top !s !i | i + 1 >= top = case next0 s of- Done -> liftM2 (,) (A.unsafeFreeze arr) (return i)+ Done -> return (arr, i) _ -> do arr' <- A.unsafeNew (top*2) A.copy arr arr' >> loop arr' (top*2) s i | otherwise = case next0 s of- Done -> liftM2 (,) (A.unsafeFreeze arr) (return i)+ Done -> return (arr, i) Skip s' -> loop arr top s' i Yield x s' -> unsafeWrite arr i x >>= loop arr top s' {-# INLINE [0] unstream #-} {-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-} --- | The empty stream.-empty :: Stream Char-empty = Stream next () 0- where next _ = Done-{-# INLINE [0] empty #-} --- | /O(n)/ Determines if two streams are equal.-eq :: Ord a => Stream a -> Stream a -> Bool-eq (Stream next1 s1 _) (Stream next2 s2 _) = cmp (next1 s1) (next2 s2)- where- cmp Done Done = True- cmp Done _ = False- cmp _ Done = False- cmp (Skip s1') (Skip s2') = cmp (next1 s1') (next2 s2')- cmp (Skip s1') x2 = cmp (next1 s1') x2- cmp x1 (Skip s2') = cmp x1 (next2 s2')- cmp (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&- cmp (next1 s1') (next2 s2')-{-# SPECIALISE eq :: Stream Char -> Stream Char -> Bool #-}--streamError :: String -> String -> a-streamError func msg = P.error $ "Data.Text.Fusion." ++ func ++ ": " ++ msg--internalError :: String -> a-internalError func = streamError func "Internal error"--emptyError :: String -> a-emptyError func = internalError func "Empty input"- -- ---------------------------------------------------------------------------- -- * Basic stream functions --- | /O(n)/ Adds a character to the front of a Stream Char.-cons :: Char -> Stream Char -> Stream Char-cons w (Stream next0 s0 len) = Stream next (S2 :!: s0) (len+2)- where- {-# INLINE next #-}- next (S2 :!: s) = Yield w (S1 :!: s)- next (S1 :!: s) = case next0 s of- Done -> Done- Skip s' -> Skip (S1 :!: s')- Yield x s' -> Yield x (S1 :!: s')-{-# INLINE [0] cons #-}---- | /O(n)/ Adds a character to the end of a stream.-snoc :: Stream Char -> Char -> Stream Char-snoc (Stream next0 xs0 len) w = Stream next (Just xs0) (len+2)- where- {-# INLINE next #-}- next (Just xs) = case next0 xs of- Done -> Yield w Nothing- Skip xs' -> Skip (Just xs')- Yield x xs' -> Yield x (Just xs')- next Nothing = Done-{-# INLINE [0] snoc #-}---- | /O(n)/ Appends one Stream to the other.-append :: Stream Char -> Stream Char -> Stream Char-append (Stream next0 s01 len1) (Stream next1 s02 len2) =- Stream next (Left s01) (len1 + len2)- where- {-# INLINE next #-}- next (Left s1) = case next0 s1 of- Done -> Skip (Right s02)- Skip s1' -> Skip (Left s1')- Yield x s1' -> Yield x (Left s1')- next (Right s2) = case next1 s2 of- Done -> Done- Skip s2' -> Skip (Right s2')- Yield x s2' -> Yield x (Right s2')-{-# INLINE [0] append #-}---- | /O(1)/ Returns the first character of a Text, which must be non-empty.--- Subject to array fusion.-head :: Stream Char -> Char-head (Stream next s0 _len) = loop_head s0- where- loop_head !s = case next s of- Yield x _ -> x- Skip s' -> loop_head s'- Done -> streamError "head" "Empty stream"-{-# INLINE [0] head #-}---- | /O(1)/ Returns the first character and remainder of a 'Stream--- Char', or 'Nothing' if empty. Subject to array fusion.-uncons :: Stream Char -> Maybe (Char, Stream Char)-uncons (Stream next s0 len) = loop_uncons s0- where- loop_uncons !s = case next s of- Yield x s1 -> Just (x, Stream next s1 (len-1))- Skip s' -> loop_uncons s'- Done -> Nothing-{-# INLINE [0] uncons #-}---- | /O(n)/ Returns the last character of a 'Stream Char', which must--- be non-empty.-last :: Stream Char -> Char-last (Stream next s0 _len) = loop0_last s0- where- loop0_last !s = case next s of- Done -> emptyError "last"- Skip s' -> loop0_last s'- Yield x s' -> loop_last x s'- loop_last !x !s = case next s of- Done -> x- Skip s' -> loop_last x s'- Yield x' s' -> loop_last x' s'-{-# INLINE[0] last #-}---- | /O(1)/ Returns all characters after the head of a Stream Char, which must--- be non-empty.-tail :: Stream Char -> Stream Char-tail (Stream next0 s0 len) = Stream next (False :!: s0) (len-1)- where- {-# INLINE next #-}- next (False :!: s) = case next0 s of- Done -> emptyError "tail"- Skip s' -> Skip (False :!: s')- Yield _ s' -> Skip (True :!: s')- next (True :!: s) = case next0 s of- Done -> Done- Skip s' -> Skip (True :!: s')- Yield x s' -> Yield x (True :!: s')-{-# INLINE [0] tail #-}----- | /O(1)/ Returns all but the last character of a Stream Char, which--- must be non-empty.-init :: Stream Char -> Stream Char-init (Stream next0 s0 len) = Stream next (Nothing :!: s0) (len-1)- where- {-# INLINE next #-}- next (Nothing :!: s) = case next0 s of- Done -> emptyError "init"- Skip s' -> Skip (Nothing :!: s')- Yield x s' -> Skip (Just x :!: s')- next (Just x :!: s) = case next0 s of- Done -> Done- Skip s' -> Skip (Just x :!: s')- Yield x' s' -> Yield x (Just x' :!: s')-{-# INLINE [0] init #-}---- | /O(1)/ Tests whether a Stream Char is empty or not.-null :: Stream Char -> Bool-null (Stream next s0 _len) = loop_null s0- where- loop_null !s = case next s of- Done -> True- Yield _ _ -> False- Skip s' -> loop_null s'-{-# INLINE[0] null #-}---- | /O(n)/ Returns the number of characters in a text. length :: Stream Char -> Int-length (Stream next s0 _len) = loop_length 0# s0- where-- loop_length z# s = case next s of- Done -> (I# z#)- Skip s' -> loop_length z# s'- Yield _ s' -> loop_length (z# +# 1#) s'+length = S.lengthI {-# INLINE[0] length #-} --- ------------------------------------------------------------------------------- * Stream transformations---- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@ to each element of--- @xs@.-map :: (Char -> Char) -> Stream Char -> Stream Char-map f (Stream next0 s0 len) = Stream next s0 len- where- {-# INLINE next #-}- next !s = case next0 s of- Done -> Done- Skip s' -> Skip s'- Yield x s' -> Yield (f x) s'-{-# INLINE [0] map #-}--{-#- RULES "STREAM map/map fusion" forall f g s.- map f (map g s) = map (\x -> f (g x)) s- #-}---- | /O(n)/ Take a character and place it between each of the--- characters of a 'Stream Char'.-intersperse :: Char -> Stream Char -> Stream Char-intersperse c (Stream next0 s0 len) = Stream next (s0 :!: Nothing :!: S1) len- where- {-# INLINE next #-}- next (s :!: Nothing :!: S1) = case next0 s of- Done -> Done- Skip s' -> Skip (s' :!: Nothing :!: S1)- Yield x s' -> Skip (s' :!: Just x :!: S1)- next (s :!: Just x :!: S1) = Yield x (s :!: Nothing :!: S2)- next (s :!: Nothing :!: S2) = case next0 s of- Done -> Done- Skip s' -> Skip (s' :!: Nothing :!: S2)- Yield x s' -> Yield c (s' :!: Just x :!: S1)- next _ = internalError "intersperse"-{-# INLINE [0] intersperse #-}- -- | /O(n)/ Reverse the characters of a string. reverse :: Stream Char -> Text reverse (Stream next s len0) | len0 == 0 = I.empty- | otherwise = Text arr off' len'+ | otherwise = I.textP arr off' len' where len0' = max len0 4- (arr, (off', len')) = A.run2 (A.unsafeNew len0 >>= loop s (len0'-1) len0')+ (arr, (off', len')) = A.run2 (A.unsafeNew len0' >>= loop s (len0'-1) len0') loop !s0 !i !len marr = case next s0 of Done -> return (marr, (j, len-j))@@ -424,195 +146,20 @@ m = n - 0x10000 lo = fromIntegral $ (m `shiftR` 10) + 0xD800 hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00- write s i len marr+ write t j l mar | n < 0x10000 = do- A.unsafeWrite marr i (fromIntegral n)- loop s (i-1) len marr+ A.unsafeWrite mar j (fromIntegral n)+ loop t (j-1) l mar | otherwise = do- A.unsafeWrite marr (i-1) lo- A.unsafeWrite marr i hi- loop s (i-2) len marr+ A.unsafeWrite mar (j-1) lo+ A.unsafeWrite mar j hi+ loop t (j-2) l mar {-# INLINE [0] reverse #-} --- ------------------------------------------------------------------------------- * Reducing Streams (folds)---- | foldl, applied to a binary operator, a starting value (typically the--- left-identity of the operator), and a Stream, reduces the Stream using the--- binary operator, from left to right.-foldl :: (b -> Char -> b) -> b -> Stream Char -> b-foldl f z0 (Stream next s0 _len) = loop_foldl z0 s0- where- loop_foldl z !s = case next s of- Done -> z- Skip s' -> loop_foldl z s'- Yield x s' -> loop_foldl (f z x) s'-{-# INLINE [0] foldl #-}---- | A strict version of foldl.-foldl' :: (b -> Char -> b) -> b -> Stream Char -> b-foldl' f z0 (Stream next s0 _len) = loop_foldl' z0 s0- where- loop_foldl' !z !s = case next s of- Done -> z- Skip s' -> loop_foldl' z s'- Yield x s' -> loop_foldl' (f z x) s'-{-# INLINE [0] foldl' #-}---- | foldl1 is a variant of foldl that has no starting value argument,--- and thus must be applied to non-empty Streams.-foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char-foldl1 f (Stream next s0 _len) = loop0_foldl1 s0- where- loop0_foldl1 !s = case next s of- Skip s' -> loop0_foldl1 s'- Yield x s' -> loop_foldl1 x s'- Done -> emptyError "foldl1"- loop_foldl1 z !s = case next s of- Done -> z- Skip s' -> loop_foldl1 z s'- Yield x s' -> loop_foldl1 (f z x) s'-{-# INLINE [0] foldl1 #-}---- | A strict version of foldl1.-foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char-foldl1' f (Stream next s0 _len) = loop0_foldl1' s0- where- loop0_foldl1' !s = case next s of- Skip s' -> loop0_foldl1' s'- Yield x s' -> loop_foldl1' x s'- Done -> emptyError "foldl1"- loop_foldl1' !z !s = case next s of- Done -> z- Skip s' -> loop_foldl1' z s'- Yield x s' -> loop_foldl1' (f z x) s'-{-# INLINE [0] foldl1' #-}---- | 'foldr', applied to a binary operator, a starting value (typically the--- right-identity of the operator), and a stream, reduces the stream using the--- binary operator, from right to left.-foldr :: (Char -> b -> b) -> b -> Stream Char -> b-foldr f z (Stream next s0 _len) = loop_foldr s0- where- loop_foldr !s = case next s of- Done -> z- Skip s' -> loop_foldr s'- Yield x s' -> f x (loop_foldr s')-{-# INLINE [0] foldr #-}---- | foldr1 is a variant of 'foldr' that has no starting value argument,--- and thus must be applied to non-empty streams.--- Subject to array fusion.-foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char-foldr1 f (Stream next s0 _len) = loop0_foldr1 s0- where- loop0_foldr1 !s = case next s of- Done -> emptyError "foldr1"- Skip s' -> loop0_foldr1 s'- Yield x s' -> loop_foldr1 x s'-- loop_foldr1 x !s = case next s of- Done -> x- Skip s' -> loop_foldr1 x s'- Yield x' s' -> f x (loop_foldr1 x' s')-{-# INLINE [0] foldr1 #-}--intercalate :: Stream Char -> [Stream Char] -> Stream Char-intercalate s = concat . (L.intersperse s)-{-# INLINE [0] intercalate #-}---- ------------------------------------------------------------------------------- ** Special folds---- | /O(n)/ Concatenate a list of streams. Subject to array fusion.-concat :: [Stream Char] -> Stream Char-concat = L.foldr append (Stream next Done 0)- where- next Done = Done- next _ = internalError "concat"---- | Map a function over a stream that results in a stream and concatenate the--- results.-concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char-concatMap f = foldr (append . f) empty---- | /O(n)/ any @p @xs determines if any character in the stream--- @xs@ satisifes the predicate @p@.-any :: (Char -> Bool) -> Stream Char -> Bool-any p (Stream next0 s0 _len) = loop_any s0- where- loop_any !s = case next0 s of- Done -> False- Skip s' -> loop_any s'- Yield x s' | p x -> True- | otherwise -> loop_any s'-{-# INLINE [0] any #-}---- | /O(n)/ all @p @xs determines if all characters in the 'Text'--- @xs@ satisify the predicate @p@.-all :: (Char -> Bool) -> Stream Char -> Bool-all p (Stream next0 s0 _len) = loop_all s0- where- loop_all !s = case next0 s of- Done -> True- Skip s' -> loop_all s'- Yield x s' | p x -> loop_all s'- | otherwise -> False-{-# INLINE [0] all #-}---- | /O(n)/ maximum returns the maximum value from a stream, which must be--- non-empty.-maximum :: Stream Char -> Char-maximum (Stream next0 s0 _len) = loop0_maximum s0- where- loop0_maximum !s = case next0 s of- Done -> emptyError "maximum"- Skip s' -> loop0_maximum s'- Yield x s' -> loop_maximum x s'- loop_maximum !z !s = case next0 s of- Done -> z- Skip s' -> loop_maximum z s'- Yield x s'- | x > z -> loop_maximum x s'- | otherwise -> loop_maximum z s'-{-# INLINE [0] maximum #-}---- | /O(n)/ minimum returns the minimum value from a 'Text', which must be--- non-empty.-minimum :: Stream Char -> Char-minimum (Stream next0 s0 _len) = loop0_minimum s0- where- loop0_minimum !s = case next0 s of- Done -> emptyError "minimum"- Skip s' -> loop0_minimum s'- Yield x s' -> loop_minimum x s'- loop_minimum !z !s = case next0 s of- Done -> z- Skip s' -> loop_minimum z s'- Yield x s'- | x < z -> loop_minimum x s'- | otherwise -> loop_minimum z s'-{-# INLINE [0] minimum #-}---- -------------------------------------------------------------------------------- * Building streams--scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char-scanl f z0 (Stream next0 s0 len) = Stream next (S1 :!: z0 :!: s0) (len+1)- where- {-# INLINE next #-}- next (S1 :!: z :!: s) = Yield z (S2 :!: z :!: s)- next (S2 :!: z :!: s) = case next0 s of- Yield x s' -> let !x' = f z x- in Yield x' (S2 :!: x' :!: s')- Skip s' -> Skip (S2 :!: z :!: s')- Done -> Done-{-# INLINE [0] scanl #-}- -- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with -- the input and result reversed. reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char-reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :!: z0 :!: s0) (len+1)+reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :!: z0 :!: s0) (len+1) -- HINT maybe too low where {-# INLINE next #-} next (S1 :!: z :!: s) = Yield z (S2 :!: z :!: s)@@ -623,237 +170,34 @@ Done -> Done {-# INLINE reverseScanr #-} --- -------------------------------------------------------------------------------- ** Accumulating maps---- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a--- function to each element of a stream, passing an accumulating--- parameter from left to right, and returns a final stream.------ /Note/: Unlike the version over lists, this function does not--- return a final value for the accumulator, because the nature of--- streams precludes it.-mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b-mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :!: z0) len- where- {-# INLINE next #-}- next (s :!: z) = case next0 s of- Yield x s' -> let (z',y) = f z x- in Yield y (s' :!: z')- Skip s' -> Skip (s' :!: z)- Done -> Done-{-# INLINE [0] mapAccumL #-}---- -------------------------------------------------------------------------------- ** Generating and unfolding streams--replicate :: Int -> Char -> Stream Char-replicate n c- | n < 0 = empty- | otherwise = Stream next 0 n- where- {-# INLINE next #-}- next i | i >= n = Done- | otherwise = Yield c (i + 1)-{-# INLINE [0] replicate #-}---- | /O(n)/, where @n@ is the length of the result. The unfoldr function--- is analogous to the List 'unfoldr'. unfoldr builds a stream--- from a seed value. The function takes the element and returns--- Nothing if it is done producing the stream or returns Just--- (a,b), in which case, a is the next Char in the string, and b is--- the seed value for further production.-unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char-unfoldr f s0 = Stream next s0 1- where- {-# INLINE next #-}- next !s = case f s of- Nothing -> Done- Just (w, s') -> Yield w s'-{-# INLINE [0] unfoldr #-}- -- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed -- value. However, the length of the result is limited by the -- first argument to 'unfoldrN'. This function is more efficient than -- 'unfoldr' when the length of the result is known. unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char-unfoldrN n f s0 | n < 0 = empty- | otherwise = Stream next (0 :!: s0) (n*2)- where- {-# INLINE next #-}- next (z :!: s) = case f s of- Nothing -> Done- Just (w, s') | z >= n -> Done- | otherwise -> Yield w ((z + 1) :!: s')----------------------------------------------------------------------------------- * Substreams---- | /O(n)/ take n, applied to a stream, returns the prefix of the--- stream of length @n@, or the stream itself if @n@ is greater than the--- length of the stream.-take :: Int -> Stream Char -> Stream Char-take n0 (Stream next0 s0 len) = Stream next (n0 :!: s0) len- where- {-# INLINE next #-}- next (n :!: s) | n <= 0 = Done- | otherwise = case next0 s of- Done -> Done- Skip s' -> Skip (n :!: s')- Yield x s' -> Yield x ((n-1) :!: s')-{-# INLINE [0] take #-}---- | /O(n)/ drop n, applied to a stream, returns the suffix of the--- stream of length @n@, or the empty stream if @n@ is greater than the--- length of the stream.-drop :: Int -> Stream Char -> Stream Char-drop n0 (Stream next0 s0 len) = Stream next (Just ((max 0 n0)) :!: s0) (len - n0)- where- {-# INLINE next #-}- next (Just !n :!: s)- | n == 0 = Skip (Nothing :!: s)- | otherwise = case next0 s of- Done -> Done- Skip s' -> Skip (Just n :!: s')- Yield _ s' -> Skip (Just (n-1) :!: s')- next (Nothing :!: s) = case next0 s of- Done -> Done- Skip s' -> Skip (Nothing :!: s')- Yield x s' -> Yield x (Nothing :!: s')-{-# INLINE [0] drop #-}---- | takeWhile, applied to a predicate @p@ and a stream, returns the--- longest prefix (possibly empty) of elements that satisfy p.-takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char-takeWhile p (Stream next0 s0 len) = Stream next s0 len- where- {-# INLINE next #-}- next !s = case next0 s of- Done -> Done- Skip s' -> Skip s'- Yield x s' | p x -> Yield x s'- | otherwise -> Done-{-# INLINE [0] takeWhile #-}---- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.-dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char-dropWhile p (Stream next0 s0 len) = Stream next (S1 :!: s0) len- where- {-# INLINE next #-}- next (S1 :!: s) = case next0 s of- Done -> Done- Skip s' -> Skip (S1 :!: s')- Yield x s' | p x -> Skip (S1 :!: s')- | otherwise -> Yield x (S2 :!: s')- next (S2 :!: s) = case next0 s of- Done -> Done- Skip s' -> Skip (S2 :!: s')- Yield x s' -> Yield x (S2 :!: s')-{-# INLINE [0] dropWhile #-}---- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns--- 'True' iff the first is a prefix of the second.-isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool-isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)- where- loop Done _ = True- loop _ Done = False- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')- loop (Skip s1') x2 = loop (next1 s1') x2- loop x1 (Skip s2') = loop x1 (next2 s2')- loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&- loop (next1 s1') (next2 s2')-{-# INLINE [0] isPrefixOf #-}-{-# SPECIALISE isPrefixOf :: Stream Char -> Stream Char -> Bool #-}---- ------------------------------------------------------------------------------- * Searching------------------------------------------------------------------------------------ ** Searching by equality---- | /O(n)/ elem is the stream membership predicate.-elem :: Char -> Stream Char -> Bool-elem w (Stream next s0 _len) = loop_elem s0- where- loop_elem !s = case next s of- Done -> False- Skip s' -> loop_elem s'- Yield x s' | x == w -> True- | otherwise -> loop_elem s'-{-# INLINE [0] elem #-}------------------------------------------------------------------------------------ ** Searching with a predicate---- | /O(n)/ The 'find' function takes a predicate and a stream,--- and returns the first element in matching the predicate, or 'Nothing'--- if there is no such element.--find :: (Char -> Bool) -> Stream Char -> Maybe Char-find p (Stream next s0 _len) = loop_find s0- where- loop_find !s = case next s of- Done -> Nothing- Skip s' -> loop_find s'- Yield x s' | p x -> Just x- | otherwise -> loop_find s'-{-# INLINE [0] find #-}---- | /O(n)/ 'filter', applied to a predicate and a stream,--- returns a stream containing those characters that satisfy the--- predicate.-filter :: (Char -> Bool) -> Stream Char -> Stream Char-filter p (Stream next0 s0 len) = Stream next s0 len- where- {-# INLINE next #-}- next !s = case next0 s of- Done -> Done- Skip s' -> Skip s'- Yield x s' | p x -> Yield x s'- | otherwise -> Skip s'-{-# INLINE [0] filter #-}--{-# RULES- "Stream filter/filter fusion" forall p q s.- filter p (filter q s) = filter (\x -> q x && p x) s- #-}+unfoldrN n = S.unfoldrNI n+{-# INLINE [0] unfoldrN #-} ------------------------------------------------------------------------------- -- ** Indexing streams --- | /O(1)/ stream index (subscript) operator, starting from 0.+-- | /O(n)/ stream index (subscript) operator, starting from 0. index :: Stream Char -> Int -> Char-index (Stream next s0 _len) n0- | n0 < 0 = streamError "index" "Negative index"- | otherwise = loop_index n0 s0- where- loop_index !n !s = case next s of- Done -> streamError "index" "Index too large"- Skip s' -> loop_index n s'- Yield x s' | n == 0 -> x- | otherwise -> loop_index (n-1) s'+index = S.indexI {-# INLINE [0] index #-} -- | The 'findIndex' function takes a predicate and a stream and -- returns the index of the first element in the stream -- satisfying the predicate. findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int-findIndex p s = case findIndices p s of- (i:_) -> Just i- _ -> Nothing+findIndex = S.findIndexI {-# INLINE [0] findIndex #-} -- | The 'findIndices' function takes a predicate and a stream and -- returns all indices of the elements in the stream -- satisfying the predicate. findIndices :: (Char -> Bool) -> Stream Char -> [Int]-findIndices p (Stream next s0 _len) = loop_findIndex 0 s0- where- loop_findIndex !i !s = case next s of- Done -> []- Skip s' -> loop_findIndex i s' -- hmm. not caught by QC- Yield x s' | p x -> i : loop_findIndex (i+1) s'- | otherwise -> loop_findIndex (i+1) s'+findIndices = S.findIndicesI {-# INLINE [0] findIndices #-} -- | The 'findIndexOrEnd' function takes a predicate and a stream and@@ -873,51 +217,17 @@ -- element in the given stream which is equal to the query -- element, or 'Nothing' if there is no such element. elemIndex :: Char -> Stream Char -> Maybe Int-elemIndex a s = case elemIndices a s of- (i:_) -> Just i- _ -> Nothing+elemIndex = S.elemIndexI {-# INLINE [0] elemIndex #-} -- | /O(n)/ The 'elemIndices' function returns the index of every -- element in the given stream which is equal to the query element. elemIndices :: Char -> Stream Char -> [Int]-elemIndices a (Stream next s0 _len) = loop 0 s0- where- loop !i !s = case next s of- Done -> []- Skip s' -> loop i s'- Yield x s' | a == x -> i : loop (i+1) s'- | otherwise -> loop (i+1) s'+elemIndices = S.elemIndicesI {-# INLINE [0] elemIndices #-} -- | /O(n)/ The 'count' function returns the number of times the query -- element appears in the given stream. count :: Char -> Stream Char -> Int-count a (Stream next s0 _len) = loop 0 s0- where- loop !i !s = case next s of- Done -> i- Skip s' -> loop i s'- Yield x s' | a == x -> loop (i+1) s'- | otherwise -> loop i s'+count = S.countI {-# INLINE [0] count #-}------------------------------------------------------------------------------------ * Zipping---- | zipWith generalises 'zip' by zipping with the function given as--- the first argument, instead of a tupling function.-zipWith :: (Char -> Char -> Char) -> Stream Char -> Stream Char -> Stream Char-zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) = Stream next (sa0 :!: sb0 :!: Nothing) (min len1 len2)- where- {-# INLINE next #-}- next (sa :!: sb :!: Nothing) = case next0 sa of- Done -> Done- Skip sa' -> Skip (sa' :!: sb :!: Nothing)- Yield a sa' -> Skip (sa' :!: sb :!: Just a)-- next (sa' :!: sb :!: Just a) = case next1 sb of- Done -> Done- Skip sb' -> Skip (sa' :!: sb' :!: Just a)- Yield b sb' -> Yield (f a b) (sa' :!: sb' :!: Nothing)-{-# INLINE [0] zipWith #-}
+ Data/Text/Fusion/Common.hs view
@@ -0,0 +1,760 @@+{-# LANGUAGE BangPatterns #-}+-- |+-- Module : Data.Text.Fusion.Common+-- Copyright : (c) Bryan O'Sullivan 2009+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,+-- duncan@haskell.org+-- Stability : experimental+-- Portability : GHC+--+-- Common stream fusion functionality for text.++module Data.Text.Fusion.Common+ (+ -- * Creation and elimination+ singleton+ , streamList+ , unstreamList++ -- * Basic interface+ , cons+ , snoc+ , append+ , head+ , uncons+ , last+ , tail+ , init+ , null+ , lengthI++ -- * Transformations+ , map+ , intercalate+ , intersperse++ -- * Folds+ , foldl+ , foldl'+ , foldl1+ , foldl1'+ , foldr+ , foldr1++ -- ** Special folds+ , concat+ , concatMap+ , any+ , all+ , maximum+ , minimum++ -- * Construction+ -- ** Scans+ , scanl++ -- ** Accumulating maps+ , mapAccumL++ -- ** Generation and unfolding+ , replicate+ , unfoldr+ , unfoldrNI++ -- * Substrings+ -- ** Breaking strings+ , take+ , drop+ , takeWhile+ , dropWhile++ -- * Predicates+ , isPrefixOf++ -- * Searching+ , elem+ , filter++ -- * Indexing+ , find+ , indexI+ , findIndexI+ , findIndicesI+ , elemIndexI+ , elemIndicesI+ , countI++ -- * Zipping and unzipping+ , zipWith+ ) where++import Prelude (Bool(..), Char, Either(..), Eq(..), Int, Integral, Maybe(..),+ Ord(..), String, (.), ($), (+), (-), (*), (++), (&&),+ fromIntegral, otherwise)+import qualified Data.List as L+import qualified Prelude as P+import Data.Text.Fusion.Internal++singleton :: Char -> Stream Char+singleton c = Stream next False 1 -- HINT maybe too low+ where next False = Yield c True+ next True = Done+{-# INLINE singleton #-}++streamList :: [a] -> Stream a+{-# INLINE [0] streamList #-}+streamList [] = empty+streamList s = Stream next s unknownLength+ where next [] = Done+ next (x:xs) = Yield x xs+ unknownLength = 8 -- random HINT++unstreamList :: Stream a -> [a]+{-# INLINE [0] unstreamList #-}+unstreamList (Stream next s0 _len) = unfold s0+ where unfold !s = case next s of+ Done -> []+ Skip s' -> unfold s'+ Yield x s' -> x : unfold s'++{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}++-- ----------------------------------------------------------------------------+-- * Basic stream functions++-- | /O(n)/ Adds a character to the front of a Stream Char.+cons :: Char -> Stream Char -> Stream Char+cons w (Stream next0 s0 len) = Stream next (S2 :!: s0) (len+2) -- HINT maybe too high+ where+ {-# INLINE next #-}+ next (S2 :!: s) = Yield w (S1 :!: s)+ next (S1 :!: s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (S1 :!: s')+ Yield x s' -> Yield x (S1 :!: s')+{-# INLINE [0] cons #-}++-- | /O(n)/ Adds a character to the end of a stream.+snoc :: Stream Char -> Char -> Stream Char+snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+2) -- HINT maybe too high+ where+ {-# INLINE next #-}+ next (J xs) = case next0 xs of+ Done -> Yield w N+ Skip xs' -> Skip (J xs')+ Yield x xs' -> Yield x (J xs')+ next N = Done+{-# INLINE [0] snoc #-}++-- | /O(n)/ Appends one Stream to the other.+append :: Stream Char -> Stream Char -> Stream Char+append (Stream next0 s01 len1) (Stream next1 s02 len2) =+ Stream next (Left s01) (len1 + len2)+ where+ {-# INLINE next #-}+ next (Left s1) = case next0 s1 of+ Done -> Skip (Right s02)+ Skip s1' -> Skip (Left s1')+ Yield x s1' -> Yield x (Left s1')+ next (Right s2) = case next1 s2 of+ Done -> Done+ Skip s2' -> Skip (Right s2')+ Yield x s2' -> Yield x (Right s2')+{-# INLINE [0] append #-}++-- | /O(1)/ Returns the first character of a Text, which must be non-empty.+-- Subject to array fusion.+head :: Stream Char -> Char+head (Stream next s0 _len) = loop_head s0+ where+ loop_head !s = case next s of+ Yield x _ -> x+ Skip s' -> loop_head s'+ Done -> streamError "head" "Empty stream"+{-# INLINE [0] head #-}++-- | /O(1)/ Returns the first character and remainder of a 'Stream+-- Char', or 'Nothing' if empty. Subject to array fusion.+uncons :: Stream Char -> Maybe (Char, Stream Char)+uncons (Stream next s0 len) = loop_uncons s0+ where+ loop_uncons !s = case next s of+ Yield x s1 -> Just (x, Stream next s1 (len-1)) -- HINT maybe too high+ Skip s' -> loop_uncons s'+ Done -> Nothing+{-# INLINE [0] uncons #-}++-- | /O(n)/ Returns the last character of a 'Stream Char', which must+-- be non-empty.+last :: Stream Char -> Char+last (Stream next s0 _len) = loop0_last s0+ where+ loop0_last !s = case next s of+ Done -> emptyError "last"+ Skip s' -> loop0_last s'+ Yield x s' -> loop_last x s'+ loop_last !x !s = case next s of+ Done -> x+ Skip s' -> loop_last x s'+ Yield x' s' -> loop_last x' s'+{-# INLINE[0] last #-}++-- | /O(1)/ Returns all characters after the head of a Stream Char, which must+-- be non-empty.+tail :: Stream Char -> Stream Char+tail (Stream next0 s0 len) = Stream next (False :!: s0) (len-1) -- HINT maybe too high+ where+ {-# INLINE next #-}+ next (False :!: s) = case next0 s of+ Done -> emptyError "tail"+ Skip s' -> Skip (False :!: s')+ Yield _ s' -> Skip (True :!: s')+ next (True :!: s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (True :!: s')+ Yield x s' -> Yield x (True :!: s')+{-# INLINE [0] tail #-}+++-- | /O(1)/ Returns all but the last character of a Stream Char, which+-- must be non-empty.+init :: Stream Char -> Stream Char+init (Stream next0 s0 len) = Stream next (N :!: s0) (len-1) -- HINT maybe too high+ where+ {-# INLINE next #-}+ next (N :!: s) = case next0 s of+ Done -> emptyError "init"+ Skip s' -> Skip (N :!: s')+ Yield x s' -> Skip (J x :!: s')+ next (J x :!: s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (J x :!: s')+ Yield x' s' -> Yield x (J x' :!: s')+{-# INLINE [0] init #-}++-- | /O(1)/ Tests whether a Stream Char is empty or not.+null :: Stream Char -> Bool+null (Stream next s0 _len) = loop_null s0+ where+ loop_null !s = case next s of+ Done -> True+ Yield _ _ -> False+ Skip s' -> loop_null s'+{-# INLINE[0] null #-}++-- | /O(n)/ Returns the number of characters in a text.+lengthI :: Integral a => Stream Char -> a+lengthI (Stream next s0 _len) = loop_length 0 s0+ where+ loop_length !z s = case next s of+ Done -> z+ Skip s' -> loop_length z s'+ Yield _ s' -> loop_length (z + 1) s'+{-# INLINE[0] lengthI #-}++-- ----------------------------------------------------------------------------+-- * Stream transformations++-- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@ to each element of+-- @xs@.+map :: (Char -> Char) -> Stream Char -> Stream Char+map f (Stream next0 s0 len) = Stream next s0 len -- HINT depends on f+ where+ {-# INLINE next #-}+ next !s = case next0 s of+ Done -> Done+ Skip s' -> Skip s'+ Yield x s' -> Yield (f x) s'+{-# INLINE [0] map #-}++{-#+ RULES "STREAM map/map fusion" forall f g s.+ map f (map g s) = map (\x -> f (g x)) s+ #-}++-- | /O(n)/ Take a character and place it between each of the+-- characters of a 'Stream Char'.+intersperse :: Char -> Stream Char -> Stream Char+intersperse c (Stream next0 s0 len) = Stream next (s0 :!: N :!: S1) len -- HINT maybe too low+ where+ {-# INLINE next #-}+ next (s :!: N :!: S1) = case next0 s of+ Done -> Done+ Skip s' -> Skip (s' :!: N :!: S1)+ Yield x s' -> Skip (s' :!: J x :!: S1)+ next (s :!: J x :!: S1) = Yield x (s :!: N :!: S2)+ next (s :!: N :!: S2) = case next0 s of+ Done -> Done+ Skip s' -> Skip (s' :!: N :!: S2)+ Yield x s' -> Yield c (s' :!: J x :!: S1)+ next _ = internalError "intersperse"+{-# INLINE [0] intersperse #-}++-- ----------------------------------------------------------------------------+-- * Reducing Streams (folds)++-- | foldl, applied to a binary operator, a starting value (typically the+-- left-identity of the operator), and a Stream, reduces the Stream using the+-- binary operator, from left to right.+foldl :: (b -> Char -> b) -> b -> Stream Char -> b+foldl f z0 (Stream next s0 _len) = loop_foldl z0 s0+ where+ loop_foldl z !s = case next s of+ Done -> z+ Skip s' -> loop_foldl z s'+ Yield x s' -> loop_foldl (f z x) s'+{-# INLINE [0] foldl #-}++-- | A strict version of foldl.+foldl' :: (b -> Char -> b) -> b -> Stream Char -> b+foldl' f z0 (Stream next s0 _len) = loop_foldl' z0 s0+ where+ loop_foldl' !z !s = case next s of+ Done -> z+ Skip s' -> loop_foldl' z s'+ Yield x s' -> loop_foldl' (f z x) s'+{-# INLINE [0] foldl' #-}++-- | foldl1 is a variant of foldl that has no starting value argument,+-- and thus must be applied to non-empty Streams.+foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char+foldl1 f (Stream next s0 _len) = loop0_foldl1 s0+ where+ loop0_foldl1 !s = case next s of+ Skip s' -> loop0_foldl1 s'+ Yield x s' -> loop_foldl1 x s'+ Done -> emptyError "foldl1"+ loop_foldl1 z !s = case next s of+ Done -> z+ Skip s' -> loop_foldl1 z s'+ Yield x s' -> loop_foldl1 (f z x) s'+{-# INLINE [0] foldl1 #-}++-- | A strict version of foldl1.+foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char+foldl1' f (Stream next s0 _len) = loop0_foldl1' s0+ where+ loop0_foldl1' !s = case next s of+ Skip s' -> loop0_foldl1' s'+ Yield x s' -> loop_foldl1' x s'+ Done -> emptyError "foldl1"+ loop_foldl1' !z !s = case next s of+ Done -> z+ Skip s' -> loop_foldl1' z s'+ Yield x s' -> loop_foldl1' (f z x) s'+{-# INLINE [0] foldl1' #-}++-- | 'foldr', applied to a binary operator, a starting value (typically the+-- right-identity of the operator), and a stream, reduces the stream using the+-- binary operator, from right to left.+foldr :: (Char -> b -> b) -> b -> Stream Char -> b+foldr f z (Stream next s0 _len) = loop_foldr s0+ where+ loop_foldr !s = case next s of+ Done -> z+ Skip s' -> loop_foldr s'+ Yield x s' -> f x (loop_foldr s')+{-# INLINE [0] foldr #-}++-- | foldr1 is a variant of 'foldr' that has no starting value argument,+-- and thus must be applied to non-empty streams.+-- Subject to array fusion.+foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char+foldr1 f (Stream next s0 _len) = loop0_foldr1 s0+ where+ loop0_foldr1 !s = case next s of+ Done -> emptyError "foldr1"+ Skip s' -> loop0_foldr1 s'+ Yield x s' -> loop_foldr1 x s'++ loop_foldr1 x !s = case next s of+ Done -> x+ Skip s' -> loop_foldr1 x s'+ Yield x' s' -> f x (loop_foldr1 x' s')+{-# INLINE [0] foldr1 #-}++intercalate :: Stream Char -> [Stream Char] -> Stream Char+intercalate s = concat . (L.intersperse s)+{-# INLINE [0] intercalate #-}++-- ----------------------------------------------------------------------------+-- ** Special folds++-- | /O(n)/ Concatenate a list of streams. Subject to array fusion.+concat :: [Stream Char] -> Stream Char+concat = L.foldr append empty++-- | Map a function over a stream that results in a stream and concatenate the+-- results.+concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char+concatMap f = foldr (append . f) empty++-- | /O(n)/ any @p @xs determines if any character in the stream+-- @xs@ satisifes the predicate @p@.+any :: (Char -> Bool) -> Stream Char -> Bool+any p (Stream next0 s0 _len) = loop_any s0+ where+ loop_any !s = case next0 s of+ Done -> False+ Skip s' -> loop_any s'+ Yield x s' | p x -> True+ | otherwise -> loop_any s'+{-# INLINE [0] any #-}++-- | /O(n)/ all @p @xs determines if all characters in the 'Text'+-- @xs@ satisify the predicate @p@.+all :: (Char -> Bool) -> Stream Char -> Bool+all p (Stream next0 s0 _len) = loop_all s0+ where+ loop_all !s = case next0 s of+ Done -> True+ Skip s' -> loop_all s'+ Yield x s' | p x -> loop_all s'+ | otherwise -> False+{-# INLINE [0] all #-}++-- | /O(n)/ maximum returns the maximum value from a stream, which must be+-- non-empty.+maximum :: Stream Char -> Char+maximum (Stream next0 s0 _len) = loop0_maximum s0+ where+ loop0_maximum !s = case next0 s of+ Done -> emptyError "maximum"+ Skip s' -> loop0_maximum s'+ Yield x s' -> loop_maximum x s'+ loop_maximum !z !s = case next0 s of+ Done -> z+ Skip s' -> loop_maximum z s'+ Yield x s'+ | x > z -> loop_maximum x s'+ | otherwise -> loop_maximum z s'+{-# INLINE [0] maximum #-}++-- | /O(n)/ minimum returns the minimum value from a 'Text', which must be+-- non-empty.+minimum :: Stream Char -> Char+minimum (Stream next0 s0 _len) = loop0_minimum s0+ where+ loop0_minimum !s = case next0 s of+ Done -> emptyError "minimum"+ Skip s' -> loop0_minimum s'+ Yield x s' -> loop_minimum x s'+ loop_minimum !z !s = case next0 s of+ Done -> z+ Skip s' -> loop_minimum z s'+ Yield x s'+ | x < z -> loop_minimum x s'+ | otherwise -> loop_minimum z s'+{-# INLINE [0] minimum #-}++-- -----------------------------------------------------------------------------+-- * Building streams++scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char+scanl f z0 (Stream next0 s0 len) = Stream next (S1 :!: z0 :!: s0) (len+1) -- HINT maybe too low+ where+ {-# INLINE next #-}+ next (S1 :!: z :!: s) = Yield z (S2 :!: z :!: s)+ next (S2 :!: z :!: s) = case next0 s of+ Yield x s' -> let !x' = f z x+ in Yield x' (S2 :!: x' :!: s')+ Skip s' -> Skip (S2 :!: z :!: s')+ Done -> Done+{-# INLINE [0] scanl #-}++-- -----------------------------------------------------------------------------+-- ** Accumulating maps++-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a+-- function to each element of a stream, passing an accumulating+-- parameter from left to right, and returns a final stream.+--+-- /Note/: Unlike the version over lists, this function does not+-- return a final value for the accumulator, because the nature of+-- streams precludes it.+mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b+mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :!: z0) len -- HINT depends on f+ where+ {-# INLINE next #-}+ next (s :!: z) = case next0 s of+ Yield x s' -> let (z',y) = f z x+ in Yield y (s' :!: z')+ Skip s' -> Skip (s' :!: z)+ Done -> Done+{-# INLINE [0] mapAccumL #-}++-- -----------------------------------------------------------------------------+-- ** Generating and unfolding streams++replicate :: Int -> Char -> Stream Char+replicate n c+ | n < 0 = empty+ | otherwise = Stream next 0 n -- HINT maybe too low+ where+ {-# INLINE next #-}+ next i | i >= n = Done+ | otherwise = Yield c (i + 1)+{-# INLINE [0] replicate #-}++-- | /O(n)/, where @n@ is the length of the result. The unfoldr function+-- is analogous to the List 'unfoldr'. unfoldr builds a stream+-- from a seed value. The function takes the element and returns+-- Nothing if it is done producing the stream or returns Just+-- (a,b), in which case, a is the next Char in the string, and b is+-- the seed value for further production.+unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char+unfoldr f s0 = Stream next s0 1 -- HINT maybe too low+ where+ {-# INLINE next #-}+ next !s = case f s of+ Nothing -> Done+ Just (w, s') -> Yield w s'+{-# INLINE [0] unfoldr #-}++-- | /O(n)/ Like 'unfoldr', 'unfoldrNI' builds a stream from a seed+-- value. However, the length of the result is limited by the+-- first argument to 'unfoldrNI'. This function is more efficient than+-- 'unfoldr' when the length of the result is known.+unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char+unfoldrNI n f s0 | n < 0 = empty+ | otherwise = Stream next (0 :!: s0) (fromIntegral (n*2)) -- HINT maybe too high+ where+ {-# INLINE next #-}+ next (z :!: s) = case f s of+ Nothing -> Done+ Just (w, s') | z >= n -> Done+ | otherwise -> Yield w ((z + 1) :!: s')+{-# INLINE unfoldrNI #-}++-------------------------------------------------------------------------------+-- * Substreams++-- | /O(n)/ take n, applied to a stream, returns the prefix of the+-- stream of length @n@, or the stream itself if @n@ is greater than the+-- length of the stream.+take :: Integral a => a -> Stream Char -> Stream Char+take n0 (Stream next0 s0 len) = Stream next (n0 :!: s0) (min 0 (len - fromIntegral n0)) -- HINT maybe too high+ where+ {-# INLINE next #-}+ next (n :!: s) | n <= 0 = Done+ | otherwise = case next0 s of+ Done -> Done+ Skip s' -> Skip (n :!: s')+ Yield x s' -> Yield x ((n-1) :!: s')+{-# INLINE [0] take #-}++-- | /O(n)/ drop n, applied to a stream, returns the suffix of the+-- stream of length @n@, or the empty stream if @n@ is greater than the+-- length of the stream.+drop :: Integral a => a -> Stream Char -> Stream Char+drop n0 (Stream next0 s0 len) =+ Stream next (J (max 0 n0) :!: s0) (len - fromIntegral n0) -- HINT maybe too high+ where+ {-# INLINE next #-}+ next (J n :!: s)+ | n == 0 = Skip (N :!: s)+ | otherwise = case next0 s of+ Done -> Done+ Skip s' -> Skip (J n :!: s')+ Yield _ s' -> Skip (J (n-1) :!: s')+ next (N :!: s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (N :!: s')+ Yield x s' -> Yield x (N :!: s')+{-# INLINE [0] drop #-}++-- | takeWhile, applied to a predicate @p@ and a stream, returns the+-- longest prefix (possibly empty) of elements that satisfy p.+takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char+takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high+ where+ {-# INLINE next #-}+ next !s = case next0 s of+ Done -> Done+ Skip s' -> Skip s'+ Yield x s' | p x -> Yield x s'+ | otherwise -> Done+{-# INLINE [0] takeWhile #-}++-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.+dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char+dropWhile p (Stream next0 s0 len) = Stream next (S1 :!: s0) len -- HINT maybe too high+ where+ {-# INLINE next #-}+ next (S1 :!: s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (S1 :!: s')+ Yield x s' | p x -> Skip (S1 :!: s')+ | otherwise -> Yield x (S2 :!: s')+ next (S2 :!: s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (S2 :!: s')+ Yield x s' -> Yield x (S2 :!: s')+{-# INLINE [0] dropWhile #-}++-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns+-- 'True' iff the first is a prefix of the second.+isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool+isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)+ where+ loop Done _ = True+ loop _ Done = False+ loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')+ loop (Skip s1') x2 = loop (next1 s1') x2+ loop x1 (Skip s2') = loop x1 (next2 s2')+ loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&+ loop (next1 s1') (next2 s2')+{-# INLINE [0] isPrefixOf #-}+{-# SPECIALISE isPrefixOf :: Stream Char -> Stream Char -> Bool #-}++-- ----------------------------------------------------------------------------+-- * Searching++-------------------------------------------------------------------------------+-- ** Searching by equality++-- | /O(n)/ elem is the stream membership predicate.+elem :: Char -> Stream Char -> Bool+elem w (Stream next s0 _len) = loop_elem s0+ where+ loop_elem !s = case next s of+ Done -> False+ Skip s' -> loop_elem s'+ Yield x s' | x == w -> True+ | otherwise -> loop_elem s'+{-# INLINE [0] elem #-}++-------------------------------------------------------------------------------+-- ** Searching with a predicate++-- | /O(n)/ The 'find' function takes a predicate and a stream,+-- and returns the first element in matching the predicate, or 'Nothing'+-- if there is no such element.++find :: (Char -> Bool) -> Stream Char -> Maybe Char+find p (Stream next s0 _len) = loop_find s0+ where+ loop_find !s = case next s of+ Done -> Nothing+ Skip s' -> loop_find s'+ Yield x s' | p x -> Just x+ | otherwise -> loop_find s'+{-# INLINE [0] find #-}++-- | /O(n)/ Stream index (subscript) operator, starting from 0.+indexI :: Integral a => Stream Char -> a -> Char+indexI (Stream next s0 _len) n0+ | n0 < 0 = streamError "index" "Negative index"+ | otherwise = loop_index n0 s0+ where+ loop_index !n !s = case next s of+ Done -> streamError "index" "Index too large"+ Skip s' -> loop_index n s'+ Yield x s' | n == 0 -> x+ | otherwise -> loop_index (n-1) s'+{-# INLINE [0] indexI #-}++-- | /O(n)/ 'filter', applied to a predicate and a stream,+-- returns a stream containing those characters that satisfy the+-- predicate.+filter :: (Char -> Bool) -> Stream Char -> Stream Char+filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high+ where+ {-# INLINE next #-}+ next !s = case next0 s of+ Done -> Done+ Skip s' -> Skip s'+ Yield x s' | p x -> Yield x s'+ | otherwise -> Skip s'+{-# INLINE [0] filter #-}++{-# RULES+ "Stream filter/filter fusion" forall p q s.+ filter p (filter q s) = filter (\x -> q x && p x) s+ #-}++-- | The 'findIndexI' function takes a predicate and a stream and+-- returns the index of the first element in the stream satisfying the+-- predicate.+findIndexI :: Integral a => (Char -> Bool) -> Stream Char -> Maybe a+findIndexI p s = case findIndicesI p s of+ (i:_) -> Just i+ _ -> Nothing+{-# INLINE [0] findIndexI #-}++-- | The 'findIndicesI' function takes a predicate and a stream and+-- returns all indices of the elements in the stream satisfying the+-- predicate.+findIndicesI :: Integral a => (Char -> Bool) -> Stream Char -> [a]+findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0+ where+ loop_findIndex !i !s = case next s of+ Done -> []+ Skip s' -> loop_findIndex i s' -- hmm. not caught by QC+ Yield x s' | p x -> i : loop_findIndex (i+1) s'+ | otherwise -> loop_findIndex (i+1) s'+{-# INLINE [0] findIndicesI #-}++-------------------------------------------------------------------------------+-- * Zipping++-- | zipWith generalises 'zip' by zipping with the function given as+-- the first argument, instead of a tupling function.+zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b+zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) = Stream next (sa0 :!: sb0 :!: N) (min len1 len2)+ where+ {-# INLINE next #-}+ next (sa :!: sb :!: N) = case next0 sa of+ Done -> Done+ Skip sa' -> Skip (sa' :!: sb :!: N)+ Yield a sa' -> Skip (sa' :!: sb :!: J a)++ next (sa' :!: sb :!: J a) = case next1 sb of+ Done -> Done+ Skip sb' -> Skip (sa' :!: sb' :!: J a)+ Yield b sb' -> Yield (f a b) (sa' :!: sb' :!: N)+{-# INLINE [0] zipWith #-}++-- | /O(n)/ The 'elemIndexI' function returns the index of the first+-- element in the given stream which is equal to the query+-- element, or 'Nothing' if there is no such element.+elemIndexI :: Integral a => Char -> Stream Char -> Maybe a+elemIndexI a s = case elemIndicesI a s of+ (i:_) -> Just i+ _ -> Nothing+{-# INLINE [0] elemIndexI #-}++-- | /O(n)/ The 'elemIndicesI' function returns the index of every+-- element in the given stream which is equal to the query element.+elemIndicesI :: Integral a => Char -> Stream Char -> [a]+elemIndicesI a (Stream next s0 _len) = loop 0 s0+ where+ loop !i !s = case next s of+ Done -> []+ Skip s' -> loop i s'+ Yield x s' | a == x -> i : loop (i+1) s'+ | otherwise -> loop (i+1) s'+{-# INLINE [0] elemIndicesI #-}++-- | /O(n)/ The 'count' function returns the number of times the query+-- element appears in the given stream.+countI :: Integral a => Char -> Stream Char -> a+countI a (Stream next s0 _len) = loop 0 s0+ where+ loop !i !s = case next s of+ Done -> i+ Skip s' -> loop i s'+ Yield x s' | a == x -> loop (i+1) s'+ | otherwise -> loop i s'+{-# INLINE [0] countI #-}++streamError :: String -> String -> a+streamError func msg = P.error $ "Data.Text.Fusion.Common." ++ func ++ ": " ++ msg++emptyError :: String -> a+emptyError func = internalError func "Empty input"++internalError :: String -> a+internalError func = streamError func "Internal error"
+ Data/Text/Fusion/Internal.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE BangPatterns, ExistentialQuantification #-}+-- |+-- Module : Data.Text.Fusion.Internal+-- Copyright : (c) Tom Harper 2008-2009,+-- (c) Bryan O'Sullivan 2009,+-- (c) Duncan Coutts 2009+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,+-- duncan@haskell.org+-- Stability : experimental+-- Portability : GHC+--+-- Core stream fusion functionality for text.++module Data.Text.Fusion.Internal+ (+ M(..)+ , M8+ , PairS(..)+ , S(..)+ , Step(..)+ , Stream(..)+ , Switch(..)+ , empty+ ) where++import Data.Word (Word8)++-- | Specialised, strict Maybe-like type.+data M a = N+ | J {-# UNPACK #-} !a+ deriving (Eq, Ord, Show)++type M8 = M Word8++-- Restreaming state.+data S s = S {-# UNPACK #-} !s+ {-# UNPACK #-} !M8 {-# UNPACK #-} !M8 {-# UNPACK #-} !M8+ deriving (Eq, Ord, Show)++infixl 2 :!:+data PairS a b = !a :!: !b+ deriving (Eq, Ord, Read, Show)++-- | Allow a function over a stream to switch between two states.+data Switch = S1 | S2+ deriving (Eq, Ord, Show)++data Step s a = Done+ | Skip !s+ | Yield !a !s++instance Show a => Show (Step s a)+ where show Done = "Done"+ show (Skip _) = "Skip"+ show (Yield x _) = "Yield " ++ show x++instance (Eq a) => Eq (Stream a) where+ (==) = eq++instance (Ord a) => Ord (Stream a) where+ compare = cmp++-- The length hint in a Stream has two roles. If its value is zero,+-- we trust it, and treat the stream as empty. Otherwise, we treat it+-- as a hint: it should usually be accurate, so we use it when+-- unstreaming to decide what size array to allocate. However, the+-- unstreaming functions must be able to cope with the hint being too+-- small or too large.+--+-- The size hint tries to track the UTF-16 code points in a stream,+-- but often counts the number of characters instead. It can easily+-- undercount if, for instance, a transformed stream contains astral+-- plane characters (those above 0x10000).++data Stream a =+ forall s. Stream+ (s -> Step s a) -- stepper function+ !s -- current state+ {-# UNPACK #-}!Int -- length hint++-- | /O(n)/ Determines if two streams are equal.+eq :: (Eq a) => Stream a -> Stream a -> Bool+eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)+ where+ loop Done Done = True+ loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')+ loop (Skip s1') x2 = loop (next1 s1') x2+ loop x1 (Skip s2') = loop x1 (next2 s2')+ loop Done _ = False+ loop _ Done = False+ loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&+ loop (next1 s1') (next2 s2')+{-# INLINE [0] eq #-}+{-# SPECIALISE eq :: Stream Char -> Stream Char -> Bool #-}++cmp :: (Ord a) => Stream a -> Stream a -> Ordering+cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)+ where+ loop Done Done = EQ+ loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')+ loop (Skip s1') x2 = loop (next1 s1') x2+ loop x1 (Skip s2') = loop x1 (next2 s2')+ loop Done _ = LT+ loop _ Done = GT+ loop (Yield x1 s1') (Yield x2 s2') =+ case compare x1 x2 of+ EQ -> loop (next1 s1') (next2 s2')+ other -> other+{-# INLINE [0] cmp #-}+{-# SPECIALISE cmp :: Stream Char -> Stream Char -> Ordering #-}++-- | The empty stream.+empty :: Stream a+empty = Stream next () 0+ where next _ = Done+{-# INLINE [0] empty #-}
Data/Text/Internal.hs view
@@ -1,13 +1,13 @@ {-# LANGUAGE DeriveDataTypeable #-} -- |--- Module : Data.Text+-- Module : Data.Text.Internal -- Copyright : (c) Tom Harper 2008-2009, -- (c) Bryan O'Sullivan 2009, -- (c) Duncan Coutts 2009 -- -- License : BSD-style--- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk, -- duncan@haskell.org -- Stability : experimental -- Portability : GHC@@ -21,6 +21,7 @@ Text(..) -- * Construction , text+ , textP -- * Code that must be here for accessibility , empty -- * Debugging@@ -55,6 +56,13 @@ empty :: Text empty = Text A.empty 0 0 {-# INLINE [1] empty #-}++-- | Construct a 'Text' without invisibly pinning its byte array in+-- memory if its length has dwindled to zero.+textP :: A.Array Word16 -> Int -> Int -> Text+textP arr off len | len == 0 = empty+ | otherwise = text arr off len+{-# INLINE textP #-} -- | A useful 'show'-like function for debugging purposes. showText :: Text -> String
+ Data/Text/Lazy.hs view
@@ -0,0 +1,872 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Module : Data.Text.Lazy+-- Copyright : (c) Bryan O'Sullivan 2009+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,+-- duncan@haskell.org+-- Stability : experimental+-- Portability : GHC+--+-- A time and space-efficient implementation of Unicode text using+-- lists of packed arrays. This representation is suitable for high+-- performance use and for streaming large quantities of data. It+-- provides a means to manipulate a large body of text without+-- requiring that the entire content be resident in memory.+--+-- Some operations, such as 'concat', 'append', 'reverse' and 'cons',+-- have better complexity than their "Data.Text" equivalents, due to+-- optimisations resulting from the list spine structure. And for+-- other operations lazy 'Text's are usually within a few percent of+-- strict ones, but with better heap usage. For data larger than+-- available memory, or if you have tight memory constraints, this+-- module will be the only option.+--+-- This module is intended to be imported @qualified@, to avoid name+-- clashes with "Prelude" functions. eg.+--+-- > import qualified Data.Text.Lazy as B++module Data.Text.Lazy+ (+ Text+ -- * Creation and elimination+ , pack+ , unpack+ , singleton+ , empty+ , fromChunks+ , toChunks++ -- * Basic interface+ , cons+ , snoc+ , append+ , uncons+ , head+ , last+ , tail+ , init+ , null+ , length++ -- * Transformations+ , map+ , intercalate+ , intersperse+ , transpose+ , reverse++ -- * Folds+ , foldl+ , foldl'+ , foldl1+ , foldl1'+ , foldr+ , foldr1++ -- ** Special folds+ , concat+ , concatMap+ , any+ , all+ , maximum+ , minimum++ -- * Construction++ -- ** Scans+ , scanl+ , scanl1+ , scanr+ , scanr1++ -- ** Accumulating maps+ , mapAccumL+ , mapAccumR++ -- ** Generation and unfolding+ , replicate+ , unfoldr+ , unfoldrN++ -- * Substrings++ -- ** Breaking strings+ , take+ , drop+ , takeWhile+ , dropWhile+ , splitAt+ , span+ , break+ , group+ , groupBy+ , inits+ , tails++ -- ** Breaking into many substrings+ , split+ , splitWith+ -- , breakSubstring++ -- ** Breaking into lines and words+ , lines+ , words+ , unlines+ , unwords++ -- * Predicates+ , isPrefixOf+ , isSuffixOf+ , isInfixOf++ -- * Searching+ , elem+ , filter+ , find+ , partition++ -- , findSubstring+ + -- * Indexing+ , index+ , findIndex+ , findIndices+ , elemIndex+ , elemIndices+ , count++ -- * Zipping and unzipping+ , zip+ , zipWith++ -- -* Ordered text+ -- , sort+ ) where++import Prelude (Char, Bool(..), Int, Maybe(..), String,+ Eq(..), Ord(..), Read(..), Show(..),+ (&&), (+), (-), (.), ($), (++),+ flip, fromIntegral, not, otherwise)+import qualified Prelude as P+import Data.Int (Int64)+import qualified Data.List as L+import Data.Char (isSpace)+import Data.String (IsString(..))+import qualified Data.Text as T+import qualified Data.Text.Fusion.Common as S+import qualified Data.Text.Unsafe as T+import qualified Data.Text.Lazy.Fusion as S+import Data.Text.Lazy.Fusion (stream, unstream)+import Data.Text.Lazy.Internal++instance Eq Text where+ t1 == t2 = stream t1 == stream t2+ {-# INLINE (==) #-}++instance Ord Text where+ compare t1 t2 = compare (stream t1) (stream t2)+ {-# INLINE compare #-}++instance Show Text where+ showsPrec p ps r = showsPrec p (unpack ps) r++instance Read Text where+ readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]++instance IsString Text where+ fromString = pack++-- | /O(n)/ Convert a 'String' into a 'Text'.+--+-- This function is subject to array fusion.+pack :: String -> Text+pack s = unstream (S.streamList s)+{-# INLINE [1] pack #-}++-- | /O(n)/ Convert a 'Text' into a 'String'.+-- Subject to array fusion.+unpack :: Text -> String+unpack t = S.unstreamList (stream t)+{-# INLINE [1] unpack #-}++singleton :: Char -> Text+singleton c = Chunk (T.singleton c) Empty+{-# INLINE [1] singleton #-}++{-# RULES+"LAZY TEXT singleton -> fused" [~1] forall c.+ singleton c = unstream (S.singleton c)+"LAZY TEXT singleton -> unfused" [1] forall c.+ unstream (S.singleton c) = singleton c+ #-}++-- | /O(c)/ Convert a list of strict 'T.Text's into a lazy 'Text'.+fromChunks :: [T.Text] -> Text+fromChunks cs = L.foldr chunk Empty cs++-- | /O(n)/ Convert a lazy 'Text' into a list of strict 'T.Text's.+toChunks :: Text -> [T.Text]+toChunks cs = foldrChunks (:) [] cs++cons :: Char -> Text -> Text+cons c t = Chunk (T.singleton c) t+{-# INLINE [1] cons #-}++{-# RULES+"LAZY TEXT cons -> fused" [~1] forall c t.+ cons c t = unstream (S.cons c (stream t))+"LAZY TEXT cons -> unfused" [1] forall c t.+ unstream (S.cons c (stream t)) = cons c t+ #-}++snoc :: Text -> Char -> Text+snoc t c = foldrChunks Chunk (singleton c) t+{-# INLINE [1] snoc #-}++{-# RULES+"LAZY TEXT snoc -> fused" [~1] forall t c.+ snoc t c = unstream (S.snoc (stream t) c)+"LAZY TEXT snoc -> unfused" [1] forall t c.+ unstream (S.snoc (stream t) c) = snoc t c+ #-}++-- | /O(n\/c)/ Appends one 'Text' to another. Subject to array+-- fusion.+append :: Text -> Text -> Text+append xs ys = foldrChunks Chunk ys xs+{-# INLINE [1] append #-}++{-# RULES+"LAZY TEXT append -> fused" [~1] forall t1 t2.+ append t1 t2 = unstream (S.append (stream t1) (stream t2))+"LAZY TEXT append -> unfused" [1] forall t1 t2.+ unstream (S.append (stream t1) (stream t2)) = append t1 t2+ #-}++-- | /O(1)/ Returns the first character and rest of a 'Text', or+-- 'Nothing' if empty. Subject to array fusion.+uncons :: Text -> Maybe (Char, Text)+uncons Empty = Nothing+uncons (Chunk t ts) =+ Just (T.unsafeHead t,+ if T.length t == 1 then ts else Chunk (T.unsafeTail t) ts)+{-# INLINE uncons #-}++-- | /O(1)/ Returns the first character of a 'Text', which must be+-- non-empty. Subject to array fusion.+head :: Text -> Char+head t = S.head (stream t)+{-# INLINE head #-}++-- | /O(1)/ Returns all characters after the head of a 'Text', which+-- must be non-empty. Subject to array fusion.+tail :: Text -> Text+tail (Chunk t ts) = chunk (T.tail t) ts+tail Empty = emptyError "tail"+{-# INLINE [1] tail #-}++{-# RULES+"LAZY TEXT tail -> fused" [~1] forall t.+ tail t = unstream (S.tail (stream t))+"LAZY TEXT tail -> unfused" [1] forall t.+ unstream (S.tail (stream t)) = tail t+ #-}++-- | /O(1)/ Returns all but the last character of a 'Text', which must+-- be non-empty. Subject to array fusion.+init :: Text -> Text+init (Chunk t0 ts0) = go t0 ts0+ where go t (Chunk t' ts) = Chunk t (go t' ts)+ go t Empty = chunk (T.init t) Empty+init Empty = emptyError "init"+{-# INLINE [1] init #-}++{-# RULES+"LAZY TEXT init -> fused" [~1] forall t.+ init t = unstream (S.init (stream t))+"LAZY TEXT init -> unfused" [1] forall t.+ unstream (S.init (stream t)) = init t+ #-}++-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to array+-- fusion.+null :: Text -> Bool+null Empty = True+null _ = False+{-# INLINE [1] null #-}++{-# RULES+"LAZY TEXT null -> fused" [~1] forall t.+ null t = S.null (stream t)+"LAZY TEXT null -> unfused" [1] forall t.+ S.null (stream t) = null t+ #-}++-- | /O(1)/ Returns the last character of a 'Text', which must be+-- non-empty. Subject to array fusion.+last :: Text -> Char+last Empty = emptyError "last"+last (Chunk t ts) = go t ts+ where go _ (Chunk t' ts') = go t' ts'+ go t' Empty = T.last t'+{-# INLINE [1] last #-}++{-# RULES+"LAZY TEXT last -> fused" [~1] forall t.+ last t = S.last (stream t)+"LAZY TEXT last -> unfused" [1] forall t.+ S.last (stream t) = last t+ #-}++length :: Text -> Int64+length = foldlChunks go 0+ where go l t = l + fromIntegral (T.length t)+{-# INLINE [1] length #-}++{-# RULES+"LAZY TEXT length -> fused" [~1] forall t.+ length t = S.length (stream t)+"LAZY TEXT length -> unfused" [1] forall t.+ S.length (stream t) = length t+ #-}++-- | /O(n)/ 'map' @f @xs is the 'Text' obtained by applying @f@ to+-- each element of @xs@. Subject to array fusion.+map :: (Char -> Char) -> Text -> Text+map f t = unstream (S.map f (stream t))+{-# INLINE [1] map #-}++-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of+-- 'Text's and concatenates the list after interspersing the first+-- argument between each element of the list.+intercalate :: Text -> [Text] -> Text+intercalate t ts = unstream (S.intercalate (stream t) (L.map stream ts))+{-# INLINE intercalate #-}++-- | /O(n)/ The 'intersperse' function takes a character and places it+-- between the characters of a 'Text'. Subject to array fusion.+intersperse :: Char -> Text -> Text+intersperse c t = unstream (S.intersperse c (stream t))+{-# INLINE intersperse #-}++-- | /O(n)/ The 'transpose' function transposes the rows and columns+-- of its 'Text' argument. Note that this function uses 'pack',+-- 'unpack', and the list version of transpose, and is thus not very+-- efficient.+transpose :: [Text] -> [Text]+transpose ts = L.map (\ss -> Chunk (T.pack ss) Empty)+ (L.transpose (L.map unpack ts))+-- TODO: make this fast++-- | /O(n)/ 'reverse' @t@ returns the elements of @t@ in reverse order.+reverse :: Text -> Text+reverse = rev Empty+ where rev a Empty = a+ rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts++-- | /O(n)/ 'foldl', applied to a binary operator, a starting value+-- (typically the left-identity of the operator), and a 'Text',+-- reduces the 'Text' using the binary operator, from left to right.+-- Subject to array fusion.+foldl :: (b -> Char -> b) -> b -> Text -> b+foldl f z t = S.foldl f z (stream t)+{-# INLINE foldl #-}++-- | /O(n)/ A strict version of 'foldl'.+-- Subject to array fusion.+foldl' :: (b -> Char -> b) -> b -> Text -> b+foldl' f z t = S.foldl' f z (stream t)+{-# INLINE foldl' #-}++-- | /O(n)/ A variant of 'foldl' that has no starting value argument,+-- and thus must be applied to a non-empty 'Text'. Subject to array+-- fusion.+foldl1 :: (Char -> Char -> Char) -> Text -> Char+foldl1 f t = S.foldl1 f (stream t)+{-# INLINE foldl1 #-}++-- | /O(n)/ A strict version of 'foldl1'.+-- Subject to array fusion.+foldl1' :: (Char -> Char -> Char) -> Text -> Char+foldl1' f t = S.foldl1' f (stream t)+{-# INLINE foldl1' #-}++-- | /O(n)/ 'foldr', applied to a binary operator, a starting value+-- (typically the right-identity of the operator), and a 'Text',+-- reduces the 'Text' using the binary operator, from right to left.+-- Subject to array fusion.+foldr :: (Char -> b -> b) -> b -> Text -> b+foldr f z t = S.foldr f z (stream t)+{-# INLINE foldr #-}++-- | /O(n)/ A variant of 'foldr' that has no starting value argument, and+-- thust must be applied to a non-empty 'Text'. Subject to array+-- fusion.+foldr1 :: (Char -> Char -> Char) -> Text -> Char+foldr1 f t = S.foldr1 f (stream t)+{-# INLINE foldr1 #-}++-- | /O(n)/ Concatenate a list of 'Text's. Subject to array fusion.+concat :: [Text] -> Text+concat ts = unstream (S.concat (L.map stream ts))+{-# INLINE concat #-}++-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and+-- concatenate the results. This function is subject to array fusion.+--+-- Note: if in 'concatMap' @f@ @t@, @f@ is defined in terms of fusible+-- functions, it will also be fusible.+concatMap :: (Char -> Text) -> Text -> Text+concatMap f t = unstream (S.concatMap (stream . f) (stream t))+{-# INLINE concatMap #-}++-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the+-- 'Text' @t@ satisifes the predicate @p@. Subject to array fusion.+any :: (Char -> Bool) -> Text -> Bool+any p t = S.any p (stream t)+{-# INLINE any #-}++-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the+-- 'Text' @t@ satisify the predicate @p@. Subject to array fusion.+all :: (Char -> Bool) -> Text -> Bool+all p t = S.all p (stream t)+{-# INLINE all #-}++-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which+-- must be non-empty. Subject to array fusion.+maximum :: Text -> Char+maximum t = S.maximum (stream t)+{-# INLINE maximum #-}++-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which+-- must be non-empty. Subject to array fusion.+minimum :: Text -> Char+minimum t = S.minimum (stream t)+{-# INLINE minimum #-}++-- | /O(n)/ 'scanl' is similar to 'foldl', but returns a list of+-- successive reduced values from the left. This function is subject+-- to array fusion.+--+-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]+--+-- Note that+--+-- > last (scanl f z xs) == foldl f z xs.+scanl :: (Char -> Char -> Char) -> Char -> Text -> Text+scanl f z t = unstream (S.scanl f z (stream t))+{-# INLINE scanl #-}++-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting+-- value argument. This function is subject to array fusion.+--+-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]+scanl1 :: (Char -> Char -> Char) -> Text -> Text+scanl1 f t0 = case uncons t0 of+ Nothing -> empty+ Just (t,ts) -> scanl f t ts+{-# INLINE scanl1 #-}++-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'.+--+-- > scanr f v == reverse . scanl (flip f) v . reverse+scanr :: (Char -> Char -> Char) -> Char -> Text -> Text+scanr f v = reverse . scanl (flip f) v . reverse++-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting+-- value argument.+scanr1 :: (Char -> Char -> Char) -> Text -> Text+scanr1 f t | null t = empty+ | otherwise = scanr f (last t) (init t)++-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a+-- function to each element of a 'Text', passing an accumulating+-- parameter from left to right, and returns a final 'Text'.+mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)+mapAccumL f s t = case uncons t of+ Nothing -> (s, empty)+ Just (x, xs) -> (s'', cons y ys)+ where (s', y ) = f s x+ (s'',ys) = mapAccumL f s' xs++-- | The 'mapAccumR' function behaves like a combination of 'map' and+-- 'foldr'; it applies a function to each element of a 'Text', passing+-- an accumulating parameter from right to left, and returning a final+-- value of this accumulator together with the new 'Text'.+mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)+mapAccumR f s t = case uncons t of+ Nothing -> (s, empty)+ Just (x, xs) -> (s'', cons y ys)+ where (s'',y ) = f s' x+ (s', ys) = mapAccumR f s xs++-- | /O(n)/ 'replicate' @n@ @c@ is a 'Text' of length @n@ with @c@ the+-- value of every element.+replicate :: Int -> Char -> Text+replicate n c = unstream (S.replicate n c)+{-# INLINE replicate #-}++-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'+-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a+-- 'Text' from a seed value. The function takes the element and+-- returns 'Nothing' if it is done producing the 'Text', otherwise+-- 'Just' @(a,b)@. In this case, @a@ is the next 'Char' in the+-- string, and @b@ is the seed value for further production.+unfoldr :: (a -> Maybe (Char,a)) -> a -> Text+unfoldr f s = unstream (S.unfoldr f s)+{-# INLINE unfoldr #-}++-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed+-- value. However, the length of the result should be limited by the+-- first argument to 'unfoldrN'. This function is more efficient than+-- 'unfoldr' when the maximum length of the result is known and+-- correct, otherwise its performance is similar to 'unfoldr'.+unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Text+unfoldrN n f s = unstream (S.unfoldrN n f s)+{-# INLINE unfoldrN #-}++-- | /O(n)/ 'take' @n@, applied to a 'Text', returns the prefix of the+-- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than+-- the length of the Text. Subject to fusion.+take :: Int64 -> Text -> Text+take i _ | i <= 0 = Empty+take i t0 = take' i t0+ where take' 0 _ = Empty+ take' _ Empty = Empty+ take' n (Chunk t ts)+ | n < len = Chunk (T.take (fromIntegral n) t) Empty+ | otherwise = Chunk t (take' (n - len) ts)+ where len = fromIntegral (T.length t)+{-# INLINE [1] take #-}++{-# RULES+"LAZY TEXT take -> fused" [~1] forall n t.+ take n t = unstream (S.take n (stream t))+"LAZY TEXT take -> unfused" [1] forall n t.+ unstream (S.take n (stream t)) = take n t+ #-}++-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the+-- 'Text' of length @n@, or the empty 'Text' if @n@ is greater than the+-- length of the 'Text'. Subject to fusion.+drop :: Int -> Text -> Text+drop i t0+ | i <= 0 = t0+ | otherwise = drop' i t0+ where drop' 0 ts = ts+ drop' _ Empty = Empty+ drop' n (Chunk t ts) + | n < len = Chunk (T.drop (fromIntegral n) t) ts+ | otherwise = drop' (n - len) ts+ where len = fromIntegral (T.length t)+{-# INLINE [1] drop #-}++{-# RULES+"LAZY TEXT drop -> fused" [~1] forall n t.+ drop n t = unstream (S.drop n (stream t))+"LAZY TEXT drop -> unfused" [1] forall n t.+ unstream (S.drop n (stream t)) = drop n t+ #-}++-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text', returns+-- the longest prefix (possibly empty) of elements that satisfy @p@.+-- This function is subject to array fusion.+takeWhile :: (Char -> Bool) -> Text -> Text+takeWhile p t0 = takeWhile' t0+ where takeWhile' Empty = Empty+ takeWhile' (Chunk t ts) =+ case T.findIndex (not . p) t of+ Just n | n > 0 -> Chunk (T.take n t) Empty+ | otherwise -> Empty+ Nothing -> Chunk t (takeWhile' ts)+{-# INLINE [1] takeWhile #-}++{-# RULES+"LAZY TEXT takeWhile -> fused" [~1] forall p t.+ takeWhile p t = unstream (S.takeWhile p (stream t))+"LAZY TEXT takeWhile -> unfused" [1] forall p t.+ unstream (S.takeWhile p (stream t)) = takeWhile p t+ #-}++-- | /O(n)/ 'dropWhile' @p@ @xs@ returns the suffix remaining after+-- 'takeWhile' @p@ @xs@. This function is subject to array fusion.+dropWhile :: (Char -> Bool) -> Text -> Text+dropWhile p t0 = dropWhile' t0+ where dropWhile' Empty = Empty+ dropWhile' (Chunk t ts) =+ case T.findIndex (not . p) t of+ Just n -> Chunk (T.drop n t) ts+ Nothing -> dropWhile' ts+{-# INLINE [1] dropWhile #-}++{-# RULES+"LAZY TEXT dropWhile -> fused" [~1] forall p t.+ dropWhile p t = unstream (S.dropWhile p (stream t))+"LAZY TEXT dropWhile -> unfused" [1] forall p t.+ unstream (S.dropWhile p (stream t)) = dropWhile p t+ #-}++-- | /O(n)/ 'splitAt' @n t@ returns a pair whose first element is a+-- prefix of @t@ of length @n@, and whose second is the remainder of+-- the string. It is equivalent to @('take' n t, 'drop' n t)@.+splitAt :: Int64 -> Text -> (Text, Text)+splitAt = loop+ where loop _ Empty = (empty, empty)+ loop n t | n <= 0 = (empty, t)+ loop n (Chunk t ts)+ | n < len = let (t',t'') = T.splitAt (fromIntegral n) t+ in (Chunk t' Empty, Chunk t'' ts)+ | otherwise = let (ts',ts'') = loop (n - len) ts+ in (Chunk t ts', ts'')+ where len = fromIntegral (T.length t)++-- | /O(n)/ 'break' is like 'span', but the prefix returned is over+-- elements that fail the predicate @p@.+break :: (Char -> Bool) -> Text -> (Text, Text)+break p t0 = break' t0+ where break' Empty = (empty, empty)+ break' c@(Chunk t ts) =+ case T.findIndex p t of+ Nothing -> let (ts', ts'') = break' ts+ in (Chunk t ts', ts'')+ Just n | n == 0 -> (Empty, c)+ | otherwise -> let (a,b) = T.splitAt n t+ in (Chunk a Empty, Chunk b ts)++-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns a+-- pair whose first element is the longest prefix (possibly empty) of+-- @t@ of elements that satisfy @p@, and whose second is the remainder+-- of the list.+span :: (Char -> Bool) -> Text -> (Text, Text)+span p = break (not . p)+{-# INLINE span #-}++-- | The 'group' function takes a 'Text' and returns a list of 'Text's+-- such that the concatenation of the result is equal to the argument.+-- Moreover, each sublist in the result contains only equal elements.+-- For example,+--+-- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"]+--+-- It is a special case of 'groupBy', which allows the programmer to+-- supply their own equality test.+group :: Text -> [Text]+group = groupBy (==)+{-# INLINE group #-}++-- | The 'groupBy' function is the non-overloaded version of 'group'.+groupBy :: (Char -> Char -> Bool) -> Text -> [Text]+groupBy _ Empty = []+groupBy eq (Chunk t ts) = cons x ys : groupBy eq zs+ where (ys,zs) = span (eq x) xs+ x = T.unsafeHead t+ xs = chunk (T.unsafeTail t) ts++-- | /O(n)/ Return all initial segments of the given 'Text',+-- shortest first.+inits :: Text -> [Text]+inits = (Empty :) . inits'+ where inits' Empty = []+ inits' (Chunk t ts) = L.map (\t' -> Chunk t' Empty) (L.tail (T.inits t))+ ++ L.map (Chunk t) (inits' ts)++-- | /O(n)/ Return all final segments of the given 'Text', longest+-- first.+tails :: Text -> [Text]+tails Empty = Empty : []+tails ts@(Chunk t ts')+ | T.length t == 1 = ts : tails ts'+ | otherwise = ts : tails (Chunk (T.unsafeTail t) ts')++-- | /O(n)/ Break a 'Text' into pieces separated by the byte+-- argument, consuming the delimiter. I.e.+--+-- > split '\n' "a\nb\nd\ne" == ["a","b","d","e"]+-- > split 'a' "aXaXaXa" == ["","X","X","X",""]+-- > split 'x' "x" == ["",""]+-- +-- and+--+-- > intercalate [c] . split c == id+-- > split == splitWith . (==)+-- +-- As for all splitting functions in this library, this function does+-- not copy the substrings, it just constructs new 'Text's that are+-- slices of the original.+split :: Char -> Text -> [Text]+split c = splitWith (==c)+{-# INLINE split #-}++-- | /O(n)/ Splits a 'Text' into components delimited by separators,+-- where the predicate returns True for a separator element. The+-- resulting components do not contain the separators. Two adjacent+-- separators result in an empty component in the output. eg.+--+-- > splitWith (=='a') "aabbaca" == ["","","bb","c",""]+-- > splitWith (=='a') [] == []+splitWith :: (Char -> Bool) -> Text -> [Text]+splitWith _ Empty = []+splitWith p (Chunk t0 ts0) = comb [] (T.splitWith p t0) ts0+ where comb acc (s:[]) Empty = revChunks (s:acc) : []+ comb acc (s:[]) (Chunk t ts) = comb (s:acc) (T.splitWith p t) ts+ comb acc (s:ss) ts = revChunks (s:acc) : comb [] ss ts+ comb _ [] _ = impossibleError "splitWith"+{-# INLINE splitWith #-}++-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at+-- newline 'Char's. The resulting strings do not contain newlines.+lines :: Text -> [Text]+lines Empty = []+lines t = let (l,t') = break ((==) '\n') t+ in l : if null t' then []+ else lines (tail t')++-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's+-- representing white space.+words :: Text -> [Text]+words = L.filter (not . null) . splitWith isSpace+{-# INLINE words #-}++-- | /O(n)/ Joins lines, after appending a terminating newline to+-- each.+unlines :: [Text] -> Text+unlines = concat . L.map (`snoc` '\n')+{-# INLINE unlines #-}++-- | /O(n)/ Joins words using single space characters.+unwords :: [Text] -> Text+unwords = intercalate (singleton ' ')+{-# INLINE unwords #-}++-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns+-- 'True' iff the first is a prefix of the second. This function is+-- subject to fusion.+isPrefixOf :: Text -> Text -> Bool+isPrefixOf Empty _ = True+isPrefixOf _ Empty = False+isPrefixOf (Chunk x xs) (Chunk y ys)+ | lx == ly = x == y && isPrefixOf xs ys+ | lx < ly = x == yh && isPrefixOf xs (Chunk yt ys)+ | otherwise = xh == y && isPrefixOf (Chunk xt xs) ys+ where (xh,xt) = T.splitAt ly x+ (yh,yt) = T.splitAt lx y+ lx = T.length x+ ly = T.length y+{-# INLINE [1] isPrefixOf #-}++{-# RULES+"LAZY TEXT isPrefixOf -> fused" [~1] forall s t.+ isPrefixOf s t = S.isPrefixOf (stream s) (stream t)+"LAZY TEXT isPrefixOf -> unfused" [1] forall s t.+ S.isPrefixOf (stream s) (stream t) = isPrefixOf s t+ #-}++-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns+-- 'True' iff the first is a suffix of the second.+isSuffixOf :: Text -> Text -> Bool+isSuffixOf x y = reverse x `isPrefixOf` reverse y+{-# INLINE isSuffixOf #-}+-- TODO: a better implementation++-- | /O(n)/ The 'isInfixOf' function takes two 'Text's and returns+-- 'True' iff the first is contained, wholly and intact, anywhere+-- within the second.+isInfixOf :: Text -> Text -> Bool+isInfixOf needle haystack = L.any (isPrefixOf needle) (tails haystack)+{-# INLINE isInfixOf #-}+-- TODO: a better implementation++-- | /O(n)/ 'elem' is the 'Text' membership predicate.+elem :: Char -> Text -> Bool+elem c t = S.elem c (stream t)+{-# INLINE elem #-}++-- | /O(n)/ 'filter', applied to a predicate and a 'Text',+-- returns a 'Text' containing those characters that satisfy the+-- predicate.+filter :: (Char -> Bool) -> Text -> Text+filter p t = unstream (S.filter p (stream t))+{-# INLINE filter #-}++-- | /O(n)/ The 'find' function takes a predicate and a 'Text',+-- and returns the first element in matching the predicate, or 'Nothing'+-- if there is no such element.+find :: (Char -> Bool) -> Text -> Maybe Char+find p t = S.find p (stream t)+{-# INLINE find #-}++-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',+-- and returns the pair of 'Text's with elements which do and do not+-- satisfy the predicate, respectively; i.e.+--+-- > partition p t == (filter p t, filter (not . p) t)+partition :: (Char -> Bool) -> Text -> (Text, Text)+partition p t = (filter p t, filter (not . p) t)+{-# INLINE partition #-}++-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.+index :: Text -> Int64 -> Char+index t n = S.index (stream t) n+{-# INLINE index #-}++-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'+-- and returns the index of the first element in the 'Text' satisfying+-- the predicate. This function is subject to fusion.+findIndex :: (Char -> Bool) -> Text -> Maybe Int64+findIndex p t = S.findIndex p (stream t)+{-# INLINE findIndex #-}++-- | The 'findIndices' function extends 'findIndex', by returning the+-- indices of all elements satisfying the predicate, in ascending+-- order. This function is subject to fusion.+findIndices :: (Char -> Bool) -> Text -> [Int64]+findIndices p t = S.findIndices p (stream t)+{-# INLINE findIndices #-}++-- | /O(n)/ The 'elemIndex' function returns the index of the first+-- element in the given 'Text' which is equal to the query element, or+-- 'Nothing' if there is no such element. This function is subject to+-- fusion.+elemIndex :: Char -> Text -> Maybe Int64+elemIndex c t = S.elemIndex c (stream t)+{-# INLINE elemIndex #-}++-- | /O(n)/ The 'elemIndices' function returns the index of every+-- element in the given 'Text' which is equal to the query+-- element. This function is subject to fusion.+elemIndices :: Char -> Text -> [Int64]+elemIndices c t = S.elemIndices c (stream t)+{-# INLINE elemIndices #-}++-- | /O(n)/ The 'count' function returns the number of times the query+-- element appears in the given 'Text'. This function is subject to+-- fusion.+count :: Char -> Text -> Int64+count c t = S.count c (stream t)+{-# INLINE count #-}++-- | /O(n)/ 'zip' takes two 'Text's and returns a list of+-- corresponding pairs of bytes. If one input 'Text' is short,+-- excess elements of the longer 'Text' are discarded. This is+-- equivalent to a pair of 'unpack' operations.+zip :: Text -> Text -> [(Char,Char)]+zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)+{-# INLINE [0] zip #-}++-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function+-- given as the first argument, instead of a tupling function.+zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text+zipWith f t1 t2 = unstream (S.zipWith f (stream t1) (stream t2))+{-# INLINE [0] zipWith #-}++revChunks :: [T.Text] -> Text+revChunks = L.foldl' (flip chunk) Empty++emptyError :: String -> a+emptyError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": empty input")++impossibleError :: String -> a+impossibleError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": impossible case")
+ Data/Text/Lazy/Encoding.hs view
@@ -0,0 +1,48 @@+-- |+-- Module : Data.Text.Lazy.Encoding+-- Copyright : (c) Bryan O'Sullivan 2009+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,+-- duncan@haskell.org+-- Stability : experimental+-- Portability : portable+--+-- Functions for converting lazy 'Text' values to and from lazy+-- 'ByteString', using several standard encodings.+--+-- To make use of a much larger variety of encodings, use the @text-icu@+-- package.++module Data.Text.Lazy.Encoding+ (+ -- * Decoding ByteStrings to Text+ -- decodeASCII+ decodeUtf8+ --, decodeUtf16LE+ --, decodeUtf16BE+ --, decodeUtf32LE+ --, decodeUtf32BE++ -- * Encoding Text to ByteStrings+ , encodeUtf8+ --, encodeUtf16LE+ --, encodeUtf16BE+ --, encodeUtf32LE+ --, encodeUtf32BE+ ) where++import Data.ByteString.Lazy (ByteString)+import Data.Text.Lazy (Text)+import qualified Data.Text.Lazy.Fusion as F+import qualified Data.Text.Lazy.Encoding.Fusion as E++-- | Decode a 'ByteString' containing UTF-8 encoded text.+decodeUtf8 :: ByteString -> Text+decodeUtf8 bs = F.unstream (E.streamUtf8 bs)+{-# INLINE decodeUtf8 #-}++-- | Encode text using UTF-8 encoding.+encodeUtf8 :: Text -> ByteString+encodeUtf8 txt = E.unstream (E.restreamUtf8 (F.stream txt))+{-# INLINE encodeUtf8 #-}
+ Data/Text/Lazy/Encoding/Fusion.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE BangPatterns #-}++-- |+-- Module : Data.Text.Lazy.Encoding.Fusion+-- Copyright : (c) Bryan O'Sullivan 2009+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk, +-- duncan@haskell.org+-- Stability : experimental+-- Portability : portable+--+-- Fusible 'Stream'-oriented functions for converting between lazy+-- 'Text' and several common encodings.++module Data.Text.Lazy.Encoding.Fusion+ (+ -- * Streaming+ -- streamASCII+ streamUtf8+ --, streamUtf16LE+ --, streamUtf16BE+ --, streamUtf32LE+ --, streamUtf32BE++ -- * Unstreaming+ , unstream++ , module Data.Text.Encoding.Fusion.Common+ ) where++import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)+import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as B+import Data.Text.Encoding.Fusion.Common+import Data.Text.Fusion (Step(..), Stream(..))+import Data.Text.Fusion.Internal (M(..), PairS(..), S(..))+import Data.Text.UnsafeChar (unsafeChr8)+import Data.Word (Word8)+import qualified Data.Text.Encoding.Utf8 as U8+import System.IO.Unsafe (unsafePerformIO)+import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)+import Foreign.Storable (pokeByteOff)+import Data.ByteString.Internal (mallocByteString, memcpy)+import Control.Exception (assert)+import qualified Data.ByteString.Internal as B++unknownLength :: Int+unknownLength = 4++-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using+-- UTF-8 encoding.+streamUtf8 :: ByteString -> Stream Char+streamUtf8 bs0 = Stream next (bs0 :!: S N N N N :!: 0) unknownLength+ where+ {-# INLINE next #-}+ next st@(bs :!: s :!: i) =+ case s of+ S (J a) N _ _ | U8.validate1 a ->+ Yield (unsafeChr8 a) es+ S (J a) (J b) N _ | U8.validate2 a b ->+ Yield (U8.chr2 a b) es+ S (J a) (J b) (J c) N | U8.validate3 a b c ->+ Yield (U8.chr3 a b c) es+ S (J a) (J b) (J c) (J d) | U8.validate4 a b c d ->+ Yield (U8.chr4 a b c d) es+ _ -> consume st+ where es = bs :!: S N N N N :!: i+ {-# INLINE consume #-}+ consume (bs@(Chunk ps rest) :!: s :!: i)+ | i >= len = consume (rest :!: s :!: 0)+ | otherwise = next (bs :!: s' :!: i+1)+ where s' = case s of+ S N _ _ _ -> S x N N N+ S a N _ _ -> S a x N N+ S a b N _ -> S a b x N+ S a b c N -> S a b c x+ _ -> encodingError "streamUtf8" "UTF-8"+ x = J (B.unsafeIndex ps i)+ len = B.length ps+ consume (Empty :!: S N _ _ _ :!: _) = Done+ consume _ = encodingError "streamUtf8" "UTF-8"+{-# INLINE [0] streamUtf8 #-}++-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.+unstreamChunks :: Int -> Stream Word8 -> ByteString+unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 len0+ where chunk s1 len1 = unsafePerformIO $ do+ let len = min (max len1 unknownLength) chunkSize+ mallocByteString len >>= loop len 0 s1+ where+ loop !n !off !s fp = case next s of+ Done | off == 0 -> return Empty+ | otherwise -> do+ bs <- trimUp fp off+ return $! Chunk bs Empty+ Skip s' -> loop n off s' fp+ Yield x s'+ | off == chunkSize -> do+ bs <- trimUp fp off+ return (Chunk bs (chunk s (n - B.length bs)))+ | off == n -> realloc fp n off s' x+ | otherwise -> do+ withForeignPtr fp $ \p -> pokeByteOff p off x+ loop n (off+1) s' fp+ {-# NOINLINE realloc #-}+ realloc fp n off s x = do+ let n' = min (n+n) chunkSize+ fp' <- copy0 fp n n'+ withForeignPtr fp' $ \p -> pokeByteOff p off x+ loop n' (off+1) s fp'+ {-# NOINLINE trimUp #-}+ trimUp fp off = return $! B.PS fp 0 off+ copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)+ copy0 !src !srcLen !destLen = assert (srcLen <= destLen) $ do+ dest <- mallocByteString destLen+ withForeignPtr src $ \src' ->+ withForeignPtr dest $ \dest' ->+ memcpy dest' src' (fromIntegral srcLen)+ return dest++-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.+unstream :: Stream Word8 -> ByteString+unstream = unstreamChunks defaultChunkSize++encodingError :: String -> String -> a+encodingError func encoding =+ error $ "Data.Text.Lazy.Encoding.Fusion." ++ func ++ ": Bad " +++ encoding ++ " stream"
+ Data/Text/Lazy/Fusion.hs view
@@ -0,0 +1,139 @@+-- |+-- Module : Data.Text.Lazy.Fusion+-- Copyright : (c) Bryan O'Sullivan 2009+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,+-- duncan@haskell.org+-- Stability : experimental+-- Portability : GHC+--+-- Core stream fusion functionality for text.++module Data.Text.Lazy.Fusion+ (+ stream+ , unstream+ , unstreamChunks+ , length+ , unfoldrN+ , index+ , findIndex+ , findIndices+ , elemIndex+ , elemIndices+ , count+ ) where++import Prelude hiding (length)+import qualified Data.Text.Fusion.Common as S+import Data.Text.Fusion.Internal+import Data.Text.Lazy.Internal+import qualified Data.Text.Internal as I+import qualified Data.Text.Array as A+import Data.Text.UnsafeChar (unsafeWrite)+import Data.Text.Unsafe (iter)+import Data.Int (Int64)++default(Int64)++-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.+stream :: Text -> Stream Char+stream text = Stream next (text :!: 0) 4 -- random HINT+ where+ next (Empty :!: _) = Done+ next (txt@(Chunk t@(I.Text _ _ len) ts) :!: i)+ | i >= len = next (ts :!: 0)+ | otherwise = Yield c (txt :!: i+d)+ where (c,d) = iter t i+{-# INLINE [0] stream #-}++-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given+-- chunk size.+unstreamChunks :: Int -> Stream Char -> Text+unstreamChunks chunkSize (Stream next s0 len0)+ | len0 == 0 = Empty+ | otherwise = outer s0+ where+ outer s = case next s of+ Done -> Empty+ Skip s' -> outer s'+ Yield x s' -> I.Text arr 0 len `chunk` outer s''+ where (arr,(s'',len)) = A.run2 fill+ fill = do a <- A.unsafeNew unknownLength+ i <- unsafeWrite a 0 x+ inner a unknownLength s' i+ unknownLength = 4+ inner marr len s i+ | i + 1 >= chunkSize = return (marr, (s,i))+ | i + 1 >= len = do+ let newLen = min (len * 2) chunkSize+ marr' <- A.unsafeNew newLen+ A.copy marr marr'+ inner marr' newLen s i+ | otherwise =+ case next s of+ Done -> return (marr,(s,i))+ Skip s' -> inner marr len s' i+ Yield x s' -> unsafeWrite marr i x >>= inner marr len s'+{-# INLINE [0] unstreamChunks #-}++-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using+-- 'defaultChunkSize'.+unstream :: Stream Char -> Text+unstream = unstreamChunks defaultChunkSize+{-# INLINE [0] unstream #-}++-- | /O(n)/ Returns the number of characters in a text.+length :: Stream Char -> Int64+length = S.lengthI+{-# INLINE[0] length #-}++{-# RULES "LAZY STREAM stream/unstream fusion" forall s.+ stream (unstream s) = s #-}++-- | /O(n)/ Like 'unfoldr', 'unfoldrN64' builds a stream from a seed+-- value. However, the length of the result is limited by the+-- first argument to 'unfoldrN64'. This function is more efficient than+-- 'unfoldr' when the length of the result is known.+unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Stream Char+unfoldrN n = S.unfoldrNI n+{-# INLINE [0] unfoldrN #-}++-- | /O(n)/ stream index (subscript) operator, starting from 0.+index :: Stream Char -> Int64 -> Char+index = S.indexI+{-# INLINE [0] index #-}++-- | The 'findIndex' function takes a predicate and a stream and+-- returns the index of the first element in the stream+-- satisfying the predicate.+findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int64+findIndex = S.findIndexI+{-# INLINE [0] findIndex #-}++-- | The 'findIndices' function takes a predicate and a stream and+-- returns all indices of the elements in the stream+-- satisfying the predicate.+findIndices :: (Char -> Bool) -> Stream Char -> [Int64]+findIndices = S.findIndicesI+{-# INLINE [0] findIndices #-}++-- | /O(n)/ The 'elemIndex' function returns the index of the first+-- element in the given stream which is equal to the query+-- element, or 'Nothing' if there is no such element.+elemIndex :: Char -> Stream Char -> Maybe Int64+elemIndex = S.elemIndexI+{-# INLINE [0] elemIndex #-}++-- | /O(n)/ The 'elemIndices' function returns the index of every+-- element in the given stream which is equal to the query element.+elemIndices :: Char -> Stream Char -> [Int64]+elemIndices = S.elemIndicesI+{-# INLINE [0] elemIndices #-}++-- | /O(n)/ The 'count' function returns the number of times the query+-- element appears in the given stream.+count :: Char -> Stream Char -> Int64+count = S.countI+{-# INLINE [0] count #-}
+ Data/Text/Lazy/Internal.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}+-- |+-- Module : Data.Text.Lazy.Internal+-- Copyright : (c) Bryan O'Sullivan 2009+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,+-- duncan@haskell.org+-- Stability : experimental+-- Portability : GHC+-- +-- A module containing semi-public 'Text' internals. This exposes the+-- 'Text' representation and low level construction functions.+-- Modules which extend the 'Text' system may need to use this module.+-- Regular users should not.+module Data.Text.Lazy.Internal+ (+ Text(..)+ , chunk+ , empty+ , foldrChunks+ , foldlChunks+ -- * Data type invariant and abstraction functions+ , invariant+ , checkInvariant+ , showStructure+ -- * Chunk allocation sizes+ , defaultChunkSize+ , smallChunkSize+ , chunkOverhead+ ) where++import qualified Data.Text.Internal as T+import qualified Data.Text as T+import Data.Typeable (Typeable)+import Data.Word (Word16)+import Foreign.Storable (sizeOf)++data Text = Empty+ | Chunk {-# UNPACK #-} !T.Text Text+ deriving (Typeable)++-- | The data type invariant: Every 'Text' is either 'Empty' or+-- consists of non-null 'T.Text's. All functions must preserve this,+-- and the QC properties must check this.+invariant :: Text -> Bool+invariant Empty = True+invariant (Chunk (T.Text _ _ len) cs) = len > 0 && invariant cs++showStructure :: Text -> String+showStructure Empty = "Empty"+showStructure (Chunk t Empty) = "Chunk " ++ show t ++ " Empty"+showStructure (Chunk t ts) =+ "Chunk " ++ show t ++ " (" ++ showStructure ts ++ ")"++-- | In a form that checks the invariant lazily.+checkInvariant :: Text -> Text+checkInvariant Empty = Empty+checkInvariant (Chunk c@(T.Text _ _ len) cs)+ | len > 0 = Chunk c (checkInvariant cs)+ | otherwise = error $ "Data.Text.Lazy: invariant violation: "+ ++ showStructure (Chunk c cs)++-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.+chunk :: T.Text -> Text -> Text+{-# INLINE chunk #-}+chunk t@(T.Text _ _ len) ts | len == 0 = ts+ | otherwise = Chunk t ts++-- | Smart constructor for 'Empty'.+empty :: Text+{-# INLINE [0] empty #-}+empty = Empty++-- | Consume the chunks of a lazy 'Text' with a natural right fold.+foldrChunks :: (T.Text -> a -> a) -> a -> Text -> a+foldrChunks f z = go+ where go Empty = z+ go (Chunk c cs) = f c (go cs)+{-# INLINE foldrChunks #-}++-- | Consume the chunks of a lazy 'Text' with a strict, tail-recursive,+-- accumulating left fold.+foldlChunks :: (a -> T.Text -> a) -> a -> Text -> a+foldlChunks f z = go z+ where go !a Empty = a+ go !a (Chunk c cs) = go (f a c) cs+{-# INLINE foldlChunks #-}++-- | Currently set to 32k, less the memory management overhead.+defaultChunkSize :: Int+defaultChunkSize = 32 * k - chunkOverhead+ where k = 1024 `div` sizeOf (undefined :: Word16)++-- | Currently set to 4k, less the memory management overhead.+smallChunkSize :: Int+smallChunkSize = 4 * k - chunkOverhead+ where k = 1024 `div` sizeOf (undefined :: Word16)++-- | The memory management overhead. Currently this is tuned for GHC only.+chunkOverhead :: Int+chunkOverhead = 2 * sizeOf (undefined :: Int)
Data/Text/Unsafe.hs view
@@ -2,7 +2,8 @@ -- Module : Data.Text.Unsafe -- Copyright : (c) Bryan O'Sullivan 2009 -- License : BSD-style--- Maintainer : bos@serpentine.com+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,+-- duncan@haskell.org -- Stability : experimental -- Portability : portable --
Data/Text/UnsafeChar.hs view
@@ -7,7 +7,7 @@ -- (c) Duncan Coutts 2009 -- -- License : BSD-style--- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk, -- duncan@haskell.org -- Stability : experimental -- Portability : GHC
text.cabal view
@@ -1,5 +1,5 @@ name: text-version: 0.1+version: 0.2 synopsis: An efficient packed Unicode text type description: An efficient packed Unicode text type. license: BSD3@@ -8,7 +8,7 @@ maintainer: Bryan O'Sullivan <bos@serpentine.com> Tom Harper <rtharper@aftereternity.co.uk> Duncan Coutts <duncan@haskell.org>-copyright: 2008-2009 Tom Harper+copyright: 2008-2009 Tom Harper, 2009 Bryan O'Sullivan category: Data, Text build-type: Simple cabal-version: >= 1.2@@ -21,9 +21,17 @@ Data.Text.Encoding.Fusion Data.Text.Foreign Data.Text.Fusion+ Data.Text.Fusion.Common+ Data.Text.Lazy+ Data.Text.Lazy.Encoding+ Data.Text.Lazy.Encoding.Fusion+ Data.Text.Lazy.Fusion other-modules: Data.Text.Array Data.Text.Internal+ Data.Text.Encoding.Fusion.Common+ Data.Text.Fusion.Internal+ Data.Text.Lazy.Internal Data.Text.Unsafe Data.Text.UnsafeChar Data.Text.Encoding.Utf8