{-|
Module      : Htcc.Tokenizer.Token
Description : Types used in lexical analysis and their utility functions
Copyright   : (c) roki, 2019
License     : MIT
Maintainer  : falgon53@yahoo.co.jp
Stability   : experimental
Portability : POSIX

Types used in lexical analysis and their utility functions
-}
{-# LANGUAGE DeriveGeneric, OverloadedStrings, ScopedTypeVariables,
             TupleSections #-}
module Htcc.Tokenizer.Token (
    -- * Token data types
    TokenLCNums (..),
    TokenLC,
    Token (..),
    -- * Utilities for accessing to token data
    length,
    emptyToken,
    isTKNum,
    isTKType,
    isTKStruct,
    isTKEnum,
    isTKIdent,
    isTKReserved,
    isTKMacro,
    isTKString,
    spanStrLiteral,
    spanCharLiteral,
    spanIntLit,
    lookupKeyword,
    altEmptyToken
) where

import           Control.DeepSeq                      (NFData (..),
                                                       NFData1 (..))
import qualified Data.ByteString                      as B
import           Data.Char                            (chr, isDigit, ord)
import           Data.List                            (find)
import qualified Data.Map                             as M
import qualified Data.Text                            as T
import qualified Data.Text.Encoding                   as T
import           Data.Tuple.Extra                     (first, second)
import           GHC.Generics                         (Generic, Generic1)
import           Numeric                              (readDec, readHex,
                                                       readInt, readOct)
import           Numeric.Natural
import           Prelude                              hiding (length)
import qualified Prelude                              as P (length)

import qualified Htcc.CRules                          as CR
import qualified Htcc.CRules.Preprocessor.Punctuators as CP
import           Htcc.Utils                           (dropFst3, lor, maybe',
                                                       spanLen, tshow)

-- | Token type
data Token i = TKReserved T.Text -- ^ The reserved token
    | TKNum !i -- ^ The number data
    | TKIdent T.Text -- ^ The identifier
    | TKReturn -- ^ The @return@ keyword
    | TKIf -- ^ The @if@ keyword
    | TKSwitch -- ^ The @switch@ keyword
    | TKCase -- ^ The @case@ keyword
    | TKDefault -- ^ The @default@ keyword
    | TKElse -- ^ The @else@ keyword
    | TKWhile -- ^ The @while@ keyword
    | TKFor -- ^ The @for@ keyword
    | TKBreak -- ^ The @break@ keyword
    | TKContinue -- ^ The @continue@ keyword
    | TKEnum -- ^ The @enum@ keyword
    | TKSizeof -- ^ The @sizeof@ keyword
    | TKAlignof -- ^ The @_Alignof@ keyword
    | TKStruct -- ^ The @struct@ keyword
    | TKGoto -- ^ THe @goto@ keyword
    | TKType (CR.StorageClass i) -- ^ Types
    | TKTypedef -- ^ The @typedef@ keyword
    | TKString B.ByteString -- ^ The string literal
    | TKMacro CP.Macros T.Text -- ^ The C macro
    | TKEmpty -- ^ The empty token (This is not used by `Htcc.Tokenizer.Core.tokenize`, but when errors are detected during parsing, the token at error locations cannot be specified)
    deriving (Token i -> Token i -> Bool
(Token i -> Token i -> Bool)
-> (Token i -> Token i -> Bool) -> Eq (Token i)
forall i. Eq i => Token i -> Token i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token i -> Token i -> Bool
$c/= :: forall i. Eq i => Token i -> Token i -> Bool
== :: Token i -> Token i -> Bool
$c== :: forall i. Eq i => Token i -> Token i -> Bool
Eq, (forall x. Token i -> Rep (Token i) x)
-> (forall x. Rep (Token i) x -> Token i) -> Generic (Token i)
forall x. Rep (Token i) x -> Token i
forall x. Token i -> Rep (Token i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (Token i) x -> Token i
forall i x. Token i -> Rep (Token i) x
$cto :: forall i x. Rep (Token i) x -> Token i
$cfrom :: forall i x. Token i -> Rep (Token i) x
Generic)

instance NFData i => NFData (Token i)

instance Show i => Show (Token i) where
    show :: Token i -> String
show (TKReserved s :: Text
s) = Text -> String
T.unpack Text
s
    show (TKNum i :: i
i)      = i -> String
forall a. Show a => a -> String
show i
i
    show (TKIdent s :: Text
s)    = Text -> String
T.unpack Text
s
    show TKReturn       = "return"
    show TKIf           = "if"
    show TKSwitch       = "switch"
    show TKCase         = "case"
    show TKDefault      = "default"
    show TKElse         = "else"
    show TKWhile        = "while"
    show TKFor          = "for"
    show TKBreak        = "break"
    show TKContinue     = "continue"
    show TKEnum         = "enum"
    show TKStruct       = "struct"
    show TKSizeof       = "sizeof"
    show TKGoto         = "goto"
    show TKAlignof      = "_Alignof"
    show TKTypedef      = "typedef"
    show (TKMacro m :: Macros
m st :: Text
st) = ('#' Char -> ShowS
forall a. a -> [a] -> [a]
: Macros -> String
forall a. Show a => a -> String
show Macros
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
st
    show (TKType x :: StorageClass i
x)     = StorageClass i -> String
forall a. Show a => a -> String
show StorageClass i
x
    show (TKString s :: ByteString
s)   = "\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (ByteString -> Text
T.decodeUtf8 ByteString
s) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\""
    show TKEmpty        = ""

instance Read i => Read (Token i) where
    readsPrec :: Int -> ReadS (Token i)
readsPrec _ xxs :: String
xxs@(x :: Char
x:xs :: String
xs)
        | Char -> Bool
isDigit Char
x = [(String -> Token i) -> (String, String) -> (Token i, String)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (i -> Token i
forall i. i -> Token i
TKNum (i -> Token i) -> (String -> i) -> String -> Token i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> i
forall a. Read a => String -> a
read :: String -> i) (String -> i) -> ShowS -> String -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:)) ((String, String) -> (Token i, String))
-> (String, String) -> (Token i, String)
forall a b. (a -> b) -> a -> b
$ (Int, String, String) -> (String, String)
forall a b c. (a, b, c) -> (b, c)
dropFst3 ((Int, String, String) -> (String, String))
-> (Int, String, String) -> (String, String)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> (Int, String, String)
forall a. (a -> Bool) -> [a] -> (Int, [a], [a])
spanLen Char -> Bool
isDigit String
xs]
        | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\"' = [(Token i, String)
