module Hydra.Sources.Tier4.Langs.Java.Syntax where

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


javaSyntaxModule :: Module
javaSyntaxModule :: Module
javaSyntaxModule = 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 Java syntax module. Based on the Oracle Java SE 12 BNF:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
"  https://docs.oracle.com/javase/specs/jls/se12/html/jls-19.html\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
"Note: all *WithComments types were added manually, rather than derived from the BNF, which does not allow for comments.")
  where
    ns :: Namespace
ns = String -> Namespace
Namespace String
"hydra/langs/java/syntax"
    def :: String -> Type -> Element
def = Namespace -> String -> Type -> Element
datatype Namespace
ns
    java :: String -> Type
java = Namespace -> String -> Type
typeref Namespace
ns

    elements :: [Element]
elements = [

--Productions from §3 (Lexical Structure)

--Identifier:
--  IdentifierChars but not a Keyword or BooleanLiteral or NullLiteral
      String -> Type -> Element
def String
"Identifier" Type
string,
--IdentifierChars:
--  JavaLetter {JavaLetterOrDigit}
--
--JavaLetter:
--  any Unicode character that is a "Java letter"
--
--JavaLetterOrDigit:
--  any Unicode character that is a "Java letter-or-digit"

--TypeIdentifier:
--  Identifier but not var
      String -> Type -> Element
def String
"TypeIdentifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Identifier",

--Literal:
      String -> Type -> Element
def String
"Literal" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
--  NullLiteral
          String
"null"String -> Type -> FieldType
>: Type
unit,
--  IntegerLiteral
          String
"integer"String -> Type -> FieldType
>: String -> Type
java String
"IntegerLiteral",
--  FloatingPointLiteral
          String
"floatingPoint"String -> Type -> FieldType
>: String -> Type
java String
"FloatingPointLiteral",
--  BooleanLiteral
          String
"boolean"String -> Type -> FieldType
>: Type
boolean,
--  CharacterLiteral
          String
"character"String -> Type -> FieldType
>: Type
uint16,
--  StringLiteral
          String
"string"String -> Type -> FieldType
>: String -> Type
java String
"StringLiteral"],
      String -> Type -> Element
def String
"IntegerLiteral" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"Note: this is an approximation which ignores encoding"
        Type
bigint,
      String -> Type -> Element
def String
"FloatingPointLiteral" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"Note: this is an approximation which ignores encoding"
        Type
bigfloat,
      String -> Type -> Element
def String
"StringLiteral" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"Note: this is an approximation which ignores encoding"
        Type
string,

--Productions from §4 (Types, Values, and Variables)

--Type:
      String -> Type -> Element
def String
"Type" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  PrimitiveType
          String
"primitive"String -> Type -> FieldType
>: String -> Type
java String
"PrimitiveTypeWithAnnotations",
--  ReferenceType
          String
"reference"String -> Type -> FieldType
>: String -> Type
java String
"ReferenceType"],

--PrimitiveType:
      String -> Type -> Element
def String
"PrimitiveTypeWithAnnotations" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
java String
"PrimitiveType",
        String
"annotations"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Annotation"],
      String -> Type -> Element
def String
"PrimitiveType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  {Annotation} NumericType
        String
"numeric"String -> Type -> FieldType
>: String -> Type
java String
"NumericType",
--  {Annotation} boolean
        String
"boolean"String -> Type -> FieldType
>: Type
unit],

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

--IntegralType:
      String -> Type -> Element
def String
"IntegralType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
--  (one of)
--  byte short int long char
        String
"byte", String
"short", String
"int", String
"long", String
"char"],

--FloatingPointType:
      String -> Type -> Element
def String
"FloatingPointType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
--  (one of)
--  float double
        String
"float", String
"double"],

--ReferenceType:
      String -> Type -> Element
def String
"ReferenceType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  ClassOrInterfaceType
        String
"classOrInterface"String -> Type -> FieldType
>: String -> Type
java String
"ClassOrInterfaceType",
--  TypeVariable
        String
"variable"String -> Type -> FieldType
>: String -> Type
java String
"TypeVariable",
--  ArrayType
        String
"array"String -> Type -> FieldType
>: String -> Type
java String
"ArrayType"],

--ClassOrInterfaceType:
      String -> Type -> Element
def String
"ClassOrInterfaceType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  ClassType
        String
"class"String -> Type -> FieldType
>: String -> Type
java String
"ClassType",
--  InterfaceType
        String
"interface"String -> Type -> FieldType
>: String -> Type
java String
"InterfaceType"],

--ClassType:
      String -> Type -> Element
def String
"ClassType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"annotations"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Annotation",
        String
"qualifier"String -> Type -> FieldType
>: String -> Type
java String
"ClassTypeQualifier",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"TypeIdentifier",
        String
"arguments"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeArgument"],
      String -> Type -> Element
def String
"ClassTypeQualifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  {Annotation} TypeIdentifier [TypeArguments]
        String
"none"String -> Type -> FieldType
>: Type
unit,
--  PackageName . {Annotation} TypeIdentifier [TypeArguments]
        String
"package"String -> Type -> FieldType
>: String -> Type
java String
"PackageName",
--  ClassOrInterfaceType . {Annotation} TypeIdentifier [TypeArguments]
        String
"parent"String -> Type -> FieldType
>: String -> Type
java String
"ClassOrInterfaceType"],

--InterfaceType:
--  ClassType
      String -> Type -> Element
def String
"InterfaceType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ClassType",

--TypeVariable:
--  {Annotation} TypeIdentifier
      String -> Type -> Element
def String
"TypeVariable" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"annotations"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Annotation",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"TypeIdentifier"],

--ArrayType:
      String -> Type -> Element
def String
"ArrayType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"dims"String -> Type -> FieldType
>: String -> Type
java String
"Dims",
        String
"variant"String -> Type -> FieldType
>: String -> Type
java String
"ArrayType.Variant"],
      String -> Type -> Element
def String
"ArrayType.Variant" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  PrimitiveType Dims
        String
"primitive"String -> Type -> FieldType
>: String -> Type
java String
"PrimitiveTypeWithAnnotations",
--  ClassOrInterfaceType Dims
        String
"classOrInterface"String -> Type -> FieldType
>: String -> Type
java String
"ClassOrInterfaceType",
--  TypeVariable Dims
        String
"variable"String -> Type -> FieldType
>: String -> Type
java String
"TypeVariable"],

--Dims:
--  {Annotation} [ ] {{Annotation} [ ]}
      String -> Type -> Element
def String
"Dims" (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
$ Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Annotation",

--TypeParameter:
--  {TypeParameterModifier} TypeIdentifier [TypeBound]
      String -> Type -> Element
def String
"TypeParameter" (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
java String
"TypeParameterModifier",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"TypeIdentifier",
        String
"bound"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeBound"],

--TypeParameterModifier:
--  Annotation
      String -> Type -> Element
def String
"TypeParameterModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Annotation",

--TypeBound:
      String -> Type -> Element
def String
"TypeBound" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  extends TypeVariable
        String
"variable"String -> Type -> FieldType
>: String -> Type
java String
"TypeVariable",
--  extends ClassOrInterfaceType {AdditionalBound}
        String
"classOrInterface"String -> Type -> FieldType
>: String -> Type
java String
"TypeBound.ClassOrInterface"],
      String -> Type -> Element
def String
"TypeBound.ClassOrInterface" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
java String
"ClassOrInterfaceType",
        String
"additional"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"AdditionalBound"],

--AdditionalBound:
--  & InterfaceType
      String -> Type -> Element
def String
"AdditionalBound" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"InterfaceType",

--TypeArguments:
--  < TypeArgumentList >
--TypeArgumentList:
--  TypeArgument {, TypeArgument}

--TypeArgument:
      String -> Type -> Element
def String
"TypeArgument" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  ReferenceType
        String
"reference"String -> Type -> FieldType
>: String -> Type
java String
"ReferenceType",
--  Wildcard
        String
"wildcard"String -> Type -> FieldType
>: String -> Type
java String
"Wildcard"],

--Wildcard:
--  {Annotation} ? [WildcardBounds]
      String -> Type -> Element
def String
"Wildcard" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"annotations"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Annotation",
        String
"wildcard"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"WildcardBounds"],

--WildcardBounds:
      String -> Type -> Element
def String
"WildcardBounds" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  extends ReferenceType
        String
"extends"String -> Type -> FieldType
>: String -> Type
java String
"ReferenceType",
--  super ReferenceType
        String
"super"String -> Type -> FieldType
>: String -> Type
java String
"ReferenceType"],

--Productions from §6 (Names)

--ModuleName:
      String -> Type -> Element
def String
"ModuleName" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
--  Identifier
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"Identifier",
--  ModuleName . Identifier
        String
"name"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ModuleName"],

--PackageName:
--  Identifier
--  PackageName . Identifier
      String -> Type -> Element
def String
"PackageName" (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
java String
"Identifier",

--TypeName:
      String -> Type -> Element
def String
"TypeName" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
--  TypeIdentifier
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"TypeIdentifier",
--  PackageOrTypeName . TypeIdentifier
        String
"qualifier"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"PackageOrTypeName"],

--ExpressionName:
--  Identifier
--  AmbiguousName . Identifier
      String -> Type -> Element
def String
"ExpressionName" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"qualifier"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"AmbiguousName",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"Identifier"],

--MethodName:
--  Identifier
      String -> Type -> Element
def String
"MethodName" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Identifier",

--PackageOrTypeName:
--  Identifier
--  PackageOrTypeName . Identifier
      String -> Type -> Element
def String
"PackageOrTypeName" (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
java String
"Identifier",

--AmbiguousName:
--  Identifier
--  AmbiguousName . Identifier
      String -> Type -> Element
def String
"AmbiguousName" (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
java String
"Identifier",

--Productions from §7 (Packages and Modules)

--CompilationUnit:
      String -> Type -> Element
def String
"CompilationUnit" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  OrdinaryCompilationUnit
        String
"ordinary"String -> Type -> FieldType
>: String -> Type
java String
"OrdinaryCompilationUnit",
--  ModularCompilationUnit
        String
"modular"String -> Type -> FieldType
>: String -> Type
java String
"ModularCompilationUnit"],

--OrdinaryCompilationUnit:
--  [PackageDeclaration] {ImportDeclaration} {TypeDeclaration}
      String -> Type -> Element
def String
"OrdinaryCompilationUnit" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"package"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"PackageDeclaration",
        String
"imports"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ImportDeclaration",
        String
"types"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeDeclarationWithComments"],

--ModularCompilationUnit:
--  {ImportDeclaration} ModuleDeclaration
      String -> Type -> Element
def String
"ModularCompilationUnit" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"imports"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ImportDeclaration",
        String
"module"String -> Type -> FieldType
>: String -> Type
java String
"ModuleDeclaration"],

