1 /* Definitions for Fortran expressions
2 
3    Copyright (C) 2020, 2021 Free Software Foundation, Inc.
4 
5    This file is part of GDB.
6 
7    This program is free software; you can redistribute it and/or modify
8    it under the terms of the GNU General Public License as published by
9    the Free Software Foundation; either version 3 of the License, or
10    (at your option) any later version.
11 
12    This program is distributed in the hope that it will be useful,
13    but WITHOUT ANY WARRANTY; without even the implied warranty of
14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15    GNU General Public License for more details.
16 
17    You should have received a copy of the GNU General Public License
18    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
19 
20 #ifndef FORTRAN_EXP_H
21 #define FORTRAN_EXP_H
22 
23 #include "expop.h"
24 
25 extern struct value *eval_op_f_abs (struct type *expect_type,
26 				    struct expression *exp,
27 				    enum noside noside,
28 				    enum exp_opcode opcode,
29 				    struct value *arg1);
30 extern struct value *eval_op_f_mod (struct type *expect_type,
31 				    struct expression *exp,
32 				    enum noside noside,
33 				    enum exp_opcode opcode,
34 				    struct value *arg1, struct value *arg2);
35 extern struct value *eval_op_f_ceil (struct type *expect_type,
36 				     struct expression *exp,
37 				     enum noside noside,
38 				     enum exp_opcode opcode,
39 				     struct value *arg1);
40 extern struct value *eval_op_f_floor (struct type *expect_type,
41 				      struct expression *exp,
42 				      enum noside noside,
43 				      enum exp_opcode opcode,
44 				      struct value *arg1);
45 extern struct value *eval_op_f_modulo (struct type *expect_type,
46 				       struct expression *exp,
47 				       enum noside noside,
48 				       enum exp_opcode opcode,
49 				       struct value *arg1, struct value *arg2);
50 extern struct value *eval_op_f_cmplx (struct type *expect_type,
51 				      struct expression *exp,
52 				      enum noside noside,
53 				      enum exp_opcode opcode,
54 				      struct value *arg1, struct value *arg2);
55 extern struct value *eval_op_f_kind (struct type *expect_type,
56 				     struct expression *exp,
57 				     enum noside noside,
58 				     enum exp_opcode opcode,
59 				     struct value *arg1);
60 extern struct value *eval_op_f_associated (struct type *expect_type,
61 					   struct expression *exp,
62 					   enum noside noside,
63 					   enum exp_opcode opcode,
64 					   struct value *arg1);
65 extern struct value *eval_op_f_associated (struct type *expect_type,
66 					   struct expression *exp,
67 					   enum noside noside,
68 					   enum exp_opcode opcode,
69 					   struct value *arg1,
70 					   struct value *arg2);
71 extern struct value * eval_op_f_allocated (struct type *expect_type,
72 					   struct expression *exp,
73 					   enum noside noside,
74 					   enum exp_opcode op,
75 					   struct value *arg1);
76 extern struct value * eval_op_f_loc (struct type *expect_type,
77 				     struct expression *exp,
78 				     enum noside noside,
79 				     enum exp_opcode op,
80 				     struct value *arg1);
81 
82 /* Implement the evaluation of UNOP_FORTRAN_RANK.  EXPECTED_TYPE, EXP, and
83    NOSIDE are as for expression::evaluate (see expression.h).  OP will
84    always be UNOP_FORTRAN_RANK, and ARG1 is the argument being passed to
85    the expression.   */
86 
87 extern struct value *eval_op_f_rank (struct type *expect_type,
88 				     struct expression *exp,
89 				     enum noside noside,
90 				     enum exp_opcode op,
91 				     struct value *arg1);
92 
93 /* Implement expression evaluation for Fortran's SIZE keyword. For
94    EXPECT_TYPE, EXP, and NOSIDE see expression::evaluate (in
95    expression.h).  OP will always for FORTRAN_ARRAY_SIZE.  ARG1 is the
96    value passed to SIZE if it is only passed a single argument.  For the
97    two argument form see the overload of this function below.  */
98 
99 extern struct value *eval_op_f_array_size (struct type *expect_type,
100 					   struct expression *exp,
101 					   enum noside noside,
102 					   enum exp_opcode opcode,
103 					   struct value *arg1);
104 
105 /* An overload of EVAL_OP_F_ARRAY_SIZE above, this version takes two
106    arguments, representing the two values passed to Fortran's SIZE
107    keyword.  */
108 
109 extern struct value *eval_op_f_array_size (struct type *expect_type,
110 					   struct expression *exp,
111 					   enum noside noside,
112 					   enum exp_opcode opcode,
113 					   struct value *arg1,
114 					   struct value *arg2);
115 
116 /* Implement the evaluation of Fortran's SHAPE keyword.  EXPECTED_TYPE,
117    EXP, and NOSIDE are as for expression::evaluate (see expression.h).  OP
118    will always be UNOP_FORTRAN_SHAPE, and ARG1 is the argument being passed
119    to the expression.  */
120 
121 extern struct value *eval_op_f_array_shape (struct type *expect_type,
122 					    struct expression *exp,
123 					    enum noside noside,
124 					    enum exp_opcode op,
125 					    struct value *arg1);
126 
127 namespace expr
128 {
129 
130 using fortran_abs_operation = unop_operation<UNOP_ABS, eval_op_f_abs>;
131 using fortran_ceil_operation = unop_operation<UNOP_FORTRAN_CEILING,
132 					      eval_op_f_ceil>;
133 using fortran_floor_operation = unop_operation<UNOP_FORTRAN_FLOOR,
134 					       eval_op_f_floor>;
135 using fortran_kind_operation = unop_operation<UNOP_FORTRAN_KIND,
136 					      eval_op_f_kind>;
137 using fortran_allocated_operation = unop_operation<UNOP_FORTRAN_ALLOCATED,
138 						   eval_op_f_allocated>;
139 using fortran_loc_operation = unop_operation<UNOP_FORTRAN_LOC,
140 						   eval_op_f_loc>;
141 
142 using fortran_mod_operation = binop_operation<BINOP_MOD, eval_op_f_mod>;
143 using fortran_modulo_operation = binop_operation<BINOP_FORTRAN_MODULO,
144 						 eval_op_f_modulo>;
145 using fortran_associated_1arg = unop_operation<FORTRAN_ASSOCIATED,
146 					       eval_op_f_associated>;
147 using fortran_associated_2arg = binop_operation<FORTRAN_ASSOCIATED,
148 						eval_op_f_associated>;
149 using fortran_rank_operation = unop_operation<UNOP_FORTRAN_RANK,
150 					      eval_op_f_rank>;
151 using fortran_array_size_1arg = unop_operation<FORTRAN_ARRAY_SIZE,
152 					       eval_op_f_array_size>;
153 using fortran_array_size_2arg = binop_operation<FORTRAN_ARRAY_SIZE,
154 						eval_op_f_array_size>;
155 using fortran_array_shape_operation = unop_operation<UNOP_FORTRAN_SHAPE,
156 						     eval_op_f_array_shape>;
157 
158 /* The Fortran "complex" operation.  */
159 class fortran_cmplx_operation
160   : public tuple_holding_operation<operation_up, operation_up>
161 {
162 public:
163 
164   using tuple_holding_operation::tuple_holding_operation;
165 
evaluate(struct type * expect_type,struct expression * exp,enum noside noside)166   value *evaluate (struct type *expect_type,
167 		   struct expression *exp,
168 		   enum noside noside) override
169   {
170     value *arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp, noside);
171     value *arg2 = std::get<1> (m_storage)->evaluate (value_type (arg1),
172 						     exp, noside);
173     return eval_op_f_cmplx (expect_type, exp, noside, BINOP_FORTRAN_CMPLX,
174 			    arg1, arg2);
175   }
176 
opcode()177   enum exp_opcode opcode () const override
178   { return BINOP_FORTRAN_CMPLX; }
179 };
180 
181 /* OP_RANGE for Fortran.  */
182 class fortran_range_operation
183   : public tuple_holding_operation<enum range_flag, operation_up, operation_up,
184 				   operation_up>
185 {
186 public:
187 
188   using tuple_holding_operation::tuple_holding_operation;
189 
190   value *evaluate (struct type *expect_type,
191 		   struct expression *exp,
192 		   enum noside noside) override
193   {
194     error (_("ranges not allowed in this context"));
195   }
196 
197   range_flag get_flags () const
198   {
199     return std::get<0> (m_storage);
200   }
201 
202   value *evaluate0 (struct expression *exp, enum noside noside) const
203   {
204     return std::get<1> (m_storage)->evaluate (nullptr, exp, noside);
205   }
206 
207   value *evaluate1 (struct expression *exp, enum noside noside) const
208   {
209     return std::get<2> (m_storage)->evaluate (nullptr, exp, noside);
210   }
211 
212   value *evaluate2 (struct expression *exp, enum noside noside) const
213   {
214     return std::get<3> (m_storage)->evaluate (nullptr, exp, noside);
215   }
216 
217   enum exp_opcode opcode () const override
218   { return OP_RANGE; }
219 };
220 
221 /* In F77, functions, substring ops and array subscript operations
222    cannot be disambiguated at parse time.  This operation handles
223    both, deciding which do to at evaluation time.  */
224 class fortran_undetermined
225   : public tuple_holding_operation<operation_up, std::vector<operation_up>>
226 {
227 public:
228 
229   using tuple_holding_operation::tuple_holding_operation;
230 
231   value *evaluate (struct type *expect_type,
232 		   struct expression *exp,
233 		   enum noside noside) override;
234 
opcode()235   enum exp_opcode opcode () const override
236   { return OP_F77_UNDETERMINED_ARGLIST; }
237 
238 private:
239 
240   value *value_subarray (value *array, struct expression *exp,
241 			 enum noside noside);
242 };
243 
244 /* Single-argument form of Fortran ubound/lbound intrinsics.  */
245 class fortran_bound_1arg
246   : public tuple_holding_operation<exp_opcode, operation_up>
247 {
248 public:
249 
250   using tuple_holding_operation::tuple_holding_operation;
251 
252   value *evaluate (struct type *expect_type,
253 		   struct expression *exp,
254 		   enum noside noside) override;
255 
opcode()256   enum exp_opcode opcode () const override
257   { return std::get<0> (m_storage); }
258 };
259 
260 /* Two-argument form of Fortran ubound/lbound intrinsics.  */
261 class fortran_bound_2arg
262   : public tuple_holding_operation<exp_opcode, operation_up, operation_up>
263 {
264 public:
265 
266   using tuple_holding_operation::tuple_holding_operation;
267 
268   value *evaluate (struct type *expect_type,
269 		   struct expression *exp,
270 		   enum noside noside) override;
271 
opcode()272   enum exp_opcode opcode () const override
273   { return std::get<0> (m_storage); }
274 };
275 
276 /* Implement STRUCTOP_STRUCT for Fortran.  */
277 class fortran_structop_operation
278   : public structop_base_operation
279 {
280 public:
281 
282   using structop_base_operation::structop_base_operation;
283 
284   value *evaluate (struct type *expect_type,
285 		   struct expression *exp,
286 		   enum noside noside) override;
287 
opcode()288   enum exp_opcode opcode () const override
289   { return STRUCTOP_STRUCT; }
290 };
291 
292 } /* namespace expr */
293 
294 #endif /* FORTRAN_EXP_H */
295