-- File generated by the BNF Converter.
-- Parser definition for use with Happy.
{
{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}
{-# LANGUAGE PatternSynonyms #-}

module ParC
  ( happyError
  , myLexer
  , pProgram
  , pListExternal_declaration
  , pExternal_declaration
  , pFunction_def
  , pDec
  , pListDec
  , pListDeclaration_specifier
  , pDeclaration_specifier
  , pListInit_declarator
  , pInit_declarator
  , pType_specifier
  , pStorage_class_specifier
  , pType_qualifier
  , pStruct_or_union_spec
  , pStruct_or_union
  , pListStruct_dec
  , pStruct_dec
  , pListSpec_qual
  , pSpec_qual
  , pListStruct_declarator
  , pStruct_declarator
  , pEnum_specifier
  , pListEnumerator
  , pEnumerator
  , pDeclarator
  , pDirect_declarator
  , pPointer
  , pListType_qualifier
  , pParameter_type
  , pParameter_declarations
  , pParameter_declaration
  , pListIdent
  , pInitializer
  , pInitializers
  , pType_name
  , pAbstract_declarator
  , pDir_abs_dec
  , pStm
  , pLabeled_stm
  , pCompound_stm
  , pExpression_stm
  , pSelection_stm
  , pIter_stm
  , pJump_stm
  , pListStm
  , pExp
  , pExp2
  , pExp3
  , pExp4
  , pExp5
  , pExp6
  , pExp7
  , pExp8
  , pExp9
  , pExp10
  , pExp11
  , pExp12
  , pExp13
  , pExp14
  , pExp15
  , pExp16
  , pExp17
  , pConstant
  , pConstant_expression
  , pUnary_operator
  , pListExp2
  , pAssignment_op
  ) where

import Prelude

import qualified AbsC
import LexC

}

%name pProgram_internal Program
%name pListExternal_declaration_internal ListExternal_declaration
%name pExternal_declaration_internal External_declaration
%name pFunction_def_internal Function_def
%name pDec_internal Dec
%name pListDec_internal ListDec
%name pListDeclaration_specifier_internal ListDeclaration_specifier
%name pDeclaration_specifier_internal Declaration_specifier
%name pListInit_declarator_internal ListInit_declarator
%name pInit_declarator_internal Init_declarator
%name pType_specifier_internal Type_specifier
%name pStorage_class_specifier_internal Storage_class_specifier
%name pType_qualifier_internal Type_qualifier
%name pStruct_or_union_spec_internal Struct_or_union_spec
%name pStruct_or_union_internal Struct_or_union
%name pListStruct_dec_internal ListStruct_dec
%name pStruct_dec_internal Struct_dec
%name pListSpec_qual_internal ListSpec_qual
%name pSpec_qual_internal Spec_qual
%name pListStruct_declarator_internal ListStruct_declarator
%name pStruct_declarator_internal Struct_declarator
%name pEnum_specifier_internal Enum_specifier
%name pListEnumerator_internal ListEnumerator
%name pEnumerator_internal Enumerator
%name pDeclarator_internal Declarator
%name pDirect_declarator_internal Direct_declarator
%name pPointer_internal Pointer
%name pListType_qualifier_internal ListType_qualifier
%name pParameter_type_internal Parameter_type
%name pParameter_declarations_internal Parameter_declarations
%name pParameter_declaration_internal Parameter_declaration
%name pListIdent_internal ListIdent
%name pInitializer_internal Initializer
%name pInitializers_internal Initializers
%name pType_name_internal Type_name
%name pAbstract_declarator_internal Abstract_declarator
%name pDir_abs_dec_internal Dir_abs_dec
%name pStm_internal Stm
%name pLabeled_stm_internal Labeled_stm
%name pCompound_stm_internal Compound_stm
%name pExpression_stm_internal Expression_stm
%name pSelection_stm_internal Selection_stm
%name pIter_stm_internal Iter_stm
%name pJump_stm_internal Jump_stm
%name pListStm_internal ListStm
%name pExp_internal Exp
%name pExp2_internal Exp2
%name pExp3_internal Exp3
%name pExp4_internal Exp4
%name pExp5_internal Exp5
%name pExp6_internal Exp6
%name pExp7_internal Exp7
%name pExp8_internal Exp8
%name pExp9_internal Exp9
%name pExp10_internal Exp10
%name pExp11_internal Exp11
%name pExp12_internal Exp12
%name pExp13_internal Exp13
%name pExp14_internal Exp14
%name pExp15_internal Exp15
%name pExp16_internal Exp16
%name pExp17_internal Exp17
%name pConstant_internal Constant
%name pConstant_expression_internal Constant_expression
%name pUnary_operator_internal Unary_operator
%name pListExp2_internal ListExp2
%name pAssignment_op_internal Assignment_op
%monad { Err } { (>>=) } { return }
%tokentype {Token}

%token
  '!' { PT _ (TS _ 1) }
  '!=' { PT _ (TS _ 2) }
  '%' { PT _ (TS _ 3) }
  '%=' { PT _ (TS _ 4) }
  '&' { PT _ (TS _ 5) }
  '&&' { PT _ (TS _ 6) }
  '&=' { PT _ (TS _ 7) }
  '(' { PT _ (TS _ 8) }
  ')' { PT _ (TS _ 9) }
  '*' { PT _ (TS _ 10) }
  '*=' { PT _ (TS _ 11) }
  '+' { PT _ (TS _ 12) }
  '++' { PT _ (TS _ 13) }
  '+=' { PT _ (TS _ 14) }
  ',' { PT _ (TS _ 15) }
  '-' { PT _ (TS _ 16) }
  '--' { PT _ (TS _ 17) }
  '-=' { PT _ (TS _ 18) }
  '->' { PT _ (TS _ 19) }
  '.' { PT _ (TS _ 20) }
  '...' { PT _ (TS _ 21) }
  '/' { PT _ (TS _ 22) }
  '/=' { PT _ (TS _ 23) }
  ':' { PT _ (TS _ 24) }
  ';' { PT _ (TS _ 25) }
  '<' { PT _ (TS _ 26) }
  '<<' { PT _ (TS _ 27) }
  '<<=' { PT _ (TS _ 28) }
  '<=' { PT _ (TS _ 29) }
  '=' { PT _ (TS _ 30) }
  '==' { PT _ (TS _ 31) }
  '>' { PT _ (TS _ 32) }
  '>=' { PT _ (TS _ 33) }
  '>>' { PT _ (TS _ 34) }
  '>>=' { PT _ (TS _ 35) }
  '?' { PT _ (TS _ 36) }
  'Typedef_name' { PT _ (TS _ 37) }
  '[' { PT _ (TS _ 38) }
  ']' { PT _ (TS _ 39) }
  '^' { PT _ (TS _ 40) }
  '^=' { PT _ (TS _ 41) }
  'auto' { PT _ (TS _ 42) }
  'break' { PT _ (TS _ 43) }
  'case' { PT _ (TS _ 44) }
  'char' { PT _ (TS _ 45) }
  'const' { PT _ (TS _ 46) }
  'continue' { PT _ (TS _ 47) }
  'default' { PT _ (TS _ 48) }
  'do' { PT _ (TS _ 49) }
  'double' { PT _ (TS _ 50) }
  'else' { PT _ (TS _ 51) }
  'enum' { PT _ (TS _ 52) }
  'extern' { PT _ (TS _ 53) }
  'float' { PT _ (TS _ 54) }
  'for' { PT _ (TS _ 55) }
  'goto' { PT _ (TS _ 56) }
  'if' { PT _ (TS _ 57) }
  'int' { PT _ (TS _ 58) }
  'long' { PT _ (TS _ 59) }
  'register' { PT _ (TS _ 60) }
  'return' { PT _ (TS _ 61) }
  'short' { PT _ (TS _ 62) }
  'signed' { PT _ (TS _ 63) }
  'sizeof' { PT _ (TS _ 64) }
  'static' { PT _ (TS _ 65) }
  'struct' { PT _ (TS _ 66) }
  'switch' { PT _ (TS _ 67) }
  'typedef' { PT _ (TS _ 68) }
  'union' { PT _ (TS _ 69) }
  'unsigned' { PT _ (TS _ 70) }
  'void' { PT _ (TS _ 71) }
  'volatile' { PT _ (TS _ 72) }
  'while' { PT _ (TS _ 73) }
  '{' { PT _ (TS _ 74) }
  '|' { PT _ (TS _ 75) }
  '|=' { PT _ (TS _ 76) }
  '||' { PT _ (TS _ 77) }
  '}' { PT _ (TS _ 78) }
  '~' { PT _ (TS _ 79) }
  L_Ident { PT _ (TV _)}
  L_charac { PT _ (TC _)}
  L_doubl { PT _ (TD _)}
  L_integ { PT _ (TI _)}
  L_quoted { PT _ (TL _)}
  L_Unsigned { PT _ (T_Unsigned _) }
  L_Long { PT _ (T_Long _) }
  L_UnsignedLong { PT _ (T_UnsignedLong _) }
  L_Hexadecimal { PT _ (T_Hexadecimal _) }
  L_HexUnsigned { PT _ (T_HexUnsigned _) }
  L_HexLong { PT _ (T_HexLong _) }
  L_HexUnsLong { PT _ (T_HexUnsLong _) }
  L_Octal { PT _ (T_Octal _) }
  L_OctalUnsigned { PT _ (T_OctalUnsigned _) }
  L_OctalLong { PT _ (T_OctalLong _) }
  L_OctalUnsLong { PT _ (T_OctalUnsLong _) }
  L_CDouble { PT _ (T_CDouble _) }
  L_CFloat { PT _ (T_CFloat _) }
  L_CLongDouble { PT _ (T_CLongDouble _) }

%%

Ident :: { (AbsC.BNFC'Position, AbsC.Ident) }
Ident  : L_Ident { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Ident (tokenText $1)) }

Char :: { (AbsC.BNFC'Position, Char) }
Char  : L_charac { (uncurry AbsC.BNFC'Position (tokenLineCol $1), (read (tokenText $1) ) :: Char) }

Double :: { (AbsC.BNFC'Position, Double) }
Double  : L_doubl  { (uncurry AbsC.BNFC'Position (tokenLineCol $1), (read (tokenText $1) ) :: Double) }

Integer :: { (AbsC.BNFC'Position, Integer) }
Integer  : L_integ  { (uncurry AbsC.BNFC'Position (tokenLineCol $1), (read (tokenText $1) ) :: Integer) }

String :: { (AbsC.BNFC'Position, String) }
String  : L_quoted { (uncurry AbsC.BNFC'Position (tokenLineCol $1), ((\(PT _ (TL s)) -> s) $1)) }

Unsigned :: { (AbsC.BNFC'Position, AbsC.Unsigned) }
Unsigned : L_Unsigned { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Unsigned (tokenText $1)) }

Long :: { (AbsC.BNFC'Position, AbsC.Long) }
Long : L_Long { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Long (tokenText $1)) }

UnsignedLong :: { (AbsC.BNFC'Position, AbsC.UnsignedLong) }
UnsignedLong : L_UnsignedLong { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.UnsignedLong (tokenText $1)) }

Hexadecimal :: { (AbsC.BNFC'Position, AbsC.Hexadecimal) }
Hexadecimal : L_Hexadecimal { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Hexadecimal (tokenText $1)) }

HexUnsigned :: { (AbsC.BNFC'Position, AbsC.HexUnsigned) }
HexUnsigned : L_HexUnsigned { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.HexUnsigned (tokenText $1)) }

HexLong :: { (AbsC.BNFC'Position, AbsC.HexLong) }
HexLong : L_HexLong { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.HexLong (tokenText $1)) }

HexUnsLong :: { (AbsC.BNFC'Position, AbsC.HexUnsLong) }
HexUnsLong : L_HexUnsLong { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.HexUnsLong (tokenText $1)) }

Octal :: { (AbsC.BNFC'Position, AbsC.Octal) }
Octal : L_Octal { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Octal (tokenText $1)) }

OctalUnsigned :: { (AbsC.BNFC'Position, AbsC.OctalUnsigned) }
OctalUnsigned : L_OctalUnsigned { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.OctalUnsigned (tokenText $1)) }

OctalLong :: { (AbsC.BNFC'Position, AbsC.OctalLong) }
OctalLong : L_OctalLong { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.OctalLong (tokenText $1)) }

OctalUnsLong :: { (AbsC.BNFC'Position, AbsC.OctalUnsLong) }
OctalUnsLong : L_OctalUnsLong { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.OctalUnsLong (tokenText $1)) }

CDouble :: { (AbsC.BNFC'Position, AbsC.CDouble) }
CDouble : L_CDouble { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.CDouble (tokenText $1)) }

CFloat :: { (AbsC.BNFC'Position, AbsC.CFloat) }
CFloat : L_CFloat { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.CFloat (tokenText $1)) }

CLongDouble :: { (AbsC.BNFC'Position, AbsC.CLongDouble) }
CLongDouble : L_CLongDouble { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.CLongDouble (tokenText $1)) }

Program :: { (AbsC.BNFC'Position, AbsC.Program) }
Program
  : ListExternal_declaration { (fst $1, AbsC.Progr (fst $1) (snd $1)) }

ListExternal_declaration :: { (AbsC.BNFC'Position, [AbsC.External_declaration]) }
ListExternal_declaration
  : External_declaration { (fst $1, (:[]) (snd $1)) }
  | External_declaration ListExternal_declaration { (fst $1, (:) (snd $1) (snd $2)) }

External_declaration :: { (AbsC.BNFC'Position, AbsC.External_declaration) }
External_declaration
  : Dec { (fst $1, AbsC.Global (fst $1) (snd $1)) }
  | Function_def { (fst $1, AbsC.Afunc (fst $1) (snd $1)) }

Function_def :: { (AbsC.BNFC'Position, AbsC.Function_def) }
Function_def
  : Declarator Compound_stm { (fst $1, AbsC.NewFuncInt (fst $1) (snd $1) (snd $2)) }
  | Declarator ListDec Compound_stm { (fst $1, AbsC.OldFuncInt (fst $1) (snd $1) (snd $2) (snd $3)) }
  | ListDeclaration_specifier Declarator Compound_stm { (fst $1, AbsC.NewFunc (fst $1) (snd $1) (snd $2) (snd $3)) }
  | ListDeclaration_specifier Declarator ListDec Compound_stm { (fst $1, AbsC.OldFunc (fst $1) (snd $1) (snd $2) (snd $3) (snd $4)) }

Dec :: { (AbsC.BNFC'Position, AbsC.Dec) }
Dec
  : ListDeclaration_specifier ';' { (fst $1, AbsC.NoDeclarator (fst $1) (snd $1)) }
  | ListDeclaration_specifier ListInit_declarator ';' { (fst $1, AbsC.Declarators (fst $1) (snd $1) (snd $2)) }

ListDec :: { (AbsC.BNFC'Position, [AbsC.Dec]) }
ListDec
  : Dec { (fst $1, (:[]) (snd $1)) }
  | Dec ListDec { (fst $1, (:) (snd $1) (snd $2)) }

ListDeclaration_specifier :: { (AbsC.BNFC'Position, [AbsC.Declaration_specifier]) }
ListDeclaration_specifier
  : Declaration_specifier { (fst $1, (:[]) (snd $1)) }
  | Declaration_specifier ListDeclaration_specifier { (fst $1, (:) (snd $1) (snd $2)) }

Declaration_specifier :: { (AbsC.BNFC'Position, AbsC.Declaration_specifier) }
Declaration_specifier
  : Storage_class_specifier { (fst $1, AbsC.Storage (fst $1) (snd $1)) }
  | Type_qualifier { (fst $1, AbsC.SpecProp (fst $1) (snd $1)) }
  | Type_specifier { (fst $1, AbsC.Type (fst $1) (snd $1)) }

ListInit_declarator :: { (AbsC.BNFC'Position, [AbsC.Init_declarator]) }
ListInit_declarator
  : Init_declarator { (fst $1, (:[]) (snd $1)) }
  | Init_declarator ',' ListInit_declarator { (fst $1, (:) (snd $1) (snd $3)) }

Init_declarator :: { (AbsC.BNFC'Position, AbsC.Init_declarator) }
Init_declarator
  : Declarator { (fst $1, AbsC.OnlyDecl (fst $1) (snd $1)) }
  | Declarator '=' Initializer { (fst $1, AbsC.InitDecl (fst $1) (snd $1) (snd $3)) }

Type_specifier :: { (AbsC.BNFC'Position, AbsC.Type_specifier) }
Type_specifier
  : 'Typedef_name' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Tname (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | 'char' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Tchar (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | 'double' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Tdouble (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | 'float' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Tfloat (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | 'int' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Tint (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | 'long' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Tlong (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | 'short' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Tshort (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | 'signed' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Tsigned (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | 'unsigned' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Tunsigned (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | 'void' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Tvoid (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | Enum_specifier { (fst $1, AbsC.Tenum (fst $1) (snd $1)) }
  | Struct_or_union_spec { (fst $1, AbsC.Tstruct (fst $1) (snd $1)) }

Storage_class_specifier :: { (AbsC.BNFC'Position, AbsC.Storage_class_specifier) }
Storage_class_specifier
  : 'auto' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.LocalBlock (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | 'extern' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.GlobalPrograms (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | 'register' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.LocalReg (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | 'static' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.LocalProgram (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | 'typedef' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.MyType (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }

Type_qualifier :: { (AbsC.BNFC'Position, AbsC.Type_qualifier) }
Type_qualifier
  : 'const' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Const (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | 'volatile' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.NoOptim (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }

Struct_or_union_spec :: { (AbsC.BNFC'Position, AbsC.Struct_or_union_spec) }
Struct_or_union_spec
  : Struct_or_union '{' ListStruct_dec '}' { (fst $1, AbsC.Unique (fst $1) (snd $1) (snd $3)) }
  | Struct_or_union Ident { (fst $1, AbsC.TagType (fst $1) (snd $1) (snd $2)) }
  | Struct_or_union Ident '{' ListStruct_dec '}' { (fst $1, AbsC.Tag (fst $1) (snd $1) (snd $2) (snd $4)) }

Struct_or_union :: { (AbsC.BNFC'Position, AbsC.Struct_or_union) }
Struct_or_union
  : 'struct' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Struct (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | 'union' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Union (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }

ListStruct_dec :: { (AbsC.BNFC'Position, [AbsC.Struct_dec]) }
ListStruct_dec
  : Struct_dec { (fst $1, (:[]) (snd $1)) }
  | Struct_dec ListStruct_dec { (fst $1, (:) (snd $1) (snd $2)) }

Struct_dec :: { (AbsC.BNFC'Position, AbsC.Struct_dec) }
Struct_dec
  : ListSpec_qual ListStruct_declarator ';' { (fst $1, AbsC.Structen (fst $1) (snd $1) (snd $2)) }

ListSpec_qual :: { (AbsC.BNFC'Position, [AbsC.Spec_qual]) }
ListSpec_qual
  : Spec_qual { (fst $1, (:[]) (snd $1)) }
  | Spec_qual ListSpec_qual { (fst $1, (:) (snd $1) (snd $2)) }

Spec_qual :: { (AbsC.BNFC'Position, AbsC.Spec_qual) }
Spec_qual
  : Type_qualifier { (fst $1, AbsC.QualSpec (fst $1) (snd $1)) }
  | Type_specifier { (fst $1, AbsC.TypeSpec (fst $1) (snd $1)) }

ListStruct_declarator :: { (AbsC.BNFC'Position, [AbsC.Struct_declarator]) }
ListStruct_declarator
  : Struct_declarator { (fst $1, (:[]) (snd $1)) }
  | Struct_declarator ',' ListStruct_declarator { (fst $1, (:) (snd $1) (snd $3)) }

Struct_declarator :: { (AbsC.BNFC'Position, AbsC.Struct_declarator) }
Struct_declarator
  : ':' Constant_expression { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Field (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2)) }
  | Declarator { (fst $1, AbsC.Decl (fst $1) (snd $1)) }
  | Declarator ':' Constant_expression { (fst $1, AbsC.DecField (fst $1) (snd $1) (snd $3)) }

Enum_specifier :: { (AbsC.BNFC'Position, AbsC.Enum_specifier) }
Enum_specifier
  : 'enum' '{' ListEnumerator '}' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.EnumDec (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $3)) }
  | 'enum' Ident { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.EnumVar (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2)) }
  | 'enum' Ident '{' ListEnumerator '}' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.EnumName (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $4)) }

ListEnumerator :: { (AbsC.BNFC'Position, [AbsC.Enumerator]) }
ListEnumerator
  : Enumerator { (fst $1, (:[]) (snd $1)) }
  | Enumerator ',' ListEnumerator { (fst $1, (:) (snd $1) (snd $3)) }

Enumerator :: { (AbsC.BNFC'Position, AbsC.Enumerator) }
Enumerator
  : Ident { (fst $1, AbsC.Plain (fst $1) (snd $1)) }
  | Ident '=' Constant_expression { (fst $1, AbsC.EnumInit (fst $1) (snd $1) (snd $3)) }

Declarator :: { (AbsC.BNFC'Position, AbsC.Declarator) }
Declarator
  : Direct_declarator { (fst $1, AbsC.NoPointer (fst $1) (snd $1)) }
  | Pointer Direct_declarator { (fst $1, AbsC.BeginPointer (fst $1) (snd $1) (snd $2)) }

Direct_declarator :: { (AbsC.BNFC'Position, AbsC.Direct_declarator) }
Direct_declarator
  : '(' Declarator ')' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.ParenDecl (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2)) }
  | Ident { (fst $1, AbsC.Name (fst $1) (snd $1)) }
  | Direct_declarator '(' ')' { (fst $1, AbsC.OldFuncDec (fst $1) (snd $1)) }
  | Direct_declarator '(' Parameter_type ')' { (fst $1, AbsC.NewFuncDec (fst $1) (snd $1) (snd $3)) }
  | Direct_declarator '(' ListIdent ')' { (fst $1, AbsC.OldFuncDef (fst $1) (snd $1) (snd $3)) }
  | Direct_declarator '[' ']' { (fst $1, AbsC.Incomplete (fst $1) (snd $1)) }
  | Direct_declarator '[' Constant_expression ']' { (fst $1, AbsC.InnitArray (fst $1) (snd $1) (snd $3)) }

Pointer :: { (AbsC.BNFC'Position, AbsC.Pointer) }
Pointer
  : '*' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Point (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | '*' Pointer { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.PointPoint (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2)) }
  | '*' ListType_qualifier { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.PointQual (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2)) }
  | '*' ListType_qualifier Pointer { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.PointQualPoint (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $3)) }

ListType_qualifier :: { (AbsC.BNFC'Position, [AbsC.Type_qualifier]) }
ListType_qualifier
  : Type_qualifier { (fst $1, (:[]) (snd $1)) }
  | Type_qualifier ListType_qualifier { (fst $1, (:) (snd $1) (snd $2)) }

Parameter_type :: { (AbsC.BNFC'Position, AbsC.Parameter_type) }
Parameter_type
  : Parameter_declarations { (fst $1, AbsC.AllSpec (fst $1) (snd $1)) }
  | Parameter_declarations ',' '...' { (fst $1, AbsC.More (fst $1) (snd $1)) }

Parameter_declarations :: { (AbsC.BNFC'Position, AbsC.Parameter_declarations) }
Parameter_declarations
  : Parameter_declaration { (fst $1, AbsC.ParamDec (fst $1) (snd $1)) }
  | Parameter_declarations ',' Parameter_declaration { (fst $1, AbsC.MoreParamDec (fst $1) (snd $1) (snd $3)) }

Parameter_declaration :: { (AbsC.BNFC'Position, AbsC.Parameter_declaration) }
Parameter_declaration
  : ListDeclaration_specifier { (fst $1, AbsC.OnlyType (fst $1) (snd $1)) }
  | ListDeclaration_specifier Abstract_declarator { (fst $1, AbsC.Abstract (fst $1) (snd $1) (snd $2)) }
  | ListDeclaration_specifier Declarator { (fst $1, AbsC.TypeAndParam (fst $1) (snd $1) (snd $2)) }

ListIdent :: { (AbsC.BNFC'Position, [AbsC.Ident]) }
ListIdent
  : Ident { (fst $1, (:[]) (snd $1)) }
  | Ident ',' ListIdent { (fst $1, (:) (snd $1) (snd $3)) }

Initializer :: { (AbsC.BNFC'Position, AbsC.Initializer) }
Initializer
  : '{' Initializers ',' '}' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.InitListTwo (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2)) }
  | '{' Initializers '}' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.InitListOne (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2)) }
  | Exp2 { (fst $1, AbsC.InitExpr (fst $1) (snd $1)) }

Initializers :: { (AbsC.BNFC'Position, AbsC.Initializers) }
Initializers
  : Initializer { (fst $1, AbsC.AnInit (fst $1) (snd $1)) }
  | Initializers ',' Initializer { (fst $1, AbsC.MoreInit (fst $1) (snd $1) (snd $3)) }

Type_name :: { (AbsC.BNFC'Position, AbsC.Type_name) }
Type_name
  : ListSpec_qual { (fst $1, AbsC.PlainType (fst $1) (snd $1)) }
  | ListSpec_qual Abstract_declarator { (fst $1, AbsC.ExtendedType (fst $1) (snd $1) (snd $2)) }

Abstract_declarator :: { (AbsC.BNFC'Position, AbsC.Abstract_declarator) }
Abstract_declarator
  : Dir_abs_dec { (fst $1, AbsC.Advanced (fst $1) (snd $1)) }
  | Pointer { (fst $1, AbsC.PointerStart (fst $1) (snd $1)) }
  | Pointer Dir_abs_dec { (fst $1, AbsC.PointAdvanced (fst $1) (snd $1) (snd $2)) }

Dir_abs_dec :: { (AbsC.BNFC'Position, AbsC.Dir_abs_dec) }
Dir_abs_dec
  : '(' ')' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.OldFunction (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | '(' Abstract_declarator ')' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.WithinParentes (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2)) }
  | '(' Parameter_type ')' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.NewFunction (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2)) }
  | '[' ']' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Array (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | '[' Constant_expression ']' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.InitiatedArray (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2)) }
  | Dir_abs_dec '(' ')' { (fst $1, AbsC.OldFuncExpr (fst $1) (snd $1)) }
  | Dir_abs_dec '(' Parameter_type ')' { (fst $1, AbsC.NewFuncExpr (fst $1) (snd $1) (snd $3)) }
  | Dir_abs_dec '[' ']' { (fst $1, AbsC.UnInitiated (fst $1) (snd $1)) }
  | Dir_abs_dec '[' Constant_expression ']' { (fst $1, AbsC.Initiated (fst $1) (snd $1) (snd $3)) }

Stm :: { (AbsC.BNFC'Position, AbsC.Stm) }
Stm
  : Compound_stm { (fst $1, AbsC.CompS (fst $1) (snd $1)) }
  | Expression_stm { (fst $1, AbsC.ExprS (fst $1) (snd $1)) }
  | Iter_stm { (fst $1, AbsC.IterS (fst $1) (snd $1)) }
  | Jump_stm { (fst $1, AbsC.JumpS (fst $1) (snd $1)) }
  | Labeled_stm { (fst $1, AbsC.LabelS (fst $1) (snd $1)) }
  | Selection_stm { (fst $1, AbsC.SelS (fst $1) (snd $1)) }

Labeled_stm :: { (AbsC.BNFC'Position, AbsC.Labeled_stm) }
Labeled_stm
  : 'case' Constant_expression ':' Stm { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.SlabelTwo (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $4)) }
  | 'default' ':' Stm { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.SlabelThree (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $3)) }
  | Ident ':' Stm { (fst $1, AbsC.SlabelOne (fst $1) (snd $1) (snd $3)) }

Compound_stm :: { (AbsC.BNFC'Position, AbsC.Compound_stm) }
Compound_stm
  : '{' '}' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.ScompOne (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | '{' ListDec '}' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.ScompThree (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2)) }
  | '{' ListDec ListStm '}' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.ScompFour (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $3)) }
  | '{' ListStm '}' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.ScompTwo (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2)) }

Expression_stm :: { (AbsC.BNFC'Position, AbsC.Expression_stm) }
Expression_stm
  : ';' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.SexprOne (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | Exp ';' { (fst $1, AbsC.SexprTwo (fst $1) (snd $1)) }

Selection_stm :: { (AbsC.BNFC'Position, AbsC.Selection_stm) }
Selection_stm
  : 'if' '(' Exp ')' Stm { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.SselOne (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $3) (snd $5)) }
  | 'if' '(' Exp ')' Stm 'else' Stm { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.SselTwo (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $3) (snd $5) (snd $7)) }
  | 'switch' '(' Exp ')' Stm { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.SselThree (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $3) (snd $5)) }

Iter_stm :: { (AbsC.BNFC'Position, AbsC.Iter_stm) }
Iter_stm
  : 'do' Stm 'while' '(' Exp ')' ';' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.SiterTwo (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $5)) }
  | 'for' '(' Expression_stm Expression_stm ')' Stm { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.SiterThree (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $3) (snd $4) (snd $6)) }
  | 'for' '(' Expression_stm Expression_stm Exp ')' Stm { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.SiterFour (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $3) (snd $4) (snd $5) (snd $7)) }
  | 'while' '(' Exp ')' Stm { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.SiterOne (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $3) (snd $5)) }

Jump_stm :: { (AbsC.BNFC'Position, AbsC.Jump_stm) }
Jump_stm
  : 'break' ';' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.SjumpThree (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | 'continue' ';' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.SjumpTwo (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | 'goto' Ident ';' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.SjumpOne (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2)) }
  | 'return' ';' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.SjumpFour (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | 'return' Exp ';' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.SjumpFive (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2)) }

ListStm :: { (AbsC.BNFC'Position, [AbsC.Stm]) }
ListStm
  : Stm { (fst $1, (:[]) (snd $1)) }
  | Stm ListStm { (fst $1, (:) (snd $1) (snd $2)) }

Exp :: { (AbsC.BNFC'Position, AbsC.Exp) }
Exp
  : Exp ',' Exp2 { (fst $1, AbsC.Ecomma (fst $1) (snd $1) (snd $3)) }
  | Exp2 { (fst $1, (snd $1)) }

Exp2 :: { (AbsC.BNFC'Position, AbsC.Exp) }
Exp2
  : Exp3 { (fst $1, (snd $1)) }
  | Exp15 Assignment_op Exp2 { (fst $1, AbsC.Eassign (fst $1) (snd $1) (snd $2) (snd $3)) }

Exp3 :: { (AbsC.BNFC'Position, AbsC.Exp) }
Exp3
  : Exp4 { (fst $1, (snd $1)) }
  | Exp4 '?' Exp ':' Exp3 { (fst $1, AbsC.Econdition (fst $1) (snd $1) (snd $3) (snd $5)) }

Exp4 :: { (AbsC.BNFC'Position, AbsC.Exp) }
Exp4
  : Exp4 '||' Exp5 { (fst $1, AbsC.Elor (fst $1) (snd $1) (snd $3)) }
  | Exp5 { (fst $1, (snd $1)) }

Exp5 :: { (AbsC.BNFC'Position, AbsC.Exp) }
Exp5
  : Exp5 '&&' Exp6 { (fst $1, AbsC.Eland (fst $1) (snd $1) (snd $3)) }
  | Exp6 { (fst $1, (snd $1)) }

Exp6 :: { (AbsC.BNFC'Position, AbsC.Exp) }
Exp6
  : Exp6 '|' Exp7 { (fst $1, AbsC.Ebitor (fst $1) (snd $1) (snd $3)) }
  | Exp7 { (fst $1, (snd $1)) }

Exp7 :: { (AbsC.BNFC'Position, AbsC.Exp) }
Exp7
  : Exp7 '^' Exp8 { (fst $1, AbsC.Ebitexor (fst $1) (snd $1) (snd $3)) }
  | Exp8 { (fst $1, (snd $1)) }

Exp8 :: { (AbsC.BNFC'Position, AbsC.Exp) }
Exp8
  : Exp8 '&' Exp9 { (fst $1, AbsC.Ebitand (fst $1) (snd $1) (snd $3)) }
  | Exp9 { (fst $1, (snd $1)) }

Exp9 :: { (AbsC.BNFC'Position, AbsC.Exp) }
Exp9
  : Exp9 '!=' Exp10 { (fst $1, AbsC.Eneq (fst $1) (snd $1) (snd $3)) }
  | Exp9 '==' Exp10 { (fst $1, AbsC.Eeq (fst $1) (snd $1) (snd $3)) }
  | Exp10 { (fst $1, (snd $1)) }

Exp10 :: { (AbsC.BNFC'Position, AbsC.Exp) }
Exp10
  : Exp10 '<' Exp11 { (fst $1, AbsC.Elthen (fst $1) (snd $1) (snd $3)) }
  | Exp10 '<=' Exp11 { (fst $1, AbsC.Ele (fst $1) (snd $1) (snd $3)) }
  | Exp10 '>' Exp11 { (fst $1, AbsC.Egrthen (fst $1) (snd $1) (snd $3)) }
  | Exp10 '>=' Exp11 { (fst $1, AbsC.Ege (fst $1) (snd $1) (snd $3)) }
  | Exp11 { (fst $1, (snd $1)) }

Exp11 :: { (AbsC.BNFC'Position, AbsC.Exp) }
Exp11
  : Exp11 '<<' Exp12 { (fst $1, AbsC.Eleft (fst $1) (snd $1) (snd $3)) }
  | Exp11 '>>' Exp12 { (fst $1, AbsC.Eright (fst $1) (snd $1) (snd $3)) }
  | Exp12 { (fst $1, (snd $1)) }

Exp12 :: { (AbsC.BNFC'Position, AbsC.Exp) }
Exp12
  : Exp12 '+' Exp13 { (fst $1, AbsC.Eplus (fst $1) (snd $1) (snd $3)) }
  | Exp12 '-' Exp13 { (fst $1, AbsC.Eminus (fst $1) (snd $1) (snd $3)) }
  | Exp13 { (fst $1, (snd $1)) }

Exp13 :: { (AbsC.BNFC'Position, AbsC.Exp) }
Exp13
  : Exp13 '%' Exp14 { (fst $1, AbsC.Emod (fst $1) (snd $1) (snd $3)) }
  | Exp13 '*' Exp14 { (fst $1, AbsC.Etimes (fst $1) (snd $1) (snd $3)) }
  | Exp13 '/' Exp14 { (fst $1, AbsC.Ediv (fst $1) (snd $1) (snd $3)) }
  | Exp14 { (fst $1, (snd $1)) }

Exp14 :: { (AbsC.BNFC'Position, AbsC.Exp) }
Exp14
  : '(' Type_name ')' Exp14 { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Etypeconv (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $4)) }
  | Exp15 { (fst $1, (snd $1)) }

Exp15 :: { (AbsC.BNFC'Position, AbsC.Exp) }
Exp15
  : '++' Exp15 { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Epreinc (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2)) }
  | '--' Exp15 { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Epredec (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2)) }
  | 'sizeof' '(' Type_name ')' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Ebytestype (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $3)) }
  | 'sizeof' Exp15 { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Ebytesexpr (uncurry AbsC.BNFC'Position (tokenLineCol $1)) (snd $2)) }
  | Unary_operator Exp14 { (fst $1, AbsC.Epreop (fst $1) (snd $1) (snd $2)) }
  | Exp16 { (fst $1, (snd $1)) }

Exp16 :: { (AbsC.BNFC'Position, AbsC.Exp) }
Exp16
  : Exp16 '(' ')' { (fst $1, AbsC.Efunk (fst $1) (snd $1)) }
  | Exp16 '(' ListExp2 ')' { (fst $1, AbsC.Efunkpar (fst $1) (snd $1) (snd $3)) }
  | Exp16 '++' { (fst $1, AbsC.Epostinc (fst $1) (snd $1)) }
  | Exp16 '--' { (fst $1, AbsC.Epostdec (fst $1) (snd $1)) }
  | Exp16 '->' Ident { (fst $1, AbsC.Epoint (fst $1) (snd $1) (snd $3)) }
  | Exp16 '.' Ident { (fst $1, AbsC.Eselect (fst $1) (snd $1) (snd $3)) }
  | Exp16 '[' Exp ']' { (fst $1, AbsC.Earray (fst $1) (snd $1) (snd $3)) }
  | Exp17 { (fst $1, (snd $1)) }

Exp17 :: { (AbsC.BNFC'Position, AbsC.Exp) }
Exp17
  : '(' Exp ')' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), (snd $2)) }
  | String { (fst $1, AbsC.Estring (fst $1) (snd $1)) }
  | Ident { (fst $1, AbsC.Evar (fst $1) (snd $1)) }
  | Constant { (fst $1, AbsC.Econst (fst $1) (snd $1)) }

Constant :: { (AbsC.BNFC'Position, AbsC.Constant) }
Constant
  : Char { (fst $1, AbsC.Echar (fst $1) (snd $1)) }
  | Double { (fst $1, AbsC.Efloat (fst $1) (snd $1)) }
  | Integer { (fst $1, AbsC.Eint (fst $1) (snd $1)) }
  | CDouble { (fst $1, AbsC.Ecdouble (fst $1) (snd $1)) }
  | CFloat { (fst $1, AbsC.Ecfloat (fst $1) (snd $1)) }
  | CLongDouble { (fst $1, AbsC.Eclongdouble (fst $1) (snd $1)) }
  | HexLong { (fst $1, AbsC.Ehexalong (fst $1) (snd $1)) }
  | HexUnsLong { (fst $1, AbsC.Ehexaunslong (fst $1) (snd $1)) }
  | HexUnsigned { (fst $1, AbsC.Ehexaunsign (fst $1) (snd $1)) }
  | Hexadecimal { (fst $1, AbsC.Ehexadec (fst $1) (snd $1)) }
  | Long { (fst $1, AbsC.Elong (fst $1) (snd $1)) }
  | Octal { (fst $1, AbsC.Eoctal (fst $1) (snd $1)) }
  | OctalLong { (fst $1, AbsC.Eoctallong (fst $1) (snd $1)) }
  | OctalUnsLong { (fst $1, AbsC.Eoctalunslong (fst $1) (snd $1)) }
  | OctalUnsigned { (fst $1, AbsC.Eoctalunsign (fst $1) (snd $1)) }
  | Unsigned { (fst $1, AbsC.Eunsigned (fst $1) (snd $1)) }
  | UnsignedLong { (fst $1, AbsC.Eunsignlong (fst $1) (snd $1)) }

Constant_expression :: { (AbsC.BNFC'Position, AbsC.Constant_expression) }
Constant_expression
  : Exp3 { (fst $1, AbsC.Especial (fst $1) (snd $1)) }

Unary_operator :: { (AbsC.BNFC'Position, AbsC.Unary_operator) }
Unary_operator
  : '!' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Logicalneg (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | '&' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Address (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | '*' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Indirection (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | '+' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Plus (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | '-' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Negative (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | '~' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Complement (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }

ListExp2 :: { (AbsC.BNFC'Position, [AbsC.Exp]) }
ListExp2
  : Exp2 { (fst $1, (:[]) (snd $1)) }
  | Exp2 ',' ListExp2 { (fst $1, (:) (snd $1) (snd $3)) }

Assignment_op :: { (AbsC.BNFC'Position, AbsC.Assignment_op) }
Assignment_op
  : '%=' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.AssignMod (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | '&=' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.AssignAnd (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | '*=' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.AssignMul (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | '+=' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.AssignAdd (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | '-=' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.AssignSub (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | '/=' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.AssignDiv (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | '<<=' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.AssignLeft (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | '=' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.Assign (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | '>>=' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.AssignRight (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | '^=' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.AssignXor (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }
  | '|=' { (uncurry AbsC.BNFC'Position (tokenLineCol $1), AbsC.AssignOr (uncurry AbsC.BNFC'Position (tokenLineCol $1))) }

{

type Err = Either String

happyError :: [Token] -> Err a
happyError ts = Left $
  "syntax error at " ++ tokenPos ts ++ 
  case ts of
    []      -> []
    [Err _] -> " due to lexer error"
    t:_     -> " before `" ++ (prToken t) ++ "'"

myLexer :: String -> [Token]
myLexer = tokens

-- Entrypoints

pProgram :: [Token] -> Err AbsC.Program
pProgram = fmap snd . pProgram_internal

pListExternal_declaration :: [Token] -> Err [AbsC.External_declaration]
pListExternal_declaration = fmap snd . pListExternal_declaration_internal

pExternal_declaration :: [Token] -> Err AbsC.External_declaration
pExternal_declaration = fmap snd . pExternal_declaration_internal

pFunction_def :: [Token] -> Err AbsC.Function_def
pFunction_def = fmap snd . pFunction_def_internal

pDec :: [Token] -> Err AbsC.Dec
pDec = fmap snd . pDec_internal

pListDec :: [Token] -> Err [AbsC.Dec]
pListDec = fmap snd . pListDec_internal

pListDeclaration_specifier :: [Token] -> Err [AbsC.Declaration_specifier]
pListDeclaration_specifier = fmap snd . pListDeclaration_specifier_internal

pDeclaration_specifier :: [Token] -> Err AbsC.Declaration_specifier
pDeclaration_specifier = fmap snd . pDeclaration_specifier_internal

pListInit_declarator :: [Token] -> Err [AbsC.Init_declarator]
pListInit_declarator = fmap snd . pListInit_declarator_internal

pInit_declarator :: [Token] -> Err AbsC.Init_declarator
pInit_declarator = fmap snd . pInit_declarator_internal

pType_specifier :: [Token] -> Err AbsC.Type_specifier
pType_specifier = fmap snd . pType_specifier_internal

pStorage_class_specifier :: [Token] -> Err AbsC.Storage_class_specifier
pStorage_class_specifier = fmap snd . pStorage_class_specifier_internal

pType_qualifier :: [Token] -> Err AbsC.Type_qualifier
pType_qualifier = fmap snd . pType_qualifier_internal

pStruct_or_union_spec :: [Token] -> Err AbsC.Struct_or_union_spec
pStruct_or_union_spec = fmap snd . pStruct_or_union_spec_internal

pStruct_or_union :: [Token] -> Err AbsC.Struct_or_union
pStruct_or_union = fmap snd . pStruct_or_union_internal

pListStruct_dec :: [Token] -> Err [AbsC.Struct_dec]
pListStruct_dec = fmap snd . pListStruct_dec_internal

pStruct_dec :: [Token] -> Err AbsC.Struct_dec
pStruct_dec = fmap snd . pStruct_dec_internal

pListSpec_qual :: [Token] -> Err [AbsC.Spec_qual]
pListSpec_qual = fmap snd . pListSpec_qual_internal

pSpec_qual :: [Token] -> Err AbsC.Spec_qual
pSpec_qual = fmap snd . pSpec_qual_internal

pListStruct_declarator :: [Token] -> Err [AbsC.Struct_declarator]
pListStruct_declarator = fmap snd . pListStruct_declarator_internal

pStruct_declarator :: [Token] -> Err AbsC.Struct_declarator
pStruct_declarator = fmap snd . pStruct_declarator_internal

pEnum_specifier :: [Token] -> Err AbsC.Enum_specifier
pEnum_specifier = fmap snd . pEnum_specifier_internal

pListEnumerator :: [Token] -> Err [AbsC.Enumerator]
pListEnumerator = fmap snd . pListEnumerator_internal

pEnumerator :: [Token] -> Err AbsC.Enumerator
pEnumerator = fmap snd . pEnumerator_internal

pDeclarator :: [Token] -> Err AbsC.Declarator
pDeclarator = fmap snd . pDeclarator_internal

pDirect_declarator :: [Token] -> Err AbsC.Direct_declarator
pDirect_declarator = fmap snd . pDirect_declarator_internal

pPointer :: [Token] -> Err AbsC.Pointer
pPointer = fmap snd . pPointer_internal

pListType_qualifier :: [Token] -> Err [AbsC.Type_qualifier]
pListType_qualifier = fmap snd . pListType_qualifier_internal

pParameter_type :: [Token] -> Err AbsC.Parameter_type
pParameter_type = fmap snd . pParameter_type_internal

pParameter_declarations :: [Token] -> Err AbsC.Parameter_declarations
pParameter_declarations = fmap snd . pParameter_declarations_internal

pParameter_declaration :: [Token] -> Err AbsC.Parameter_declaration
pParameter_declaration = fmap snd . pParameter_declaration_internal

pListIdent :: [Token] -> Err [AbsC.Ident]
pListIdent = fmap snd . pListIdent_internal

pInitializer :: [Token] -> Err AbsC.Initializer
pInitializer = fmap snd . pInitializer_internal

pInitializers :: [Token] -> Err AbsC.Initializers
pInitializers = fmap snd . pInitializers_internal

pType_name :: [Token] -> Err AbsC.Type_name
pType_name = fmap snd . pType_name_internal

pAbstract_declarator :: [Token] -> Err AbsC.Abstract_declarator
pAbstract_declarator = fmap snd . pAbstract_declarator_internal

pDir_abs_dec :: [Token] -> Err AbsC.Dir_abs_dec
pDir_abs_dec = fmap snd . pDir_abs_dec_internal

pStm :: [Token] -> Err AbsC.Stm
pStm = fmap snd . pStm_internal

pLabeled_stm :: [Token] -> Err AbsC.Labeled_stm
pLabeled_stm = fmap snd . pLabeled_stm_internal

pCompound_stm :: [Token] -> Err AbsC.Compound_stm
pCompound_stm = fmap snd . pCompound_stm_internal

pExpression_stm :: [Token] -> Err AbsC.Expression_stm
pExpression_stm = fmap snd . pExpression_stm_internal

pSelection_stm :: [Token] -> Err AbsC.Selection_stm
pSelection_stm = fmap snd . pSelection_stm_internal

pIter_stm :: [Token] -> Err AbsC.Iter_stm
pIter_stm = fmap snd . pIter_stm_internal

pJump_stm :: [Token] -> Err AbsC.Jump_stm
pJump_stm = fmap snd . pJump_stm_internal

pListStm :: [Token] -> Err [AbsC.Stm]
pListStm = fmap snd . pListStm_internal

pExp :: [Token] -> Err AbsC.Exp
pExp = fmap snd . pExp_internal

pExp2 :: [Token] -> Err AbsC.Exp
pExp2 = fmap snd . pExp2_internal

pExp3 :: [Token] -> Err AbsC.Exp
pExp3 = fmap snd . pExp3_internal

pExp4 :: [Token] -> Err AbsC.Exp
pExp4 = fmap snd . pExp4_internal

pExp5 :: [Token] -> Err AbsC.Exp
pExp5 = fmap snd . pExp5_internal

pExp6 :: [Token] -> Err AbsC.Exp
pExp6 = fmap snd . pExp6_internal

pExp7 :: [Token] -> Err AbsC.Exp
pExp7 = fmap snd . pExp7_internal

pExp8 :: [Token] -> Err AbsC.Exp
pExp8 = fmap snd . pExp8_internal

pExp9 :: [Token] -> Err AbsC.Exp
pExp9 = fmap snd . pExp9_internal

pExp10 :: [Token] -> Err AbsC.Exp
pExp10 = fmap snd . pExp10_internal

pExp11 :: [Token] -> Err AbsC.Exp
pExp11 = fmap snd . pExp11_internal

pExp12 :: [Token] -> Err AbsC.Exp
pExp12 = fmap snd . pExp12_internal

pExp13 :: [Token] -> Err AbsC.Exp
pExp13 = fmap snd . pExp13_internal

pExp14 :: [Token] -> Err AbsC.Exp
pExp14 = fmap snd . pExp14_internal

pExp15 :: [Token] -> Err AbsC.Exp
pExp15 = fmap snd . pExp15_internal

pExp16 :: [Token] -> Err AbsC.Exp
pExp16 = fmap snd . pExp16_internal

pExp17 :: [Token] -> Err AbsC.Exp
pExp17 = fmap snd . pExp17_internal

pConstant :: [Token] -> Err AbsC.Constant
pConstant = fmap snd . pConstant_internal

pConstant_expression :: [Token] -> Err AbsC.Constant_expression
pConstant_expression = fmap snd . pConstant_expression_internal

pUnary_operator :: [Token] -> Err AbsC.Unary_operator
pUnary_operator = fmap snd . pUnary_operator_internal

pListExp2 :: [Token] -> Err [AbsC.Exp]
pListExp2 = fmap snd . pListExp2_internal

pAssignment_op :: [Token] -> Err AbsC.Assignment_op
pAssignment_op = fmap snd . pAssignment_op_internal
}