module Hydra.Sources.Tier4.Ext.Csharp.Syntax where

import Hydra.Sources.Tier3.All
import Hydra.Dsl.Types as Types
import Hydra.Dsl.Annotations
import Hydra.Dsl.Bootstrap


csharpSyntaxModule :: Module
csharpSyntaxModule :: Module
csharpSyntaxModule = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe String -> Module
Module Namespace
ns [Element]
elements [Module
hydraCoreModule] [Module]
tier0Modules (Maybe String -> Module) -> Maybe String -> Module
forall a b. (a -> b) -> a -> b
$
    String -> Maybe String
forall a. a -> Maybe a
Just (String
"A C# syntax module based on the ANTLR grammar dated 02/07/2024 and available at:\n"
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"  https://learn.microsoft.com/en-us/dotnet/csharp/language-reference/language-specification/grammar")
  where
    ns :: Namespace
ns = String -> Namespace
Namespace String
"hydra/ext/csharp/syntax"
    def :: String -> Type -> Element
def = Namespace -> String -> Type -> Element
datatype Namespace
ns
    csharp :: String -> Type
csharp = Namespace -> String -> Type
typeref Namespace
ns

    elements :: [Element]
elements = [Element]
lexicalElements [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
syntacticElements [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
unsafeElements

    lexicalElements :: [Element]
lexicalElements = [
-- // Source: §6.3.1 General
-- DEFAULT  : 'default' ;
-- NULL     : 'null' ;
-- TRUE     : 'true' ;
-- FALSE    : 'false' ;
-- ASTERISK : '*' ;
-- SLASH    : '/' ;
--
-- // Source: §6.3.1 General
-- input
--     : input_section?
--     ;
--
-- input_section
--     : input_section_part+
--     ;
--
-- input_section_part
--     : input_element* New_Line
--     | PP_Directive
--     ;
--
-- input_element
--     : Whitespace
--     | Comment
--     | token
--     ;
--
-- // Source: §6.3.2 Line terminators
-- New_Line
--     : New_Line_Character
--     | '\u000D\u000A'    // carriage return, line feed
--     ;
--
-- // Source: §6.3.3 Comments
-- Comment
--     : Single_Line_Comment
--     | Delimited_Comment
--     ;
--
-- fragment Single_Line_Comment
--     : '//' Input_Character*
--     ;
--
-- fragment Input_Character
--     // anything but New_Line_Character
--     : ~('\u000D' | '\u000A'   | '\u0085' | '\u2028' | '\u2029')
--     ;
--
-- fragment New_Line_Character
--     : '\u000D'  // carriage return
--     | '\u000A'  // line feed
--     | '\u0085'  // next line
--     | '\u2028'  // line separator
--     | '\u2029'  // paragraph separator
--     ;
--
-- fragment Delimited_Comment
--     : '/*' Delimited_Comment_Section* ASTERISK+ '/'
--     ;
--
-- fragment Delimited_Comment_Section
--     : SLASH
--     | ASTERISK* Not_Slash_Or_Asterisk
--     ;
--
-- fragment Not_Slash_Or_Asterisk
--     : ~('/' | '*')    // Any except SLASH or ASTERISK
--     ;
--
-- // Source: §6.3.4 White space
-- Whitespace
--     : [\p{Zs}]  // any character with Unicode class Zs
--     | '\u0009'  // horizontal tab
--     | '\u000B'  // vertical tab
--     | '\u000C'  // form feed
--     ;
--
-- // Source: §6.4.1 General
-- token
--     : identifier
--     | keyword
--     | Integer_Literal
--     | Real_Literal
--     | Character_Literal
--     | String_Literal
--     | operator_or_punctuator
--     ;
--
-- // Source: §6.4.2 Unicode character escape sequences
-- fragment Unicode_Escape_Sequence
--     : '\\u' Hex_Digit Hex_Digit Hex_Digit Hex_Digit
--     | '\\U' Hex_Digit Hex_Digit Hex_Digit Hex_Digit
--             Hex_Digit Hex_Digit Hex_Digit Hex_Digit
--     ;
--
-- // Source: §6.4.3 Identifiers
-- identifier
--     : Simple_Identifier
--     | contextual_keyword
--     ;

      String -> Type -> Element
def String
"Identifier" Type
string,

-- Simple_Identifier
--     : Available_Identifier
--     | Escaped_Identifier
--     ;
--
-- fragment Available_Identifier
--     // excluding keywords or contextual keywords, see note below
--     : Basic_Identifier
--     ;
--
-- fragment Escaped_Identifier
--     // Includes keywords and contextual keywords prefixed by '@'.
--     // See note below.
--     : '@' Basic_Identifier
--     ;
--
-- fragment Basic_Identifier
--     : Identifier_Start_Character Identifier_Part_Character*
--     ;
--
-- fragment Identifier_Start_Character
--     : Letter_Character
--     | Underscore_Character
--     ;
--
-- fragment Underscore_Character
--     : '_'               // underscore
--     | '\\u005' [fF]     // Unicode_Escape_Sequence for underscore
--     | '\\U0000005' [fF] // Unicode_Escape_Sequence for underscore
--     ;
--
-- fragment Identifier_Part_Character
--     : Letter_Character
--     | Decimal_Digit_Character
--     | Connecting_Character
--     | Combining_Character
--     | Formatting_Character
--     ;
--
-- fragment Letter_Character
--     // Category Letter, all subcategories; category Number, subcategory letter.
--     : [\p{L}\p{Nl}]
--     // Only escapes for categories L & Nl allowed. See note below.
--     | Unicode_Escape_Sequence
--     ;
--
-- fragment Combining_Character
--     // Category Mark, subcategories non-spacing and spacing combining.
--     : [\p{Mn}\p{Mc}]
--     // Only escapes for categories Mn & Mc allowed. See note below.
--     | Unicode_Escape_Sequence
--     ;
--
-- fragment Decimal_Digit_Character
--     // Category Number, subcategory decimal digit.
--     : [\p{Nd}]
--     // Only escapes for category Nd allowed. See note below.
--     | Unicode_Escape_Sequence
--     ;
--
-- fragment Connecting_Character
--     // Category Punctuation, subcategory connector.
--     : [\p{Pc}]
--     // Only escapes for category Pc allowed. See note below.
--     | Unicode_Escape_Sequence
--     ;
--
-- fragment Formatting_Character
--     // Category Other, subcategory format.
--     : [\p{Cf}]
--     // Only escapes for category Cf allowed, see note below.
--     | Unicode_Escape_Sequence
--     ;
--
-- // Source: §6.4.4 Keywords
-- keyword
--     : 'abstract' | 'as'       | 'base'       | 'bool'      | 'break'
--     | 'byte'     | 'case'     | 'catch'      | 'char'      | 'checked'
--     | 'class'    | 'const'    | 'continue'   | 'decimal'   | DEFAULT
--     | 'delegate' | 'do'       | 'double'     | 'else'      | 'enum'
--     | 'event'    | 'explicit' | 'extern'     | FALSE       | 'finally'
--     | 'fixed'    | 'float'    | 'for'        | 'foreach'   | 'goto'
--     | 'if'       | 'implicit' | 'in'         | 'int'       | 'interface'
--     | 'internal' | 'is'       | 'lock'       | 'long'      | 'namespace'
--     | 'new'      | NULL       | 'object'     | 'operator'  | 'out'
--     | 'override' | 'params'   | 'private'    | 'protected' | 'public'
--     | 'readonly' | 'ref'      | 'return'     | 'sbyte'     | 'sealed'
--     | 'short'    | 'sizeof'   | 'stackalloc' | 'static'    | 'string'
--     | 'struct'   | 'switch'   | 'this'       | 'throw'     | TRUE
--     | 'try'      | 'typeof'   | 'uint'       | 'ulong'     | 'unchecked'
--     | 'unsafe'   | 'ushort'   | 'using'      | 'virtual'   | 'void'
--     | 'volatile' | 'while'
--     ;

      String -> Type -> Element
def String
"Keyword" Type
string,

-- // Source: §6.4.4 Keywords
-- contextual_keyword
--     : 'add'    | 'alias'      | 'ascending' | 'async'     | 'await'
--     | 'by'     | 'descending' | 'dynamic'   | 'equals'    | 'from'
--     | 'get'    | 'global'     | 'group'     | 'into'      | 'join'
--     | 'let'    | 'nameof'     | 'on'        | 'orderby'   | 'partial'
--     | 'remove' | 'select'     | 'set'       | 'unmanaged' | 'value'
--     | 'var'    | 'when'       | 'where'     | 'yield'
--     ;
--
-- // Source: §6.4.5.1 General
-- literal
--     : boolean_literal
--     | Integer_Literal
--     | Real_Literal
--     | Character_Literal
--     | String_Literal
--     | null_literal
--     ;

      String -> Type -> Element
def String
"Literal" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"boolean"String -> Type -> FieldType
>: Type
boolean,
        String
"integer"String -> Type -> FieldType
>: String -> Type
csharp String
"IntegerLiteral",
        String
"real"String -> Type -> FieldType
>: Type
bigfloat,
        String
"character"String -> Type -> FieldType
>: Type
string,
        String
"string"String -> Type -> FieldType
>: Type
string,
        String
"null"String -> Type -> FieldType
>: Type
unit],

-- // Source: §6.4.5.2 Boolean literals
-- boolean_literal
--     : TRUE
--     | FALSE
--     ;
--
-- // Source: §6.4.5.3 Integer literals
-- Integer_Literal
--     : Decimal_Integer_Literal
--     | Hexadecimal_Integer_Literal
--     | Binary_Integer_Literal
--     ;

      String -> Type -> Element
def String
"IntegerLiteral" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"decimal"String -> Type -> FieldType
>: Type
string,
        String
"hexadecimal"String -> Type -> FieldType
>: Type
string,
        String
"binary"String -> Type -> FieldType
>: Type
bigint]

-- fragment Decimal_Integer_Literal
--     : Decimal_Digit Decorated_Decimal_Digit* Integer_Type_Suffix?
--     ;
--
-- fragment Decorated_Decimal_Digit
--     : '_'* Decimal_Digit
--     ;
--
-- fragment Decimal_Digit
--     : '0'..'9'
--     ;
--
-- fragment Integer_Type_Suffix
--     : 'U' | 'u' | 'L' | 'l' |
--       'UL' | 'Ul' | 'uL' | 'ul' | 'LU' | 'Lu' | 'lU' | 'lu'
--     ;
--
-- fragment Hexadecimal_Integer_Literal
--     : ('0x' | '0X') Decorated_Hex_Digit+ Integer_Type_Suffix?
--     ;
--
-- fragment Decorated_Hex_Digit
--     : '_'* Hex_Digit
--     ;
--
-- fragment Hex_Digit
--     : '0'..'9' | 'A'..'F' | 'a'..'f'
--     ;
--
-- fragment Binary_Integer_Literal
--     : ('0b' | '0B') Decorated_Binary_Digit+ Integer_Type_Suffix?
--     ;
--
-- fragment Decorated_Binary_Digit
--     : '_'* Binary_Digit
--     ;
--
-- fragment Binary_Digit
--     : '0' | '1'
--     ;
--
-- // Source: §6.4.5.4 Real literals
-- Real_Literal
--     : Decimal_Digit Decorated_Decimal_Digit* '.'
--       Decimal_Digit Decorated_Decimal_Digit* Exponent_Part? Real_Type_Suffix?
--     | '.' Decimal_Digit Decorated_Decimal_Digit* Exponent_Part? Real_Type_Suffix?
--     | Decimal_Digit Decorated_Decimal_Digit* Exponent_Part Real_Type_Suffix?
--     | Decimal_Digit Decorated_Decimal_Digit* Real_Type_Suffix
--     ;
--
-- fragment Exponent_Part
--     : ('e' | 'E') Sign? Decimal_Digit Decorated_Decimal_Digit*
--     ;
--
-- fragment Sign
--     : '+' | '-'
--     ;
--
-- fragment Real_Type_Suffix
--     : 'F' | 'f' | 'D' | 'd' | 'M' | 'm'
--     ;
--
-- // Source: §6.4.5.5 Character literals
-- Character_Literal
--     : '\'' Character '\''
--     ;
--
-- fragment Character
--     : Single_Character
--     | Simple_Escape_Sequence
--     | Hexadecimal_Escape_Sequence
--     | Unicode_Escape_Sequence
--     ;
--
-- fragment Single_Character
--     // anything but ', \, and New_Line_Character
--     : ~['\\\u000D\u000A\u0085\u2028\u2029]
--     ;
--
-- fragment Simple_Escape_Sequence
--     : '\\\'' | '\\"' | '\\\\' | '\\0' | '\\a' | '\\b' |
--       '\\f' | '\\n' | '\\r' | '\\t' | '\\v'
--     ;
--
-- fragment Hexadecimal_Escape_Sequence
--     : '\\x' Hex_Digit Hex_Digit? Hex_Digit? Hex_Digit?
--     ;
--
-- // Source: §6.4.5.6 String literals
-- String_Literal
--     : Regular_String_Literal
--     | Verbatim_String_Literal
--     ;
--
-- fragment Regular_String_Literal
--     : '"' Regular_String_Literal_Character* '"'
--     ;
--
-- fragment Regular_String_Literal_Character
--     : Single_Regular_String_Literal_Character
--     | Simple_Escape_Sequence
--     | Hexadecimal_Escape_Sequence
--     | Unicode_Escape_Sequence
--     ;
--
-- fragment Single_Regular_String_Literal_Character
--     // anything but ", \, and New_Line_Character
--     : ~["\\\u000D\u000A\u0085\u2028\u2029]
--     ;
--
-- fragment Verbatim_String_Literal
--     : '@"' Verbatim_String_Literal_Character* '"'
--     ;
--
-- fragment Verbatim_String_Literal_Character
--     : Single_Verbatim_String_Literal_Character
--     | Quote_Escape_Sequence
--     ;
--
-- fragment Single_Verbatim_String_Literal_Character
--     : ~["]     // anything but quotation mark (U+0022)
--     ;
--
-- fragment Quote_Escape_Sequence
--     : '""'
--     ;
--
-- // Source: §6.4.5.7 The null literal
-- null_literal
--     : NULL
--     ;
--
-- // Source: §6.4.6 Operators and punctuators
-- operator_or_punctuator
--     : '{'  | '}'  | '['  | ']'  | '('   | ')'  | '.'  | ','  | ':'  | ';'
--     | '+'  | '-'  | ASTERISK    | SLASH | '%'  | '&'  | '|'  | '^'  | '!' | '~'
--     | '='  | '<'  | '>'  | '?'  | '??'  | '::' | '++' | '--' | '&&' | '||'
--     | '->' | '==' | '!=' | '<=' | '>='  | '+=' | '-=' | '*=' | '/=' | '%='
--     | '&=' | '|=' | '^=' | '<<' | '<<=' | '=>'
--     ;
--
-- right_shift
--     : '>'  '>'
--     ;
--
-- right_shift_assignment
--     : '>' '>='
--     ;
--
-- // Source: §6.5.1 General
-- PP_Directive
--     : PP_Start PP_Kind PP_New_Line
--     ;
--
-- fragment PP_Kind
--     : PP_Declaration
--     | PP_Conditional
--     | PP_Line
--     | PP_Diagnostic
--     | PP_Region
--     | PP_Pragma
--     | PP_Nullable
--     ;
--
-- // Only recognised at the beginning of a line
-- fragment PP_Start
--     // See note below.
--     : { getCharPositionInLine() == 0 }? PP_Whitespace? '#' PP_Whitespace?
--     ;
--
-- fragment PP_Whitespace
--     : ( [\p{Zs}]  // any character with Unicode class Zs
--       | '\u0009'  // horizontal tab
--       | '\u000B'  // vertical tab
--       | '\u000C'  // form feed
--       )+
--     ;
--
-- fragment PP_New_Line
--     : PP_Whitespace? Single_Line_Comment? New_Line
--     ;
--
-- // Source: §6.5.2 Conditional compilation symbols
-- fragment PP_Conditional_Symbol
--     // Must not be equal to tokens TRUE or FALSE. See note below.
--     : Basic_Identifier
--     ;
--
-- // Source: §6.5.3 Pre-processing expressions
-- fragment PP_Expression
--     : PP_Whitespace? PP_Or_Expression PP_Whitespace?
--     ;
--
-- fragment PP_Or_Expression
--     : PP_And_Expression (PP_Whitespace? '||' PP_Whitespace? PP_And_Expression)*
--     ;
--
-- fragment PP_And_Expression
--     : PP_Equality_Expression (PP_Whitespace? '&&' PP_Whitespace?
--       PP_Equality_Expression)*
--     ;
--
-- fragment PP_Equality_Expression
--     : PP_Unary_Expression (PP_Whitespace? ('==' | '!=') PP_Whitespace?
--       PP_Unary_Expression)*
--     ;
--
-- fragment PP_Unary_Expression
--     : PP_Primary_Expression
--     | '!' PP_Whitespace? PP_Unary_Expression
--     ;
--
-- fragment PP_Primary_Expression
--     : TRUE
--     | FALSE
--     | PP_Conditional_Symbol
--     | '(' PP_Whitespace? PP_Expression PP_Whitespace? ')'
--     ;
--
-- // Source: §6.5.4 Definition directives
-- fragment PP_Declaration
--     : 'define' PP_Whitespace PP_Conditional_Symbol
--     | 'undef' PP_Whitespace PP_Conditional_Symbol
--     ;
--
-- // Source: §6.5.5 Conditional compilation directives
-- fragment PP_Conditional
--     : PP_If_Section
--     | PP_Elif_Section
--     | PP_Else_Section
--     | PP_Endif
--     ;
--
-- fragment PP_If_Section
--     : 'if' PP_Whitespace PP_Expression
--     ;
--
-- fragment PP_Elif_Section
--     : 'elif' PP_Whitespace PP_Expression
--     ;
--
-- fragment PP_Else_Section
--     : 'else'
--     ;
--
-- fragment PP_Endif
--     : 'endif'
--     ;
--
-- // Source: §6.5.6 Diagnostic directives
-- fragment PP_Diagnostic
--     : 'error' PP_Message?
--     | 'warning' PP_Message?
--     ;
--
-- fragment PP_Message
--     : PP_Whitespace Input_Character*
--     ;
--
-- // Source: §6.5.7 Region directives
-- fragment PP_Region
--     : PP_Start_Region
--     | PP_End_Region
--     ;
--
-- fragment PP_Start_Region
--     : 'region' PP_Message?
--     ;
--
-- fragment PP_End_Region
--     : 'endregion' PP_Message?
--     ;
--
-- // Source: §6.5.8 Line directives
-- fragment PP_Line
--     : 'line' PP_Whitespace PP_Line_Indicator
--     ;
--
-- fragment PP_Line_Indicator
--     : Decimal_Digit+ PP_Whitespace PP_Compilation_Unit_Name
--     | Decimal_Digit+
--     | DEFAULT
--     | 'hidden'
--     ;
--
-- fragment PP_Compilation_Unit_Name
--     : '"' PP_Compilation_Unit_Name_Character+ '"'
--     ;
--
-- fragment PP_Compilation_Unit_Name_Character
--     // Any Input_Character except "
--     : ~('\u000D' | '\u000A'   | '\u0085' | '\u2028' | '\u2029' | '#')
--     ;
--
-- // Source: §6.5.9 Nullable directive
-- fragment PP_Nullable
--     : 'nullable' PP_Whitespace PP_Nullable_Action (PP_Whitespace PP_Nullable_Target)?
--     ;
-- fragment PP_Nullable_Action
--     : 'disable'
--     | 'enable'
--     | 'restore'
--     ;
-- fragment PP_Nullable_Target
--     : 'warnings'
--     | 'annotations'
--     ;
--
-- // Source: §6.5.10 Pragma directives
-- fragment PP_Pragma
--     : 'pragma' PP_Pragma_Text?
--     ;
--
-- fragment PP_Pragma_Text
--     : PP_Whitespace Input_Character*
--     ;
      ]

    syntacticElements :: [Element]
syntacticElements = [
-- // Source: §7.8.1 General
-- namespace_name
--     : namespace_or_type_name
--     ;

      String -> Type -> Element
def String
"NamespaceName" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"NamespaceOrTypeName",

-- type_name
--     : namespace_or_type_name
--     ;

      String -> Type -> Element
def String
"TypeName" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"NamespaceOrTypeName",

-- namespace_or_type_name
--     : identifier type_argument_list?
--     | namespace_or_type_name '.' identifier type_argument_list?
--     | qualified_alias_member
--     ;

        String -> Type -> Element
def String
"NamespaceOrTypeName" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
          String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"IdentifierNamespaceOrTypeName",
          String
"qualified"String -> Type -> FieldType
>: String -> Type
csharp String
"QualifiedNamespaceOrTypeName",
          String
"alias"String -> Type -> FieldType
>: String -> Type
csharp String
"QualifiedAliasMember"],

        String -> Type -> Element
def String
"IdentifierNamespaceOrTypeName" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
          String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
          String
"arguments"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeArgumentList"],

       String -> Type -> Element
def String
"QualifiedNamespaceOrTypeName" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
          String
"namespaceOrType"String -> Type -> FieldType
>: String -> Type
csharp String
"NamespaceOrTypeName",
          String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
          String
"arguments"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeArgumentList"],

-- // Source: §8.1 General
-- type
--     : reference_type
--     | value_type
--     | type_parameter
--     | pointer_type     // unsafe code support
--     ;

      String -> Type -> Element
def String
"Type" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"reference"String -> Type -> FieldType
>: String -> Type
csharp String
"ReferenceType",
        String
"value"String -> Type -> FieldType
>: String -> Type
csharp String
"ValueType",
        String
"param"String -> Type -> FieldType
>: String -> Type
csharp String
"TypeParameter",
        String
"pointer"String -> Type -> FieldType
>: String -> Type
csharp String
"PointerType"],

-- // Source: §8.2.1 General
-- reference_type
--     : class_type
--     | interface_type
--     | array_type
--     | delegate_type
--     | 'dynamic'
--     ;

      String -> Type -> Element
def String
"ReferenceType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"class"String -> Type -> FieldType
>: String -> Type
csharp String
"ClassType",
        String
"interface"String -> Type -> FieldType
>: String -> Type
csharp String
"InterfaceType",
        String
"array"String -> Type -> FieldType
>: String -> Type
csharp String
"ArrayType",
        String
"delegate"String -> Type -> FieldType
>: String -> Type
csharp String
"DelegateType",
        String
"dynamic"String -> Type -> FieldType
>: Type
unit],

-- class_type
--     : type_name
--     | 'object'
--     | 'string'
--     ;

      String -> Type -> Element
def String
"ClassType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"typeName"String -> Type -> FieldType
>: String -> Type
csharp String
"TypeName",
        String
"object"String -> Type -> FieldType
>: Type
unit,
        String
"string"String -> Type -> FieldType
>: Type
unit],