--PackageDeclaration:
--  {PackageModifier} package Identifier {. Identifier} ;
      String -> Type -> Element
def String
"PackageDeclaration" (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
java String
"PackageModifier",
        String
"identifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Identifier"],

--PackageModifier:
--  Annotation
      String -> Type -> Element
def String
"PackageModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Annotation",

--ImportDeclaration:
      String -> Type -> Element
def String
"ImportDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  SingleTypeImportDeclaration
        String
"singleType"String -> Type -> FieldType
>: String -> Type
java String
"SingleTypeImportDeclaration",
--  TypeImportOnDemandDeclaration
        String
"typeImportOnDemand"String -> Type -> FieldType
>: String -> Type
java String
"TypeImportOnDemandDeclaration",
--  SingleStaticImportDeclaration
        String
"singleStaticImport"String -> Type -> FieldType
>: String -> Type
java String
"SingleStaticImportDeclaration",
--  StaticImportOnDemandDeclaration
        String
"staticImportOnDemand"String -> Type -> FieldType
>: String -> Type
java String
"StaticImportOnDemandDeclaration"],

--SingleTypeImportDeclaration:
--  import TypeName ;
      String -> Type -> Element
def String
"SingleTypeImportDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeName",

--TypeImportOnDemandDeclaration:
--  import PackageOrTypeName . * ;
      String -> Type -> Element
def String
"TypeImportOnDemandDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"PackageOrTypeName",

--SingleStaticImportDeclaration:
--  import static TypeName . Identifier ;
      String -> Type -> Element
def String
"SingleStaticImportDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"typeName"String -> Type -> FieldType
>: String -> Type
java String
"TypeName",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"Identifier"],

--StaticImportOnDemandDeclaration:
--  import static TypeName . * ;
      String -> Type -> Element
def String
"StaticImportOnDemandDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeName",

--TypeDeclaration:
      String -> Type -> Element
def String
"TypeDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  ClassDeclaration
        String
"class"String -> Type -> FieldType
>: String -> Type
java String
"ClassDeclaration",
--  InterfaceDeclaration
        String
"interface"String -> Type -> FieldType
>: String -> Type
java String
"InterfaceDeclaration",
--  ;
        String
"none"String -> Type -> FieldType
>: Type
unit],
      String -> Type -> Element
def String
"TypeDeclarationWithComments" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"value"String -> Type -> FieldType
>: String -> Type
java String
"TypeDeclaration",
          String
"comments"String -> Type -> FieldType
>: Type -> Type
optional Type
string],

--ModuleDeclaration:
--  {Annotation} [open] module Identifier {. Identifier} { {ModuleDirective} }
      String -> Type -> Element
def String
"ModuleDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"annotations"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Annotation",
        String
"open"String -> Type -> FieldType
>: Type
boolean,
        String
"identifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Identifier",
        String
"directives"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ModuleDirective"],

--ModuleDirective:
      String -> Type -> Element
def String
"ModuleDirective" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  requires {RequiresModifier} ModuleName ;
        String
"requires"String -> Type -> FieldType
>: String -> Type
java String
"ModuleDirective.Requires",
--  exports PackageName [to ModuleName {, ModuleName}] ;
        String
"exports"String -> Type -> FieldType
>: String -> Type
java String
"ModuleDirective.ExportsOrOpens",
--  opens PackageName [to ModuleName {, ModuleName}] ;
        String
"opens"String -> Type -> FieldType
>: String -> Type
java String
"ModuleDirective.ExportsOrOpens",
--  uses TypeName ;
        String
"uses"String -> Type -> FieldType
>: String -> Type
java String
"TypeName",
--  provides TypeName with TypeName {, TypeName} ;
        String
"provides"String -> Type -> FieldType
>: String -> Type
java String
"ModuleDirective.Provides"],
      String -> Type -> Element
def String
"ModuleDirective.Requires" (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
java String
"RequiresModifier",
        String
"module"String -> Type -> FieldType
>: String -> Type
java String
"ModuleName"],
      String -> Type -> Element
def String
"ModuleDirective.ExportsOrOpens" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"package"String -> Type -> FieldType
>: String -> Type
java String
"PackageName",
        String
"modules"String -> Type -> FieldType
>:
          String -> Type -> Type
doc String
"At least one module" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
          Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ModuleName"],
      String -> Type -> Element
def String
"ModuleDirective.Provides" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"to"String -> Type -> FieldType
>: String -> Type
java String
"TypeName",
        String
"with"String -> Type -> FieldType
>:
          String -> Type -> Type
doc String
"At least one type" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
          Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeName"],

--RequiresModifier:
      String -> Type -> Element
def String
"RequiresModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
--  (one of)
--  transitive static
        String
"transitive", String
"static"],

--Productions from §8 (Classes)

--ClassDeclaration:
      String -> Type -> Element
def String
"ClassDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  NormalClassDeclaration
        String
"normal"String -> Type -> FieldType
>: String -> Type
java String
"NormalClassDeclaration",
--  EnumDeclaration
        String
"enum"String -> Type -> FieldType
>: String -> Type
java String
"EnumDeclaration"],

--NormalClassDeclaration:
--  {ClassModifier} class TypeIdentifier [TypeParameters] [Superclass] [Superinterfaces] ClassBody
      String -> Type -> Element
def String
"NormalClassDeclaration" (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
java String
"ClassModifier",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"TypeIdentifier",
        String
"parameters"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeParameter",
        String
"extends"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ClassType",
        String
"implements"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"InterfaceType",
        String
"body"String -> Type -> FieldType
>: String -> Type
java String
"ClassBody"],

--ClassModifier:
      String -> Type -> Element
def String
"ClassModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  (one of)
--  Annotation public protected private
--  abstract static final strictfp
        String
"annotation"String -> Type -> FieldType
>: String -> Type
java String
"Annotation",
        String
"public"String -> Type -> FieldType
>: Type
unit,
        String
"protected"String -> Type -> FieldType
>: Type
unit,
        String
"private"String -> Type -> FieldType
>: Type
unit,
        String
"abstract"String -> Type -> FieldType
>: Type
unit,
        String
"static"String -> Type -> FieldType
>: Type
unit,
        String
"final"String -> Type -> FieldType
>: Type
unit,
        String
"strictfp"String -> Type -> FieldType
>: Type
unit],

--TypeParameters:
--  < TypeParameterList >
--TypeParameterList:
--  TypeParameter {, TypeParameter}
--Superclass:
--  extends ClassType
--Superinterfaces:
--  implements InterfaceTypeList
--InterfaceTypeList:
--  InterfaceType {, InterfaceType}

--ClassBody:
--  { {ClassBodyDeclaration} }
      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
java String
"ClassBodyDeclarationWithComments",

--ClassBodyDeclaration:
      String -> Type -> Element
def String
"ClassBodyDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  ClassMemberDeclaration
        String
"classMember"String -> Type -> FieldType
>: String -> Type
java String
"ClassMemberDeclaration",
--  InstanceInitializer
        String
"instanceInitializer"String -> Type -> FieldType
>: String -> Type
java String
"InstanceInitializer",
--  StaticInitializer
        String
"staticInitializer"String -> Type -> FieldType
>: String -> Type
java String
"StaticInitializer",
--  ConstructorDeclaration
        String
"constructorDeclaration"String -> Type -> FieldType
>: String -> Type
java String
"ConstructorDeclaration"],
      String -> Type -> Element
def String
"ClassBodyDeclarationWithComments" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"value"String -> Type -> FieldType
>: String -> Type
java String
"ClassBodyDeclaration",
          String
"comments"String -> Type -> FieldType
>: Type -> Type
optional Type
string],

--ClassMemberDeclaration:
      String -> Type -> Element
def String
"ClassMemberDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  FieldDeclaration
        String
"field"String -> Type -> FieldType
>: String -> Type
java String
"FieldDeclaration",
--  MethodDeclaration
        String
"method"String -> Type -> FieldType
>: String -> Type
java String
"MethodDeclaration",
--  ClassDeclaration
        String
"class"String -> Type -> FieldType
>: String -> Type
java String
"ClassDeclaration",
--  InterfaceDeclaration
        String
"interface"String -> Type -> FieldType
>: String -> Type
java String
"InterfaceDeclaration",
--  ;
        String
"none"String -> Type -> FieldType
>: Type
unit],

--FieldDeclaration:
--  {FieldModifier} UnannType VariableDeclaratorList ;
      String -> Type -> Element
def String
"FieldDeclaration" (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
java String
"FieldModifier",
        String
"unannType"String -> Type -> FieldType
>: String -> Type
java String
"UnannType",
        String
"variableDeclarators"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"VariableDeclarator"],

--FieldModifier:
--  (one of)
      String -> Type -> Element
def String
"FieldModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  Annotation public protected private
--  static final transient volatile
        String
"annotation"String -> Type -> FieldType
>: String -> Type
java String
"Annotation",
        String
"public"String -> Type -> FieldType
>: Type
unit,
        String
"protected"String -> Type -> FieldType
>: Type
unit,
        String
"private"String -> Type -> FieldType
>: Type
unit,
        String
"static"String -> Type -> FieldType
>: Type
unit,
        String
"final"String -> Type -> FieldType
>: Type
unit,
        String
"transient"String -> Type -> FieldType
>: Type
unit,
        String
"volatile"String -> Type -> FieldType
>: Type
unit],

--VariableDeclaratorList:
--  VariableDeclarator {, VariableDeclarator}
--VariableDeclarator:
--  VariableDeclaratorId [= VariableInitializer]
      String -> Type -> Element
def String
"VariableDeclarator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"id"String -> Type -> FieldType
>: String -> Type
java String
"VariableDeclaratorId",
        String
"initializer"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"VariableInitializer"],

--VariableDeclaratorId:
--  Identifier [Dims]
      String -> Type -> Element
def String
"VariableDeclaratorId" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"Identifier",
        String
"dims"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Dims"],

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

--UnannType:
--  UnannPrimitiveType
--  UnannReferenceType
      String -> Type -> Element
def String
"UnannType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A Type which does not allow annotations" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        String -> Type
java String
"Type",
--UnannPrimitiveType:
--  NumericType
--  boolean
--UnannReferenceType:
--  UnannClassOrInterfaceType
--  UnannTypeVariable
--  UnannArrayType
--UnannClassOrInterfaceType:
--  UnannClassType
--  UnannInterfaceType
--UnannClassType:
--  TypeIdentifier [TypeArguments]
--  PackageName . {Annotation} TypeIdentifier [TypeArguments]
--  UnannClassOrInterfaceType . {Annotation} TypeIdentifier [TypeArguments]
      String -> Type -> Element