-> Maybe (Text, Text)
-> ((Text, Text) -> (Token i, String))
-> (Token i, String)
forall b a. b -> Maybe a -> (a -> b) -> b
maybe' (String -> (Token i, String)
forall a. HasCallStack => String -> a
error "No parse: string literal was not closed") (Text -> Maybe (Text, Text)
spanStrLiteral (Text -> Maybe (Text, Text)) -> Text -> Maybe (Text, Text)
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
xs) (((Text, Text) -> (Token i, String)) -> (Token i, String))
-> ((Text, Text) -> (Token i, String)) -> (Token i, String)
forall a b. (a -> b) -> a -> b
$ (Text -> Token i) -> (Text, String) -> (Token i, String)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (ByteString -> Token i
forall i. ByteString -> Token i
TKString (ByteString -> Token i) -> (Text -> ByteString) -> Text -> Token i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text) -> Text -> Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Text
T.append "\0") ((Text, String) -> (Token i, String))
-> ((Text, Text) -> (Text, String))
-> (Text, Text)
-> (Token i, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> String) -> (Text, Text) -> (Text, String)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second Text -> String
T.unpack]
        | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length String
xxs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 2 Bool -> Bool -> Bool
&& String -> Text
T.pack (Int -> ShowS
forall a. Int -> [a] -> [a]
take 3 String
xxs) Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
CR.strOps3 = [(Text -> Token i
forall i. Text -> Token i
TKReserved (Text -> Token i) -> Text -> Token i
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
take 3 String
xxs, Int -> ShowS
forall a. Int -> [a] -> [a]
drop 3 String
xxs)]
        | Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs) Bool -> Bool -> Bool
&& String -> Text
T.pack (Int -> ShowS
forall a. Int -> [a] -> [a]
take 2 String
xxs) Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
CR.strOps2 = [(Text -> Token i
forall i. Text -> Token i
TKReserved (Text -> Token i) -> Text -> Token i
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
take 2 String
xxs, Int -> ShowS
forall a. Int -> [a] -> [a]
drop 2 String
xxs)]
        | Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
