{-# LANGUAGE BangPatterns, CPP, MagicHash #-}
module Data.Text.Internal.Fusion
(
Stream(..)
, Step(..)
, stream
, unstream
, reverseStream
, length
, reverse
, reverseScanr
, mapAccumL
, unfoldrN
, index
, findIndex
, countChar
) where
import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,
Num(..), Ord(..), ($),
otherwise)
import Data.Bits (shiftL, shiftR)
import Data.Text.Internal (Text(..))
import Data.Text.Internal.Private (runText)
import Data.Text.Internal.Unsafe.Char (unsafeChr8, unsafeWrite)
import qualified Data.Text.Array as A
import qualified Data.Text.Internal.Fusion.Common as S
import Data.Text.Internal.Fusion.Types
import Data.Text.Internal.Fusion.Size
import qualified Data.Text.Internal as I
import qualified Data.Text.Internal.Encoding.Utf8 as U8
import GHC.Stack (HasCallStack)
default(Int)
stream ::
#if defined(ASSERTS)
HasCallStack =>
#endif
Text -> Stream Char
stream :: Text -> Stream Char
stream (Text Array
arr Int
off Int
len) = (Int -> Step Int Char) -> Int -> Size -> Stream Char
forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream Int -> Step Int Char
next Int
off (Int -> Int -> Size
betweenSize (Int
len Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
2) Int
len)
where
!end :: Int
end = Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
len
next :: Int -> Step Int Char
next !Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = Step Int Char
forall s a. Step s a
Done
| Bool
otherwise = Char -> Int -> Step Int Char
forall s a. a -> s -> Step s a
Yield Char
chr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l)
where
n0 :: Word8
n0 = Array -> Int -> Word8
A.unsafeIndex Array
arr Int
i
n1 :: Word8
n1 = Array -> Int -> Word8
A.unsafeIndex Array
arr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
n2 :: Word8
n2 = Array -> Int -> Word8
A.unsafeIndex Array
arr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
n3 :: Word8
n3 = Array -> Int -> Word8
A.unsafeIndex Array
arr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
l :: Int
l = Word8 -> Int
U8.utf8LengthByLeader Word8
n0
chr :: Char
chr = case Int
l of
Int
1 -> Word8 -> Char
unsafeChr8 Word8
n0
Int
2 -> Word8 -> Word8 -> Char
U8.chr2 Word8
n0 Word8
n1
Int
3 -> Word8 -> Word8 -> Word8 -> Char
U8.chr3 Word8
n0 Word8
n1 Word8
n2
Int
_ -> Word8 -> Word8 -> Word8 -> Word8 -> Char
U8.chr4 Word8
n0 Word8
n1 Word8
n2 Word8
n3
{-# INLINE [0] stream #-}
reverseStream :: Text -> Stream Char
reverseStream :: Text -> Stream Char
reverseStream (Text Array
arr Int
off Int
len) = (Int -> Step Int Char) -> Int -> Size -> Stream Char
forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream Int -> Step Int Char
next (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int -> Int -> Size
betweenSize (Int
len Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
2) Int
len)
where
{-# INLINE next #-}
next :: Int -> Step Int Char
next !Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
off = Step Int Char
forall s a. Step s a
Done
| Word8
n0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0x80 = Char -> Int -> Step Int Char
forall s a. a -> s -> Step s a
Yield (Word8 -> Char
unsafeChr8 Word8
n0) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
| Word8
n1 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0xC0 = Char -> Int -> Step Int Char
forall s a. a -> s -> Step s a
Yield (Word8 -> Word8 -> Char
U8.chr2 Word8
n1 Word8
n0) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
| Word8
n2 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0xC0 = Char -> Int -> Step Int Char
forall s a. a -> s -> Step s a
Yield (Word8 -> Word8 -> Word8 -> Char
U8.chr3 Word8
n2 Word8
n1 Word8
n0) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3)
| Bool
otherwise = Char -> Int -> Step Int Char
forall s a. a -> s -> Step s a
Yield (Word8 -> Word8 -> Word8 -> Word8 -> Char
U8.chr4 Word8
n3 Word8
n2 Word8
n1 Word8
n0) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)
where
n0 :: Word8
n0 = Array -> Int -> Word8
A.unsafeIndex Array
arr Int
i
n1 :: Word8
n1 = Array -> Int -> Word8
A.unsafeIndex Array
arr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
n2 :: Word8
n2 = Array -> Int -> Word8
A.unsafeIndex Array
arr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
n3 :: Word8
n3 = Array -> Int -> Word8
A.unsafeIndex Array
arr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3)
{-# INLINE [0] reverseStream #-}
unstream :: Stream Char -> Text
unstream :: Stream Char -> Text
unstream (Stream s -> Step s Char
next0 s
s0 Size
len) = (forall s. (MArray s -> Int -> ST s Text) -> ST s Text) -> Text
runText ((forall s. (MArray s -> Int -> ST s Text) -> ST s Text) -> Text)
-> (forall s. (MArray s -> Int -> ST s Text) -> ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ \MArray s -> Int -> ST s Text
done -> do
let mlen :: Int
mlen = Int -> Size -> Int
upperBound Int
4 Size
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3
MArray s
arr0 <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
mlen
let outer :: MArray s -> Int -> s -> Int -> ST s Text
outer !MArray s
arr !Int
maxi = s -> Int -> ST s Text
encode
where
encode :: s -> Int -> ST s Text
encode !s
si !Int
di =
case s -> Step s Char
next0 s
si of
Step s Char
Done -> MArray s -> Int -> ST s Text
done MArray s
arr Int
di
Skip s
si' -> s -> Int -> ST s Text
encode s
si' Int
di
Yield Char
c s
si'
| Int
maxi Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 -> s -> Int -> ST s Text
realloc s
si Int
di
| Bool
otherwise -> do
Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
arr Int
di Char
c
s -> Int -> ST s Text
encode s
si' (Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
{-# NOINLINE realloc #-}
realloc :: s -> Int -> ST s Text
realloc !s
si !Int
di = do
let newlen :: Int
newlen = (Int
maxi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
MArray s
arr' <- MArray s -> Int -> ST s (MArray s)
forall s. MArray s -> Int -> ST s (MArray s)
A.resizeM MArray s
arr Int
newlen
MArray s -> Int -> s -> Int -> ST s Text
outer MArray s
arr' (Int
newlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) s
si Int
di
MArray s -> Int -> s -> Int -> ST s Text
outer MArray s
arr0 (Int
mlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) s
s0 Int
0
{-# INLINE [0] unstream #-}
{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
length :: Stream Char -> Int
length :: Stream Char -> Int
length = Stream Char -> Int
forall a. Integral a => Stream Char -> a
S.lengthI
{-# INLINE[0] length #-}
reverse ::
#if defined(ASSERTS)
HasCallStack =>
#endif
Stream Char -> Text
reverse :: Stream Char -> Text
reverse (Stream s -> Step s Char
next s
s Size
len0)
| Size -> Bool
isEmpty Size
len0 = Text
I.empty
| Bool
otherwise = Array -> Int -> Int -> Text
I.text Array
arr Int
off' Int
len'
where
len0' :: Int
len0' = Int -> Size -> Int
upperBound Int
4 (Size -> Size -> Size
larger Size
len0 Size
4)
(Array
arr, (Int
off', Int
len')) = (forall s. ST s (MArray s, (Int, Int))) -> (Array, (Int, Int))
forall a. (forall s. ST s (MArray s, a)) -> (Array, a)
A.run2 (Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
len0' ST s (MArray s)
-> (MArray s -> ST s (MArray s, (Int, Int)))
-> ST s (MArray s, (Int, Int))
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> Int -> Int -> MArray s -> ST s (MArray s, (Int, Int))
forall {s}.
s -> Int -> Int -> MArray s -> ST s (MArray s, (Int, Int))
loop s
s (Int
len0'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
len0')
loop :: s -> Int -> Int -> MArray s -> ST s (MArray s, (Int, Int))
loop !s
s0 !Int
i !Int
len MArray s
marr =
case s -> Step s Char
next s
s0 of
Step s Char
Done -> (MArray s, (Int, Int)) -> ST s (MArray s, (Int, Int))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (MArray s
marr, (Int
j, Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
j))
where j :: Int
j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
Skip s
s1 -> s -> Int -> Int -> MArray s -> ST s (MArray s, (Int, Int))
loop s
s1 Int
i Int
len MArray s
marr
Yield Char
x s
s1 | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
least -> {-# SCC "reverse/resize" #-} do
let newLen :: Int
newLen = Int
len Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
1
MArray s
marr' <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
newLen
MArray s -> Int -> MArray s -> Int -> Int -> ST s ()
forall s. MArray s -> Int -> MArray s -> Int -> Int -> ST s ()
A.copyM MArray s
marr' (Int
newLenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
len) MArray s
marr Int
0 Int
len
Int
_ <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr' (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
least) Char
x
s -> Int -> Int -> MArray s -> ST s (MArray s, (Int, Int))
loop s
s1 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
least Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
newLen MArray s
marr'
| Bool
otherwise -> do
Int
_ <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
least) Char
x
s -> Int -> Int -> MArray s -> ST s (MArray s, (Int, Int))
loop s
s1 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
least Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
len MArray s
marr
where least :: Int
least = Char -> Int
U8.utf8Length Char
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
{-# INLINE [0] reverse #-}
reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
reverseScanr Char -> Char -> Char
f Char
z0 (Stream s -> Step s Char
next0 s
s0 Size
len) = (Scan s -> Step (Scan s) Char) -> Scan s -> Size -> Stream Char
forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream Scan s -> Step (Scan s) Char
next (Char -> s -> Scan s
forall s. Char -> s -> Scan s
Scan1 Char
z0 s
s0) (Size
lenSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
1)
where
{-# INLINE next #-}
next :: Scan s -> Step (Scan s) Char
next (Scan1 Char
z s
s) = Char -> Scan s -> Step (Scan s) Char
forall s a. a -> s -> Step s a
Yield Char
z (Char -> s -> Scan s
forall s. Char -> s -> Scan s
Scan2 Char
z s
s)
next (Scan2 Char
z s
s) = case s -> Step s Char
next0 s
s of
Yield Char
x s
s' -> let !x' :: Char
x' = Char -> Char -> Char
f Char
x Char
z
in Char -> Scan s -> Step (Scan s) Char
forall s a. a -> s -> Step s a
Yield Char
x' (Char -> s -> Scan s
forall s. Char -> s -> Scan s
Scan2 Char
x' s
s')
Skip s
s' -> Scan s -> Step (Scan s) Char
forall s a. s -> Step s a
Skip (Char -> s -> Scan s
forall s. Char -> s -> Scan s
Scan2 Char
z s
s')
Step s Char
Done -> Step (Scan s) Char
forall s a. Step s a
Done
{-# INLINE reverseScanr #-}
unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char
unfoldrN :: forall a. Int -> (a -> Maybe (Char, a)) -> a -> Stream Char
unfoldrN Int
n = Int -> (a -> Maybe (Char, a)) -> a -> Stream Char
forall a b.
Integral a =>
a -> (b -> Maybe (Char, b)) -> b -> Stream Char
S.unfoldrNI Int
n
{-# INLINE [0] unfoldrN #-}
index :: HasCallStack => Stream Char -> Int -> Char
index :: HasCallStack => Stream Char -> Int -> Char
index = Stream Char -> Int -> Char
forall a. (HasCallStack, Integral a) => Stream Char -> a -> Char
S.indexI
{-# INLINE [0] index #-}
findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int
findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int
findIndex = (Char -> Bool) -> Stream Char -> Maybe Int
forall a. Integral a => (Char -> Bool) -> Stream Char -> Maybe a
S.findIndexI
{-# INLINE [0] findIndex #-}
countChar :: Char -> Stream Char -> Int
countChar :: Char -> Stream Char -> Int
countChar = Char -> Stream Char -> Int
forall a. Integral a => Char -> Stream Char -> a
S.countCharI
{-# INLINE [0] countChar #-}
mapAccumL ::
#if defined(ASSERTS)
HasCallStack =>
#endif
(a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)
mapAccumL :: forall a. (a -> Char -> (a, Char)) -> a -> Stream Char -> (a, Text)
mapAccumL a -> Char -> (a, Char)
f a
z0 (Stream s -> Step s Char
next0 s
s0 Size
len) = (a
nz, Array -> Int -> Int -> Text
I.text Array
na Int
0 Int
nl)
where
(Array
na,(a
nz,Int
nl)) = (forall s. ST s (MArray s, (a, Int))) -> (Array, (a, Int))
forall a. (forall s. ST s (MArray s, a)) -> (Array, a)
A.run2 (Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
mlen ST s (MArray s)
-> (MArray s -> ST s (MArray s, (a, Int)))
-> ST s (MArray s, (a, Int))
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MArray s
arr -> MArray s -> Int -> a -> s -> Int -> ST s (MArray s, (a, Int))
forall {s}.
MArray s -> Int -> a -> s -> Int -> ST s (MArray s, (a, Int))
outer MArray s
arr Int
mlen a
z0 s
s0 Int
0)
where mlen :: Int
mlen = Int -> Size -> Int
upperBound Int
4 Size
len
outer :: MArray s -> Int -> a -> s -> Int -> ST s (MArray s, (a, Int))
outer MArray s
arr Int
top = a -> s -> Int -> ST s (MArray s, (a, Int))
loop
where
loop :: a -> s -> Int -> ST s (MArray s, (a, Int))
loop !a
z !s
s !Int
i =
case s -> Step s Char
next0 s
s of
Step s Char
Done -> (MArray s, (a, Int)) -> ST s (MArray s, (a, Int))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (MArray s
arr, (a
z,Int
i))
Skip s
s' -> a -> s -> Int -> ST s (MArray s, (a, Int))
loop a
z s
s' Int
i
Yield Char
x s
s'
| Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
top -> {-# SCC "mapAccumL/resize" #-} do
let top' :: Int
top' = (Int
top Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
1
MArray s
arr' <- MArray s -> Int -> ST s (MArray s)
forall s. MArray s -> Int -> ST s (MArray s)
A.resizeM MArray s
arr Int
top'
MArray s -> Int -> a -> s -> Int -> ST s (MArray s, (a, Int))
outer MArray s
arr' Int
top' a
z s
s Int
i
| Bool
otherwise -> do Int
d <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
arr Int
i Char
c
a -> s -> Int -> ST s (MArray s, (a, Int))
loop a
z' s
s' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d)
where (a
z',Char
c) = a -> Char -> (a, Char)
f a
z Char
x
j :: Int
j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
U8.utf8Length Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
{-# INLINE [0] mapAccumL #-}