-- interface_type
--     : type_name
--     ;

      String -> Type -> Element
def String
"InterfaceType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeName",

-- array_type
--     : non_array_type rank_specifier+
--     ;

      String -> Type -> Element
def String
"ArrayType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"NonArrayType",
        String
"rank"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"RankSpecifier"],

-- non_array_type
--     : value_type
--     | class_type
--     | interface_type
--     | delegate_type
--     | 'dynamic'
--     | type_parameter
--     | pointer_type      // unsafe code support
--     ;

      String -> Type -> Element
def String
"NonArrayType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"value"String -> Type -> FieldType
>: String -> Type
csharp String
"ValueType",
        String
"class"String -> Type -> FieldType
>: String -> Type
csharp String
"ClassType",
        String
"interface"String -> Type -> FieldType
>: String -> Type
csharp String
"InterfaceType",
        String
"delegate"String -> Type -> FieldType
>: String -> Type
csharp String
"DelegateType",
        String
"dynamic"String -> Type -> FieldType
>: Type
unit,
        String
"parameter"String -> Type -> FieldType
>: String -> Type
csharp String
"TypeParameter",
        String
"pointer"String -> Type -> FieldType
>: String -> Type
csharp String
"PointerType"],

-- rank_specifier
--     : '[' ','* ']'
--     ;

      String -> Type -> Element
def String
"RankSpecifier" Type
int32, -- Note: non-negative

-- delegate_type
--     : type_name
--     ;

      String -> Type -> Element
def String
"DelegateType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeName",

-- // Source: §8.3.1 General
-- value_type
--     : non_nullable_value_type
--     | nullable_value_type
--     ;

      String -> Type -> Element
def String
"ValueType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"nonNullable"String -> Type -> FieldType
>: String -> Type
csharp String
"StructOrEnumType",
        String
"nullable"String -> Type -> FieldType
>: String -> Type
csharp String
"StructOrEnumType"],

-- non_nullable_value_type
--     : struct_type
--     | enum_type
--     ;

      String -> Type -> Element
def String
"StructOrEnumType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"struct"String -> Type -> FieldType
>: String -> Type
csharp String
"StructType",
        String
"enum"String -> Type -> FieldType
>: String -> Type
csharp String
"EnumType"],

-- struct_type
--     : type_name
--     | simple_type
--     | tuple_type
--     ;

      String -> Type -> Element
def String
"StructType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"typeName"String -> Type -> FieldType
>: String -> Type
csharp String
"TypeName",
        String
"simple"String -> Type -> FieldType
>: String -> Type
csharp String
"SimpleType",
        String
"tuple"String -> Type -> FieldType
>: String -> Type
csharp String
"TupleType"],

-- simple_type
--     : numeric_type
--     | 'bool'
--     ;

      String -> Type -> Element
def String
"SimpleType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"numeric"String -> Type -> FieldType
>: String -> Type
csharp String
"NumericType",
        String
"bool"String -> Type -> FieldType
>: Type
unit],

-- numeric_type
--     : integral_type
--     | floating_point_type
--     | 'decimal'
--     ;

      String -> Type -> Element
def String
"NumericType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"integral"String -> Type -> FieldType
>: String -> Type
csharp String
"IntegralType",
        String
"floatingPoint"String -> Type -> FieldType
>: String -> Type
csharp String
"FloatingPointType",
        String
"decimal"String -> Type -> FieldType
>: Type
unit],

-- integral_type
--     : 'sbyte'
--     | 'byte'
--     | 'short'
--     | 'ushort'
--     | 'int'
--     | 'uint'
--     | 'long'
--     | 'ulong'
--     | 'char'
--     ;

      String -> Type -> Element
def String
"IntegralType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"sbyte"String -> Type -> FieldType
>: Type
unit,
        String
"byte"String -> Type -> FieldType
>: Type
unit,
        String
"short"String -> Type -> FieldType
>: Type
unit,
        String
"ushort"String -> Type -> FieldType
>: Type
unit,
        String
"int"String -> Type -> FieldType
>: Type
unit,
        String
"uint"String -> Type -> FieldType
>: Type
unit,
        String
"long"String -> Type -> FieldType
>: Type
unit,
        String
"ulong"String -> Type -> FieldType
>: Type
unit,
        String
"char"String -> Type -> FieldType
>: Type
unit],

-- floating_point_type
--     : 'float'
--     | 'double'
--     ;

      String -> Type -> Element
def String
"FloatingPointType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"float"String -> Type -> FieldType
>: Type
unit,
        String
"double"String -> Type -> FieldType
>: Type
unit],

-- tuple_type
--     : '(' tuple_type_element (',' tuple_type_element)+ ')'
--     ;

      String -> Type -> Element
def String
"TupleType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TupleTypeElement",

-- tuple_type_element
--     : type identifier?
--     ;

      String -> Type -> Element
def String
"TupleTypeElement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"identifier"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Identifier"],

-- enum_type
--     : type_name
--     ;

      String -> Type -> Element
def String
"EnumType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeName",

-- nullable_value_type
--     : non_nullable_value_type '?'
--     ;
--
-- // Source: §8.4.2 Type arguments
-- type_argument_list
--     : '<' type_arguments '>'
--     ;

      String -> Type -> Element
def String
"TypeArgumentList" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Type",

-- type_arguments
--     : type_argument (',' type_argument)*
--     ;
--
-- type_argument
--     : type
--     ;
--
-- // Source: §8.5 Type parameters
-- type_parameter
--     : identifier
--     ;

      String -> Type -> Element
def String
"TypeParameter" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Identifier",

-- // Source: §8.8 Unmanaged types
-- unmanaged_type
--     : value_type
--     | pointer_type     // unsafe code support
--     ;

      String -> Type -> Element
def String
"UnmanagedType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"value"String -> Type -> FieldType
>: String -> Type
csharp String
"ValueType",
        String
"pointer"String -> Type -> FieldType
>: String -> Type
csharp String
"PointerType"],

-- // Source: §9.5 Variable references
-- variable_reference
--     : expression
--     ;

      String -> Type -> Element
def String
"VariableReference" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Expression",

-- // Source: §11.2.1 General
-- pattern
--     : declaration_pattern
--     | constant_pattern
--     | var_pattern
--     ;

      String -> Type -> Element
def String
"Pattern" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"declaration"String -> Type -> FieldType
>: String -> Type
csharp String
"DeclarationPattern",
        String
"constant"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"var"String -> Type -> FieldType
>: String -> Type
csharp String
"Designation"],

-- // Source: §11.2.2 Declaration pattern
-- declaration_pattern
--     : type simple_designation
--     ;

      String -> Type -> Element
def String
"DeclarationPattern" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"designation"String -> Type -> FieldType
>: String -> Type
csharp String
"Designation"],

-- simple_designation
--     : single_variable_designation
--     ;

      String -> Type -> Element
def String
"Designation" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Identifier",

-- single_variable_designation
--     : identifier
--     ;
--
-- // Source: §11.2.3 Constant pattern
-- constant_pattern
--     : constant_expression
--     ;
--
-- // Source: §11.2.4 Var pattern
-- var_pattern
--     : 'var' designation
--     ;
-- designation
--     : simple_designation
--     ;
--
-- // Source: §12.6.2.1 General
-- argument_list
--     : argument (',' argument)*
--     ;

      String -> Type -> Element
def String
"ArgumentList" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Argument",

-- argument
--     : argument_name? argument_value
--     ;

      String -> Type -> Element
def String
"Argument" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"name"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Identifier",
        String
"value"String -> Type -> FieldType
>: String -> Type
csharp String
"ArgumentValue"],

-- argument_name
--     : identifier ':'
--     ;
--
-- argument_value
--     : expression
--     | 'in' variable_reference
--     | 'ref' variable_reference
--     | 'out' variable_reference
--     ;

      String -> Type -> Element
def String
"ArgumentValue" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"in"String -> Type -> FieldType
>: String -> Type
csharp String
"VariableReference",
        String
"ref"String -> Type -> FieldType
>: String -> Type
csharp String
"VariableReference",
        String
"out"String -> Type -> FieldType
>: String -> Type
csharp String
"VariableReference"],

-- // Source: §12.8.1 General
-- primary_expression
--     : primary_no_array_creation_expression
--     | array_creation_expression
--     ;

      String -> Type -> Element
def String
"PrimaryExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"noArray"String -> Type -> FieldType
>: String -> Type
csharp String
"PrimaryNoArrayCreationExpression",
        String
"array"String -> Type -> FieldType
>: String -> Type
csharp String
"ArrayCreationExpression"],

-- primary_no_array_creation_expression
--     : literal
--     | interpolated_string_expression
--     | simple_name
--     | parenthesized_expression
--     | tuple_expression
--     | member_access
--     | null_conditional_member_access
--     | invocation_expression
--     | element_access
--     | null_conditional_element_access
--     | this_access
--     | base_access
--     | post_increment_expression
--     | post_decrement_expression
--     | object_creation_expression
--     | delegate_creation_expression
--     | anonymous_object_creation_expression
--     | typeof_expression
--     | sizeof_expression
--     | checked_expression
--     | unchecked_expression
--     | default_value_expression
--     | nameof_expression
--     | anonymous_method_expression
--     | pointer_member_access     // unsafe code support
--     | pointer_element_access    // unsafe code support
--     | stackalloc_expression
--     ;

      String -> Type -> Element
def String
"PrimaryNoArrayCreationExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"literal"String -> Type -> FieldType
>: String -> Type
csharp String
"Literal",
        String
"interpolatedString"String -> Type -> FieldType
>: String -> Type
csharp String
"InterpolatedStringExpression",
        String
"simpleName"String -> Type -> FieldType
>: String -> Type
csharp String
"SimpleName",
        String
"parenthesized"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"tuple"String -> Type -> FieldType
>: String -> Type
csharp String
"TupleExpression",
        String
"memberAccess"String -> Type -> FieldType
>: String -> Type
csharp String
"MemberAccess",
        String
"nullConditionalMemberAccess"String -> Type -> FieldType
>: String -> Type
csharp String
"NullConditionalMemberAccess",
        String
"invocation"String -> Type -> FieldType
>: String -> Type
csharp String
"InvocationExpression",
        String
"elementAccess"String -> Type -> FieldType
>: String -> Type
csharp String
"ElementAccess",
        String
"nullConditionalElementAccess"String -> Type -> FieldType
>: String -> Type
csharp String
"NullConditionalElementAccess",
        String
"thisAccess"String -> Type -> FieldType
>: Type
unit,
        String
"baseAccess"String -> Type -> FieldType
>: String -> Type
csharp String
"BaseAccess",
        String
"postIncrement"String -> Type -> FieldType
>: String -> Type
csharp String
"PrimaryExpression",
        String
"postDecrement"String -> Type -> FieldType
>: String -> Type
csharp String
"PrimaryExpression",
        String
"objectCreation"String -> Type -> FieldType
>: String -> Type
csharp String
"ObjectCreationExpression",
        String
"delegateCreation"String -> Type -> FieldType
>: String -> Type
csharp String
"DelegateCreationExpression",
        String
"anonymousObjectCreation"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"MemberDeclaratorList",
        String
"typeof"String -> Type -> FieldType
>: String -> Type
csharp String
"TypeofExpression",
        String
"sizeof"String -> Type -> FieldType
>: String -> Type
csharp String
"UnmanagedType",
        String
"checked"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"unchecked"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"defaultValue"String -> Type -> FieldType
>: String -> Type
csharp String
"DefaultValueExpression",
        String
"nameof"String -> Type -> FieldType
>: String -> Type
csharp String
"NamedEntity",
        String
"anonymousMethod"String -> Type -> FieldType
>: String -> Type
csharp String
"AnonymousMethodExpression",
        String
"pointerMemberAccess"String -> Type -> FieldType
>: String -> Type
csharp String
"PointerMemberAccess",
        String
"pointerElementAccess"String -> Type -> FieldType
>: String -> Type
csharp String
"PointerElementAccess",
        String
"stackalloc"String -> Type -> FieldType
>: String -> Type
csharp String
"StackallocExpression"],

-- // Source: §12.8.3 Interpolated string expressions
-- interpolated_string_expression
--     : interpolated_regular_string_expression
--     | interpolated_verbatim_string_expression
--     ;

      String -> Type -> Element
def String
"InterpolatedStringExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"regular"String -> Type -> FieldType
>: String -> Type
csharp String
"InterpolatedRegularStringExpression",
        String
"verbatim"String -> Type -> FieldType
>: String -> Type
csharp String
"InterpolatedVerbatimStringExpression"],

-- // interpolated regular string expressions
--
-- interpolated_regular_string_expression
--     : Interpolated_Regular_String_Start Interpolated_Regular_String_Mid?
--       ('{' regular_interpolation '}' Interpolated_Regular_String_Mid?)*
--       Interpolated_Regular_String_End
--     ;

      String -> Type -> Element
def String
"InterpolatedRegularStringExpression" Type
string,

-- regular_interpolation
--     : expression (',' interpolation_minimum_width)?
--       Regular_Interpolation_Format?
--     ;

      String -> Type -> Element
def String
"RegularInterpolation" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"width"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Expression",
        String
"format"String -> Type -> FieldType
>: Type -> Type
optional Type
string],

-- interpolation_minimum_width
--     : constant_expression
--     ;
--
-- Interpolated_Regular_String_Start
--     : '$"'
--     ;
--
-- // the following three lexical rules are context sensitive, see details below
--
-- Interpolated_Regular_String_Mid
--     : Interpolated_Regular_String_Element+
--     ;
--
-- Regular_Interpolation_Format
--     : ':' Interpolated_Regular_String_Element+
--     ;
--
-- Interpolated_Regular_String_End
--     : '"'
--     ;
--
-- fragment Interpolated_Regular_String_Element
--     : Interpolated_Regular_String_Character
--     | Simple_Escape_Sequence
--     | Hexadecimal_Escape_Sequence
--     | Unicode_Escape_Sequence
--     | Open_Brace_Escape_Sequence
--     | Close_Brace_Escape_Sequence
--     ;
--
-- fragment Interpolated_Regular_String_Character
--     // Any character except " (U+0022), \\ (U+005C),
--     // { (U+007B), } (U+007D), and New_Line_Character.
--     : ~["\\{}\u000D\u000A\u0085\u2028\u2029]
--     ;
--
-- // interpolated verbatim string expressions
--
-- interpolated_verbatim_string_expression
--     : Interpolated_Verbatim_String_Start Interpolated_Verbatim_String_Mid?
--       ('{' verbatim_interpolation '}' Interpolated_Verbatim_String_Mid?)*
--       Interpolated_Verbatim_String_End
--     ;

      String -> Type -> Element
def String
"InterpolatedVerbatimStringExpression" Type
string,

-- verbatim_interpolation
--     : expression (',' interpolation_minimum_width)?
--       Verbatim_Interpolation_Format?
--     ;

      String -> Type -> Element
def String
"VerbatimInterpolation" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"width"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ConstantExpression",
        String
"format"String -> Type -> FieldType
>: Type -> Type
optional Type
string],