CR.charOps = [(Text -> Token i
forall i. Text -> Token i
TKReserved (Char -> Text
T.singleton Char
x), String
xs)]
        | Bool
otherwise = [(String -> Token i) -> (String, String) -> (Token i, String)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Text -> Token i
forall i. Text -> Token i
TKIdent (Text -> Token i) -> (String -> Text) -> String -> Token i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) ((String, String) -> (Token i, String))
-> (String, String) -> (Token i, String)
forall a b. (a -> b) -> a -> b
$ (Int, String, String) -> (String, String)
forall a b c. (a, b, c) -> (b, c)
dropFst3 ((Int, String, String) -> (String, String))
-> (Int, String, String) -> (String, String)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> (Int, String, String)
forall a. (a -> Bool) -> [a] -> (Int, [a], [a])
spanLen Char -> Bool
CR.isValidChar String
xxs]
    readsPrec _ _ = [(Token i
forall i. Token i
TKEmpty, [])]

{-# INLINE length #-}
-- | `length` returns the token length
length :: Show i => Token i -> Int
length :: Token i -> Int
length (TKReserved s :: Text
s) = Text -> Int
T.length Text
s
length (TKNum i :: i
i)      = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ i -> String
forall a. Show a => a -> String
show i
i
length (TKIdent i :: Text
i)    = Text -> Int
T.length Text
i
length TKReturn       = 6
length TKIf           = 2
length TKSwitch       = 6
length TKCase         = 4
length TKDefault      = 7
length TKElse         = 4
length TKWhile        = 5
length TKBreak        = 5
length TKContinue     = 8
length TKFor          = 3
length TKEnum         = 4
length TKStruct       = 6
length TKSizeof       = 6
length TKAlignof      = 8
length TKTypedef      = 7
length TKGoto         = 4
length (TKType tk :: StorageClass i
tk)    = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ StorageClass i -> String
forall a. Show a => a -> String
show StorageClass i
tk
length (TKString s :: ByteString
s)   = ByteString -> Int
B.length ByteString
s
length (TKMacro m :: Macros
m t :: Text
t)  = Macros -> Int
CP.length Macros
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
t
length TKEmpty        = 0

-- | Lookup keyword from `T.Text`. If the specified `T.Text` is not keyword as C language, `lookupKeyword` returns `Nothing`.
lookupKeyword :: forall i. (Show i) => T.Text -> Maybe (Token i)
lookupKeyword :: Text -> Maybe (Token i)
lookupKeyword s :: Text
s = (Token i -> Bool) -> [Token i] -> Maybe (Token i)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) Text
s (Text -> Bool) -> (Token i -> Text) -> Token i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token i -> Text
forall a. Show a => a -> Text
tshow) [
    Token i
forall i. Token i
TKReturn,
    Token i
forall i. Token i
TKWhile,
    Token i
forall i. Token i
TKIf,
    Token i
forall i. Token i
TKSwitch,
    Token i
forall i. Token i
TKCase,
    Token i
forall i. Token i
TKDefault,
    Token i
forall i. Token i
TKElse,
    Token i
forall i. Token i
TKFor,
    Token i
forall i. Token i
TKBreak,
    Token i
forall i. Token i
TKContinue,
    Token i
forall i. Token i
TKEnum,
    Token i
forall i. Token i
TKStruct,
    Token i
forall i. Token i
TKSizeof,
    Token i
forall i. Token i
TKGoto,
    Token i
forall i. Token i
TKAlignof,
    Token i
forall i. Token i
TKTypedef,
    StorageClass i -> Token i
forall i. StorageClass i -> Token i
TKType (StorageClass i -> Token i) -> StorageClass i -> Token i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CR.SCUndef TypeKind i
forall i. TypeKind i
CR.CTInt,
    StorageClass i -> Token i
forall i. StorageClass i -> Token i
TKType (StorageClass i -> Token i) -> StorageClass i -> Token i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CR.SCUndef TypeKind i
forall i. TypeKind i
CR.CTChar,
    StorageClass i -> Token i
forall i. StorageClass i -> Token i
TKType (StorageClass i -> Token i) -> StorageClass i -> Token i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CR.SCUndef (TypeKind i -> StorageClass i) -> TypeKind i -> StorageClass i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
CR.CTSigned TypeKind i
forall i. TypeKind i
CR.CTUndef,
    StorageClass i -> Token i
forall i. StorageClass i -> Token i
TKType (StorageClass i -> Token i) -> StorageClass i -> Token i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CR.SCUndef (TypeKind i -> StorageClass i) -> TypeKind i -> StorageClass i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
CR.CTShort TypeKind i
forall i. TypeKind i
CR.CTUndef,
    StorageClass i -> Token i
forall i. StorageClass i -> Token i
TKType (StorageClass i -> Token i) -> StorageClass i -> Token i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CR.SCUndef (TypeKind i -> StorageClass i) -> TypeKind i -> StorageClass i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
CR.CTLong TypeKind i
forall i. TypeKind i
CR.CTUndef,
    StorageClass i -> Token i
forall i. StorageClass i -> Token i
TKType (StorageClass i -> Token i) -> StorageClass i -> Token i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CR.SCUndef TypeKind i
forall i. TypeKind i
CR.CTVoid,
    StorageClass i -> Token i
forall i. StorageClass i -> Token i
TKType (StorageClass i -> Token i) -> StorageClass i -> Token i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CR.SCUndef TypeKind i
forall i. TypeKind i
CR.CTBool,
    Text -> Token i
forall i. Text -> Token i
TKReserved (Text -> Token i) -> Text -> Token i
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ StorageClass i -> String
forall a. Show a => a -> String
show (TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CR.SCAuto TypeKind i
forall i. TypeKind i
CR.CTUndef :: CR.StorageClass i),
    Text -> Token i
forall i. Text -> Token i
TKReserved (Text -> Token i) -> Text -> Token i
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ StorageClass i -> String
forall a. Show a => a -> String
show (TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CR.SCStatic TypeKind i
forall i. TypeKind i
CR.CTUndef :: CR.StorageClass i),
    Text -> Token i
forall i. Text -> Token i
TKReserved (Text -> Token i) -> Text -> Token i
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ StorageClass i -> String
forall a. Show a => a -> String
show (TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CR.SCRegister TypeKind i
forall i. TypeKind i
CR.CTUndef :: CR.StorageClass i)
    ]

