{-# LANGUAGE BangPatterns, CPP, MagicHash #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
module Data.Text.Internal.Transformation
( mapNonEmpty
, toCaseFoldNonEmpty
, toLowerNonEmpty
, toUpperNonEmpty
, filter_
) where
import Prelude (Char, Bool(..), Int,
Ord(..),
Monad(..), pure,
(+), (-), ($),
not, return, otherwise)
import Data.Bits ((.&.), shiftR, shiftL)
import Control.Monad.ST (ST, runST)
import qualified Data.Text.Array as A
import Data.Text.Internal.Encoding.Utf8 (utf8LengthByLeader, chr2, chr3, chr4)
import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, upperMapping)
import Data.Text.Internal (Text(..), safe)
import Data.Text.Internal.Unsafe.Char (unsafeWrite, unsafeChr8)
import qualified Prelude as P
import Data.Text.Unsafe (Iter(..), iterArray)
import Data.Word (Word8)
import qualified GHC.Exts as Exts
import GHC.Int (Int64(..))
mapNonEmpty :: (Char -> Char) -> Text -> Text
mapNonEmpty :: (Char -> Char) -> Text -> Text
mapNonEmpty Char -> Char
f = Text -> Text
go
where
go :: Text -> Text
go (Text Array
src Int
o Int
l) = (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
marr <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
outer marr (l + 4) o 0
where
outer :: forall s. A.MArray s -> Int -> Int -> Int -> ST s Text
outer :: forall s. MArray s -> Int -> Int -> Int -> ST s Text
outer !MArray s
dst !Int
dstLen = Int -> Int -> ST s Text
inner
where
inner :: Int -> Int -> ST s Text
inner !Int
srcOff !Int
dstOff
| Int
srcOff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o = do
MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
A.shrinkM MArray s
dst Int
dstOff
arr <- MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
dst
return (Text arr 0 dstOff)
| Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
dstLen = do
let !dstLen' :: Int
dstLen' = Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4
dst' <- MArray s -> Int -> ST s (MArray s)
forall s. MArray s -> Int -> ST s (MArray s)
A.resizeM MArray s
dst Int
dstLen'
outer dst' dstLen' srcOff dstOff
| Bool
otherwise = do
let !(Iter Char
c Int
d) = Array -> Int -> Iter
iterArray Array
src Int
srcOff
d' <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
dst Int
dstOff (Char -> Char
safe (Char -> Char
f Char
c))
inner (srcOff + d) (dstOff + d')
{-# INLINE mapNonEmpty #-}
caseConvert :: (Word8 -> Word8) -> (Exts.Char# -> _ ) -> Text -> Text
caseConvert :: (Word8 -> Word8) -> (Char# -> Int64#) -> Text -> Text
caseConvert Word8 -> Word8
ascii Char# -> Int64#
remap (Text Array
src Int
o Int
l) = (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
dst <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12)
outer dst l o 0
where
outer :: forall s. A.MArray s -> Int -> Int -> Int -> ST s Text
outer :: forall s. MArray s -> Int -> Int -> Int -> ST s Text
outer !MArray s
dst !Int
dstLen = Int -> Int -> ST s Text
inner
where
inner :: Int -> Int -> ST s Text
inner !Int
srcOff !Int
dstOff
| Int
srcOff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l = do
MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
A.shrinkM MArray s
dst Int
dstOff
arr <- MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
dst
return (Text arr 0 dstOff)
| Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
dstLen = do
let !dstLen' :: Int
dstLen' = Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
12 (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
srcOff)
dst' <- MArray s -> Int -> ST s (MArray s)
forall s. MArray s -> Int -> ST s (MArray s)
A.resizeM MArray s
dst Int
dstLen'
outer dst' dstLen' srcOff dstOff
| Bool
otherwise = do
let m0 :: Word8
m0 = Array -> Int -> Word8
A.unsafeIndex Array
src Int
srcOff
m1 :: Word8
m1 = Array -> Int -> Word8
A.unsafeIndex Array
src (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
m2 :: Word8
m2 = Array -> Int -> Word8
A.unsafeIndex Array
src (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
m3 :: Word8
m3 = Array -> Int -> Word8
A.unsafeIndex Array
src (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
!d :: Int
d = Word8 -> Int
utf8LengthByLeader Word8
m0
case Int
d of
Int
1 -> do
MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff (Word8 -> Word8
ascii Word8
m0)
Int -> Int -> ST s Text
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Int
2 -> do
let !(Exts.C# Char#
c) = Word8 -> Word8 -> Char
chr2 Word8
m0 Word8
m1
dstOff' <- case Int64# -> Int64
I64# (Char# -> Int64#
remap Char#
c) of
Int64
0 -> do
MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
Int -> ST s Int
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
Int64
i -> Int64 -> Int -> ST s Int
writeMapping Int64
i Int
dstOff
inner (srcOff + 2) dstOff'
Int
3 -> do
let !(Exts.C# Char#
c) = Word8 -> Word8 -> Word8 -> Char
chr3 Word8
m0 Word8
m1 Word8
m2
dstOff' <- case Int64# -> Int64
I64# (Char# -> Int64#
remap Char#
c) of
Int64
0 -> do
MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word8
m2
Int -> ST s Int
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3
Int64
i -> Int64 -> Int -> ST s Int
writeMapping Int64
i Int
dstOff
inner (srcOff + 3) dstOff'
Int
_ -> do
let !(Exts.C# Char#
c) = Word8 -> Word8 -> Word8 -> Word8 -> Char
chr4 Word8
m0 Word8
m1 Word8
m2 Word8
m3
dstOff' <- case Int64# -> Int64
I64# (Char# -> Int64#
remap Char#
c) of
Int64
0 -> do
MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word8
m2
MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Word8
m3
Int -> ST s Int
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4
Int64
i -> Int64 -> Int -> ST s Int
writeMapping Int64
i Int
dstOff
inner (srcOff + 4) dstOff'
writeMapping :: Int64 -> Int -> ST s Int
writeMapping :: Int64 -> Int -> ST s Int
writeMapping Int64
0 Int
dstOff = Int -> ST s Int
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
dstOff
writeMapping Int64
i Int
dstOff = do
let (Char
ch, Int64
j) = Int64 -> (Char, Int64)
chopOffChar Int64
i
d <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
dst Int
dstOff Char
ch
writeMapping j (dstOff + d)
chopOffChar :: Int64 -> (Char, Int64)
chopOffChar :: Int64 -> (Char, Int64)
chopOffChar Int64
ab = (Int -> Char
chr Int
a, Int64
ab Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` Int
21)
where
chr :: Int -> Char
chr (Exts.I# Int#
n) = Char# -> Char
Exts.C# (Int# -> Char#
Exts.chr# Int#
n)
mask :: Int64
mask = (Int64
1 Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` Int
21) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1
a :: Int
a = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Int64
ab Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. Int64
mask
{-# INLINE caseConvert #-}
toCaseFoldNonEmpty :: Text -> Text
toCaseFoldNonEmpty :: Text -> Text
toCaseFoldNonEmpty = \Text
xs -> (Word8 -> Word8) -> (Char# -> Int64#) -> Text -> Text
caseConvert (\Word8
w -> if Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
65 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
25 then Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
32 else Word8
w) Char# -> Int64#
foldMapping Text
xs
{-# INLINE toCaseFoldNonEmpty #-}
toLowerNonEmpty :: Text -> Text
toLowerNonEmpty :: Text -> Text
toLowerNonEmpty = \Text
xs -> (Word8 -> Word8) -> (Char# -> Int64#) -> Text -> Text
caseConvert (\Word8
w -> if Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
65 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
25 then Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
32 else Word8
w) Char# -> Int64#
lowerMapping Text
xs
{-# INLINE toLowerNonEmpty #-}
toUpperNonEmpty :: Text -> Text
toUpperNonEmpty :: Text -> Text
toUpperNonEmpty = \Text
xs -> (Word8 -> Word8) -> (Char# -> Int64#) -> Text -> Text
caseConvert (\Word8
w -> if Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
97 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
25 then Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
32 else Word8
w) Char# -> Int64#
upperMapping Text
xs
{-# INLINE toUpperNonEmpty #-}
filter_ :: forall a. (A.Array -> Int -> Int -> a) -> (Char -> Bool) -> Text -> a
filter_ :: forall a. (Array -> Int -> Int -> a) -> (Char -> Bool) -> Text -> a
filter_ Array -> Int -> Int -> a
mkText Char -> Bool
p = Text -> a
go
where
go :: Text -> a
go (Text Array
src Int
o Int
l) = (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$ do
let !dstLen :: Int
dstLen = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
l Int
64
dst <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
dstLen
outer dst dstLen o 0
where
outer :: forall s. A.MArray s -> Int -> Int -> Int -> ST s a
outer :: forall s. MArray s -> Int -> Int -> Int -> ST s a
outer !MArray s
dst !Int
dstLen = Int -> Int -> ST s a
inner
where
inner :: Int -> Int -> ST s a
inner !Int
srcOff !Int
dstOff
| Int
srcOff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l = do
MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
A.shrinkM MArray s
dst Int
dstOff
arr <- MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
dst
return $ mkText arr 0 dstOff
| Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
dstLen = do
let !dstLen' :: Int
dstLen' = Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
4 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
srcOff) Int
dstLen)
dst' <- MArray s -> Int -> ST s (MArray s)
forall s. MArray s -> Int -> ST s (MArray s)
A.resizeM MArray s
dst Int
dstLen'
outer dst' dstLen' srcOff dstOff
| Bool
otherwise = do
let m0 :: Word8
m0 = Array -> Int -> Word8
A.unsafeIndex Array
src Int
srcOff
m1 :: Word8
m1 = Array -> Int -> Word8
A.unsafeIndex Array
src (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
m2 :: Word8
m2 = Array -> Int -> Word8
A.unsafeIndex Array
src (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
m3 :: Word8
m3 = Array -> Int -> Word8
A.unsafeIndex Array
src (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
!d :: Int
d = Word8 -> Int
utf8LengthByLeader Word8
m0
case Int
d of
Int
1 -> do
let !c :: Char
c = Word8 -> Char
unsafeChr8 Word8
m0
if Bool -> Bool
not (Char -> Bool
p Char
c) then Int -> Int -> ST s a
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
dstOff else do
MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
Int -> Int -> ST s a
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Int
2 -> do
let !c :: Char
c = Word8 -> Word8 -> Char
chr2 Word8
m0 Word8
m1
if Bool -> Bool
not (Char -> Bool
p Char
c) then Int -> Int -> ST s a
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Int
dstOff else do
MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
Int -> Int -> ST s a
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
Int
3 -> do
let !c :: Char
c = Word8 -> Word8 -> Word8 -> Char
chr3 Word8
m0 Word8
m1 Word8
m2
if Bool -> Bool
not (Char -> Bool
p Char
c) then Int -> Int -> ST s a
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Int
dstOff else do
MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word8
m2
Int -> Int -> ST s a
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
Int
_ -> do
let !c :: Char
c = Word8 -> Word8 -> Word8 -> Word8 -> Char
chr4 Word8
m0 Word8
m1 Word8
m2 Word8
m3
if Bool -> Bool
not (Char -> Bool
p Char
c) then Int -> Int -> ST s a
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Int
dstOff else do
MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff Word8
m0
MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
m1
MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word8
m2
MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Word8
m3
Int -> Int -> ST s a
inner (Int
srcOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
{-# INLINE filter_ #-}