-- Interpolated_Verbatim_String_Start
--     : '$@"'
--     | '@$"'
--     ;
--
-- // the following three lexical rules are context sensitive, see details below
--
-- Interpolated_Verbatim_String_Mid
--     : Interpolated_Verbatim_String_Element+
--     ;
--
-- Verbatim_Interpolation_Format
--     : ':' Interpolated_Verbatim_String_Element+
--     ;
--
-- Interpolated_Verbatim_String_End
--     : '"'
--     ;
--
-- fragment Interpolated_Verbatim_String_Element
--     : Interpolated_Verbatim_String_Character
--     | Quote_Escape_Sequence
--     | Open_Brace_Escape_Sequence
--     | Close_Brace_Escape_Sequence
--     ;
--
-- fragment Interpolated_Verbatim_String_Character
--     : ~["{}]    // Any character except " (U+0022), { (U+007B) and } (U+007D)
--     ;
--
-- // lexical fragments used by both regular and verbatim interpolated strings
--
-- fragment Open_Brace_Escape_Sequence
--     : '{{'
--     ;
--
-- fragment Close_Brace_Escape_Sequence
--     : '}}'
--     ;
--
-- // Source: §12.8.4 Simple names
-- simple_name
--     : identifier type_argument_list?
--     ;

      String -> Type -> Element
def String
"SimpleName" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"typeArguments"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeArgumentList"],

-- // Source: §12.8.5 Parenthesized expressions
-- parenthesized_expression
--     : '(' expression ')'
--     ;
--
-- // Source: §12.8.6 Tuple expressions
-- tuple_expression
--     : '(' tuple_element (',' tuple_element)+ ')'
--     | deconstruction_expression
--     ;

      String -> Type -> Element
def String
"TupleExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"elements"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TupleElement",
        String
"deconstruction"String -> Type -> FieldType
>: String -> Type
csharp String
"DeconstructionTuple"],

-- tuple_element
--     : (identifier ':')? expression
--     ;

      String -> Type -> Element
def String
"TupleElement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"name"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Identifier",
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression"],

-- deconstruction_expression
--     : 'var' deconstruction_tuple
--     ;
--
-- deconstruction_tuple
--     : '(' deconstruction_element (',' deconstruction_element)+ ')'
--     ;

      String -> Type -> Element
def String
"DeconstructionTuple" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"DeconstructionElement",

-- deconstruction_element
--     : deconstruction_tuple
--     | identifier
--     ;

      String -> Type -> Element
def String
"DeconstructionElement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"tuple"String -> Type -> FieldType
>: String -> Type
csharp String
"DeconstructionTuple",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier"],

-- // Source: §12.8.7.1 General
-- member_access
--     : primary_expression '.' identifier type_argument_list?
--     | predefined_type '.' identifier type_argument_list?
--     | qualified_alias_member '.' identifier type_argument_list?
--     ;

      String -> Type -> Element
def String
"MemberAccess" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"head"String -> Type -> FieldType
>: String -> Type
csharp String
"MemberAccessHead",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"typeArguments"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeArgumentList"],

      String -> Type -> Element
def String
"MemberAccessHead" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"primary"String -> Type -> FieldType
>: String -> Type
csharp String
"PrimaryExpression",
        String
"predefined"String -> Type -> FieldType
>: String -> Type
csharp String
"PredefinedType",
        String
"qualifiedAlias"String -> Type -> FieldType
>: String -> Type
csharp String
"QualifiedAliasMember"],

-- predefined_type
--     : 'bool' | 'byte' | 'char' | 'decimal' | 'double' | 'float' | 'int'
--     | 'long' | 'object' | 'sbyte' | 'short' | 'string' | 'uint' | 'ulong'
--     | 'ushort'
--     ;

      String -> Type -> Element
def String
"PredefinedType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"bool", String
"byte", String
"char", String
"decimal", String
"double", String
"float", String
"int", String
"long", String
"object", String
"sbyte", String
"short", String
"string",
         String
"uint", String
"ulong", String
"ushort"],

-- // Source: §12.8.8 Null Conditional Member Access
-- null_conditional_member_access
--     : primary_expression '?' '.' identifier type_argument_list?
--       dependent_access*
--     ;

      String -> Type -> Element
def String
"NullConditionalMemberAccess" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"PrimaryExpression",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"typeArguments"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeArgumentList",
        String
"dependentAccess"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"DependentAccess"],

-- dependent_access
--     : '.' identifier type_argument_list?    // member access
--     | '[' argument_list ']'                 // element access
--     | '(' argument_list? ')'                // invocation
--     ;

      String -> Type -> Element
def String
"DependentAccess" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"memberAccess"String -> Type -> FieldType
>: String -> Type
csharp String
"DependentAccessForMember",
        String
"elementAccess"String -> Type -> FieldType
>: String -> Type
csharp String
"ArgumentList",
        String
"invocation"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ArgumentList"],

      String -> Type -> Element
def String
"DependentAccessForMember" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"typeArguments"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeArgumentList"],

-- null_conditional_projection_initializer
--     : primary_expression '?' '.' identifier type_argument_list?
--     ;

      String -> Type -> Element
def String
"NullConditionalProjectionInitializer" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"PrimaryExpression",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"typeArguments"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeArgumentList"],

-- // Source: §12.8.9.1 General
-- invocation_expression
--     : primary_expression '(' argument_list? ')'
--     ;

      String -> Type -> Element
def String
"InvocationExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"PrimaryExpression",
        String
"arguments"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ArgumentList"],

-- // Source: §12.8.10 Null Conditional Invocation Expression
-- null_conditional_invocation_expression
--     : null_conditional_member_access '(' argument_list? ')'
--     | null_conditional_element_access '(' argument_list? ')'
--     ;

      String -> Type -> Element
def String
"NullConditionalInvocationExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"head"String -> Type -> FieldType
>: String -> Type
csharp String
"NullConditionalInvocationExpressionHead",
        String
"arguments"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ArgumentList"],

      String -> Type -> Element
def String
"NullConditionalInvocationExpressionHead" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"member"String -> Type -> FieldType
>: String -> Type
csharp String
"NullConditionalMemberAccess",
        String
"element"String -> Type -> FieldType
>: String -> Type
csharp String
"NullConditionalElementAccess"],

-- // Source: §12.8.11.1 General
-- element_access
--     : primary_no_array_creation_expression '[' argument_list ']'
--     ;

      String -> Type -> Element
def String
"ElementAccess" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"PrimaryNoArrayCreationExpression",
        String
"arguments"String -> Type -> FieldType
>: String -> Type
csharp String
"ArgumentList"],

-- // Source: §12.8.12 Null Conditional Element Access
-- null_conditional_element_access
--     : primary_no_array_creation_expression '?' '[' argument_list ']'
--       dependent_access*
--     ;

      String -> Type -> Element
def String
"NullConditionalElementAccess" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"PrimaryNoArrayCreationExpression",
        String
"arguments"String -> Type -> FieldType
>: String -> Type
csharp String
"ArgumentList",
        String
"dependentAccess"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"DependentAccess"],

-- // Source: §12.8.13 This access
-- this_access
--     : 'this'
--     ;
--
-- // Source: §12.8.14 Base access
-- base_access
--     : 'base' '.' identifier type_argument_list?
--     | 'base' '[' argument_list ']'
--     ;

      String -> Type -> Element
def String
"BaseAccess" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"BaseAccessWithIdentifier",
        String
"arguments"String -> Type -> FieldType
>: String -> Type
csharp String
"ArgumentList"],

      String -> Type -> Element
def String
"BaseAccessWithIdentifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"typeArguments"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeArgumentList"],

-- // Source: §12.8.15 Postfix increment and decrement operators
-- post_increment_expression
--     : primary_expression '++'
--     ;
--
-- post_decrement_expression
--     : primary_expression '--'
--     ;
--
-- // Source: §12.8.16.2 Object creation expressions
-- object_creation_expression
--     : 'new' type '(' argument_list? ')' object_or_collection_initializer?
--     | 'new' type object_or_collection_initializer
--     ;

      String -> Type -> Element
def String
"ObjectCreationExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"arguments"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ArgumentList",
        String
"initializer"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ObjectOrCollectionInitializer"],

-- object_or_collection_initializer
--     : object_initializer
--     | collection_initializer
--     ;

      String -> Type -> Element
def String
"ObjectOrCollectionInitializer" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"object"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"MemberInitializer",
        String
"collection"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ElementInitializer"],

-- // Source: §12.8.16.3 Object initializers
-- object_initializer
--     : '{' member_initializer_list? '}'
--     | '{' member_initializer_list ',' '}'
--     ;
--
-- member_initializer_list
--     : member_initializer (',' member_initializer)*
--     ;
--
-- member_initializer
--     : initializer_target '=' initializer_value
--     ;

      String -> Type -> Element
def String
"MemberInitializer" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"target"String -> Type -> FieldType
>: String -> Type
csharp String
"InitializerTarget",
        String
"value"String -> Type -> FieldType
>: String -> Type
csharp String
"InitializerValue"],

-- initializer_target
--     : identifier
--     | '[' argument_list ']'
--     ;

      String -> Type -> Element
def String
"InitializerTarget" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"arguments"String -> Type -> FieldType
>: String -> Type
csharp String
"ArgumentList"],

-- initializer_value
--     : expression
--     | object_or_collection_initializer
--     ;

      String -> Type -> Element
def String
"InitializerValue" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"objectOrCollection"String -> Type -> FieldType
>: String -> Type
csharp String
"ObjectOrCollectionInitializer"],

-- // Source: §12.8.16.4 Collection initializers
-- collection_initializer
--     : '{' element_initializer_list '}'
--     | '{' element_initializer_list ',' '}'
--     ;
--
-- element_initializer_list
--     : element_initializer (',' element_initializer)*
--     ;
--
-- element_initializer
--     : non_assignment_expression
--     | '{' expression_list '}'
--     ;

      String -> Type -> Element
def String
"ElementInitializer" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"single"String -> Type -> FieldType
>: String -> Type
csharp String
"NonAssignmentExpression",
        String
"list"String -> Type -> FieldType
>: String -> Type
csharp String
"ExpressionList"],

-- expression_list
--     : expression
--     | expression_list ',' expression
--     ;

      String -> Type -> Element
def String
"ExpressionList" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Expression",

-- // Source: §12.8.16.5 Array creation expressions
-- array_creation_expression
--     : 'new' non_array_type '[' expression_list ']' rank_specifier*
--       array_initializer?
--     | 'new' array_type array_initializer
--     | 'new' rank_specifier array_initializer
--     ;

      String -> Type -> Element
def String
"ArrayCreationExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"nonArrayType"String -> Type -> FieldType
>: String -> Type
csharp String
"NonArrayTypeArrayCreationExpression",
        String
"arrayType"String -> Type -> FieldType
>: String -> Type
csharp String
"ArrayTypeArrayCreationExpression",
        String
"rankSpecifier"String -> Type -> FieldType
>: String -> Type
csharp String
"RankSpecifierArrayCreationExpression"],

      String -> Type -> Element
def String
"NonArrayTypeArrayCreationExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"NonArrayType",
        String
"expressions"String -> Type -> FieldType
>: String -> Type
csharp String
"ExpressionList",
        String
"rankSpecifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"RankSpecifier",
        String
"initializer"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ArrayInitializer"],

      String -> Type -> Element
def String
"ArrayTypeArrayCreationExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"ArrayType",
        String
"initializer"String -> Type -> FieldType
>: String -> Type
csharp String
"ArrayInitializer"],

      String -> Type -> Element
def String
"RankSpecifierArrayCreationExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"rankSpecifier"String -> Type -> FieldType
>: String -> Type
csharp String
"RankSpecifier",
        String
"initializer"String -> Type -> FieldType
>: String -> Type
csharp String
"ArrayInitializer"],

-- // Source: §12.8.16.6 Delegate creation expressions
-- delegate_creation_expression
--     : 'new' delegate_type '(' expression ')'
--     ;

      String -> Type -> Element
def String
"DelegateCreationExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"DelegateType",
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression"],

-- // Source: §12.8.16.7 Anonymous object creation expressions
-- anonymous_object_creation_expression
--     : 'new' anonymous_object_initializer
--     ;
--
-- anonymous_object_initializer
--     : '{' member_declarator_list? '}'
--     | '{' member_declarator_list ',' '}'
--     ;
--
-- member_declarator_list
--     : member_declarator (',' member_declarator)*
--     ;

      String -> Type -> Element
def String
"MemberDeclaratorList" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"MemberDeclarator",

-- member_declarator
--     : simple_name
--     | member_access
--     | null_conditional_projection_initializer
--     | base_access
--     | identifier '=' expression
--     ;

      String -> Type -> Element
def String
"MemberDeclarator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"SimpleName",
        String
"memberAccess"String -> Type -> FieldType
>: String -> Type
csharp String
"MemberAccess",
        String
"nullConditionalProjectionInitializer"String -> Type -> FieldType
>: String -> Type
csharp String
"NullConditionalProjectionInitializer",
        String
"baseAccess"String -> Type -> FieldType
>: String -> Type
csharp String
"BaseAccess",
        String
"assignment"String -> Type -> FieldType
>: String -> Type
csharp String
"AssignmentMemberDeclarator"],

      String -> Type -> Element
def String
"AssignmentMemberDeclarator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression"],

-- // Source: §12.8.17 The typeof operator
-- typeof_expression
--     : 'typeof' '(' type ')'
--     | 'typeof' '(' unbound_type_name ')'
--     | 'typeof' '(' 'void' ')'
--     ;

      String -> Type -> Element
def String
"TypeofExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"unboundTypeName"String -> Type -> FieldType
>: String -> Type
csharp String
"UnboundTypeName",
        String
"void"String -> Type -> FieldType
>: Type
unit],

-- unbound_type_name
--     : identifier generic_dimension_specifier?
--     | identifier '::' identifier generic_dimension_specifier?
--     | unbound_type_name '.' identifier generic_dimension_specifier?
--     ;

      String -> Type -> Element
def String
"UnboundTypeName" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"UnboundTypeNamePart",

      String -> Type -> Element
def String
"UnboundTypeNamePart" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"aliased"String -> Type -> FieldType
>: Type
boolean,
        String
"dimension"String -> Type -> FieldType
>: Type -> Type
optional Type
int32], -- Note: non-negative

-- generic_dimension_specifier
--     : '<' comma* '>'
--     ;
-- comma
--     : ','
--     ;
--
--
-- // Source: §12.8.18 The sizeof operator
-- sizeof_expression
--     : 'sizeof' '(' unmanaged_type ')'
--     ;
--
-- // Source: §12.8.19 The checked and unchecked operators
-- checked_expression
--     : 'checked' '(' expression ')'
--     ;
--
-- unchecked_expression
--     : 'unchecked' '(' expression ')'
--     ;
--
-- // Source: §12.8.20 Default value expressions
-- default_value_expression
--     : explictly_typed_default
--     | default_literal
--     ;

      String -> Type -> Element
def String
"DefaultValueExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"explicitlyTyped"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"defaultLiteral"String -> Type -> FieldType
>: Type
unit],

-- explictly_typed_default
--     : 'default' '(' type ')'
--     ;
--
-- default_literal
--     : 'default'
--     ;
--
-- // Source: §12.8.21 Stack allocation
-- stackalloc_expression
--     : 'stackalloc' unmanaged_type '[' expression ']'
--     | 'stackalloc' unmanaged_type? '[' constant_expression? ']'
--       stackalloc_initializer
--     ;

      String -> Type -> Element
def String
"StackallocExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"UnmanagedType",
        String
"expression"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ConstantExpression",
        String
"initializer"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Expression"],

-- stackalloc_initializer
--      : '{' stackalloc_initializer_element_list '}'
--      ;
--
-- stackalloc_initializer_element_list
--      : stackalloc_element_initializer (',' stackalloc_element_initializer)* ','?
--      ;
--
-- stackalloc_element_initializer
--     : expression
--     ;
--
-- // Source: §12.8.22 The nameof operator
-- nameof_expression
--     : 'nameof' '(' named_entity ')'
--     ;
--
-- named_entity
--     : named_entity_target ('.' identifier type_argument_list?)*
--     ;

      String -> Type -> Element
def String
"NamedEntity" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"target"String -> Type -> FieldType
>: String -> Type
csharp String
"NamedEntityTarget",
        String
"parts"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"NamedEntityPart"],

      String -> Type -> Element
def String
"NamedEntityPart" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"typeArguments"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeArgumentList"],

-- named_entity_target
--     : simple_name
--     | 'this'
--     | 'base'
--     | predefined_type
--     | qualified_alias_member
--     ;

      String -> Type -> Element
def String
"NamedEntityTarget" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"SimpleName",
        String
"this"String -> Type -> FieldType
>: Type
unit,
        String
"base"String -> Type -> FieldType
>: Type
unit,
        String
"predefinedType"String -> Type -> FieldType
>: String -> Type
csharp String
"PredefinedType",
        String
"qualifiedAliasMember"String -> Type -> FieldType
>: String -> Type
csharp String
"QualifiedAliasMember"],

-- // Source: §12.9.1 General
-- unary_expression
--     : primary_expression
--     | '+' unary_expression
--     | '-' unary_expression
--     | '!' unary_expression
--     | '~' unary_expression
--     | pre_increment_expression
--     | pre_decrement_expression
--     | cast_expression
--     | await_expression
--     | pointer_indirection_expression    // unsafe code support
--     | addressof_expression              // unsafe code support
--     ;

      String -> Type -> Element
def String
"UnaryExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"primary"String -> Type -> FieldType
>: String -> Type
csharp String
"PrimaryExpression",
        String
"plus"String -> Type -> FieldType
>: String -> Type
csharp String
"UnaryExpression",
        String
"minus"String -> Type -> FieldType
>: String -> Type
csharp String
"UnaryExpression",
        String
"not"String -> Type -> FieldType
>: String -> Type
csharp String
"UnaryExpression",
        String
"bitwiseComplement"String -> Type -> FieldType
>: String -> Type
csharp String
"UnaryExpression",
        String
"preIncrement"String -> Type -> FieldType
>: String -> Type
csharp String
"UnaryExpression",
        String
"preDecrement"String -> Type -> FieldType
>: String -> Type
csharp String
"UnaryExpression",
        String
"cast"String -> Type -> FieldType
>: String -> Type
csharp String
"CastExpression",
        String
"await"String -> Type -> FieldType
>: String -> Type
csharp String
"UnaryExpression",
        String
"pointerIndirection"String -> Type -> FieldType
>: String -> Type
csharp String
"UnaryExpression",
        String
"addressOf"String -> Type -> FieldType
>: String -> Type
csharp String
"UnaryExpression"],