-- | `TokenLCNums` is data structure for storing the line number and character number of each token
data TokenLCNums i = TokenLCNums -- ^ The constructor of `TokenLCNums`
    {
        TokenLCNums i -> i
tkLn :: !i, -- ^ line number
        TokenLCNums i -> i
tkCn :: !i -- ^ character number
    } deriving (TokenLCNums i -> TokenLCNums i -> Bool
(TokenLCNums i -> TokenLCNums i -> Bool)
-> (TokenLCNums i -> TokenLCNums i -> Bool) -> Eq (TokenLCNums i)
forall i. Eq i => TokenLCNums i -> TokenLCNums i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenLCNums i -> TokenLCNums i -> Bool
$c/= :: forall i. Eq i => TokenLCNums i -> TokenLCNums i -> Bool
== :: TokenLCNums i -> TokenLCNums i -> Bool
$c== :: forall i. Eq i => TokenLCNums i -> TokenLCNums i -> Bool
Eq, (forall x. TokenLCNums i -> Rep (TokenLCNums i) x)
-> (forall x. Rep (TokenLCNums i) x -> TokenLCNums i)
-> Generic (TokenLCNums i)
forall x. Rep (TokenLCNums i) x -> TokenLCNums i
forall x. TokenLCNums i -> Rep (TokenLCNums i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (TokenLCNums i) x -> TokenLCNums i
forall i x. TokenLCNums i -> Rep (TokenLCNums i) x
$cto :: forall i x. Rep (TokenLCNums i) x -> TokenLCNums i
$cfrom :: forall i x. TokenLCNums i -> Rep (TokenLCNums i) x
Generic, (forall a. TokenLCNums a -> Rep1 TokenLCNums a)
-> (forall a. Rep1 TokenLCNums a -> TokenLCNums a)
-> Generic1 TokenLCNums
forall a. Rep1 TokenLCNums a -> TokenLCNums a
forall a. TokenLCNums a -> Rep1 TokenLCNums a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 TokenLCNums a -> TokenLCNums a
$cfrom1 :: forall a. TokenLCNums a -> Rep1 TokenLCNums a
Generic1)

instance Show i => Show (TokenLCNums i) where
    show :: TokenLCNums i -> String
show (TokenLCNums ln :: i
ln cn :: i
cn) = i -> String
forall a. Show a => a -> String
show i
ln String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ i -> String
forall a. Show a => a -> String
show i
cn

instance NFData i => NFData (TokenLCNums i)
instance NFData1 TokenLCNums

-- | `Htcc.Tokenizer.Token.Token` and its `TokenLCNums`.
type TokenLC i = (TokenLCNums i, Token i)

{-# INLINE isTKIdent #-}
-- | Utility for `TKIdent`. When the argument is `TKIdent`, it returns `True`, otherwise `False`.
isTKIdent :: Token i -> Bool
isTKIdent :: Token i -> Bool
isTKIdent (TKIdent _) = Bool
True
isTKIdent _           = Bool
False

{-# INLINE isTKNum #-}
-- | Utility for `TKNum`. When the argument is `TKNum`, it returns `True`, otherwise `False`.
isTKNum :: Token i -> Bool
isTKNum :: Token i -> Bool
isTKNum (TKNum _) = Bool
True
isTKNum _         = Bool
False

{-# INLINE isTKReserved #-}
-- | Utility for `TKReserved`. When the argument is `TKReserved`, it returns `True`, otherwise `False`.
isTKReserved :: Token i -> Bool
isTKReserved :: Token i -> Bool
isTKReserved (TKReserved _) = Bool
True
isTKReserved _              = Bool
False

{-# INLINE isTKType #-}
-- | Utility for `TKType`. When the argument is `TKType`, it returns `True`, otherwise `False`.
isTKType :: Token i -> Bool
isTKType :: Token i -> Bool
isTKType (TKType _) = Bool
True
isTKType _          = Bool
False

{-# INLINE isTKStruct #-}
-- | Utility for `TKStruct`. When the argument is `TKStruct`, it returns `True`, otherwise `False`.
isTKStruct :: Token i -> Bool
isTKStruct :: Token i -> Bool
isTKStruct TKStruct = Bool
True
isTKStruct _        = Bool
False

{-# INLINE isTKEnum #-}
-- | Utility for `TKEnum`. When the argument is `TKEnum`, it returns `True`, otherwise `False`.
isTKEnum :: Token i -> Bool
isTKEnum :: Token i -> Bool
isTKEnum TKEnum = Bool
True
isTKEnum _      = Bool
False

{-# INLINE isTKMacro #-}
-- | Utility for `TKMacro`. When the argument is `TKMacro`, it returns `True`, otherwise `False`.
isTKMacro :: Token i -> Bool
isTKMacro :: Token i -> Bool
isTKMacro (TKMacro _ _) = Bool
True
isTKMacro _             = Bool
False

{-# INLINE isTKString #-}
-- | Utility for `TKString`. When the argument is `TKString`, it returns `True`, otherwise `False`.
isTKString :: Token i -> Bool
isTKString :: Token i -> Bool
isTKString (TKString _) = Bool
True
isTKString _            = Bool
False

-- `Htcc.Tokenizer.Token.escapeChar` converts escape characters in the input `T.Text` to correct escape characters
escapeChar :: T.Text -> T.Text
escapeChar :: Text -> Text
escapeChar xxs :: Text
xxs = case Text -> Maybe (Char, Text)
T.uncons Text
xxs of
    Just (x :: Char
x, xs :: Text
xs)
        | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\\' Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
xs) -> Text -> (Char -> Text) -> Maybe Char -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Text
escapeChar Text
xs) (Char -> Text -> Text
`T.cons` Text -> Text
escapeChar (Text -> Text
T.tail Text
xs)) (Maybe Char -> Text) -> Maybe Char -> Text
forall a b. (a -> b) -> a -> b
$ Char -> Map Char Char -> Maybe Char
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> Char
T.head Text
xs) Map Char Char
mp
        | Bool
otherwise -> Char -> Text -> Text
T.cons Char
x (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeChar Text
xs
    _ -> Text
T.empty
    where
        mp :: Map Char Char
mp = [(Char, Char)] -> Map Char Char
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
            ('\\', '\\'),
            ('a', '\a'),
            ('b', '\b'),
            ('t', '\t'),
            ('n', '\n'),
            ('v', '\v'),
            ('f', '\f'),
            ('r', '\r'),
            ('e', Int -> Char
chr 27),
            ('0', '\0')]

spanLiteral :: Char -> T.Text -> Maybe (T.Text, T.Text)
spanLiteral :: Char -> Text -> Maybe (Text, Text)
spanLiteral c :: Char
c ts :: Text
ts = (Text -> Text) -> (Text, Text) -> (Text, Text)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first Text -> Text
escapeChar ((Text, Text) -> (Text, Text))
-> Maybe (Text, Text) -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Text, Text)
f Text
ts
    where
        f :: Text -> Maybe (Text, Text)
f ts' :: Text
ts' = case Text -> Maybe (Char, Text)
T.uncons Text
ts' of
            Just (x :: Char
x, xs :: Text
xs)
                | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\\' Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
xs) Bool -> Bool -> Bool
&& Text -> Char
T.head Text
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '"' -> (Text -> Text) -> (Text, Text) -> (Text, Text)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Char -> Text -> Text
T.cons '"') ((Text, Text) -> (Text, Text))
-> Maybe (Text, Text) -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Text, Text)
f (Text -> Text
T.tail Text
xs)
                | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\\' Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
xs) Bool -> Bool -> Bool
&& Text -> Char
T.head Text
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\\' -> (Text -> Text) -> (Text, Text) -> (Text, Text)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Text -> Text -> Text
T.append "\\\\") ((Text, Text) -> (Text, Text))
-> Maybe (Text, Text) -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Text, Text)
f (Text -> Text
T.tail Text
xs)
                | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c -> (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
T.empty, Text
xs)
                | Bool
