{-# LANGUAGE MagicHash #-}
module Basement.UTF8.Table
( isContinuation
, isContinuation2
, isContinuation3
, getNbBytes
, isContinuation#
, isContinuationW#
, getNbBytes#
) where
import GHC.Prim (Word#, Int#, Addr#, indexWord8OffAddr#, word2Int#)
import GHC.Types
import GHC.Word
import Basement.Compat.Base
import Basement.Compat.Primitive
import Basement.Bits
import Basement.UTF8.Types (StepASCII(..))
isContinuation :: Word8 -> Bool
isContinuation :: Word8 -> Bool
isContinuation (W8# Word#
w) = Word# -> Bool
isContinuation# Word#
w
{-# INLINE isContinuation #-}
isContinuation2 :: Word8 -> Word8 -> Bool
isContinuation2 :: Word8 -> Word8 -> Bool
isContinuation2 !Word8
w1 !Word8
w2 = Word8 -> Bool
forall a. (Eq a, BitOps a, Integral a) => a -> Bool
mask Word8
w1 Bool -> Bool -> Bool
&& Word8 -> Bool
forall a. (Eq a, BitOps a, Integral a) => a -> Bool
mask Word8
w2
where
mask :: a -> Bool
mask a
v = (a
v a -> a -> a
forall bits. BitOps bits => bits -> bits -> bits
.&. a
0xC0) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0x80
{-# INLINE isContinuation2 #-}
isContinuation3 :: Word8 -> Word8 -> Word8 -> Bool
isContinuation3 :: Word8 -> Word8 -> Word8 -> Bool
isContinuation3 !Word8
w1 !Word8
w2 !Word8
w3 =
Word8 -> Bool
forall a. (Eq a, BitOps a, Integral a) => a -> Bool
mask Word8
w1 Bool -> Bool -> Bool
&& Word8 -> Bool
forall a. (Eq a, BitOps a, Integral a) => a -> Bool
mask Word8
w2 Bool -> Bool -> Bool
&& Word8 -> Bool
forall a. (Eq a, BitOps a, Integral a) => a -> Bool
mask Word8
w3
where
mask :: a -> Bool
mask a
v = (a
v a -> a -> a
forall bits. BitOps bits => bits -> bits -> bits
.&. a
0xC0) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0x80
{-# INLINE isContinuation3 #-}
data NbBytesCont = NbBytesInvalid | NbBytesCont0 | NbBytesCont1 | NbBytesCont2 | NbBytesCont3
data NbBytesCont_ = NbBytesCont0_ | NbBytesCont1_ | NbBytesCont2_ | NbBytesCont3_
getNbBytes :: StepASCII -> Int
getNbBytes :: StepASCII -> Int
getNbBytes (StepASCII (W8# Word#
w)) = Int# -> Int
I# (Word# -> Int#
getNbBytes# Word#
w)
{-# INLINE getNbBytes #-}
isContinuation# :: Word8# -> Bool
isContinuation# :: Word# -> Bool
isContinuation# Word#
w = Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# (Table -> Addr#
unTable Table
contTable) (Word# -> Int#
word2Int# (Word# -> Word#
word8ToWord# Word#
w))) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0
{-# INLINE isContinuation# #-}
isContinuationW# :: Word# -> Bool
isContinuationW# :: Word# -> Bool
isContinuationW# Word#
w = Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# (Table -> Addr#
unTable Table
contTable) (Word# -> Int#
word2Int# Word#
w)) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0
{-# INLINE isContinuationW# #-}
getNbBytes# :: Word8# -> Int#
getNbBytes# :: Word# -> Int#
getNbBytes# Word#
w = Word# -> Int#
word8ToInt# (Addr# -> Int# -> Word#
indexWord8OffAddr# (Table -> Addr#
unTable Table
headTable) (Word# -> Int#
word2Int# (Word# -> Word#
word8ToWord# Word#
w)))
{-# INLINE getNbBytes# #-}
data Table = Table { Table -> Addr#
unTable :: !Addr# }
contTable :: Table
contTable :: Table
contTable = Addr# -> Table
Table
Addr#
"\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\
\\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\
\\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\
\\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\
\\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\
\\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\
\\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\
\\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\
\\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
\\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
\\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
\\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
\\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\
\\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\
\\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\
\\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01"#
{-# NOINLINE contTable #-}
headTable :: Table
headTable :: Table
headTable = Addr# -> Table
Table
Addr#
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
\\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
\\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
\\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
\\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
\\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
\\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
\\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
\\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
\\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
\\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
\\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
\\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\
\\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\
\\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\
\\x03\x03\x03\x03\x03\x03\x03\x03\xff\xff\xff\xff\xff\xff\xff\xff"#
{-# NOINLINE headTable #-}