-- // Source: §12.9.6 Prefix increment and decrement operators
-- pre_increment_expression
--     : '++' unary_expression
--     ;
--
-- pre_decrement_expression
--     : '--' unary_expression
--     ;
--
-- // Source: §12.9.7 Cast expressions
-- cast_expression
--     : '(' type ')' unary_expression
--     ;

      String -> Type -> Element
def String
"CastExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"UnaryExpression"],

-- // Source: §12.9.8.1 General
-- await_expression
--     : 'await' unary_expression
--     ;
--
-- // Source: §12.10.1 General
-- multiplicative_expression
--     : unary_expression
--     | multiplicative_expression '*' unary_expression
--     | multiplicative_expression '/' unary_expression
--     | multiplicative_expression '%' unary_expression
--     ;

      String -> Type -> Element
def String
"MultiplicativeExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"simple"String -> Type -> FieldType
>: String -> Type
csharp String
"UnaryExpression",
        String
"binary"String -> Type -> FieldType
>: String -> Type
csharp String
"BinaryMultiplicativeExpression"],

      String -> Type -> Element
def String
"BinaryMultiplicativeExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"left"String -> Type -> FieldType
>: String -> Type
csharp String
"MultiplicativeExpression",
        String
"operator"String -> Type -> FieldType
>: String -> Type
csharp String
"MultiplicativeOperator",
        String
"right"String -> Type -> FieldType
>: String -> Type
csharp String
"UnaryExpression"],

      String -> Type -> Element
def String
"MultiplicativeOperator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [String
"times", String
"divide", String
"modulo"],

-- additive_expression
--     : multiplicative_expression
--     | additive_expression '+' multiplicative_expression
--     | additive_expression '-' multiplicative_expression
--     ;

      String -> Type -> Element
def String
"AdditiveExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"simple"String -> Type -> FieldType
>: String -> Type
csharp String
"MultiplicativeExpression",
        String
"binary"String -> Type -> FieldType
>: String -> Type
csharp String
"BinaryAdditiveExpression"],

      String -> Type -> Element
def String
"BinaryAdditiveExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"left"String -> Type -> FieldType
>: String -> Type
csharp String
"AdditiveExpression",
        String
"operator"String -> Type -> FieldType
>: String -> Type
csharp String
"AdditiveOperator",
        String
"right"String -> Type -> FieldType
>: String -> Type
csharp String
"MultiplicativeExpression"],

      String -> Type -> Element
def String
"AdditiveOperator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [String
"plus", String
"minus"],

-- // Source: §12.11 Shift operators
-- shift_expression
--     : additive_expression
--     | shift_expression '<<' additive_expression
--     | shift_expression right_shift additive_expression
--     ;

      String -> Type -> Element
def String
"ShiftExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"simple"String -> Type -> FieldType
>: String -> Type
csharp String
"AdditiveExpression",
        String
"binary"String -> Type -> FieldType
>: String -> Type
csharp String
"BinaryShiftExpression"],

      String -> Type -> Element
def String
"BinaryShiftExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"left"String -> Type -> FieldType
>: String -> Type
csharp String
"ShiftExpression",
        String
"operator"String -> Type -> FieldType
>: String -> Type
csharp String
"ShiftOperator",
        String
"right"String -> Type -> FieldType
>: String -> Type
csharp String
"AdditiveExpression"],

      String -> Type -> Element
def String
"ShiftOperator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [String
"left", String
"right"],

-- // Source: §12.12.1 General
-- relational_expression
--     : shift_expression
--     | relational_expression '<' shift_expression
--     | relational_expression '>' shift_expression
--     | relational_expression '<=' shift_expression
--     | relational_expression '>=' shift_expression
--     | relational_expression 'is' type
--     | relational_expression 'is' pattern
--     | relational_expression 'as' type
--     ;

      String -> Type -> Element
def String
"RelationalExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"simple"String -> Type -> FieldType
>: String -> Type
csharp String
"ShiftExpression",
        String
"binary"String -> Type -> FieldType
>: String -> Type
csharp String
"BinaryRelationalExpression",
        String
"isType"String -> Type -> FieldType
>: String -> Type
csharp String
"IsTypeExpression",
        String
"isPattern"String -> Type -> FieldType
>: String -> Type
csharp String
"IsPatternExpression",
        String
"asType"String -> Type -> FieldType
>: String -> Type
csharp String
"AsTypeExpression"],

      String -> Type -> Element
def String
"BinaryRelationalExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
       String
"left"String -> Type -> FieldType
>: String -> Type
csharp String
"RelationalExpression",
        String
"operator"String -> Type -> FieldType
>: String -> Type
csharp String
"RelationalOperator",
        String
"right"String -> Type -> FieldType
>: String -> Type
csharp String
"ShiftExpression"],

      String -> Type -> Element
def String
"RelationalOperator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"lessThan", String
"greaterThan", String
"lessThanOrEqual", String
"greaterThanOrEqual"],

      String -> Type -> Element
def String
"IsTypeExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
       String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"RelationalExpression",
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type"],

      String -> Type -> Element
def String
"IsPatternExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"RelationalExpression",
        String
"pattern"String -> Type -> FieldType
>: String -> Type
csharp String
"Pattern"],

      String -> Type -> Element
def String
"AsTypeExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"RelationalExpression",
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type"],

-- equality_expression
--     : relational_expression
--     | equality_expression '==' relational_expression
--     | equality_expression '!=' relational_expression
--     ;

      String -> Type -> Element
def String
"EqualityExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"simple"String -> Type -> FieldType
>: String -> Type
csharp String
"RelationalExpression",
        String
"binary"String -> Type -> FieldType
>: String -> Type
csharp String
"BinaryEqualityExpression"],

      String -> Type -> Element
def String
"BinaryEqualityExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"left"String -> Type -> FieldType
>: String -> Type
csharp String
"EqualityExpression",
        String
"operator"String -> Type -> FieldType
>: String -> Type
csharp String
"EqualityOperator",
        String
"right"String -> Type -> FieldType
>: String -> Type
csharp String
"RelationalExpression"],

      String -> Type -> Element
def String
"EqualityOperator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [String
"equal", String
"notEqual"],

-- // Source: §12.13.1 General
-- and_expression
--     : equality_expression
--     | and_expression '&' equality_expression
--     ;

      String -> Type -> Element
def String
"AndExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"simple"String -> Type -> FieldType
>: String -> Type
csharp String
"EqualityExpression",
        String
"binary"String -> Type -> FieldType
>: String -> Type
csharp String
"BinaryAndExpression"],

      String -> Type -> Element
def String
"BinaryAndExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"left"String -> Type -> FieldType
>: String -> Type
csharp String
"AndExpression",
        String
"right"String -> Type -> FieldType
>: String -> Type
csharp String
"EqualityExpression"],

-- exclusive_or_expression
--     : and_expression
--     | exclusive_or_expression '^' and_expression
--     ;

      String -> Type -> Element
def String
"ExclusiveOrExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"simple"String -> Type -> FieldType
>: String -> Type
csharp String
"AndExpression",
        String
"binary"String -> Type -> FieldType
>: String -> Type
csharp String
"BinaryExclusiveOrExpression"],

      String -> Type -> Element
def String
"BinaryExclusiveOrExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"left"String -> Type -> FieldType
>: String -> Type
csharp String
"ExclusiveOrExpression",
        String
"right"String -> Type -> FieldType
>: String -> Type
csharp String
"AndExpression"],

-- inclusive_or_expression
--     : exclusive_or_expression
--     | inclusive_or_expression '|' exclusive_or_expression
--     ;

      String -> Type -> Element
def String
"InclusiveOrExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"simple"String -> Type -> FieldType
>: String -> Type
csharp String
"ExclusiveOrExpression",
        String
"binary"String -> Type -> FieldType
>: String -> Type
csharp String
"BinaryInclusiveOrExpression"],

      String -> Type -> Element
def String
"BinaryInclusiveOrExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"left"String -> Type -> FieldType
>: String -> Type
csharp String
"InclusiveOrExpression",
        String
"right"String -> Type -> FieldType
>: String -> Type
csharp String
"ExclusiveOrExpression"],

-- // Source: §12.14.1 General
-- conditional_and_expression
--     : inclusive_or_expression
--     | conditional_and_expression '&&' inclusive_or_expression
--     ;

      String -> Type -> Element
def String
"ConditionalAndExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"simple"String -> Type -> FieldType
>: String -> Type
csharp String
"InclusiveOrExpression",
        String
"binary"String -> Type -> FieldType
>: String -> Type
csharp String
"BinaryConditionalAndExpression"],

      String -> Type -> Element
def String
"BinaryConditionalAndExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"left"String -> Type -> FieldType
>: String -> Type
csharp String
"ConditionalAndExpression",
        String
"right"String -> Type -> FieldType
>: String -> Type
csharp String
"InclusiveOrExpression"],

-- conditional_or_expression
--     : conditional_and_expression
--     | conditional_or_expression '||' conditional_and_expression
--     ;

      String -> Type -> Element
def String
"ConditionalOrExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"simple"String -> Type -> FieldType
>: String -> Type
csharp String
"ConditionalAndExpression",
        String
"binary"String -> Type -> FieldType
>: String -> Type
csharp String
"BinaryConditionalOrExpression"],

      String -> Type -> Element
def String
"BinaryConditionalOrExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"left"String -> Type -> FieldType
>: String -> Type
csharp String
"ConditionalOrExpression",
        String
"right"String -> Type -> FieldType
>: String -> Type
csharp String
"ConditionalAndExpression"],

-- // Source: §12.15 The null coalescing operator
-- null_coalescing_expression
--     : conditional_or_expression
--     | conditional_or_expression '??' null_coalescing_expression
--     | throw_expression
--     ;

      String -> Type -> Element
def String
"NullCoalescingExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"simple"String -> Type -> FieldType
>: String -> Type
csharp String
"ConditionalOrExpression",
        String
"binary"String -> Type -> FieldType
>: String -> Type
csharp String
"BinaryNullCoalescingExpression",
        String
"throw"String -> Type -> FieldType
>: String -> Type
csharp String
"NullCoalescingExpression"],

      String -> Type -> Element
def String
"BinaryNullCoalescingExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"left"String -> Type -> FieldType
>: String -> Type
csharp String
"ConditionalOrExpression",
        String
"right"String -> Type -> FieldType
>: String -> Type
csharp String
"NullCoalescingExpression"],

-- // Source: §12.16 The throw expression operator
-- throw_expression
--     : 'throw' null_coalescing_expression
--     ;
--
-- // Source: §12.17 Declaration expressions
-- declaration_expression
--     : local_variable_type identifier
--     ;

      String -> Type -> Element
def String
"DeclarationExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"LocalVariableType",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier"],

-- local_variable_type
--     : type
--     | 'var'
--     ;

      String -> Type -> Element
def String
"LocalVariableType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"var"String -> Type -> FieldType
>: Type
unit],

-- // Source: §12.18 Conditional operator
-- conditional_expression
--     : null_coalescing_expression
--     | null_coalescing_expression '?' expression ':' expression
--     | null_coalescing_expression '?' 'ref' variable_reference ':'
--       'ref' variable_reference
--     ;

      String -> Type -> Element
def String
"ConditionalExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"simple"String -> Type -> FieldType
>: String -> Type
csharp String
"NullCoalescingExpression",
        String
"simpleConditional"String -> Type -> FieldType
>: String -> Type
csharp String
"SimpleConditionalExpression",
        String
"refConditional"String -> Type -> FieldType
>: String -> Type
csharp String
"RefConditionalExpression"],

      String -> Type -> Element
def String
"SimpleConditionalExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"condition"String -> Type -> FieldType
>: String -> Type
csharp String
"NullCoalescingExpression",
        String
"true"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"false"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression"],

      String -> Type -> Element
def String
"RefConditionalExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"condition"String -> Type -> FieldType
>: String -> Type
csharp String
"NullCoalescingExpression",
        String
"true"String -> Type -> FieldType
>: String -> Type
csharp String
"VariableReference",
        String
"false"String -> Type -> FieldType
>: String -> Type
csharp String
"VariableReference"],

-- // Source: §12.19.1 General
-- lambda_expression
--     : 'async'? anonymous_function_signature '=>' anonymous_function_body
--     ;

      String -> Type -> Element
def String
"LambdaExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"async"String -> Type -> FieldType
>: Type
boolean,
        String
"signature"String -> Type -> FieldType
>: String -> Type
csharp String
"AnonymousFunctionSignature",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"AnonymousFunctionBody"],

-- anonymous_method_expression
--     : 'async'? 'delegate' explicit_anonymous_function_signature? block
--     ;

      String -> Type -> Element
def String
"AnonymousMethodExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"async"String -> Type -> FieldType
>: Type
boolean,
        String
"signature"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ExplicitAnonymousFunctionParameter",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"Block"],

-- anonymous_function_signature
--     : explicit_anonymous_function_signature
--     | implicit_anonymous_function_signature
--     ;

      String -> Type -> Element
def String
"AnonymousFunctionSignature" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"explicit"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ExplicitAnonymousFunctionParameter",
        String
"implicit"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Identifier"],

-- explicit_anonymous_function_signature
--     : '(' explicit_anonymous_function_parameter_list? ')'
--     ;
--
-- explicit_anonymous_function_parameter_list
--     : explicit_anonymous_function_parameter
--       (',' explicit_anonymous_function_parameter)*
--     ;
--
-- explicit_anonymous_function_parameter
--     : anonymous_function_parameter_modifier? type identifier
--     ;

      String -> Type -> Element
def String
"ExplicitAnonymousFunctionParameter" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"modifier"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"AnonymousFunctionParameterModifier",
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier"],

-- anonymous_function_parameter_modifier
--     : 'ref'
--     | 'out'
--     | 'in'
--     ;

      String -> Type -> Element
def String
"AnonymousFunctionParameterModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [ String
"ref", String
"out", String
"in" ],

-- implicit_anonymous_function_signature
--     : '(' implicit_anonymous_function_parameter_list? ')'
--     | implicit_anonymous_function_parameter
--     ;
--
-- implicit_anonymous_function_parameter_list
--     : implicit_anonymous_function_parameter
--       (',' implicit_anonymous_function_parameter)*
--     ;
--
-- implicit_anonymous_function_parameter
--     : identifier
--     ;
--
-- anonymous_function_body
--     : null_conditional_invocation_expression
--     | expression
--     | 'ref' variable_reference
--     | block
--     ;

      String -> Type -> Element
def String
"AnonymousFunctionBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"nullConditionalInvocation"String -> Type -> FieldType
>: String -> Type
csharp String
"NullConditionalInvocationExpression",
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"ref"String -> Type -> FieldType
>: String -> Type
csharp String
"VariableReference",
        String
"block"String -> Type -> FieldType
>: String -> Type
csharp String
"Block"],

-- // Source: §12.20.1 General
-- query_expression
--     : from_clause query_body
--     ;

      String -> Type -> Element
def String
"QueryExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"from"String -> Type -> FieldType
>: String -> Type
csharp String
"FromClause",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"QueryBody"],

-- from_clause
--     : 'from' type? identifier 'in' expression
--     ;

      String -> Type -> Element
def String
"FromClause" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Type",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"in"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression"],

-- query_body
--     : query_body_clauses? select_or_group_clause query_continuation?
--     ;

      String -> Type -> Element
def String
"QueryBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"clauses"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"QueryBodyClause",
        String
"selectOrGroup"String -> Type -> FieldType
>: String -> Type
csharp String
"SelectOrGroupClause",
        String
"continuation"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"QueryContinuation"],

-- query_body_clauses
--     : query_body_clause
--     | query_body_clauses query_body_clause
--     ;
--
-- query_body_clause
--     : from_clause
--     | let_clause
--     | where_clause
--     | join_clause
--     | join_into_clause
--     | orderby_clause
--     ;

      String -> Type -> Element
def String
"QueryBodyClause" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"from"String -> Type -> FieldType
>: String -> Type
csharp String
"FromClause",
        String
"let"String -> Type -> FieldType
>: String -> Type
csharp String
"LetClause",
        String
"where"String -> Type -> FieldType
>: String -> Type
csharp String
"BooleanExpression",
        String
"join"String -> Type -> FieldType
>: String -> Type
csharp String
"JoinClause",
        String
"orderby"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Ordering"],

-- let_clause
--     : 'let' identifier '=' expression
--     ;

      String -> Type -> Element
def String
"LetClause" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"left"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"right"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression"],

-- where_clause
--     : 'where' boolean_expression
--     ;
--
-- join_clause
--     : 'join' type? identifier 'in' expression 'on' expression
--       'equals' expression
--     ;

      String -> Type -> Element
def String
"JoinClause" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Type",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"in"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"on"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"equals"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"into"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Identifier"],

-- join_into_clause
--     : 'join' type? identifier 'in' expression 'on' expression
--       'equals' expression 'into' identifier
--     ;
--
-- orderby_clause
--     : 'orderby' orderings
--     ;
--
-- orderings
--     : ordering (',' ordering)*
--     ;
--
-- ordering
--     : expression ordering_direction?
--     ;

      String -> Type -> Element
def String
"Ordering" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"direction"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"OrderingDirection"],

-- ordering_direction
--     : 'ascending'
--     | 'descending'
--     ;

      String -> Type -> Element
def String
"OrderingDirection" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [ String
"ascending", String
"descending" ],

-- select_or_group_clause
--     : select_clause
--     | group_clause
--     ;

      String -> Type -> Element
def String
"SelectOrGroupClause" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"select"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"group"String -> Type -> FieldType
>: String -> Type
csharp String
"GroupClause"],

-- select_clause
--     : 'select' expression
--     ;
--
-- group_clause
--     : 'group' expression 'by' expression
--     ;


      String -> Type -> Element
def String
"GroupClause" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"grouped"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"by"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression"],

-- query_continuation
--     : 'into' identifier query_body
--     ;

      String -> Type -> Element
def String
"QueryContinuation" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"into"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"QueryBody"],

-- // Source: §12.21.1 General
-- assignment
--     : unary_expression assignment_operator expression
--     ;

      String -> Type -> Element
def String
"Assignment" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"left"String -> Type -> FieldType
>: String -> Type
csharp String
"UnaryExpression",
        String
"operator"String -> Type -> FieldType
>: String -> Type
csharp String
"AssignmentOperator",
        String
"right"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression"],

-- assignment_operator
--     : '=' 'ref'? | '+=' | '-=' | '*=' | '/=' | '%=' | '&=' | '|=' | '^=' | '<<='
--     | right_shift_assignment
--     ;

      String -> Type -> Element
def String
"AssignmentOperator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"simple"String -> Type -> FieldType
>: Type
boolean,
        String
"plusEquals"String -> Type -> FieldType
>: Type
unit,
        String
"minusEquals"String -> Type -> FieldType
>: Type
unit,
        String
"timesEquals"String -> Type -> FieldType
>: Type
unit,
        String