def String
"UnannClassType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A ClassType which does not allow annotations" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        String -> Type
java String
"ClassType",
--UnannInterfaceType:
--  UnannClassType
--UnannTypeVariable:
--  TypeIdentifier
--UnannArrayType:
--  UnannPrimitiveType Dims
--  UnannClassOrInterfaceType Dims
--  UnannTypeVariable Dims

--MethodDeclaration:
--  {MethodModifier} MethodHeader MethodBody
      String -> Type -> Element
def String
"MethodDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"annotations"String -> Type -> FieldType
>:
          String -> Type -> Type
doc String
"Note: simple methods cannot have annotations" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
          Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Annotation",
        String
"modifiers"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"MethodModifier",
        String
"header"String -> Type -> FieldType
>: String -> Type
java String
"MethodHeader",
        String
"body"String -> Type -> FieldType
>: String -> Type
java String
"MethodBody"],

--MethodModifier:
--  (one of)
      String -> Type -> Element
def String
"MethodModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  Annotation public protected private
--  abstract static final synchronized native strictfp
        String
"annotation"String -> Type -> FieldType
>: String -> Type
java String
"Annotation",
        String
"public"String -> Type -> FieldType
>: Type
unit,
        String
"protected"String -> Type -> FieldType
>: Type
unit,
        String
"private"String -> Type -> FieldType
>: Type
unit,
        String
"abstract"String -> Type -> FieldType
>: Type
unit,
        String
"static"String -> Type -> FieldType
>: Type
unit,
        String
"final"String -> Type -> FieldType
>: Type
unit,
        String
"synchronized"String -> Type -> FieldType
>: Type
unit,
        String
"native"String -> Type -> FieldType
>: Type
unit,
        String
"strictfb"String -> Type -> FieldType
>: Type
unit],

--MethodHeader:
--  Result MethodDeclarator [Throws]
--  TypeParameters {Annotation} Result MethodDeclarator [Throws]
      String -> Type -> Element
def String
"MethodHeader" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"parameters"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeParameter",
        String
"result"String -> Type -> FieldType
>: String -> Type
java String
"Result",
        String
"declarator"String -> Type -> FieldType
>: String -> Type
java String
"MethodDeclarator",
        String
"throws"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Throws"],

--Result:
      String -> Type -> Element
def String
"Result" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  UnannType
        String
"type"String -> Type -> FieldType
>: String -> Type
java String
"UnannType",
--  void
        String
"void"String -> Type -> FieldType
>: Type
unit],

--MethodDeclarator:
--  Identifier ( [ReceiverParameter ,] [FormalParameterList] ) [Dims]
      String -> Type -> Element
def String
"MethodDeclarator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"Identifier",
        String
"receiverParameter"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ReceiverParameter",
        String
"formalParameters"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"FormalParameter"],

--ReceiverParameter:
--  {Annotation} UnannType [Identifier .] this
      String -> Type -> Element
def String
"ReceiverParameter" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"annotations"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Annotation",
        String
"unannType"String -> Type -> FieldType
>: String -> Type
java String
"UnannType",
        String
"identifier"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Identifier"],

--FormalParameterList:
--  FormalParameter {, FormalParameter}
--FormalParameter:
      String -> Type -> Element
def String
"FormalParameter" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  {VariableModifier} UnannType VariableDeclaratorId
        String
"simple"String -> Type -> FieldType
>: String -> Type
java String
"FormalParameter.Simple",
--  VariableArityParameter
        String
"variableArity"String -> Type -> FieldType
>: String -> Type
java String
"VariableArityParameter"],
      String -> Type -> Element
def String
"FormalParameter.Simple" (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
java String
"VariableModifier",
        String
"type"String -> Type -> FieldType
>: String -> Type
java String
"UnannType",
        String
"id"String -> Type -> FieldType
>: String -> Type
java String
"VariableDeclaratorId"],

--VariableArityParameter:
--  {VariableModifier} UnannType {Annotation} ... Identifier
      String -> Type -> Element
def String
"VariableArityParameter" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"modifiers"String -> Type -> FieldType
>: String -> Type
java String
"VariableModifier",
        String
"type"String -> Type -> FieldType
>: String -> Type
java String
"UnannType",
        String
"annotations"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Annotation",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"Identifier"],

--VariableModifier:
      String -> Type -> Element
def String
"VariableModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  Annotation
        String
"annotation"String -> Type -> FieldType
>: String -> Type
java String
"Annotation",
--  final
        String
"final"String -> Type -> FieldType
>: Type
unit],

--Throws:
--  throws ExceptionTypeList
      String -> Type -> Element
def String
"Throws" (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
java String
"ExceptionType",

--ExceptionTypeList:
--  ExceptionType {, ExceptionType}
--ExceptionType:
      String -> Type -> Element
def String
"ExceptionType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  ClassType
        String
"class"String -> Type -> FieldType
>: String -> Type
java String
"ClassType",
--  TypeVariable
        String
"variable"String -> Type -> FieldType
>: String -> Type
java String
"TypeVariable"],

--MethodBody:
      String -> Type -> Element
def String
"MethodBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  Block
        String
"block"String -> Type -> FieldType
>: String -> Type
java String
"Block",
--  ;
        String
"none"String -> Type -> FieldType
>: Type
unit],

--InstanceInitializer:
--  Block
      String -> Type -> Element
def String
"InstanceInitializer" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Block",

--StaticInitializer:
--  static Block
      String -> Type -> Element
def String
"StaticInitializer" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Block",

--ConstructorDeclaration:
--  {ConstructorModifier} ConstructorDeclarator [Throws] ConstructorBody
      String -> Type -> Element
def String
"ConstructorDeclaration" (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
java String
"ConstructorModifier",
        String
"constructor"String -> Type -> FieldType
>: String -> Type
java String
"ConstructorDeclarator",
        String
"throws"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Throws",
        String
"body"String -> Type -> FieldType
>: String -> Type
java String
"ConstructorBody"],

--ConstructorModifier:
--  (one of)
      String -> Type -> Element
def String
"ConstructorModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  Annotation public protected private
        String
"annotation"String -> Type -> FieldType
>: String -> Type
java String
"Annotation",
        String
"public"String -> Type -> FieldType
>: Type
unit,
        String
"protected"String -> Type -> FieldType
>: Type
unit,
        String
"private"String -> Type -> FieldType
>: Type
unit],

--ConstructorDeclarator:
--  [TypeParameters] SimpleTypeName ( [ReceiverParameter ,] [FormalParameterList] )
      String -> Type -> Element
def String
"ConstructorDeclarator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"parameters"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeParameter",
        String
"name"String -> Type -> FieldType
>: String -> Type
java String
"SimpleTypeName",
        String
"receiverParameter"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ReceiverParameter",
        String
"formalParameters"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"FormalParameter"],

--SimpleTypeName:
--  TypeIdentifier
      String -> Type -> Element
def String
"SimpleTypeName" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeIdentifier",

--ConstructorBody:
--  { [ExplicitConstructorInvocation] [BlockStatements] }
      String -> Type -> Element
def String
"ConstructorBody" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"invocation"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ExplicitConstructorInvocation",
        String
"statements"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"BlockStatement"],

--ExplicitConstructorInvocation:
      String -> Type -> Element
def String
"ExplicitConstructorInvocation" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"typeArguments"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeArgument",
        String
"arguments"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Expression",
        String
"variant"String -> Type -> FieldType
>: String -> Type
java String
"ExplicitConstructorInvocation.Variant"],
      String -> Type -> Element
def String
"ExplicitConstructorInvocation.Variant" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  [TypeArguments] this ( [ArgumentList] ) ;
        String
"this"String -> Type -> FieldType
>: Type
unit,
--  [TypeArguments] super ( [ArgumentList] ) ;
--  ExpressionName . [TypeArguments] super ( [ArgumentList] ) ;
        String
"super"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ExpressionName",
--  Primary . [TypeArguments] super ( [ArgumentList] ) ;
        String
"primary"String -> Type -> FieldType
>: String -> Type
java String
"Primary"],

--EnumDeclaration:
--  {ClassModifier} enum TypeIdentifier [Superinterfaces] EnumBody
      String -> Type -> Element
def String
"EnumDeclaration" (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
java String
"ClassModifier",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"TypeIdentifier",
        String
"implements"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"InterfaceType",
        String
"body"String -> Type -> FieldType
>: String -> Type
java String
"EnumBody"],

--EnumBody:
--  { [EnumConstantList] [,] [EnumBodyDeclarations] }
      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
java String
"EnumBody.Element",
      String -> Type -> Element
def String
"EnumBody.Element" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"constants"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"EnumConstant",
        String
"bodyDeclarations"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ClassBodyDeclaration"],

--EnumConstantList:
--  EnumConstant {, EnumConstant}
--EnumConstant:
--  {EnumConstantModifier} Identifier [( [ArgumentList] )] [ClassBody]
      String -> Type -> Element
def String
"EnumConstant" (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
java String
"EnumConstantModifier",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"Identifier",
        String
"arguments"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Expression",
        String
"body"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ClassBody"],

--EnumConstantModifier:
--  Annotation
      String -> Type -> Element
def String
"EnumConstantModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Annotation",

--EnumBodyDeclarations:
--  ; {ClassBodyDeclaration}

--Productions from §9 (Interfaces)

--InterfaceDeclaration:
      String -> Type -> Element
def String
"InterfaceDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  NormalInterfaceDeclaration
        String
"normalInterface"String -> Type -> FieldType
>: String -> Type
java String
"NormalInterfaceDeclaration",
--  AnnotationTypeDeclaration
        String
"annotationType"String -> Type -> FieldType
>: String -> Type
java String
"AnnotationTypeDeclaration"],

--NormalInterfaceDeclaration:
--  {InterfaceModifier} interface TypeIdentifier [TypeParameters] [ExtendsInterfaces] InterfaceBody
      String -> Type -> Element
def String
"NormalInterfaceDeclaration" (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
java String
"InterfaceModifier",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"TypeIdentifier",
        String
"parameters"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeParameter",
        String
"extends"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"InterfaceType",
        String
"body"String -> Type -> FieldType
>: String -> Type
java String
"InterfaceBody"],

--InterfaceModifier:
--  (one of)
      String -> Type -> Element
def String
"InterfaceModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  Annotation public protected private
--  abstract static strictfp
        String
"annotation"String -> Type -> FieldType
>: String -> Type
java String
"Annotation",
        String
"public"String -> Type -> FieldType
>: Type
unit,
        String
"protected"String -> Type -> FieldType
>: Type
unit,
        String
"private"String -> Type -> FieldType
>: Type
unit,
        String
"abstract"String -> Type -> FieldType
>: Type
unit,
        String
