diff options
Diffstat (limited to 'languages/ada/ada.g')
-rw-r--r-- | languages/ada/ada.g | 1982 |
1 files changed, 1982 insertions, 0 deletions
diff --git a/languages/ada/ada.g b/languages/ada/ada.g new file mode 100644 index 00000000..5f97952b --- /dev/null +++ b/languages/ada/ada.g @@ -0,0 +1,1982 @@ +/* + * Ada95 Grammar for ANTLR, target language C++ + * + * Copyright (C) 2003 Oliver M. Kellogg <[email protected]> + * Modifications (C) 2005 Daniel Zuberbuehler <[email protected]> + * + * Adapted from lexer9x.l/grammar9x.y, + * + ******* A YACC grammar for Ada 9X ********************************* + * Copyright (C) Intermetrics, Inc. 1994 Cambridge, MA USA * + * Copying permitted if accompanied by this statement. * + * Derivative works are permitted if accompanied by this statement.* + * This grammar is thought to be correct as of May 1, 1994 * + * but as usual there is *no warranty* to that effect. * + ******************************************************************* + * + * $Id$ + * + * Not all rules from the Ada95 Reference Manual (RM) Annex P, + * Syntax Summary, are mirrored as rules here. + * The tree nodes follow the RM grammar as closely as sensible. + * This applies in particular to the terminals. OTOH, trivially + * reconstructable non-terminal rules are not reflected in the tree. + * FIXME: Document the exact rationale of the tree design. + * + */ + + +header "pre_include_hpp" { +#include <antlr/SemanticException.hpp> // antlr wants this +#include "AdaAST.hpp" +#include "preambles.h" +} + +options { + language="Cpp"; +} + +//----------------------------------------------------------------------------- +// Define a Parser, calling it AdaParser +//----------------------------------------------------------------------------- +class AdaParser extends Parser; +options { + k = 2; // token lookahead + exportVocab=Ada; // Call its vocabulary "Ada" + // codeGenMakeSwitchThreshold = 2; // Some optimizations + // codeGenBitsetTestThreshold = 3; + defaultErrorHandler = false; // Generate parser error handlers + buildAST = true; + ASTLabelType = "RefAdaAST"; +} + +{ + ANTLR_PARSER_PREAMBLE + +public: + // Ada support stuff + void push_def_id (const RefAdaAST& defid); + const RefAdaAST& pop_def_id (); + bool end_id_matches_def_id (const RefAdaAST& endid); + bool definable_operator (const char *string); // operator_symbol sans "/=" + bool is_operator_symbol (const char *string); +} + +// Compilation Unit: This is the start rule for this parser. +// The rules in this grammar are listed in the order in which +// compilation_unit introduces them, depth first, with the +// exception of the expression related rules which are listed +// towards the end. +compilation_unit + : context_items_opt ( library_item | subunit ) ( pragma )* + ; + +// The pragma related rules are pulled up here to get them out of the way. + +pragma : PRAGMA^ IDENTIFIER pragma_args_opt SEMI! + ; + +pragma_args_opt : ( LPAREN! pragma_arg ( COMMA! pragma_arg )* RPAREN! )? + ; + +pragma_arg : ( IDENTIFIER RIGHT_SHAFT^ )? expression + ; + +context_items_opt : ( pragma | with_clause | use_clause )* + { #context_items_opt = + #(#[CONTEXT_CLAUSE, "CONTEXT_CLAUSE"], #context_items_opt); } + // RM Annex P neglects pragmas; we include them. + // The node should really be named CONTEXT_ITEMS_OPT but we + // stick with the RM wording. + ; + +with_clause : w:WITH^ c_name_list SEMI! + { Set(#w, WITH_CLAUSE); } + ; + +c_name_list : compound_name ( COMMA! compound_name )* + ; + +compound_name : IDENTIFIER ( DOT^ IDENTIFIER )* + // Strangely, the RM never defines this rule, which however is + // required for tightening up the syntax of certain names + // (library unit names etc.) + ; + +use_clause : u:USE^ + ( TYPE! subtype_mark ( COMMA! subtype_mark )* + { Set(#u, USE_TYPE_CLAUSE); } + | c_name_list { Set(#u, USE_CLAUSE); } + ) + SEMI! + ; + +subtype_mark : compound_name ( TIC^ attribute_id )? + // { #subtype_mark = #(#[SUBTYPE_MARK, "SUBTYPE_MARK"], #subtype_mark); } + ; + +attribute_id : RANGE + | DIGITS + | DELTA + | ACCESS + | IDENTIFIER + ; + +library_item : private_opt + /* Slightly loose; PRIVATE can only precede + {generic|package|subprog}_decl. + Semantic check required to ensure it.*/ + ( lib_pkg_spec_or_body + | subprog_decl_or_rename_or_inst_or_body[true] + | generic_decl[true] + ) + { #library_item = #(#[LIBRARY_ITEM, "LIBRARY_ITEM"], #library_item); } + ; + +private_opt : ( PRIVATE )? + { #private_opt = #(#[MODIFIERS, "MODIFIERS"], #private_opt); } + ; + +lib_pkg_spec_or_body + : pkg:PACKAGE^ + ( BODY! def_id[true] IS! pkg_body_part SEMI! + { Set(#pkg, PACKAGE_BODY); } + | def_id[true] spec_decl_part[#pkg] + ) + ; + +subprog_decl [boolean lib_level] + { RefAdaAST t; } + : p:PROCEDURE^ def_id[lib_level] + ( generic_subp_inst + { Set(#p, GENERIC_PROCEDURE_INSTANTIATION); } + | formal_part_opt + ( renames { Set(#p, PROCEDURE_RENAMING_DECLARATION); } + | is_separate_or_abstract_or_decl[#p] + ) + SEMI! + ) + | f:FUNCTION^ def_designator[lib_level] + ( generic_subp_inst + { Set(#f, GENERIC_FUNCTION_INSTANTIATION); } + | function_tail + ( renames { Set(#f, FUNCTION_RENAMING_DECLARATION); } + | is_separate_or_abstract_or_decl[#f] + ) + SEMI! + ) + ; + +def_id [boolean lib_level] + : { lib_level }? cn:compound_name { push_def_id(#cn); } + | { !lib_level }? n:IDENTIFIER { push_def_id(#n); } + ; + +generic_subp_inst : IS! generic_inst SEMI! + ; + +generic_inst : NEW! compound_name ( LPAREN! value_s RPAREN! )? + { pop_def_id(); } + ; + +parenth_values : LPAREN! value ( COMMA! value )* RPAREN! + ; + +value : ( OTHERS^ RIGHT_SHAFT! expression + | ranged_expr_s ( RIGHT_SHAFT^ expression )? + ) + // { #value = #(#[VALUE, "VALUE"], #value); } + ; + +ranged_expr_s : ranged_expr ( PIPE^ ranged_expr )* + // { #ranged_expr_s = + // #(#[RANGED_EXPRS, "RANGED_EXPRS"], #ranged_expr_s); } + ; + +ranged_expr : expression + ( DOT_DOT^ simple_expression + | RANGE^ range + )? + ; + +range_constraint : r:RANGE^ range + { Set(#r, RANGE_CONSTRAINT); } + ; + +range : ( (range_dots) => range_dots + | range_attrib_ref + ) + // Current assumption is we don't need an extra node for range, + // otherwise uncomment the following line: + // { #range = #(#[RANGE_EXPR, "RANGE_EXPR"], #range); } + ; + +range_dots : simple_expression DOT_DOT^ simple_expression + ; + +range_attrib_ref : // "name TIC RANGE" is ambiguous; instead: + prefix TIC! r:RANGE^ ( LPAREN! expression RPAREN! )? + { Set(#r, RANGE_ATTRIBUTE_REFERENCE); } + ; + +// Here, the definition of `prefix' deviates from the RM. +// This gives us some more strictness than `name' (which the RM uses to +// define `prefix'.) +prefix : IDENTIFIER + ( DOT^ ( ALL | IDENTIFIER ) + | p:LPAREN^ value_s RPAREN! + { Set(#p, INDEXED_COMPONENT); } + )* + ; + +formal_part_opt : ( LPAREN! parameter_specification + ( SEMI! parameter_specification )* + RPAREN! )? + { #formal_part_opt = #([FORMAL_PART_OPT, "FORMAL_PART_OPT"], + #formal_part_opt); } + ; + +parameter_specification : def_ids_colon mode_opt subtype_mark init_opt + { #parameter_specification = + #(#[PARAMETER_SPECIFICATION, + "PARAMETER_SPECIFICATION"], #parameter_specification); } + ; + +def_ids_colon : defining_identifier_list COLON! + ; + +defining_identifier_list : IDENTIFIER ( COMMA! IDENTIFIER )* + { #defining_identifier_list = + #(#[DEFINING_IDENTIFIER_LIST, + "DEFINING_IDENTIFIER_LIST"], #defining_identifier_list); } + ; + +mode_opt : ( IN ( OUT )? | OUT | ACCESS )? + { #mode_opt = #(#[MODIFIERS, "MODIFIERS"], #mode_opt); } + ; + +renames { RefAdaAST dummy; } + : RENAMES! ( name + | dummy=definable_operator_symbol + ) + { pop_def_id(); } + ; + +name { RefAdaAST dummy; } + : IDENTIFIER + ( DOT^ ( ALL + | IDENTIFIER + | CHARACTER_LITERAL + | dummy=is_operator + ) + | p:LPAREN^ value_s RPAREN! + { Set(#p, INDEXED_COMPONENT); } + | TIC^ attribute_id // must be in here because of e.g. + // Character'Pos (x) + )* + // { #name = #(#[NAME, "NAME"], #name); } + ; + +is_operator returns [RefAdaAST d] + : { is_operator_symbol(LT(1)->getText().c_str()) }? + op:CHAR_STRING { #op->setType(OPERATOR_SYMBOL); d=#op; } + ; + +definable_operator_symbol returns [RefAdaAST d] + : { definable_operator(LT(1)->getText().c_str()) }? + op:CHAR_STRING { #op->setType(OPERATOR_SYMBOL); d=#op; } + ; + +parenthesized_primary : pp:LPAREN^ + ( NuLL RECORD! + | value_s extension_opt + ) + RPAREN! + { Set(#pp, PARENTHESIZED_PRIMARY); } + ; + +extension_opt : ( WITH! ( NuLL RECORD! | value_s ) )? + { #extension_opt = + #(#[EXTENSION_OPT, "EXTENSION_OPT"], #extension_opt); } + ; + +is_separate_or_abstract_or_decl! [RefAdaAST t] + : IS! separate_or_abstract[t] + | { pop_def_id(); + if (t->getType() == AdaTokenTypes::PROCEDURE) + Set(t, PROCEDURE_DECLARATION); + else + Set(t, FUNCTION_DECLARATION); + } + ; + +separate_or_abstract! [RefAdaAST t] + : SEPARATE! + { pop_def_id(); + if (t->getType() == AdaTokenTypes::PROCEDURE) + Set(t, PROCEDURE_BODY_STUB); + else + Set(t, FUNCTION_BODY_STUB); + } + | ABSTRACT! + { pop_def_id(); + if (t->getType() == AdaTokenTypes::PROCEDURE) + Set(t, ABSTRACT_PROCEDURE_DECLARATION); + else + Set(t, ABSTRACT_FUNCTION_DECLARATION); + } + ; + +def_designator [boolean lib_level] + { RefAdaAST d; } + : { lib_level }? n:compound_name { push_def_id(#n); } + | { !lib_level }? d=designator { push_def_id(d); } + ; + +designator returns [RefAdaAST d] + { RefAdaAST op; } + : op=definable_operator_symbol { d = op; } + | n:IDENTIFIER { d = #n; } + ; + +function_tail : func_formal_part_opt RETURN! subtype_mark + ; + +// formal_part_opt is not strict enough for functions, i.e. it permits +// "in out" and "out" as modes, thus we make an extra rule: +func_formal_part_opt : ( LPAREN! func_param ( SEMI! func_param )* RPAREN! )? + { #func_formal_part_opt = + #([FORMAL_PART_OPT, + "FORMAL_PART_OPT"], #func_formal_part_opt); } + ; + +func_param : def_ids_colon in_access_opt subtype_mark init_opt + { #func_param = + #(#[PARAMETER_SPECIFICATION, + "PARAMETER_SPECIFICATION"], #func_param); } + ; + +in_access_opt : ( IN | ACCESS )? + { #in_access_opt = #(#[MODIFIERS, "MODIFIERS"], #in_access_opt); } + ; + +spec_decl_part [RefAdaAST pkg] + : ( IS! ( generic_inst { Set(pkg, GENERIC_PACKAGE_INSTANTIATION); } + | pkg_spec_part { Set(pkg, PACKAGE_SPECIFICATION); } + ) + | renames { Set(pkg, PACKAGE_RENAMING_DECLARATION); } + ) + SEMI! + ; + +pkg_spec_part : basic_declarative_items_opt + private_declarative_items_opt + end_id_opt + ; + +private_declarative_items_opt : ( PRIVATE! ( basic_decl_item | pragma )* )? + { #private_declarative_items_opt = + #(#[PRIVATE_DECLARATIVE_ITEMS_OPT, + "PRIVATE_DECLARATIVE_ITEMS_OPT"], + #private_declarative_items_opt); } + ; + +basic_declarative_items_opt : ( basic_decl_item | pragma )* + { #basic_declarative_items_opt = + #(#[BASIC_DECLARATIVE_ITEMS_OPT, + "BASIC_DECLARATIVE_ITEMS_OPT"], + #basic_declarative_items_opt); } + ; + +basic_declarative_items : ( basic_decl_item | pragma )+ + { #basic_declarative_items = + #(#[BASIC_DECLARATIVE_ITEMS_OPT, + "BASIC_DECLARATIVE_ITEMS_OPT"], + #basic_declarative_items); } + ; + +basic_decl_item + : pkg:PACKAGE^ def_id[false] spec_decl_part[#pkg] + | tsk:TASK^ task_type_or_single_decl[#tsk] + | pro:PROTECTED^ prot_type_or_single_decl[#pro] SEMI! + | subprog_decl[false] + | decl_common + ; + +task_type_or_single_decl [RefAdaAST tsk] + : TYPE! def_id[false] discrim_part_opt task_definition_opt + { Set(tsk, TASK_TYPE_DECLARATION); } + | def_id[false] task_definition_opt + { Set(tsk, SINGLE_TASK_DECLARATION); } + ; + +task_definition_opt + : IS! task_items_opt private_task_items_opt end_id_opt SEMI! + | SEMI! { pop_def_id(); } + ; + +discrim_part_opt + : ( discrim_part_text )? + { #discrim_part_opt = + #(#[DISCRIM_PART_OPT, + "DISCRIM_PART_OPT"], #discrim_part_opt); } + ; + +discrim_part_text : LPAREN! (BOX | discriminant_specifications) RPAREN! + ; + +known_discrim_part + : LPAREN! discriminant_specifications RPAREN! + { #known_discrim_part = + #(#[DISCRIM_PART_OPT, + "DISCRIM_PART_OPT"], #known_discrim_part); } + ; + +empty_discrim_opt : /* empty */ + { #empty_discrim_opt = + #(#[DISCRIM_PART_OPT, + "DISCRIM_PART_OPT"], #empty_discrim_opt); } + ; + +discrim_part + : discrim_part_text + { #discrim_part = + #(#[DISCRIM_PART_OPT, + "DISCRIM_PART_OPT"], #discrim_part); } + ; + +discriminant_specifications : discriminant_specification + ( SEMI! discriminant_specification )* + { #discriminant_specifications = + #(#[DISCRIMINANT_SPECIFICATIONS, + "DISCRIMINANT_SPECIFICATIONS"], + #discriminant_specifications); } + ; + +discriminant_specification : def_ids_colon access_opt subtype_mark init_opt + { #discriminant_specification = + #(#[DISCRIMINANT_SPECIFICATION, + "DISCRIMINANT_SPECIFICATION"], + #discriminant_specification); } + ; + +access_opt : ( ACCESS )? + { #access_opt = #(#[MODIFIERS, "MODIFIERS"], #access_opt); } + ; + +init_opt : ( ASSIGN! expression )? + { #init_opt = #(#[INIT_OPT, "INIT_OPT"], #init_opt); } + ; // `expression' is of course much too loose; + // semantic checks are required in the usage contexts. + +task_items_opt : ( pragma )* entrydecls_repspecs_opt + { #task_items_opt = + #(#[TASK_ITEMS_OPT, "TASK_ITEMS_OPT"], #task_items_opt); } + ; + +entrydecls_repspecs_opt : ( entry_declaration ( pragma | rep_spec )* )* + ; + +entry_declaration : e:ENTRY^ IDENTIFIER + discrete_subtype_def_opt formal_part_opt SEMI! + { Set (#e, ENTRY_DECLARATION); } + ; + +discrete_subtype_def_opt : ( (LPAREN discrete_subtype_definition RPAREN) => + LPAREN! discrete_subtype_definition RPAREN! + | /* empty */ + ) + { #discrete_subtype_def_opt = + #(#[DISCRETE_SUBTYPE_DEF_OPT, + "DISCRETE_SUBTYPE_DEF_OPT"], #discrete_subtype_def_opt); } + ; + +discrete_subtype_definition : ( (range) => range + | subtype_ind + ) + // Looks alot like discrete_range, but it's not + // (as soon as we start doing semantics.) + /* TBC: No need for extra node, just use the inner nodes? + { #discrete_subtype_definition = + #(#[DISCRETE_SUBTYPE_DEFINITION, + "DISCRETE_SUBTYPE_DEFINITION"], + #discrete_subtype_definition); } + */ + ; + +rep_spec : r:FOR^ subtype_mark USE! rep_spec_part[#r] SEMI! + ; + +rep_spec_part [RefAdaAST t] + : RECORD! align_opt comp_loc_s END! RECORD! // record_type_spec + { Set(t, RECORD_REPRESENTATION_CLAUSE); } + | AT! expression // address_spec (Ada83) + { Set(t, AT_CLAUSE); } + | expression // attrib_def. Semantic check must ensure that the + // respective subtype_mark contains an attribute reference. + { Set(t, ATTRIBUTE_DEFINITION_CLAUSE); } + ; + +align_opt : ( AT! MOD! expression SEMI! )? + { #align_opt = #(#[MOD_CLAUSE_OPT, "MOD_CLAUSE_OPT"], #align_opt); } + ; + +comp_loc_s : ( pragma | subtype_mark AT! expression RANGE! range SEMI! )* + { #comp_loc_s = #(#[COMPONENT_CLAUSES_OPT, "COMPONENT_CLAUSES_OPT"], + #comp_loc_s); } + ; + +private_task_items_opt : ( PRIVATE! ( pragma )* entrydecls_repspecs_opt )? + { #private_task_items_opt = + #(#[PRIVATE_TASK_ITEMS_OPT, + "PRIVATE_TASK_ITEMS_OPT"], #private_task_items_opt); } + // Maybe we could just reuse TASK_ITEMS_OPT here instead of + // making a separate node type. + ; + +prot_type_or_single_decl [RefAdaAST pro] + : TYPE! def_id[false] discrim_part_opt protected_definition + { Set(pro, PROTECTED_TYPE_DECLARATION); } + | def_id[false] protected_definition + { Set(pro, SINGLE_PROTECTED_DECLARATION); } + ; + +prot_private_opt : ( PRIVATE! ( prot_op_decl | comp_decl )* )? + { #prot_private_opt = + #(#[PROT_PRIVATE_OPT, + "PROT_PRIVATE_OPT"], #prot_private_opt); } + ; + +protected_definition + : IS! prot_op_decl_s prot_private_opt end_id_opt + ; + +prot_op_decl_s : ( prot_op_decl )* + { #prot_op_decl_s = #(#[PROT_OP_DECLARATIONS, + "PROT_OP_DECLARATIONS"], #prot_op_decl_s); } + ; + +prot_op_decl : entry_declaration + | p:PROCEDURE^ def_id[false] formal_part_opt SEMI! + { pop_def_id(); Set(#p, PROCEDURE_DECLARATION); } + | f:FUNCTION^ def_designator[false] function_tail SEMI! + { pop_def_id(); Set(#f, FUNCTION_DECLARATION); } + | rep_spec + | pragma + ; + +prot_member_decl_s : ( prot_op_decl | comp_decl )* + { #prot_member_decl_s = + #(#[PROT_MEMBER_DECLARATIONS, + "PROT_MEMBER_DECLARATIONS"], #prot_member_decl_s); } + ; + +comp_decl : def_ids_colon component_subtype_def init_opt SEMI! + { #comp_decl = + #(#[COMPONENT_DECLARATION, + "COMPONENT_DECLARATION"], #comp_decl); } + ; + +// decl_common is shared between declarative_item and basic_decl_item. +// decl_common only contains specifications. +decl_common + : t:TYPE^ IDENTIFIER + ( IS! type_def[#t] + | ( discrim_part + ( IS! derived_or_private_or_record[#t, true] + | { Set(#t, INCOMPLETE_TYPE_DECLARATION); } + ) + | empty_discrim_opt + { Set(#t, INCOMPLETE_TYPE_DECLARATION); } + // NB: In this case, the discrim_part_opt does not + // appear in the INCOMPLETE_TYPE_DECLARATION node. + ) + /* The artificial derived_or_private_or_record rule + gives us some syntax-level control over where a + discrim_part may appear. + However, a semantic check is still necessary to make + sure the discrim_part is not given for a derived type + of an elementary type, or for the full view of a + private type that turns out to be such. */ + ) + SEMI! + | s:SUBTYPE^ IDENTIFIER IS! subtype_ind SEMI! // subtype_decl + { Set(#s, SUBTYPE_DECLARATION); } + | generic_decl[false] + | use_clause + | r:FOR^ ( (local_enum_name USE LPAREN) => local_enum_name USE! + enumeration_aggregate + { Set(#r, ENUMERATION_REPESENTATION_CLAUSE); } + | subtype_mark USE! rep_spec_part[#r] + ) + SEMI! + | (IDENTIFIER COLON EXCEPTION RENAMES) => + IDENTIFIER erd:COLON^ EXCEPTION! RENAMES! compound_name SEMI! + { Set(#erd, EXCEPTION_RENAMING_DECLARATION); } + | (IDENTIFIER COLON subtype_mark RENAMES) => + IDENTIFIER ord:COLON^ subtype_mark RENAMES! name SEMI! + { Set(#ord, OBJECT_RENAMING_DECLARATION); } + | defining_identifier_list od:COLON^ // object_declaration + ( EXCEPTION! + { Set(#od, EXCEPTION_DECLARATION); } + | (CONSTANT ASSIGN) => CONSTANT! ASSIGN! expression + { Set(#od, NUMBER_DECLARATION); } + | aliased_constant_opt + ( array_type_definition[#od] init_opt + { Set(#od, ARRAY_OBJECT_DECLARATION); } + // Not an RM rule, but simplifies distinction + // from the non-array object_declaration. + | subtype_ind init_opt + { Set(#od, OBJECT_DECLARATION); } + ) + ) + SEMI! + ; + +type_def [RefAdaAST t] + : LPAREN! enum_id_s RPAREN! + { Set(t, ENUMERATION_TYPE_DECLARATION); } + | RANGE! range + { Set(t, SIGNED_INTEGER_TYPE_DECLARATION); } + | MOD! expression + { Set(t, MODULAR_TYPE_DECLARATION); } + | DIGITS! expression range_constraint_opt + { Set(t, FLOATING_POINT_DECLARATION); } + | DELTA! expression + ( RANGE! range + { Set(t, ORDINARY_FIXED_POINT_DECLARATION); } + | DIGITS! expression range_constraint_opt + { Set(t, DECIMAL_FIXED_POINT_DECLARATION); } + ) + | array_type_definition[t] + | access_type_definition[t] + | empty_discrim_opt derived_or_private_or_record[t, false] + ; + +enum_id_s : enumeration_literal_specification + ( COMMA! enumeration_literal_specification )* + ; + +enumeration_literal_specification : IDENTIFIER | CHARACTER_LITERAL + ; + +range_constraint_opt : ( range_constraint )? + ; + +array_type_definition [RefAdaAST t] + : ARRAY! LPAREN! index_or_discrete_range_s RPAREN! + OF! component_subtype_def + { Set(t, ARRAY_TYPE_DECLARATION); } + ; + +index_or_discrete_range_s + : index_or_discrete_range ( COMMA^ index_or_discrete_range )* + ; + +index_or_discrete_range + : simple_expression + ( DOT_DOT^ simple_expression // constrained + | RANGE^ ( BOX // unconstrained + | range // constrained + ) + )? + ; + +component_subtype_def : aliased_opt subtype_ind + ; + +aliased_opt : ( ALIASED )? + { #aliased_opt = #(#[MODIFIERS, "MODIFIERS"], #aliased_opt); } + ; + +subtype_ind : subtype_mark constraint_opt + { #subtype_ind = #(#[SUBTYPE_INDICATION, "SUBTYPE_INDICATION"], + #subtype_ind); } + ; + +constraint_opt : ( range_constraint + | digits_constraint + | delta_constraint + | (index_constraint) => index_constraint + | discriminant_constraint + )? + ; + +digits_constraint : d:DIGITS^ expression range_constraint_opt + { Set(#d, DIGITS_CONSTRAINT); } + ; + +delta_constraint : d:DELTA^ expression range_constraint_opt + { Set(#d, DELTA_CONSTRAINT); } + ; + +index_constraint : p:LPAREN^ discrete_range ( COMMA! discrete_range )* RPAREN! + { Set(#p, INDEX_CONSTRAINT); } + ; + +discrete_range + : (range) => range + | subtype_ind + ; + +discriminant_constraint : p:LPAREN^ discriminant_association + ( COMMA! discriminant_association )* RPAREN! + { Set(#p, DISCRIMINANT_CONSTRAINT); } + ; + +discriminant_association : selector_names_opt expression + { #discriminant_association = + #(#[DISCRIMINANT_ASSOCIATION, + "DISCRIMINANT_ASSOCIATION"], #discriminant_association); } + ; + +selector_names_opt : ( (association_head) => association_head + | /* empty */ + ) + { #selector_names_opt = + #(#[SELECTOR_NAMES_OPT, + "SELECTOR_NAMES_OPT"], #selector_names_opt); } + ; + +association_head : selector_name ( PIPE! selector_name )* RIGHT_SHAFT! + ; + +selector_name : IDENTIFIER // TBD: sem pred + ; + +access_type_definition [RefAdaAST t] + : ACCESS! + ( protected_opt + ( PROCEDURE! formal_part_opt + { Set(t, ACCESS_TO_PROCEDURE_DECLARATION); } + | FUNCTION! func_formal_part_opt RETURN! subtype_mark + { Set(t, ACCESS_TO_FUNCTION_DECLARATION); } + ) + | constant_all_opt subtype_ind + { Set(t, ACCESS_TO_OBJECT_DECLARATION); } + ) + ; + +protected_opt : ( PROTECTED )? + { #protected_opt = #(#[MODIFIERS, "MODIFIERS"], #protected_opt); } + ; + +constant_all_opt : ( CONSTANT | ALL )? + { #constant_all_opt = + #(#[MODIFIERS, "MODIFIERS"], #constant_all_opt); } + ; + +derived_or_private_or_record [RefAdaAST t, boolean has_discrim] + : ( ( ABSTRACT )? NEW subtype_ind WITH ) => + abstract_opt NEW! subtype_ind WITH! + ( PRIVATE! { Set(t, PRIVATE_EXTENSION_DECLARATION); } + | record_definition[has_discrim] + { Set(t, DERIVED_RECORD_EXTENSION); } + ) + | NEW! subtype_ind { Set(t, ORDINARY_DERIVED_TYPE_DECLARATION); } + | abstract_tagged_limited_opt + ( PRIVATE! { Set(t, PRIVATE_TYPE_DECLARATION); } + | record_definition[has_discrim] + { Set(t, RECORD_TYPE_DECLARATION); } + ) + ; + +abstract_opt : ( ABSTRACT )? + { #abstract_opt = #(#[MODIFIERS, "MODIFIERS"], #abstract_opt); } + ; + +record_definition [boolean has_discrim] + : RECORD! component_list[has_discrim] END! RECORD! + | NuLL! RECORD! // Thus the component_list is optional in the tree. + ; + +component_list [boolean has_discrim] + : NuLL! SEMI! // Thus the component_list is optional in the tree. + | component_items ( variant_part { has_discrim }? )? + | empty_component_items variant_part { has_discrim }? + ; + +component_items : ( pragma | comp_decl )+ + { #component_items = + #(#[COMPONENT_ITEMS, + "COMPONENT_ITEMS"], #component_items); } + ; + +empty_component_items : + { #empty_component_items = + #(#[COMPONENT_ITEMS, + "COMPONENT_ITEMS"], #empty_component_items); } + ; + +variant_part : c:CASE^ discriminant_direct_name IS! variant_s END! CASE! SEMI! + { Set (#c, VARIANT_PART); } + ; + +discriminant_direct_name : IDENTIFIER // TBD: symtab lookup. + ; + +variant_s : ( variant )+ + { #variant_s = #(#[VARIANTS, "VARIANTS"], #variant_s); } + ; + +variant : w:WHEN^ choice_s RIGHT_SHAFT! component_list[true] + { Set (#w, VARIANT); } + ; + +choice_s : choice ( PIPE^ choice )* + ; + +choice : OTHERS + | (discrete_with_range) => discrete_with_range + | expression // ( DOT_DOT^ simple_expression )? + ; // No, that's already in discrete_with_range + +discrete_with_range : (mark_with_constraint) => mark_with_constraint + | range + ; + +mark_with_constraint : subtype_mark range_constraint + { #mark_with_constraint = + #(#[MARK_WITH_CONSTRAINT, + "MARK_WITH_CONSTRAINT"], #mark_with_constraint); } + ; + +abstract_tagged_limited_opt + : ( ABSTRACT TAGGED! | TAGGED )? + ( LIMITED )? + { #abstract_tagged_limited_opt = + #(#[MODIFIERS, "MODIFIERS"], #abstract_tagged_limited_opt); } + ; + +local_enum_name : IDENTIFIER // to be refined: do a symbol table lookup + ; + +enumeration_aggregate : parenth_values + ; + +aliased_constant_opt : ( ALIASED )? ( CONSTANT )? + { #aliased_constant_opt = + #(#[MODIFIERS, "MODIFIERS"], #aliased_constant_opt); } + ; + +generic_decl [boolean lib_level] + : g:GENERIC^ generic_formal_part_opt + ( PACKAGE! def_id[lib_level] + ( renames { Set(#g, GENERIC_PACKAGE_RENAMING); } + | IS! pkg_spec_part { Set(#g, GENERIC_PACKAGE_DECLARATION); } + ) + | PROCEDURE! def_id[lib_level] formal_part_opt + ( renames { Set(#g, GENERIC_PROCEDURE_RENAMING); } + // ^^^ Semantic check must ensure that the (generic_formal)* + // after GENERIC is not given here. + | { Set(#g, GENERIC_PROCEDURE_DECLARATION); pop_def_id(); } + ) + | FUNCTION! def_designator[lib_level] function_tail + ( renames { Set(#g, GENERIC_FUNCTION_RENAMING); } + // ^^^ Semantic check must ensure that the (generic_formal)* + // after GENERIC is not given here. + | { Set(#g, GENERIC_FUNCTION_DECLARATION); pop_def_id(); } + ) + ) + SEMI! + ; + +generic_formal_part_opt : ( use_clause | pragma | generic_formal_parameter )* + { #generic_formal_part_opt = + #(#[GENERIC_FORMAL_PART, + "GENERIC_FORMAL_PART"], + #generic_formal_part_opt); } + ; + +generic_formal_parameter : + ( t:TYPE^ def_id[false] + ( IS! + ( LPAREN! BOX! RPAREN! + { Set (#t, FORMAL_DISCRETE_TYPE_DECLARATION); } + | RANGE! BOX! + { Set (#t, FORMAL_SIGNED_INTEGER_TYPE_DECLARATION); } + | MOD! BOX! + { Set (#t, FORMAL_MODULAR_TYPE_DECLARATION); } + | DELTA! BOX! + ( DIGITS! BOX! + { Set (#t, FORMAL_DECIMAL_FIXED_POINT_DECLARATION); } + | { Set (#t, FORMAL_ORDINARY_FIXED_POINT_DECLARATION); } + ) + | DIGITS! BOX! + { Set (#t, FORMAL_FLOATING_POINT_DECLARATION); } + | array_type_definition[#t] + | access_type_definition[#t] + | empty_discrim_opt discriminable_type_definition[#t] + ) + | discrim_part IS! discriminable_type_definition[#t] + ) + { pop_def_id(); } + | w:WITH^ ( PROCEDURE! def_id[false] formal_part_opt subprogram_default_opt + { Set(#w, FORMAL_PROCEDURE_DECLARATION); } + | FUNCTION! def_designator[false] function_tail subprogram_default_opt + { Set(#w, FORMAL_FUNCTION_DECLARATION); } + | PACKAGE! def_id[false] IS! NEW! compound_name formal_package_actual_part_opt + { Set(#w, FORMAL_PACKAGE_DECLARATION); } + ) + { pop_def_id(); } + | parameter_specification + ) + SEMI! + ; + +discriminable_type_definition [RefAdaAST t] + : ( ( ABSTRACT )? NEW subtype_ind WITH ) => + abstract_opt NEW! subtype_ind WITH! PRIVATE! + { Set (t, FORMAL_PRIVATE_EXTENSION_DECLARATION); } + | NEW! subtype_ind + { Set (t, FORMAL_ORDINARY_DERIVED_TYPE_DECLARATION); } + | abstract_tagged_limited_opt PRIVATE! + { Set (t, FORMAL_PRIVATE_TYPE_DECLARATION); } + ; + +subprogram_default_opt : ( IS! ( BOX | name ) )? + ; + +formal_package_actual_part_opt + : ( LPAREN! ( BOX | defining_identifier_list ) RPAREN! )? + ; + +subprog_decl_or_rename_or_inst_or_body [boolean lib_level] + { RefAdaAST t; } + : p:PROCEDURE^ def_id[lib_level] + ( generic_subp_inst + { Set(#p, GENERIC_PROCEDURE_INSTANTIATION); } + | formal_part_opt + ( renames { Set(#p, PROCEDURE_RENAMING_DECLARATION); } + | IS! ( separate_or_abstract[#p] + | body_part { Set(#p, PROCEDURE_BODY); } + ) + | { pop_def_id(); + Set(#p, PROCEDURE_DECLARATION); } + ) + SEMI! + ) + | f:FUNCTION^ def_designator[lib_level] + ( generic_subp_inst + { Set(#f, GENERIC_FUNCTION_INSTANTIATION); } + | function_tail + ( renames { Set(#f, FUNCTION_RENAMING_DECLARATION); } + | IS! ( separate_or_abstract[#f] + | body_part { Set(#f, FUNCTION_BODY); } + ) + | { pop_def_id(); + Set(#f, FUNCTION_DECLARATION); } + ) + SEMI! + ) + ; + +body_part : declarative_part block_body end_id_opt + ; + +declarative_part : ( pragma | declarative_item )* + { #declarative_part = + #(#[DECLARATIVE_PART, "DECLARATIVE_PART"], + #declarative_part); } + ; + +// A declarative_item may appear in the declarative part of any body. +declarative_item : + ( pkg:PACKAGE^ ( body_is + ( separate { Set(#pkg, PACKAGE_BODY_STUB); } + | pkg_body_part + { Set(#pkg, PACKAGE_BODY); } + ) + SEMI! + | def_id[false] spec_decl_part[#pkg] + ) + | tsk:TASK^ ( body_is + ( separate { Set(#tsk, TASK_BODY_STUB); } + | body_part { Set(#tsk, TASK_BODY); } + ) + SEMI! + | task_type_or_single_decl[#tsk] + ) + | pro:PROTECTED^ + ( body_is + ( separate { Set(#pro, PROTECTED_BODY_STUB); } + | prot_op_bodies_opt end_id_opt + { Set(#pro, PROTECTED_BODY); } + ) + | prot_type_or_single_decl[#pro] + ) + SEMI! + | subprog_decl_or_rename_or_inst_or_body[false] + | decl_common + ) + /* DECLARATIVE_ITEM is just a pass-thru node so we omit it. + Objections anybody? + { #declarative_item = + #(#[DECLARATIVE_ITEM, + "DECLARATIVE_ITEM"], #declarative_item); } + */ + ; + +body_is : BODY! def_id[false] IS! + ; + +separate : SEPARATE! { pop_def_id(); } + ; + +pkg_body_part : declarative_part block_body_opt end_id_opt + ; + +block_body_opt : ( BEGIN! handled_stmt_s )? + { #block_body_opt = + #(#[BLOCK_BODY_OPT, + "BLOCK_BODY_OPT"], #block_body_opt); } + ; + +prot_op_bodies_opt : ( entry_body + | subprog_decl_or_body + | pragma + )* + { #prot_op_bodies_opt = + #(#[PROT_OP_BODIES_OPT, + "PROT_OP_BODIES_OPT"], #prot_op_bodies_opt); } + ; + +subprog_decl_or_body + : p:PROCEDURE^ def_id[false] formal_part_opt + ( IS! body_part { Set(#p, PROCEDURE_BODY); } + | { pop_def_id(); Set(#p, PROCEDURE_DECLARATION); } + ) + SEMI! + | f:FUNCTION^ def_designator[false] function_tail + ( IS! body_part { Set(#f, FUNCTION_BODY); } + | { pop_def_id(); Set(#f, FUNCTION_DECLARATION); } + ) + SEMI! + ; + +block_body : b:BEGIN^ handled_stmt_s + { Set(#b, BLOCK_BODY); } + ; + +handled_stmt_s : statements except_handler_part_opt + { #handled_stmt_s = + #(#[HANDLED_SEQUENCE_OF_STATEMENTS, + "HANDLED_SEQUENCE_OF_STATEMENTS"], #handled_stmt_s); } + ; + +handled_stmts_opt : ( statements except_handler_part_opt )? + { #handled_stmts_opt = + #(#[HANDLED_STMTS_OPT, + "HANDLED_STMTS_OPT"], #handled_stmts_opt); } + ; + +statements : ( pragma | statement )+ + { #statements = #(#[SEQUENCE_OF_STATEMENTS, + "SEQUENCE_OF_STATEMENTS"], #statements); } + ; + +statement : def_label_opt + ( null_stmt + | exit_stmt + | return_stmt + | goto_stmt + | delay_stmt + | abort_stmt + | raise_stmt + | requeue_stmt + | accept_stmt + | select_stmt + | if_stmt + | case_stmt + | loop_stmt SEMI! + | block END! SEMI! + | statement_identifier + ( loop_stmt id_opt SEMI! + | block end_id_opt SEMI! + ) + | call_or_assignment + // | code_stmt // TBD: resolve ambiguity + ) + { #statement = #(#[STATEMENT, "STATEMENT"], #statement); } + ; + +def_label_opt : ( LT_LT! IDENTIFIER GT_GT! )? + { #def_label_opt = #(#[LABEL_OPT, "LABEL_OPT"], #def_label_opt); } + ; + +null_stmt : s:NuLL SEMI! + { Set(#s, NULL_STATEMENT); } + ; + +if_stmt : s:IF^ cond_clause elsifs_opt + else_opt + END! IF! SEMI! + { Set(#s, IF_STATEMENT); } + ; + +cond_clause : condition c:THEN^ statements + { Set(#c, COND_CLAUSE); } + ; + +condition : expression + // { #condition = #(#[CONDITION, "CONDITION"], #condition); } + ; + +elsifs_opt : ( ELSIF! cond_clause )* + { #elsifs_opt = #(#[ELSIFS_OPT, "ELSIFS_OPT"], #elsifs_opt); } + ; + +else_opt : ( ELSE! statements )? + { #else_opt = #(#[ELSE_OPT, "ELSE_OPT"], #else_opt); } + ; + +case_stmt : s:CASE^ expression IS! alternative_s END! CASE! SEMI! + { Set(#s, CASE_STATEMENT); } + ; + +alternative_s : ( case_statement_alternative )+ + ; + +case_statement_alternative : s:WHEN^ choice_s RIGHT_SHAFT! statements + { Set(#s, CASE_STATEMENT_ALTERNATIVE); } + ; + +loop_stmt : iteration_scheme_opt + l:LOOP^ statements END! LOOP! // basic_loop + { Set(#l, LOOP_STATEMENT); } + ; + +iteration_scheme_opt : ( WHILE^ condition + | FOR^ IDENTIFIER IN! reverse_opt discrete_subtype_definition + )? + { #iteration_scheme_opt = + #(#[ITERATION_SCHEME_OPT, + "ITERATION_SCHEME_OPT"], #iteration_scheme_opt); } + ; + +reverse_opt : ( REVERSE )? + { #reverse_opt = #(#[MODIFIERS, "MODIFIERS"], #reverse_opt); } + ; + +id_opt_aux { RefAdaAST endid; } : + endid=definable_operator_symbol { end_id_matches_def_id (endid) }? + | n:compound_name { end_id_matches_def_id (#n) }? + /* Ordinarily we would need to be stricter here, i.e. + match compound_name only for the library-level case + (and IDENTIFIER otherwise), but end_id_matches_def_id + does the right thing for us. */ + | { pop_def_id(); } + ; + +id_opt : id_opt_aux + { #id_opt = #(#[ID_OPT, "ID_OPT"], #id_opt); } + ; + +end_id_opt : e:END^ id_opt_aux + { Set(#e, END_ID_OPT); } + ; + +/* Note: This rule should really be `statement_identifier_opt'. + However, manual disambiguation of `loop_stmt' from `block' + in the presence of the statement_identifier in `statement' + results in this rule. The case of loop_stmt/block given + without the statement_identifier is directly coded in + `statement'. */ +statement_identifier! : n:IDENTIFIER COLON! + { push_def_id(#n); } + ; + +/* +statement_identifier_opt : ( n:IDENTIFIER COLON! { push_def_id(#n); } )? + { #statement_identifier_opt = + #(#[STATEMENT_IDENTIFIER_OPT, + "STATEMENT_IDENTIFIER_OPT"], #statement_identifier_opt); } + ; + */ + +block : declare_opt block_body + { #block = #(#[BLOCK_STATEMENT, "BLOCK_STATEMENT"], #block); } + ; + +declare_opt : ( DECLARE! declarative_part )? + { #declare_opt = #(#[DECLARE_OPT, "DECLARE_OPT"], #declare_opt); } + ; + +exit_stmt : s:EXIT^ ( label_name )? ( WHEN condition )? SEMI! + { Set(#s, EXIT_STATEMENT); } + ; + +label_name : IDENTIFIER + ; + +return_stmt : s:RETURN^ ( expression )? SEMI! + { Set(#s, RETURN_STATEMENT); } + ; + +goto_stmt : s:GOTO^ label_name SEMI! + { Set(#s, GOTO_STATEMENT); } + ; + +call_or_assignment : // procedure_call is in here. + name ( ASSIGN! expression + { #call_or_assignment = + #(#[ASSIGNMENT_STATEMENT, + "ASSIGNMENT_STATEMENT"], #call_or_assignment); } + | { #call_or_assignment = + #(#[CALL_STATEMENT, + "CALL_STATEMENT"], #call_or_assignment); } + /* Preliminary. Use semantic analysis to produce + {PROCEDURE|ENTRY}_CALL_STATEMENT. */ + ) + SEMI! + ; + +entry_body : e:ENTRY^ def_id[false] entry_body_formal_part entry_barrier IS! + body_part SEMI! + { Set (#e, ENTRY_BODY); } + ; + +entry_body_formal_part : entry_index_spec_opt formal_part_opt + ; + +entry_index_spec_opt : + ( (LPAREN FOR) => + LPAREN! FOR! def_id[false] IN! discrete_subtype_definition RPAREN! + | /* empty */ + ) + { #entry_index_spec_opt = + #(#[ENTRY_INDEX_SPECIFICATION, + "ENTRY_INDEX_SPECIFICATION"], #entry_index_spec_opt); } + ; + +entry_barrier : WHEN! condition + ; + +entry_call_stmt : name SEMI! // Semantic analysis required, for example + // to ensure `name' is an entry. + { #entry_call_stmt = + #(#[ENTRY_CALL_STATEMENT, + "ENTRY_CALL_STATEMENT"], #entry_call_stmt); } + ; + +accept_stmt : a:ACCEPT^ def_id[false] entry_index_opt formal_part_opt + ( DO! handled_stmts_opt end_id_opt SEMI! + | SEMI! { pop_def_id(); } + ) + { Set (#a, ACCEPT_STATEMENT); } + ; + +entry_index_opt : ( (LPAREN expression RPAREN) => LPAREN! expression RPAREN! + // Looks alot like parenthesized_expr_opt, but it's not. + // We need the syn pred for the usage context in accept_stmt. + // The formal_part_opt that follows the entry_index_opt there + // creates ambiguity (due to the opening LPAREN.) + | /* empty */ + ) + { #entry_index_opt = + #(#[ENTRY_INDEX_OPT, + "ENTRY_INDEX_OPT"], #entry_index_opt); } + ; + +delay_stmt : d:DELAY^ until_opt expression SEMI! + { Set (#d, DELAY_STATEMENT); } + ; + +until_opt : ( UNTIL )? + { #until_opt = #(#[MODIFIERS, "MODIFIERS"], #until_opt); } + ; + +// SELECT_STATEMENT itself is not modeled since it is trivially +// reconstructed: +// select_statement ::= selective_accept | timed_entry_call +// | conditional_entry_call | asynchronous_select +// +select_stmt : s:SELECT^ + ( (triggering_alternative THEN ABORT) => + triggering_alternative THEN! ABORT! abortable_part + { Set (#s, ASYNCHRONOUS_SELECT); } + | selective_accept + { Set (#s, SELECTIVE_ACCEPT); } + | entry_call_alternative + ( OR! delay_alternative { Set (#s, TIMED_ENTRY_CALL); } + | ELSE! statements { Set (#s, CONDITIONAL_ENTRY_CALL); } + ) + ) + END! SELECT! SEMI! + // { Set (#s, SELECT_STATEMENT); } + ; + +triggering_alternative : ( delay_stmt | entry_call_stmt ) stmts_opt + { #triggering_alternative = + #(#[TRIGGERING_ALTERNATIVE, + "TRIGGERING_ALTERNATIVE"], #triggering_alternative); } + ; + +abortable_part : stmts_opt + { #abortable_part = + #(#[ABORTABLE_PART, + "ABORTABLE_PART"], #abortable_part); } + ; + +entry_call_alternative : entry_call_stmt stmts_opt + { #entry_call_alternative = + #(#[ENTRY_CALL_ALTERNATIVE, + "ENTRY_CALL_ALTERNATIVE"], #entry_call_alternative); } + ; + +selective_accept : guard_opt select_alternative or_select_opt else_opt + ; + +guard_opt : ( w:WHEN^ condition RIGHT_SHAFT! ( pragma )* )? + { Set(#w, GUARD_OPT); } + ; + +select_alternative // Not modeled since it's just a pass-through. + : accept_alternative + | delay_alternative + | t:TERMINATE SEMI! { Set(#t, TERMINATE_ALTERNATIVE); } + ; + +accept_alternative : accept_stmt stmts_opt + { #accept_alternative = + #(#[ACCEPT_ALTERNATIVE, + "ACCEPT_ALTERNATIVE"], #accept_alternative); } + ; + +delay_alternative : delay_stmt stmts_opt + { #delay_alternative = + #(#[DELAY_ALTERNATIVE, + "DELAY_ALTERNATIVE"], #delay_alternative); } + ; + +stmts_opt : ( pragma | statement )* + ; + +or_select_opt : ( OR! guard_opt select_alternative )* + { #or_select_opt = + #(#[OR_SELECT_OPT, "OR_SELECT_OPT"], #or_select_opt); } + ; + +abort_stmt : a:ABORT^ name ( COMMA! name )* SEMI! + { Set (#a, ABORT_STATEMENT); } + ; + +except_handler_part_opt : ( EXCEPTION! ( exception_handler )+ )? + { #except_handler_part_opt = + #(#[EXCEPT_HANDLER_PART_OPT, + "EXCEPT_HANDLER_PART_OPT"], #except_handler_part_opt); } + ; + +exception_handler : w:WHEN^ identifier_colon_opt except_choice_s RIGHT_SHAFT! + statements + { Set (#w, EXCEPTION_HANDLER); } + ; + +identifier_colon_opt : ( IDENTIFIER COLON! )? + { #identifier_colon_opt = + #(#[IDENTIFIER_COLON_OPT, + "IDENTIFIER_COLON_OPT"], #identifier_colon_opt); } + ; + +except_choice_s : exception_choice ( PIPE^ exception_choice )* + ; + +exception_choice : compound_name + | OTHERS + ; + +raise_stmt : r:RAISE^ ( compound_name )? SEMI! + { Set (#r, RAISE_STATEMENT); } + ; + +requeue_stmt : r:REQUEUE^ name ( WITH! ABORT )? SEMI! + { Set (#r, REQUEUE_STATEMENT); } + ; + +operator_call : cs:CHAR_STRING^ operator_call_tail[#cs] + ; + +operator_call_tail [RefAdaAST opstr] + : LPAREN! { is_operator_symbol(opstr->getText().c_str()) }? + value_s RPAREN! { opstr->setType(OPERATOR_SYMBOL); } + ; + +value_s : value ( COMMA! value )* + { #value_s = #(#[VALUES, "VALUES"], #value_s); } + ; + +/* +literal : NUMERIC_LIT + | CHARACTER_LITERAL + | CHAR_STRING + | NuLL + ; + */ + +expression : relation + ( a:AND^ ( THEN! { Set (#a, AND_THEN); } )? relation + | o:OR^ ( ELSE! { Set (#o, OR_ELSE); } )? relation + | XOR^ relation + )* + ; + +relation : simple_expression + ( IN^ range_or_mark + | n:NOT^ IN! range_or_mark { Set (#n, NOT_IN); } + | EQ^ simple_expression + | NE^ simple_expression + | LT_^ simple_expression + | LE^ simple_expression + | GT^ simple_expression + | GE^ simple_expression + )? + ; + +range_or_mark : (range) => range + | subtype_mark + ; + +simple_expression : signed_term + ( PLUS^ signed_term + | MINUS^ signed_term + | CONCAT^ signed_term + )* + ; + +signed_term + : p:PLUS^ term { Set(#p, UNARY_PLUS); } + | m:MINUS^ term { Set(#m, UNARY_MINUS); } + | term + ; + +term : factor ( STAR^ factor + | DIV^ factor + | MOD^ factor + | REM^ factor + )* + ; + +factor : ( NOT^ primary + | ABS^ primary + | primary ( EXPON^ primary )? + ) + ; + +primary : ( name_or_qualified + | parenthesized_primary + | allocator + | NuLL + | NUMERIC_LIT + | CHARACTER_LITERAL + | cs:CHAR_STRING^ ( operator_call_tail[#cs] )? + ) + ; + +// Temporary, to be turned into just `qualified'. +// We get away with it because `qualified' is always mentioned +// together with `name'. +// Only exception: `code_stmt', which is not yet implemented. +name_or_qualified { RefAdaAST dummy; } + : IDENTIFIER + ( DOT^ ( ALL + | IDENTIFIER + | CHARACTER_LITERAL + | dummy=is_operator + ) + | p:LPAREN^ value_s RPAREN! + { Set(#p, INDEXED_COMPONENT); } + | TIC^ ( parenthesized_primary | attribute_id ) + )* + ; + +allocator : n:NEW^ name_or_qualified + { Set(#n, ALLOCATOR); } + ; + +subunit : sep:SEPARATE^ LPAREN! compound_name RPAREN! + { Set(#sep, SUBUNIT); } + ( subprogram_body + | package_body + | task_body + | protected_body + ) + ; + +subprogram_body + : p:PROCEDURE^ def_id[false] formal_part_opt IS! body_part SEMI! + { pop_def_id(); Set(#p, PROCEDURE_BODY); } + | f:FUNCTION^ def_designator[false] function_tail IS! body_part SEMI! + { pop_def_id(); Set(#f, FUNCTION_BODY); } + ; + +package_body : p:PACKAGE^ body_is pkg_body_part SEMI! + { Set(#p, PACKAGE_BODY); } + ; + +task_body : t:TASK^ body_is body_part SEMI! + { Set(#t, TASK_BODY); } + ; + +protected_body : p:PROTECTED^ body_is prot_op_bodies_opt end_id_opt SEMI! + { Set(#p, PROTECTED_BODY); } + ; + +// TBD +// code_stmt : qualified SEMI! +// ; + +//---------------------------------------------------------------------------- +// The Ada scanner +//---------------------------------------------------------------------------- +{ +#include "preambles.h" +} +class AdaLexer extends Lexer; + +options { + charVocabulary = '\3'..'\377'; + exportVocab = Ada; // call the vocabulary "Ada" + testLiterals = false; // don't automatically test for literals + k = 4; // number of characters of lookahead + caseSensitive = false; + caseSensitiveLiterals = false; + ///defaultErrorHandler = true; +} + +tokens { + // part 1: keywords + ABORT = "abort" ; + ABS = "abs" ; + ABSTRACT = "abstract" ; + ACCEPT = "accept" ; + ACCESS = "access" ; + ALIASED = "aliased" ; + ALL = "all" ; + AND = "and" ; + ARRAY = "array" ; + AT = "at" ; + BEGIN = "begin" ; + BODY = "body" ; + CASE = "case" ; + CONSTANT = "constant" ; + DECLARE = "declare" ; + DELAY = "delay" ; + DELTA = "delta" ; + DIGITS = "digits" ; + DO = "do" ; + ELSE = "else" ; + ELSIF = "elsif" ; + END = "end" ; + ENTRY = "entry" ; + EXCEPTION = "exception" ; + EXIT = "exit" ; + FOR = "for" ; + FUNCTION = "function" ; + GENERIC = "generic" ; + GOTO = "goto" ; + IF = "if" ; + IN = "in" ; + IS = "is" ; + LIMITED = "limited" ; + LOOP = "loop" ; + MOD = "mod" ; + NEW = "new" ; + NOT = "not" ; + NuLL = "null" ; + OF = "of" ; + OR = "or" ; + OTHERS = "others" ; + OUT = "out" ; + PACKAGE = "package" ; + PRAGMA = "pragma" ; + PRIVATE = "private" ; + PROCEDURE = "procedure" ; + PROTECTED = "protected" ; + RAISE = "raise" ; + RANGE = "range" ; + RECORD = "record" ; + REM = "rem" ; + RENAMES = "renames" ; + REQUEUE = "requeue" ; + RETURN = "return" ; + REVERSE = "reverse" ; + SELECT = "select" ; + SEPARATE = "separate" ; + SUBTYPE = "subtype" ; + TAGGED = "tagged" ; + TASK = "task" ; + TERMINATE = "terminate" ; + THEN = "then" ; + TYPE = "type" ; + UNTIL = "until" ; + USE = "use" ; + WHEN = "when" ; + WHILE = "while" ; + WITH = "with" ; + XOR = "xor" ; + + // part 2: RM tokens (synthetic) + ABORTABLE_PART; + ABORT_STATEMENT; + /*ABSTRACT_SUBPROGRAM_DECLARATION; => + ABSTRACT_{FUNCTION|PROCEDURE}_DECLARATION */ + ACCEPT_ALTERNATIVE; + ACCEPT_STATEMENT; + /* ACCESS_TO_FUNCTION_DEFINITION => ACCESS_TO_FUNCTION_DECLARATION */ + /* ACCESS_TO_OBJECT_DEFINITION => ACCESS_TO_OBJECT_DECLARATION */ + /* ACCESS_TO_PROCEDURE_DEFINITION => ACCESS_TO_PROCEDURE_DECLARATION */ + /* ACCESS_TYPE_DEFINITION => ACCESS_TYPE_DECLARATION */ + ALLOCATOR; + /* ARRAY_TYPE_DEFINITION => ARRAY_TYPE_DECLARATION */ + ASSIGNMENT_STATEMENT; + ASYNCHRONOUS_SELECT; + ATTRIBUTE_DEFINITION_CLAUSE; + AT_CLAUSE; + BLOCK_STATEMENT; + CASE_STATEMENT; + CASE_STATEMENT_ALTERNATIVE; + CODE_STATEMENT; + COMPONENT_DECLARATION; + // COMPONENT_LIST; // not currently used as an explicit node + // CONDITION; // not currently used + CONDITIONAL_ENTRY_CALL; + CONTEXT_CLAUSE; + /* DECIMAL_FIXED_POINT_DEFINITION => DECIMAL_FIXED_POINT_DECLARATION */ + // DECLARATIVE_ITEM; // not currently used + DECLARATIVE_PART; + DEFINING_IDENTIFIER_LIST; + DELAY_ALTERNATIVE; + DELAY_STATEMENT; + DELTA_CONSTRAINT; + /* DERIVED_TYPE_DEFINITION; => + DERIVED_RECORD_EXTENSION, ORDINARY_DERIVED_TYPE_DECLARATION */ + DIGITS_CONSTRAINT; + // DISCRETE_RANGE; // Not used; instead, directly use its RHS alternatives. + DISCRIMINANT_ASSOCIATION; + DISCRIMINANT_CONSTRAINT; + DISCRIMINANT_SPECIFICATION; + ENTRY_BODY; + ENTRY_CALL_ALTERNATIVE; + ENTRY_CALL_STATEMENT; + ENTRY_DECLARATION; + ENTRY_INDEX_SPECIFICATION; + ENUMERATION_REPESENTATION_CLAUSE; + /* ENUMERATION_TYPE_DEFINITION => ENUMERATION_TYPE_DECLARATION */ + EXCEPTION_DECLARATION; + EXCEPTION_HANDLER; + EXCEPTION_RENAMING_DECLARATION; + EXIT_STATEMENT; + /* FLOATING_POINT_DEFINITION => FLOATING_POINT_DECLARATION */ + /* FORMAL_ACCESS_TYPE_DEFINITION => FORMAL_ACCESS_TYPE_DECLARATION */ + /* FORMAL_ARRAY_TYPE_DEFINITION => FORMAL_ARRAY_TYPE_DECLARATION */ + /* FORMAL_DECIMAL_FIXED_POINT_DEFINITION => + FORMAL_DECIMAL_FIXED_POINT_DECLARATION */ + /* FORMAL_DERIVED_TYPE_DEFINITION => + FORMAL_{ORDINARY_DERIVED_TYPE|PRIVATE_EXTENSION}_DECLARATION */ + /* FORMAL_DISCRETE_TYPE_DEFINITION => FORMAL_DISCRETE_TYPE_DECLARATION */ + /* FORMAL_FLOATING_POINT_DEFINITION => + FORMAL_FLOATING_POINT_DECLARATION */ + /* FORMAL_MODULAR_TYPE_DEFINITION => FORMAL_MODULAR_TYPE_DECLARATION */ + /* FORMAL_ORDINARY_FIXED_POINT_DEFINITION => + FORMAL_ORDINARY_FIXED_POINT_DECLARATION */ + FORMAL_PACKAGE_DECLARATION; + /* FORMAL_PRIVATE_TYPE_DEFINITION => FORMAL_PRIVATE_TYPE_DECLARATION */ + /* FORMAL_SIGNED_INTEGER_TYPE_DEFINITION => + FORMAL_SIGNED_INTEGER_TYPE_DECLARATION */ + /* FORMAL_SUBPROGRAM_DECLARATION; => + FORMAL_{FUNCTION|PROCEDURE}_DECLARATION */ + /* FORMAL_TYPE_DECLARATION; not used, replaced by the corresponding + finer grained declarations */ + /* FORMAL_TYPE_DEFINITION; not used at all; we use declarations + not definitions */ + /* FULL_TYPE_DECLARATION; not used, replaced by the corresponding + finer grained declarations */ + GENERIC_FORMAL_PART; + /* GENERIC_INSTANTIATION; => + GENERIC_{FUNCTION|PACKAGE|PROCEDURE}_INSTANTIATION */ + GENERIC_PACKAGE_DECLARATION; + /* GENERIC_RENAMING_DECLARATION; => + GENERIC_{FUNCTION|PACKAGE|PROCEDURE}_RENAMING */ + /* GENERIC_SUBPROGRAM_DECLARATION; => + GENERIC_{FUNCTION|PROCEDURE}_DECLARATION */ + GOTO_STATEMENT; + HANDLED_SEQUENCE_OF_STATEMENTS; + HANDLED_STMTS_OPT; + IF_STATEMENT; + INCOMPLETE_TYPE_DECLARATION; + INDEXED_COMPONENT; + INDEX_CONSTRAINT; + LIBRARY_ITEM; + LOOP_STATEMENT; + /* MODULAR_TYPE_DEFINITION => MODULAR_TYPE_DECLARATION */ + NAME; + NULL_STATEMENT; + NUMBER_DECLARATION; + OBJECT_DECLARATION; + OBJECT_RENAMING_DECLARATION; + OPERATOR_SYMBOL; + /* ORDINARY_FIXED_POINT_DEFINITION => ORDINARY_FIXED_POINT_DECLARATION */ + PACKAGE_BODY; + PACKAGE_BODY_STUB; + PACKAGE_RENAMING_DECLARATION; + PACKAGE_SPECIFICATION; + PARAMETER_SPECIFICATION; + // PREFIX; // not used + // PRIMARY; // not used + PRIVATE_EXTENSION_DECLARATION; + PRIVATE_TYPE_DECLARATION; + // PROCEDURE_CALL_STATEMENT; // NYI, using CALL_STATEMENT for now. + PROTECTED_BODY; + PROTECTED_BODY_STUB; + PROTECTED_TYPE_DECLARATION; + RAISE_STATEMENT; + RANGE_ATTRIBUTE_REFERENCE; + RECORD_REPRESENTATION_CLAUSE; + /* RECORD_TYPE_DEFINITION => RECORD_TYPE_DECLARATION */ + REQUEUE_STATEMENT; + RETURN_STATEMENT; + SELECTIVE_ACCEPT; + /* SELECT_ALTERNATIVE; Not used - instead, we use the finer grained rules + ACCEPT_ALTERNATIVE | DELAY_ALTERNATIVE + | TERMINATE_ALTERNATIVE */ + /* SELECT_STATEMENT; Not used - instead, we use the finer grained rules + SELECTIVE_ACCEPT | TIMED_ENTRY_CALL + | CONDITIONAL_ENTRY_CALL | ASYNCHRONOUS_SELECT */ + SEQUENCE_OF_STATEMENTS; + /* SIGNED_INTEGER_TYPE_DEFINITION => SIGNED_INTEGER_TYPE_DECLARATION */ + SINGLE_PROTECTED_DECLARATION; + SINGLE_TASK_DECLARATION; + STATEMENT; + /* SUBPROGRAM_BODY; => {FUNCTION|PROCEDURE}_BODY */ + /* SUBPROGRAM_BODY_STUB; => {FUNCTION|PROCEDURE}_BODY_STUB */ + /* SUBPROGRAM_DECLARATION; => {FUNCTION|PROCEDURE}_DECLARATION */ + /* SUBPROGRAM_RENAMING_DECLARATION; => + {FUNCTION|PROCEDURE}_RENAMING_DECLARATION */ + SUBTYPE_DECLARATION; + SUBTYPE_INDICATION; + SUBTYPE_MARK; + SUBUNIT; + TASK_BODY; + TASK_BODY_STUB; + TASK_TYPE_DECLARATION; + TERMINATE_ALTERNATIVE; + TIMED_ENTRY_CALL; + TRIGGERING_ALTERNATIVE; + /* TYPE_DECLARATION; not used, replaced by the corresponding + finer grained declarations */ + USE_CLAUSE; + USE_TYPE_CLAUSE; + VARIANT; + VARIANT_PART; + WITH_CLAUSE; + + // part 3: Non-RM synthetic tokens. + // They exist mainly to normalize the node structure with respect to + // optional items. (Without them, the presence or absence of an optional + // item would change the node layout, but we want a fixed layout.) + ABSTRACT_FUNCTION_DECLARATION; + ABSTRACT_PROCEDURE_DECLARATION; + ACCESS_TO_FUNCTION_DECLARATION; + ACCESS_TO_OBJECT_DECLARATION; + ACCESS_TO_PROCEDURE_DECLARATION; + /* ACCESS_TYPE_DECLARATION; not used, replaced by + ACCESS_TO_{FUNCTION|OBJECT|PROCEDURE}_DECLARATION + */ + ARRAY_OBJECT_DECLARATION; + ARRAY_TYPE_DECLARATION; + AND_THEN; + BASIC_DECLARATIVE_ITEMS_OPT; + BLOCK_BODY; + BLOCK_BODY_OPT; + CALL_STATEMENT; // See {PROCEDURE|ENTRY}_CALL_STATEMENT + COMPONENT_CLAUSES_OPT; + COMPONENT_ITEMS; + COND_CLAUSE; + DECIMAL_FIXED_POINT_DECLARATION; + DECLARE_OPT; + DERIVED_RECORD_EXTENSION; + // DERIVED_TYPE_DECLARATION; // not used + DISCRETE_SUBTYPE_DEF_OPT; + DISCRIMINANT_SPECIFICATIONS; + DISCRIM_PART_OPT; + ELSE_OPT; + ELSIFS_OPT; + END_ID_OPT; + ENTRY_INDEX_OPT; + ENUMERATION_TYPE_DECLARATION; + EXCEPT_HANDLER_PART_OPT; + EXTENSION_OPT; + FLOATING_POINT_DECLARATION; + /* FORMAL_ACCESS_TYPE_DECLARATION => ACCESS_TYPE_DECLARATION */ + /* FORMAL_ARRAY_TYPE_DECLARATION => ARRAY_TYPE_DECLARATION */ + FORMAL_DECIMAL_FIXED_POINT_DECLARATION; + FORMAL_DISCRETE_TYPE_DECLARATION; + FORMAL_FLOATING_POINT_DECLARATION; + FORMAL_FUNCTION_DECLARATION; + FORMAL_MODULAR_TYPE_DECLARATION; + FORMAL_ORDINARY_DERIVED_TYPE_DECLARATION; + FORMAL_ORDINARY_FIXED_POINT_DECLARATION; + FORMAL_PART_OPT; + FORMAL_PRIVATE_EXTENSION_DECLARATION; + FORMAL_PRIVATE_TYPE_DECLARATION; + FORMAL_PROCEDURE_DECLARATION; + FORMAL_SIGNED_INTEGER_TYPE_DECLARATION; + FUNCTION_BODY; + FUNCTION_BODY_STUB; + FUNCTION_DECLARATION; + FUNCTION_RENAMING_DECLARATION; + GENERIC_FUNCTION_DECLARATION; + GENERIC_FUNCTION_INSTANTIATION; + GENERIC_FUNCTION_RENAMING; + GENERIC_PACKAGE_INSTANTIATION; + GENERIC_PACKAGE_RENAMING; + GENERIC_PROCEDURE_DECLARATION; + GENERIC_PROCEDURE_INSTANTIATION; + GENERIC_PROCEDURE_RENAMING; + GUARD_OPT; + IDENTIFIER_COLON_OPT; + ID_OPT; + INIT_OPT; + ITERATION_SCHEME_OPT; + LABEL_OPT; + MARK_WITH_CONSTRAINT; + MODIFIERS; /* Possible values: abstract access aliased all constant in + limited out private protected reverse tagged */ + MODULAR_TYPE_DECLARATION; + MOD_CLAUSE_OPT; + // NAME_OR_QUALIFIED; + NOT_IN; + ORDINARY_DERIVED_TYPE_DECLARATION; + ORDINARY_FIXED_POINT_DECLARATION; + OR_ELSE; + OR_SELECT_OPT; + PARENTHESIZED_PRIMARY; + // PARENTHESIZED_VALUES; + // PARENTHESIZED_VALUES_OPT; + PRIVATE_DECLARATIVE_ITEMS_OPT; + PRIVATE_TASK_ITEMS_OPT; + PROCEDURE_BODY; + PROCEDURE_BODY_STUB; + PROCEDURE_DECLARATION; + PROCEDURE_RENAMING_DECLARATION; + PROT_MEMBER_DECLARATIONS; + PROT_OP_BODIES_OPT; + PROT_OP_DECLARATIONS; + PROT_PRIVATE_OPT; + RANGED_EXPRS; // ugh, what an ugly name + RANGE_CONSTRAINT; + RECORD_TYPE_DECLARATION; + SELECTOR_NAMES_OPT; + SIGNED_INTEGER_TYPE_DECLARATION; + TASK_ITEMS_OPT; + UNARY_MINUS; + UNARY_PLUS; + VALUE; + VALUES; + VARIANTS; +} + +{ + ANTLR_LEXER_PREAMBLE + private: + bool lastTokenWasTicCompatible; +} + +//---------------------------------------------------------------------------- +// OPERATORS +//---------------------------------------------------------------------------- +COMMENT_INTRO : "--" {lastTokenWasTicCompatible=false;}; +DOT_DOT : ".." {lastTokenWasTicCompatible=false;}; +LT_LT : "<<" {lastTokenWasTicCompatible=false;}; +OX : "<>" {lastTokenWasTicCompatible=false;}; +GT_GT : ">>" {lastTokenWasTicCompatible=false;}; +ASSIGN : ":=" {lastTokenWasTicCompatible=false;}; +RIGHT_SHAFT : "=>" {lastTokenWasTicCompatible=false;}; +NE : "/=" {lastTokenWasTicCompatible=false;}; +LE : "<=" {lastTokenWasTicCompatible=false;}; +GE : ">=" {lastTokenWasTicCompatible=false;}; +EXPON : "**" {lastTokenWasTicCompatible=false;}; +PIPE : '|' {lastTokenWasTicCompatible=false;}; +CONCAT : '&' {lastTokenWasTicCompatible=false;}; +DOT : '.' {lastTokenWasTicCompatible=false;}; +EQ : '=' {lastTokenWasTicCompatible=false;}; +LT_ : '<' {lastTokenWasTicCompatible=false;}; +GT : '>' {lastTokenWasTicCompatible=false;}; +PLUS : '+' {lastTokenWasTicCompatible=false;}; +MINUS : '-' {lastTokenWasTicCompatible=false;}; +STAR : '*' {lastTokenWasTicCompatible=false;}; +DIV : '/' {lastTokenWasTicCompatible=false;}; +LPAREN : '(' {lastTokenWasTicCompatible=false;}; +RPAREN : ')' {lastTokenWasTicCompatible=true;}; +COLON : ':' {lastTokenWasTicCompatible=false;}; +COMMA : ',' {lastTokenWasTicCompatible=false;}; +SEMI : ';' {lastTokenWasTicCompatible=false;}; + + +// Literals. + +// Rule for IDENTIFIER: testLiterals is set to true. This means that +// after we match the rule, we look in the literals table to see if +// it's a keyword or really an identifier. +IDENTIFIER + options {testLiterals=true;} + : ( 'a'..'z' ) ( ('_')? ( 'a'..'z'|'0'..'9' ) )* + ; + +TIC_OR_CHARACTER_LITERAL : + "'"! { $setType(TIC); } ( + { ! lastTokenWasTicCompatible }? . "'"! + { $setType(CHARACTER_LITERAL); } + )? + {lastTokenWasTicCompatible=false;}; + +CHAR_STRING : '"'! ("\"\"" | ~('"'))* '"'! + {lastTokenWasTicCompatible=true;}; + +NUMERIC_LIT : ( DIGIT )+ + ( '#' BASED_INTEGER ( '.' BASED_INTEGER )? '#' + | ( '_' ( DIGIT )+ )+ // INTEGER + )? + ( { LA(2)!='.' }? //&& LA(3)!='.' }? + ( '.' ( DIGIT )+ ( '_' ( DIGIT )+ )* ( EXPONENT )? + | EXPONENT + ) + )? + {lastTokenWasTicCompatible=false;}; + +// a couple protected methods to assist in matching the various numbers + +protected +DIGIT : ( '0'..'9' ) {lastTokenWasTicCompatible=false;}; + +protected +EXPONENT : ('e') ('+'|'-')? ( DIGIT )+ {lastTokenWasTicCompatible=false;}; + +protected +EXTENDED_DIGIT : ( DIGIT | 'a'..'f' ) {lastTokenWasTicCompatible=false;}; + +protected +BASED_INTEGER : ( EXTENDED_DIGIT ) ( ('_')? EXTENDED_DIGIT )* {lastTokenWasTicCompatible=false;}; + + +// Whitespace -- ignored +WS_ : ( ' ' + | '\t' + | '\f' + // handle newlines + | ( "\r\n" // Evil DOS + | '\r' // Macintosh + | '\n' // Unix (the right way) + ) + { newline(); } + ) + { $setType(antlr::Token::SKIP); } + ; + +// Single-line comments +COMMENT : COMMENT_INTRO (~('\n'|'\r'))* ('\n'|'\r'('\n')?) + { $setType(antlr::Token::SKIP); + newline(); + lastTokenWasTicCompatible=false; } + ; + |