"divideEquals"String -> Type -> FieldType
>: Type
unit,
        String
"modEquals"String -> Type -> FieldType
>: Type
unit,
        String
"andEquals"String -> Type -> FieldType
>: Type
unit,
        String
"orEquals"String -> Type -> FieldType
>: Type
unit,
        String
"xorEquals"String -> Type -> FieldType
>: Type
unit,
        String
"leftShiftEquals"String -> Type -> FieldType
>: Type
unit,
        String
"rightShiftEquals"String -> Type -> FieldType
>: Type
unit],

-- // Source: §12.22 Expression
-- expression
--     : non_assignment_expression
--     | assignment
--     ;

      String -> Type -> Element
def String
"Expression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"nonAssignment"String -> Type -> FieldType
>: String -> Type
csharp String
"NonAssignmentExpression",
        String
"assignment"String -> Type -> FieldType
>: String -> Type
csharp String
"Assignment"],

-- non_assignment_expression
--     : declaration_expression
--     | conditional_expression
--     | lambda_expression
--     | query_expression
--     ;

      String -> Type -> Element
def String
"NonAssignmentExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"declaration"String -> Type -> FieldType
>: String -> Type
csharp String
"DeclarationExpression",
        String
"conditional"String -> Type -> FieldType
>: String -> Type
csharp String
"ConditionalExpression",
        String
"lambda"String -> Type -> FieldType
>: String -> Type
csharp String
"LambdaExpression",
        String
"query"String -> Type -> FieldType
>: String -> Type
csharp String
"QueryExpression"],

-- // Source: §12.23 Constant expressions
-- constant_expression
--     : expression
--     ;

      String -> Type -> Element
def String
"ConstantExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Expression",

-- // Source: §12.24 Boolean expressions
-- boolean_expression
--     : expression
--     ;

      String -> Type -> Element
def String
"BooleanExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Expression",

-- // Source: §13.1 General
-- statement
--     : labeled_statement
--     | declaration_statement
--     | embedded_statement
--     ;

      String -> Type -> Element
def String
"Statement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"labeled"String -> Type -> FieldType
>: String -> Type
csharp String
"LabeledStatement",
        String
"declaration"String -> Type -> FieldType
>: String -> Type
csharp String
"DeclarationStatement",
        String
"embedded"String -> Type -> FieldType
>: String -> Type
csharp String
"EmbeddedStatement"],

-- embedded_statement
--     : block
--     | empty_statement
--     | expression_statement
--     | selection_statement
--     | iteration_statement
--     | jump_statement
--     | try_statement
--     | checked_statement
--     | unchecked_statement
--     | lock_statement
--     | using_statement
--     | yield_statement
--     | unsafe_statement   // unsafe code support
--     | fixed_statement    // unsafe code support
--     ;

      String -> Type -> Element
def String
"EmbeddedStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"block"String -> Type -> FieldType
>: String -> Type
csharp String
"Block",
        String
"empty"String -> Type -> FieldType
>: Type
unit,
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"StatementExpression",
        String
"selection"String -> Type -> FieldType
>: String -> Type
csharp String
"SelectionStatement",
        String
"iteration"String -> Type -> FieldType
>: String -> Type
csharp String
"IterationStatement",
        String
"jump"String -> Type -> FieldType
>: String -> Type
csharp String
"JumpStatement",
        String
"try"String -> Type -> FieldType
>: String -> Type
csharp String
"TryStatement",
        String
"checked"String -> Type -> FieldType
>: String -> Type
csharp String
"Block",
        String
"unchecked"String -> Type -> FieldType
>: String -> Type
csharp String
"Block",
        String
"lock"String -> Type -> FieldType
>: String -> Type
csharp String
"LockStatement",
        String
"using"String -> Type -> FieldType
>: String -> Type
csharp String
"UsingStatement",
        String
"yield"String -> Type -> FieldType
>: String -> Type
csharp String
"YieldStatement",
        String
"unsafe"String -> Type -> FieldType
>: String -> Type
csharp String
"Block",
        String
"fixed"String -> Type -> FieldType
>: String -> Type
csharp String
"FixedStatement"],

-- // Source: §13.3.1 General
-- block
--     : '{' statement_list? '}'
--     ;

      String -> Type -> Element
def String
"Block" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Statement",

-- // Source: §13.3.2 Statement lists
-- statement_list
--     : statement+
--     ;
--
-- // Source: §13.4 The empty statement
-- empty_statement
--     : ';'
--     ;
--
-- // Source: §13.5 Labeled statements
-- labeled_statement
--     : identifier ':' statement
--     ;

      String -> Type -> Element
def String
"LabeledStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"label"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"statement"String -> Type -> FieldType
>: String -> Type
csharp String
"Statement"],

-- // Source: §13.6.1 General
-- declaration_statement
--     : local_variable_declaration ';'
--     | local_constant_declaration ';'
--     | local_function_declaration
--     ;

      String -> Type -> Element
def String
"DeclarationStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"variable"String -> Type -> FieldType
>: String -> Type
csharp String
"LocalVariableDeclaration",
        String
"constant"String -> Type -> FieldType
>: String -> Type
csharp String
"LocalConstantDeclaration",
        String
"function"String -> Type -> FieldType
>: String -> Type
csharp String
"LocalFunctionDeclaration"],

-- // Source: §13.6.2.1 General
-- local_variable_declaration
--     : implicitly_typed_local_variable_declaration
--     | explicitly_typed_local_variable_declaration
--     | ref_local_variable_declaration
--     ;


      String -> Type -> Element
def String
"LocalVariableDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"implicitlyTyped"String -> Type -> FieldType
>: String -> Type
csharp String
"ImplicitlyTypedLocalVariableDeclaration",
        String
"explicitlyTyped"String -> Type -> FieldType
>: String -> Type
csharp String
"ExplicitlyTypedLocalVariableDeclaration",
        String
"ref"String -> Type -> FieldType
>: String -> Type
csharp String
"RefLocalVariableDeclaration"],

-- // Source: §13.6.2.2 Implicitly typed local variable declarations
-- implicitly_typed_local_variable_declaration
--     : 'var' implicitly_typed_local_variable_declarator
--     | ref_kind 'var' ref_local_variable_declarator
--     ;

      String -> Type -> Element
def String
"ImplicitlyTypedLocalVariableDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"var"String -> Type -> FieldType
>: String -> Type
csharp String
"ImplicitlyTypedLocalVariableDeclarator",
        String
"refVar"String -> Type -> FieldType
>: String -> Type
csharp String
"RefVarImplicitlyTypedLocalVariableDeclaration"],

      String -> Type -> Element
def String
"RefVarImplicitlyTypedLocalVariableDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"refKind"String -> Type -> FieldType
>: String -> Type
csharp String
"RefKind",
        String
"declarator"String -> Type -> FieldType
>: String -> Type
csharp String
"RefLocalVariableDeclarator"],

-- implicitly_typed_local_variable_declarator
--     : identifier '=' expression
--     ;

      String -> Type -> Element
def String
"ImplicitlyTypedLocalVariableDeclarator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression"],

-- // Source: §13.6.2.3 Explicitly typed local variable declarations
-- explicitly_typed_local_variable_declaration
--     : type explicitly_typed_local_variable_declarators
--     ;

      String -> Type -> Element
def String
"ExplicitlyTypedLocalVariableDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"declarators"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ExplicitlyTypedLocalVariableDeclarator"],

-- explicitly_typed_local_variable_declarators
--     : explicitly_typed_local_variable_declarator
--       (',' explicitly_typed_local_variable_declarator)*
--     ;

      String -> Type -> Element
def String
"ExplicitlyTypedLocalVariableDeclarator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"initializer"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"LocalVariableInitializer"],

-- explicitly_typed_local_variable_declarator
--     : identifier ('=' local_variable_initializer)?
--     ;
--
-- local_variable_initializer
--     : expression
--     | array_initializer
--     ;

      String -> Type -> Element
def String
"LocalVariableInitializer" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"initializer"String -> Type -> FieldType
>: String -> Type
csharp String
"ArrayInitializer"],

-- // Source: §13.6.2.4 Ref local variable declarations
-- ref_local_variable_declaration
--     : ref_kind type ref_local_variable_declarators
--     ;

      String -> Type -> Element
def String
"RefLocalVariableDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"refKind"String -> Type -> FieldType
>: String -> Type
csharp String
"RefKind",
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"declarators"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"RefLocalVariableDeclarator"],

-- ref_local_variable_declarators
--     : ref_local_variable_declarator (',' ref_local_variable_declarator)*
--     ;
--
-- ref_local_variable_declarator
--     : identifier '=' 'ref' variable_reference
--     ;

      String -> Type -> Element
def String
"RefLocalVariableDeclarator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"left"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"right"String -> Type -> FieldType
>: String -> Type
csharp String
"VariableReference"],

-- // Source: §13.6.3 Local constant declarations
-- local_constant_declaration
--     : 'const' type constant_declarators
--     ;

      String -> Type -> Element
def String
"LocalConstantDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"declarators"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ConstantDeclarator"],

-- constant_declarators
--     : constant_declarator (',' constant_declarator)*
--     ;
--
-- constant_declarator
--     : identifier '=' constant_expression
--     ;

      String -> Type -> Element
def String
"ConstantDeclarator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"ConstantExpression"],

-- // Source: §13.6.4 Local function declarations
-- local_function_declaration
--     : local_function_modifier* return_type local_function_header
--       local_function_body
--     | ref_local_function_modifier* ref_kind ref_return_type
--       local_function_header ref_local_function_body
--     ;

      String -> Type -> Element
def String
"LocalFunctionDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"standard"String -> Type -> FieldType
>: String -> Type
csharp String
"StandardLocalFunctionDeclaration",
        String
"ref"String -> Type -> FieldType
>: String -> Type
csharp String
"RefLocalFunctionDeclaration"],

      String -> Type -> Element
def String
"StandardLocalFunctionDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"LocalFunctionModifier",
        String
"returnType"String -> Type -> FieldType
>: String -> Type
csharp String
"ReturnType",
        String
"header"String -> Type -> FieldType
>: String -> Type
csharp String
"LocalFunctionHeader",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"LocalFunctionBody"],

      String -> Type -> Element
def String
"RefLocalFunctionDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"RefLocalFunctionModifier",
        String
"refKind"String -> Type -> FieldType
>: String -> Type
csharp String
"RefKind",
        String
"returnType"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"header"String -> Type -> FieldType
>: String -> Type
csharp String
"LocalFunctionHeader",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"RefLocalFunctionBody"],

-- local_function_header
--     : identifier '(' formal_parameter_list? ')'
--     | identifier type_parameter_list '(' formal_parameter_list? ')'
--       type_parameter_constraints_clause*
--     ;

      String -> Type -> Element
def String
"LocalFunctionHeader" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"typeParameters"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeParameterList",
        String
"parameters"String -> Type -> FieldType
>: String -> Type
csharp String
"FormalParameterList",
        String
"constraints"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeParameterConstraintsClause"],

-- local_function_modifier
--     : ref_local_function_modifier
--     | 'async'
--     ;

      String -> Type -> Element
def String
"LocalFunctionModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"ref"String -> Type -> FieldType
>: String -> Type
csharp String
"RefLocalFunctionModifier",
        String
"async"String -> Type -> FieldType
>: Type
unit],

-- ref_local_function_modifier
--     : 'static'
--     | unsafe_modifier   // unsafe code support
--     ;

      String -> Type -> Element
def String
"RefLocalFunctionModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [String
"static", String
"unsafe"],

-- local_function_body
--     : block
--     | '=>' null_conditional_invocation_expression ';'
--     | '=>' expression ';'
--     ;

      String -> Type -> Element
def String
"LocalFunctionBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"block"String -> Type -> FieldType
>: String -> Type
csharp String
"Block",
        String
"nullConditionalInvocation"String -> Type -> FieldType
>: String -> Type
csharp String
"NullConditionalInvocationExpression",
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression"],

-- ref_local_function_body
--     : block
--     | '=>' 'ref' variable_reference ';'
--     ;

      String -> Type -> Element
def String
"RefLocalFunctionBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"block"String -> Type -> FieldType
>: String -> Type
csharp String
"Block",
        String
"ref"String -> Type -> FieldType
>: String -> Type
csharp String
"VariableReference"],

-- // Source: §13.7 Expression statements
-- expression_statement
--     : statement_expression ';'
--     ;
--
-- statement_expression
--     : null_conditional_invocation_expression
--     | invocation_expression
--     | object_creation_expression
--     | assignment
--     | post_increment_expression
--     | post_decrement_expression
--     | pre_increment_expression
--     | pre_decrement_expression
--     | await_expression
--     ;

      String -> Type -> Element
def String
"StatementExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"nullConditionalInvocation"String -> Type -> FieldType
>: String -> Type
csharp String
"NullConditionalInvocationExpression",
        String
"invocation"String -> Type -> FieldType
>: String -> Type
csharp String
"InvocationExpression",
        String
"objectCreation"String -> Type -> FieldType
>: String -> Type
csharp String
"ObjectCreationExpression",
        String
"assignment"String -> Type -> FieldType
>: String -> Type
csharp String
"Assignment",
        String
"postIncrement"String -> Type -> FieldType
>: String -> Type
csharp String
"PrimaryExpression",
        String
"postDecrement"String -> Type -> FieldType
>: String -> Type
csharp String
"PrimaryExpression",
        String
"preIncrement"String -> Type -> FieldType
>: String -> Type
csharp String
"UnaryExpression",
        String
"preDecrement"String -> Type -> FieldType
>: String -> Type
csharp String
"UnaryExpression",
        String
"await"String -> Type -> FieldType
>: String -> Type
csharp String
"UnaryExpression"],

-- // Source: §13.8.1 General
-- selection_statement
--     : if_statement
--     | switch_statement
--     ;

      String -> Type -> Element
def String
"SelectionStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"if"String -> Type -> FieldType
>: String -> Type
csharp String
"IfStatement",
        String
"switch"String -> Type -> FieldType
>: String -> Type
csharp String
"SwitchStatement"],

-- // Source: §13.8.2 The if statement
-- if_statement
--     : 'if' '(' boolean_expression ')' embedded_statement
--     | 'if' '(' boolean_expression ')' embedded_statement
--       'else' embedded_statement
--     ;

      String -> Type -> Element
def String
"IfStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"condition"String -> Type -> FieldType
>: String -> Type
csharp String
"BooleanExpression",
        String
"ifBranch"String -> Type -> FieldType
>: String -> Type
csharp String
"EmbeddedStatement",
        String
"elseBranch"String -> Type -> FieldType
>: String -> Type
csharp String
"EmbeddedStatement"],

-- // Source: §13.8.3 The switch statement
-- switch_statement
--     : 'switch' '(' expression ')' switch_block
--     ;

      String -> Type -> Element
def String
"SwitchStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"branches"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"SwitchSection"],

-- switch_block
--     : '{' switch_section* '}'
--     ;
--
-- switch_section
--     : switch_label+ statement_list
--     ;

      String -> Type -> Element
def String
"SwitchSection" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"labels"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"SwitchLabel",
        String
"statements"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Statement"],

-- switch_label
--     : 'case' pattern case_guard?  ':'
--     | 'default' ':'
--     ;

      String -> Type -> Element
def String
"SwitchLabel" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"branch"String -> Type -> FieldType
>: String -> Type
csharp String
"SwitchBranch",
        String
"default"String -> Type -> FieldType
>: Type
unit],

      String -> Type -> Element
def String
"SwitchBranch" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"pattern"String -> Type -> FieldType
>: String -> Type
csharp String
"Pattern",
        String
"guard"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Expression"],

-- case_guard
--     : 'when' expression
--     ;
--
-- // Source: §13.9.1 General
-- iteration_statement
--     : while_statement
--     | do_statement
--     | for_statement
--     | foreach_statement
--     ;

      String -> Type -> Element
def String
"IterationStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"while"String -> Type -> FieldType
>: String -> Type
csharp String
"WhileStatement",
        String
"do"String -> Type -> FieldType
>: String -> Type
csharp String
"DoStatement",
        String
"for"String -> Type -> FieldType
>: String -> Type
csharp String
"ForStatement",
        String
"foreach"String -> Type -> FieldType
>: String -> Type
csharp String
"ForeachStatement"],

-- // Source: §13.9.2 The while statement
-- while_statement
--     : 'while' '(' boolean_expression ')' embedded_statement
--     ;

      String -> Type -> Element
def String
"WhileStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"condition"String -> Type -> FieldType
>: String -> Type
csharp String
"BooleanExpression",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"EmbeddedStatement"],

-- // Source: §13.9.3 The do statement
-- do_statement
--     : 'do' embedded_statement 'while' '(' boolean_expression ')' ';'
--     ;

      String -> Type -> Element
def String
"DoStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"EmbeddedStatement",
        String
"while"String -> Type -> FieldType
>: String -> Type
csharp String
"BooleanExpression"],

-- // Source: §13.9.4 The for statement
-- for_statement
--     : 'for' '(' for_initializer? ';' for_condition? ';' for_iterator? ')'
--       embedded_statement
--     ;

        String -> Type -> Element
def String
"ForStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
          String
"initializer"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ForInitializer",
          String
"condition"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"BooleanExpression",
          String
"iterator"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"StatementExpressionList",
          String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"EmbeddedStatement"],

-- for_initializer
--     : local_variable_declaration
--     | statement_expression_list
--     ;

      String -> Type -> Element
def String
"ForInitializer" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"variable"String -> Type -> FieldType
>: String -> Type
csharp String
"LocalVariableDeclaration",
        String
"statements"String -> Type -> FieldType
>: String -> Type
csharp String
"StatementExpressionList"],

-- for_condition
--     : boolean_expression
--     ;
--
-- for_iterator
--     : statement_expression_list
--     ;
--
-- statement_expression_list
--     : statement_expression (',' statement_expression)*
--     ;

      String -> Type -> Element
def String
"StatementExpressionList" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"StatementExpression",

-- // Source: §13.9.5 The foreach statement
-- foreach_statement
--     : 'foreach' '(' ref_kind? local_variable_type identifier 'in'
--       expression ')' embedded_statement
--     ;

      String -> Type -> Element
def String
"ForeachStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"kind"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"RefKind",
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"LocalVariableType",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"EmbeddedStatement"],

-- // Source: §13.10.1 General
-- jump_statement
--     : break_statement
--     | continue_statement
--     | goto_statement
--     | return_statement
--     | throw_statement
--     ;

      String -> Type -> Element
def String
"JumpStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"break"String -> Type -> FieldType
>: Type
unit,
        String
"continue"String -> Type -> FieldType
>: Type
unit,
        String
"goto"String -> Type -> FieldType
>: String -> Type
csharp String
"GotoStatement",
        String
"return"String -> Type -> FieldType
>: String -> Type
csharp String
"ReturnStatement",
        String
"throw"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Expression"],