otherwise -> (Text -> Text) -> (Text, Text) -> (Text, Text)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Char -> Text -> Text
T.cons Char
x) ((Text, Text) -> (Text, Text))
-> Maybe (Text, Text) -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Text, Text)
f Text
xs
            Nothing -> Maybe (Text, Text)
forall a. Maybe a
Nothing


-- | `spanStrLiteral` separate the string literal part and the non-string literal part from the input text
spanStrLiteral :: T.Text -> Maybe (T.Text, T.Text)
spanStrLiteral :: Text -> Maybe (Text, Text)
spanStrLiteral = Char -> Text -> Maybe (Text, Text)
spanLiteral '"'


-- | `spanCharLiteral` separate the string literal part and the non-string literal part from the input text
spanCharLiteral :: T.Text -> Maybe (T.Text, T.Text)
spanCharLiteral :: Text -> Maybe (Text, Text)
spanCharLiteral = Char -> Text -> Maybe (Text, Text)
spanLiteral '\''


-- | Take the integer literal from given text.
spanIntLit :: (Eq i, Num i, Read i) => T.Text -> Maybe (Natural, Token i, T.Text)
spanIntLit :: Text -> Maybe (Natural, Token i, Text)
spanIntLit ts :: Text
ts = case Text -> Maybe (Char, Text)
T.uncons Text
ts of
    Just (x :: Char
x, xs :: Text
xs)
        | Text -> Int
