From 08a057e64bb74f4194a216f6693e04b1ad230f48 Mon Sep 17 00:00:00 2001
From: Tom Tromey <tom@tromey.com>
Date: Mon, 8 Mar 2021 07:27:57 -0700
Subject: [PATCH] Convert ada-exp.y to use operations

This converts the Ada parser to generate operations rather than
exp_elements.

This was the most difficult of the parser conversions, partly due to
the decision to integrate Ada expression resolution into the parse,
and partly due to Ada aggregregate assignment.  A couple of new
per-parse globals are introduced, along with a number of helper
functions.  Resolution is done in 'ada_pop', yielding the unfortunate
rule that ada-exp.y should generally not use parser_state::pop
(exceptions are marked).

gdb/ChangeLog
2021-03-08  Tom Tromey  <tom@tromey.com>

	* ada-exp.y: Create operations.
	(empty_stoken): Remove.
	(ada_pop, ada_wrap, ada_addrof, ada_un_wrap2, ada_wrap2)
	(ada_wrap_op, ada_wrap3, ada_funcall): New functions.
	(components): New global.
	(push_component, choice_component, pop_component, pop_components):
	New functions.
	(associations): New global
	(push_association, pop_association, pop_associations): New
	functions.
	(ada_parse): Update.
	(write_var_from_sym, write_int): Create operations.
	(write_exp_op_with_string): Remove.
	(write_object_renaming, write_selectors, write_ambiguous_var)
	(write_var_or_type, write_name_assoc): Create operations.
	* ada-lang.h (ada_index_type): Declare.
	* ada-lang.c (ada_index_type): No longer static.
---
 gdb/ChangeLog  |  20 ++
 gdb/ada-exp.y  | 656 ++++++++++++++++++++++++++++++++++---------------
 gdb/ada-lang.c |   8 +-
 gdb/ada-lang.h |   8 +
 4 files changed, 483 insertions(+), 209 deletions(-)

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 3af105597cf..5ecd54e7a06 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,23 @@
+2021-03-08  Tom Tromey  <tom@tromey.com>
+
+	* ada-exp.y: Create operations.
+	(empty_stoken): Remove.
+	(ada_pop, ada_wrap, ada_addrof, ada_un_wrap2, ada_wrap2)
+	(ada_wrap_op, ada_wrap3, ada_funcall): New functions.
+	(components): New global.
+	(push_component, choice_component, pop_component, pop_components):
+	New functions.
+	(associations): New global
+	(push_association, pop_association, pop_associations): New
+	functions.
+	(ada_parse): Update.
+	(write_var_from_sym, write_int): Create operations.
+	(write_exp_op_with_string): Remove.
+	(write_object_renaming, write_selectors, write_ambiguous_var)
+	(write_var_or_type, write_name_assoc): Create operations.
+	* ada-lang.h (ada_index_type): Declare.
+	* ada-lang.c (ada_index_type): No longer static.
+
 2021-03-08  Tom Tromey  <tom@tromey.com>
 
 	* f-exp.y: Create operations.
diff --git a/gdb/ada-exp.y b/gdb/ada-exp.y
index 36375d9b8b3..de88c863cff 100644
--- a/gdb/ada-exp.y
+++ b/gdb/ada-exp.y
@@ -47,6 +47,7 @@
 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
 #include "frame.h"
 #include "block.h"
+#include "ada-exp.h"
 
 #define parse_type(ps) builtin_type (ps->gdbarch ())
 