"static"String -> Type -> FieldType
>: Type
unit,
        String
"strictfb"String -> Type -> FieldType
>: Type
unit],

--ExtendsInterfaces:
--  extends InterfaceTypeList

--InterfaceBody:
--  { {InterfaceMemberDeclaration} }
      String -> Type -> Element
def String
"InterfaceBody" (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
java String
"InterfaceMemberDeclaration",

--InterfaceMemberDeclaration:
      String -> Type -> Element
def String
"InterfaceMemberDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  ConstantDeclaration
        String
"constant"String -> Type -> FieldType
>: String -> Type
java String
"ConstantDeclaration",
--  InterfaceMethodDeclaration
        String
"interfaceMethod"String -> Type -> FieldType
>: String -> Type
java String
"InterfaceMethodDeclaration",
--  ClassDeclaration
        String
"class"String -> Type -> FieldType
>: String -> Type
java String
"ClassDeclaration",
--  InterfaceDeclaration
        String
"interface"String -> Type -> FieldType
>: String -> Type
java String
"InterfaceDeclaration"],
--  ;

--ConstantDeclaration:
--  {ConstantModifier} UnannType VariableDeclaratorList ;
      String -> Type -> Element
def String
"ConstantDeclaration" (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
java String
"ConstantModifier",
        String
"type"String -> Type -> FieldType
>: String -> Type
java String
"UnannType",
        String
"variables"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"VariableDeclarator"],

--ConstantModifier:
--  (one of)
      String -> Type -> Element
def String
"ConstantModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  Annotation public
--  static final
        String
"annotation"String -> Type -> FieldType
>: String -> Type
java String
"Annotation",
        String
"public"String -> Type -> FieldType
>: Type
unit,
        String
"static"String -> Type -> FieldType
>: Type
unit,
        String
"final"String -> Type -> FieldType
>: Type
unit],

--InterfaceMethodDeclaration:
--  {InterfaceMethodModifier} MethodHeader MethodBody
      String -> Type -> Element
def String
"InterfaceMethodDeclaration" (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
java String
"InterfaceMethodModifier",
        String
"header"String -> Type -> FieldType
>: String -> Type
java String
"MethodHeader",
        String
"body"String -> Type -> FieldType
>: String -> Type
java String
"MethodBody"],

--InterfaceMethodModifier:
--  (one of)
      String -> Type -> Element
def String
"InterfaceMethodModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  Annotation public private
--  abstract default static strictfp
        String
"annotation"String -> Type -> FieldType
>: String -> Type
java String
"Annotation",
        String
"public"String -> Type -> FieldType
>: Type
unit,
        String
"private"String -> Type -> FieldType
>: Type
unit,
        String
"abstract"String -> Type -> FieldType
>: Type
unit,
        String
"default"String -> Type -> FieldType
>: Type
unit,
        String
"static"String -> Type -> FieldType
>: Type
unit,
        String
"strictfp"String -> Type -> FieldType
>: Type
unit],

--AnnotationTypeDeclaration:
--  {InterfaceModifier} @ interface TypeIdentifier AnnotationTypeBody
      String -> Type -> Element
def String
"AnnotationTypeDeclaration" (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
java String
"InterfaceModifier",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"TypeIdentifier",
        String
"body"String -> Type -> FieldType
>: String -> Type
java String
"AnnotationTypeBody"],

--AnnotationTypeBody:
--  { {AnnotationTypeMemberDeclaration} }
      String -> Type -> Element
def String
"AnnotationTypeBody" (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
$ Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"AnnotationTypeMemberDeclaration",

--AnnotationTypeMemberDeclaration:
      String -> Type -> Element
def String
"AnnotationTypeMemberDeclaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  AnnotationTypeElementDeclaration
        String
"annotationType"String -> Type -> FieldType
>: String -> Type
java String
"AnnotationTypeElementDeclaration",
--  ConstantDeclaration
        String
"constant"String -> Type -> FieldType
>: String -> Type
java String
"ConstantDeclaration",
--  ClassDeclaration
        String
"class"String -> Type -> FieldType
>: String -> Type
java String
"ClassDeclaration",
--  InterfaceDeclaration
        String
"interface"String -> Type -> FieldType
>: String -> Type
java String
"InterfaceDeclaration"],
--  ;

--AnnotationTypeElementDeclaration:
--  {AnnotationTypeElementModifier} UnannType Identifier ( ) [Dims] [DefaultValue] ;
      String -> Type -> Element
def String
"AnnotationTypeElementDeclaration" (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
java String
"AnnotationTypeElementModifier",
        String
"type"String -> Type -> FieldType
>: String -> Type
java String
"UnannType",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"Identifier",
        String
"dims"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Dims",
        String
"default"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"DefaultValue"],

--AnnotationTypeElementModifier:
--  (one of)
      String -> Type -> Element
def String
"AnnotationTypeElementModifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  Annotation public
        String
"public"String -> Type -> FieldType
>: String -> Type
java String
"Annotation",
--  abstract
        String
"abstract"String -> Type -> FieldType
>: Type
unit],

--DefaultValue:
--  default ElementValue
      String -> Type -> Element
def String
"DefaultValue" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ElementValue",

--Annotation:
      String -> Type -> Element
def String
"Annotation" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  NormalAnnotation
        String
"normal"String -> Type -> FieldType
>: String -> Type
java String
"NormalAnnotation",
--  MarkerAnnotation
        String
"marker"String -> Type -> FieldType
>: String -> Type
java String
"MarkerAnnotation",
--  SingleElementAnnotation
        String
"singleElement"String -> Type -> FieldType
>: String -> Type
java String
"SingleElementAnnotation"],

--NormalAnnotation:
--  @ TypeName ( [ElementValuePairList] )
      String -> Type -> Element
def String
"NormalAnnotation" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"typeName"String -> Type -> FieldType
>: String -> Type
java String
"TypeName",
        String
"pairs"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ElementValuePair"],

--ElementValuePairList:
--  ElementValuePair {, ElementValuePair}
--ElementValuePair:
--  Identifier = ElementValue
      String -> Type -> Element
def String
"ElementValuePair" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"key"String -> Type -> FieldType
>: String -> Type
java String
"Identifier",
        String
"value"String -> Type -> FieldType
>: String -> Type
java String
"ElementValue"],

--ElementValue:
      String -> Type -> Element
def String
"ElementValue" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  ConditionalExpression
        String
"conditionalExpression"String -> Type -> FieldType
>: String -> Type
java String
"ConditionalExpression",
--  ElementValueArrayInitializer
        String
"elementValueArrayInitializer"String -> Type -> FieldType
>: String -> Type
java String
"ElementValueArrayInitializer",
--  Annotation
        String
"annotation"String -> Type -> FieldType
>: String -> Type
java String
"Annotation"],

--ElementValueArrayInitializer:
--  { [ElementValueList] [,] }
      String -> Type -> Element
def String
"ElementValueArrayInitializer" (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
java String
"ElementValue",
--ElementValueList:
--  ElementValue {, ElementValue}

--MarkerAnnotation:
--  @ TypeName
      String -> Type -> Element
def String
"MarkerAnnotation" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeName",

--SingleElementAnnotation:
      String -> Type -> Element
def String
"SingleElementAnnotation" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
--  @ TypeName ( ElementValue )
        String
"name"String -> Type -> FieldType
>: String -> Type
java String
"TypeName",
        String
"value"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ElementValue"],

--  Productions from §10 (Arrays)

--ArrayInitializer:
--  { [VariableInitializerList] [,] }
      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
$ Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"VariableInitializer",
--VariableInitializerList:
--  VariableInitializer {, VariableInitializer}

--Productions from §14 (Blocks and Statements)

--Block:
--  { [BlockStatements] }
      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
java String
"BlockStatement",

--BlockStatements:
--  BlockStatement {BlockStatement}
--BlockStatement:
      String -> Type -> Element
def String
"BlockStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  LocalVariableDeclarationStatement
        String
"localVariableDeclaration"String -> Type -> FieldType
>: String -> Type
java String
"LocalVariableDeclarationStatement",
--  ClassDeclaration
        String
"class"String -> Type -> FieldType
>: String -> Type
java String
"ClassDeclaration",
--  Statement
        String
"statement"String -> Type -> FieldType
>: String -> Type
java String
"Statement"],

--LocalVariableDeclarationStatement:
--  LocalVariableDeclaration ;
      String -> Type -> Element
def String
"LocalVariableDeclarationStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"LocalVariableDeclaration",

--LocalVariableDeclaration:
--  {VariableModifier} LocalVariableType VariableDeclaratorList
      String -> Type -> Element
def String
"LocalVariableDeclaration" (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
java String
"VariableModifier",
        String
"type"String -> Type -> FieldType
>: String -> Type
java String
"LocalVariableType",
        String
"declarators"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"VariableDeclarator"],

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

--Statement:
      String -> Type -> Element
def String
"Statement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  StatementWithoutTrailingSubstatement
        String
"withoutTrailing"String -> Type -> FieldType
>: String -> Type
java String
"StatementWithoutTrailingSubstatement",
--  LabeledStatement
        String
"labeled"String -> Type -> FieldType
>: String -> Type
java String
"LabeledStatement",
--  IfThenStatement
        String
"ifThen"String -> Type -> FieldType
>: String -> Type
java String
"IfThenStatement",
--  IfThenElseStatement
        String
"ifThenElse"String -> Type -> FieldType
>: String -> Type
java String
"IfThenElseStatement",
--  WhileStatement
        String
"while"String -> Type -> FieldType
>: String -> Type
java String
"WhileStatement",
--  ForStatement
        String
"for"String -> Type -> FieldType
>: String -> Type
java String
"ForStatement"],

--StatementNoShortIf:
      String -> Type -> Element
def String
"StatementNoShortIf" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  StatementWithoutTrailingSubstatement
        String
"withoutTrailing"String -> Type -> FieldType
>: String -> Type
java String
"StatementWithoutTrailingSubstatement",
--  LabeledStatementNoShortIf
        String
"labeled"String -> Type -> FieldType
>: String -> Type
java String
"LabeledStatementNoShortIf",
--  IfThenElseStatementNoShortIf
        String
"ifThenElse"String -> Type -> FieldType
>: String -> Type
java String
"IfThenElseStatementNoShortIf",
--  WhileStatementNoShortIf
        String
"while"String -> Type -> FieldType
>: String -> Type
java String
"WhileStatementNoShortIf",
--  ForStatementNoShortIf
        String
"for"String -> Type -> FieldType
>: String -> Type
java String
"ForStatementNoShortIf"],

--StatementWithoutTrailingSubstatement:
      String -> Type -> Element
def String
"StatementWithoutTrailingSubstatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  Block
        String
