-- | -- Module : Language.C.Parser.Tokens -- Copyright : (c) Harvard University 2006-2011 -- (c) Geoffrey Mainland 2011-2012 -- License : BSD-style -- Maintainer : mainland@eecs.harvard.edu module Language.C.Parser.Tokens ( Token(..), ExtensionsInt, keywords, keywordMap ) where import Data.Bits import Data.List (foldl') import qualified Data.Map as Map import Data.Maybe (fromMaybe) import Data.Word import Text.PrettyPrint.Mainland import Language.C.Syntax (Extensions(..), Signed(..)) data Token = Teof | Tpragma String | TintConst (String, Signed, Integer) | TlongIntConst (String, Signed, Integer) | TlongLongIntConst (String, Signed, Integer) | TfloatConst (String, Rational) | TdoubleConst (String, Rational) | TlongDoubleConst (String, Rational) | 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 | Tinline | Tint | Tlong | Tregister | Trestrict | Treturn | Tshort | Tsigned | Tsizeof | Tstatic | Tstruct | Tswitch | Ttypedef | Tunion | Tunsigned | Tvoid | Tvolatile | Twhile | TBool | TComplex | TImaginary -- GCC | Tasm | Tattribute | Tbuiltin_va_arg | Tbuiltin_va_list | Textension | Ttypeof -- CUDA | TCUDA3lt | TCUDA3gt | TCUDAdevice | TCUDAglobal | TCUDAhost | TCUDAconstant | TCUDAshared | TCUDAnoinline -- OpenCL | TCLprivate | TCLlocal | TCLglobal | TCLconstant | TCLreadonly | TCLwriteonly | TCLkernel -- Antiquoting | Ttypename | Tanti_id 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_edecl String | Tanti_edecls String | Tanti_item String | Tanti_items String | Tanti_stm String | Tanti_stms String | Tanti_type String | Tanti_spec String | Tanti_param String | Tanti_params String | Tanti_pragma String deriving (Ord, Eq) instance Pretty Token where ppr = text . show instance Show Token where show Teof = "EOF" show (Tpragma s) = "#pragma " ++ s show (TintConst (s, _, _)) = s show (TlongIntConst (s, _, _)) = s show (TlongLongIntConst (s, _, _)) = s show (TfloatConst (s, _)) = s show (TdoubleConst (s, _)) = s show (TlongDoubleConst (s, _)) = s show (TcharConst (s, _)) = s show (TstringConst (s, _)) = s show (Tidentifier s) = s show t = fromMaybe (error "internal error: unknown token") (lookup t tokenStrings) tokenStrings :: [(Token, String)] tokenStrings = [(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, "^="), -- -- Keywords -- (Tauto, "auto"), (Tbreak, "break"), (Tcase, "case"), (Tchar, "char"), (Tconst, "const"), (Tcontinue, "continue"), (Tdefault, "default"), (Tdo, "do"), (Tdouble, "double"), (Telse, "else"), (Tenum, "enum"), (Textern, "extern"), (Tfloat, "float"), (Tfor, "for"), (Tgoto, "goto"), (Tif, "if"), (Tinline, "inline"), (Tint, "int"), (Tlong, "long"), (Tregister, "register"), (Trestrict, "restrict"), (Treturn, "return"), (Tshort, "short"), (Tsigned, "signed"), (Tsizeof, "sizeof"), (Tstatic, "static"), (Tstruct, "struct"), (Tswitch, "switch"), (Ttypedef, "typedef"), (Tunion, "union"), (Tunsigned, "unsigned"), (Tvoid, "void"), (Tvolatile, "volatile"), (Twhile, "while"), (TBool, "_Bool"), (TComplex, "_TComplex"), (TImaginary, "_TImaginary"), -- -- GCC extensions -- (Tasm, "asm"), (Tattribute, "__attribute__"), (Tbuiltin_va_arg, "__builtin_va_arg"), (Tbuiltin_va_list, "__builtin_va_list"), (Textension, "__extension__"), (Ttypeof, "typeof"), -- -- CUDA extensions -- (TCUDAdevice, "__device__"), (TCUDAglobal, "__global__"), (TCUDAhost, "__host__"), (TCUDAconstant, "__constant__"), (TCUDAshared, "__shared__"), (TCUDAnoinline, "__noinline__"), -- -- OpenCL extensions -- (TCLprivate, "__private"), (TCLlocal, "__local"), (TCLglobal, "__global"), (TCLconstant, "__constant"), (TCLreadonly, "read_only"), (TCLwriteonly, "write_only"), (TCLkernel, "__kernel") ] keywords :: [(String, Token, Maybe [Extensions])] keywords = [("auto", Tauto, Nothing), ("break", Tbreak, Nothing), ("case", Tcase, Nothing), ("char", Tchar, Nothing), ("const", Tconst, Nothing), ("continue", Tcontinue, Nothing), ("default", Tdefault, Nothing), ("do", Tdo, Nothing), ("double", Tdouble, Nothing), ("else", Telse, Nothing), ("enum", Tenum, Nothing), ("extern", Textern, Nothing), ("float", Tfloat, Nothing), ("for", Tfor, Nothing), ("goto", Tgoto, Nothing), ("if", Tif, Nothing), ("inline", Tinline, Nothing), ("int", Tint, Nothing), ("long", Tlong, Nothing), ("register", Tregister, Nothing), ("restrict", Trestrict, Nothing), ("return", Treturn, Nothing), ("short", Tshort, Nothing), ("signed", Tsigned, Nothing), ("sizeof", Tsizeof, Nothing), ("static", Tstatic, Nothing), ("struct", Tstruct, Nothing), ("switch", Tswitch, Nothing), ("typedef", Ttypedef, Nothing), ("union", Tunion, Nothing), ("unsigned", Tunsigned, Nothing), ("void", Tvoid, Nothing), ("volatile", Tvolatile, Nothing), ("while", Twhile, Nothing), ("_Bool", TBool, Nothing), ("_Complex", TComplex, Nothing), ("_Imaginary", TImaginary, Nothing), ("asm", Tasm, Just [Gcc]), ("__asm", Tasm, Just [Gcc]), ("__asm__", Tasm, Just [Gcc]), ("__attribute__", Tattribute, Just [Gcc]), ("__builtin_va_arg", Tbuiltin_va_arg, Just [Gcc]), ("__builtin_va_list", Tbuiltin_va_list, Just [Gcc]), ("__const", Tconst, Just [Gcc]), ("__const__", Tconst, Just [Gcc]), ("__inline", Tinline, Just [Gcc]), ("__inline__", Tinline, Just [Gcc]), ("__restrict", Trestrict, Just [Gcc]), ("__restrict__", Trestrict, Just [Gcc]), ("typeof", Ttypeof, Just [Gcc]), ("__typeof", Ttypeof, Just [Gcc]), ("__typeof__", Ttypeof, Just [Gcc]), ("__volatile", Tvolatile, Just [Gcc]), ("__volatile__", Tvolatile, Just [Gcc]), ("__device__", TCUDAdevice, Just [CUDA]), ("__global__", TCUDAglobal, Just [CUDA]), ("__host__", TCUDAhost, Just [CUDA]), ("__constant__", TCUDAconstant, Just [CUDA]), ("__shared__", TCUDAshared, Just [CUDA]), ("__noinline__", TCUDAnoinline, Just [CUDA]), ("private", TCLprivate, Just [OpenCL]), ("__private", TCLprivate, Just [OpenCL]), ("local", TCLlocal, Just [OpenCL]), ("__local", TCLlocal, Just [OpenCL]), ("global", TCLglobal, Just [OpenCL]), ("__global", TCLglobal, Just [OpenCL]), ("constant", TCLconstant, Just [OpenCL]), ("__constant", TCLconstant, Just [OpenCL]), ("read_only", TCLreadonly, Just [OpenCL]), ("__read_only", TCLreadonly, Just [OpenCL]), ("write_only", TCLwriteonly, Just [OpenCL]), ("__write_only", TCLwriteonly, Just [OpenCL]), ("kernel", TCLkernel, Just [OpenCL]), ("__kernel", TCLkernel, Just [OpenCL]) ] type ExtensionsInt = Word32 keywordMap :: Map.Map String (Token, Maybe ExtensionsInt) keywordMap = Map.fromList (map f keywords) where f :: (String, Token, Maybe [Extensions]) -> (String, (Token, Maybe ExtensionsInt)) f (s, t, Nothing) = (s, (t, Nothing)) f (s, t, Just exts) = (s, (t, Just i)) where i = foldl' setBit 0 (map fromEnum exts)