{-# LANGUAGE CPP #-}
module Unicode.Char.General.Scripts
( S.Script(..)
, script
, scriptExtensions
, scriptDefinition
)
where
#include "MachDeps.h"
import Data.Char (chr)
import Data.List.NonEmpty (NonEmpty)
import GHC.Exts
(Ptr(..), Char(..), Int(..),
indexWord32OffAddr#, word2Int#,
and#, isTrue#, neWord#, (-#), (<#), chr#)
#if MIN_VERSION_base(4,16,0)
import GHC.Exts (word32ToWord#)
#endif
#ifdef WORDS_BIGENDIAN
import GHC.Exts (byteSwap32#, narrow32Word#)
#endif
import qualified Unicode.Internal.Char.Scripts as S
import qualified Unicode.Internal.Char.ScriptExtensions as S
{-# INLINE script #-}
script :: Char -> S.Script
script :: Char -> Script
script = Int -> Script
forall a. Enum a => Int -> a
toEnum (Int -> Script) -> (Char -> Int) -> Char -> Script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
S.script
scriptDefinition :: S.Script -> String
scriptDefinition :: Script -> String
scriptDefinition = (Ptr Int32, Int) -> String
forall {a}. (Ptr a, Int) -> String
unpack ((Ptr Int32, Int) -> String)
-> (Script -> (Ptr Int32, Int)) -> Script -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script -> (Ptr Int32, Int)
S.scriptDefinition
where
scriptRangeMask# :: Word#
scriptRangeMask# = Word#
0x80000000##
maskComplement# :: Word#
maskComplement# = Word#
0x7fffffff##
unpack :: (Ptr a, Int) -> String
unpack (Ptr Addr#
addr#, I# Int#
n#) = let {
getRawCodePoint :: Int# -> Word#
getRawCodePoint Int#
k# =
#ifdef WORDS_BIGENDIAN
#if MIN_VERSION_base(4,16,0)
narrow32Word# (byteSwap32# (word32ToWord# (indexWord32OffAddr# addr# k#)));
#else
narrow32Word# (byteSwap32# (indexWord32OffAddr# addr# k#));
#endif
#elif MIN_VERSION_base(4,16,0)
Word32# -> Word#
word32ToWord# (Addr# -> Int# -> Word32#
indexWord32OffAddr# Addr#
addr# Int#
k#);
#else
indexWord32OffAddr# addr# k#;
#endif
getCodePoint :: Word# -> Int#
getCodePoint Word#
k# = Word# -> Int#
word2Int# (Word# -> Word# -> Word#
and# Word#
maskComplement# Word#
k#);
addRange :: Int# -> String -> String
addRange Int#
k# String
acc = if Int# -> Bool
isTrue# (Int#
k# Int# -> Int# -> Int#
<# Int#
0#)
then String
acc
else let {
r1# :: Word#
r1# = Int# -> Word#
getRawCodePoint Int#
k#;
c1# :: Int#
c1# = Word# -> Int#
getCodePoint Word#
r1#;
isRange :: Bool
isRange = Int# -> Bool
isTrue# (Word# -> Word# -> Word#
and# Word#
r1# Word#
scriptRangeMask# Word# -> Word# -> Int#
`neWord#` Word#
0##)
} in if Bool
isRange
then let {
c2# :: Int#
c2# = Word# -> Int#
getCodePoint (Int# -> Word#
getRawCodePoint (Int#
k# Int# -> Int# -> Int#
-# Int#
1#));
acc' :: String
acc' = (Int -> String -> String) -> String -> [Int] -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (Char -> String -> String)
-> (Int -> Char) -> Int -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
chr) String
acc [Int# -> Int
I# Int#
c2# .. Int# -> Int
I# Int#
c1#]
} in Int# -> String -> String
addRange (Int#
k# Int# -> Int# -> Int#
-# Int#
2#) String
acc'
else Int# -> String -> String
addRange (Int#
k# Int# -> Int# -> Int#
-# Int#
1#) (Char# -> Char
C# (Int# -> Char#
chr# Int#
c1#) Char -> String -> String
forall a. a -> [a] -> [a]
: String
acc)
} in Int# -> String -> String
addRange (Int#
n# Int# -> Int# -> Int#
-# Int#
1#) String
forall a. Monoid a => a
mempty
{-# INLINE scriptExtensions #-}
scriptExtensions :: Char -> NonEmpty S.Script
scriptExtensions :: Char -> NonEmpty Script
scriptExtensions = Int -> NonEmpty Script
S.decodeScriptExtensions (Int -> NonEmpty Script)
-> (Char -> Int) -> Char -> NonEmpty Script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
S.scriptExtensions