-- |
-- Module      :  Language.C.Parser.Tokens
-- Copyright   :  (c) 2006-2011 Harvard University
--                (c) 2011-2013 Geoffrey Mainland
--                (c) 2013 Manuel M T Chakravarty
--                (c) 2013-2016 Drexel University
-- License     :  BSD-style
-- Maintainer  :  mainland@drexel.edu

module Language.C.Parser.Tokens (
    Token(..),
    ExtensionsInt,
    keywords,
    keywordMap
  ) where

import Data.Bits
import Data.Char (isAlphaNum,
                  isLower)
import Data.List (foldl')
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.Word
import Text.PrettyPrint.Mainland
import Text.PrettyPrint.Mainland.Class

import Language.C.Syntax (Extensions(..),
                          Signed(..))

data Token = Teof
           | Tpragma String
           | Tcomment String -- ^ Raw comment string
           | TintConst (String, Signed, Integer)
           | TlongIntConst (String, Signed, Integer)
           | TlongLongIntConst (String, Signed, Integer)
           | TfloatConst (String, Float)
           | TdoubleConst (String, Double)
           | TlongDoubleConst (String, Double)
           | TcharConst (String, Char)
           | TstringConst (String, String)
           | Tidentifier String
           | Tnamed String
           | Tlparen
           | Trparen
           | Tlbrack
           | Trbrack
           | Tlbrace
           | Trbrace
           | Tcomma
           | Tsemi
           | Tcolon
           | Tquestion
           | Tdot
           | Tarrow
           | Tellipses

           | Tplus
           | Tminus
           | Tstar
           | Tdiv
           | Tmod
           | Tnot
           | Tand
           | Tor
           | Txor
           | Tlsh
           | Trsh
           | Tinc
           | Tdec

           | Tlnot
           | Tland
           | Tlor

           | Teq
           | Tne
           | Tlt
           | Tgt
           | Tle
           | Tge

           | Tassign
           | Tadd_assign
           | Tsub_assign
           | Tmul_assign
           | Tdiv_assign
           | Tmod_assign
           | Tlsh_assign
           | Trsh_assign
           | Tand_assign
           | Tor_assign
           | Txor_assign

           | Tauto
           | Tbreak
           | Tcase
           | Tchar
           | Tconst
           | Tcontinue
           | Tdefault
           | Tdo
           | Tdouble
           | Telse
           | Tenum
           | Textern
           | Tfloat
           | Tfor
           | Tgoto
           | Tif
           | Tint
           | Tlong
           | Tregister
           | Treturn
           | Tshort
           | Tsigned
           | Tsizeof
           | Tstatic
           | Tstruct
           | Tswitch
           | Ttypedef
           | Tunion
           | Tunsigned
           | Tvoid
           | Tvolatile
           | Twhile

           | Ttypename

           | Tanti_id String
           | Tanti_const String
           | Tanti_int String
           | Tanti_uint String
           | Tanti_lint String
           | Tanti_ulint String
           | Tanti_llint String
           | Tanti_ullint String
           | Tanti_float String
           | Tanti_double String
           | Tanti_long_double String
           | Tanti_char String
           | Tanti_string String
           | Tanti_exp String
           | Tanti_func String
           | Tanti_args String
           | Tanti_decl String
           | Tanti_decls String
           | Tanti_sdecl String
           | Tanti_sdecls String
           | Tanti_enum String
           | Tanti_enums String
           | Tanti_esc String
           | Tanti_escstm String
           | Tanti_edecl String
           | Tanti_edecls String
           | Tanti_item String
           | Tanti_items String
           | Tanti_stm String
           | Tanti_stms String
           | Tanti_type_qual String
           | Tanti_type_quals String
           | Tanti_type String
           | Tanti_spec String
           | Tanti_param String
           | Tanti_params String
           | Tanti_pragma String
           | Tanti_comment String
           | Tanti_init String
           | Tanti_inits String
           | Tanti_attr String
           | Tanti_attrs String

           -- C99
           | TBool
           | TComplex
           | TImaginary
           | Tinline
           | Trestrict

           -- GCC
           | Tasm
           | Tattribute
           | Tbuiltin_va_arg
           | Tbuiltin_va_list
           | Textension
           | Ttypeof
           | T__restrict

           -- CUDA
           | TCUDAmutable
           | TCUDA3lt
           | TCUDA3gt
           | TCUDAdevice
           | TCUDAglobal
           | TCUDAhost
           | TCUDAconstant
           | TCUDAshared
           | TCUDArestrict
           | TCUDAnoinline

           -- OpenCL
           | TCLprivate
           | TCLlocal
           | TCLglobal
           | TCLconstant
           | TCLreadonly
           | TCLwriteonly
           | TCLkernel

           -- Clang (currently active is Objective-C is active)
           | T__block

           -- Objective-C
           | TObjCnamed String
           | TObjCat
           | TObjCautoreleasepool
           | TObjCcatch
           | TObjCclass
           | TObjCcompatibility_alias
           | TObjCdynamic
           | TObjCencode
           | TObjCend
           | TObjCfinally
           | TObjCimplementation
           | TObjCinterface
           | TObjCNO
           | TObjCprivate
           | TObjCoptional
           | TObjCpublic
           | TObjCproperty
           | TObjCprotected
           | TObjCprotocol
           | TObjCpackage
           | TObjCrequired
           | TObjCselector
           | TObjCsynchronized
           | TObjCsynthesize
           | TObjCthrow
           | TObjCtry
           | TObjCYES
           | TObjC__weak
           | TObjC__strong
           | TObjC__unsafe_unretained

           | Tanti_objc_ifdecl String
           | Tanti_objc_ifdecls String
           | Tanti_objc_prop String
           | Tanti_objc_props String
           | Tanti_objc_prop_attr String
           | Tanti_objc_prop_attrs String
           | Tanti_objc_dicts String
           | Tanti_objc_param String
           | Tanti_objc_params String
           | Tanti_objc_method_proto String
           | Tanti_objc_method_def String
           | Tanti_objc_method_defs String
           | Tanti_objc_recv String
           | Tanti_objc_arg String
           | Tanti_objc_args String
    deriving (Eq Token
Eq Token
-> (Token -> Token -> Ordering)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Token)
-> (Token -> Token -> Token)
-> Ord Token
Token -> Token -> Bool
Token -> Token -> Ordering
Token -> Token -> Token
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Token -> Token -> Token
$cmin :: Token -> Token -> Token
max :: Token -> Token -> Token
$cmax :: Token -> Token -> Token
>= :: Token -> Token -> Bool
$c>= :: Token -> Token -> Bool
> :: Token -> Token -> Bool
$c> :: Token -> Token -> Bool
<= :: Token -> Token -> Bool
$c<= :: Token -> Token -> Bool
< :: Token -> Token -> Bool
$c< :: Token -> Token -> Bool
compare :: Token -> Token -> Ordering
$ccompare :: Token -> Token -> Ordering
$cp1Ord :: Eq Token
Ord, Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq)

