{-# OPTIONS  #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Language.C.Parser.Tokens
-- Copyright   :  [1999..2004] Manuel M T Chakravarty
--                2005 Duncan Coutts
-- License     :  BSD-style
-- Maintainer  :  benedikt.huber@gmail.com
-- Portability :  portable
--
--  C Tokens for the C lexer.
--
-----------------------------------------------------------------------------
module Language.C.Parser.Tokens (CToken(..), posLenOfTok, GnuCTok(..), ClangCTok(..)) where

import Language.C.Data.Position    (Position, Pos(..), PosLength)
import Language.C.Data.Ident       (Ident, identToString)
import Language.C.Syntax.Constants (CChar, CInteger, CFloat, CString, ClangCVersion)

-- token definition
-- ----------------

-- possible tokens (EXPORTED)
--
data CToken = CTokLParen   !PosLength            -- `('
            | CTokRParen   !PosLength            -- `)'
            | CTokLBracket !PosLength            -- `['
            | CTokRBracket !PosLength            -- `]'
            | CTokArrow    !PosLength            -- `->'
            | CTokDot      !PosLength            -- `.'
            | CTokExclam   !PosLength            -- `!'
            | CTokTilde    !PosLength            -- `~'
            | CTokInc      !PosLength            -- `++'
            | CTokDec      !PosLength            -- `--'
            | CTokPlus     !PosLength            -- `+'
            | CTokMinus    !PosLength            -- `-'
            | CTokStar     !PosLength            -- `*'
            | CTokSlash    !PosLength            -- `/'
            | CTokPercent  !PosLength            -- `%'
            | CTokAmper    !PosLength            -- `&'
            | CTokShiftL   !PosLength            -- `<<'
            | CTokShiftR   !PosLength            -- `>>'
            | CTokLess     !PosLength            -- `<'
            | CTokLessEq   !PosLength            -- `<='
            | CTokHigh     !PosLength            -- `>'
            | CTokHighEq   !PosLength            -- `>='
            | CTokEqual    !PosLength            -- `=='
            | CTokUnequal  !PosLength            -- `!='
            | CTokHat      !PosLength            -- `^'
            | CTokBar      !PosLength            -- `|'
            | CTokAnd      !PosLength            -- `&&'
            | CTokOr       !PosLength            -- `||'
            | CTokQuest    !PosLength            -- `?'
            | CTokColon    !PosLength            -- `:'
            | CTokAssign   !PosLength            -- `='
            | CTokPlusAss  !PosLength            -- `+='
            | CTokMinusAss !PosLength            -- `-='
            | CTokStarAss  !PosLength            -- `*='
            | CTokSlashAss !PosLength            -- `/='
            | CTokPercAss  !PosLength            -- `%='
            | CTokAmpAss   !PosLength            -- `&='
            | CTokHatAss   !PosLength            -- `^='
            | CTokBarAss   !PosLength            -- `|='
            | CTokSLAss    !PosLength            -- `<<='
            | CTokSRAss    !PosLength            -- `>>='
            | CTokComma    !PosLength            -- `,'
            | CTokSemic    !PosLength            -- `;'
            | CTokLBrace   !PosLength            -- `{'
            | CTokRBrace   !PosLength            -- `}'
            | CTokEllipsis !PosLength            -- `...'
            | CTokAlignof  !PosLength            -- `alignof'
                                                -- (or `__alignof',
                                                -- `__alignof__')
            | CTokAlignas  !PosLength            -- `_Alignas'
            | CTokAsm      !PosLength            -- `asm'
                                                -- (or `__asm',
                                                -- `__asm__')
            | CTokAtomic   !PosLength            -- `_Atomic'
            | CTokAuto     !PosLength            -- `auto'
            | CTokBreak    !PosLength            -- `break'
            | CTokBool     !PosLength            -- `_Bool'
            | CTokCase     !PosLength            -- `case'
            | CTokChar     !PosLength            -- `char'
            | CTokConst    !PosLength            -- `const'
                                                -- (or `__const', `__const__')
            | CTokContinue !PosLength            -- `continue'
            | CTokComplex  !PosLength            -- `_Complex'
            | CTokDefault  !PosLength            -- `default'
            | CTokDo       !PosLength            -- `do'
            | CTokDouble   !PosLength            -- `double'
            | CTokElse     !PosLength            -- `else'
            | CTokEnum     !PosLength            -- `enum'
            | CTokExtern   !PosLength            -- `extern'
            | CTokFloat    !PosLength            -- `float'
            | CTokFloatN !Int !Bool !PosLength   -- `__float128' or `_Float{32,64,128}{,x}`
            | CTokFor      !PosLength            -- `for'
            | CTokGeneric  !PosLength            -- `_Generic'
            | CTokGoto     !PosLength            -- `goto'
            | CTokIf       !PosLength            -- `if'
            | CTokInline   !PosLength            -- `inline'
                                                -- (or `__inline',
                                                -- `__inline__')
            | CTokInt      !PosLength            -- `int'
            | CTokInt128   !PosLength            -- `__int128`
            | CTokLong     !PosLength            -- `long'
            | CTokLabel    !PosLength            -- `__label__
            | CTokNoreturn !PosLength            -- `_Noreturn'
            | CTokNullable !PosLength            -- `_Nullable'
            | CTokNonnull  !PosLength            -- `_Nonnull'
            | CTokRegister !PosLength            -- `register'
            | CTokRestrict !PosLength            -- `restrict'
                                                -- (or `__restrict',
                                                -- `__restrict__')
            | CTokReturn   !PosLength            -- `return'
            | CTokShort    !PosLength            -- `short'
            | CTokSigned   !PosLength            -- `signed'
                                                -- (or `__signed',
                                                -- `__signed__')
            | CTokSizeof   !PosLength            -- `sizeof'
            | CTokStatic   !PosLength            -- `static'
            | CTokStaticAssert !PosLength        -- `_Static_assert'
            | CTokStruct   !PosLength            -- `struct'
            | CTokSwitch   !PosLength            -- `switch'
            | CTokTypedef  !PosLength            -- `typedef'
            | CTokTypeof   !PosLength            -- `typeof'
            | CTokThread   !PosLength            -- `__thread'
            | CTokUnion    !PosLength            -- `union'
            | CTokUnsigned !PosLength            -- `unsigned'
            | CTokVoid     !PosLength            -- `void'
            | CTokVolatile !PosLength            -- `volatile'
                                                -- (or `__volatile',
                                                -- `__volatile__')
            | CTokWhile    !PosLength            -- `while'
            | CTokCLit     !PosLength !CChar     -- character constant
            | CTokILit     !PosLength !CInteger  -- integer constant
            | CTokFLit     !PosLength CFloat     -- float constant
            | CTokSLit     !PosLength CString    -- string constant
            | CTokIdent    !PosLength !Ident     -- identifier

              -- not generated here, but in `CParser.parseCHeader'
            | CTokTyIdent  !PosLength !Ident     -- `typedef-name' identifier
            | CTokGnuC !GnuCTok !PosLength       -- special GNU C tokens
            | CTokClangC !PosLength !ClangCTok   -- special Clang C tokens
            | CTokClKernel !PosLength            -- OpenCL `__kernel'
            | CTokClRdOnly !PosLength            -- OpenCL `__read_only'
            | CTokClWrOnly !PosLength            -- OpenCL `__write_only'
            | CTokClGlobal !PosLength            -- OpenCL `__Global'
            | CTokClLocal  !PosLength            -- OpenCL `__Local'
            | CTokEof                           -- end of file

-- special tokens used in GNU C extensions to ANSI C
--
data GnuCTok = GnuCAttrTok              -- `__attribute__'
             | GnuCExtTok               -- `__extension__'
             | GnuCVaArg                -- `__builtin_va_arg'
             | GnuCOffsetof             -- `__builtin_offsetof'
             | GnuCTyCompat             -- `__builtin_types_compatible_p'
             | GnuCComplexReal          -- `__real__'
             | GnuCComplexImag          -- `__imag__'

data ClangCTok = ClangCVersionTok !ClangCVersion -- version constant from 'availability' attribute
               | ClangBuiltinConvertVector

instance Pos CToken where
  posOf :: CToken -> Position
posOf = (Position, Int) -> Position
forall a b. (a, b) -> a
fst ((Position, Int) -> Position)
-> (CToken -> (Position, Int)) -> CToken -> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CToken -> (Position, Int)
posLenOfTok

-- token position and length
posLenOfTok :: CToken -> (Position,Int)
posLenOfTok :: CToken -> (Position, Int)
posLenOfTok (CTokLParen   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokRParen   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokLBracket pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokRBracket pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokArrow    pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokDot      pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokExclam   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokTilde    pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokInc      pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokDec      pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokPlus     pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokMinus    pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokStar     pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokSlash    pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokPercent  pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokAmper    pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokShiftL   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokShiftR   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokLess     pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokLessEq   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokHigh     pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokHighEq   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokEqual    pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokUnequal  pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokHat      pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokBar      pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokAnd      pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokOr       pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokQuest    pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokColon    pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokAssign   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokPlusAss  pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokMinusAss pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokStarAss  pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokSlashAss pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokPercAss  pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokAmpAss   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokHatAss   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokBarAss   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokSLAss    pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokSRAss    pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokComma    pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokSemic    pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokLBrace   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokRBrace   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokEllipsis pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokAlignof  pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokAlignas  pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokAsm      pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokAtomic   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokAuto     pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokBreak    pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokBool     pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokCase     pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokChar     pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokConst    pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokContinue pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokComplex  pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokDefault  pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokDo       pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokDouble   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokElse     pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokEnum     pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokExtern   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokFloat    pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokFloatN _ _ pos :: (Position, Int)
pos) = (Position, Int)
pos
posLenOfTok (CTokFor      pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokGeneric  pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokGoto     pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokInt      pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokInt128   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokInline   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokIf       pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokLong     pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokLabel    pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokNoreturn pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokNullable pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokNonnull  pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokRegister pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokRestrict pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokReturn   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokShort    pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokSigned   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokSizeof   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokStatic   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokStaticAssert pos :: (Position, Int)
pos) = (Position, Int)
pos
posLenOfTok (CTokStruct   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokSwitch   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokTypedef  pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokTypeof   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokThread   pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokUnion    pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokUnsigned pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokVoid     pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokVolatile pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokWhile    pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokCLit     pos :: (Position, Int)
pos _) = (Position, Int)
pos
posLenOfTok (CTokILit     pos :: (Position, Int)
pos _) = (Position, Int)
pos
posLenOfTok (CTokFLit     pos :: (Position, Int)
pos _) = (Position, Int)
pos
posLenOfTok (CTokSLit     pos :: (Position, Int)
pos _) = (Position, Int)
pos
posLenOfTok (CTokIdent    pos :: (Position, Int)
pos _) = (Position, Int)
pos
posLenOfTok (CTokTyIdent  pos :: (Position, Int)
pos _) = (Position, Int)
pos
posLenOfTok (CTokGnuC   _ pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokClangC   pos :: (Position, Int)
pos _) = (Position, Int)
pos
posLenOfTok (CTokClKernel pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokClRdOnly pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokClWrOnly pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokClGlobal pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok (CTokClLocal  pos :: (Position, Int)
pos  ) = (Position, Int)
pos
posLenOfTok CTokEof = [Char] -> (Position, Int)
forall a. HasCallStack => [Char] -> a
error "tokenPos: Eof"

instance Show CToken where
  showsPrec :: Int -> CToken -> ShowS
showsPrec _ (CTokLParen   _  ) = [Char] -> ShowS
showString "("
  showsPrec _ (CTokRParen   _  ) = [Char] -> ShowS
showString ")"
  showsPrec _ (CTokLBracket _  ) = [Char] -> ShowS
showString "["
  showsPrec _ (CTokRBracket _  ) = [Char] -> ShowS
showString "]"
  showsPrec _ (CTokArrow    _  ) = [Char] -> ShowS
showString "->"
  showsPrec _ (CTokDot      _  ) = [Char] -> ShowS
showString "."
  showsPrec _ (CTokExclam   _  ) = [Char] -> ShowS
showString "!"
  showsPrec _ (CTokTilde    _  ) = [Char] -> ShowS
showString "~"
  showsPrec _ (CTokInc      _  ) = [Char] -> ShowS
showString "++"
  showsPrec _ (CTokDec      _  ) = [Char] -> ShowS
showString "--"
  showsPrec _ (CTokPlus     _  ) = [Char] -> ShowS
showString "+"
  showsPrec _ (CTokMinus    _  ) = [Char] -> ShowS
showString "-"
  showsPrec _ (CTokStar     _  ) = [Char] -> ShowS
showString "*"
  showsPrec _ (CTokSlash    _  ) = [Char] -> ShowS
showString "/"
  showsPrec _ (CTokPercent  _  ) = [Char] -> ShowS
showString "%"
  showsPrec _ (CTokAmper    _  ) = [Char] -> ShowS
showString "&"
  showsPrec _ (CTokShiftL   _  ) = [Char] -> ShowS
showString "<<"
  showsPrec _ (CTokShiftR   _  ) = [Char] -> ShowS
showString ">>"
  showsPrec _ (CTokLess     _  ) = [Char] -> ShowS
showString "<"
  showsPrec _ (CTokLessEq   _  ) = [Char] -> ShowS
showString "<="
  showsPrec _ (CTokHigh     _  ) = [Char] -> ShowS
showString ">"
  showsPrec _ (CTokHighEq   _  ) = [Char] -> ShowS
showString ">="
  showsPrec _ (CTokEqual    _  ) = [Char] -> ShowS
showString "=="
  showsPrec _ (CTokUnequal  _  ) = [Char] -> ShowS
showString "!="
  showsPrec _ (CTokHat      _  ) = [Char] -> ShowS
showString "^"
  showsPrec _ (CTokBar      _  ) = [Char] -> ShowS
showString "|"
  showsPrec _ (CTokAnd      _  ) = [Char] -> ShowS
showString "&&"
  showsPrec _ (CTokOr       _  ) = [Char] -> ShowS
showString "||"
  showsPrec _ (CTokQuest    _  ) = [Char] -> ShowS
showString "?"
  showsPrec _ (CTokColon    _  ) = [Char] -> ShowS
showString ":"
  showsPrec _ (CTokAssign   _  ) = [Char] -> ShowS
showString "="
  showsPrec _ (CTokPlusAss  _  ) = [Char] -> ShowS
showString "+="
  showsPrec _ (CTokMinusAss _  ) = [Char] -> ShowS
showString "-="
  showsPrec _ (CTokStarAss  _  ) = [Char] -> ShowS
showString "*="
  showsPrec _ (CTokSlashAss _  ) = [Char] -> ShowS
showString "/="
  showsPrec _ (CTokPercAss  _  ) = [Char] -> ShowS
showString "%="
  showsPrec _ (CTokAmpAss   _  ) = [Char] -> ShowS
showString "&="
  showsPrec _ (CTokHatAss   _  ) = [Char] -> ShowS
showString "^="
  showsPrec _ (CTokBarAss   _  ) = [Char] -> ShowS
showString "|="
  showsPrec _ (CTokSLAss    _  ) = [Char] -> ShowS
showString "<<="
  showsPrec _ (CTokSRAss    _  ) = [Char] -> ShowS
showString ">>="
  showsPrec _ (CTokComma    _  ) = [Char] -> ShowS
showString ","
  showsPrec _ (CTokSemic    _  ) = [Char] -> ShowS
showString ";"
  showsPrec _ (CTokLBrace   _  ) = [Char] -> ShowS
showString "{"
  showsPrec _ (CTokRBrace   _  ) = [Char] -> ShowS
showString "}"
  showsPrec _ (CTokEllipsis _  ) = [Char] -> ShowS
showString "..."
  showsPrec _ (CTokAlignof  _  ) = [Char] -> ShowS
showString "alignof"
  showsPrec _ (CTokAlignas  _  ) = [Char] -> ShowS
showString "_Alignas"
  showsPrec _ (CTokAsm      _  ) = [Char] -> ShowS
showString "asm"
  showsPrec _ (CTokAtomic      _  ) = [Char] -> ShowS
showString "_Atomic"
  showsPrec _ (CTokAuto     _  ) = [Char] -> ShowS
showString "auto"
  showsPrec _ (CTokBool _)       = [Char] -> ShowS
showString "_Bool"
  showsPrec _ (CTokBreak    _  ) = [Char] -> ShowS
showString "break"
  showsPrec _ (CTokCase     _  ) = [Char] -> ShowS
showString "case"
  showsPrec _ (CTokChar     _  ) = [Char] -> ShowS
showString "char"
  showsPrec _ (CTokComplex _)    = [Char] -> ShowS
showString "_Complex"
  showsPrec _ (CTokConst    _  ) = [Char] -> ShowS
showString "const"
  showsPrec _ (CTokContinue _  ) = [Char] -> ShowS
showString "continue"
  showsPrec _ (CTokDefault  _  ) = [Char] -> ShowS
showString "default"
  showsPrec _ (CTokDouble   _  ) = [Char] -> ShowS
showString "double"
  showsPrec _ (CTokDo       _  ) = [Char] -> ShowS
showString "do"
  showsPrec _ (CTokElse     _  ) = [Char] -> ShowS
showString "else"
  showsPrec _ (CTokEnum     _  ) = [Char] -> ShowS
showString "enum"
  showsPrec _ (CTokExtern   _  ) = [Char] -> ShowS
showString "extern"
  showsPrec _ (CTokFloat    _  ) = [Char] -> ShowS
showString "float"
  showsPrec _ (CTokFloatN n :: Int
n x :: Bool
x _) = [Char] -> ShowS
showString "_Float" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
n ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                   [Char] -> ShowS
showString (if Bool
x then "x" else "")
  showsPrec _ (CTokFor      _  ) = [Char] -> ShowS
showString "for"
  showsPrec _ (CTokGeneric  _  ) = [Char] -> ShowS
showString "_Generic"
  showsPrec _ (CTokGoto     _  ) = [Char] -> ShowS
showString "goto"
  showsPrec _ (CTokIf       _  ) = [Char] -> ShowS
showString "if"
  showsPrec _ (CTokInline   _  ) = [Char] -> ShowS
showString "inline"
  showsPrec _ (CTokInt      _  ) = [Char] -> ShowS
showString "int"
  showsPrec _ (CTokInt128   _  ) = [Char] -> ShowS
showString "__int128"
  showsPrec _ (CTokLong     _  ) = [Char] -> ShowS
showString "long"
  showsPrec _ (CTokLabel    _  ) = [Char] -> ShowS
showString "__label__"
  showsPrec _ (CTokNoreturn    _  ) = [Char] -> ShowS
showString "_Noreturn"
  showsPrec _ (CTokNullable    _  ) = [Char] -> ShowS
showString "_Nullable"
  showsPrec _ (CTokNonnull     _  ) = [Char] -> ShowS
showString "_Nonnull"
  showsPrec _ (CTokRegister _  ) = [Char] -> ShowS
showString "register"
  showsPrec _ (CTokRestrict _  ) = [Char] -> ShowS
showString "restrict"
  showsPrec _ (CTokReturn   _  ) = [Char] -> ShowS
showString "return"
  showsPrec _ (CTokShort    _  ) = [Char] -> ShowS
showString "short"
  showsPrec _ (CTokSigned   _  ) = [Char] -> ShowS
showString "signed"
  showsPrec _ (CTokSizeof   _  ) = [Char] -> ShowS
showString "sizeof"
  showsPrec _ (CTokStatic   _  ) = [Char] -> ShowS
showString "static"
  showsPrec _ (CTokStaticAssert   _  ) = [Char] -> ShowS
showString "_Static_assert"
  showsPrec _ (CTokStruct   _  ) = [Char] -> ShowS
showString "struct"
  showsPrec _ (CTokSwitch   _  ) = [Char] -> ShowS
showString "switch"
  showsPrec _ (CTokTypedef  _  ) = [Char] -> ShowS
showString "typedef"
  showsPrec _ (CTokTypeof   _  ) = [Char] -> ShowS
showString "typeof"
  showsPrec _ (CTokThread   _  ) = [Char] -> ShowS
showString "_Thread_local"
  showsPrec _ (CTokUnion    _  ) = [Char] -> ShowS
showString "union"
  showsPrec _ (CTokUnsigned _  ) = [Char] -> ShowS
showString "unsigned"
  showsPrec _ (CTokVoid     _  ) = [Char] -> ShowS
showString "void"
  showsPrec _ (CTokVolatile _  ) = [Char] -> ShowS
showString "volatile"
  showsPrec _ (CTokWhile    _  ) = [Char] -> ShowS
showString "while"
  showsPrec _ (CTokCLit     _ c :: CChar
c) = CChar -> ShowS
forall a. Show a => a -> ShowS
shows CChar
c
  showsPrec _ (CTokILit     _ i :: CInteger
i) = CInteger -> ShowS
forall a. Show a => a -> ShowS
shows CInteger
i
  showsPrec _ (CTokFLit     _ f :: CFloat
f) = CFloat -> ShowS
forall a. Show a => a -> ShowS
shows CFloat
f
  showsPrec _ (CTokSLit     _ s :: CString
s) = CString -> ShowS
forall a. Show a => a -> ShowS
shows CString
s
  showsPrec _ (CTokIdent    _ i :: Ident
i) = ([Char] -> ShowS
showString ([Char] -> ShowS) -> (Ident -> [Char]) -> Ident -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> [Char]
identToString) Ident
i
  showsPrec _ (CTokTyIdent  _ i :: Ident
i) = ([Char] -> ShowS
showString ([Char] -> ShowS) -> (Ident -> [Char]) -> Ident -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> [Char]
identToString) Ident
i
  showsPrec _ (CTokGnuC GnuCAttrTok _) = [Char] -> ShowS
showString "__attribute__"
  showsPrec _ (CTokGnuC GnuCExtTok  _) = [Char] -> ShowS
showString "__extension__"
  showsPrec _ (CTokGnuC GnuCComplexReal _) = [Char] -> ShowS
showString "__real__"
  showsPrec _ (CTokGnuC GnuCComplexImag  _) = [Char] -> ShowS
showString "__imag__"
  showsPrec _ (CTokGnuC GnuCVaArg    _) = [Char] -> ShowS
showString "__builtin_va_arg"
  showsPrec _ (CTokGnuC GnuCOffsetof _) = [Char] -> ShowS
showString "__builtin_offsetof"
  showsPrec _ (CTokGnuC GnuCTyCompat _) = [Char] -> ShowS
showString "__builtin_types_compatible_p"
  showsPrec _ (CTokClangC _ (ClangCVersionTok v :: ClangCVersion
v)) = ClangCVersion -> ShowS
forall a. Show a => a -> ShowS
shows ClangCVersion
v
  showsPrec _ (CTokClangC _ ClangBuiltinConvertVector) = [Char] -> ShowS
showString "__builtin_convertvector"
  showsPrec _ (CTokClKernel _  ) = [Char] -> ShowS
showString "__kernel"
  showsPrec _ (CTokClRdOnly _  ) = [Char] -> ShowS
showString "__read_only"
  showsPrec _ (CTokClWrOnly _  ) = [Char] -> ShowS
showString "__write_only"
  showsPrec _ (CTokClGlobal _  ) = [Char] -> ShowS
showString "__global"
  showsPrec _ (CTokClLocal  _  ) = [Char] -> ShowS
showString "__Local"
  showsPrec _ CTokEof = [Char] -> ShowS
forall a. HasCallStack => [Char] -> a
error "show CToken : CTokEof"