"block"String -> Type -> FieldType
>: String -> Type
java String
"Block",
--  EmptyStatement
        String
"empty"String -> Type -> FieldType
>: String -> Type
java String
"EmptyStatement",
--  ExpressionStatement
        String
"expression"String -> Type -> FieldType
>: String -> Type
java String
"ExpressionStatement",
--  AssertStatement
        String
"assert"String -> Type -> FieldType
>: String -> Type
java String
"AssertStatement",
--  SwitchStatement
        String
"switch"String -> Type -> FieldType
>: String -> Type
java String
"SwitchStatement",
--  DoStatement
        String
"do"String -> Type -> FieldType
>: String -> Type
java String
"DoStatement",
--  BreakStatement
        String
"break"String -> Type -> FieldType
>: String -> Type
java String
"BreakStatement",
--  ContinueStatement
        String
"continue"String -> Type -> FieldType
>: String -> Type
java String
"ContinueStatement",
--  ReturnStatement
        String
"return"String -> Type -> FieldType
>: String -> Type
java String
"ReturnStatement",
--  SynchronizedStatement
        String
"synchronized"String -> Type -> FieldType
>: String -> Type
java String
"SynchronizedStatement",
--  ThrowStatement
        String
"throw"String -> Type -> FieldType
>: String -> Type
java String
"ThrowStatement",
--  TryStatement
        String
"try"String -> Type -> FieldType
>: String -> Type
java String
"TryStatement"],

--EmptyStatement:
--  ;
      String -> Type -> Element
def String
"EmptyStatement" Type
unit,

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

--LabeledStatementNoShortIf:
--  Identifier : StatementNoShortIf
      String -> Type -> Element
def String
"LabeledStatementNoShortIf" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"Identifier",
        String
"statement"String -> Type -> FieldType
>: String -> Type
java String
"StatementNoShortIf"],

--ExpressionStatement:
--  StatementExpression ;
      String -> Type -> Element
def String
"ExpressionStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"StatementExpression",

--StatementExpression:
      String -> Type -> Element
def String
"StatementExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  Assignment
        String
"assignment"String -> Type -> FieldType
>: String -> Type
java String
"Assignment",
--  PreIncrementExpression
        String
"preIncrement"String -> Type -> FieldType
>: String -> Type
java String
"PreIncrementExpression",
--  PreDecrementExpression
        String
"preDecrement"String -> Type -> FieldType
>: String -> Type
java String
"PreDecrementExpression",
--  PostIncrementExpression
        String
"postIncrement"String -> Type -> FieldType
>: String -> Type
java String
"PostIncrementExpression",
--  PostDecrementExpression
        String
"postDecrement"String -> Type -> FieldType
>: String -> Type
java String
"PostDecrementExpression",
--  MethodInvocation
        String
"methodInvocation"String -> Type -> FieldType
>: String -> Type
java String
"MethodInvocation",
--  ClassInstanceCreationExpression
        String
"classInstanceCreation"String -> Type -> FieldType
>: String -> Type
java String
"ClassInstanceCreationExpression"],

--IfThenStatement:
--  if ( Expression ) Statement
      String -> Type -> Element
def String
"IfThenStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"expression"String -> Type -> FieldType
>: String -> Type
java String
"Expression",
        String
"statement"String -> Type -> FieldType
>: String -> Type
java String
"Statement"],

--IfThenElseStatement:
--  if ( Expression ) StatementNoShortIf else Statement
      String -> Type -> Element
def String
"IfThenElseStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"cond"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Expression",
        String
"then"String -> Type -> FieldType
>: String -> Type
java String
"StatementNoShortIf",
        String
"else"String -> Type -> FieldType
>: String -> Type
java String
"Statement"],

--IfThenElseStatementNoShortIf:
--  if ( Expression ) StatementNoShortIf else StatementNoShortIf
      String -> Type -> Element
def String
"IfThenElseStatementNoShortIf" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"cond"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Expression",
        String
"then"String -> Type -> FieldType
>: String -> Type
java String
"StatementNoShortIf",
        String
"else"String -> Type -> FieldType
>: String -> Type
java String
"StatementNoShortIf"],

--AssertStatement:
      String -> Type -> Element
def String
"AssertStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  assert Expression ;
        String
"single"String -> Type -> FieldType
>: String -> Type
java String
"Expression",
--  assert Expression : Expression ;
        String
"pair"String -> Type -> FieldType
>: String -> Type
java String
"AssertStatement.Pair"],
      String -> Type -> Element
def String
"AssertStatement.Pair" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"first"String -> Type -> FieldType
>: String -> Type
java String
"Expression",
        String
"second"String -> Type -> FieldType
>: String -> Type
java String
"Expression"],

--SwitchStatement:
--  switch ( Expression ) SwitchBlock
      String -> Type -> Element
def String
"SwitchStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"cond"String -> Type -> FieldType
>: String -> Type
java String
"Expression",
        String
"block"String -> Type -> FieldType
>: String -> Type
java String
"SwitchBlock"],

--SwitchBlock:
--  { {SwitchBlockStatementGroup} {SwitchLabel} }
      String -> Type -> Element
def String
"SwitchBlock" (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
java String
"SwitchBlock.Pair",
      String -> Type -> Element
def String
"SwitchBlock.Pair" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"statements"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"SwitchBlockStatementGroup",
        String
"labels"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"SwitchLabel"],

--SwitchBlockStatementGroup:
--  SwitchLabels BlockStatements
      String -> Type -> Element
def String
"SwitchBlockStatementGroup" (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
java String
"SwitchLabel",
        String
"statements"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"BlockStatement"],

--SwitchLabels:
--  SwitchLabel {SwitchLabel}
--SwitchLabel:
      String -> Type -> Element
def String
"SwitchLabel" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  case ConstantExpression :
        String
"constant"String -> Type -> FieldType
>: String -> Type
java String
"ConstantExpression",
--  case EnumConstantName :
        String
"enumConstant"String -> Type -> FieldType
>: String -> Type
java String
"EnumConstantName",
--  default :
        String
"default"String -> Type -> FieldType
>: Type
unit],

--EnumConstantName:
--  Identifier
      String -> Type -> Element
def String
"EnumConstantName" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Identifier",

--WhileStatement:
--  while ( Expression ) Statement
      String -> Type -> Element
def String
"WhileStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"cond"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Expression",
        String
"body"String -> Type -> FieldType
>: String -> Type
java String
"Statement"],

--WhileStatementNoShortIf:
--  while ( Expression ) StatementNoShortIf
      String -> Type -> Element
def String
"WhileStatementNoShortIf" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"cond"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Expression",
        String
"body"String -> Type -> FieldType
>: String -> Type
java String
"StatementNoShortIf"],

--DoStatement:
--  do Statement while ( 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
java String
"Statement",
        String
"conde"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Expression"],

--ForStatement:
      String -> Type -> Element
def String
"ForStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  BasicForStatement
        String
"basic"String -> Type -> FieldType
>: String -> Type
java String
"BasicForStatement",
--  EnhancedForStatement
        String
"enhanced"String -> Type -> FieldType
>: String -> Type
java String
"EnhancedForStatement"],

--ForStatementNoShortIf:
      String -> Type -> Element
def String
"ForStatementNoShortIf" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  BasicForStatementNoShortIf
        String
"basic"String -> Type -> FieldType
>: String -> Type
java String
"BasicForStatementNoShortIf",
--  EnhancedForStatementNoShortIf
        String
"enhanced"String -> Type -> FieldType
>: String -> Type
java String
"EnhancedForStatementNoShortIf"],

--BasicForStatement:
--  for ( [ForInit] ; [Expression] ; [ForUpdate] ) Statement
      String -> Type -> Element
def String
"BasicForStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"cond"String -> Type -> FieldType
>: String -> Type
java String
"ForCond",
        String
"body"String -> Type -> FieldType
>: String -> Type
java String
"Statement"],
      String -> Type -> Element
def String
"ForCond" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"init"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ForInit",
        String
"cond"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Expression",
        String
"update"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ForUpdate"],
--BasicForStatementNoShortIf:
--  for ( [ForInit] ; [Expression] ; [ForUpdate] ) StatementNoShortIf
      String -> Type -> Element
def String
"BasicForStatementNoShortIf" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"cond"String -> Type -> FieldType
>: String -> Type
java String
"ForCond",
        String
"body"String -> Type -> FieldType
>: String -> Type
java String
"StatementNoShortIf"],

--ForInit:
      String -> Type -> Element
def String
"ForInit" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  StatementExpressionList
        String
"statements"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"StatementExpression",
--  LocalVariableDeclaration
        String
"localVariable"String -> Type -> FieldType
>: String -> Type
java String
"LocalVariableDeclaration"],

--ForUpdate:
--  StatementExpressionList
      String -> Type -> Element
def String
"ForUpdate" (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
java String
"StatementExpression",
--  StatementExpressionList:
--  StatementExpression {, StatementExpression}

--EnhancedForStatement:
      String -> Type -> Element
def String
"EnhancedForStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
--  for ( {VariableModifier} LocalVariableType VariableDeclaratorId : Expression ) Statement
        String
"cond"String -> Type -> FieldType
>: String -> Type
java String
"EnhancedForCond",
        String
"body"String -> Type -> FieldType
>: String -> Type
java String
"Statement"],
      String -> Type -> Element
def String
"EnhancedForCond" (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
java String
"VariableModifier",
        String
"type"String -> Type -> FieldType
>: String -> Type
java String
"LocalVariableType",
        String
"id"String -> Type -> FieldType
>: String -> Type
java String
"VariableDeclaratorId",
        String
"expression"String -> Type -> FieldType
>: String -> Type
java String
"Expression"],
--EnhancedForStatementNoShortIf:
--  for ( {VariableModifier} LocalVariableType VariableDeclaratorId : Expression ) StatementNoShortIf
      String -> Type -> Element
def String
"EnhancedForStatementNoShortIf" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"cond"String -> Type -> FieldType
>: String -> Type
java String
"EnhancedForCond",
        String
"body"String -> Type -> FieldType
>: String -> Type
java String
"StatementNoShortIf"],

--BreakStatement:
--  break [Identifier] ;
      String -> Type -> Element
def String
"BreakStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Identifier",

--ContinueStatement:
--  continue [Identifier] ;
      String -> Type -> Element
def String
"ContinueStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Identifier",

--ReturnStatement:
--  return [Expression] ;
      String -> Type -> Element
def String
"ReturnStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Expression",

--ThrowStatement:
--  throw Expression ;
      String -> Type -> Element
def String
"ThrowStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Expression",

--SynchronizedStatement:
--  synchronized ( Expression ) Block
      String -> Type -> Element
def String
"SynchronizedStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"expression"String -> Type -> FieldType
>: String -> Type
java String
"Expression",
        String