T.length Text
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '0' Bool -> Bool -> Bool
&& Text -> Char
T.head Text
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== 'x' Bool -> Bool -> Bool
|| Text -> Char
T.head Text
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== 'X' -> let (ntk :: Text
ntk, ds :: Text
ds) = (Char -> Bool) -> Text -> (Text, Text)
T.span (\c :: Char
c -> Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| 'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& 'f' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
c Bool -> Bool -> Bool
|| 'A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& 'F' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
c) (Text -> Text
T.tail Text
xs) in
            (Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
ntk,,Text
ds) (Token i -> (Natural, Token i, Text))
-> (i -> Token i) -> i -> (Natural, Token i, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Token i
forall i. i -> Token i
TKNum (i -> (Natural, Token i, Text))
-> Maybe i -> Maybe (Natural, Token i, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(i, String)] -> Maybe i
forall a b. [(a, b)] -> Maybe a
sh (ReadS i
forall a. (Eq a, Num a) => ReadS a
readHex ReadS i -> ReadS i
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
ntk)
        | Text -> Int
T.length Text
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '0' Bool -> Bool -> Bool
&& Text -> Char
T.head Text
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== 'b' Bool -> Bool -> Bool
|| Text -> Char
T.head Text
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== 'B' -> let (ntk :: Text
ntk, ds :: Text
ds) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isDigit (Text -> Text
T.tail Text
xs) in
            (Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
ntk,,Text
ds) (Token i -> (Natural, Token i, Text))
-> (i -> Token i) -> i -> (Natural, Token i, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Token i
forall i. i -> Token i
TKNum (i -> (Natural, Token i, Text))
-> Maybe i -> Maybe (Natural, Token i, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(i, String)] -> Maybe i
forall a b. [(a, b)] -> Maybe a
sh (ReadS i
readBin ReadS i -> ReadS i
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
ntk)
        | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '0' Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
xs) -> let (ntk :: Text
ntk, ds :: Text
ds) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isDigit (Char
x Char -> Text -> Text
`T.cons` Text
xs) in (Natural, Token i, Text) -> Maybe (Natural, Token i, Text)
forall a. a -> Maybe a
Just (Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
ntk, i -> Token i
forall i. i -> Token i
TKNum (i -> Token i) -> i -> Token i
forall a b. (a -> b) -> a -> b
$ (i, String) -> i
forall a b. (a, b) -> a
fst ((i, String) -> i) -> (i, String) -> i
forall a b. (a -> b) -> a -> b
$ [(i, String)] -> (i, String)
forall a. [a] -> a
head ([(i, String)] -> (i, String)) -> [(i, String)] -> (i, String)
forall a b. (a -> b) -> a -> b
$ ReadS i
forall a. (Eq a, Num a) => ReadS a
readOct ReadS i -> ReadS i
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
ntk, Text
ds)
        | Char -> Bool
isDigit Char
x -> let (ntk :: Text
ntk, ds :: Text
ds) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isDigit (Char
x Char -> Text -> Text
`T.cons` Text
xs) in (Natural, Token i, Text) -> Maybe (Natural, Token i, Text)
forall a. a -> Maybe a
Just (Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
ntk, i -> Token i
forall i. i -> Token i
TKNum (i -> Token i) -> i -> Token i
forall a b. (a -> b) -> a -> b
$ (i, String) -> i
forall a b. (a, b) -> a
fst ((i, String) -> i) -> (i, String) -> i
forall a b. (a -> b) -> a -> b
$ [(i, String)] -> (i, String)
forall a. [a] -> a
head ([(i, String)] -> (i, String)) -> [(i, String)] -> (i, String)
forall a b. (a -> b) -> a -> b
$ ReadS i
forall a. (Eq a, Num a) => ReadS a
readDec ReadS i -> ReadS i
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
ntk, Text
ds)
        | Bool
otherwise -> Maybe (Natural, Token i, Text)
forall a. Maybe a
Nothing
    Nothing -> Maybe (Natural, Token i, Text)
forall a. Maybe a
Nothing
    where
        readBin :: ReadS i
readBin = i -> (Char -> Bool) -> (Char -> Int) -> ReadS i
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt 2 ([Char -> Bool] -> Char -> Bool
forall a. [a -> Bool] -> a -> Bool
lor [(Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='0'), (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='1')]) ((Char -> Int) -> ReadS i) -> (Char -> Int) -> ReadS i
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int
forall a. Num a => a -> a
negate (Char -> Int
ord '0')) (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
        sh :: [(a, b)] -> Maybe a
sh ys :: [(a, b)]
ys | [(a, b)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, b)]
ys = Maybe a
forall a. Maybe a
Nothing | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ (a, b) -> a
forall a b. (a, b) -> a
fst ((a, b) -> a) -> (a, b) -> a
forall a b. (a -> b) -> a -> b
$ [(a, b)] -> (a, b)
forall a. [a] -> a
head [(a, b)]
ys

-- | `emptyToken` is used when it cannot be referenced
emptyToken :: Num i => TokenLC i
emptyToken :: TokenLC i
emptyToken = (i -> i -> TokenLCNums i
forall i. i -> i -> TokenLCNums i
TokenLCNums 0 0, Token i
forall i. Token i
TKEmpty)

-- | `altEmptyToken` returns `emptyToken` if the first token is empty. Otherwise, returns the first token in the token sequence.
altEmptyToken :: Num i => [TokenLC i] -> TokenLC i
altEmptyToken :: [TokenLC i] -> TokenLC i
altEmptyToken []    = TokenLC i
forall i. Num i => TokenLC i
emptyToken
altEmptyToken (x :: TokenLC i
x:_) = TokenLC i
x