-- // Source: §13.10.2 The break statement
-- break_statement
--     : 'break' ';'
--     ;
--
-- // Source: §13.10.3 The continue statement
-- continue_statement
--     : 'continue' ';'
--     ;
--
-- // Source: §13.10.4 The goto statement
-- goto_statement
--     : 'goto' identifier ';'
--     | 'goto' 'case' constant_expression ';'
--     | 'goto' 'default' ';'
--     ;

      String -> Type -> Element
def String
"GotoStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"case"String -> Type -> FieldType
>: String -> Type
csharp String
"ConstantExpression",
        String
"default"String -> Type -> FieldType
>: Type
unit],

-- // Source: §13.10.5 The return statement
-- return_statement
--     : 'return' ';'
--     | 'return' expression ';'
--     | 'return' 'ref' variable_reference ';'
--     ;

      String -> Type -> Element
def String
"ReturnStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"simple"String -> Type -> FieldType
>: Type
unit,
        String
"value"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"ref"String -> Type -> FieldType
>: String -> Type
csharp String
"VariableReference"],

-- // Source: §13.10.6 The throw statement
-- throw_statement
--     : 'throw' expression? ';'
--     ;
--
-- // Source: §13.11 The try statement
-- try_statement
--     : 'try' block catch_clauses
--     | 'try' block catch_clauses? finally_clause
--     ;

      String -> Type -> Element
def String
"TryStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"Block",
        String
"catches"String -> Type -> FieldType
>: String -> Type
csharp String
"CatchClauses",
        String
"finally"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Block"],

-- catch_clauses
--     : specific_catch_clause+
--     | specific_catch_clause* general_catch_clause
--     ;

      String -> Type -> Element
def String
"CatchClauses" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"specific"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"SpecificCatchClause",
        String
"general"String -> Type -> FieldType
>: String -> Type
csharp String
"Block"],

-- specific_catch_clause
--     : 'catch' exception_specifier exception_filter? block
--     | 'catch' exception_filter block
--     ;

      String -> Type -> Element
def String
"SpecificCatchClause" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"specifier"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ExceptionSpecifier",
        String
"filter"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"BooleanExpression",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"Block"],

-- exception_specifier
--     : '(' type identifier? ')'
--     ;

      String -> Type -> Element
def String
"ExceptionSpecifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"identifier"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Identifier"],

-- exception_filter
--     : 'when' '(' boolean_expression ')'
--     ;
--
-- general_catch_clause
--     : 'catch' block
--     ;
--
-- finally_clause
--     : 'finally' block
--     ;
--
-- // Source: §13.12 The checked and unchecked statements
-- checked_statement
--     : 'checked' block
--     ;
--
-- unchecked_statement
--     : 'unchecked' block
--     ;
--
-- // Source: §13.13 The lock statement
-- lock_statement
--     : 'lock' '(' expression ')' embedded_statement
--     ;

      String -> Type -> Element
def String
"LockStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"EmbeddedStatement"],

-- // Source: §13.14 The using statement
-- using_statement
--     : 'using' '(' resource_acquisition ')' embedded_statement
--     ;

      String -> Type -> Element
def String
"UsingStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"acquisition"String -> Type -> FieldType
>: String -> Type
csharp String
"ResourceAcquisition",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"EmbeddedStatement"],

-- resource_acquisition
--     : local_variable_declaration
--     | expression
--     ;

      String -> Type -> Element
def String
"ResourceAcquisition" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"local"String -> Type -> FieldType
>: String -> Type
csharp String
"LocalVariableDeclaration",
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression"],

-- // Source: §13.15 The yield statement
-- yield_statement
--     : 'yield' 'return' expression ';'
--     | 'yield' 'break' ';'
--     ;

      String -> Type -> Element
def String
"YieldStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"return"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"break"String -> Type -> FieldType
>: Type
unit],

-- // Source: §14.2 Compilation units
-- compilation_unit
--     : extern_alias_directive* using_directive* global_attributes?
--       namespace_member_declaration*
--     ;

      String -> Type -> Element
def String
"CompilationUnit" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"externs"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Identifier",
        String
"usings"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"UsingDirective",
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"GlobalAttributeSection",
        String
"members"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"NamespaceMemberDeclaration"],

-- // Source: §14.3 Namespace declarations
-- namespace_declaration
--     : 'namespace' qualified_identifier namespace_body ';'?
--     ;

      String -> Type -> Element
def String
"NamespaceDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"name"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Identifier",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"NamespaceBody"],

-- qualified_identifier
--     : identifier ('.' identifier)*
--     ;
--
-- namespace_body
--     : '{' extern_alias_directive* using_directive*
--       namespace_member_declaration* '}'
--     ;

      String -> Type -> Element
def String
"NamespaceBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"externs"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Identifier",
        String
"usings"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"UsingDirective",
        String
"members"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"NamespaceMemberDeclaration"],

-- // Source: §14.4 Extern alias directives
-- extern_alias_directive
--     : 'extern' 'alias' identifier ';'
--     ;
--
-- // Source: §14.5.1 General
-- using_directive
--     : using_alias_directive
--     | using_namespace_directive
--     | using_static_directive
--     ;

      String -> Type -> Element
def String
"UsingDirective" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"alias"String -> Type -> FieldType
>: String -> Type
csharp String
"UsingAliasDirective",
        String
"namespace"String -> Type -> FieldType
>: String -> Type
csharp String
"NamespaceName",
        String
"static"String -> Type -> FieldType
>: String -> Type
csharp String
"TypeName"],

-- // Source: §14.5.2 Using alias directives
-- using_alias_directive
--     : 'using' identifier '=' namespace_or_type_name ';'
--     ;

      String -> Type -> Element
def String
"UsingAliasDirective" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"alias"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"NamespaceOrTypeName"],

-- // Source: §14.5.3 Using namespace directives
-- using_namespace_directive
--     : 'using' namespace_name ';'
--     ;
--
-- // Source: §14.5.4 Using static directives
-- using_static_directive
--     : 'using' 'static' type_name ';'
--     ;
--
-- // Source: §14.6 Namespace member declarations
-- namespace_member_declaration
--     : namespace_declaration
--     | type_declaration
--     ;

      String -> Type -> Element
def String
"NamespaceMemberDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"namespace"String -> Type -> FieldType
>: String -> Type
csharp String
"NamespaceDeclaration",
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"TypeDeclaration"],

-- // Source: §14.7 Type declarations
-- type_declaration
--     : class_declaration
--     | struct_declaration
--     | interface_declaration
--     | enum_declaration
--     | delegate_declaration
--     ;

      String -> Type -> Element
def String
"TypeDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"class"String -> Type -> FieldType
>: String -> Type
csharp String
"ClassDeclaration",
        String
"struct"String -> Type -> FieldType
>: String -> Type
csharp String
"StructDeclaration",
        String
"interface"String -> Type -> FieldType
>: String -> Type
csharp String
"InterfaceDeclaration",
        String
"enum"String -> Type -> FieldType
>: String -> Type
csharp String
"EnumDeclaration",
        String
"delegate"String -> Type -> FieldType
>: String -> Type
csharp String
"DelegateDeclaration"],

-- // Source: §14.8.1 General
-- qualified_alias_member
--     : identifier '::' identifier type_argument_list?
--     ;

      String -> Type -> Element
def String
"QualifiedAliasMember" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"alias"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"member"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"arguments"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeArgumentList"],

-- // Source: §15.2.1 General
-- class_declaration
--     : attributes? class_modifier* 'partial'? 'class' identifier
--         type_parameter_list? class_base? type_parameter_constraints_clause*
--         class_body ';'?
--     ;

      String -> Type -> Element
def String
"ClassDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ClassModifier",
        String
"partial"String -> Type -> FieldType
>: Type
unit,
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"parameters"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeParameterList",
        String
"base"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ClassBase",
        String
"constraints"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeParameterConstraintsClause",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"ClassBody"],

-- // Source: §15.2.2.1 General
-- class_modifier
--     : 'new'
--     | 'public'
--     | 'protected'
--     | 'internal'
--     | 'private'
--     | 'abstract'
--     | 'sealed'
--     | 'static'
--     | unsafe_modifier   // unsafe code support
--     ;

      String -> Type -> Element
def String
"ClassModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"new",
        String
"public",
        String
"protected",
        String
"internal",
        String
"private",
        String
"abstract",
        String
"sealed",
        String
"static",
        String
"unsafe"],

-- // Source: §15.2.3 Type parameters
-- type_parameter_list
--     : '<' type_parameters '>'
--     ;
--
-- type_parameters
--     : attributes? type_parameter
--     | type_parameters ',' attributes? type_parameter
--     ;

      String -> Type -> Element
def String
"TypeParameterList" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeParameterPart",

      String -> Type -> Element
def String
"TypeParameterPart" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"TypeParameter"],

-- // Source: §15.2.4.1 General
-- class_base
--     : ':' class_type
--     | ':' interface_type_list
--     | ':' class_type ',' interface_type_list
--     ;

      String -> Type -> Element
def String
"ClassBase" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"class"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ClassType",
        String
"interfaces"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"InterfaceType"],

-- interface_type_list
--     : interface_type (',' interface_type)*
--     ;
--
-- // Source: §15.2.5 Type parameter constraints
-- type_parameter_constraints_clauses
--     : type_parameter_constraints_clause
--     | type_parameter_constraints_clauses type_parameter_constraints_clause
--     ;
--
-- type_parameter_constraints_clause
--     : 'where' type_parameter ':' type_parameter_constraints
--     ;

      String -> Type -> Element
def String
"TypeParameterConstraintsClause" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"parameter"String -> Type -> FieldType
>: String -> Type
csharp String
"TypeParameter",
        String
"constraints"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeParameterConstraints"],

-- type_parameter_constraints
--     : primary_constraint
--     | secondary_constraints
--     | constructor_constraint
--     | primary_constraint ',' secondary_constraints
--     | primary_constraint ',' constructor_constraint
--     | secondary_constraints ',' constructor_constraint
--     | primary_constraint ',' secondary_constraints ',' constructor_constraint
--     ;

      String -> Type -> Element
def String
"TypeParameterConstraints" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"primary"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"PrimaryConstraint",
        String
"secondary"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"SecondaryConstraints",
        String
"constructor"String -> Type -> FieldType
>: Type
boolean],

-- primary_constraint
--     : class_type
--     | 'class'
--     | 'struct'
--     | 'unmanaged'
--     ;

      String -> Type -> Element
def String
"PrimaryConstraint" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"classType"String -> Type -> FieldType
>: String -> Type
csharp String
"ClassType",
        String
"class"String -> Type -> FieldType
>: Type
unit,
        String
"struct"String -> Type -> FieldType
>: Type
unit,
        String
"unmanaged"String -> Type -> FieldType
>: Type
unit],

-- secondary_constraints
--     : interface_type
--     | type_parameter
--     | secondary_constraints ',' interface_type
--     | secondary_constraints ',' type_parameter
--     ;

      String -> Type -> Element
def String
"SecondaryConstraints" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"SecondaryConstraint",

      String -> Type -> Element
def String
"SecondaryConstraint" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"interface"String -> Type -> FieldType
>: String -> Type
csharp String
"InterfaceType",
        String
"parameter"String -> Type -> FieldType
>: String -> Type
csharp String
"TypeParameter"],

-- constructor_constraint
--     : 'new' '(' ')'
--     ;
--
-- // Source: §15.2.6 Class body
-- class_body
--     : '{' class_member_declaration* '}'
--     ;

      String -> Type -> Element
def String
"ClassBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ClassMemberDeclaration",

-- // Source: §15.3.1 General
-- class_member_declaration
--     : constant_declaration
--     | field_declaration
--     | method_declaration
--     | property_declaration
--     | event_declaration
--     | indexer_declaration
--     | operator_declaration
--     | constructor_declaration
--     | finalizer_declaration
--     | static_constructor_declaration
--     | type_declaration
--     ;

      String -> Type -> Element
def String
"ClassMemberDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"constant"String -> Type -> FieldType
>: String -> Type
csharp String
"ConstantDeclaration",
        String
"field"String -> Type -> FieldType
>: String -> Type
csharp String
"FieldDeclaration",
        String
"method"String -> Type -> FieldType
>: String -> Type
csharp String
"MethodDeclaration",
        String
"property"String -> Type -> FieldType
>: String -> Type
csharp String
"PropertyDeclaration",
        String
"event"String -> Type -> FieldType
>: String -> Type
csharp String
"EventDeclaration",
        String
"indexer"String -> Type -> FieldType
>: String -> Type
csharp String
"IndexerDeclaration",
        String
"operator"String -> Type -> FieldType
>: String -> Type
csharp String
"OperatorDeclaration",
        String
"constructor"String -> Type -> FieldType
>: String -> Type
csharp String
"ConstructorDeclaration",
        String
"finalizer"String -> Type -> FieldType
>: String -> Type
csharp String
"FinalizerDeclaration",
        String
"staticConstructor"String -> Type -> FieldType
>: String -> Type
csharp String
"StaticConstructorDeclaration",
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"TypeDeclaration"],

-- // Source: §15.4 Constants
-- constant_declaration
--     : attributes? constant_modifier* 'const' type constant_declarators ';'
--     ;

      String -> Type -> Element
def String
"ConstantDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ConstantModifier",
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"declarators"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ConstantDeclarator"],

-- constant_modifier
--     : 'new'
--     | 'public'
--     | 'protected'
--     | 'internal'
--     | 'private'
--     ;

      String -> Type -> Element
def String
"ConstantModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"new",
        String
"public",
        String
"protected",
        String
"internal",
        String
"private"],

-- // Source: §15.5.1 General
-- field_declaration
--     : attributes? field_modifier* type variable_declarators ';'
--     ;

      String -> Type -> Element
def String
"FieldDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"FieldModifier",
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"declarators"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"VariableDeclarator"],

-- field_modifier
--     : 'new'
--     | 'public'
--     | 'protected'
--     | 'internal'
--     | 'private'
--     | 'static'
--     | 'readonly'
--     | 'volatile'
--     | unsafe_modifier   // unsafe code support
--     ;

      String -> Type -> Element
def String
"FieldModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"new",
        String
"public",
        String
"protected",
        String
"internal",
        String
"private",
        String
"static",
        String
"readonly",
        String
"volatile",
        String
"unsafe"],

-- variable_declarators
--     : variable_declarator (',' variable_declarator)*
--     ;

      String -> Type -> Element
def String
"VariableDeclarators" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"VariableDeclarator",

-- variable_declarator
--     : identifier ('=' variable_initializer)?
--     ;

      String -> Type -> Element
def String
"VariableDeclarator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"initializer"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"VariableInitializer"],

-- // Source: §15.6.1 General
-- method_declaration
--     : attributes? method_modifiers return_type method_header method_body
--     | attributes? ref_method_modifiers ref_kind ref_return_type method_header
--       ref_method_body
--     ;

      String -> Type -> Element
def String
"MethodDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"standard"String -> Type -> FieldType
>: String -> Type
csharp String
"StandardMethodDeclaration",
        String
"refReturn"String -> Type -> FieldType
>: String -> Type
csharp String
"RefReturnMethodDeclaration"],

      String -> Type -> Element
def String
"StandardMethodDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"MethodModifier",
        String
"returnType"String -> Type -> FieldType
>: String -> Type
csharp String
"ReturnType",
        String
"header"String -> Type -> FieldType
>: String -> Type
csharp String
"MethodHeader",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"MethodBody"],

      String -> Type -> Element
def String
"RefReturnMethodDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"RefMethodModifier",
        String
"kind"String -> Type -> FieldType
>: String -> Type
csharp String
"RefKind",
        String
"returnType"String -> Type -> FieldType
>: String -> Type
csharp String
"ReturnType",
        String
"header"String -> Type -> FieldType
>: String -> Type
csharp String
"MethodHeader",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"RefMethodBody"],

-- method_modifiers
--     : method_modifier* 'partial'?
--     ;

      String -> Type -> Element
def String
"MethodModifiers" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"MethodModifier",
        String
"partial"String -> Type -> FieldType
>: Type
boolean],

-- ref_kind
--     : 'ref'
--     | 'ref' 'readonly'
--     ;

      String -> Type -> Element
def String
"RefKind" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"ref",
        String
"refReadonly"],

-- ref_method_modifiers
--     : ref_method_modifier*
--     ;
--
-- method_header
--     : member_name '(' formal_parameter_list? ')'
--     | member_name type_parameter_list '(' formal_parameter_list? ')'
--       type_parameter_constraints_clause*
--     ;

      String -> Type -> Element
def String
"MethodHeader" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"MemberName",
        String
"typeParameters"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeParameterList",
        String
"parameters"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"FormalParameterList",
        String
"constraints"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeParameterConstraintsClause"],

-- method_modifier
--     : ref_method_modifier
--     | 'async'
--     ;

      String -> Type -> Element
def String
"MethodModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"ref"String -> Type -> FieldType
>: String -> Type
csharp String
"RefMethodModifier",
        String
"async"String -> Type -> FieldType
>: Type
unit],

-- ref_method_modifier
--     : 'new'
--     | 'public'
--     | 'protected'
--     | 'internal'
--     | 'private'
--     | 'static'
--     | 'virtual'
--     | 'sealed'
--     | 'override'
--     | 'abstract'
--     | 'extern'
--     | unsafe_modifier   // unsafe code support
--     ;

      String -> Type -> Element
def String
"RefMethodModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"new",
        String
"public",
        String
"protected",
        String
"internal",
        String
"private",
        String
"static",
        String
"virtual",
        String
"sealed",
        String
"override",
        String
"abstract",
        String
"extern",
        String
"unsafe"],

-- return_type
--     : ref_return_type
--     | 'void'
--     ;

      String -> Type -> Element
def String
"ReturnType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"ref"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"void"String -> Type -> FieldType
>: Type
unit],

-- ref_return_type
--     : type
--     ;
--
-- member_name
--     : identifier
--     | interface_type '.' identifier
--     ;

      String -> Type -> Element
def String
"MemberName" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"interfaceType"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeName",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier"],

-- method_body
--     : block
--     | '=>' null_conditional_invocation_expression ';'
--     | '=>' expression ';'
--     | ';'
--     ;

      String -> Type -> Element
def String
"MethodBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"block"String -> Type -> FieldType
>: String -> Type
csharp String
"Block",
        String
"nullConditionalInvocation"String -> Type -> FieldType
>: String -> Type
csharp String
"NullConditionalInvocationExpression",
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"empty"String -> Type -> FieldType
>: Type
unit],

-- ref_method_body
--     : block
--     | '=>' 'ref' variable_reference ';'
--     | ';'
--     ;

      String -> Type -> Element
def String
"RefMethodBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"block"String -> Type -> FieldType
>: String -> Type
csharp String
"Block",
        String
"ref"String -> Type -> FieldType
>: String -> Type
csharp String
"VariableReference",
        String
"empty"String -> Type -> FieldType
>: Type
unit],