"block"String -> Type -> FieldType
>: String -> Type
java String
"Block"],

--TryStatement:
      String -> Type -> Element
def String
"TryStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  try Block Catches
        String
"simple"String -> Type -> FieldType
>: String -> Type
java String
"TryStatement.Simple",
--  try Block [Catches] Finally
        String
"withFinally"String -> Type -> FieldType
>: String -> Type
java String
"TryStatement.WithFinally",
--  TryWithResourcesStatement
        String
"withResources"String -> Type -> FieldType
>: String -> Type
java String
"TryWithResourcesStatement"],
      String -> Type -> Element
def String
"TryStatement.Simple" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"block"String -> Type -> FieldType
>: String -> Type
java String
"Block",
        String
"catches"String -> Type -> FieldType
>: String -> Type
java String
"Catches"],
      String -> Type -> Element
def String
"TryStatement.WithFinally" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"block"String -> Type -> FieldType
>: String -> Type
java String
"Block",
        String
"catches"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Catches",
        String
"finally"String -> Type -> FieldType
>: String -> Type
java String
"Finally"],

--Catches:
--  CatchClause {CatchClause}
      String -> Type -> Element
def String
"Catches" (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
java String
"CatchClause",

--CatchClause:
--  catch ( CatchFormalParameter ) Block
      String -> Type -> Element
def String
"CatchClause" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"parameter"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"CatchFormalParameter",
        String
"block"String -> Type -> FieldType
>: String -> Type
java String
"Block"],

--CatchFormalParameter:
--  {VariableModifier} CatchType VariableDeclaratorId
      String -> Type -> Element
def String
"CatchFormalParameter" (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
java String
"VariableModifier",
        String
"type"String -> Type -> FieldType
>: String -> Type
java String
"CatchType",
        String
"id"String -> Type -> FieldType
>: String -> Type
java String
"VariableDeclaratorId"],

--CatchType:
--  UnannClassType {| ClassType}
      String -> Type -> Element
def String
"CatchType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
java String
"UnannClassType",
        String
"types"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ClassType"],

--Finally:
--  finally Block
      String -> Type -> Element
def String
"Finally" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Block",

--TryWithResourcesStatement:
--  try ResourceSpecification Block [Catches] [Finally]
      String -> Type -> Element
def String
"TryWithResourcesStatement" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"resourceSpecification"String -> Type -> FieldType
>: String -> Type
java String
"ResourceSpecification",
        String
"block"String -> Type -> FieldType
>: String -> Type
java String
"Block",
        String
"catches"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Catches",
        String
"finally"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Finally"],

--ResourceSpecification:
--  ( ResourceList [;] )
      String -> Type -> Element
def String
"ResourceSpecification" (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
java String
"Resource",

--ResourceList:
--  Resource {; Resource}
--Resource:
      String -> Type -> Element
def String
"Resource" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  {VariableModifier} LocalVariableType Identifier = Expression
        String
"local"String -> Type -> FieldType
>: String -> Type
java String
"Resource.Local",
--  VariableAccess
        String
"variable"String -> Type -> FieldType
>: String -> Type
java String
"VariableAccess"],
      String -> Type -> Element
def String
"Resource.Local" (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
java String
"VariableModifier",
        String
"type"String -> Type -> FieldType
>: String -> Type
java String
"LocalVariableType",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"Identifier",
        String
"expression"String -> Type -> FieldType
>: String -> Type
java String
"Expression"],

--VariableAccess:
      String -> Type -> Element
def String
"VariableAccess" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  ExpressionName
        String
"expressionName"String -> Type -> FieldType
>: String -> Type
java String
"ExpressionName",
--  FieldAccess
        String
"fieldAccess"String -> Type -> FieldType
>: String -> Type
java String
"FieldAccess"],

--Productions from §15 (Expressions)

--Primary:
      String -> Type -> Element
def String
"Primary" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  PrimaryNoNewArray
        String
"noNewArray"String -> Type -> FieldType
>: String -> Type
java String
"PrimaryNoNewArray",
--  ArrayCreationExpression
        String
"arrayCreation"String -> Type -> FieldType
>: String -> Type
java String
"ArrayCreationExpression"],

--PrimaryNoNewArray:
      String -> Type -> Element
def String
"PrimaryNoNewArray" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  Literal
        String
"literal"String -> Type -> FieldType
>: String -> Type
java String
"Literal",
--  ClassLiteral
        String
"classLiteral"String -> Type -> FieldType
>: String -> Type
java String
"ClassLiteral",
--  this
        String
"this"String -> Type -> FieldType
>: Type
unit,
--  TypeName . this
        String
"dotThis"String -> Type -> FieldType
>: String -> Type
java String
"TypeName",
--  ( Expression )
        String
"parens"String -> Type -> FieldType
>: String -> Type
java String
"Expression",
--  ClassInstanceCreationExpression
        String
"classInstance"String -> Type -> FieldType
>: String -> Type
java String
"ClassInstanceCreationExpression",
--  FieldAccess
        String
"fieldAccess"String -> Type -> FieldType
>: String -> Type
java String
"FieldAccess",
--  ArrayAccess
        String
"arrayAccess"String -> Type -> FieldType
>: String -> Type
java String
"ArrayAccess",
--  MethodInvocation
        String
"methodInvocation"String -> Type -> FieldType
>: String -> Type
java String
"MethodInvocation",
--  MethodReference
        String
"methodReference"String -> Type -> FieldType
>: String -> Type
java String
"MethodReference"],

--ClassLiteral:
      String -> Type -> Element
def String
"ClassLiteral" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  TypeName {[ ]} . class
        String
"type"String -> Type -> FieldType
>: String -> Type
java String
"TypeNameArray",
--  NumericType {[ ]} . class
        String
"numericType"String -> Type -> FieldType
>: String -> Type
java String
"NumericTypeArray",
--  boolean {[ ]} . class
        String
"boolean"String -> Type -> FieldType
>: String -> Type
java String
"BooleanArray",
--  void . class
        String
"void"String -> Type -> FieldType
>: Type
unit],
      String -> Type -> Element
def String
"TypeNameArray" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"simple"String -> Type -> FieldType
>: String -> Type
java String
"TypeName",
        String
"array"String -> Type -> FieldType
>: String -> Type
java String
"TypeNameArray"],
      String -> Type -> Element
def String
"NumericTypeArray" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"simple"String -> Type -> FieldType
>: String -> Type
java String
"NumericType",
        String
"array"String -> Type -> FieldType
>: String -> Type
java String
"NumericTypeArray"],
      String -> Type -> Element
def String
"BooleanArray" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"simple"String -> Type -> FieldType
>: Type
unit,
        String
"array"String -> Type -> FieldType
>: String -> Type
java String
"BooleanArray"],

--ClassInstanceCreationExpression:
--  UnqualifiedClassInstanceCreationExpression
--  ExpressionName . UnqualifiedClassInstanceCreationExpression
--  Primary . UnqualifiedClassInstanceCreationExpression
      String -> Type -> Element
def String
"ClassInstanceCreationExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"qualifier"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ClassInstanceCreationExpression.Qualifier",
        String
"expression"String -> Type -> FieldType
>: String -> Type
java String
"UnqualifiedClassInstanceCreationExpression"],
      String -> Type -> Element
def String
"ClassInstanceCreationExpression.Qualifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"expression"String -> Type -> FieldType
>: String -> Type
java String
"ExpressionName",
        String
"primary"String -> Type -> FieldType
>: String -> Type
java String
"Primary"],

--UnqualifiedClassInstanceCreationExpression:
--  new [TypeArguments] ClassOrInterfaceTypeToInstantiate ( [ArgumentList] ) [ClassBody]
      String -> Type -> Element
def String
"UnqualifiedClassInstanceCreationExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"typeArguments"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeArgument",
        String
"classOrInterface"String -> Type -> FieldType
>: String -> Type
java String
"ClassOrInterfaceTypeToInstantiate",
        String
"arguments"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Expression",
        String
"body"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ClassBody"],

--ClassOrInterfaceTypeToInstantiate:
--  {Annotation} Identifier {. {Annotation} Identifier} [TypeArgumentsOrDiamond]
      String -> Type -> Element
def String
"ClassOrInterfaceTypeToInstantiate" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"identifiers"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"AnnotatedIdentifier",
        String
"typeArguments"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeArgumentsOrDiamond"],
      String -> Type -> Element
def String
"AnnotatedIdentifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"annotations"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Annotation",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"Identifier"],

--TypeArgumentsOrDiamond:
      String -> Type -> Element
def String
"TypeArgumentsOrDiamond" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  TypeArguments
        String
"arguments"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeArgument",
--  <>
        String
"diamond"String -> Type -> FieldType
>: Type
unit],

--FieldAccess:
      String -> Type -> Element
def String
"FieldAccess" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"qualifier"String -> Type -> FieldType
>: String -> Type
java String
"FieldAccess.Qualifier",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"Identifier"],
      String -> Type -> Element
def String
"FieldAccess.Qualifier" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  Primary . Identifier
        String
"primary"String -> Type -> FieldType
>: String -> Type
java String
"Primary",
--  super . Identifier
        String
"super"String -> Type -> FieldType
>: Type
unit,
--  TypeName . super . Identifier
        String
"typed"String -> Type -> FieldType
>: String -> Type
java String
"TypeName"],

--ArrayAccess:
      String -> Type -> Element
def String
"ArrayAccess" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"expression"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Expression",
        String
"variant"String -> Type -> FieldType
>: String -> Type
java String
"ArrayAccess.Variant"],
      String -> Type -> Element
def String
"ArrayAccess.Variant" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  ExpressionName [ Expression ]
        String
"name"String -> Type -> FieldType
>: String -> Type
java String
"ExpressionName",
--  PrimaryNoNewArray [ Expression ]
        String
"primary"String -> Type -> FieldType
>: String -> Type
java String
"PrimaryNoNewArray"],

--MethodInvocation:
      String -> Type -> Element
def String
"MethodInvocation" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"header"String -> Type -> FieldType
>: String -> Type
java String
"MethodInvocation.Header",
        String
"arguments"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Expression"],
      String -> Type -> Element
def String
"MethodInvocation.Header" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  MethodName ( [ArgumentList] )
        String
"simple"String -> Type -> FieldType
>: String -> Type
java String
"MethodName",
        String
"complex"String -> Type -> FieldType
>: String -> Type
java String
"MethodInvocation.Complex"],
      String -> Type -> Element
def String
"MethodInvocation.Complex" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"variant"String -> Type -> FieldType
>: String -> Type
java String
"MethodInvocation.Variant",
        String
"typeArguments"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeArgument",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"Identifier"],
      String -> Type -> Element
