-- |
-- Module      : Basement.UTF8.Table
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : portable
--
-- UTF8 lookup tables for fast continuation & nb bytes per header queries
{-# LANGUAGE MagicHash #-}
module Basement.UTF8.Table
    ( isContinuation
    , isContinuation2
    , isContinuation3
    , getNbBytes
    , isContinuation#
    , getNbBytes#
    ) where

import           GHC.Prim
import           GHC.Types
import           GHC.Word
import           Basement.Compat.Base
import           Basement.Compat.Primitive
import           Basement.HeadHackageUtils
import           Basement.UTF8.Types (StepASCII(..))

-- | Check if the byte is a continuation byte
isContinuation :: Word8 -> Bool
isContinuation :: Word8 -> Bool
isContinuation (W8# Word#
w) = Word# -> Bool
isContinuation# (Word# -> Word#
word8ToWordCompat# Word#
w)
{-# INLINE isContinuation #-}

isContinuation2 :: Word8 -> Word8 -> Bool
isContinuation2 :: Word8 -> Word8 -> Bool
isContinuation2 (W8# Word#
w1) (W8# Word#
w2) =
    Int# -> Bool
bool# (Word# -> Int#
mask (Word# -> Word#
word8ToWordCompat# Word#
w1) Int# -> Int# -> Int#
`andI#` Word# -> Int#
mask (Word# -> Word#
word8ToWordCompat# Word#
w2))
  where
    mask :: Word# -> Int#
mask Word#
v = (Word# -> Word# -> Word#
and# Word#
0xC0## Word#
v) Word# -> Word# -> Int#
`eqWord#` Word#
0x80##
{-# INLINE isContinuation2 #-}

isContinuation3 :: Word8 -> Word8 -> Word8 -> Bool
isContinuation3 :: Word8 -> Word8 -> Word8 -> Bool
isContinuation3 (W8# Word#
w1) (W8# Word#
w2) (W8# Word#
w3) =
    Int# -> Bool
bool# (Word# -> Int#
mask (Word# -> Word#
word8ToWordCompat# Word#
w1)) Bool -> Bool -> Bool
&& Int# -> Bool
bool# (Word# -> Int#
mask (Word# -> Word#
word8ToWordCompat# Word#
w2)) Bool -> Bool -> Bool
&& Int# -> Bool
bool# (Word# -> Int#
mask (Word# -> Word#
word8ToWordCompat# Word#
w3))
  where
    mask :: Word# -> Int#
mask Word#
v = (Word# -> Word# -> Word#
and# Word#
0xC0## Word#
v) Word# -> Word# -> Int#
`eqWord#` Word#
0x80##
{-# INLINE isContinuation3 #-}

-- | Number of bytes associated with a specific header byte
--
-- If the header byte is invalid then NbBytesInvalid is returned,
data NbBytesCont = NbBytesInvalid | NbBytesCont0 | NbBytesCont1 | NbBytesCont2 | NbBytesCont3

-- | Identical to 'NbBytesCont' but doesn't allow to represent any failure.
--
-- Only use in validated place
data NbBytesCont_ = NbBytesCont0_ | NbBytesCont1_ | NbBytesCont2_ | NbBytesCont3_

-- | Get the number of following bytes given the first byte of a UTF8 sequence.
getNbBytes :: StepASCII -> Int
getNbBytes :: StepASCII -> Int
getNbBytes (StepASCII (W8# Word#
w)) = Int# -> Int
I# (Word# -> Int#
getNbBytes# (Word# -> Word#
word8ToWordCompat# Word#
w))
{-# INLINE getNbBytes #-}

-- | Check if the byte is a continuation byte
isContinuation# :: Word# -> Bool
isContinuation# :: Word# -> Bool
isContinuation# Word#
w = Word# -> Word
W# (Word# -> Word#
word8ToWordCompat# (Addr# -> Int# -> Word#
indexWord8OffAddr# (Table -> Addr#
unTable Table
contTable) (Word# -> Int#
word2Int# Word#
w))) Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word# -> Word
W# Word#
0##
{-# INLINE isContinuation# #-}

-- | Get the number of following bytes given the first byte of a UTF8 sequence.
getNbBytes# :: Word# -> Int#
getNbBytes# :: Word# -> Int#
getNbBytes# Word#
w = Word# -> Int#
word2Int# (Word# -> Word#
word8ToWordCompat# (Addr# -> Int# -> Word#
indexWord8OffAddr# (Table -> Addr#
unTable Table
headTable) (Word# -> Int#
word2Int# 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 #-}