-- // Source: §15.6.2.1 General
-- formal_parameter_list
--     : fixed_parameters
--     | fixed_parameters ',' parameter_array
--     | parameter_array
--     ;

      String -> Type -> Element
def String
"FormalParameterList" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"fixed"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"FixedParameter",
        String
"array"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ParameterArray"],

-- fixed_parameters
--     : fixed_parameter (',' fixed_parameter)*
--     ;
--
-- fixed_parameter
--     : attributes? parameter_modifier? type identifier default_argument?
--     ;

      String -> Type -> Element
def String
"FixedParameter" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifier"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ParameterModifier",
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"defaultArgument"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Expression"],

-- default_argument
--     : '=' expression
--     ;
--
-- parameter_modifier
--     : parameter_mode_modifier
--     | 'this'
--     ;

      String -> Type -> Element
def String
"ParameterModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"mode"String -> Type -> FieldType
>: String -> Type
csharp String
"ParameterModeModifier",
        String
"this"String -> Type -> FieldType
>: Type
unit],

-- parameter_mode_modifier
--     : 'ref'
--     | 'out'
--     | 'in'
--     ;

      String -> Type -> Element
def String
"ParameterModeModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"ref",
        String
"out",
        String
"in"],

-- parameter_array
--     : attributes? 'params' array_type identifier
--     ;

      String -> Type -> Element
def String
"ParameterArray" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"ArrayType",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier"],

-- // Source: §15.7.1 General
-- property_declaration
--     : attributes? property_modifier* type member_name property_body
--     | attributes? property_modifier* ref_kind type member_name ref_property_body
--     ;

      String -> Type -> Element
def String
"PropertyDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"standard"String -> Type -> FieldType
>: String -> Type
csharp String
"StandardPropertyDeclaration",
        String
"refReturn"String -> Type -> FieldType
>: String -> Type
csharp String
"RefReturnPropertyDeclaration"],

      String -> Type -> Element
def String
"StandardPropertyDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"PropertyModifier",
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"MemberName",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"PropertyBody"],

      String -> Type -> Element
def String
"RefReturnPropertyDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"PropertyModifier",
        String
"refKind"String -> Type -> FieldType
>: String -> Type
csharp String
"RefKind",
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"MemberName",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"RefPropertyBody"],

-- property_modifier
--     : 'new'
--     | 'public'
--     | 'protected'
--     | 'internal'
--     | 'private'
--     | 'static'
--     | 'virtual'
--     | 'sealed'
--     | 'override'
--     | 'abstract'
--     | 'extern'
--     | unsafe_modifier   // unsafe code support
--     ;

      String -> Type -> Element
def String
"PropertyModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"new",
        String
"public",
        String
"protected",
        String
"internal",
        String
"private",
        String
"static",
        String
"virtual",
        String
"sealed",
        String
"override",
        String
"abstract",
        String
"extern",
        String
"unsafe"],

-- property_body
--     : '{' accessor_declarations '}' property_initializer?
--     | '=>' expression ';'
--     ;

      String -> Type -> Element
def String
"PropertyBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"block"String -> Type -> FieldType
>: String -> Type
csharp String
"BlockPropertyBody",
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression"],

      String -> Type -> Element
def String
"BlockPropertyBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"accessors"String -> Type -> FieldType
>: String -> Type
csharp String
"AccessorDeclarations",
        String
"initializer"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"VariableInitializer"],

-- property_initializer
--     : '=' variable_initializer ';'
--     ;
--
-- ref_property_body
--     : '{' ref_get_accessor_declaration '}'
--     | '=>' 'ref' variable_reference ';'
--     ;

      String -> Type -> Element
def String
"RefPropertyBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"block"String -> Type -> FieldType
>: String -> Type
csharp String
"RefGetAccessorDeclaration",
        String
"ref"String -> Type -> FieldType
>: String -> Type
csharp String
"VariableReference"],

-- // Source: §15.7.3 Accessors
-- accessor_declarations
--     : get_accessor_declaration set_accessor_declaration?
--     | set_accessor_declaration get_accessor_declaration?
--     ;

      String -> Type -> Element
def String
"AccessorDeclarations" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"get"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"AccessorDeclaration",
        String
"set"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"AccessorDeclaration"],

      String -> Type -> Element
def String
"AccessorDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifier"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"AccessorModifier",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"AccessorBody"],

-- get_accessor_declaration
--     : attributes? accessor_modifier? 'get' accessor_body
--     ;
--
-- set_accessor_declaration
--     : attributes? accessor_modifier? 'set' accessor_body
--     ;
--
-- accessor_modifier
--     : 'protected'
--     | 'internal'
--     | 'private'
--     | 'protected' 'internal'
--     | 'internal' 'protected'
--     | 'protected' 'private'
--     | 'private' 'protected'
--     ;

      String -> Type -> Element
def String
"AccessorModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"protected",
        String
"internal",
        String
"private",
        String
"protectedInternal",
        String
"internalProtected",
        String
"protectedPrivate",
        String
"privateProtected"],

-- accessor_body
--     : block
--     | '=>' expression ';'
--     | ';'
--     ;

      String -> Type -> Element
def String
"AccessorBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"block"String -> Type -> FieldType
>: String -> Type
csharp String
"Block",
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"empty"String -> Type -> FieldType
>: Type
unit],

-- ref_get_accessor_declaration
--     : attributes? accessor_modifier? 'get' ref_accessor_body
--     ;

      String -> Type -> Element
def String
"RefGetAccessorDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifier"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"AccessorModifier",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"RefAccessorBody"],

-- ref_accessor_body
--     : block
--     | '=>' 'ref' variable_reference ';'
--     | ';'
--     ;

      String -> Type -> Element
def String
"RefAccessorBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"block"String -> Type -> FieldType
>: String -> Type
csharp String
"Block",
        String
"ref"String -> Type -> FieldType
>: String -> Type
csharp String
"VariableReference",
        String
"empty"String -> Type -> FieldType
>: Type
unit],

-- // Source: §15.8.1 General
-- event_declaration
--     : attributes? event_modifier* 'event' type variable_declarators ';'
--     | attributes? event_modifier* 'event' type member_name
--         '{' event_accessor_declarations '}'
--     ;

      String -> Type -> Element
def String
"EventDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"standard"String -> Type -> FieldType
>: String -> Type
csharp String
"StandardEventDeclaration",
        String
"accessors"String -> Type -> FieldType
>: String -> Type
csharp String
"AccessorsEventDeclaration"],

      String -> Type -> Element
def String
"StandardEventDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"EventModifier",
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"declarators"String -> Type -> FieldType
>: String -> Type
csharp String
"VariableDeclarators"],

      String -> Type -> Element
def String
"AccessorsEventDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"EventModifier",
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"MemberName",
        String
"accessors"String -> Type -> FieldType
>: String -> Type
csharp String
"EventAccessorDeclarations"],

-- event_modifier
--     : 'new'
--     | 'public'
--     | 'protected'
--     | 'internal'
--     | 'private'
--     | 'static'
--     | 'virtual'
--     | 'sealed'
--     | 'override'
--     | 'abstract'
--     | 'extern'
--     | unsafe_modifier   // unsafe code support
--     ;

      String -> Type -> Element
def String
"EventModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"new",
        String
"public",
        String
"protected",
        String
"internal",
        String
"private",
        String
"static",
        String
"virtual",
        String
"sealed",
        String
"override",
        String
"abstract",
        String
"extern",
        String
"unsafe"],

-- event_accessor_declarations
--     : add_accessor_declaration remove_accessor_declaration
--     | remove_accessor_declaration add_accessor_declaration
--     ;

      String -> Type -> Element
def String
"EventAccessorDeclarations" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"add"String -> Type -> FieldType
>: String -> Type
csharp String
"AddRemoveAccessorDeclaration",
        String
"remove"String -> Type -> FieldType
>: String -> Type
csharp String
"AddRemoveAccessorDeclaration"],

      String -> Type -> Element
def String
"AddRemoveAccessorDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"Block"],

-- add_accessor_declaration
--     : attributes? 'add' block
--     ;
--
-- remove_accessor_declaration
--     : attributes? 'remove' block
--     ;
--
-- // Source: §15.9.1 General
-- indexer_declaration
--     : attributes? indexer_modifier* indexer_declarator indexer_body
--     | attributes? indexer_modifier* ref_kind indexer_declarator ref_indexer_body
--     ;

      String -> Type -> Element
def String
"IndexerDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"standard"String -> Type -> FieldType
>: String -> Type
csharp String
"StandardIndexerDeclaration",
        String
"ref"String -> Type -> FieldType
>: String -> Type
csharp String
"RefIndexerDeclaration"],

      String -> Type -> Element
def String
"StandardIndexerDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"IndexerModifier",
        String
"declarator"String -> Type -> FieldType
>: String -> Type
csharp String
"IndexerDeclarator",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"IndexerBody"],

      String -> Type -> Element
def String
"RefIndexerDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"IndexerModifier",
        String
"refKind"String -> Type -> FieldType
>: String -> Type
csharp String
"RefKind",
        String
"declarator"String -> Type -> FieldType
>: String -> Type
csharp String
"IndexerDeclarator",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"RefIndexerBody"],

-- indexer_modifier
--     : 'new'
--     | 'public'
--     | 'protected'
--     | 'internal'
--     | 'private'
--     | 'virtual'
--     | 'sealed'
--     | 'override'
--     | 'abstract'
--     | 'extern'
--     | unsafe_modifier   // unsafe code support
--     ;

      String -> Type -> Element
def String
"IndexerModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"new",
        String
"public",
        String
"protected",
        String
"internal",
        String
"private",
        String
"virtual",
        String
"sealed",
        String
"override",
        String
"abstract",
        String
"extern",
        String
"unsafe"],

-- indexer_declarator
--     : type 'this' '[' formal_parameter_list ']'
--     | type interface_type '.' 'this' '[' formal_parameter_list ']'
--     ;

      String -> Type -> Element
def String
"IndexerDeclarator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"interface"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"InterfaceType",
        String
"parameters"String -> Type -> FieldType
>: String -> Type
csharp String
"FormalParameterList"],

-- indexer_body
--     : '{' accessor_declarations '}'
--     | '=>' expression ';'
--     ;

      String -> Type -> Element
def String
"IndexerBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"block"String -> Type -> FieldType
>: String -> Type
csharp String
"AccessorDeclarations",
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression"],

-- ref_indexer_body
--     : '{' ref_get_accessor_declaration '}'
--     | '=>' 'ref' variable_reference ';'
--     ;

      String -> Type -> Element
def String
"RefIndexerBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"block"String -> Type -> FieldType
>: String -> Type
csharp String
"RefGetAccessorDeclaration",
        String
"ref"String -> Type -> FieldType
>: String -> Type
csharp String
"VariableReference"],

-- // Source: §15.10.1 General
-- operator_declaration
--     : attributes? operator_modifier+ operator_declarator operator_body
--     ;

      String -> Type -> Element
def String
"OperatorDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"OperatorModifier",
        String
"declarator"String -> Type -> FieldType
>: String -> Type
csharp String
"OperatorDeclarator",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"OperatorBody"],

-- operator_modifier
--     : 'public'
--     | 'static'
--     | 'extern'
--     | unsafe_modifier   // unsafe code support
--     ;

      String -> Type -> Element
def String
"OperatorModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"public",
        String
"static",
        String
"extern",
        String
"unsafe"],

-- operator_declarator
--     : unary_operator_declarator
--     | binary_operator_declarator
--     | conversion_operator_declarator
--     ;

      String -> Type -> Element
def String
"OperatorDeclarator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"unary"String -> Type -> FieldType
>: String -> Type
csharp String
"UnaryOperatorDeclarator",
        String
"binary"String -> Type -> FieldType
>: String -> Type
csharp String
"BinaryOperatorDeclarator",
        String
"conversion"String -> Type -> FieldType
>: String -> Type
csharp String
"ConversionOperatorDeclarator"],

-- unary_operator_declarator
--     : type 'operator' overloadable_unary_operator '(' fixed_parameter ')'
--     ;

      String -> Type -> Element
def String
"UnaryOperatorDeclarator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"operator"String -> Type -> FieldType
>: String -> Type
csharp String
"OverloadableUnaryOperator",
        String
"parameter"String -> Type -> FieldType
>: String -> Type
csharp String
"FixedParameter"],

-- overloadable_unary_operator
--     : '+' | '-' | '!' | '~' | '++' | '--' | 'true' | 'false'
--     ;

      String -> Type -> Element
def String
"OverloadableUnaryOperator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"plus",
        String
"minus",
        String
"not",
        String
"complement",
        String
"increment",
        String
"decrement",
        String
"true",
        String
"false"],

-- binary_operator_declarator
--     : type 'operator' overloadable_binary_operator
--         '(' fixed_parameter ',' fixed_parameter ')'
--     ;

      String -> Type -> Element
def String
"BinaryOperatorDeclarator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"operator"String -> Type -> FieldType
>: String -> Type
csharp String
"OverloadableBinaryOperator",
        String
"left"String -> Type -> FieldType
>: String -> Type
csharp String
"FixedParameter",
        String
"right"String -> Type -> FieldType
>: String -> Type
csharp String
"FixedParameter"],

-- overloadable_binary_operator
--     : '+'  | '-'  | '*'  | '/'  | '%'  | '&' | '|' | '^'  | '<<'
--     | right_shift | '==' | '!=' | '>' | '<' | '>=' | '<='
--     ;

      String -> Type -> Element
def String
"OverloadableBinaryOperator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"add",
        String
"subtract",
        String
"multiply",
        String
"divide",
        String
"modulus",
        String
"and",
        String
"or",
        String
"xor",
        String
"leftShift",
        String
"rightShift",
        String
"equal",
        String
"notEqual",
        String
"greaterThan",
        String
"lessThan",
        String
"greaterThanOrEqual",
        String
"lessThanOrEqual"],

-- conversion_operator_declarator
--     : 'implicit' 'operator' type '(' fixed_parameter ')'
--     | 'explicit' 'operator' type '(' fixed_parameter ')'
--     ;

      String -> Type -> Element
def String
"ConversionOperatorDeclarator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"kind"String -> Type -> FieldType
>: String -> Type
csharp String
"ConversionKind",
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"parameter"String -> Type -> FieldType
>: String -> Type
csharp String
"FixedParameter"],

      String -> Type -> Element
def String
"ConversionKind" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"implicit",
        String
"explicit"],

-- operator_body
--     : block
--     | '=>' expression ';'
--     | ';'
--     ;

      String -> Type -> Element
def String
"OperatorBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"block"String -> Type -> FieldType
>: String -> Type
csharp String
"Block",
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"empty"String -> Type -> FieldType
>: Type
unit],

-- // Source: §15.11.1 General
-- constructor_declaration
--     : attributes? constructor_modifier* constructor_declarator constructor_body
--     ;

      String -> Type -> Element
def String
"ConstructorDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ConstructorModifier",
        String
"declarator"String -> Type -> FieldType
>: String -> Type
csharp String
"ConstructorDeclarator",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"ConstructorBody"],

-- constructor_modifier
--     : 'public'
--     | 'protected'
--     | 'internal'
--     | 'private'
--     | 'extern'
--     | unsafe_modifier   // unsafe code support
--     ;

      String -> Type -> Element
def String
"ConstructorModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"public",
        String
"protected",
        String
"internal",
        String
"private",
        String
"extern",
        String
"unsafe"],

-- constructor_declarator
--     : identifier '(' formal_parameter_list? ')' constructor_initializer?
--     ;

      String -> Type -> Element
def String
"ConstructorDeclarator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"parameters"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"FormalParameterList",
        String
"initializer"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ConstructorInitializer"],

-- constructor_initializer
--     : ':' 'base' '(' argument_list? ')'
--     | ':' 'this' '(' argument_list? ')'
--     ;

      String -> Type -> Element
def String
"ConstructorInitializer" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"base"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ArgumentList",
        String
"this"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ArgumentList"],

-- constructor_body
--     : block
--     | '=>' expression ';'
--     | ';'
--     ;

      String -> Type -> Element
def String
"ConstructorBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"block"String -> Type -> FieldType
>: String -> Type
csharp String
"Block",
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"empty"String -> Type -> FieldType
>: Type
unit],

-- // Source: §15.12 Static constructors
-- static_constructor_declaration
--     : attributes? static_constructor_modifiers identifier '(' ')'
--         static_constructor_body
--     ;

      String -> Type -> Element
def String
"StaticConstructorDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifiers"String -> Type -> FieldType
>: String -> Type
csharp String
"StaticConstructorModifiers",
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"StaticConstructorBody"],

-- static_constructor_modifiers
--     : 'static'
--     | 'static' 'extern' unsafe_modifier?
--     | 'static' unsafe_modifier 'extern'?
--     | 'extern' 'static' unsafe_modifier?
--     | 'extern' unsafe_modifier 'static'
--     | unsafe_modifier 'static' 'extern'?
--     | unsafe_modifier 'extern' 'static'
--     ;

      String -> Type -> Element
def String
"StaticConstructorModifiers" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"extern"String -> Type -> FieldType
>: Type
boolean,
        String
"unsafe"String -> Type -> FieldType
>: Type
boolean],

-- static_constructor_body
--     : block
--     | '=>' expression ';'
--     | ';'
--     ;

      String -> Type -> Element
def String
"StaticConstructorBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"block"String -> Type -> FieldType
>: String -> Type
csharp String
"Block",
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"empty"String -> Type -> FieldType
>: Type
unit],

-- // Source: §15.13 Finalizers
-- finalizer_declaration
--     : attributes? '~' identifier '(' ')' finalizer_body
--     | attributes? 'extern' unsafe_modifier? '~' identifier '(' ')'
--       finalizer_body
--     | attributes? unsafe_modifier 'extern'? '~' identifier '(' ')'
--       finalizer_body
--     ;

      String -> Type -> Element
def String
"FinalizerDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"extern"String -> Type -> FieldType
>: Type
boolean,
        String
"unsafe"String -> Type -> FieldType
>: Type
boolean,
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"body"String -> Type -> FieldType
>: String -> Type
csharp String
"FinalizerBody"],

-- finalizer_body
--     : block
--     | '=>' expression ';'
--     | ';'
--     ;

      String -> Type -> Element
def String
"FinalizerBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"block"String -> Type -> FieldType
>: String -> Type
csharp String
"Block",
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"empty"String -> Type -> FieldType
>: Type
unit],

-- // Source: §16.2.1 General
-- struct_declaration
--     : attributes? struct_modifier* 'ref'? 'partial'? 'struct'
--       identifier type_parameter_list? struct_interfaces?
--       type_parameter_constraints_clause* struct_body ';'?
--     ;

      String -> Type -> Element
def String
"StructDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"StructModifier",
        String
"ref"String -> Type -> FieldType
>: Type
boolean,
        String
