1 /* Definitions for Fortran expressions 2 3 Copyright (C) 2020-2023 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 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 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); 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 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); 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 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); 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 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); 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 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); 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); 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); 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); 140 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 152 /* Implement expression evaluation for Fortran's SIZE keyword. For 153 EXPECT_TYPE, EXP, and NOSIDE see expression::evaluate (in 154 expression.h). OPCODE will always for FORTRAN_ARRAY_SIZE. ARG1 is the 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 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 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); 195 196 namespace expr 197 { 198 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 252 using fortran_abs_operation = unop_operation<UNOP_ABS, eval_op_f_abs>; 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>; 261 using fortran_kind_operation = unop_operation<UNOP_FORTRAN_KIND, 262 eval_op_f_kind>; 263 using fortran_allocated_operation = unop_operation<UNOP_FORTRAN_ALLOCATED, 264 eval_op_f_allocated>; 265 using fortran_loc_operation = unop_operation<UNOP_FORTRAN_LOC, 266 eval_op_f_loc>; 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>; 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>; 275 using fortran_rank_operation = unop_operation<UNOP_FORTRAN_RANK, 276 eval_op_f_rank>; 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>; 281 using fortran_array_size_3arg = fortran_kind_3arg<FORTRAN_ARRAY_SIZE, 282 eval_op_f_array_size>; 283 using fortran_array_shape_operation = unop_operation<UNOP_FORTRAN_SHAPE, 284 eval_op_f_array_shape>; 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>; 291 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 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 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 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 418 } /* namespace expr */ 419 420 #endif /* FORTRAN_EXP_H */ 421