@@ -67,8 +68,6 @@ struct name_info {
 
 static struct parser_state *pstate = NULL;
 
-static struct stoken empty_stoken = { "", 0 };
-
 /* If expression is in the context of TYPE'(...), then TYPE, else
  * NULL.  */
 static struct type *type_qualifier;
@@ -90,9 +89,6 @@ static struct type* write_var_or_type (struct parser_state *,
 
 static void write_name_assoc (struct parser_state *, struct stoken);
 
-static void write_exp_op_with_string (struct parser_state *, enum exp_opcode,
-				      struct stoken);
-
 static const struct block *block_lookup (const struct block *, const char *);
 
 static LONGEST convert_char_literal (struct type *, LONGEST);
@@ -114,6 +110,233 @@ static struct type *type_boolean (struct parser_state *);
 
 static struct type *type_system_address (struct parser_state *);
 
+using namespace expr;
+
+/* Handle Ada type resolution for OP.  DEPROCEDURE_P and CONTEXT_TYPE
+   are passed to the resolve method, if called.  */
+static operation_up
+resolve (operation_up &&op, bool deprocedure_p, struct type *context_type)
+{
+  operation_up result = std::move (op);
+  ada_resolvable *res = dynamic_cast<ada_resolvable *> (result.get ());
+  if (res != nullptr
+      && res->resolve (pstate->expout.get (),
+		       deprocedure_p,
+		       pstate->parse_completion,
+		       pstate->block_tracker,
+		       context_type))
+    result
+      = make_operation<ada_funcall_operation> (std::move (result),
+					       std::vector<operation_up> ());
+
+  return result;
+}
+
+/* Like parser_state::pop, but handles Ada type resolution.
+   DEPROCEDURE_P and CONTEXT_TYPE are passed to the resolve method, if
+   called.  */
+static operation_up
+ada_pop (bool deprocedure_p = true, struct type *context_type = nullptr)
+{
+  /* Of course it's ok to call parser_state::pop here... */
+  return resolve (pstate->pop (), deprocedure_p, context_type);
+}
+
+/* Like parser_state::wrap, but use ada_pop to pop the value.  */
+template<typename T>
+void
+ada_wrap ()
+{
+  operation_up arg = ada_pop ();
+  pstate->push_new<T> (std::move (arg));
+}
+
+/* Create and push an address-of operation, as appropriate for Ada.
+   If TYPE is not NULL, the resulting operation will be wrapped in a
+   cast to TYPE.  */
+static void
+ada_addrof (struct type *type = nullptr)
+{
+  operation_up arg = ada_pop (false);
+  operation_up addr = make_operation<unop_addr_operation> (std::move (arg));
+  operation_up wrapped
+    = make_operation<ada_wrapped_operation> (std::move (addr));
+  if (type != nullptr)
+    wrapped = make_operation<unop_cast_operation> (std::move (wrapped), type);
+  pstate->push (std::move (wrapped));
+}
+
+/* A variant of parser_state::wrap2 that uses ada_pop to pop both
+   operands, and then pushes a new Ada-wrapped operation of the
+   template type T.  */
+template<typename T>
+void
+ada_un_wrap2 ()
+{
+  operation_up rhs = ada_pop ();
+  operation_up lhs = ada_pop ();
+  operation_up wrapped = make_operation<T> (std::move (lhs), std::move (rhs));
+  pstate->push_new<ada_wrapped_operation> (std::move (wrapped));
+}
+
+/* A variant of parser_state::wrap2 that uses ada_pop to pop both
+   operands.  Unlike ada_un_wrap2, ada_wrapped_operation is not
+   used.  */
+template<typename T>
+void
+ada_wrap2 ()
+{
+  operation_up rhs = ada_pop ();
+  operation_up lhs = ada_pop ();
+  pstate->push_new<T> (std::move (lhs), std::move (rhs));
+}
+
+/* A variant of parser_state::wrap2 that uses ada_pop to pop both
+   operands.  OP is also passed to the constructor of the new binary
+   operation.  */
+template<typename T>
+void
+ada_wrap_op (enum exp_opcode op)
+{
+  operation_up rhs = ada_pop ();
+  operation_up lhs = ada_pop ();
+  pstate->push_new<T> (op, std::move (lhs), std::move (rhs));
+}
+
+/* Pop three operands using ada_pop, then construct a new ternary
+   operation of type T and push it.  */
+template<typename T>
+void
+ada_wrap3 ()
+{
+  operation_up rhs = ada_pop ();
+  operation_up mid = ada_pop ();
+  operation_up lhs = ada_pop ();
+  pstate->push_new<T> (std::move (lhs), std::move (mid), std::move (rhs));
+}
+
+/* Pop NARGS operands, then a callee operand, and use these to
+   construct and push a new Ada function call operation.  */
+static void
+ada_funcall (int nargs)
+{
+  /* We use the ordinary pop here, because we're going to do
+     resolution in a separate step, in order to handle array
+     indices.  */
+  std::vector<operation_up> args = pstate->pop_vector (nargs);
+  /* Call parser_state::pop here, because we don't want to
+     function-convert the callee slot of a call we're already
+     constructing.  */
+  operation_up callee = pstate->pop ();
+
+  ada_var_value_operation *vvo
+    = dynamic_cast<ada_var_value_operation *> (callee.get ());
+  int array_arity = 0;
+  struct type *callee_t = nullptr;
+  if (vvo == nullptr
+      || SYMBOL_DOMAIN (vvo->get_symbol ()) != UNDEF_DOMAIN)
+    {
+      struct value *callee_v = callee->evaluate (nullptr,
+						 pstate->expout.get (),
+						 EVAL_AVOID_SIDE_EFFECTS);
+      callee_t = ada_check_typedef (value_type (callee_v));
+      array_arity = ada_array_arity (callee_t);
+    }
+
+  for (int i = 0; i < nargs; ++i)
+    {
+      struct type *subtype = nullptr;
+      if (i < array_arity)
+	subtype = ada_index_type (callee_t, i + 1, "array type");
+      args[i] = resolve (std::move (args[i]), true, subtype);
+    }
+
+  std::unique_ptr<ada_funcall_operation> funcall
+    (new ada_funcall_operation (std::move (callee), std::move (args)));
+  funcall->resolve (pstate->expout.get (), true, pstate->parse_completion,
+		    pstate->block_tracker, nullptr);
+  pstate->push (std::move (funcall));
+}
+
+/* The components being constructed during this parse.  */
+static std::vector<ada_component_up> components;
+
+/* Create a new ada_component_up of the indicated type and arguments,
+   and push it on the global 'components' vector.  */
+template<typename T, typename... Arg>
+void
+push_component (Arg... args)
+{
+  components.emplace_back (new T (std::forward<Arg> (args)...));
+}
+
+/* Examine the final element of the 'components' vector, and return it
+   as a pointer to an ada_choices_component.  The caller is
+   responsible for ensuring that the final element is in fact an
+   ada_choices_component.  */
+static ada_choices_component *
+choice_component ()
+{
+  ada_component *last = components.back ().get ();
+  ada_choices_component *result = dynamic_cast<ada_choices_component *> (last);
+  gdb_assert (result != nullptr);
+  return result;
+}
+
+/* Pop the most recent component from the global stack, and return
+   it.  */
+static ada_component_up
+pop_component ()
+{
+  ada_component_up result = std::move (components.back ());
+  components.pop_back ();
+  return result;
+}
+
+/* Pop the N most recent components from the global stack, and return
+   them in a vector.  */
+static std::vector<ada_component_up>
+pop_components (int n)
+{
+  std::vector<ada_component_up> result (n);
+  for (int i = 1; i <= n; ++i)
+    result[n - i] = pop_component ();
+  return result;
+}
+
+/* The associations being constructed during this parse.  */
+static std::vector<ada_association_up> associations;
+
+/* Create a new ada_association_up of the indicated type and
+   arguments, and push it on the global 'associations' vector.  */
+template<typename T, typename... Arg>
+void
+push_association (Arg... args)
+{
+  associations.emplace_back (new T (std::forward<Arg> (args)...));
+}
+
+/* Pop the most recent association from the global stack, and return
+   it.  */
+static ada_association_up
+pop_association ()
+{
+  ada_association_up result = std::move (associations.back ());
+  associations.pop_back ();
+  return result;
+}
+
+/* Pop the N most recent associations from the global stack, and
+   return them in a vector.  */
+static std::vector<ada_association_up>
+pop_associations (int n)
+{
+  std::vector<ada_association_up> result (n);
+  for (int i = 1; i <= n; ++i)
+    result[n - i] = pop_association ();
+  return result;
+}
+
 %}
 
 %union
@@ -135,7 +358,7 @@ static struct type *type_system_address (struct parser_state *);
 
 %type <lval> positional_list component_groups component_associations
 %type <lval> aggregate_component_list 
-%type <tval> var_or_type
+%type <tval> var_or_type type_prefix opt_type_prefix
 
 %token <typed_val> INT NULL_PTR CHARLIT
 %token <typed_val_float> FLOAT
@@ -188,43 +411,38 @@ start   :	exp1
 /* Expressions, including the sequencing operator.  */
 exp1	:	exp
 	|	exp1 ';' exp
-			{ write_exp_elt_opcode (pstate, BINOP_COMMA); }
+			{ ada_wrap2<comma_operation> (); }
 	| 	primary ASSIGN exp   /* Extension for convenience */
-			{ write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
+			{ ada_wrap2<ada_assign_operation> (); }
 	;
 
 /* Expressions, not including the sequencing operator.  */
 primary :	primary DOT_ALL
-			{ write_exp_elt_opcode (pstate, UNOP_IND); }
+			{ ada_wrap<ada_unop_ind_operation> (); }
 	;
 
 primary :	primary DOT_ID
-			{ write_exp_op_with_string (pstate, STRUCTOP_STRUCT,
-						    $2); }
+			{
+			  operation_up arg = ada_pop ();
+			  pstate->push_new<ada_structop_operation>
+			    (std::move (arg), copy_name ($2));
+			}
 	;
 
 primary :	primary '(' arglist ')'
-			{
-			  write_exp_elt_opcode (pstate, OP_FUNCALL);
-			  write_exp_elt_longcst (pstate, $3);
-			  write_exp_elt_opcode (pstate, OP_FUNCALL);
-			}
+			{ ada_funcall ($3); }
 	|	var_or_type '(' arglist ')'
 			{
 			  if ($1 != NULL)
 			    {
 			      if ($3 != 1)
 				error (_("Invalid conversion"));
-			      write_exp_elt_opcode (pstate, UNOP_CAST);
-			      write_exp_elt_type (pstate, $1);
-			      write_exp_elt_opcode (pstate, UNOP_CAST);
+			      operation_up arg = ada_pop ();
+			      pstate->push_new<unop_cast_operation>
+				(std::move (arg), $1);
 			    }
 			  else
-			    {
-			      write_exp_elt_opcode (pstate, OP_FUNCALL);
-			      write_exp_elt_longcst (pstate, $3);
-			      write_exp_elt_opcode (pstate, OP_FUNCALL);
-			    }
+			    ada_funcall ($3);
 			}
 	;
 
@@ -233,9 +451,10 @@ primary :	var_or_type '\'' save_qualifier { type_qualifier = $1; }
 			{
 			  if ($1 == NULL)
 			    error (_("Type required for qualification"));
-			  write_exp_elt_opcode (pstate, UNOP_QUAL);
-			  write_exp_elt_type (pstate, $1);
-			  write_exp_elt_opcode (pstate, UNOP_QUAL);
+			  operation_up arg = ada_pop (true,
+						      check_typedef ($1));
+			  pstate->push_new<ada_qual_operation>
+			    (std::move (arg), $1);
 			  type_qualifier = $3;
 			}
 	;
@@ -245,10 +464,10 @@ save_qualifier : 	{ $$ = type_qualifier; }
 
 primary :
 		primary '(' simple_exp DOTDOT simple_exp ')'
-			{ write_exp_elt_opcode (pstate, TERNOP_SLICE); }
+			{ ada_wrap3<ada_ternop_slice_operation> (); }
 	|	var_or_type '(' simple_exp DOTDOT simple_exp ')'
 			{ if ($1 == NULL) 
-			    write_exp_elt_opcode (pstate, TERNOP_SLICE);
+			    ada_wrap3<ada_ternop_slice_operation> ();
 			  else
 			    error (_("Cannot slice a type"));
 			}
@@ -267,38 +486,40 @@ primary :	'(' exp1 ')'	{ }
 
 primary :	var_or_type	%prec VAR
 			{ if ($1 != NULL)
-			    {
-			      write_exp_elt_opcode (pstate, OP_TYPE);
-			      write_exp_elt_type (pstate, $1);
-			      write_exp_elt_opcode (pstate, OP_TYPE);
-			    }
+			    pstate->push_new<type_operation> ($1);
 			}
 	;
 
 primary :	DOLLAR_VARIABLE /* Various GDB extensions */
-			{ write_dollar_variable (pstate, $1); }
+			{ pstate->push_dollar ($1); }
 	;
 
 primary :     	aggregate
+			{
+			  pstate->push_new<ada_aggregate_operation>
+			    (pop_component ());
+			}
 	;        
 
 simple_exp : 	primary
 	;
 
 simple_exp :	'-' simple_exp    %prec UNARY
-			{ write_exp_elt_opcode (pstate, UNOP_NEG); }
+			{ ada_wrap<ada_neg_operation> (); }
 	;
 
 simple_exp :	'+' simple_exp    %prec UNARY
-			{ write_exp_elt_opcode (pstate, UNOP_PLUS); }
+			{
+			  /* No need to do anything.  */
+			}
 	;
 
 simple_exp :	NOT simple_exp    %prec UNARY
-			{ write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
+			{ ada_wrap<unary_logical_not_operation> (); }
 	;
 
 simple_exp :    ABS simple_exp	   %prec UNARY
-			{ write_exp_elt_opcode (pstate, UNOP_ABS); }
+			{ ada_wrap<ada_abs_operation> (); }
 	;
 
 arglist	:		{ $$ = 0; }
@@ -319,111 +540,114 @@ primary :	'{' var_or_type '}' primary  %prec '.'
 			{ 
 			  if ($2 == NULL)
 			    error (_("Type required within braces in coercion"));
-			  write_exp_elt_opcode (pstate, UNOP_MEMVAL);
-			  write_exp_elt_type (pstate, $2);
-			  write_exp_elt_opcode (pstate, UNOP_MEMVAL);
+			  operation_up arg = ada_pop ();
+			  pstate->push_new<unop_memval_operation>
+			    (std::move (arg), $2);
 			}
 	;
 
 /* Binary operators in order of decreasing precedence.  */
 
 simple_exp 	: 	simple_exp STARSTAR simple_exp
-			{ write_exp_elt_opcode (pstate, BINOP_EXP); }
+			{ ada_wrap2<ada_binop_exp_operation> (); }
 	;
 
 simple_exp	:	simple_exp '*' simple_exp
-			{ write_exp_elt_opcode (pstate, BINOP_MUL); }
+			{ ada_wrap2<ada_binop_mul_operation> (); }
 	;
 
 simple_exp	:	simple_exp '/' simple_exp
-			{ write_exp_elt_opcode (pstate, BINOP_DIV); }
+			{ ada_wrap2<ada_binop_div_operation> (); }
 	;
 
 simple_exp	:	simple_exp REM simple_exp /* May need to be fixed to give correct Ada REM */
-			{ write_exp_elt_opcode (pstate, BINOP_REM); }
+			{ ada_wrap2<ada_binop_rem_operation> (); }
 	;
 
 simple_exp	:	simple_exp MOD simple_exp
-			{ write_exp_elt_opcode (pstate, BINOP_MOD); }
+			{ ada_wrap2<ada_binop_mod_operation> (); }
 	;
 
 simple_exp	:	simple_exp '@' simple_exp	/* GDB extension */
-			{ write_exp_elt_opcode (pstate, BINOP_REPEAT); }
+			{ ada_wrap2<repeat_operation> (); }
 	;
 
 simple_exp	:	simple_exp '+' simple_exp
-			{ write_exp_elt_opcode (pstate, BINOP_ADD); }
+			{ ada_wrap_op<ada_binop_addsub_operation> (BINOP_ADD); }
 	;
 
 simple_exp	:	simple_exp '&' simple_exp
-			{ write_exp_elt_opcode (pstate, BINOP_CONCAT); }
+			{ ada_wrap2<concat_operation> (); }
 	;
 
 simple_exp	:	simple_exp '-' simple_exp
-			{ write_exp_elt_opcode (pstate, BINOP_SUB); }
+			{ ada_wrap_op<ada_binop_addsub_operation> (BINOP_SUB); }
 	;
 
 relation :	simple_exp
 	;
 
 relation :	simple_exp '=' simple_exp
-			{ write_exp_elt_opcode (pstate, BINOP_EQUAL); }
+			{ ada_wrap_op<ada_binop_equal_operation> (BINOP_EQUAL); }
 	;
 
 relation :	simple_exp NOTEQUAL simple_exp
-			{ write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
+			{ ada_wrap_op<ada_binop_equal_operation> (BINOP_NOTEQUAL); }
 	;
 
 relation :	simple_exp LEQ simple_exp
-			{ write_exp_elt_opcode (pstate, BINOP_LEQ); }
+			{ ada_un_wrap2<leq_operation> (); }
 	;
 
 relation :	simple_exp IN simple_exp DOTDOT simple_exp
-			{ write_exp_elt_opcode (pstate, TERNOP_IN_RANGE); }
+			{ ada_wrap3<ada_ternop_range_operation> (); }
 	|       simple_exp IN primary TICK_RANGE tick_arglist
-			{ write_exp_elt_opcode (pstate, BINOP_IN_BOUNDS);
-			  write_exp_elt_longcst (pstate, (LONGEST) $5);
-			  write_exp_elt_opcode (pstate, BINOP_IN_BOUNDS);
+			{
+			  operation_up rhs = ada_pop ();
+			  operation_up lhs = ada_pop ();
+			  pstate->push_new<ada_binop_in_bounds_operation>
+			    (std::move (lhs), std::move (rhs), $5);
 			}
  	|	simple_exp IN var_or_type	%prec TICK_ACCESS
 			{ 
 			  if ($3 == NULL)
 			    error (_("Right operand of 'in' must be type"));
-			  write_exp_elt_opcode (pstate, UNOP_IN_RANGE);
-			  write_exp_elt_type (pstate, $3);
-			  write_exp_elt_opcode (pstate, UNOP_IN_RANGE);
+			  operation_up arg = ada_pop ();
+			  pstate->push_new<ada_unop_range_operation>
+			    (std::move (arg), $3);
 			}
 	|	simple_exp NOT IN simple_exp DOTDOT simple_exp
-			{ write_exp_elt_opcode (pstate, TERNOP_IN_RANGE);
-			  write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT);
-			}
+			{ ada_wrap3<ada_ternop_range_operation> ();
+			  ada_wrap<unary_logical_not_operation> (); }
 	|       simple_exp NOT IN primary TICK_RANGE tick_arglist
-			{ write_exp_elt_opcode (pstate, BINOP_IN_BOUNDS);
-			  write_exp_elt_longcst (pstate, (LONGEST) $6);
-			  write_exp_elt_opcode (pstate, BINOP_IN_BOUNDS);
-			  write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT);
+			{
+			  operation_up rhs = ada_pop ();
+			  operation_up lhs = ada_pop ();
+			  pstate->push_new<ada_binop_in_bounds_operation>
+			    (std::move (lhs), std::move (rhs), $6);
+			  ada_wrap<unary_logical_not_operation> ();
 			}
  	|	simple_exp NOT IN var_or_type	%prec TICK_ACCESS
 			{ 
 			  if ($4 == NULL)
 			    error (_("Right operand of 'in' must be type"));
-			  write_exp_elt_opcode (pstate, UNOP_IN_RANGE);
-			  write_exp_elt_type (pstate, $4);
-			  write_exp_elt_opcode (pstate, UNOP_IN_RANGE);
-			  write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT);
+			  operation_up arg = ada_pop ();
+			  pstate->push_new<ada_unop_range_operation>
+			    (std::move (arg), $4);
+			  ada_wrap<unary_logical_not_operation> ();
 			}
 	;
 
 relation :	simple_exp GEQ simple_exp
-			{ write_exp_elt_opcode (pstate, BINOP_GEQ); }
+			{ ada_un_wrap2<geq_operation> (); }
 	;
 
 relation :	simple_exp '<' simple_exp
-			{ write_exp_elt_opcode (pstate, BINOP_LESS); }
+			{ ada_un_wrap2<less_operation> (); }
 	;
 
 relation :	simple_exp '>' simple_exp
-			{ write_exp_elt_opcode (pstate, BINOP_GTR); }
+			{ ada_un_wrap2<gtr_operation> (); }
 	;
 
 exp	:	relation
@@ -436,36 +660,36 @@ exp	:	relation
 
 and_exp :
 		relation _AND_ relation 
-			{ write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
+			{ ada_wrap2<ada_bitwise_and_operation> (); }
 	|	and_exp _AND_ relation
-			{ write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
+			{ ada_wrap2<ada_bitwise_and_operation> (); }
 	;
 
 and_then_exp :
 	       relation _AND_ THEN relation
-			{ write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
+			{ ada_wrap2<logical_and_operation> (); }
 	|	and_then_exp _AND_ THEN relation
-			{ write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
+			{ ada_wrap2<logical_and_operation> (); }
 	;
 
 or_exp :
 		relation OR relation 
-			{ write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
+			{ ada_wrap2<ada_bitwise_ior_operation> (); }
 	|	or_exp OR relation
-			{ write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
+			{ ada_wrap2<ada_bitwise_ior_operation> (); }
 	;
 
 or_else_exp :
 	       relation OR ELSE relation
-			{ write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
+			{ ada_wrap2<logical_or_operation> (); }
 	|      or_else_exp OR ELSE relation
-			{ write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
+			{ ada_wrap2<logical_or_operation> (); }
 	;
 
 xor_exp :       relation XOR relation
-			{ write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
+			{ ada_wrap2<ada_bitwise_xor_operation> (); }
 	|	xor_exp XOR relation
-			{ write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
+			{ ada_wrap2<ada_bitwise_xor_operation> (); }
 	;
 
 /* Primaries can denote types (OP_TYPE).  In cases such as 
@@ -477,37 +701,51 @@ xor_exp :       relation XOR relation
    aType'access evaluates to a type that evaluate_subexp attempts to 
    evaluate. */
 primary :	primary TICK_ACCESS
-			{ write_exp_elt_opcode (pstate, UNOP_ADDR); }
+			{ ada_addrof (); }
 	|	primary TICK_ADDRESS
-			{ write_exp_elt_opcode (pstate, UNOP_ADDR);
-			  write_exp_elt_opcode (pstate, UNOP_CAST);
-			  write_exp_elt_type (pstate,
-					      type_system_address (pstate));
-			  write_exp_elt_opcode (pstate, UNOP_CAST);
-			}
+			{ ada_addrof (type_system_address (pstate)); }
 	|	primary TICK_FIRST tick_arglist
-			{ write_int (pstate, $3, type_int (pstate));
-			  write_exp_elt_opcode (pstate, OP_ATR_FIRST); }
+			{
+			  operation_up arg = ada_pop ();
+			  pstate->push_new<ada_unop_atr_operation>
+			    (std::move (arg), OP_ATR_FIRST, $3);
+			}
 	|	primary TICK_LAST tick_arglist
-			{ write_int (pstate, $3, type_int (pstate));
-			  write_exp_elt_opcode (pstate, OP_ATR_LAST); }
+			{
+			  operation_up arg = ada_pop ();
+			  pstate->push_new<ada_unop_atr_operation>
+			    (std::move (arg), OP_ATR_LAST, $3);
+			}
 	| 	primary TICK_LENGTH tick_arglist
-			{ write_int (pstate, $3, type_int (pstate));
-			  write_exp_elt_opcode (pstate, OP_ATR_LENGTH); }
+			{
+			  operation_up arg = ada_pop ();
+			  pstate->push_new<ada_unop_atr_operation>
+			    (std::move (arg), OP_ATR_LENGTH, $3);
+			}
 	|       primary TICK_SIZE
-			{ write_exp_elt_opcode (pstate, OP_ATR_SIZE); }
+			{ ada_wrap<ada_atr_size_operation> (); }
 	|	primary TICK_TAG
-			{ write_exp_elt_opcode (pstate, OP_ATR_TAG); }
+			{ ada_wrap<ada_atr_tag_operation> (); }
 	|       opt_type_prefix TICK_MIN '(' exp ',' exp ')'
-			{ write_exp_elt_opcode (pstate, OP_ATR_MIN); }
+			{ ada_wrap2<ada_binop_min_operation> (); }
 	|       opt_type_prefix TICK_MAX '(' exp ',' exp ')'
-			{ write_exp_elt_opcode (pstate, OP_ATR_MAX); }
+			{ ada_wrap2<ada_binop_max_operation> (); }
 	| 	opt_type_prefix TICK_POS '(' exp ')'
-			{ write_exp_elt_opcode (pstate, OP_ATR_POS); }
+			{ ada_wrap<ada_pos_operation> (); }
 	|	type_prefix TICK_VAL '(' exp ')'
-			{ write_exp_elt_opcode (pstate, OP_ATR_VAL); }
+			{
+			  operation_up arg = ada_pop ();
+			  pstate->push_new<ada_atr_val_operation>
+			    ($1, std::move (arg));
+			}
 	|	type_prefix TICK_MODULUS
-			{ write_exp_elt_opcode (pstate, OP_ATR_MODULUS); }
+			{
+			  struct type *type_arg = check_typedef ($1);
+			  if (!ada_is_modular_type (type_arg))
+			    error (_("'modulus must be applied to modular type"));
+			  write_int (pstate, ada_modulus (type_arg),
+				     TYPE_TARGET_TYPE (type_arg));
+			}
 	;
 
 tick_arglist :			%prec '('
@@ -521,18 +759,15 @@ type_prefix :
 			{ 
 			  if ($1 == NULL)
 			    error (_("Prefix must be type"));
-			  write_exp_elt_opcode (pstate, OP_TYPE);
-			  write_exp_elt_type (pstate, $1);
-			  write_exp_elt_opcode (pstate, OP_TYPE); }
+			  $$ = $1;
+			}
 	;
 
 opt_type_prefix :
 		type_prefix
+			{ $$ = $1; }
 	| 	/* EMPTY */
-			{ write_exp_elt_opcode (pstate, OP_TYPE);
-			  write_exp_elt_type (pstate,
-					  parse_type (pstate)->builtin_void);
-			  write_exp_elt_opcode (pstate, OP_TYPE); }
+			{ $$ = parse_type (pstate)->builtin_void; }
 	;
 
 
@@ -549,10 +784,13 @@ primary	:	CHARLIT
 	;
 
 primary	:	FLOAT
-			{ write_exp_elt_opcode (pstate, OP_FLOAT);
-			  write_exp_elt_type (pstate, $1.type);
-			  write_exp_elt_floatcst (pstate, $1.val);
-			  write_exp_elt_opcode (pstate, OP_FLOAT);
+			{
+			  float_data data;
+			  std::copy (std::begin ($1.val), std::end ($1.val),
+				     std::begin (data));
+			  pstate->push_new<float_const_operation>
+			    ($1.type, data);
+			  ada_wrap<ada_wrapped_operation> ();
 			}
 	;
 
@@ -562,7 +800,8 @@ primary	:	NULL_PTR
 
 primary	:	STRING
 			{ 
-			  write_exp_op_with_string (pstate, OP_STRING, $1);
+			  pstate->push_new<ada_string_operation>
+			    (copy_name ($1));
 			}
 	;
 
@@ -584,7 +823,7 @@ var_or_type:	NAME   	    %prec VAR
 			{ 
 			  $$ = write_var_or_type (pstate, NULL, $1);
 			  if ($$ == NULL)
-			    write_exp_elt_opcode (pstate, UNOP_ADDR);
+			    ada_addrof ();
 			  else
 			    $$ = lookup_pointer_type ($$);
 			}
@@ -592,7 +831,7 @@ var_or_type:	NAME   	    %prec VAR
 			{ 
 			  $$ = write_var_or_type (pstate, $1, $2);
 			  if ($$ == NULL)
-			    write_exp_elt_opcode (pstate, UNOP_ADDR);
+			    ada_addrof ();
 			  else
 			    $$ = lookup_pointer_type ($$);
 			}
@@ -608,18 +847,20 @@ block   :       NAME COLONCOLON
 aggregate :
 		'(' aggregate_component_list ')'  
 			{
-			  write_exp_elt_opcode (pstate, OP_AGGREGATE);
-			  write_exp_elt_longcst (pstate, $2);
-			  write_exp_elt_opcode (pstate, OP_AGGREGATE);
+			  std::vector<ada_component_up> components
+			    = pop_components ($2);
+
+			  push_component<ada_aggregate_component>
+			    (std::move (components));
 			}
 	;
 
 aggregate_component_list :
 		component_groups	 { $$ = $1; }
 	|	positional_list exp
-			{ write_exp_elt_opcode (pstate, OP_POSITIONAL);
-			  write_exp_elt_longcst (pstate, $1);
-			  write_exp_elt_opcode (pstate, OP_POSITIONAL);
+			{
+			  push_component<ada_positional_component>
+			    ($1, ada_pop ());
 			  $$ = $1 + 1;
 			}
 	|	positional_list component_groups
@@ -628,15 +869,15 @@ aggregate_component_list :
 
 positional_list :
 		exp ','
-			{ write_exp_elt_opcode (pstate, OP_POSITIONAL);
-			  write_exp_elt_longcst (pstate, 0);
-			  write_exp_elt_opcode (pstate, OP_POSITIONAL);
+			{
+			  push_component<ada_positional_component>
+			    (0, ada_pop ());
 			  $$ = 1;
 			} 
 	|	positional_list exp ','
-			{ write_exp_elt_opcode (pstate, OP_POSITIONAL);
-			  write_exp_elt_longcst (pstate, $1);
-			  write_exp_elt_opcode (pstate, OP_POSITIONAL);
+			{
+			  push_component<ada_positional_component>
+			    ($1, ada_pop ());
 			  $$ = $1 + 1; 
 			}
 	;
@@ -649,15 +890,16 @@ component_groups:
 	;
 
 others 	:	OTHERS ARROW exp
-			{ write_exp_elt_opcode (pstate, OP_OTHERS); }
+			{
+			  push_component<ada_others_component> (ada_pop ());
+			}
 	;
 
 component_group :
 		component_associations
 			{
-			  write_exp_elt_opcode (pstate, OP_CHOICES);
-			  write_exp_elt_longcst (pstate, $1);
-			  write_exp_elt_opcode (pstate, OP_CHOICES);
+			  ada_choices_component *choices = choice_component ();
+			  choices->set_associations (pop_associations ($1));
 			}
 	;
 
@@ -667,36 +909,60 @@ component_group :
    decisions until after the => or '|', we convert the ambiguity to a 
    resolved shift/reduce conflict. */
 component_associations :
-		NAME ARROW 
-			{ write_name_assoc (pstate, $1); }
-		    exp	{ $$ = 1; }
+		NAME ARROW exp
+			{
+			  push_component<ada_choices_component> (ada_pop ());
+			  write_name_assoc (pstate, $1);
+			  $$ = 1;
+			}
 	|	simple_exp ARROW exp
-			{ $$ = 1; }
-	|	simple_exp DOTDOT simple_exp ARROW 
-			{ write_exp_elt_opcode (pstate, OP_DISCRETE_RANGE);
-			  write_exp_op_with_string (pstate, OP_NAME,
-						    empty_stoken);
+			{
+			  push_component<ada_choices_component> (ada_pop ());
+			  push_association<ada_name_association> (ada_pop ());
+			  $$ = 1;
+			}
+	|	simple_exp DOTDOT simple_exp ARROW exp
+			{
+			  push_component<ada_choices_component> (ada_pop ());
+			  operation_up rhs = ada_pop ();
+			  operation_up lhs = ada_pop ();
+			  push_association<ada_discrete_range_association>
+			    (std::move (lhs), std::move (rhs));
+			  $$ = 1;
+			}
+	|	NAME '|' component_associations
+			{
+			  write_name_assoc (pstate, $1);
+			  $$ = $3 + 1;
+			}
+	|	simple_exp '|' component_associations
+			{
+			  push_association<ada_name_association> (ada_pop ());
+			  $$ = $3 + 1;
+			}
+	|	simple_exp DOTDOT simple_exp '|' component_associations
+
+			{
+			  operation_up rhs = ada_pop ();
+			  operation_up lhs = ada_pop ();
+			  push_association<ada_discrete_range_association>
+			    (std::move (lhs), std::move (rhs));
+			  $$ = $5 + 1;
 			}
-		    exp { $$ = 1; }
-	|	NAME '|' 
-			{ write_name_assoc (pstate, $1); }
-		    component_associations  { $$ = $4 + 1; }
-	|	simple_exp '|'  
-		    component_associations  { $$ = $3 + 1; }
-	|	simple_exp DOTDOT simple_exp '|'
-			{ write_exp_elt_opcode (pstate, OP_DISCRETE_RANGE); }
-		    component_associations  { $$ = $6 + 1; }
 	;
 
 /* Some extensions borrowed from C, for the benefit of those who find they
    can't get used to Ada notation in GDB.  */
 
 primary	:	'*' primary		%prec '.'
-			{ write_exp_elt_opcode (pstate, UNOP_IND); }
+			{ ada_wrap<ada_unop_ind_operation> (); }
 	|	'&' primary		%prec '.'
-			{ write_exp_elt_opcode (pstate, UNOP_ADDR); }
+			{ ada_addrof (); }
 	|	primary '[' exp ']'
-			{ write_exp_elt_opcode (pstate, BINOP_SUBSCRIPT); }
+			{
+			  ada_wrap2<subscript_operation> ();
+			  ada_wrap<ada_wrapped_operation> ();
+			}
 	;
 
 %%
@@ -737,8 +1003,18 @@ ada_parse (struct parser_state *par_state)
   type_qualifier = NULL;
   obstack_free (&temp_parse_space, NULL);
   obstack_init (&temp_parse_space);
+  components.clear ();
+  associations.clear ();
 
-  return yyparse ();
+  int result = yyparse ();
+  if (!result)
+    {
+      struct type *context_type = nullptr;
+      if (par_state->void_context_p)
+	context_type = parse_type (par_state)->builtin_void;
+      pstate->set_operation (ada_pop (true, context_type));
+    }
+  return result;
 }
 
 static void
@@ -758,10 +1034,7 @@ write_var_from_sym (struct parser_state *par_state,
   if (symbol_read_needs_frame (sym))
     par_state->block_tracker->update (block, INNERMOST_BLOCK_FOR_SYMBOLS);
 
-  write_exp_elt_opcode (par_state, OP_VAR_VALUE);
-  write_exp_elt_block (par_state, block);
-  write_exp_elt_sym (par_state, sym);
-  write_exp_elt_opcode (par_state, OP_VAR_VALUE);
+  par_state->push_new<ada_var_value_operation> (sym, block);
 }
 
 /* Write integer or boolean constant ARG of type TYPE.  */
@@ -769,22 +1042,10 @@ write_var_from_sym (struct parser_state *par_state,
 static void
 write_int (struct parser_state *par_state, LONGEST arg, struct type *type)
 {
-  write_exp_elt_opcode (par_state, OP_LONG);
-  write_exp_elt_type (par_state, type);
-  write_exp_elt_longcst (par_state, arg);
-  write_exp_elt_opcode (par_state, OP_LONG);
+  pstate->push_new<long_const_operation> (type, arg);
+  ada_wrap<ada_wrapped_operation> ();
 }
 
-/* Write an OPCODE, string, OPCODE sequence to the current expression.  */
-static void
-write_exp_op_with_string (struct parser_state *par_state,
-			  enum exp_opcode opcode, struct stoken token)
-{
-  write_exp_elt_opcode (par_state, opcode);
-  write_exp_string (par_state, token);
-  write_exp_elt_opcode (par_state, opcode);
-}
-  
 /* Emit expression corresponding to the renamed object named 
  * designated by RENAMED_ENTITY[0 .. RENAMED_ENTITY_LEN-1] in the
  * context of ORIG_LEFT_CONTEXT, to which is applied the operations
@@ -852,7 +1113,7 @@ write_object_renaming (struct parser_state *par_state,
       switch (*renaming_expr) {
       case 'A':
 	renaming_expr += 1;
-	write_exp_elt_opcode (par_state, UNOP_IND);
+	ada_wrap<ada_unop_ind_operation> ();
 	break;
       case 'L':
 	slice_state = LOWER_BOUND;
@@ -866,10 +1127,7 @@ write_object_renaming (struct parser_state *par_state,
 	    if (next == renaming_expr)
 	      goto BadEncoding;
 	    renaming_expr = next;
-	    write_exp_elt_opcode (par_state, OP_LONG);
-	    write_exp_elt_type (par_state, type_int (par_state));
-	    write_exp_elt_longcst (par_state, (LONGEST) val);
-	    write_exp_elt_opcode (par_state, OP_LONG);
+	    write_int (par_state, val, type_int (par_state));
 	  }
 	else
 	  {
@@ -896,25 +1154,19 @@ write_object_renaming (struct parser_state *par_state,
 				index_sym_info.symbol);
 	  }
 	if (slice_state == SIMPLE_INDEX)
-	  {
-	    write_exp_elt_opcode (par_state, OP_FUNCALL);
-	    write_exp_elt_longcst (par_state, (LONGEST) 1);
-	    write_exp_elt_opcode (par_state, OP_FUNCALL);
-	  }
+	  ada_funcall (1);
 	else if (slice_state == LOWER_BOUND)
 	  slice_state = UPPER_BOUND;
 	else if (slice_state == UPPER_BOUND)
 	  {
-	    write_exp_elt_opcode (par_state, TERNOP_SLICE);
+	    ada_wrap3<ada_ternop_slice_operation> ();
 	    slice_state = SIMPLE_INDEX;
 	  }
 	break;
 
       case 'R':
 	{
-	  struct stoken field_name;
 	  const char *end;
-	  char *buf;
 
 	  renaming_expr += 1;
 
@@ -923,13 +1175,12 @@ write_object_renaming (struct parser_state *par_state,
 	  end = strchr (renaming_expr, 'X');
 	  if (end == NULL)
 	    end = renaming_expr + strlen (renaming_expr);
-	  field_name.length = end - renaming_expr;
-	  buf = (char *) malloc (end - renaming_expr + 1);
-	  field_name.ptr = buf;
-	  strncpy (buf, renaming_expr, end - renaming_expr);
-	  buf[end - renaming_expr] = '\000';
+
+	  operation_up arg = ada_pop ();
+	  pstate->push_new<ada_structop_operation>
+	    (std::move (arg), std::string (renaming_expr,
+					   end - renaming_expr));
 	  renaming_expr = end;
-	  write_exp_op_with_string (par_state, STRUCTOP_STRUCT, field_name);
 	  break;
 	}
 
@@ -1085,15 +1336,14 @@ write_selectors (struct parser_state *par_state, char *sels)
 {
   while (*sels != '\0')
     {
-      struct stoken field_name;
       char *p = chop_separator (sels);
       sels = p;
       while (*sels != '\0' && *sels != '.' 
 	     && (sels[0] != '_' || sels[1] != '_'))
 	sels += 1;
-      field_name.length = sels - p;
-      field_name.ptr = p;
-      write_exp_op_with_string (par_state, STRUCTOP_STRUCT, field_name);
+      operation_up arg = ada_pop ();
+      pstate->push_new<ada_structop_operation>
+	(std::move (arg), std::string (p, sels - p));
     }
 }
 
@@ -1111,10 +1361,7 @@ write_ambiguous_var (struct parser_state *par_state,
   sym->set_linkage_name (obstack_strndup (&temp_parse_space, name, len));
   sym->set_language (language_ada, nullptr);
 
-  write_exp_elt_opcode (par_state, OP_VAR_VALUE);
-  write_exp_elt_block (par_state, block);
-  write_exp_elt_sym (par_state, sym);
-  write_exp_elt_opcode (par_state, OP_VAR_VALUE);
+  par_state->push_new<ada_var_value_operation> (sym, block);
 }
 
 /* A convenient wrapper around ada_get_field_index that takes
@@ -1303,7 +1550,8 @@ write_var_or_type (struct parser_state *par_state,
 		= ada_lookup_simple_minsym (encoded_name);
 	      if (msym.minsym != NULL)
 		{
-		  write_exp_msymbol (par_state, msym);
+		  par_state->push_new<ada_var_msym_value_operation>
+		    (msym.minsym, msym.objfile);
 		  /* Maybe cause error here rather than later? FIXME? */
 		  write_selectors (par_state, encoded_name + tail_index);
 		  return NULL;
@@ -1365,13 +1613,15 @@ write_name_assoc (struct parser_state *par_state, struct stoken name)
 				  VAR_DOMAIN);
 
       if (syms.size () != 1 || SYMBOL_CLASS (syms[0].symbol) == LOC_TYPEDEF)
-	write_exp_op_with_string (par_state, OP_NAME, name);
+	pstate->push_new<ada_string_operation> (copy_name (name));
       else
 	write_var_from_sym (par_state, syms[0].block, syms[0].symbol);
     }
   else
     if (write_var_or_type (par_state, NULL, name) != NULL)
       error (_("Invalid use of type."));
+
+  push_association<ada_name_association> (ada_pop ());
 }
 
 /* Convert the character literal whose ASCII value would be VAL to the
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 2c2ceee1cea..fd072d5aac4 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -2898,13 +2898,9 @@ ada_array_element_type (struct type *type, int nindices)
   return NULL;
 }
 
-/* The type of nth index in arrays of given type (n numbering from 1).
-   Does not examine memory.  Throws an error if N is invalid or TYPE
-   is not an array type.  NAME is the name of the Ada attribute being
-   evaluated ('range, 'first, 'last, or 'length); it is used in building
-   the error message.  */
+/* See ada-lang.h.  */
 
-static struct type *
+struct type *
 ada_index_type (struct type *type, int n, const char *name)
 {
   struct type *result_type;
diff --git a/gdb/ada-lang.h b/gdb/ada-lang.h
index 679aeb4fa72..8aaf9757a62 100644
--- a/gdb/ada-lang.h
+++ b/gdb/ada-lang.h
@@ -417,4 +417,12 @@ extern block_symbol ada_resolve_variable (struct symbol *sym,
 					  int deprocedure_p,
 					  innermost_block_tracker *tracker);
 
+/* The type of nth index in arrays of given type (n numbering from 1).
+   Does not examine memory.  Throws an error if N is invalid or TYPE
+   is not an array type.  NAME is the name of the Ada attribute being
+   evaluated ('range, 'first, 'last, or 'length); it is used in building
+   the error message.  */
+extern struct type *ada_index_type (struct type *type, int n,
+				    const char *name);
+
 #endif
-- 
2.30.2