]>
Commit | Line | Data |
---|---|---|
9dcd3e29 TT |
1 | /* Definitions for Fortran expressions |
2 | ||
213516ef | 3 | Copyright (C) 2020-2023 Free Software Foundation, Inc. |
9dcd3e29 TT |
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); | |
891e4190 NCK |
35 | |
36 | /* Implement expression evaluation for Fortran's CEILING intrinsic function | |
37 | called with one argument. For EXPECT_TYPE, EXP, and NOSIDE see | |
38 | expression::evaluate (in expression.h). OPCODE will always be | |
39 | FORTRAN_CEILING and ARG1 is the argument passed to CEILING. */ | |
40 | ||
9dcd3e29 TT |
41 | extern struct value *eval_op_f_ceil (struct type *expect_type, |
42 | struct expression *exp, | |
43 | enum noside noside, | |
44 | enum exp_opcode opcode, | |
45 | struct value *arg1); | |
891e4190 NCK |
46 | |
47 | /* Implement expression evaluation for Fortran's CEILING intrinsic function | |
48 | called with two arguments. For EXPECT_TYPE, EXP, and NOSIDE see | |
49 | expression::evaluate (in expression.h). OPCODE will always be | |
50 | FORTRAN_CEILING, ARG1 is the first argument passed to CEILING, and KIND_ARG | |
51 | is the type corresponding to the KIND parameter passed to CEILING. */ | |
52 | ||
53 | extern value *eval_op_f_ceil (type *expect_type, expression *exp, | |
54 | noside noside, exp_opcode opcode, value *arg1, | |
55 | type *kind_arg); | |
56 | ||
57 | /* Implement expression evaluation for Fortran's FLOOR intrinsic function | |
58 | called with one argument. For EXPECT_TYPE, EXP, and NOSIDE see | |
59 | expression::evaluate (in expression.h). OPCODE will always be FORTRAN_FLOOR | |
60 | and ARG1 is the argument passed to FLOOR. */ | |
61 | ||
9dcd3e29 TT |
62 | extern struct value *eval_op_f_floor (struct type *expect_type, |
63 | struct expression *exp, | |
64 | enum noside noside, | |
65 | enum exp_opcode opcode, | |
66 | struct value *arg1); | |
891e4190 NCK |
67 | |
68 | /* Implement expression evaluation for Fortran's FLOOR intrinsic function | |
69 | called with two arguments. For EXPECT_TYPE, EXP, and NOSIDE see | |
70 | expression::evaluate (in expression.h). OPCODE will always be | |
71 | FORTRAN_FLOOR, ARG1 is the first argument passed to FLOOR, and KIND_ARG is | |
72 | the type corresponding to the KIND parameter passed to FLOOR. */ | |
73 | ||
74 | extern value *eval_op_f_floor (type *expect_type, expression *exp, | |
75 | noside noside, exp_opcode opcode, value *arg1, | |
76 | type *kind_arg); | |
77 | ||
9dcd3e29 TT |
78 | extern struct value *eval_op_f_modulo (struct type *expect_type, |
79 | struct expression *exp, | |
80 | enum noside noside, | |
81 | enum exp_opcode opcode, | |
82 | struct value *arg1, struct value *arg2); | |
891e4190 NCK |
83 | |
84 | /* Implement expression evaluation for Fortran's CMPLX intrinsic function | |
85 | called with one argument. For EXPECT_TYPE, EXP, and NOSIDE see | |
86 | expression::evaluate (in expression.h). OPCODE will always be | |
87 | FORTRAN_CMPLX and ARG1 is the argument passed to CMPLX if. */ | |
88 | ||
89 | extern value *eval_op_f_cmplx (type *expect_type, expression *exp, | |
90 | noside noside, exp_opcode opcode, value *arg1); | |
91 | ||
92 | /* Implement expression evaluation for Fortran's CMPLX intrinsic function | |
93 | called with two arguments. For EXPECT_TYPE, EXP, and NOSIDE see | |
94 | expression::evaluate (in expression.h). OPCODE will always be | |
95 | FORTRAN_CMPLX, ARG1 and ARG2 are the arguments passed to CMPLX. */ | |
96 | ||
9dcd3e29 TT |
97 | extern struct value *eval_op_f_cmplx (struct type *expect_type, |
98 | struct expression *exp, | |
99 | enum noside noside, | |
100 | enum exp_opcode opcode, | |
101 | struct value *arg1, struct value *arg2); | |
891e4190 NCK |
102 | |
103 | /* Implement expression evaluation for Fortran's CMPLX intrinsic function | |
104 | called with three arguments. For EXPECT_TYPE, EXP, and NOSIDE see | |
105 | expression::evaluate (in expression.h). OPCODE will always be | |
106 | FORTRAN_CMPLX, ARG1 and ARG2 are real and imaginary part passed to CMPLX, | |
107 | and KIND_ARG is the type corresponding to the KIND parameter passed to | |
108 | CMPLX. */ | |
109 | ||
110 | extern value *eval_op_f_cmplx (type *expect_type, expression *exp, | |
111 | noside noside, exp_opcode opcode, value *arg1, | |
112 | value *arg2, type *kind_arg); | |
113 | ||
9dcd3e29 TT |
114 | extern struct value *eval_op_f_kind (struct type *expect_type, |
115 | struct expression *exp, | |
116 | enum noside noside, | |
117 | enum exp_opcode opcode, | |
118 | struct value *arg1); | |
eb4c9271 TT |
119 | extern struct value *eval_op_f_associated (struct type *expect_type, |
120 | struct expression *exp, | |
121 | enum noside noside, | |
122 | enum exp_opcode opcode, | |
123 | struct value *arg1); | |
124 | extern struct value *eval_op_f_associated (struct type *expect_type, | |
125 | struct expression *exp, | |
126 | enum noside noside, | |
127 | enum exp_opcode opcode, | |
128 | struct value *arg1, | |
129 | struct value *arg2); | |
f403a4e4 TT |
130 | extern struct value * eval_op_f_allocated (struct type *expect_type, |
131 | struct expression *exp, | |
132 | enum noside noside, | |
133 | enum exp_opcode op, | |
134 | struct value *arg1); | |
611aa09d FW |
135 | extern struct value * eval_op_f_loc (struct type *expect_type, |
136 | struct expression *exp, | |
137 | enum noside noside, | |
138 | enum exp_opcode op, | |
139 | struct value *arg1); | |
9dcd3e29 | 140 | |
e14816a8 AB |
141 | /* Implement the evaluation of UNOP_FORTRAN_RANK. EXPECTED_TYPE, EXP, and |
142 | NOSIDE are as for expression::evaluate (see expression.h). OP will | |
143 | always be UNOP_FORTRAN_RANK, and ARG1 is the argument being passed to | |
144 | the expression. */ | |
145 | ||
146 | extern struct value *eval_op_f_rank (struct type *expect_type, | |
147 | struct expression *exp, | |
148 | enum noside noside, | |
149 | enum exp_opcode op, | |
150 | struct value *arg1); | |
151 | ||
7ba155b3 AB |
152 | /* Implement expression evaluation for Fortran's SIZE keyword. For |
153 | EXPECT_TYPE, EXP, and NOSIDE see expression::evaluate (in | |
891e4190 | 154 | expression.h). OPCODE will always for FORTRAN_ARRAY_SIZE. ARG1 is the |
7ba155b3 AB |
155 | value passed to SIZE if it is only passed a single argument. For the |
156 | two argument form see the overload of this function below. */ | |
157 | ||
158 | extern struct value *eval_op_f_array_size (struct type *expect_type, | |
159 | struct expression *exp, | |
160 | enum noside noside, | |
161 | enum exp_opcode opcode, | |
162 | struct value *arg1); | |
163 | ||
164 | /* An overload of EVAL_OP_F_ARRAY_SIZE above, this version takes two | |
165 | arguments, representing the two values passed to Fortran's SIZE | |
166 | keyword. */ | |
167 | ||
168 | extern struct value *eval_op_f_array_size (struct type *expect_type, | |
169 | struct expression *exp, | |
170 | enum noside noside, | |
171 | enum exp_opcode opcode, | |
172 | struct value *arg1, | |
173 | struct value *arg2); | |
174 | ||
891e4190 NCK |
175 | /* Implement expression evaluation for Fortran's SIZE intrinsic function called |
176 | with three arguments. For EXPECT_TYPE, EXP, and NOSIDE see | |
177 | expression::evaluate (in expression.h). OPCODE will always be | |
178 | FORTRAN_ARRAY_SIZE, ARG1 and ARG2 the first two values passed to SIZE, and | |
179 | KIND_ARG is the type corresponding to the KIND parameter passed to SIZE. */ | |
180 | ||
181 | extern value *eval_op_f_array_size (type *expect_type, expression *exp, | |
182 | noside noside, exp_opcode opcode, | |
183 | value *arg1, value *arg2, type *kind_arg); | |
184 | ||
eef32f59 AB |
185 | /* Implement the evaluation of Fortran's SHAPE keyword. EXPECTED_TYPE, |
186 | EXP, and NOSIDE are as for expression::evaluate (see expression.h). OP | |
187 | will always be UNOP_FORTRAN_SHAPE, and ARG1 is the argument being passed | |
188 | to the expression. */ | |
189 | ||
190 | extern struct value *eval_op_f_array_shape (struct type *expect_type, | |
191 | struct expression *exp, | |
192 | enum noside noside, | |
193 | enum exp_opcode op, | |
194 | struct value *arg1); | |
7ba155b3 | 195 | |
9dcd3e29 TT |
196 | namespace expr |
197 | { | |
198 | ||
891e4190 NCK |
199 | /* Function prototype for Fortran intrinsic functions taking one argument and |
200 | one kind argument. */ | |
201 | typedef value *binary_kind_ftype (type *expect_type, expression *exp, | |
202 | noside noside, exp_opcode op, value *arg1, | |
203 | type *kind_arg); | |
204 | ||
205 | /* Two-argument operation with the second argument being a kind argument. */ | |
206 | template<exp_opcode OP, binary_kind_ftype FUNC> | |
207 | class fortran_kind_2arg | |
208 | : public tuple_holding_operation<operation_up, type*> | |
209 | { | |
210 | public: | |
211 | ||
212 | using tuple_holding_operation::tuple_holding_operation; | |
213 | ||
214 | value *evaluate (type *expect_type, expression *exp, noside noside) override | |
215 | { | |
216 | value *arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp, noside); | |
217 | type *kind_arg = std::get<1> (m_storage); | |
218 | return FUNC (expect_type, exp, noside, OP, arg1, kind_arg); | |
219 | } | |
220 | ||
221 | exp_opcode opcode () const override | |
222 | { return OP; } | |
223 | }; | |
224 | ||
225 | /* Function prototype for Fortran intrinsic functions taking two arguments and | |
226 | one kind argument. */ | |
227 | typedef value *ternary_kind_ftype (type *expect_type, expression *exp, | |
228 | noside noside, exp_opcode op, value *arg1, | |
229 | value *arg2, type *kind_arg); | |
230 | ||
231 | /* Three-argument operation with the third argument being a kind argument. */ | |
232 | template<exp_opcode OP, ternary_kind_ftype FUNC> | |
233 | class fortran_kind_3arg | |
234 | : public tuple_holding_operation<operation_up, operation_up, type *> | |
235 | { | |
236 | public: | |
237 | ||
238 | using tuple_holding_operation::tuple_holding_operation; | |
239 | ||
240 | value *evaluate (type *expect_type, expression *exp, noside noside) override | |
241 | { | |
242 | value *arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp, noside); | |
243 | value *arg2 = std::get<1> (m_storage)->evaluate (nullptr, exp, noside); | |
244 | type *kind_arg = std::get<2> (m_storage); | |
245 | return FUNC (expect_type, exp, noside, OP, arg1, arg2, kind_arg); | |
246 | } | |
247 | ||
248 | exp_opcode opcode () const override | |
249 | { return OP; } | |
250 | }; | |
251 | ||
9dcd3e29 | 252 | using fortran_abs_operation = unop_operation<UNOP_ABS, eval_op_f_abs>; |
891e4190 NCK |
253 | using fortran_ceil_operation_1arg = unop_operation<FORTRAN_CEILING, |
254 | eval_op_f_ceil>; | |
255 | using fortran_ceil_operation_2arg = fortran_kind_2arg<FORTRAN_CEILING, | |
256 | eval_op_f_ceil>; | |
257 | using fortran_floor_operation_1arg = unop_operation<FORTRAN_FLOOR, | |
258 | eval_op_f_floor>; | |
259 | using fortran_floor_operation_2arg = fortran_kind_2arg<FORTRAN_FLOOR, | |
260 | eval_op_f_floor>; | |
9dcd3e29 TT |
261 | using fortran_kind_operation = unop_operation<UNOP_FORTRAN_KIND, |
262 | eval_op_f_kind>; | |
f403a4e4 TT |
263 | using fortran_allocated_operation = unop_operation<UNOP_FORTRAN_ALLOCATED, |
264 | eval_op_f_allocated>; | |
611aa09d FW |
265 | using fortran_loc_operation = unop_operation<UNOP_FORTRAN_LOC, |
266 | eval_op_f_loc>; | |
9dcd3e29 TT |
267 | |
268 | using fortran_mod_operation = binop_operation<BINOP_MOD, eval_op_f_mod>; | |
269 | using fortran_modulo_operation = binop_operation<BINOP_FORTRAN_MODULO, | |
270 | eval_op_f_modulo>; | |
eb4c9271 TT |
271 | using fortran_associated_1arg = unop_operation<FORTRAN_ASSOCIATED, |
272 | eval_op_f_associated>; | |
273 | using fortran_associated_2arg = binop_operation<FORTRAN_ASSOCIATED, | |
274 | eval_op_f_associated>; | |
e14816a8 AB |
275 | using fortran_rank_operation = unop_operation<UNOP_FORTRAN_RANK, |
276 | eval_op_f_rank>; | |
7ba155b3 AB |
277 | using fortran_array_size_1arg = unop_operation<FORTRAN_ARRAY_SIZE, |
278 | eval_op_f_array_size>; | |
279 | using fortran_array_size_2arg = binop_operation<FORTRAN_ARRAY_SIZE, | |
280 | eval_op_f_array_size>; | |
891e4190 NCK |
281 | using fortran_array_size_3arg = fortran_kind_3arg<FORTRAN_ARRAY_SIZE, |
282 | eval_op_f_array_size>; | |
eef32f59 AB |
283 | using fortran_array_shape_operation = unop_operation<UNOP_FORTRAN_SHAPE, |
284 | eval_op_f_array_shape>; | |
891e4190 NCK |
285 | using fortran_cmplx_operation_1arg = unop_operation<FORTRAN_CMPLX, |
286 | eval_op_f_cmplx>; | |
287 | using fortran_cmplx_operation_2arg = binop_operation<FORTRAN_CMPLX, | |
288 | eval_op_f_cmplx>; | |
289 | using fortran_cmplx_operation_3arg = fortran_kind_3arg<FORTRAN_CMPLX, | |
290 | eval_op_f_cmplx>; | |
9dcd3e29 | 291 | |
2f98abe1 TT |
292 | /* OP_RANGE for Fortran. */ |
293 | class fortran_range_operation | |
294 | : public tuple_holding_operation<enum range_flag, operation_up, operation_up, | |
295 | operation_up> | |
296 | { | |
297 | public: | |
298 | ||
299 | using tuple_holding_operation::tuple_holding_operation; | |
300 | ||
301 | value *evaluate (struct type *expect_type, | |
302 | struct expression *exp, | |
303 | enum noside noside) override | |
304 | { | |
305 | error (_("ranges not allowed in this context")); | |
306 | } | |
307 | ||
308 | range_flag get_flags () const | |
309 | { | |
310 | return std::get<0> (m_storage); | |
311 | } | |
312 | ||
313 | value *evaluate0 (struct expression *exp, enum noside noside) const | |
314 | { | |
315 | return std::get<1> (m_storage)->evaluate (nullptr, exp, noside); | |
316 | } | |
317 | ||
318 | value *evaluate1 (struct expression *exp, enum noside noside) const | |
319 | { | |
320 | return std::get<2> (m_storage)->evaluate (nullptr, exp, noside); | |
321 | } | |
322 | ||
323 | value *evaluate2 (struct expression *exp, enum noside noside) const | |
324 | { | |
325 | return std::get<3> (m_storage)->evaluate (nullptr, exp, noside); | |
326 | } | |
327 | ||
328 | enum exp_opcode opcode () const override | |
329 | { return OP_RANGE; } | |
330 | }; | |
331 | ||
332 | /* In F77, functions, substring ops and array subscript operations | |
333 | cannot be disambiguated at parse time. This operation handles | |
334 | both, deciding which do to at evaluation time. */ | |
335 | class fortran_undetermined | |
336 | : public tuple_holding_operation<operation_up, std::vector<operation_up>> | |
337 | { | |
338 | public: | |
339 | ||
340 | using tuple_holding_operation::tuple_holding_operation; | |
341 | ||
342 | value *evaluate (struct type *expect_type, | |
343 | struct expression *exp, | |
344 | enum noside noside) override; | |
345 | ||
346 | enum exp_opcode opcode () const override | |
347 | { return OP_F77_UNDETERMINED_ARGLIST; } | |
348 | ||
349 | private: | |
350 | ||
351 | value *value_subarray (value *array, struct expression *exp, | |
352 | enum noside noside); | |
353 | }; | |
354 | ||
58a76c72 TT |
355 | /* Single-argument form of Fortran ubound/lbound intrinsics. */ |
356 | class fortran_bound_1arg | |
357 | : public tuple_holding_operation<exp_opcode, operation_up> | |
358 | { | |
359 | public: | |
360 | ||
361 | using tuple_holding_operation::tuple_holding_operation; | |
362 | ||
363 | value *evaluate (struct type *expect_type, | |
364 | struct expression *exp, | |
365 | enum noside noside) override; | |
366 | ||
367 | enum exp_opcode opcode () const override | |
368 | { return std::get<0> (m_storage); } | |
369 | }; | |
370 | ||
371 | /* Two-argument form of Fortran ubound/lbound intrinsics. */ | |
372 | class fortran_bound_2arg | |
373 | : public tuple_holding_operation<exp_opcode, operation_up, operation_up> | |
374 | { | |
375 | public: | |
376 | ||
377 | using tuple_holding_operation::tuple_holding_operation; | |
378 | ||
379 | value *evaluate (struct type *expect_type, | |
380 | struct expression *exp, | |
381 | enum noside noside) override; | |
382 | ||
383 | enum exp_opcode opcode () const override | |
384 | { return std::get<0> (m_storage); } | |
385 | }; | |
386 | ||
891e4190 NCK |
387 | /* Three-argument form of Fortran ubound/lbound intrinsics. */ |
388 | class fortran_bound_3arg | |
389 | : public tuple_holding_operation<exp_opcode, operation_up, operation_up, | |
390 | type *> | |
391 | { | |
392 | public: | |
393 | ||
394 | using tuple_holding_operation::tuple_holding_operation; | |
395 | ||
396 | value *evaluate (type *expect_type, expression *exp, noside noside) override; | |
397 | ||
398 | exp_opcode opcode () const override | |
399 | { return std::get<0> (m_storage); } | |
400 | }; | |
401 | ||
0a703a4c AB |
402 | /* Implement STRUCTOP_STRUCT for Fortran. */ |
403 | class fortran_structop_operation | |
404 | : public structop_base_operation | |
405 | { | |
406 | public: | |
407 | ||
408 | using structop_base_operation::structop_base_operation; | |
409 | ||
410 | value *evaluate (struct type *expect_type, | |
411 | struct expression *exp, | |
412 | enum noside noside) override; | |
413 | ||
414 | enum exp_opcode opcode () const override | |
415 | { return STRUCTOP_STRUCT; } | |
416 | }; | |
417 | ||
9dcd3e29 TT |
418 | } /* namespace expr */ |
419 | ||
420 | #endif /* FORTRAN_EXP_H */ |