"partial"String -> Type -> FieldType
>: Type
boolean,
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"parameters"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeParameterList",
        String
"interfaces"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"InterfaceType",
        String
"constraints"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeParameterConstraintsClause",
        String
"body"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"StructMemberDeclaration"],

-- // Source: §16.2.2 Struct modifiers
-- struct_modifier
--     : 'new'
--     | 'public'
--     | 'protected'
--     | 'internal'
--     | 'private'
--     | 'readonly'
--     | unsafe_modifier   // unsafe code support
--     ;

      String -> Type -> Element
def String
"StructModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"new",
        String
"public",
        String
"protected",
        String
"internal",
        String
"private",
        String
"readonly",
        String
"unsafe"],

-- // Source: §16.2.5 Struct interfaces
-- struct_interfaces
--     : ':' interface_type_list
--     ;
--
-- // Source: §16.2.6 Struct body
-- struct_body
--     : '{' struct_member_declaration* '}'
--     ;
--
-- // Source: §16.3 Struct members
-- struct_member_declaration
--     : constant_declaration
--     | field_declaration
--     | method_declaration
--     | property_declaration
--     | event_declaration
--     | indexer_declaration
--     | operator_declaration
--     | constructor_declaration
--     | static_constructor_declaration
--     | type_declaration
--     | fixed_size_buffer_declaration   // unsafe code support
--     ;

      String -> Type -> Element
def String
"StructMemberDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"constant"String -> Type -> FieldType
>: String -> Type
csharp String
"ConstantDeclaration",
        String
"field"String -> Type -> FieldType
>: String -> Type
csharp String
"FieldDeclaration",
        String
"method"String -> Type -> FieldType
>: String -> Type
csharp String
"MethodDeclaration",
        String
"property"String -> Type -> FieldType
>: String -> Type
csharp String
"PropertyDeclaration",
        String
"event"String -> Type -> FieldType
>: String -> Type
csharp String
"EventDeclaration",
        String
"indexer"String -> Type -> FieldType
>: String -> Type
csharp String
"IndexerDeclaration",
        String
"operator"String -> Type -> FieldType
>: String -> Type
csharp String
"OperatorDeclaration",
        String
"constructor"String -> Type -> FieldType
>: String -> Type
csharp String
"ConstructorDeclaration",
        String
"staticConstructor"String -> Type -> FieldType
>: String -> Type
csharp String
"StaticConstructorDeclaration",
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"TypeDeclaration",
        String
"fixedSizeBuffer"String -> Type -> FieldType
>: String -> Type
csharp String
"FixedSizeBufferDeclaration"],

-- // Source: §17.7 Array initializers
-- array_initializer
--     : '{' variable_initializer_list? '}'
--     | '{' variable_initializer_list ',' '}'
--     ;

      String -> Type -> Element
def String
"ArrayInitializer" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"VariableInitializer",

-- variable_initializer_list
--     : variable_initializer (',' variable_initializer)*
--     ;
--
-- variable_initializer
--     : expression
--     | array_initializer
--     ;

      String -> Type -> Element
def String
"VariableInitializer" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression",
        String
"array"String -> Type -> FieldType
>: String -> Type
csharp String
"ArrayInitializer"],

-- // Source: §18.2.1 General
-- interface_declaration
--     : attributes? interface_modifier* 'partial'? 'interface'
--       identifier variant_type_parameter_list? interface_base?
--       type_parameter_constraints_clause* interface_body ';'?
--     ;

      String -> Type -> Element
def String
"InterfaceDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"InterfaceModifier",
        String
"partial"String -> Type -> FieldType
>: Type
boolean,
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"parameters"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"VariantTypeParameters",
        String
"base"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"InterfaceType",
        String
"constraints"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeParameterConstraintsClause",
        String
"body"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"InterfaceMemberDeclaration"],

-- // Source: §18.2.2 Interface modifiers
-- interface_modifier
--     : 'new'
--     | 'public'
--     | 'protected'
--     | 'internal'
--     | 'private'
--     | unsafe_modifier   // unsafe code support
--     ;

      String -> Type -> Element
def String
"InterfaceModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"new",
        String
"public",
        String
"protected",
        String
"internal",
        String
"private",
        String
"unsafe"],

-- // Source: §18.2.3.1 General
-- variant_type_parameter_list
--     : '<' variant_type_parameters '>'
--     ;
--
-- // Source: §18.2.3.1 General
-- variant_type_parameters
--     : attributes? variance_annotation? type_parameter
--     | variant_type_parameters ',' attributes? variance_annotation?
--       type_parameter
--     ;

      String -> Type -> Element
def String
"VariantTypeParameters" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"VariantTypeParameter",

      String -> Type -> Element
def String
"VariantTypeParameter" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"variance"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"VarianceAnnotation",
        String
"parameter"String -> Type -> FieldType
>: String -> Type
csharp String
"TypeParameter"],

-- // Source: §18.2.3.1 General
-- variance_annotation
--     : 'in'
--     | 'out'
--     ;

      String -> Type -> Element
def String
"VarianceAnnotation" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"in",
        String
"out"],

-- // Source: §18.2.4 Base interfaces
-- interface_base
--     : ':' interface_type_list
--     ;
--
-- // Source: §18.3 Interface body
-- interface_body
--     : '{' interface_member_declaration* '}'
--     ;
--
-- // Source: §18.4.1 General
-- interface_member_declaration
--     : interface_method_declaration
--     | interface_property_declaration
--     | interface_event_declaration
--     | interface_indexer_declaration
--     ;

      String -> Type -> Element
def String
"InterfaceMemberDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"method"String -> Type -> FieldType
>: String -> Type
csharp String
"InterfaceMethodDeclaration",
        String
"property"String -> Type -> FieldType
>: String -> Type
csharp String
"InterfacePropertyDeclaration",
        String
"event"String -> Type -> FieldType
>: String -> Type
csharp String
"InterfaceEventDeclaration",
        String
"indexer"String -> Type -> FieldType
>: String -> Type
csharp String
"InterfaceIndexerDeclaration"],

-- // Source: §18.4.2 Interface methods
-- interface_method_declaration
--     : attributes? 'new'? return_type interface_method_header
--     | attributes? 'new'? ref_kind ref_return_type interface_method_header
--     ;

      String -> Type -> Element
def String
"InterfaceMethodDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"new"String -> Type -> FieldType
>: Type
boolean,
        String
"returnType"String -> Type -> FieldType
>: String -> Type
csharp String
"ReturnType",
        String
"refKind"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"RefKind",
        String
"header"String -> Type -> FieldType
>: String -> Type
csharp String
"InterfaceMethodHeader"],

-- interface_method_header
--     : identifier '(' formal_parameter_list? ')' ';'
--     | identifier type_parameter_list '(' formal_parameter_list? ')'
--       type_parameter_constraints_clause* ';'
--     ;

      String -> Type -> Element
def String
"InterfaceMethodHeader" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"parameters"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"FormalParameterList",
        String
"typeParameters"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeParameterList",
        String
"constraints"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeParameterConstraintsClause"],

-- // Source: §18.4.3 Interface properties
-- interface_property_declaration
--     : attributes? 'new'? type identifier '{' interface_accessors '}'
--     | attributes? 'new'? ref_kind type identifier '{' ref_interface_accessor '}'
--     ;

      String -> Type -> Element
def String
"InterfacePropertyDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"new"String -> Type -> FieldType
>: Type
boolean,
        String
"refKind"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"RefKind",
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"accessors"String -> Type -> FieldType
>: String -> Type
csharp String
"InterfaceAccessors"],

-- interface_accessors
--     : attributes? 'get' ';'
--     | attributes? 'set' ';'
--     | attributes? 'get' ';' attributes? 'set' ';'
--     | attributes? 'set' ';' attributes? 'get' ';'
--     ;

      String -> Type -> Element
def String
"InterfaceAccessors" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"get"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"set"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes"],

-- ref_interface_accessor
--     : attributes? 'get' ';'
--     ;
--
-- // Source: §18.4.4 Interface events
-- interface_event_declaration
--     : attributes? 'new'? 'event' type identifier ';'
--     ;

      String -> Type -> Element
def String
"InterfaceEventDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"new"String -> Type -> FieldType
>: Type
boolean,
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier"],

-- // Source: §18.4.5 Interface indexers
-- interface_indexer_declaration
--     : attributes? 'new'? type 'this' '[' formal_parameter_list ']'
--       '{' interface_accessors '}'
--     | attributes? 'new'? ref_kind type 'this' '[' formal_parameter_list ']'
--       '{' ref_interface_accessor '}'
--     ;

      String -> Type -> Element
def String
"InterfaceIndexerDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"new"String -> Type -> FieldType
>: Type
boolean,
        String
"refKind"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"RefKind",
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"parameters"String -> Type -> FieldType
>: String -> Type
csharp String
"FormalParameterList",
        String
"accessors"String -> Type -> FieldType
>: String -> Type
csharp String
"InterfaceAccessors"],

-- // Source: §19.2 Enum declarations
-- enum_declaration
--     : attributes? enum_modifier* 'enum' identifier enum_base? enum_body ';'?
--     ;

      String -> Type -> Element
def String
"EnumDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"EnumModifier",
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"base"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"EnumBase",
        String
"body"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"EnumBody"],

-- enum_base
--     : ':' integral_type
--     | ':' integral_type_name
--     ;

      String -> Type -> Element
def String
"EnumBase" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"type"String -> Type -> FieldType
>: String -> Type
csharp String
"IntegralType",
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"TypeName"],

-- integral_type_name
--     : type_name // Shall resolve to an integral type other than char
--     ;
--
-- enum_body
--     : '{' enum_member_declarations? '}'
--     | '{' enum_member_declarations ',' '}'
--     ;

      String -> Type -> Element
def String
"EnumBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"EnumMemberDeclaration",

-- // Source: §19.3 Enum modifiers
-- enum_modifier
--     : 'new'
--     | 'public'
--     | 'protected'
--     | 'internal'
--     | 'private'
--     ;

      String -> Type -> Element
def String
"EnumModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"new",
        String
"public",
        String
"protected",
        String
"internal",
        String
"private"],

-- // Source: §19.4 Enum members
-- enum_member_declarations
--     : enum_member_declaration (',' enum_member_declaration)*
--     ;
--
-- // Source: §19.4 Enum members
-- enum_member_declaration
--     : attributes? identifier ('=' constant_expression)?
--     ;

      String -> Type -> Element
def String
"EnumMemberDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"value"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ConstantExpression"],

-- // Source: §20.2 Delegate declarations
-- delegate_declaration
--     : attributes? delegate_modifier* 'delegate' return_type delegate_header
--     | attributes? delegate_modifier* 'delegate' ref_kind ref_return_type
--       delegate_header
--     ;

      String -> Type -> Element
def String
"DelegateDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"DelegateModifier",
        String
"returnType"String -> Type -> FieldType
>: String -> Type
csharp String
"ReturnType",
        String
"refKind"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"RefKind",
        String
"refReturnType"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Type",
        String
"header"String -> Type -> FieldType
>: String -> Type
csharp String
"DelegateHeader"],

-- delegate_header
--     : identifier '(' formal_parameter_list? ')' ';'
--     | identifier variant_type_parameter_list '(' formal_parameter_list? ')'
--       type_parameter_constraints_clause* ';'
--     ;

      String -> Type -> Element
def String
"DelegateHeader" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"typeParameters"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"VariantTypeParameters",
        String
"parameters"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"FormalParameterList",
        String
"constraints"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeParameterConstraintsClause"],

-- delegate_modifier
--     : 'new'
--     | 'public'
--     | 'protected'
--     | 'internal'
--     | 'private'
--     | unsafe_modifier   // unsafe code support
--     ;

      String -> Type -> Element
def String
"DelegateModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"new",
        String
"public",
        String
"protected",
        String
"internal",
        String
"private",
        String
"unsafe"],

-- // Source: §22.3 Attribute specification
-- global_attributes
--     : global_attribute_section+
--     ;
--
-- global_attribute_section
--     : '[' global_attribute_target_specifier attribute_list ']'
--     | '[' global_attribute_target_specifier attribute_list ',' ']'
--     ;

      String -> Type -> Element
def String
"GlobalAttributeSection" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"target"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"attributes"String -> Type -> FieldType
>: String -> Type
csharp String
"AttributeList"],

-- global_attribute_target_specifier
--     : global_attribute_target ':'
--     ;
--
-- global_attribute_target
--     : identifier
--     ;
--
-- attributes
--     : attribute_section+
--     ;

      String -> Type -> Element
def String
"Attributes" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"AttributeSection",

-- attribute_section
--     : '[' attribute_target_specifier? attribute_list ']'
--     | '[' attribute_target_specifier? attribute_list ',' ']'
--     ;

      String -> Type -> Element
def String
"AttributeSection" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"target"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"AttributeTarget",
        String
"attributes"String -> Type -> FieldType
>: String -> Type
csharp String
"AttributeList"],

-- attribute_target_specifier
--     : attribute_target ':'
--     ;
--
-- attribute_target
--     : identifier
--     | keyword
--     ;

      String -> Type -> Element
def String
"AttributeTarget" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"identifier"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"keyword"String -> Type -> FieldType
>: String -> Type
csharp String
"Keyword"],

-- attribute_list
--     : attribute (',' attribute)*
--     ;

      String -> Type -> Element
def String
"AttributeList" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attribute",

-- attribute
--     : attribute_name attribute_arguments?
--     ;

      String -> Type -> Element
def String
"Attribute" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"AttributeName",
        String
"arguments"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"AttributeArguments"],

-- attribute_name
--     : type_name
--     ;

      String -> Type -> Element
def String
"AttributeName" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeName",

-- attribute_arguments
--     : '(' ')'
--     | '(' positional_argument_list (',' named_argument_list)? ')'
--     | '(' named_argument_list ')'
--     ;

      String -> Type -> Element
def String
"AttributeArguments" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"positonal"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"PositionalArgumentList",
        String
"named"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"NamedArgumentList"],

-- positional_argument_list
--     : positional_argument (',' positional_argument)*
--     ;

      String -> Type -> Element
def String
"PositionalArgumentList" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"PositionalArgument",

-- positional_argument
--     : argument_name? attribute_argument_expression
--     ;

      String -> Type -> Element
def String
"PositionalArgument" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"name"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Identifier",
        String
"value"String -> Type -> FieldType
>: String -> Type
csharp String
"AttributeArgumentExpression"],

-- named_argument_list
--     : named_argument (','  named_argument)*
--     ;

      String -> Type -> Element
def String
"NamedArgumentList" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"NamedArgument",

-- named_argument
--     : identifier '=' attribute_argument_expression
--     ;

      String -> Type -> Element
def String
"NamedArgument" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"value"String -> Type -> FieldType
>: String -> Type
csharp String
"AttributeArgumentExpression"],

-- attribute_argument_expression
--     : non_assignment_expression
--     ;

      String -> Type -> Element
def String
"AttributeArgumentExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"NonAssignmentExpression"]

    unsafeElements :: [Element]
unsafeElements = [

-- // Source: §23.2 Unsafe contexts
-- unsafe_modifier
--     : 'unsafe'
--     ;
--
-- unsafe_statement
--     : 'unsafe' block
--     ;
--
-- // Source: §23.3 Pointer types
-- pointer_type
--     : value_type ('*')+
--     | 'void' ('*')+
--     ;

      String -> Type -> Element
def String
"PointerType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"valueType"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"ValueType",
        String
"pointerDepth"String -> Type -> FieldType
>: Type
int32], -- Note: positive integer

-- // Source: §23.6.2 Pointer indirection
-- pointer_indirection_expression
--     : '*' unary_expression
--     ;
--
-- // Source: §23.6.3 Pointer member access
-- pointer_member_access
--     : primary_expression '->' identifier type_argument_list?
--     ;

      String -> Type -> Element
def String
"PointerMemberAccess" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"pointer"String -> Type -> FieldType
>: String -> Type
csharp String
"PrimaryExpression",
        String
"member"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"typeArguments"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"TypeArgumentList"],

-- // Source: §23.6.4 Pointer element access
-- pointer_element_access
--     : primary_no_array_creation_expression '[' expression ']'
--     ;

      String -> Type -> Element
def String
"PointerElementAccess" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"pointer"String -> Type -> FieldType
>: String -> Type
csharp String
"PrimaryNoArrayCreationExpression",
        String
"index"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression"],

-- // Source: §23.6.5 The address-of operator
-- addressof_expression
--     : '&' unary_expression
--     ;
--
-- // Source: §23.7 The fixed statement
-- fixed_statement
--     : 'fixed' '(' pointer_type fixed_pointer_declarators ')' embedded_statement
--     ;

      String -> Type -> Element
def String
"FixedStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"pointerType"String -> Type -> FieldType
>: String -> Type
csharp String
"PointerType",
        String
"declarators"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"FixedPointerDeclarator",
        String
"statement"String -> Type -> FieldType
>: String -> Type
csharp String
"EmbeddedStatement"],

-- fixed_pointer_declarators
--     : fixed_pointer_declarator (','  fixed_pointer_declarator)*
--     ;
--
-- fixed_pointer_declarator
--     : identifier '=' fixed_pointer_initializer
--     ;
--
-- fixed_pointer_initializer
--     : '&' variable_reference
--     | expression
--     ;

      String -> Type -> Element
def String
"FixedPointerDeclarator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"reference"String -> Type -> FieldType
>: String -> Type
csharp String
"VariableReference",
        String
"expression"String -> Type -> FieldType
>: String -> Type
csharp String
"Expression"],

-- // Source: §23.8.2 Fixed-size buffer declarations
-- fixed_size_buffer_declaration
--     : attributes? fixed_size_buffer_modifier* 'fixed' buffer_element_type
--       fixed_size_buffer_declarators ';'
--     ;

      String -> Type -> Element
def String
"FixedSizeBufferDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"attributes"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"Attributes",
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"FixedSizeBufferModifier",
        String
"elementType"String -> Type -> FieldType
>: String -> Type
csharp String
"Type",
        String
"declarators"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
csharp String
"FixedSizeBufferDeclarator"],

-- fixed_size_buffer_modifier
--     : 'new'
--     | 'public'
--     | 'internal'
--     | 'private'
--     | 'unsafe'
--     ;

      String -> Type -> Element
def String
"FixedSizeBufferModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"new",
        String
"public",
        String
"internal",
        String
"private",
        String
"unsafe"],

-- buffer_element_type
--     : type
--     ;
--
-- fixed_size_buffer_declarators
--     : fixed_size_buffer_declarator (',' fixed_size_buffer_declarator)*
--     ;
--
-- fixed_size_buffer_declarator
--     : identifier '[' constant_expression ']'
--     ;

      String -> Type -> Element
def String
"FixedSizeBufferDeclarator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"name"String -> Type -> FieldType
>: String -> Type
csharp String
"Identifier",
        String
"size"String -> Type -> FieldType
>: String -> Type
csharp String
"ConstantExpression"]]