def String
"MethodInvocation.Variant" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  TypeName . [TypeArguments] Identifier ( [ArgumentList] )
        String
"type"String -> Type -> FieldType
>: String -> Type
java String
"TypeName",
--  ExpressionName . [TypeArguments] Identifier ( [ArgumentList] )
        String
"expression"String -> Type -> FieldType
>: String -> Type
java String
"ExpressionName",
--  Primary . [TypeArguments] Identifier ( [ArgumentList] )
        String
"primary"String -> Type -> FieldType
>: String -> Type
java String
"Primary",
--  super . [TypeArguments] Identifier ( [ArgumentList] )
        String
"super"String -> Type -> FieldType
>: Type
unit,
--  TypeName . super . [TypeArguments] Identifier ( [ArgumentList] )
        String
"typeSuper"String -> Type -> FieldType
>: String -> Type
java String
"TypeName"],

--ArgumentList:
--  Expression {, Expression}

--MethodReference:
      String -> Type -> Element
def String
"MethodReference" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  ExpressionName :: [TypeArguments] Identifier
        String
"expression"String -> Type -> FieldType
>: String -> Type
java String
"MethodReference.Expression",
--  Primary :: [TypeArguments] Identifier
        String
"primary"String -> Type -> FieldType
>: String -> Type
java String
"MethodReference.Primary",
--  ReferenceType :: [TypeArguments] Identifier
        String
"referenceType"String -> Type -> FieldType
>: String -> Type
javaString
"MethodReference.ReferenceType",
--  super :: [TypeArguments] Identifier
--  TypeName . super :: [TypeArguments] Identifier
        String
"super"String -> Type -> FieldType
>: String -> Type
java String
"MethodReference.Super",
--  ClassType :: [TypeArguments] new
        String
"new"String -> Type -> FieldType
>: String -> Type
java String
"MethodReference.New",
--  ArrayType :: new
        String
"array"String -> Type -> FieldType
>: String -> Type
java String
"MethodReference.Array"],
      String -> Type -> Element
def String
"MethodReference.Expression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"name"String -> Type -> FieldType
>: String -> Type
java String
"ExpressionName",
        String
"typeArguments"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeArgument",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"Identifier"],
      String -> Type -> Element
def String
"MethodReference.Primary" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"primary"String -> Type -> FieldType
>: String -> Type
java String
"Primary",
        String
"typeArguments"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeArgument",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"Identifier"],
      String -> Type -> Element
def String
"MethodReference.ReferenceType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"referenceType"String -> Type -> FieldType
>: String -> Type
java String
"ReferenceType",
        String
"typeArguments"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeArgument",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"Identifier"],
      String -> Type -> Element
def String
"MethodReference.Super" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"typeArguments"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeArgument",
        String
"identifier"String -> Type -> FieldType
>: String -> Type
java String
"Identifier",
        String
"super"String -> Type -> FieldType
>: Type
boolean],
      String -> Type -> Element
def String
"MethodReference.New" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"classType"String -> Type -> FieldType
>: String -> Type
java String
"ClassType",
        String
"typeArguments"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"TypeArgument"],
      String -> Type -> Element
def String
"MethodReference.Array" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"ArrayType",

--ArrayCreationExpression:
      String -> Type -> Element
def String
"ArrayCreationExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  new PrimitiveType DimExprs [Dims]
        String
"primitive"String -> Type -> FieldType
>: String -> Type
java String
"ArrayCreationExpression.Primitive",
--  new ClassOrInterfaceType DimExprs [Dims]
        String
"classOrInterface"String -> Type -> FieldType
>: String -> Type
java String
"ArrayCreationExpression.ClassOrInterface",
--  new PrimitiveType Dims ArrayInitializer
        String
"primitiveArray"String -> Type -> FieldType
>: String -> Type
java String
"ArrayCreationExpression.PrimitiveArray",
--  new ClassOrInterfaceType Dims ArrayInitializer
        String
"classOrInterfaceArray"String -> Type -> FieldType
>: String -> Type
java String
"ArrayCreationExpression.ClassOrInterfaceArray"],
      String -> Type -> Element
def String
"ArrayCreationExpression.Primitive" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
java String
"PrimitiveTypeWithAnnotations",
        String
"dimExprs"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"DimExpr",
        String
"dims"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Dims"],
      String -> Type -> Element
def String
"ArrayCreationExpression.ClassOrInterface" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
java String
"ClassOrInterfaceType",
        String
"dimExprs"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"DimExpr",
        String
"dims"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Dims"],
      String -> Type -> Element
def String
"ArrayCreationExpression.PrimitiveArray" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
java String
"PrimitiveTypeWithAnnotations",
        String
"dims"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Dims",
        String
"array"String -> Type -> FieldType
>: String -> Type
java String
"ArrayInitializer"],
      String -> Type -> Element
def String
"ArrayCreationExpression.ClassOrInterfaceArray" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
java String
"ClassOrInterfaceType",
        String
"dims"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Dims",
        String
"array"String -> Type -> FieldType
>: String -> Type
java String
"ArrayInitializer"],

--DimExprs:
--  DimExpr {DimExpr}
--DimExpr:
--  {Annotation} [ Expression ]
      String -> Type -> Element
def String
"DimExpr" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"annotations"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Annotation",
        String
"expression"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Expression"],

--Expression:
      String -> Type -> Element
def String
"Expression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  LambdaExpression
        String
"lambda"String -> Type -> FieldType
>: String -> Type
java String
"LambdaExpression",
--  AssignmentExpression
        String
"assignment"String -> Type -> FieldType
>: String -> Type
java String
"AssignmentExpression"],

--LambdaExpression:
--  LambdaParameters -> LambdaBody
      String -> Type -> Element
def String
"LambdaExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"parameters"String -> Type -> FieldType
>: String -> Type
java String
"LambdaParameters",
        String
"body"String -> Type -> FieldType
>: String -> Type
java String
"LambdaBody"],

--LambdaParameters:
--  ( [LambdaParameterList] )
--  Identifier
      String -> Type -> Element
def String
"LambdaParameters" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"tuple"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"LambdaParameters",
        String
"single"String -> Type -> FieldType
>: String -> Type
java String
"Identifier"],

--LambdaParameterList:
--  LambdaParameter {, LambdaParameter}
--  Identifier {, Identifier}
--LambdaParameter:
      String -> Type -> Element
def String
"LambdaParameter" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  {VariableModifier} LambdaParameterType VariableDeclaratorId
        String
"normal"String -> Type -> FieldType
>: String -> Type
java String
"LambdaParameter.Normal",
--  VariableArityParameter
        String
"variableArity"String -> Type -> FieldType
>: String -> Type
java String
"VariableArityParameter"],
      String -> Type -> Element
def String
"LambdaParameter.Normal" (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
java String
"VariableModifier",
        String
"type"String -> Type -> FieldType
>: String -> Type
java String
"LambdaParameterType",
        String
"id"String -> Type -> FieldType
>: String -> Type
java String
"VariableDeclaratorId"],

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

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

--AssignmentExpression:
      String -> Type -> Element
def String
"AssignmentExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  ConditionalExpression
        String
"conditional"String -> Type -> FieldType
>: String -> Type
java String
"ConditionalExpression",
--  Assignment
        String
"assignment"String -> Type -> FieldType
>: String -> Type
java String
"Assignment"],

--Assignment:
--  LeftHandSide AssignmentOperator Expression
      String -> Type -> Element
def String
"Assignment" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"lhs"String -> Type -> FieldType
>: String -> Type
java String
"LeftHandSide",
        String
"op"String -> Type -> FieldType
>: String -> Type
java String
"AssignmentOperator",
        String
"expression"String -> Type -> FieldType
>: String -> Type
java String
"Expression"],

--LeftHandSide:
      String -> Type -> Element
def String
"LeftHandSide" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  ExpressionName
        String
"expressionName"String -> Type -> FieldType
>: String -> Type
java String
"ExpressionName",
--  FieldAccess
        String
"fieldAccess"String -> Type -> FieldType
>: String -> Type
java String
"FieldAccess",
--  ArrayAccess
        String
"arrayAccess"String -> Type -> FieldType
>: String -> Type
java String
"ArrayAccess"],

--AssignmentOperator:
--  (one of)
      String -> Type -> Element
def String
"AssignmentOperator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
--  =  *=  /=  %=  +=  -=  <<=  >>=  >>>=  &=  ^=  |=
        String
"simple", String
"times", String
"div", String
"mod", String
"plus", String
"minus",
        String
"shiftLeft", String
"shiftRight", String
"shiftRightZeroFill", String
"and", String
"xor", String
"or"],

--ConditionalExpression:
      String -> Type -> Element
def String
"ConditionalExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  ConditionalOrExpression
        String
"simple"String -> Type -> FieldType
>: String -> Type
java String
"ConditionalOrExpression",
--  ConditionalOrExpression ? Expression : ConditionalExpression
        String
"ternaryCond"String -> Type -> FieldType
>: String -> Type
java String
"ConditionalExpression.TernaryCond",
--  ConditionalOrExpression ? Expression : LambdaExpression
        String
"ternaryLambda"String -> Type -> FieldType
>: String -> Type
java String
"ConditionalExpression.TernaryLambda"],
      String -> Type -> Element
def String
"ConditionalExpression.TernaryCond" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"cond"String -> Type -> FieldType
>: String -> Type
java String
"ConditionalOrExpression",
        String
"ifTrue"String -> Type -> FieldType
>: String -> Type
java String
"Expression",
        String
"ifFalse"String -> Type -> FieldType
>: String -> Type
java String
"ConditionalExpression"],
      String -> Type -> Element
def String
"ConditionalExpression.TernaryLambda" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"cond"String -> Type -> FieldType
>: String -> Type
java String
"ConditionalOrExpression",
        String
"ifTrue"String -> Type -> FieldType
>: String -> Type
java String
"Expression",
        String
"ifFalse"String -> Type -> FieldType
>: String -> Type
java String
"LambdaExpression"],

--ConditionalOrExpression:
--  ConditionalAndExpression
--  ConditionalOrExpression || ConditionalAndExpression
      String -> Type -> Element
