{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
module Data.Unicode.Internal.NormalizeStream
(
D.DecomposeMode(..)
, stream
, unstream
, unstreamC
)
where
import Data.Char (chr, ord)
import qualified Data.Text.Array as A
import Data.Text.Internal (Text (..))
import qualified Data.Text.Internal.Encoding.Utf16 as U16
import Data.Text.Internal.Fusion.Size (betweenSize,
upperBound)
import Data.Text.Internal.Fusion.Types (Step (..), Stream (..))
import Data.Text.Internal.Private (runText)
import Data.Text.Internal.Unsafe.Char (unsafeWrite)
import Data.Text.Internal.Unsafe.Char (unsafeChr)
import Data.Text.Internal.Unsafe.Shift (shiftR)
import GHC.ST (ST (..))
import GHC.Types (SPEC(..))
import qualified Data.Unicode.Properties.CombiningClass as CC
import qualified Data.Unicode.Properties.Compositions as C
import qualified Data.Unicode.Properties.Decompose as D
import qualified Data.Unicode.Properties.DecomposeHangul as H
data ReBuf = Empty | One !Char | Many !Char !Char ![Char]
{-# INLINE insertIntoReBuf #-}
insertIntoReBuf :: Char -> ReBuf -> ReBuf
insertIntoReBuf :: Char -> ReBuf -> ReBuf
insertIntoReBuf c :: Char
c Empty = Char -> ReBuf
One Char
c
insertIntoReBuf c :: Char
c (One c0 :: Char
c0)
| Char -> Int
CC.getCombiningClass Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Char -> Int
CC.getCombiningClass Char
c0
= Char -> Char -> [Char] -> ReBuf
Many Char
c Char
c0 []
| Bool
otherwise
= Char -> Char -> [Char] -> ReBuf
Many Char
c0 Char
c []
insertIntoReBuf c :: Char
c (Many c0 :: Char
c0 c1 :: Char
c1 cs :: [Char]
cs)
| Int
cc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Char -> Int
CC.getCombiningClass Char
c0
= Char -> Char -> [Char] -> ReBuf
Many Char
c Char
c0 (Char
c1 Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs)
| Int
cc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Char -> Int
CC.getCombiningClass Char
c1
= Char -> Char -> [Char] -> ReBuf
Many Char
c0 Char
c (Char
c1 Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs)
| Bool
otherwise
= Char -> Char -> [Char] -> ReBuf
Many Char
c0 Char
c1 ([Char]
cs' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs''))
where
cc :: Int
cc = Char -> Int
CC.getCombiningClass Char
c
(cs' :: [Char]
cs', cs'' :: [Char]
cs'') = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cc) (Int -> Bool) -> (Char -> Int) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
CC.getCombiningClass) [Char]
cs
writeStr :: A.MArray s -> Int -> [Char] -> ST s Int
writeStr :: MArray s -> Int -> [Char] -> ST s Int
writeStr marr :: MArray s
marr di :: Int
di str :: [Char]
str = Int -> [Char] -> ST s Int
go Int
di [Char]
str
where
go :: Int -> [Char] -> ST s Int
go i :: Int
i [] = Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
go i :: Int
i (c :: Char
c : cs :: [Char]
cs) = do
Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
i Char
c
Int -> [Char] -> ST s Int
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) [Char]
cs
{-# INLINE writeReorderBuffer #-}
writeReorderBuffer :: A.MArray s -> Int -> ReBuf -> ST s Int
writeReorderBuffer :: MArray s -> Int -> ReBuf -> ST s Int
writeReorderBuffer _ di :: Int
di Empty = Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
di
writeReorderBuffer marr :: MArray s
marr di :: Int
di (One c :: Char
c) = do
Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
di Char
c
Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
writeReorderBuffer marr :: MArray s
marr di :: Int
di (Many c1 :: Char
c1 c2 :: Char
c2 str :: [Char]
str) = do
Int
n1 <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
di Char
c1
Int
n2 <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr (Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n1) Char
c2
MArray s -> Int -> [Char] -> ST s Int
forall s. MArray s -> Int -> [Char] -> ST s Int
writeStr MArray s
marr (Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2) [Char]
str
decomposeCharHangul :: A.MArray s -> Int -> Char -> ST s Int
decomposeCharHangul :: MArray s -> Int -> Char -> ST s Int
decomposeCharHangul marr :: MArray s
marr j :: Int
j c :: Char
c =
if Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Char
chr Int
H.jamoTFirst then do
Int
n1 <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
j Char
l
Int
n2 <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n1) Char
v
Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2)
else do
Int
n1 <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
j Char
l
Int
n2 <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n1) Char
v
Int
n3 <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2) Char
t
Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n3)
where
(l :: Char
l, v :: Char
v, t :: Char
t) = Char -> (Char, Char, Char)
D.decomposeCharHangul Char
c
{-# INLINE decomposeChar #-}
decomposeChar
:: D.DecomposeMode
-> A.MArray s
-> Int
-> ReBuf
-> Char
-> ST s (Int, ReBuf)
decomposeChar :: DecomposeMode
-> MArray s -> Int -> ReBuf -> Char -> ST s (Int, ReBuf)
decomposeChar mode :: DecomposeMode
mode marr :: MArray s
marr index :: Int
index reBuf :: ReBuf
reBuf ch :: Char
ch
| Char -> Bool
D.isHangul Char
ch = do
Int
j <- MArray s -> Int -> ReBuf -> ST s Int
forall s. MArray s -> Int -> ReBuf -> ST s Int
writeReorderBuffer MArray s
marr Int
index ReBuf
reBuf
(, ReBuf
Empty) (Int -> (Int, ReBuf)) -> ST s Int -> ST s (Int, ReBuf)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
decomposeCharHangul MArray s
marr Int
j Char
ch
| DecomposeMode -> Char -> Bool
D.isDecomposable DecomposeMode
mode Char
ch =
MArray s -> Int -> ReBuf -> [Char] -> ST s (Int, ReBuf)
forall s. MArray s -> Int -> ReBuf -> [Char] -> ST s (Int, ReBuf)
decomposeAll MArray s
marr Int
index ReBuf
reBuf (DecomposeMode -> Char -> [Char]
D.decomposeChar DecomposeMode
mode Char
ch)
| Bool
otherwise =
MArray s -> Int -> ReBuf -> Char -> ST s (Int, ReBuf)
forall s. MArray s -> Int -> ReBuf -> Char -> ST s (Int, ReBuf)
reorder MArray s
marr Int
index ReBuf
reBuf Char
ch
where
{-# INLINE decomposeAll #-}
decomposeAll :: MArray s -> Int -> ReBuf -> [Char] -> ST s (Int, ReBuf)
decomposeAll _ i :: Int
i rbuf :: ReBuf
rbuf [] = (Int, ReBuf) -> ST s (Int, ReBuf)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, ReBuf
rbuf)
decomposeAll arr :: MArray s
arr i :: Int
i rbuf :: ReBuf
rbuf (x :: Char
x : xs :: [Char]
xs)
| DecomposeMode -> Char -> Bool
D.isDecomposable DecomposeMode
mode Char
x = do
(i' :: Int
i', rbuf' :: ReBuf
rbuf') <- MArray s -> Int -> ReBuf -> [Char] -> ST s (Int, ReBuf)
decomposeAll MArray s
arr Int
i ReBuf
rbuf (DecomposeMode -> Char -> [Char]
D.decomposeChar DecomposeMode
mode Char
x)
MArray s -> Int -> ReBuf -> [Char] -> ST s (Int, ReBuf)
decomposeAll MArray s
arr Int
i' ReBuf
rbuf' [Char]
xs
| Bool
otherwise = do
(i' :: Int
i', rbuf' :: ReBuf
rbuf') <- MArray s -> Int -> ReBuf -> Char -> ST s (Int, ReBuf)
forall s. MArray s -> Int -> ReBuf -> Char -> ST s (Int, ReBuf)
reorder MArray s
arr Int
i ReBuf
rbuf Char
x
MArray s -> Int -> ReBuf -> [Char] -> ST s (Int, ReBuf)
decomposeAll MArray s
arr Int
i' ReBuf
rbuf' [Char]
xs
{-# INLINE reorder #-}
reorder :: MArray s -> Int -> ReBuf -> Char -> ST s (Int, ReBuf)
reorder arr :: MArray s
arr i :: Int
i rbuf :: ReBuf
rbuf c :: Char
c
| Char -> Bool
CC.isCombining Char
c = (Int, ReBuf) -> ST s (Int, ReBuf)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, Char -> ReBuf -> ReBuf
insertIntoReBuf Char
c ReBuf
rbuf)
| Bool
otherwise = do
Int
j <- MArray s -> Int -> ReBuf -> ST s Int
forall s. MArray s -> Int -> ReBuf -> ST s Int
writeReorderBuffer MArray s
arr Int
i ReBuf
rbuf
Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
arr Int
j Char
c
(Int, ReBuf) -> ST s (Int, ReBuf)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n, ReBuf
Empty)
stream :: Text -> Stream Char
stream :: Text -> Stream Char
stream (Text arr :: Array
arr off :: Int
off len :: 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. UnsafeShift a => a -> Int -> a
`shiftR` 1) Int
len)
where
!end :: Int
end = Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
len
{-# INLINE next #-}
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
| (Word16
n Word16 -> Int -> Word16
forall a. UnsafeShift a => a -> Int -> a
`shiftR` 10) Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x36 = Char -> Int -> Step Int Char
forall s a. a -> s -> Step s a
Yield (Word16 -> Word16 -> Char
U16.chr2 Word16
n Word16
n2) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2)
| Bool
otherwise = Char -> Int -> Step Int Char
forall s a. a -> s -> Step s a
Yield (Word16 -> Char
unsafeChr Word16
n) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
where
n :: Word16
n = Array -> Int -> Word16
A.unsafeIndex Array
arr Int
i
n2 :: Word16
n2 = Array -> Int -> Word16
A.unsafeIndex Array
arr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
{-# INLINE [0] stream #-}
unstream :: D.DecomposeMode -> Stream Char -> Text
unstream :: DecomposeMode -> Stream Char -> Text
unstream mode :: DecomposeMode
mode (Stream next0 :: s -> Step s Char
next0 s0 :: s
s0 len :: 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
$ \done :: MArray s -> Int -> ST s Text
done -> do
let margin :: Int
margin = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxDecomposeLen
mlen :: Int
mlen = (Int -> Size -> Int
upperBound 4 Size
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
margin)
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 -> ReBuf -> ST s Text
outer !MArray s
arr !Int
maxi = s -> Int -> ReBuf -> ST s Text
encode
where
encode :: s -> Int -> ReBuf -> ST s Text
encode !s
si !Int
di rbuf :: ReBuf
rbuf =
if 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
margin
then s -> Int -> ReBuf -> ST s Text
realloc s
si Int
di ReBuf
rbuf
else
case s -> Step s Char
next0 s
si of
Done -> do
Int
di' <- MArray s -> Int -> ReBuf -> ST s Int
forall s. MArray s -> Int -> ReBuf -> ST s Int
writeReorderBuffer MArray s
arr Int
di ReBuf
rbuf
MArray s -> Int -> ST s Text
done MArray s
arr Int
di'
Skip si' :: s
si' -> s -> Int -> ReBuf -> ST s Text
encode s
si' Int
di ReBuf
rbuf
Yield c :: Char
c si' :: s
si' -> do
(di' :: Int
di', rbuf' :: ReBuf
rbuf') <- DecomposeMode
-> MArray s -> Int -> ReBuf -> Char -> ST s (Int, ReBuf)
forall s.
DecomposeMode
-> MArray s -> Int -> ReBuf -> Char -> ST s (Int, ReBuf)
decomposeChar DecomposeMode
mode MArray s
arr Int
di ReBuf
rbuf Char
c
s -> Int -> ReBuf -> ST s Text
encode s
si' Int
di' ReBuf
rbuf'
{-# NOINLINE realloc #-}
realloc :: s -> Int -> ReBuf -> ST s Text
realloc !s
si !Int
di rbuf :: ReBuf
rbuf = do
let newlen :: Int
newlen = Int
maxi Int -> Int -> Int
forall a. Num a => a -> a -> a
* 2
MArray s
arr' <- 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
arr' 0 MArray s
arr 0 Int
di
MArray s -> Int -> s -> Int -> ReBuf -> ST s Text
outer MArray s
arr' (Int
newlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) s
si Int
di ReBuf
rbuf
MArray s -> Int -> s -> Int -> ReBuf -> ST s Text
outer MArray s
arr0 (Int
mlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) s
s0 0 ReBuf
Empty
{-# INLINE [0] unstream #-}
maxDecomposeLen :: Int
maxDecomposeLen :: Int
maxDecomposeLen = 32
data JamoBuf
= Jamo !Char
| Hangul !Char
| HangulLV !Char
data RegBuf
= RegOne !Char
| RegMany !Char !Char ![Char]
data ComposeState
= ComposeNone
| ComposeReg !RegBuf
| ComposeJamo !JamoBuf
{-# INLINE writeJamoBuf #-}
writeJamoBuf :: A.MArray s -> Int -> JamoBuf -> ST s Int
writeJamoBuf :: MArray s -> Int -> JamoBuf -> ST s Int
writeJamoBuf arr :: MArray s
arr i :: Int
i jbuf :: JamoBuf
jbuf = do
Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
arr Int
i (JamoBuf -> Char
getCh JamoBuf
jbuf)
Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
where
getCh :: JamoBuf -> Char
getCh (Jamo ch :: Char
ch) = Char
ch
getCh (Hangul ch :: Char
ch) = Char
ch
getCh (HangulLV ch :: Char
ch) = Char
ch
{-# INLINE initHangul #-}
initHangul :: Char -> Int -> ST s (Int, ComposeState)
initHangul :: Char -> Int -> ST s (Int, ComposeState)
initHangul c :: Char
c i :: Int
i = (Int, ComposeState) -> ST s (Int, ComposeState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, JamoBuf -> ComposeState
ComposeJamo (Char -> JamoBuf
Hangul Char
c))
{-# INLINE initJamo #-}
initJamo :: Char -> Int -> ST s (Int, ComposeState)
initJamo :: Char -> Int -> ST s (Int, ComposeState)
initJamo c :: Char
c i :: Int
i = (Int, ComposeState) -> ST s (Int, ComposeState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, JamoBuf -> ComposeState
ComposeJamo (Char -> JamoBuf
Jamo Char
c))
{-# INLINE insertJamo #-}
insertJamo
:: A.MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
insertJamo :: MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
insertJamo arr :: MArray s
arr i :: Int
i jbuf :: JamoBuf
jbuf ch :: Char
ch
| Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
H.jamoLLast = do
Int
j <- MArray s -> Int -> JamoBuf -> ST s Int
forall s. MArray s -> Int -> JamoBuf -> ST s Int
writeJamoBuf MArray s
arr Int
i JamoBuf
jbuf
(Int, ComposeState) -> ST s (Int, ComposeState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
j, JamoBuf -> ComposeState
ComposeJamo (Char -> JamoBuf
Jamo Char
ch))
| Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
H.jamoVFirst =
MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
flushAndWrite MArray s
arr Int
i JamoBuf
jbuf Char
ch
| Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
H.jamoVLast = do
case JamoBuf
jbuf of
Jamo c :: Char
c ->
case Char -> Maybe Int
H.jamoLIndex Char
c of
Just li :: Int
li ->
let vi :: Int
vi = Int
ich Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
H.jamoVFirst
lvi :: Int
lvi = Int
li Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
H.jamoNCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vi Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
H.jamoTCount
lv :: Char
lv = Int -> Char
chr (Int
H.hangulFirst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lvi)
in (Int, ComposeState) -> ST s (Int, ComposeState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, JamoBuf -> ComposeState
ComposeJamo (Char -> JamoBuf
HangulLV Char
lv))
Nothing -> MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
writeTwo MArray s
arr Int
i Char
c Char
ch
Hangul c :: Char
c -> MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
writeTwo MArray s
arr Int
i Char
c Char
ch
HangulLV c :: Char
c -> MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
writeTwo MArray s
arr Int
i Char
c Char
ch
| Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
H.jamoTFirst = do
MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
flushAndWrite MArray s
arr Int
i JamoBuf
jbuf Char
ch
| Bool
otherwise = do
let ti :: Int
ti = Int
ich Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
H.jamoTFirst
case JamoBuf
jbuf of
Jamo c :: Char
c -> MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
writeTwo MArray s
arr Int
i Char
c Char
ch
Hangul c :: Char
c
| Char -> Bool
H.isHangulLV Char
c -> do
MArray s -> Int -> Char -> Int -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> Char -> Int -> ST s (Int, ComposeState)
writeLVT MArray s
arr Int
i Char
c Int
ti
| Bool
otherwise ->
MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
writeTwo MArray s
arr Int
i Char
c Char
ch
HangulLV c :: Char
c ->
MArray s -> Int -> Char -> Int -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> Char -> Int -> ST s (Int, ComposeState)
writeLVT MArray s
arr Int
i Char
c Int
ti
where
ich :: Int
ich = Char -> Int
ord Char
ch
{-# INLINE flushAndWrite #-}
flushAndWrite :: MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
flushAndWrite marr :: MArray s
marr ix :: Int
ix jb :: JamoBuf
jb c :: Char
c = do
Int
j <- MArray s -> Int -> JamoBuf -> ST s Int
forall s. MArray s -> Int -> JamoBuf -> ST s Int
writeJamoBuf MArray s
marr Int
ix JamoBuf
jb
Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
j Char
c
(Int, ComposeState) -> ST s (Int, ComposeState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n, ComposeState
ComposeNone)
{-# INLINE writeLVT #-}
writeLVT :: MArray s -> Int -> Char -> Int -> ST s (Int, ComposeState)
writeLVT marr :: MArray s
marr ix :: Int
ix lv :: Char
lv ti :: Int
ti = do
Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
ix (Int -> Char
chr ((Char -> Int
ord Char
lv) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ti))
(Int, ComposeState) -> ST s (Int, ComposeState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n, ComposeState
ComposeNone)
{-# INLINE writeTwo #-}
writeTwo :: MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
writeTwo marr :: MArray s
marr ix :: Int
ix c1 :: Char
c1 c2 :: Char
c2 = do
Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
ix Char
c1
Int
m <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Char
c2
(Int, ComposeState) -> ST s (Int, ComposeState)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m), ComposeState
ComposeNone)
{-# INLINE insertHangul #-}
insertHangul
:: A.MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
insertHangul :: MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
insertHangul arr :: MArray s
arr i :: Int
i jbuf :: JamoBuf
jbuf ch :: Char
ch = do
Int
j <- MArray s -> Int -> JamoBuf -> ST s Int
forall s. MArray s -> Int -> JamoBuf -> ST s Int
writeJamoBuf MArray s
arr Int
i JamoBuf
jbuf
(Int, ComposeState) -> ST s (Int, ComposeState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
j, JamoBuf -> ComposeState
ComposeJamo (Char -> JamoBuf
Hangul Char
ch))
{-# INLINE insertIntoRegBuf #-}
insertIntoRegBuf :: Char -> RegBuf -> RegBuf
insertIntoRegBuf :: Char -> RegBuf -> RegBuf
insertIntoRegBuf c :: Char
c (RegOne c0 :: Char
c0)
| Char -> Int
CC.getCombiningClass Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Char -> Int
CC.getCombiningClass Char
c0
= Char -> Char -> [Char] -> RegBuf
RegMany Char
c Char
c0 []
| Bool
otherwise
= Char -> Char -> [Char] -> RegBuf
RegMany Char
c0 Char
c []
insertIntoRegBuf c :: Char
c (RegMany c0 :: Char
c0 c1 :: Char
c1 cs :: [Char]
cs)
| Int
cc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Char -> Int
CC.getCombiningClass Char
c0
= Char -> Char -> [Char] -> RegBuf
RegMany Char
c Char
c0 (Char
c1 Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs)
| Int
cc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Char -> Int
CC.getCombiningClass Char
c1
= Char -> Char -> [Char] -> RegBuf
RegMany Char
c0 Char
c (Char
c1 Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs)
| Bool
otherwise
= Char -> Char -> [Char] -> RegBuf
RegMany Char
c0 Char
c1 ([Char]
cs' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs''))
where
cc :: Int
cc = Char -> Int
CC.getCombiningClass Char
c
(cs' :: [Char]
cs', cs'' :: [Char]
cs'') = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cc) (Int -> Bool) -> (Char -> Int) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
CC.getCombiningClass) [Char]
cs
{-# INLINE writeRegBuf #-}
writeRegBuf :: A.MArray s -> Int -> RegBuf -> ST s Int
writeRegBuf :: MArray s -> Int -> RegBuf -> ST s Int
writeRegBuf arr :: MArray s
arr i :: Int
i = \case
RegOne c :: Char
c -> do
Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
arr Int
i Char
c
Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
RegMany st :: Char
st c :: Char
c [] ->
case Char -> Char -> Maybe Char
C.composePair Char
st Char
c of
Just x :: Char
x -> do
Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
arr Int
i Char
x
Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
Nothing -> do
Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
arr Int
i Char
st
Int
m <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
arr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Char
c
Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m)
RegMany st0 :: Char
st0 c0 :: Char
c0 cs0 :: [Char]
cs0 -> [Char] -> Char -> [Char] -> ST s Int
go [] Char
st0 (Char
c0 Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs0)
where
go :: [Char] -> Char -> [Char] -> ST s Int
go uncs :: [Char]
uncs st :: Char
st [] = MArray s -> Int -> [Char] -> ST s Int
forall s. MArray s -> Int -> [Char] -> ST s Int
writeStr MArray s
arr Int
i (Char
st Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
uncs)
go uncs :: [Char]
uncs st :: Char
st (c :: Char
c : cs :: [Char]
cs) = case Char -> Char -> Maybe Char
C.composePair Char
st Char
c of
Nothing -> [Char] -> Char -> [Char] -> ST s Int
go ([Char]
uncs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
same)) Char
st [Char]
bigger
Just x :: Char
x -> [Char] -> Char -> [Char] -> ST s Int
go [Char]
uncs Char
x [Char]
cs
where
cc :: Int
cc = Char -> Int
CC.getCombiningClass Char
c
(same :: [Char]
same, bigger :: [Char]
bigger) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cc) (Int -> Bool) -> (Char -> Int) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
CC.getCombiningClass) [Char]
cs
{-# INLINE flushComposeState #-}
flushComposeState :: A.MArray s -> Int -> ComposeState -> ST s Int
flushComposeState :: MArray s -> Int -> ComposeState -> ST s Int
flushComposeState arr :: MArray s
arr i :: Int
i = \case
ComposeNone -> Int -> ST s Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
ComposeReg rbuf :: RegBuf
rbuf -> MArray s -> Int -> RegBuf -> ST s Int
forall s. MArray s -> Int -> RegBuf -> ST s Int
writeRegBuf MArray s
arr Int
i RegBuf
rbuf
ComposeJamo jbuf :: JamoBuf
jbuf -> MArray s -> Int -> JamoBuf -> ST s Int
forall s. MArray s -> Int -> JamoBuf -> ST s Int
writeJamoBuf MArray s
arr Int
i JamoBuf
jbuf
{-# INLINE composeChar #-}
composeChar
:: D.DecomposeMode
-> A.MArray s
-> Char
-> Int
-> ComposeState
-> ST s (Int, ComposeState)
composeChar :: DecomposeMode
-> MArray s
-> Char
-> Int
-> ComposeState
-> ST s (Int, ComposeState)
composeChar mode :: DecomposeMode
mode marr :: MArray s
marr = Char -> Int -> ComposeState -> ST s (Int, ComposeState)
go0
where
go0 :: Char -> Int -> ComposeState -> ST s (Int, ComposeState)
go0 ch :: Char
ch !Int
i !ComposeState
st =
case ComposeState
st of
ComposeReg rbuf :: RegBuf
rbuf
| Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
H.jamoLFirst ->
RegBuf -> Char -> Int -> ComposeState -> ST s (Int, ComposeState)
composeReg RegBuf
rbuf Char
ch Int
i ComposeState
st
| Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
H.jamoLast -> do
Int
j <- MArray s -> Int -> RegBuf -> ST s Int
forall s. MArray s -> Int -> RegBuf -> ST s Int
writeRegBuf MArray s
marr Int
i RegBuf
rbuf
Char -> Int -> ST s (Int, ComposeState)
forall s. Char -> Int -> ST s (Int, ComposeState)
initJamo Char
ch Int
j
| Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
H.hangulFirst ->
RegBuf -> Char -> Int -> ComposeState -> ST s (Int, ComposeState)
composeReg RegBuf
rbuf Char
ch Int
i ComposeState
st
| Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
H.hangulLast -> do
Int
j <- MArray s -> Int -> RegBuf -> ST s Int
forall s. MArray s -> Int -> RegBuf -> ST s Int
writeRegBuf MArray s
marr Int
i RegBuf
rbuf
Char -> Int -> ST s (Int, ComposeState)
forall s. Char -> Int -> ST s (Int, ComposeState)
initHangul Char
ch Int
j
| Bool
otherwise ->
RegBuf -> Char -> Int -> ComposeState -> ST s (Int, ComposeState)
composeReg RegBuf
rbuf Char
ch Int
i ComposeState
st
ComposeJamo jbuf :: JamoBuf
jbuf
| Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
H.jamoLFirst -> do
MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
jamoToReg MArray s
marr Int
i JamoBuf
jbuf Char
ch
| Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
H.jamoLast -> do
MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
insertJamo MArray s
marr Int
i JamoBuf
jbuf Char
ch
| Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
H.hangulFirst ->
MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
jamoToReg MArray s
marr Int
i JamoBuf
jbuf Char
ch
| Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
H.hangulLast -> do
MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
insertHangul MArray s
marr Int
i JamoBuf
jbuf Char
ch
| Bool
otherwise ->
MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
jamoToReg MArray s
marr Int
i JamoBuf
jbuf Char
ch
ComposeNone
| Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
H.jamoLFirst ->
Char -> Int -> ST s (Int, ComposeState)
initReg Char
ch Int
i
| Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
H.jamoLast ->
Char -> Int -> ST s (Int, ComposeState)
forall s. Char -> Int -> ST s (Int, ComposeState)
initJamo Char
ch Int
i
| Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
H.hangulFirst ->
Char -> Int -> ST s (Int, ComposeState)
initReg Char
ch Int
i
| Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
H.hangulLast ->
Char -> Int -> ST s (Int, ComposeState)
forall s. Char -> Int -> ST s (Int, ComposeState)
initHangul Char
ch Int
i
| Bool
otherwise ->
Char -> Int -> ST s (Int, ComposeState)
initReg Char
ch Int
i
where ich :: Int
ich = Char -> Int
ord Char
ch
{-# INLINE jamoToReg #-}
jamoToReg :: MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
jamoToReg arr :: MArray s
arr i :: Int
i jbuf :: JamoBuf
jbuf ch :: Char
ch = do
Int
j <- MArray s -> Int -> JamoBuf -> ST s Int
forall s. MArray s -> Int -> JamoBuf -> ST s Int
writeJamoBuf MArray s
arr Int
i JamoBuf
jbuf
Char -> Int -> ST s (Int, ComposeState)
initReg Char
ch Int
j
{-# INLINE initReg #-}
initReg :: Char -> Int -> ST s (Int, ComposeState)
initReg !Char
ch !Int
i
| DecomposeMode -> Char -> Bool
D.isDecomposable DecomposeMode
mode Char
ch =
[Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go (DecomposeMode -> Char -> [Char]
D.decomposeChar DecomposeMode
mode Char
ch) Int
i ComposeState
ComposeNone
| Bool
otherwise =
(Int, ComposeState) -> ST s (Int, ComposeState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
i, RegBuf -> ComposeState
ComposeReg (Char -> RegBuf
RegOne Char
ch))
{-# INLINE composeReg #-}
composeReg :: RegBuf -> Char -> Int -> ComposeState -> ST s (Int, ComposeState)
composeReg rbuf :: RegBuf
rbuf !Char
ch !Int
i !ComposeState
st
| DecomposeMode -> Char -> Bool
D.isDecomposable DecomposeMode
mode Char
ch =
[Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go (DecomposeMode -> Char -> [Char]
D.decomposeChar DecomposeMode
mode Char
ch) Int
i ComposeState
st
| Char -> Bool
CC.isCombining Char
ch = do
(Int, ComposeState) -> ST s (Int, ComposeState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
i, RegBuf -> ComposeState
ComposeReg (Char -> RegBuf -> RegBuf
insertIntoRegBuf Char
ch RegBuf
rbuf))
| RegOne s :: Char
s <- RegBuf
rbuf
, Char -> Bool
C.isSecondStarter Char
ch
, Just x :: Char
x <- Char -> Char -> Maybe Char
C.composeStarterPair Char
s Char
ch =
(Int, ComposeState) -> ST s (Int, ComposeState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
i, (RegBuf -> ComposeState
ComposeReg (Char -> RegBuf
RegOne Char
x)))
| Bool
otherwise = do
Int
j <- MArray s -> Int -> RegBuf -> ST s Int
forall s. MArray s -> Int -> RegBuf -> ST s Int
writeRegBuf MArray s
marr Int
i RegBuf
rbuf
(Int, ComposeState) -> ST s (Int, ComposeState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
j, RegBuf -> ComposeState
ComposeReg (Char -> RegBuf
RegOne Char
ch))
go :: [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [] !Int
i !ComposeState
st = (Int, ComposeState) -> ST s (Int, ComposeState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
i, ComposeState
st)
go (ch :: Char
ch : rest :: [Char]
rest) i :: Int
i st :: ComposeState
st =
case ComposeState
st of
ComposeReg rbuf :: RegBuf
rbuf
| Char -> Bool
H.isHangul Char
ch -> do
Int
j <- MArray s -> Int -> RegBuf -> ST s Int
forall s. MArray s -> Int -> RegBuf -> ST s Int
writeRegBuf MArray s
marr Int
i RegBuf
rbuf
(k :: Int
k, s :: ComposeState
s) <- Char -> Int -> ST s (Int, ComposeState)
forall s. Char -> Int -> ST s (Int, ComposeState)
initHangul Char
ch Int
j
[Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
k ComposeState
s
| Char -> Bool
H.isJamo Char
ch -> do
Int
j <- MArray s -> Int -> RegBuf -> ST s Int
forall s. MArray s -> Int -> RegBuf -> ST s Int
writeRegBuf MArray s
marr Int
i RegBuf
rbuf
(k :: Int
k, s :: ComposeState
s) <- Char -> Int -> ST s (Int, ComposeState)
forall s. Char -> Int -> ST s (Int, ComposeState)
initJamo Char
ch Int
j
[Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
k ComposeState
s
| DecomposeMode -> Char -> Bool
D.isDecomposable DecomposeMode
mode Char
ch ->
[Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go (DecomposeMode -> Char -> [Char]
D.decomposeChar DecomposeMode
mode Char
ch [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
rest) Int
i ComposeState
st
| Char -> Bool
CC.isCombining Char
ch -> do
[Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
i (RegBuf -> ComposeState
ComposeReg (Char -> RegBuf -> RegBuf
insertIntoRegBuf Char
ch RegBuf
rbuf))
| RegOne s :: Char
s <- RegBuf
rbuf
, Char -> Bool
C.isSecondStarter Char
ch
, Just x :: Char
x <- Char -> Char -> Maybe Char
C.composeStarterPair Char
s Char
ch ->
[Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
i (RegBuf -> ComposeState
ComposeReg (Char -> RegBuf
RegOne Char
x))
| Bool
otherwise -> do
Int
j <- MArray s -> Int -> RegBuf -> ST s Int
forall s. MArray s -> Int -> RegBuf -> ST s Int
writeRegBuf MArray s
marr Int
i RegBuf
rbuf
[Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
j (RegBuf -> ComposeState
ComposeReg (Char -> RegBuf
RegOne Char
ch))
ComposeJamo jbuf :: JamoBuf
jbuf
| Char -> Bool
H.isJamo Char
ch -> do
(j :: Int
j, s :: ComposeState
s) <- MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
insertJamo MArray s
marr Int
i JamoBuf
jbuf Char
ch
[Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
j ComposeState
s
| Char -> Bool
H.isHangul Char
ch -> do
(j :: Int
j, s :: ComposeState
s) <- MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
insertHangul MArray s
marr Int
i JamoBuf
jbuf Char
ch
[Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
j ComposeState
s
| Bool
otherwise -> do
Int
j <- MArray s -> Int -> JamoBuf -> ST s Int
forall s. MArray s -> Int -> JamoBuf -> ST s Int
writeJamoBuf MArray s
marr Int
i JamoBuf
jbuf
case () of
_
| DecomposeMode -> Char -> Bool
D.isDecomposable DecomposeMode
mode Char
ch ->
[Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go (DecomposeMode -> Char -> [Char]
D.decomposeChar DecomposeMode
mode Char
ch [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
rest) Int
j
ComposeState
ComposeNone
| Bool
otherwise ->
[Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
j (RegBuf -> ComposeState
ComposeReg (Char -> RegBuf
RegOne Char
ch))
ComposeNone
| Char -> Bool
H.isHangul Char
ch -> do
(j :: Int
j, s :: ComposeState
s) <- Char -> Int -> ST s (Int, ComposeState)
forall s. Char -> Int -> ST s (Int, ComposeState)
initHangul Char
ch Int
i
[Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
j ComposeState
s
| Char -> Bool
H.isJamo Char
ch -> do
(j :: Int
j, s :: ComposeState
s) <- Char -> Int -> ST s (Int, ComposeState)
forall s. Char -> Int -> ST s (Int, ComposeState)
initJamo Char
ch Int
i
[Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
j ComposeState
s
| DecomposeMode -> Char -> Bool
D.isDecomposable DecomposeMode
mode Char
ch ->
[Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go (DecomposeMode -> Char -> [Char]
D.decomposeChar DecomposeMode
mode Char
ch [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
rest) Int
i ComposeState
st
| Bool
otherwise ->
[Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
i (RegBuf -> ComposeState
ComposeReg (Char -> RegBuf
RegOne Char
ch))
unstreamC :: D.DecomposeMode -> Stream Char -> Text
unstreamC :: DecomposeMode -> Stream Char -> Text
unstreamC mode :: DecomposeMode
mode (Stream next0 :: s -> Step s Char
next0 s0 :: s
s0 len :: 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
$ \done :: MArray s -> Int -> ST s Text
done -> do
let margin :: Int
margin = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxDecomposeLen
mlen :: Int
mlen = (Int -> Size -> Int
upperBound 4 Size
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
margin)
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 -> ComposeState -> ST s Text
outer !MArray s
arr !Int
maxi = SPEC -> s -> Int -> ComposeState -> ST s Text
encode SPEC
SPEC
where
encode :: SPEC -> s -> Int -> ComposeState -> ST s Text
encode !SPEC
_ !s
si !Int
di st :: ComposeState
st =
if 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
margin
then s -> Int -> ComposeState -> ST s Text
realloc s
si Int
di ComposeState
st
else
case s -> Step s Char
next0 s
si of
Done -> do
Int
di' <- MArray s -> Int -> ComposeState -> ST s Int
forall s. MArray s -> Int -> ComposeState -> ST s Int
flushComposeState MArray s
arr Int
di ComposeState
st
MArray s -> Int -> ST s Text
done MArray s
arr Int
di'
Skip si' :: s
si' -> SPEC -> s -> Int -> ComposeState -> ST s Text
encode SPEC
SPEC s
si' Int
di ComposeState
st
Yield c :: Char
c si' :: s
si' -> do
(di' :: Int
di', st' :: ComposeState
st') <- DecomposeMode
-> MArray s
-> Char
-> Int
-> ComposeState
-> ST s (Int, ComposeState)
forall s.
DecomposeMode
-> MArray s
-> Char
-> Int
-> ComposeState
-> ST s (Int, ComposeState)
composeChar DecomposeMode
mode MArray s
arr Char
c Int
di ComposeState
st
SPEC -> s -> Int -> ComposeState -> ST s Text
encode SPEC
SPEC s
si' Int
di' ComposeState
st'
{-# NOINLINE realloc #-}
realloc :: s -> Int -> ComposeState -> ST s Text
realloc !s
si !Int
di st :: ComposeState
st = do
let newlen :: Int
newlen = Int
maxi Int -> Int -> Int
forall a. Num a => a -> a -> a
* 2
MArray s
arr' <- 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
arr' 0 MArray s
arr 0 Int
di
MArray s -> Int -> s -> Int -> ComposeState -> ST s Text
outer MArray s
arr' (Int
newlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) s
si Int
di ComposeState
st
MArray s -> Int -> s -> Int -> ComposeState -> ST s Text
outer MArray s
arr0 (Int
mlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) s
s0 0 ComposeState
ComposeNone
{-# INLINE [0] unstreamC #-}