{-# 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 Char
c ReBuf
Empty = Char -> ReBuf
One Char
c
insertIntoReBuf Char
c (One 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 Char
c (Many Char
c0 Char
c1 [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
([Char]
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 MArray s
marr Int
di [Char]
str = Int -> [Char] -> ST s Int
go Int
di [Char]
str
where
go :: Int -> [Char] -> ST s Int
go Int
i [] = Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
go Int
i (Char
c : [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 MArray s
_ Int
di ReBuf
Empty = Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
di
writeReorderBuffer MArray s
marr Int
di (One 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 MArray s
marr Int
di (Many Char
c1 Char
c2 [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 MArray s
marr Int
j 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
(Char
l, Char
v, 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 DecomposeMode
mode MArray s
marr Int
index ReBuf
reBuf 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 MArray s
_ Int
i ReBuf
rbuf [] = (Int, ReBuf) -> ST s (Int, ReBuf)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, ReBuf
rbuf)
decomposeAll MArray s
arr Int
i ReBuf
rbuf (Char
x : [Char]
xs)
| DecomposeMode -> Char -> Bool
D.isDecomposable DecomposeMode
mode Char
x = do
(Int
i', 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
(Int
i', 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 MArray s
arr Int
i ReBuf
rbuf 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 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. UnsafeShift a => a -> Int -> a
`shiftR` Int
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` Int
10) Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
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
+ Int
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
+ Int
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
+ Int
1)
{-# INLINE [0] stream #-}
unstream :: D.DecomposeMode -> Stream Char -> Text
unstream :: DecomposeMode -> Stream Char -> Text
unstream DecomposeMode
mode (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 margin :: Int
margin = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxDecomposeLen
mlen :: Int
mlen = (Int -> Size -> Int
upperBound Int
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 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
Step s Char
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 s
si' -> s -> Int -> ReBuf -> ST s Text
encode s
si' Int
di ReBuf
rbuf
Yield Char
c s
si' -> do
(Int
di', 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 ReBuf
rbuf = do
let newlen :: Int
newlen = Int
maxi Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
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' Int
0 MArray s
arr Int
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
- Int
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
- Int
1) s
s0 Int
0 ReBuf
Empty
{-# INLINE [0] unstream #-}
maxDecomposeLen :: Int
maxDecomposeLen :: Int
maxDecomposeLen = Int
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 MArray s
arr Int
i 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 Char
ch) = Char
ch
getCh (Hangul Char
ch) = Char
ch
getCh (HangulLV Char
ch) = Char
ch
{-# INLINE initHangul #-}
initHangul :: Char -> Int -> ST s (Int, ComposeState)
initHangul :: Char -> Int -> ST s (Int, ComposeState)
initHangul Char
c 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 Char
c 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 MArray s
arr Int
i JamoBuf
jbuf 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 Char
c ->
case Char -> Maybe Int
H.jamoLIndex Char
c of
Just 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))
Maybe Int
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 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 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 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 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 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 MArray s
marr Int
ix JamoBuf
jb 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 MArray s
marr Int
ix Char
lv 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 MArray s
marr Int
ix Char
c1 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 MArray s
arr Int
i JamoBuf
jbuf 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 Char
c (RegOne 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 Char
c (RegMany Char
c0 Char
c1 [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
([Char]
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 MArray s
arr Int
i = \case
RegOne 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 Char
st Char
c [] ->
case Char -> Char -> Maybe Char
C.composePair Char
st Char
c of
Just 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)
Maybe Char
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 Char
st0 Char
c0 [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 [Char]
uncs 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 [Char]
uncs Char
st (Char
c : [Char]
cs) = case Char -> Char -> Maybe Char
C.composePair Char
st Char
c of
Maybe Char
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 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
([Char]
same, [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 MArray s
arr Int
i = \case
ComposeState
ComposeNone -> Int -> ST s Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
ComposeReg 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 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 DecomposeMode
mode MArray s
marr = Char -> Int -> ComposeState -> ST s (Int, ComposeState)
go0
where
go0 :: Char -> Int -> ComposeState -> ST s (Int, ComposeState)
go0 Char
ch !Int
i !ComposeState
st =
case ComposeState
st of
ComposeReg 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 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
ComposeState
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 MArray s
arr Int
i JamoBuf
jbuf 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 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 Char
s <- RegBuf
rbuf
, Char -> Bool
C.isSecondStarter Char
ch
, Just 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 (Char
ch : [Char]
rest) Int
i ComposeState
st =
case ComposeState
st of
ComposeReg 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
(Int
k, 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
(Int
k, 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 Char
s <- RegBuf
rbuf
, Char -> Bool
C.isSecondStarter Char
ch
, Just 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 JamoBuf
jbuf
| Char -> Bool
H.isJamo Char
ch -> do
(Int
j, 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
(Int
j, 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))
ComposeState
ComposeNone
| Char -> Bool
H.isHangul Char
ch -> do
(Int
j, 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
(Int
j, 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 DecomposeMode
mode (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 margin :: Int
margin = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxDecomposeLen
mlen :: Int
mlen = (Int -> Size -> Int
upperBound Int
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 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
Step s Char
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 s
si' -> SPEC -> s -> Int -> ComposeState -> ST s Text
encode SPEC
SPEC s
si' Int
di ComposeState
st
Yield Char
c s
si' -> do
(Int
di', 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 ComposeState
st = do
let newlen :: Int
newlen = Int
maxi Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
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' Int
0 MArray s
arr Int
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
- Int
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
- Int
1) s
s0 Int
0 ComposeState
ComposeNone
{-# INLINE [0] unstreamC #-}