def String
"ConditionalOrExpression" (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
java String
"ConditionalAndExpression",

--ConditionalAndExpression:
--  InclusiveOrExpression
--  ConditionalAndExpression && InclusiveOrExpression
      String -> Type -> Element
def String
"ConditionalAndExpression" (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
java String
"InclusiveOrExpression",

--InclusiveOrExpression:
--  ExclusiveOrExpression
--  InclusiveOrExpression | ExclusiveOrExpression
      String -> Type -> Element
def String
"InclusiveOrExpression" (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
java String
"ExclusiveOrExpression",

--ExclusiveOrExpression:
--  AndExpression
--  ExclusiveOrExpression ^ AndExpression
      String -> Type -> Element
def String
"ExclusiveOrExpression" (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
java String
"AndExpression",

--AndExpression:
--  EqualityExpression
--  AndExpression & EqualityExpression
      String -> Type -> Element
def String
"AndExpression" (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
java String
"EqualityExpression",

--EqualityExpression:
      String -> Type -> Element
def String
"EqualityExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  RelationalExpression
        String
"unary"String -> Type -> FieldType
>: String -> Type
java String
"RelationalExpression",
--  EqualityExpression == RelationalExpression
        String
"equal"String -> Type -> FieldType
>: String -> Type
java String
"EqualityExpression.Binary",
--  EqualityExpression != RelationalExpression
        String
"notEqual"String -> Type -> FieldType
>: String -> Type
java String
"EqualityExpression.Binary"],
      String -> Type -> Element
def String
"EqualityExpression.Binary" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"lhs"String -> Type -> FieldType
>: String -> Type
java String
"EqualityExpression",
        String
"rhs"String -> Type -> FieldType
>: String -> Type
java String
"RelationalExpression"],

--RelationalExpression:
      String -> Type -> Element
def String
"RelationalExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  ShiftExpression
        String
"simple"String -> Type -> FieldType
>: String -> Type
java String
"ShiftExpression",
--  RelationalExpression < ShiftExpression
        String
"lessThan"String -> Type -> FieldType
>: String -> Type
java String
"RelationalExpression.LessThan",
--  RelationalExpression > ShiftExpression
        String
"greaterThan"String -> Type -> FieldType
>: String -> Type
java String
"RelationalExpression.GreaterThan",
--  RelationalExpression <= ShiftExpression
        String
"lessThanEqual"String -> Type -> FieldType
>: String -> Type
java String
"RelationalExpression.LessThanEqual",
--  RelationalExpression >= ShiftExpression
        String
"greaterThanEqual"String -> Type -> FieldType
>: String -> Type
java String
"RelationalExpression.GreaterThanEqual",
--  RelationalExpression instanceof ReferenceType
        String
"instanceof"String -> Type -> FieldType
>: String -> Type
java String
"RelationalExpression.InstanceOf"],
      String -> Type -> Element
def String
"RelationalExpression.LessThan" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"lhs"String -> Type -> FieldType
>: String -> Type
java String
"RelationalExpression",
        String
"rhs"String -> Type -> FieldType
>: String -> Type
java String
"ShiftExpression"],
      String -> Type -> Element
def String
"RelationalExpression.GreaterThan" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"lhs"String -> Type -> FieldType
>: String -> Type
java String
"RelationalExpression",
        String
"rhs"String -> Type -> FieldType
>: String -> Type
java String
"ShiftExpression"],
      String -> Type -> Element
def String
"RelationalExpression.LessThanEqual" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"lhs"String -> Type -> FieldType
>: String -> Type
java String
"RelationalExpression",
        String
"rhs"String -> Type -> FieldType
>: String -> Type
java String
"ShiftExpression"],
      String -> Type -> Element
def String
"RelationalExpression.GreaterThanEqual" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"lhs"String -> Type -> FieldType
>: String -> Type
java String
"RelationalExpression",
        String
"rhs"String -> Type -> FieldType
>: String -> Type
java String
"ShiftExpression"],
      String -> Type -> Element
def String
"RelationalExpression.InstanceOf" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"lhs"String -> Type -> FieldType
>: String -> Type
java String
"RelationalExpression",
        String
"rhs"String -> Type -> FieldType
>: String -> Type
java String
"ReferenceType"],

--ShiftExpression:
      String -> Type -> Element
def String
"ShiftExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  AdditiveExpression
        String
"unary"String -> Type -> FieldType
>: String -> Type
java String
"AdditiveExpression",
--  ShiftExpression << AdditiveExpression
        String
"shiftLeft"String -> Type -> FieldType
>: String -> Type
java String
"ShiftExpression.Binary",
--  ShiftExpression >> AdditiveExpression
        String
"shiftRight"String -> Type -> FieldType
>: String -> Type
java String
"ShiftExpression.Binary",
--  ShiftExpression >>> AdditiveExpression
        String
"shiftRightZeroFill"String -> Type -> FieldType
>: String -> Type
java String
"ShiftExpression.Binary"],
      String -> Type -> Element
def String
"ShiftExpression.Binary" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"lhs"String -> Type -> FieldType
>: String -> Type
java String
"ShiftExpression",
        String
"rhs"String -> Type -> FieldType
>: String -> Type
java String
"AdditiveExpression"],

--AdditiveExpression:
      String -> Type -> Element
def String
"AdditiveExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  MultiplicativeExpression
        String
"unary"String -> Type -> FieldType
>: String -> Type
java String
"MultiplicativeExpression",
--  AdditiveExpression + MultiplicativeExpression
        String
"plus"String -> Type -> FieldType
>: String -> Type
java String
"AdditiveExpression.Binary",
--  AdditiveExpression - MultiplicativeExpression
        String
"minus"String -> Type -> FieldType
>: String -> Type
java String
"AdditiveExpression.Binary"],
      String -> Type -> Element
def String
"AdditiveExpression.Binary" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"lhs"String -> Type -> FieldType
>: String -> Type
java String
"AdditiveExpression",
        String
"rhs"String -> Type -> FieldType
>: String -> Type
java String
"MultiplicativeExpression"],

--MultiplicativeExpression:
      String -> Type -> Element
def String
"MultiplicativeExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  UnaryExpression
        String
"unary"String -> Type -> FieldType
>: String -> Type
java String
"UnaryExpression",
--  MultiplicativeExpression * UnaryExpression
        String
"times"String -> Type -> FieldType
>: String -> Type
java String
"MultiplicativeExpression.Binary",
--  MultiplicativeExpression / UnaryExpression
        String
"divide"String -> Type -> FieldType
>: String -> Type
java String
"MultiplicativeExpression.Binary",
--  MultiplicativeExpression % UnaryExpression
        String
"mod"String -> Type -> FieldType
>: String -> Type
java String
"MultiplicativeExpression.Binary"],
      String -> Type -> Element
def String
"MultiplicativeExpression.Binary" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"lhs"String -> Type -> FieldType
>: String -> Type
java String
"MultiplicativeExpression",
        String
"rhs"String -> Type -> FieldType
>: String -> Type
java String
"UnaryExpression"],

--UnaryExpression:
      String -> Type -> Element
def String
"UnaryExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  PreIncrementExpression
        String
"preIncrement"String -> Type -> FieldType
>: String -> Type
java String
"PreIncrementExpression",
--  PreDecrementExpression
        String
"preDecrement"String -> Type -> FieldType
>: String -> Type
java String
"PreDecrementExpression",
--  + UnaryExpression
        String
"plus"String -> Type -> FieldType
>: String -> Type
java String
"UnaryExpression",
--  - UnaryExpression
        String
"minus"String -> Type -> FieldType
>: String -> Type
java String
"UnaryExpression",
--  UnaryExpressionNotPlusMinus
        String
"other"String -> Type -> FieldType
>: String -> Type
java String
"UnaryExpressionNotPlusMinus"],

--PreIncrementExpression:
--  ++ UnaryExpression
      String -> Type -> Element
def String
"PreIncrementExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"UnaryExpression",

--PreDecrementExpression:
--  -- UnaryExpression
      String -> Type -> Element
def String
"PreDecrementExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"UnaryExpression",

--UnaryExpressionNotPlusMinus:
      String -> Type -> Element
def String
"UnaryExpressionNotPlusMinus" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  PostfixExpression
        String
"postfix"String -> Type -> FieldType
>: String -> Type
java String
"PostfixExpression",
--  ~ UnaryExpression
        String
"tilde"String -> Type -> FieldType
>: String -> Type
java String
"UnaryExpression",
--  ! UnaryExpression
        String
"not"String -> Type -> FieldType
>: String -> Type
java String
"UnaryExpression",
--  CastExpression
        String
"cast"String -> Type -> FieldType
>: String -> Type
java String
"CastExpression"],

--PostfixExpression:
      String -> Type -> Element
def String
"PostfixExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  Primary
        String
"primary"String -> Type -> FieldType
>: String -> Type
java String
"Primary",
--  ExpressionName
        String
"name"String -> Type -> FieldType
>: String -> Type
java String
"ExpressionName",
--  PostIncrementExpression
        String
"postIncrement"String -> Type -> FieldType
>: String -> Type
java String
"PostIncrementExpression",
--  PostDecrementExpression
        String
"postDecrement"String -> Type -> FieldType
>: String -> Type
java String
"PostDecrementExpression"],

--PostIncrementExpression:
--  PostfixExpression ++
      String -> Type -> Element
def String
"PostIncrementExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"PostfixExpression",

--PostDecrementExpression:
--  PostfixExpression --
      String -> Type -> Element
def String
"PostDecrementExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"PostfixExpression",

--CastExpression:
      String -> Type -> Element
def String
"CastExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
--  ( PrimitiveType ) UnaryExpression
        String
"primitive"String -> Type -> FieldType
>: String -> Type
java String
"CastExpression.Primitive",
--  ( ReferenceType {AdditionalBound} ) UnaryExpressionNotPlusMinus
        String
"notPlusMinus"String -> Type -> FieldType
>: String -> Type
java String
"CastExpression.NotPlusMinus",
--  ( ReferenceType {AdditionalBound} ) LambdaExpression
        String
"lambda"String -> Type -> FieldType
>: String -> Type
java String
"CastExpression.Lambda"],
      String -> Type -> Element
def String
"CastExpression.Primitive" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
java String
"PrimitiveTypeWithAnnotations",
        String
"expression"String -> Type -> FieldType
>: String -> Type
java String
"UnaryExpression"],
      String -> Type -> Element
def String
"CastExpression.NotPlusMinus" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"refAndBounds"String -> Type -> FieldType
>: String -> Type
java String
"CastExpression.RefAndBounds",
        String
"expression"String -> Type -> FieldType
>: String -> Type
java String
"UnaryExpression"],
      String -> Type -> Element
def String
"CastExpression.Lambda" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"refAndBounds"String -> Type -> FieldType
>: String -> Type
java String
"CastExpression.RefAndBounds",
        String
"expression"String -> Type -> FieldType
>: String -> Type
java String
"LambdaExpression"],
      String -> Type -> Element
def String
"CastExpression.RefAndBounds" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"type"String -> Type -> FieldType
>: String -> Type
java String
"ReferenceType",
        String
"bounds"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"AdditionalBound"],

--ConstantExpression:
--  Expression
      String -> Type -> Element
def String
"ConstantExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
java String
"Expression"]