instance Pretty Token where
    ppr :: Token -> Doc
ppr = String -> Doc
text (String -> Doc) -> (Token -> String) -> Token -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> String
forall a. Show a => a -> String
show

instance Show Token where
    show :: Token -> String
show Token
Teof                           = String
"EOF"
    show (Tpragma String
s)                    = String
"#pragma " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
    show (Tcomment String
s)                   = String
s
    show (TintConst (String
s, Signed
_, Integer
_))          = String
s
    show (TlongIntConst (String
s, Signed
_, Integer
_))      = String
s
    show (TlongLongIntConst (String
s, Signed
_, Integer
_))  = String
s
    show (TfloatConst (String
s, Float
_))           = String
s
    show (TdoubleConst (String
s, Double
_))          = String
s
    show (TlongDoubleConst (String
s, Double
_))      = String
s
    show (TcharConst (String
s, Char
_))            = String
s
    show (TstringConst (String
s, String
_))          = String
s
    show (Tidentifier String
s)                = String
s
    show (Tnamed String
s)                     = String
s

    show (Tanti_id String
s)                   = String -> ShowS
showAnti String
"id"  String
s
    show (Tanti_const String
s)                = String -> ShowS
showAnti String
"const"  String
s
    show (Tanti_int String
s)                  = String -> ShowS
showAnti String
"int"  String
s
    show (Tanti_uint String
s)                 = String -> ShowS
showAnti String
"uint"  String
s
    show (Tanti_lint String
s)                 = String -> ShowS
showAnti String
"lint"  String
s
    show (Tanti_ulint String
s)                = String -> ShowS
showAnti String
"ulint"  String
s
    show (Tanti_llint String
s)                = String -> ShowS
showAnti String
"llint"  String
s
    show (Tanti_ullint String
s)               = String -> ShowS
showAnti String
"ullint"  String
s
    show (Tanti_float String
s)                = String -> ShowS
showAnti String
"float"  String
s
    show (Tanti_double String
s)               = String -> ShowS
showAnti String
"double"  String
s
    show (Tanti_long_double String
s)          = String -> ShowS
showAnti String
"longdouble"  String
s
    show (Tanti_char String
s)                 = String -> ShowS
showAnti String
"char"  String
s
    show (Tanti_string String
s)               = String -> ShowS
showAnti String
"string"  String
s
    show (Tanti_exp String
s)                  = String -> ShowS
showAnti String
"exp"  String
s
    show (Tanti_func String
s)                 = String -> ShowS
showAnti String
"func"  String
s
    show (Tanti_args String
s)                 = String -> ShowS
showAnti String
"args"  String
s
    show (Tanti_decl String
s)                 = String -> ShowS
showAnti String
"decl"  String
s
    show (Tanti_decls String
s)                = String -> ShowS
showAnti String
"decls"  String
s
    show (Tanti_sdecl String
s)                = String -> ShowS
showAnti String
"sdecl"  String
s
    show (Tanti_sdecls String
s)               = String -> ShowS
showAnti String
"sdecls"  String
s
    show (Tanti_enum String
s)                 = String -> ShowS
showAnti String
"enum"  String
s
    show (Tanti_enums String
s)                = String -> ShowS
showAnti String
"enums"  String
s
    show (Tanti_esc String
s)                  = String -> ShowS
showAnti String
"esc"  String
s
    show (Tanti_escstm String
s)               = String -> ShowS
showAnti String
"escstm"  String
s
    show (Tanti_edecl String
s)                = String -> ShowS
showAnti String
"edecl"  String
s
    show (Tanti_edecls String
s)               = String -> ShowS
showAnti String
"edecls"  String
s
    show (Tanti_item String
s)                 = String -> ShowS
showAnti String
"item"  String
s
    show (Tanti_items String
s)                = String -> ShowS
showAnti String
"items"  String
s
    show (Tanti_stm String
s)                  = String -> ShowS
showAnti String
"stm"  String
s
    show (Tanti_stms String
s)                 = String -> ShowS
showAnti String
"stms"  String
s
    show (Tanti_type_quals String
s)           = String -> ShowS
showAnti String
"tyquals" String
s
    show (Tanti_type_qual String
s)            = String -> ShowS
showAnti String
"tyqual" String
s
    show (Tanti_type String
s)                 = String -> ShowS
showAnti String
"ty"  String
s
    show (Tanti_spec String
s)                 = String -> ShowS
showAnti String
"spec"  String
s
    show (Tanti_param String
s)                = String -> ShowS
showAnti String
"param"  String
s
    show (Tanti_params String
s)               = String -> ShowS
showAnti String
"params"  String
s
    show (Tanti_pragma String
s)               = String -> ShowS
showAnti String
"pragma"  String
s
    show (Tanti_comment String
s)              = String -> ShowS
showAnti String
"comment"  String
s
    show (Tanti_init String
s)                 = String -> ShowS
showAnti String
"init"  String
s
    show (Tanti_inits String
s)                = String -> ShowS
showAnti String
"inits"  String
s
    show (Tanti_attr String
s)                 = String -> ShowS
showAnti String
"attr"  String
s
    show (Tanti_attrs String
s)                = String -> ShowS
showAnti String
"attrs"  String
s

    --
    -- Objective C
    --
    show (TObjCnamed String
s)              = String
s

    show (Tanti_objc_ifdecl String
s)       = String -> ShowS
showAnti String
"ifdecl" String
s
    show (Tanti_objc_ifdecls String
s)      = String -> ShowS
showAnti String
"ifdecls" String
s
    show (Tanti_objc_prop String
s)         = String -> ShowS
showAnti String
"prop" String
s
    show (Tanti_objc_props String
s)        = String -> ShowS
showAnti String
"props" String
s
    show (Tanti_objc_prop_attr String
s)    = String -> ShowS
showAnti String
"propattr" String
s
    show (Tanti_objc_prop_attrs String
s)   = String -> ShowS
showAnti String
"propattrs" String
s
    show (Tanti_objc_dicts String
s)        = String -> ShowS
showAnti String
"dictelems" String
s
    show (Tanti_objc_param String
s)        = String -> ShowS
showAnti String
"methparam" String
s
    show (Tanti_objc_params String
s)       = String -> ShowS
showAnti String
"methparams" String
s
    show (Tanti_objc_method_proto String
s) = String -> ShowS
showAnti String
"methproto" String
s
    show (Tanti_objc_method_def String
s)   = String -> ShowS
showAnti String
"methdef" String
s
    show (Tanti_objc_method_defs String
s)  = String -> ShowS
showAnti String
"methdefs" String
s
    show (Tanti_objc_recv String
s)         = String -> ShowS
showAnti String
"recv" String
s
    show (Tanti_objc_arg String
s)          = String -> ShowS
showAnti String
"kwarg" String
s
    show (Tanti_objc_args String
s)         = String -> ShowS
showAnti String
"kwargs" String
s

    show Token
t = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (ShowS
forall a. HasCallStack => String -> a
error String
"language-c-quote: internal error: unknown token")
                       (Token -> [(Token, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Token
t [(Token, String)]
tokenStrings)

showAnti :: String -> String -> String
showAnti :: String -> ShowS
showAnti String
anti String
s =
    String
"$" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
anti String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    if String -> Bool
isIdentifier String
s then String
s else String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  where
    isIdentifier :: String -> Bool
    isIdentifier :: String -> Bool
isIdentifier []       = Bool
False
    isIdentifier (Char
'_':String
cs) = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isIdChar String
cs
    isIdentifier (Char
c:String
cs)   = Char -> Bool
isLower Char
c Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isIdChar String
cs

    isIdChar :: Char -> Bool
    isIdChar :: Char -> Bool
isIdChar Char
'_' = Bool
True
    isIdChar Char
c   = Char -> Bool
isAlphaNum Char
c

tokenStrings :: [(Token, String)]
tokenStrings :: [(Token, String)]
tokenStrings = [(Token
Tlparen,     String
"("),
                (Token
Trparen,     String
")"),
                (Token
Tlbrack,     String
"["),
                (Token
Trbrack,     String
"]"),
                (Token
Tlbrace,     String
"{"),
                (Token
Trbrace,     String
"}"),
                (Token
Tcomma,      String
","),
                (Token
Tsemi,       String
";"),
                (Token
Tcolon,      String
":"),
                (Token
Tquestion,   String
"?"),
                (Token
Tdot,        String
"."),
                (Token
Tarrow,      String
"->"),
                (Token
Tellipses,   String
"..."),
                (Token
Tplus,       String
"+"),
                (Token
Tminus,      String
"-"),
                (Token
Tstar,       String
"*"),
                (Token
Tdiv,        String
"/"),
                (Token
Tmod,        String
"%"),
                (Token
Tnot,        String
"~"),
                (Token
Tand,        String
"&"),
                (Token
Tor,         String
"|"),
                (Token
Txor,        String
"^"),
                (Token
Tlsh,        String
"<<"),
                (Token
Trsh,        String
">>"),
                (Token
Tinc,        String
"++"),
                (Token
Tdec,        String
"--"),
                (Token
Tlnot,       String
"!"),
                (Token
Tland,       String
"&&"),
                (Token
Tlor,        String
"||"),
                (Token
Teq,         String
"=="),
                (Token
Tne,         String
"!="),
                (Token
Tlt,         String
"<"),
                (Token
Tgt,         String
">"),
                (Token
Tle,         String
"<="),
                (Token
Tge,         String
">="),
                (Token
Tassign,     String
"="),
                (Token
Tadd_assign, String
"+="),
                (Token
Tsub_assign, String
"-="),
                (Token
Tmul_assign, String
"*="),
                (Token
Tdiv_assign, String
"/="),
                (Token
Tmod_assign, String
"%="),
                (Token
Tlsh_assign, String
"<<="),
                (Token
Trsh_assign, String
">>="),
                (Token
Tand_assign, String
"&="),
                (Token
Tor_assign,  String
"|="),
                (Token
Txor_assign, String
"^="),

                --
                -- Keywords
                --
                (Token
Tauto,      String
"auto"),
                (Token
Tbreak,     String
"break"),
                (Token
Tcase,      String
"case"),
                (Token
Tchar,      String
"char"),
                (Token
Tconst,     String
"const"),
                (Token
Tcontinue,  String
"continue"),
                (Token
Tdefault,   String
"default"),
                (Token
Tdo,        String
"do"),
                (Token
Tdouble,    String
"double"),
                (Token
Telse,      String
"else"),
                (Token
Tenum,      String
"enum"),
                (Token
Textern,    String
"extern"),
                (Token
Tfloat,     String
"float"),
                (Token
Tfor,       String
"for"),
                (Token
Tgoto,      String
"goto"),
                (Token
Tif,        String
"if"),
                (Token
Tint,       String
"int"),
                (Token
Tlong,      String
"long"),
                (Token
Tregister,  String
"register"),
                (Token
Treturn,    String
"return"),
                (Token
Tshort,     String
"short"),
                (Token
Tsigned,    String
"signed"),
                (Token
Tsizeof,    String
"sizeof"),
                (Token
Tstatic,    String
"static"),
                (Token
Tstruct,    String
"struct"),
                (Token
Tswitch,    String
"switch"),
                (Token
Ttypedef,   String
"typedef"),
                (Token
Tunion,     String
"union"),
                (Token
Tunsigned,  String
"unsigned"),
                (Token
Tvoid,      String
"void"),
                (Token
Tvolatile,  String
"volatile"),
                (Token
Twhile,     String
"while"),

                (Token
Ttypename,  String
"typename"),

                --
                -- C99 extensions
                --
                (Token
TBool,      String
"_Bool"),
                (Token
TComplex,   String
"_TComplex"),
                (Token
TImaginary, String
"_TImaginary"),
                (Token
Tinline,    String
"inline"),
                (Token
Trestrict,  String
"restrict"),

                --
                -- GCC extensions
                --
                (Token
Tasm,             String
"asm"),
                (Token
Tattribute,       String
"__attribute__"),
                (Token
Tbuiltin_va_arg,  String
"__builtin_va_arg"),
                (Token
Tbuiltin_va_list, String
"__builtin_va_list"),
                (Token
Textension,       String
"__extension__"),
                (Token
Ttypeof,          String
"typeof"),
                (Token
T__restrict,      String
"__restrict"),

                --
                -- Clang extensions
                --
                (Token
T__block , String
"__block"),

                --
                -- Objective-C extensions
                --
                (Token
TObjCat                   , String
"@"),
                (Token
TObjCautoreleasepool      , String
"autoreleasepool"),
                (Token
TObjCcatch                , String
"catch"),
                (Token
TObjCclass                , String
"class"),
                (Token
TObjCcompatibility_alias  , String
"compatibility_alias"),
                (Token
TObjCdynamic              , String
"dynamic"),
                (Token
TObjCencode               , String
"encode"),
                (Token
TObjCend                  , String
"end"),
                (Token
TObjCfinally              , String
"finally"),
                (Token
TObjCimplementation       , String
"implementation"),
                (Token
TObjCinterface            , String
"interface"),
                (Token
TObjCNO                   , String
"NO"),
                (Token
TObjCoptional             , String
"optional"),
                (Token
TObjCprivate              , String
"private"),
                (Token
TObjCpublic               , String
"public"),
                (Token
TObjCproperty             , String
"property"),
                (Token
TObjCprotected            , String
"protected"),
                (Token
TObjCprotocol             , String
"protocol"),
                (Token
TObjCpackage              , String
"package"),
                (Token
TObjCrequired             , String
"required"),
                (Token
TObjCselector             , String
"selector"),
                (Token
TObjCsynchronized         , String
"synchronized"),
                (Token
TObjCsynthesize           , String
"synthesize"),
                (Token
TObjCthrow                , String
"throw"),
                (Token
TObjCtry                  , String
"try"),
                (Token
TObjCYES                  , String
"YES"),
                (Token
TObjC__weak               , String
"__weak"),
                (Token
TObjC__strong             , String
"__strong"),
                (Token
TObjC__unsafe_unretained  , String
"__unsafe_unretained"),

                --
                -- CUDA extensions
                --
                (Token
TCUDAmutable,  String
"mutable"),
                (Token
TCUDAdevice,   String
"__device__"),
                (Token
TCUDAglobal,   String
"__global__"),
                (Token
TCUDAhost,     String
"__host__"),
                (Token
TCUDAconstant, String
"__constant__"),
                (Token
TCUDAshared,   String
"__shared__"),
                (Token
TCUDArestrict, String
"__restrict__"),
                (Token
TCUDAnoinline, String
"__noinline__"),

                --
                -- OpenCL extensions
                --
                (Token
TCLprivate,   String
"private"),    -- must be without '__' prefix for Objective-C
                (Token
TCLlocal,     String
"__local"),
                (Token
TCLglobal,    String
"__global"),
                (Token
TCLconstant,  String
"__constant"),
                (Token
TCLreadonly,  String
"read_only"),
                (Token
TCLwriteonly, String
"write_only"),
                (Token
TCLkernel,    String
"__kernel")
                ]

keywords :: [(String,      Token,      Maybe [Extensions])]
keywords :: [(String, Token, Maybe [Extensions])]
keywords = [(String
"auto",       Token
Tauto,      Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"break",      Token
Tbreak,     Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"case",       Token
Tcase,      Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"char",       Token
Tchar,      Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"const",      Token
Tconst,     Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"continue",   Token
Tcontinue,  Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"default",    Token
Tdefault,   Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"do",         Token
Tdo,        Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"double",     Token
Tdouble,    Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"else",       Token
Telse,      Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"enum",       Token
Tenum,      Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"extern",     Token
Textern,    Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"float",      Token
Tfloat,     Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"for",        Token
Tfor,       Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"goto",       Token
Tgoto,      Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"if",         Token
Tif,        Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"int",        Token
Tint,       Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"long",       Token
Tlong,      Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"register",   Token
Tregister,  Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"return",     Token
Treturn,    Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"short",      Token
Tshort,     Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"signed",     Token
Tsigned,    Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"sizeof",     Token
Tsizeof,    Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"static",     Token
Tstatic,    Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"struct",     Token
Tstruct,    Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"switch",     Token
Tswitch,    Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"typedef",    Token
Ttypedef,   Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"union",      Token
Tunion,     Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"unsigned",   Token
Tunsigned,  Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"void",       Token
Tvoid,      Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"volatile",   Token
Tvolatile,  Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"while",      Token
Twhile,     Maybe [Extensions]
forall a. Maybe a
Nothing),

            --
            -- C99
            --
            (String
"_Bool",      Token
TBool,      Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"_Complex",   Token
TComplex,   Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"_Imaginary", Token
TImaginary, Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"inline",     Token
Tinline,    Maybe [Extensions]
forall a. Maybe a
Nothing),
            (String
"restrict",   Token
Trestrict,  Maybe [Extensions]
forall a. Maybe a
Nothing),

            --
            -- GCC
            --
            (String
"asm",               Token
Tasm,             [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
Gcc]),
            (String
"__asm",             Token
Tasm,             [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
Gcc]),
            (String
"__asm__",           Token
Tasm,             [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
Gcc]),
            (String
"__attribute__",     Token
Tattribute,       [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
Gcc]),
            (String
"__builtin_va_arg",  Token
Tbuiltin_va_arg,  [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
Gcc]),
            (String
"__builtin_va_list", Token
Tbuiltin_va_list, [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
Gcc]),
            (String
"__const",           Token
Tconst,           [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
Gcc]),
            (String
"__const__",         Token
Tconst,           [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
Gcc]),
            (String
"__inline",          Token
Tinline,          [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
Gcc]),
            (String
"__inline__",        Token
Tinline,          [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
Gcc]),
            (String
"__restrict",        Token
T__restrict,      [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
Gcc]),
            (String
"__restrict__",      Token
T__restrict,      [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
Gcc]),
            (String
"typeof",            Token
Ttypeof,          [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
Gcc]),
            (String
"__typeof",          Token
Ttypeof,          [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
Gcc]),
            (String
"__typeof__",        Token
Ttypeof,          [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
Gcc]),
            (String
"__volatile",        Token
Tvolatile,        [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
Gcc]),
            (String
"__volatile__",      Token
Tvolatile,        [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
Gcc]),

            --
            -- Clang blocks
            --
            (String
"__block", Token
T__block, [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
Blocks, Extensions
ObjC]),

            --
            -- Objective-C
            --
            (String
"autoreleasepool",     Token
TObjCautoreleasepool,     [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"catch",               Token
TObjCcatch,               [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"class",               Token
TObjCclass,               [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"compatibility_alias", Token
TObjCcompatibility_alias, [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"dynamic",             Token
TObjCdynamic,             [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"encode",              Token
TObjCencode,              [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"end",                 Token
TObjCend,                 [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"finally",             Token
TObjCfinally,             [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"implementation",      Token
TObjCimplementation,      [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"interface",           Token
TObjCinterface,           [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"NO",                  Token
TObjCNO,                  [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"optional",            Token
TObjCoptional,            [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"public",              Token
TObjCpublic,              [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"property",            Token
TObjCproperty,            [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"protected",           Token
TObjCprotected,           [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"package",             Token
TObjCpackage,             [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"protocol",            Token
TObjCprotocol,            [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"required",            Token
TObjCrequired,            [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"selector",            Token
TObjCselector,            [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"synchronized",        Token
TObjCsynchronized,        [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"synthesize",          Token
TObjCsynthesize,          [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"throw",               Token
TObjCthrow,               [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"try",                 Token
TObjCtry,                 [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"YES",                 Token
TObjCYES,                 [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"__weak",              Token
TObjC__weak,              [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"__strong",            Token
TObjC__strong,            [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),
            (String
"__unsafe_unretained", Token
TObjC__unsafe_unretained, [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
ObjC]),

            --
            -- CUDA
            --
            (String
"mutable",      Token
TCUDAmutable,  [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
CUDA]),
            (String
"__device__",   Token
TCUDAdevice,   [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
CUDA]),
            (String
"__global__",   Token
TCUDAglobal,   [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
CUDA]),
            (String
"__host__",     Token
TCUDAhost,     [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
CUDA]),
            (String
"__constant__", Token
TCUDAconstant, [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
CUDA]),
            (String
"__shared__",   Token
TCUDAshared,   [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
CUDA]),
            (String
"__restrict__", Token
TCUDArestrict, [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
CUDA]),
            (String
"__noinline__", Token
TCUDAnoinline, [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
CUDA]),

            --
            -- OpenCL
            --
            (String
"private",      Token
TCLprivate,   [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
OpenCL, Extensions
ObjC]),  -- see Lexer.identifier for 'TObjCprivate'
            (String
"__private",    Token
TCLprivate,   [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
OpenCL]),
            (String
"local",        Token
TCLlocal,     [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
OpenCL]),
            (String
"__local",      Token
TCLlocal,     [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
OpenCL]),
            (String
"global",       Token
TCLglobal,    [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
OpenCL]),
            (String
"__global",     Token
TCLglobal,    [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
OpenCL]),
            (String
"constant",     Token
TCLconstant,  [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
OpenCL]),
            (String
"__constant",   Token
TCLconstant,  [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
OpenCL]),
            (String
"read_only",    Token
TCLreadonly,  [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
OpenCL]),
            (String
"__read_only",  Token
TCLreadonly,  [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
OpenCL]),
            (String
"write_only",   Token
TCLwriteonly, [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
OpenCL]),
            (String
"__write_only", Token
TCLwriteonly, [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
OpenCL]),
            (String
"kernel",       Token
TCLkernel,    [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
OpenCL]),
            (String
"__kernel",     Token
TCLkernel,    [Extensions] -> Maybe [Extensions]
forall a. a -> Maybe a
Just [Extensions
OpenCL])
           ]

type ExtensionsInt = Word32

keywordMap :: Map.Map String (Token, Maybe ExtensionsInt)
keywordMap :: Map String (Token, Maybe ExtensionsInt)
keywordMap = [(String, (Token, Maybe ExtensionsInt))]
-> Map String (Token, Maybe ExtensionsInt)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (((String, Token, Maybe [Extensions])
 -> (String, (Token, Maybe ExtensionsInt)))
-> [(String, Token, Maybe [Extensions])]
-> [(String, (Token, Maybe ExtensionsInt))]
forall a b. (a -> b) -> [a] -> [b]
map (String, Token, Maybe [Extensions])
-> (String, (Token, Maybe ExtensionsInt))
f [(String, Token, Maybe [Extensions])]
keywords)
  where
    f  ::  (String, Token, Maybe [Extensions])
       ->  (String, (Token, Maybe ExtensionsInt))
    f :: (String, Token, Maybe [Extensions])
-> (String, (Token, Maybe ExtensionsInt))
f (String
s, Token
t, Maybe [Extensions]
Nothing)    = (String
s, (Token
t, Maybe ExtensionsInt
forall a. Maybe a
Nothing))
    f (String
s, Token
t, Just [Extensions]
exts)  = (String
s, (Token
t, ExtensionsInt -> Maybe ExtensionsInt
forall a. a -> Maybe a
Just ExtensionsInt
i))
      where
        i :: ExtensionsInt
i = (ExtensionsInt -> Int -> ExtensionsInt)
-> ExtensionsInt -> [Int] -> ExtensionsInt
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ExtensionsInt -> Int -> ExtensionsInt
forall a. Bits a => a -> Int -> a
setBit ExtensionsInt
0 ((Extensions -> Int) -> [Extensions] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Extensions -> Int
forall a. Enum a => a -> Int
fromEnum [Extensions]
exts)